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 ")