annotate lisp/utils/assoc.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1 ;;; assoc.el --- insert/delete/sort functions on association lists
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3 ;; Author: Barry A. Warsaw <bwarsaw@cen.com>
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4 ;; Keywords: extensions
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6 ;; This software is distributed in the hope that it will be useful,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
7 ;; but WITHOUT ANY WARRANTY. No author or distributor accepts
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
8 ;; responsibility to anyone for the consequences of using it or for
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
9 ;; whether it serves any particular purpose or works at all, unless he
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
10 ;; says so in writing.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
11
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
12 ;; This software was written as part of the supercite author's
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
13 ;; official duty as an employee of the United States Government and is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
14 ;; thus in the public domain. You are free to use that particular
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
15 ;; software as you wish, but WITHOUT ANY WARRANTY WHATSOEVER. It
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
16 ;; would be nice, though if when you use any of this code, you give
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
17 ;; due credit to the author.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
18
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
19 ;;; Synched up with: FSF 19.30.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
20
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
21 ;;; Commentary:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
22
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
23 ;; Association list utilities providing insertion, deletion, sorting
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
24 ;; fetching off key-value pairs in association lists.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
25
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
26 ;;; Code:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
27
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
28 (defun asort (alist-symbol key)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
29 "Move a specified key-value pair to the head of an alist.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
30 The alist is referenced by ALIST-SYMBOL. Key-value pair to move to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
31 head is one matching KEY. Returns the sorted list and doesn't affect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
32 the order of any other key-value pair. Side effect sets alist to new
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
33 sorted list."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
34 (set alist-symbol
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
35 (sort (copy-alist (eval alist-symbol))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
36 (function (lambda (a b) (equal (car a) key))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
37
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
38
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
39 (defun aelement (key value)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
40 "Makes a list of a cons cell containing car of KEY and cdr of VALUE.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
41 The returned list is suitable as an element of an alist."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
42 (list (cons key value)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
43
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
44
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
45 (defun aheadsym (alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
46 "Return the key symbol at the head of ALIST."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
47 (car (car alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
48
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
49
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
50 (defun anot-head-p (alist key)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
51 "Find out if a specified key-value pair is not at the head of an alist.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
52 The alist to check is specified by ALIST and the key-value pair is the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
53 one matching the supplied KEY. Returns nil if ALIST is nil, or if
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
54 key-value pair is at the head of the alist. Returns t if key-value
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
55 pair is not at the head of alist. ALIST is not altered."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
56 (not (equal (aheadsym alist) key)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
57
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
58
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
59 (defun aput (alist-symbol key &optional value)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
60 "Inserts a key-value pair into an alist.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
61 The alist is referenced by ALIST-SYMBOL. The key-value pair is made
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
62 from KEY and optionally, VALUE. Returns the altered alist or nil if
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
63 ALIST is nil.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
64
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
65 If the key-value pair referenced by KEY can be found in the alist, and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
66 VALUE is supplied non-nil, then the value of KEY will be set to VALUE.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
67 If VALUE is not supplied, or is nil, the key-value pair will not be
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
68 modified, but will be moved to the head of the alist. If the key-value
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
69 pair cannot be found in the alist, it will be inserted into the head
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
70 of the alist (with value nil if VALUE is nil or not supplied)."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
71 (let ((elem (aelement key value))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
72 alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
73 (asort alist-symbol key)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
74 (setq alist (eval alist-symbol))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
75 (cond ((null alist) (set alist-symbol elem))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
76 ((anot-head-p alist key) (set alist-symbol (nconc elem alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
77 (value (setcar alist (car elem)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
78 (t alist))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
79
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
80
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
81 (defun adelete (alist-symbol key)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
82 "Delete a key-value pair from the alist.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
83 Alist is referenced by ALIST-SYMBOL and the key-value pair to remove
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
84 is pair matching KEY. Returns the altered alist."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
85 (asort alist-symbol key)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
86 (let ((alist (eval alist-symbol)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
87 (cond ((null alist) nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
88 ((anot-head-p alist key) alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
89 (t (set alist-symbol (cdr alist))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
90
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
91
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
92 (defun aget (alist key &optional keynil-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
93 "Returns the value in ALIST that is associated with KEY.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
94 Optional KEYNIL-P describes what to do if the value associated with
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
95 KEY is nil. If KEYNIL-P is not supplied or is nil, and the value is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
96 nil, then KEY is returned. If KEYNIL-P is non-nil, then nil would be
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
97 returned.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
98
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
99 If no key-value pair matching KEY could be found in ALIST, or ALIST is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
100 nil then nil is returned. ALIST is not altered."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
101 (let ((copy (copy-alist alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
102 (cond ((null alist) nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
103 ((progn (asort 'copy key)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
104 (anot-head-p copy key)) nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
105 ((cdr (car copy)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
106 (keynil-p nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
107 ((car (car copy)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
108 (t nil))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
109
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
110
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
111 (defun amake (alist-symbol keylist &optional valuelist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
112 "Make an association list.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
113 The association list is attached to the alist referenced by
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
114 ALIST-SYMBOL. Each element in the KEYLIST becomes a key and is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
115 associated with the value in VALUELIST with the same index. If
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
116 VALUELIST is not supplied or is nil, then each key in KEYLIST is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
117 associated with nil.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
118
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
119 KEYLIST and VALUELIST should have the same number of elements, but
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
120 this isn't enforced. If VALUELIST is smaller than KEYLIST, remaining
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
121 keys are associated with nil. If VALUELIST is larger than KEYLIST,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
122 extra values are ignored. Returns the created alist."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
123 (let ((keycar (car keylist))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
124 (keycdr (cdr keylist))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
125 (valcar (car valuelist))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
126 (valcdr (cdr valuelist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
127 (cond ((null keycdr)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
128 (aput alist-symbol keycar valcar))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
129 (t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
130 (amake alist-symbol keycdr valcdr)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
131 (aput alist-symbol keycar valcar))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
132 (eval alist-symbol))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
133
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
134 (provide 'assoc)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
135
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
136 ;;; assoc.el ends here