Mercurial > hg > xemacs-beta
comparison lisp/cl-extra.el @ 5420:b9167d522a9a
Rebase with 21.5 trunk.
author | Mats Lidell <matsl@xemacs.org> |
---|---|
date | Thu, 28 Oct 2010 23:53:24 +0200 |
parents | 308d34e9f07d 99de5fd48e87 |
children | 8d29f1c4bb98 |
comparison
equal
deleted
inserted
replaced
5419:eaf01113cd42 | 5420:b9167d522a9a |
---|---|
401 | 401 |
402 (defun nreconc (x y) | 402 (defun nreconc (x y) |
403 "Equivalent to (nconc (nreverse X) Y)." | 403 "Equivalent to (nconc (nreverse X) Y)." |
404 (nconc (nreverse x) y)) | 404 (nconc (nreverse x) y)) |
405 | 405 |
406 ;; XEmacs; check LIST for type and circularity. | |
406 (defun tailp (sublist list) | 407 (defun tailp (sublist list) |
407 "Return true if SUBLIST is a tail of LIST." | 408 "Return true if SUBLIST is a tail of LIST." |
408 (while (and (consp list) (not (eq sublist list))) | 409 (check-argument-type #'listp list) |
409 (setq list (cdr list))) | 410 (let ((before list) (evenp t)) |
410 (if (numberp sublist) (equal sublist list) (eq sublist list))) | 411 (while (and (consp list) (not (eq sublist list))) |
412 (setq list (cdr list) | |
413 evenp (not evenp)) | |
414 (if evenp (setq before (cdr before))) | |
415 (if (eq before list) (error 'circular-list list))) | |
416 (eql sublist list))) | |
411 | 417 |
412 (defalias 'cl-copy-tree 'copy-tree) | 418 (defalias 'cl-copy-tree 'copy-tree) |
413 | 419 |
414 ;;; Property lists. | 420 ;;; Property lists. |
415 | 421 |
416 ;; XEmacs: our `get' groks DEFAULT. | 422 ;; XEmacs: our `get' groks DEFAULT. |
417 (defalias 'get* 'get) | 423 (defalias 'get* 'get) |
418 (defalias 'getf 'plist-get) | 424 (defalias 'getf 'plist-get) |
419 | 425 |
420 (defun cl-set-getf (plist tag val) | 426 ;; XEmacs; these are built-in. |
421 (let ((p plist)) | 427 (defalias 'cl-set-getf 'plist-put) |
422 (while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p)))) | 428 (defalias 'cl-do-remf 'plist-remprop) |
423 (if p (progn (setcar (cdr p) val) plist) (list* tag val plist)))) | |
424 | |
425 (defun cl-do-remf (plist tag) | |
426 (let ((p (cdr plist))) | |
427 (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p)))) | |
428 (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) | |
429 | |
430 ;; XEmacs change: we have a builtin remprop | |
431 (defalias 'cl-remprop 'remprop) | 429 (defalias 'cl-remprop 'remprop) |
432 | 430 |
433 (defun get-properties (plist indicator-list) | 431 (defun get-properties (plist indicator-list) |
434 "Find a property from INDICATOR-LIST in PLIST. | 432 "Find a property from INDICATOR-LIST in PLIST. |
435 Return 3 values: | 433 Return 3 values: |
653 (and (not full) '((block) (eval-when))))) | 651 (and (not full) '((block) (eval-when))))) |
654 (message "Formatting...") | 652 (message "Formatting...") |
655 (prog1 (cl-prettyprint form) | 653 (prog1 (cl-prettyprint form) |
656 (message "")))) | 654 (message "")))) |
657 | 655 |
656 ;; XEmacs addition; force cl-macs to be available from here on when | |
657 ;; compiling files to be dumped. This is more reasonable than forcing other | |
658 ;; files to do the same, multiple times. | |
659 (eval-when-compile (or (cl-compiling-file) (load "cl-macs"))) | |
660 | |
658 (run-hooks 'cl-extra-load-hook) | 661 (run-hooks 'cl-extra-load-hook) |
659 | 662 |
660 ;; XEmacs addition | 663 ;; XEmacs addition |
661 (provide 'cl-extra) | 664 (provide 'cl-extra) |
662 | 665 |