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