diff options
| -rw-r--r-- | lisp/emacs-lisp/cl-extra.el | 60 |
1 files changed, 59 insertions, 1 deletions
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 60c20e68b03..98e55dab98f 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el | |||
| @@ -43,6 +43,7 @@ | |||
| 43 | 43 | ||
| 44 | ;;; Type coercion. | 44 | ;;; Type coercion. |
| 45 | 45 | ||
| 46 | ;;;###autoload | ||
| 46 | (defun coerce (x type) | 47 | (defun coerce (x type) |
| 47 | "Coerce OBJECT to type TYPE. | 48 | "Coerce OBJECT to type TYPE. |
| 48 | TYPE is a Common Lisp type specifier. | 49 | TYPE is a Common Lisp type specifier. |
| @@ -60,6 +61,7 @@ TYPE is a Common Lisp type specifier. | |||
| 60 | 61 | ||
| 61 | ;;; Predicates. | 62 | ;;; Predicates. |
| 62 | 63 | ||
| 64 | ;;;###autoload | ||
| 63 | (defun equalp (x y) | 65 | (defun equalp (x y) |
| 64 | "Return t if two Lisp objects have similar structures and contents. | 66 | "Return t if two Lisp objects have similar structures and contents. |
| 65 | This is like `equal', except that it accepts numerically equal | 67 | This is like `equal', except that it accepts numerically equal |
| @@ -87,6 +89,7 @@ strings case-insensitively." | |||
| 87 | 89 | ||
| 88 | ;;; Control structures. | 90 | ;;; Control structures. |
| 89 | 91 | ||
| 92 | ;;;###autoload | ||
| 90 | (defun cl-mapcar-many (cl-func cl-seqs) | 93 | (defun cl-mapcar-many (cl-func cl-seqs) |
| 91 | (if (cdr (cdr cl-seqs)) | 94 | (if (cdr (cdr cl-seqs)) |
| 92 | (let* ((cl-res nil) | 95 | (let* ((cl-res nil) |
| @@ -119,6 +122,7 @@ strings case-insensitively." | |||
| 119 | cl-res))) | 122 | cl-res))) |
| 120 | (nreverse cl-res)))) | 123 | (nreverse cl-res)))) |
| 121 | 124 | ||
| 125 | ;;;###autoload | ||
| 122 | (defun map (cl-type cl-func cl-seq &rest cl-rest) | 126 | (defun map (cl-type cl-func cl-seq &rest cl-rest) |
| 123 | "Map a FUNCTION across one or more SEQUENCEs, returning a sequence. | 127 | "Map a FUNCTION across one or more SEQUENCEs, returning a sequence. |
| 124 | TYPE is the sequence type to return. | 128 | TYPE is the sequence type to return. |
| @@ -126,6 +130,7 @@ TYPE is the sequence type to return. | |||
| 126 | (let ((cl-res (apply 'mapcar* cl-func cl-seq cl-rest))) | 130 | (let ((cl-res (apply 'mapcar* cl-func cl-seq cl-rest))) |
| 127 | (and cl-type (coerce cl-res cl-type)))) | 131 | (and cl-type (coerce cl-res cl-type)))) |
| 128 | 132 | ||
| 133 | ;;;###autoload | ||
| 129 | (defun maplist (cl-func cl-list &rest cl-rest) | 134 | (defun maplist (cl-func cl-list &rest cl-rest) |
| 130 | "Map FUNCTION to each sublist of LIST or LISTs. | 135 | "Map FUNCTION to each sublist of LIST or LISTs. |
| 131 | Like `mapcar', except applies to lists and their cdr's rather than to | 136 | Like `mapcar', except applies to lists and their cdr's rather than to |
| @@ -154,6 +159,7 @@ the elements themselves. | |||
| 154 | cl-seq) | 159 | cl-seq) |
| 155 | (mapc cl-func cl-seq))) | 160 | (mapc cl-func cl-seq))) |
| 156 | 161 | ||
| 162 | ;;;###autoload | ||
| 157 | (defun mapl (cl-func cl-list &rest cl-rest) | 163 | (defun mapl (cl-func cl-list &rest cl-rest) |
| 158 | "Like `maplist', but does not accumulate values returned by the function. | 164 | "Like `maplist', but does not accumulate values returned by the function. |
| 159 | \n(fn FUNCTION LIST...)" | 165 | \n(fn FUNCTION LIST...)" |
| @@ -163,16 +169,19 @@ the elements themselves. | |||
| 163 | (while cl-p (funcall cl-func cl-p) (setq cl-p (cdr cl-p))))) | 169 | (while cl-p (funcall cl-func cl-p) (setq cl-p (cdr cl-p))))) |
| 164 | cl-list) | 170 | cl-list) |
| 165 | 171 | ||
| 172 | ;;;###autoload | ||
| 166 | (defun mapcan (cl-func cl-seq &rest cl-rest) | 173 | (defun mapcan (cl-func cl-seq &rest cl-rest) |
| 167 | "Like `mapcar', but nconc's together the values returned by the function. | 174 | "Like `mapcar', but nconc's together the values returned by the function. |
| 168 | \n(fn FUNCTION SEQUENCE...)" | 175 | \n(fn FUNCTION SEQUENCE...)" |
| 169 | (apply 'nconc (apply 'mapcar* cl-func cl-seq cl-rest))) | 176 | (apply 'nconc (apply 'mapcar* cl-func cl-seq cl-rest))) |
| 170 | 177 | ||
| 178 | ;;;###autoload | ||
| 171 | (defun mapcon (cl-func cl-list &rest cl-rest) | 179 | (defun mapcon (cl-func cl-list &rest cl-rest) |
| 172 | "Like `maplist', but nconc's together the values returned by the function. | 180 | "Like `maplist', but nconc's together the values returned by the function. |
| 173 | \n(fn FUNCTION LIST...)" | 181 | \n(fn FUNCTION LIST...)" |
| 174 | (apply 'nconc (apply 'maplist cl-func cl-list cl-rest))) | 182 | (apply 'nconc (apply 'maplist cl-func cl-list cl-rest))) |
| 175 | 183 | ||
| 184 | ;;;###autoload | ||
| 176 | (defun some (cl-pred cl-seq &rest cl-rest) | 185 | (defun some (cl-pred cl-seq &rest cl-rest) |
| 177 | "Return true if PREDICATE is true of any element of SEQ or SEQs. | 186 | "Return true if PREDICATE is true of any element of SEQ or SEQs. |
| 178 | If so, return the true (non-nil) value returned by PREDICATE. | 187 | If so, return the true (non-nil) value returned by PREDICATE. |
| @@ -188,6 +197,7 @@ If so, return the true (non-nil) value returned by PREDICATE. | |||
| 188 | (while (and cl-seq (not (setq cl-x (funcall cl-pred (pop cl-seq)))))) | 197 | (while (and cl-seq (not (setq cl-x (funcall cl-pred (pop cl-seq)))))) |
| 189 | cl-x))) | 198 | cl-x))) |
| 190 | 199 | ||
| 200 | ;;;###autoload | ||
| 191 | (defun every (cl-pred cl-seq &rest cl-rest) | 201 | (defun every (cl-pred cl-seq &rest cl-rest) |
| 192 | "Return true if PREDICATE is true of every element of SEQ or SEQs. | 202 | "Return true if PREDICATE is true of every element of SEQ or SEQs. |
| 193 | \n(fn PREDICATE SEQ...)" | 203 | \n(fn PREDICATE SEQ...)" |
| @@ -201,19 +211,23 @@ If so, return the true (non-nil) value returned by PREDICATE. | |||
| 201 | (setq cl-seq (cdr cl-seq))) | 211 | (setq cl-seq (cdr cl-seq))) |
| 202 | (null cl-seq))) | 212 | (null cl-seq))) |
| 203 | 213 | ||
| 214 | ;;;###autoload | ||
| 204 | (defun notany (cl-pred cl-seq &rest cl-rest) | 215 | (defun notany (cl-pred cl-seq &rest cl-rest) |
| 205 | "Return true if PREDICATE is false of every element of SEQ or SEQs. | 216 | "Return true if PREDICATE is false of every element of SEQ or SEQs. |
| 206 | \n(fn PREDICATE SEQ...)" | 217 | \n(fn PREDICATE SEQ...)" |
| 207 | (not (apply 'some cl-pred cl-seq cl-rest))) | 218 | (not (apply 'some cl-pred cl-seq cl-rest))) |
| 208 | 219 | ||
| 220 | ;;;###autoload | ||
| 209 | (defun notevery (cl-pred cl-seq &rest cl-rest) | 221 | (defun notevery (cl-pred cl-seq &rest cl-rest) |
| 210 | "Return true if PREDICATE is false of some element of SEQ or SEQs. | 222 | "Return true if PREDICATE is false of some element of SEQ or SEQs. |
| 211 | \n(fn PREDICATE SEQ...)" | 223 | \n(fn PREDICATE SEQ...)" |
| 212 | (not (apply 'every cl-pred cl-seq cl-rest))) | 224 | (not (apply 'every cl-pred cl-seq cl-rest))) |
| 213 | 225 | ||
| 214 | ;;; Support for `loop'. | 226 | ;;; Support for `loop'. |
| 227 | ;;;###autoload | ||
| 215 | (defalias 'cl-map-keymap 'map-keymap) | 228 | (defalias 'cl-map-keymap 'map-keymap) |
| 216 | 229 | ||
| 230 | ;;;###autoload | ||
| 217 | (defun cl-map-keymap-recursively (cl-func-rec cl-map &optional cl-base) | 231 | (defun cl-map-keymap-recursively (cl-func-rec cl-map &optional cl-base) |
| 218 | (or cl-base | 232 | (or cl-base |
| 219 | (setq cl-base (copy-sequence [0]))) | 233 | (setq cl-base (copy-sequence [0]))) |
| @@ -228,6 +242,7 @@ If so, return the true (non-nil) value returned by PREDICATE. | |||
| 228 | (funcall cl-func-rec cl-base cl-bind)))) | 242 | (funcall cl-func-rec cl-base cl-bind)))) |
| 229 | cl-map)) | 243 | cl-map)) |
| 230 | 244 | ||
| 245 | ;;;###autoload | ||
| 231 | (defun cl-map-intervals (cl-func &optional cl-what cl-prop cl-start cl-end) | 246 | (defun cl-map-intervals (cl-func &optional cl-what cl-prop cl-start cl-end) |
| 232 | (or cl-what (setq cl-what (current-buffer))) | 247 | (or cl-what (setq cl-what (current-buffer))) |
| 233 | (if (bufferp cl-what) | 248 | (if (bufferp cl-what) |
| @@ -255,6 +270,7 @@ If so, return the true (non-nil) value returned by PREDICATE. | |||
| 255 | (funcall cl-func cl-start (min cl-next cl-end)) | 270 | (funcall cl-func cl-start (min cl-next cl-end)) |
| 256 | (setq cl-start cl-next))))) | 271 | (setq cl-start cl-next))))) |
| 257 | 272 | ||
| 273 | ;;;###autoload | ||
| 258 | (defun cl-map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg) | 274 | (defun cl-map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg) |
| 259 | (or cl-buffer (setq cl-buffer (current-buffer))) | 275 | (or cl-buffer (setq cl-buffer (current-buffer))) |
| 260 | (if (fboundp 'overlay-lists) | 276 | (if (fboundp 'overlay-lists) |
| @@ -296,6 +312,7 @@ If so, return the true (non-nil) value returned by PREDICATE. | |||
| 296 | (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil))))) | 312 | (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil))))) |
| 297 | 313 | ||
| 298 | ;;; Support for `setf'. | 314 | ;;; Support for `setf'. |
| 315 | ;;;###autoload | ||
| 299 | (defun cl-set-frame-visible-p (frame val) | 316 | (defun cl-set-frame-visible-p (frame val) |
| 300 | (cond ((null val) (make-frame-invisible frame)) | 317 | (cond ((null val) (make-frame-invisible frame)) |
| 301 | ((eq val 'icon) (iconify-frame frame)) | 318 | ((eq val 'icon) (iconify-frame frame)) |
| @@ -304,6 +321,7 @@ If so, return the true (non-nil) value returned by PREDICATE. | |||
| 304 | 321 | ||
| 305 | ;;; Support for `progv'. | 322 | ;;; Support for `progv'. |
| 306 | (defvar cl-progv-save) | 323 | (defvar cl-progv-save) |
| 324 | ;;;###autoload | ||
| 307 | (defun cl-progv-before (syms values) | 325 | (defun cl-progv-before (syms values) |
| 308 | (while syms | 326 | (while syms |
| 309 | (push (if (boundp (car syms)) | 327 | (push (if (boundp (car syms)) |
| @@ -323,6 +341,7 @@ If so, return the true (non-nil) value returned by PREDICATE. | |||
| 323 | 341 | ||
| 324 | ;;; Numbers. | 342 | ;;; Numbers. |
| 325 | 343 | ||
| 344 | ;;;###autoload | ||
| 326 | (defun gcd (&rest args) | 345 | (defun gcd (&rest args) |
| 327 | "Return the greatest common divisor of the arguments." | 346 | "Return the greatest common divisor of the arguments." |
| 328 | (let ((a (abs (or (pop args) 0)))) | 347 | (let ((a (abs (or (pop args) 0)))) |
| @@ -331,6 +350,7 @@ If so, return the true (non-nil) value returned by PREDICATE. | |||
| 331 | (while (> b 0) (setq b (% a (setq a b)))))) | 350 | (while (> b 0) (setq b (% a (setq a b)))))) |
| 332 | a)) | 351 | a)) |
| 333 | 352 | ||
| 353 | ;;;###autoload | ||
| 334 | (defun lcm (&rest args) | 354 | (defun lcm (&rest args) |
| 335 | "Return the least common multiple of the arguments." | 355 | "Return the least common multiple of the arguments." |
| 336 | (if (memq 0 args) | 356 | (if (memq 0 args) |
| @@ -341,6 +361,7 @@ If so, return the true (non-nil) value returned by PREDICATE. | |||
| 341 | (setq a (* (/ a (gcd a b)) b)))) | 361 | (setq a (* (/ a (gcd a b)) b)))) |
| 342 | a))) | 362 | a))) |
| 343 | 363 | ||
| 364 | ;;;###autoload | ||
| 344 | (defun isqrt (x) | 365 | (defun isqrt (x) |
| 345 | "Return the integer square root of the argument." | 366 | "Return the integer square root of the argument." |
| 346 | (if (and (integerp x) (> x 0)) | 367 | (if (and (integerp x) (> x 0)) |
| @@ -352,12 +373,14 @@ If so, return the true (non-nil) value returned by PREDICATE. | |||
| 352 | g) | 373 | g) |
| 353 | (if (eq x 0) 0 (signal 'arith-error nil)))) | 374 | (if (eq x 0) 0 (signal 'arith-error nil)))) |
| 354 | 375 | ||
| 376 | ;;;###autoload | ||
| 355 | (defun floor* (x &optional y) | 377 | (defun floor* (x &optional y) |
| 356 | "Return a list of the floor of X and the fractional part of X. | 378 | "Return a list of the floor of X and the fractional part of X. |
| 357 | With two arguments, return floor and remainder of their quotient." | 379 | With two arguments, return floor and remainder of their quotient." |
| 358 | (let ((q (floor x y))) | 380 | (let ((q (floor x y))) |
| 359 | (list q (- x (if y (* y q) q))))) | 381 | (list q (- x (if y (* y q) q))))) |
| 360 | 382 | ||
| 383 | ;;;###autoload | ||
| 361 | (defun ceiling* (x &optional y) | 384 | (defun ceiling* (x &optional y) |
| 362 | "Return a list of the ceiling of X and the fractional part of X. | 385 | "Return a list of the ceiling of X and the fractional part of X. |
| 363 | With two arguments, return ceiling and remainder of their quotient." | 386 | With two arguments, return ceiling and remainder of their quotient." |
| @@ -365,12 +388,14 @@ With two arguments, return ceiling and remainder of their quotient." | |||
| 365 | (if (= (car (cdr res)) 0) res | 388 | (if (= (car (cdr res)) 0) res |
| 366 | (list (1+ (car res)) (- (car (cdr res)) (or y 1)))))) | 389 | (list (1+ (car res)) (- (car (cdr res)) (or y 1)))))) |
| 367 | 390 | ||
| 391 | ;;;###autoload | ||
| 368 | (defun truncate* (x &optional y) | 392 | (defun truncate* (x &optional y) |
| 369 | "Return a list of the integer part of X and the fractional part of X. | 393 | "Return a list of the integer part of X and the fractional part of X. |
| 370 | With two arguments, return truncation and remainder of their quotient." | 394 | With two arguments, return truncation and remainder of their quotient." |
| 371 | (if (eq (>= x 0) (or (null y) (>= y 0))) | 395 | (if (eq (>= x 0) (or (null y) (>= y 0))) |
| 372 | (floor* x y) (ceiling* x y))) | 396 | (floor* x y) (ceiling* x y))) |
| 373 | 397 | ||
| 398 | ;;;###autoload | ||
| 374 | (defun round* (x &optional y) | 399 | (defun round* (x &optional y) |
| 375 | "Return a list of X rounded to the nearest integer and the remainder. | 400 | "Return a list of X rounded to the nearest integer and the remainder. |
| 376 | With two arguments, return rounding and remainder of their quotient." | 401 | With two arguments, return rounding and remainder of their quotient." |
| @@ -389,14 +414,17 @@ With two arguments, return rounding and remainder of their quotient." | |||
| 389 | (let ((q (round x))) | 414 | (let ((q (round x))) |
| 390 | (list q (- x q)))))) | 415 | (list q (- x q)))))) |
| 391 | 416 | ||
| 417 | ;;;###autoload | ||
| 392 | (defun mod* (x y) | 418 | (defun mod* (x y) |
| 393 | "The remainder of X divided by Y, with the same sign as Y." | 419 | "The remainder of X divided by Y, with the same sign as Y." |
| 394 | (nth 1 (floor* x y))) | 420 | (nth 1 (floor* x y))) |
| 395 | 421 | ||
| 422 | ;;;###autoload | ||
| 396 | (defun rem* (x y) | 423 | (defun rem* (x y) |
| 397 | "The remainder of X divided by Y, with the same sign as X." | 424 | "The remainder of X divided by Y, with the same sign as X." |
| 398 | (nth 1 (truncate* x y))) | 425 | (nth 1 (truncate* x y))) |
| 399 | 426 | ||
| 427 | ;;;###autoload | ||
| 400 | (defun signum (x) | 428 | (defun signum (x) |
| 401 | "Return 1 if X is positive, -1 if negative, 0 if zero." | 429 | "Return 1 if X is positive, -1 if negative, 0 if zero." |
| 402 | (cond ((> x 0) 1) ((< x 0) -1) (t 0))) | 430 | (cond ((> x 0) 1) ((< x 0) -1) (t 0))) |
| @@ -405,6 +433,7 @@ With two arguments, return rounding and remainder of their quotient." | |||
| 405 | ;; Random numbers. | 433 | ;; Random numbers. |
| 406 | 434 | ||
| 407 | (defvar *random-state*) | 435 | (defvar *random-state*) |
| 436 | ;;;###autoload | ||
| 408 | (defun random* (lim &optional state) | 437 | (defun random* (lim &optional state) |
| 409 | "Return a random nonnegative number less than LIM, an integer or float. | 438 | "Return a random nonnegative number less than LIM, an integer or float. |
| 410 | Optional second arg STATE is a random-state object." | 439 | Optional second arg STATE is a random-state object." |
| @@ -412,7 +441,7 @@ Optional second arg STATE is a random-state object." | |||
| 412 | ;; Inspired by "ran3" from Numerical Recipes. Additive congruential method. | 441 | ;; Inspired by "ran3" from Numerical Recipes. Additive congruential method. |
| 413 | (let ((vec (aref state 3))) | 442 | (let ((vec (aref state 3))) |
| 414 | (if (integerp vec) | 443 | (if (integerp vec) |
| 415 | (let ((i 0) (j (- 1357335 (% (abs vec) 1357333))) (k 1) ii) | 444 | (let ((i 0) (j (- 1357335 (% (abs vec) 1357333))) (k 1)) |
| 416 | (aset state 3 (setq vec (make-vector 55 nil))) | 445 | (aset state 3 (setq vec (make-vector 55 nil))) |
| 417 | (aset vec 0 j) | 446 | (aset vec 0 j) |
| 418 | (while (> (setq i (% (+ i 21) 55)) 0) | 447 | (while (> (setq i (% (+ i 21) 55)) 0) |
| @@ -429,6 +458,7 @@ Optional second arg STATE is a random-state object." | |||
| 429 | (if (< (setq n (logand n mask)) lim) n (random* lim state)))) | 458 | (if (< (setq n (logand n mask)) lim) n (random* lim state)))) |
| 430 | (* (/ n '8388608e0) lim))))) | 459 | (* (/ n '8388608e0) lim))))) |
| 431 | 460 | ||
| 461 | ;;;###autoload | ||
| 432 | (defun make-random-state (&optional state) | 462 | (defun make-random-state (&optional state) |
| 433 | "Return a copy of random-state STATE, or of `*random-state*' if omitted. | 463 | "Return a copy of random-state STATE, or of `*random-state*' if omitted. |
| 434 | If STATE is t, return a new state object seeded from the time of day." | 464 | If STATE is t, return a new state object seeded from the time of day." |
| @@ -437,6 +467,7 @@ If STATE is t, return a new state object seeded from the time of day." | |||
| 437 | ((integerp state) (vector 'cl-random-state-tag -1 30 state)) | 467 | ((integerp state) (vector 'cl-random-state-tag -1 30 state)) |
| 438 | (t (make-random-state (cl-random-time))))) | 468 | (t (make-random-state (cl-random-time))))) |
| 439 | 469 | ||
| 470 | ;;;###autoload | ||
| 440 | (defun random-state-p (object) | 471 | (defun random-state-p (object) |
| 441 | "Return t if OBJECT is a random-state object." | 472 | "Return t if OBJECT is a random-state object." |
| 442 | (and (vectorp object) (= (length object) 4) | 473 | (and (vectorp object) (= (length object) 4) |
| @@ -460,6 +491,7 @@ If STATE is t, return a new state object seeded from the time of day." | |||
| 460 | (defvar float-epsilon) | 491 | (defvar float-epsilon) |
| 461 | (defvar float-negative-epsilon) | 492 | (defvar float-negative-epsilon) |
| 462 | 493 | ||
| 494 | ;;;###autoload | ||
| 463 | (defun cl-float-limits () | 495 | (defun cl-float-limits () |
| 464 | (or most-positive-float (not (numberp '2e1)) | 496 | (or most-positive-float (not (numberp '2e1)) |
| 465 | (let ((x '2e0) y z) | 497 | (let ((x '2e0) y z) |
| @@ -497,6 +529,7 @@ If STATE is t, return a new state object seeded from the time of day." | |||
| 497 | 529 | ||
| 498 | ;;; Sequence functions. | 530 | ;;; Sequence functions. |
| 499 | 531 | ||
| 532 | ;;;###autoload | ||
| 500 | (defun subseq (seq start &optional end) | 533 | (defun subseq (seq start &optional end) |
| 501 | "Return the subsequence of SEQ from START to END. | 534 | "Return the subsequence of SEQ from START to END. |
| 502 | If END is omitted, it defaults to the length of the sequence. | 535 | If END is omitted, it defaults to the length of the sequence. |
| @@ -522,6 +555,7 @@ If START or END is negative, it counts from the end." | |||
| 522 | (setq i (1+ i) start (1+ start))) | 555 | (setq i (1+ i) start (1+ start))) |
| 523 | res)))))) | 556 | res)))))) |
| 524 | 557 | ||
| 558 | ;;;###autoload | ||
| 525 | (defun concatenate (type &rest seqs) | 559 | (defun concatenate (type &rest seqs) |
| 526 | "Concatenate, into a sequence of type TYPE, the argument SEQUENCEs. | 560 | "Concatenate, into a sequence of type TYPE, the argument SEQUENCEs. |
| 527 | \n(fn TYPE SEQUENCE...)" | 561 | \n(fn TYPE SEQUENCE...)" |
| @@ -533,14 +567,17 @@ If START or END is negative, it counts from the end." | |||
| 533 | 567 | ||
| 534 | ;;; List functions. | 568 | ;;; List functions. |
| 535 | 569 | ||
| 570 | ;;;###autoload | ||
| 536 | (defun revappend (x y) | 571 | (defun revappend (x y) |
| 537 | "Equivalent to (append (reverse X) Y)." | 572 | "Equivalent to (append (reverse X) Y)." |
| 538 | (nconc (reverse x) y)) | 573 | (nconc (reverse x) y)) |
| 539 | 574 | ||
| 575 | ;;;###autoload | ||
| 540 | (defun nreconc (x y) | 576 | (defun nreconc (x y) |
| 541 | "Equivalent to (nconc (nreverse X) Y)." | 577 | "Equivalent to (nconc (nreverse X) Y)." |
| 542 | (nconc (nreverse x) y)) | 578 | (nconc (nreverse x) y)) |
| 543 | 579 | ||
| 580 | ;;;###autoload | ||
| 544 | (defun list-length (x) | 581 | (defun list-length (x) |
| 545 | "Return the length of list X. Return nil if list is circular." | 582 | "Return the length of list X. Return nil if list is circular." |
| 546 | (let ((n 0) (fast x) (slow x)) | 583 | (let ((n 0) (fast x) (slow x)) |
| @@ -548,6 +585,7 @@ If START or END is negative, it counts from the end." | |||
| 548 | (setq n (+ n 2) fast (cdr (cdr fast)) slow (cdr slow))) | 585 | (setq n (+ n 2) fast (cdr (cdr fast)) slow (cdr slow))) |
| 549 | (if fast (if (cdr fast) nil (1+ n)) n))) | 586 | (if fast (if (cdr fast) nil (1+ n)) n))) |
| 550 | 587 | ||
| 588 | ;;;###autoload | ||
| 551 | (defun tailp (sublist list) | 589 | (defun tailp (sublist list) |
| 552 | "Return true if SUBLIST is a tail of LIST." | 590 | "Return true if SUBLIST is a tail of LIST." |
| 553 | (while (and (consp list) (not (eq sublist list))) | 591 | (while (and (consp list) (not (eq sublist list))) |
| @@ -559,6 +597,7 @@ If START or END is negative, it counts from the end." | |||
| 559 | 597 | ||
| 560 | ;;; Property lists. | 598 | ;;; Property lists. |
| 561 | 599 | ||
| 600 | ;;;###autoload | ||
| 562 | (defun get* (sym tag &optional def) ; See compiler macro in cl-macs.el | 601 | (defun get* (sym tag &optional def) ; See compiler macro in cl-macs.el |
| 563 | "Return the value of SYMBOL's PROPNAME property, or DEFAULT if none. | 602 | "Return the value of SYMBOL's PROPNAME property, or DEFAULT if none. |
| 564 | \n(fn SYMBOL PROPNAME &optional DEFAULT)" | 603 | \n(fn SYMBOL PROPNAME &optional DEFAULT)" |
| @@ -569,6 +608,7 @@ If START or END is negative, it counts from the end." | |||
| 569 | (setq plist (cdr (cdr plist)))) | 608 | (setq plist (cdr (cdr plist)))) |
| 570 | (if plist (car (cdr plist)) def))))) | 609 | (if plist (car (cdr plist)) def))))) |
| 571 | 610 | ||
| 611 | ;;;###autoload | ||
| 572 | (defun getf (plist tag &optional def) | 612 | (defun getf (plist tag &optional def) |
| 573 | "Search PROPLIST for property PROPNAME; return its value or DEFAULT. | 613 | "Search PROPLIST for property PROPNAME; return its value or DEFAULT. |
| 574 | PROPLIST is a list of the sort returned by `symbol-plist'. | 614 | PROPLIST is a list of the sort returned by `symbol-plist'. |
| @@ -583,16 +623,19 @@ PROPLIST is a list of the sort returned by `symbol-plist'. | |||
| 583 | (setq plist (cdr (cdr plist)))) | 623 | (setq plist (cdr (cdr plist)))) |
| 584 | (if plist (car (cdr plist)) def)))) | 624 | (if plist (car (cdr plist)) def)))) |
| 585 | 625 | ||
| 626 | ;;;###autoload | ||
| 586 | (defun cl-set-getf (plist tag val) | 627 | (defun cl-set-getf (plist tag val) |
| 587 | (let ((p plist)) | 628 | (let ((p plist)) |
| 588 | (while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p)))) | 629 | (while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p)))) |
| 589 | (if p (progn (setcar (cdr p) val) plist) (list* tag val plist)))) | 630 | (if p (progn (setcar (cdr p) val) plist) (list* tag val plist)))) |
| 590 | 631 | ||
| 632 | ;;;###autoload | ||
| 591 | (defun cl-do-remf (plist tag) | 633 | (defun cl-do-remf (plist tag) |
| 592 | (let ((p (cdr plist))) | 634 | (let ((p (cdr plist))) |
| 593 | (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p)))) | 635 | (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p)))) |
| 594 | (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) | 636 | (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) |
| 595 | 637 | ||
| 638 | ;;;###autoload | ||
| 596 | (defun cl-remprop (sym tag) | 639 | (defun cl-remprop (sym tag) |
| 597 | "Remove from SYMBOL's plist the property PROPNAME and its value. | 640 | "Remove from SYMBOL's plist the property PROPNAME and its value. |
| 598 | \n(fn SYMBOL PROPNAME)" | 641 | \n(fn SYMBOL PROPNAME)" |
| @@ -600,6 +643,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'. | |||
| 600 | (if (and plist (eq tag (car plist))) | 643 | (if (and plist (eq tag (car plist))) |
| 601 | (progn (setplist sym (cdr (cdr plist))) t) | 644 | (progn (setplist sym (cdr (cdr plist))) t) |
| 602 | (cl-do-remf plist tag)))) | 645 | (cl-do-remf plist tag)))) |
| 646 | ;;;###autoload | ||
| 603 | (defalias 'remprop 'cl-remprop) | 647 | (defalias 'remprop 'cl-remprop) |
| 604 | 648 | ||
| 605 | 649 | ||
| @@ -616,14 +660,22 @@ PROPLIST is a list of the sort returned by `symbol-plist'. | |||
| 616 | (defvar cl-builtin-clrhash (symbol-function 'clrhash)) | 660 | (defvar cl-builtin-clrhash (symbol-function 'clrhash)) |
| 617 | (defvar cl-builtin-maphash (symbol-function 'maphash)) | 661 | (defvar cl-builtin-maphash (symbol-function 'maphash)) |
| 618 | 662 | ||
| 663 | ;;;###autoload | ||
| 619 | (defalias 'cl-gethash 'gethash) | 664 | (defalias 'cl-gethash 'gethash) |
| 665 | ;;;###autoload | ||
| 620 | (defalias 'cl-puthash 'puthash) | 666 | (defalias 'cl-puthash 'puthash) |
| 667 | ;;;###autoload | ||
| 621 | (defalias 'cl-remhash 'remhash) | 668 | (defalias 'cl-remhash 'remhash) |
| 669 | ;;;###autoload | ||
| 622 | (defalias 'cl-clrhash 'clrhash) | 670 | (defalias 'cl-clrhash 'clrhash) |
| 671 | ;;;###autoload | ||
| 623 | (defalias 'cl-maphash 'maphash) | 672 | (defalias 'cl-maphash 'maphash) |
| 624 | ;; These three actually didn't exist in Emacs-20. | 673 | ;; These three actually didn't exist in Emacs-20. |
| 674 | ;;;###autoload | ||
| 625 | (defalias 'cl-make-hash-table 'make-hash-table) | 675 | (defalias 'cl-make-hash-table 'make-hash-table) |
| 676 | ;;;###autoload | ||
| 626 | (defalias 'cl-hash-table-p 'hash-table-p) | 677 | (defalias 'cl-hash-table-p 'hash-table-p) |
| 678 | ;;;###autoload | ||
| 627 | (defalias 'cl-hash-table-count 'hash-table-count) | 679 | (defalias 'cl-hash-table-count 'hash-table-count) |
| 628 | 680 | ||
| 629 | ;;; Some debugging aids. | 681 | ;;; Some debugging aids. |
| @@ -672,6 +724,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'. | |||
| 672 | (defvar cl-macroexpand-cmacs nil) | 724 | (defvar cl-macroexpand-cmacs nil) |
| 673 | (defvar cl-closure-vars nil) | 725 | (defvar cl-closure-vars nil) |
| 674 | 726 | ||
| 727 | ;;;###autoload | ||
| 675 | (defun cl-macroexpand-all (form &optional env) | 728 | (defun cl-macroexpand-all (form &optional env) |
| 676 | "Expand all macro calls through a Lisp FORM. | 729 | "Expand all macro calls through a Lisp FORM. |
| 677 | This also does some trivial optimizations to make the form prettier." | 730 | This also does some trivial optimizations to make the form prettier." |
| @@ -753,6 +806,7 @@ This also does some trivial optimizations to make the form prettier." | |||
| 753 | (defun cl-macroexpand-body (body &optional env) | 806 | (defun cl-macroexpand-body (body &optional env) |
| 754 | (mapcar (function (lambda (x) (cl-macroexpand-all x env))) body)) | 807 | (mapcar (function (lambda (x) (cl-macroexpand-all x env))) body)) |
| 755 | 808 | ||
| 809 | ;;;###autoload | ||
| 756 | (defun cl-prettyexpand (form &optional full) | 810 | (defun cl-prettyexpand (form &optional full) |
| 757 | (message "Expanding...") | 811 | (message "Expanding...") |
| 758 | (let ((cl-macroexpand-cmacs full) (cl-compiling-file full) | 812 | (let ((cl-macroexpand-cmacs full) (cl-compiling-file full) |
| @@ -767,5 +821,9 @@ This also does some trivial optimizations to make the form prettier." | |||
| 767 | 821 | ||
| 768 | (run-hooks 'cl-extra-load-hook) | 822 | (run-hooks 'cl-extra-load-hook) |
| 769 | 823 | ||
| 824 | ;; Local variables: | ||
| 825 | ;; generated-autoload-file: "cl-loaddefs.el" | ||
| 826 | ;; End: | ||
| 827 | |||
| 770 | ;; arch-tag: bcd03437-0871-43fb-a8f1-ad0e0b5427ed | 828 | ;; arch-tag: bcd03437-0871-43fb-a8f1-ad0e0b5427ed |
| 771 | ;;; cl-extra.el ends here | 829 | ;;; cl-extra.el ends here |