annotate lisp/=sc-alist.el @ 18999:4d5237dec736 libc-970727 libc-970728

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