1;;; assoc.el --- insert/delete/sort functions on association lists 2 3;; Copyright (C) 1996, 2001, 2002, 2003, 2004, 2005, 4;; 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Barry A. Warsaw <bwarsaw@cen.com> 7;; Keywords: extensions 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software; you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation; either version 2, or (at your option) 14;; any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with GNU Emacs; see the file COPYING. If not, write to the 23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Commentary: 27 28;; Association list utilities providing insertion, deletion, sorting 29;; fetching off key-value pairs in association lists. 30 31;;; Code: 32 33(defun asort (alist-symbol key) 34 "Move a specified key-value pair to the head of an alist. 35The alist is referenced by ALIST-SYMBOL. Key-value pair to move to 36head is one matching KEY. Returns the sorted list and doesn't affect 37the order of any other key-value pair. Side effect sets alist to new 38sorted list." 39 (set alist-symbol 40 (sort (copy-alist (eval alist-symbol)) 41 (function (lambda (a b) (equal (car a) key)))))) 42 43 44(defun aelement (key value) 45 "Makes a list of a cons cell containing car of KEY and cdr of VALUE. 46The returned list is suitable as an element of an alist." 47 (list (cons key value))) 48 49 50(defun aheadsym (alist) 51 "Return the key symbol at the head of ALIST." 52 (car (car alist))) 53 54 55(defun anot-head-p (alist key) 56 "Find out if a specified key-value pair is not at the head of an alist. 57The alist to check is specified by ALIST and the key-value pair is the 58one matching the supplied KEY. Returns nil if ALIST is nil, or if 59key-value pair is at the head of the alist. Returns t if key-value 60pair is not at the head of alist. ALIST is not altered." 61 (not (equal (aheadsym alist) key))) 62 63 64(defun aput (alist-symbol key &optional value) 65 "Inserts a key-value pair into an alist. 66The alist is referenced by ALIST-SYMBOL. The key-value pair is made 67from KEY and optionally, VALUE. Returns the altered alist or nil if 68ALIST is nil. 69 70If the key-value pair referenced by KEY can be found in the alist, and 71VALUE is supplied non-nil, then the value of KEY will be set to VALUE. 72If VALUE is not supplied, or is nil, the key-value pair will not be 73modified, but will be moved to the head of the alist. If the key-value 74pair cannot be found in the alist, it will be inserted into the head 75of the alist (with value nil if VALUE is nil or not supplied)." 76 (let ((elem (aelement key value)) 77 alist) 78 (asort alist-symbol key) 79 (setq alist (eval alist-symbol)) 80 (cond ((null alist) (set alist-symbol elem)) 81 ((anot-head-p alist key) (set alist-symbol (nconc elem alist))) 82 (value (setcar alist (car elem))) 83 (t alist)))) 84 85 86(defun adelete (alist-symbol key) 87 "Delete a key-value pair from the alist. 88Alist is referenced by ALIST-SYMBOL and the key-value pair to remove 89is pair matching KEY. Returns the altered alist." 90 (asort alist-symbol key) 91 (let ((alist (eval alist-symbol))) 92 (cond ((null alist) nil) 93 ((anot-head-p alist key) alist) 94 (t (set alist-symbol (cdr alist)))))) 95 96 97(defun aget (alist key &optional keynil-p) 98 "Returns the value in ALIST that is associated with KEY. 99Optional KEYNIL-P describes what to do if the value associated with 100KEY is nil. If KEYNIL-P is not supplied or is nil, and the value is 101nil, then KEY is returned. If KEYNIL-P is non-nil, then nil would be 102returned. 103 104If no key-value pair matching KEY could be found in ALIST, or ALIST is 105nil then nil is returned. ALIST is not altered." 106 (let ((copy (copy-alist alist))) 107 (cond ((null alist) nil) 108 ((progn (asort 'copy key) 109 (anot-head-p copy key)) nil) 110 ((cdr (car copy))) 111 (keynil-p nil) 112 ((car (car copy))) 113 (t nil)))) 114 115 116(defun amake (alist-symbol keylist &optional valuelist) 117 "Make an association list. 118The association list is attached to the alist referenced by 119ALIST-SYMBOL. Each element in the KEYLIST becomes a key and is 120associated with the value in VALUELIST with the same index. If 121VALUELIST is not supplied or is nil, then each key in KEYLIST is 122associated with nil. 123 124KEYLIST and VALUELIST should have the same number of elements, but 125this isn't enforced. If VALUELIST is smaller than KEYLIST, remaining 126keys are associated with nil. If VALUELIST is larger than KEYLIST, 127extra values are ignored. Returns the created alist." 128 (let ((keycar (car keylist)) 129 (keycdr (cdr keylist)) 130 (valcar (car valuelist)) 131 (valcdr (cdr valuelist))) 132 (cond ((null keycdr) 133 (aput alist-symbol keycar valcar)) 134 (t 135 (amake alist-symbol keycdr valcdr) 136 (aput alist-symbol keycar valcar)))) 137 (eval alist-symbol)) 138 139(provide 'assoc) 140 141;;; arch-tag: 3e58bd89-d912-4b74-a0dc-6ed9735922bc 142;;; assoc.el ends here 143