Mercurial > hg > xemacs-beta

comparison lisp/cl.el @ 3343:29234c1a76c7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2006-04-16 15:54:16 by aidan] Docstring improvements for basic Lisp functions, CL.
author aidan
date Sun, 16 Apr 2006 15:54:21 +0000
parents 6a9afa282c8e
children 721daee0fcd8
comparison
equal deleted inserted replaced
3342:9e258fc95550 3343:29234c1a76c7
130 130
131 ;;; Generalized variables. These macros are defined here so that they 131 ;;; Generalized variables. These macros are defined here so that they
132 ;;; can safely be used in .emacs files. 132 ;;; can safely be used in .emacs files.
133 133
134 (defmacro incf (place &optional x) 134 (defmacro incf (place &optional x)
135 "(incf PLACE [X]): increment PLACE by X (1 by default). 135 "Increment PLACE by X (1 by default).
136 PLACE may be a symbol, or any generalized variable allowed by `setf'. 136 PLACE may be a symbol, or any generalized variable allowed by `setf'.
137 The return value is the incremented value of PLACE." 137 The return value is the incremented value of PLACE."
138 (if (symbolp place) 138 (if (symbolp place)
139 (list 'setq place (if x (list '+ place x) (list '1+ place))) 139 (list 'setq place (if x (list '+ place x) (list '1+ place)))
140 ;; XEmacs byte-compiler optimizes (+ FOO 1) to (1+ FOO), so this 140 ;; XEmacs byte-compiler optimizes (+ FOO 1) to (1+ FOO), so this
141 ;; is OK. 141 ;; is OK.
142 (list 'callf '+ place (or x 1)))) 142 (list 'callf '+ place (or x 1))))
143 143
144 (defmacro decf (place &optional x) 144 (defmacro decf (place &optional x)
145 "(decf PLACE [X]): decrement PLACE by X (1 by default). 145 "Decrement PLACE by X (1 by default).
146 PLACE may be a symbol, or any generalized variable allowed by `setf'. 146 PLACE may be a symbol, or any generalized variable allowed by `setf'.
147 The return value is the decremented value of PLACE." 147 The return value is the decremented value of PLACE."
148 (if (symbolp place) 148 (if (symbolp place)
149 (list 'setq place (if x (list '- place x) (list '1- place))) 149 (list 'setq place (if x (list '- place x) (list '1- place)))
150 (list 'callf '- place (or x 1)))) 150 (list 'callf '- place (or x 1))))
151 151
152 (defmacro pop (place) 152 (defmacro pop (place)
153 "(pop PLACE): remove and return the head of the list stored in PLACE. 153 "Remove and return the head of the list stored in PLACE.
154 Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more 154 Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more
155 careful about evaluating each argument only once and in the right order. 155 careful about evaluating each argument only once and in the right order.
156 PLACE may be a symbol, or any generalized variable allowed by `setf'." 156 PLACE may be a symbol, or any generalized variable allowed by `setf'."
157 (if (symbolp place) 157 (if (symbolp place)
158 `(car (prog1 ,place (setq ,place (cdr ,place)))) 158 `(car (prog1 ,place (setq ,place (cdr ,place))))
159 (cl-do-pop place))) 159 (cl-do-pop place)))
160 160
161 (defmacro push (x place) 161 (defmacro push (newelt listname)
162 "(push X PLACE): insert X at the head of the list stored in PLACE. 162 "Add NEWELT to the list stored in LISTNAME.
163 Analogous to (setf PLACE (cons X PLACE)), though more careful about 163 Analogous to (setf LISTNAME (cons NEWELT LISTNAME)), though more careful about
164 evaluating each argument only once and in the right order. PLACE may 164 evaluating each argument only once and in the right order. LISTNAME may
165 be a symbol, or any generalized variable allowed by `setf'." 165 be a symbol, or any generalized variable allowed by `setf'."
166 (if (symbolp place) `(setq ,place (cons ,x ,place)) 166 (if (symbolp listname) `(setq ,listname (cons ,newelt ,listname))
167 (list 'callf2 'cons x place))) 167 (list 'callf2 'cons newelt listname)))
168 168
169 (defmacro pushnew (x place &rest keys) 169 (defmacro pushnew (newelt listname &rest keys)
170 "(pushnew X PLACE): insert X at the head of the list if not already there. 170 "Add NEWELT to the list stored in LISTNAME, unless it's already there.
171 Like (push X PLACE), except that the list is unmodified if X is `eql' to 171 Like (push NEWELT LISTNAME), except that the list is unmodified if NEWELT is
172 an element already on the list. 172 `eql' to an element already on the list.
173 Keywords supported: :test :test-not :key" 173 Keywords supported: :test :test-not :key"
174 (if (symbolp place) (list 'setq place (list* 'adjoin x place keys)) 174 (if (symbolp listname) (list 'setq listname
175 (list* 'callf2 'adjoin x place keys))) 175 (list* 'adjoin newelt listname keys))
176 (list* 'callf2 'adjoin newelt listname keys)))
176 177
177 (defun cl-set-elt (seq n val) 178 (defun cl-set-elt (seq n val)
178 (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val))) 179 (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val)))
179 180
180 (defun cl-set-nthcdr (n list x) 181 (defun cl-set-nthcdr (n list x)