Mercurial > hg > xemacs-beta
diff lisp/cl-extra.el @ 4800:b828e06dbe38
New (Common Lisp) function get-propertie
author | Didier Verna <didier@xemacs.org> |
---|---|
date | Wed, 06 Jan 2010 13:48:25 +0100 |
parents | 95b04754ea8c |
children | 6ef8256a020a 8431b52e43b1 |
line wrap: on
line diff
--- a/lisp/cl-extra.el Mon Jan 04 16:48:55 2010 -0700 +++ b/lisp/cl-extra.el Wed Jan 06 13:48:25 2010 +0100 @@ -103,8 +103,8 @@ (or (eq (setq cl-char (aref cl-string cl-i)) (setq cl-other (aref cl-vector cl-i))) (and (characterp cl-other) ; Note we want to call this - ; as rarely as possible, it - ; doesn't have a bytecode. + ; as rarely as possible, it + ; doesn't have a bytecode. (eq (downcase cl-char) (downcase cl-other)))))) (< cl-i 0)))) @@ -118,7 +118,7 @@ (when (= cl-i (length cl-vector)) (while (and (>= (setq cl-i (1- cl-i)) 0) (numberp (setq cl-other (aref cl-vector cl-i))) - ;; Differs from clisp here. + ;; Differs from clisp here. (= (aref cl-bit-vector cl-i) cl-other))) (< cl-i 0)))) @@ -182,7 +182,7 @@ (setq x (cdr x) y (cdr y))) (and (not (consp x)) (equalp x y))) (t - ;; From here on, the type tests don't (yet) have bytecodes. + ;; From here on, the type tests don't (yet) have bytecodes. (let ((x-type (type-of x))) (cond ((eq 'vector x-type) (if (stringp y) @@ -501,7 +501,7 @@ symbols (cdr symbols)) (push `(make-obsolete ',(intern (format "%s*" symbol)) ',symbol "21.5.29") - result) + result) (push `(defun ,(intern (format "%s*" symbol)) (number &optional divisor) ,(format "See `%s'. This returns a list, not multiple values." @@ -698,6 +698,18 @@ ;; XEmacs change: we have a builtin remprop (defalias 'cl-remprop 'remprop) +(defun get-properties (plist indicator-list) + "Find a property from INDICATOR-LIST in PLIST. +Return 3 values: +- the first property found, +- its value, +- the tail of PLIST beginning with the found entry." + (do ((plst plist (cddr plst))) + ((null plst) (values nil nil nil)) + (cond ((atom (cdr plst)) + (error "Malformed property list: %S." plist)) + ((memq (car plst) indicator-list) + (return (values (car plst) (cadr plst) plst)))))) ;;; Hash tables. @@ -764,7 +776,7 @@ (defun cl-do-prettyprint () (skip-chars-forward " ") (if (looking-at "(") - (let ((skip (or (looking-at "((") + (let ((skip (or (looking-at "((") ;; XEmacs: be selective about trailing stuff after prog (looking-at "(prog[nv12\\(ress-feedback\\|n-with-message\\)]") (looking-at "(unwind-protect ")