* vmlisp.lisp.pamphlet (getl): Rewrite to accept list of symbols

	of lists too.

2 files changed, 27 insertions, 7 deletions

diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog
index cb827526..1b969f79 100644
--- a/src/interp/ChangeLog
+++ b/src/interp/ChangeLog
@@ -1,3 +1,8 @@
+2007-08-23  Gabriel Dos Reis  <gdr@cs.tamu,edu>
+
+	* vmlisp.lisp.pamphlet (getl): Rewrite to accept list of symbols
+	of lists too.
+
 2007-08-22  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* bootfuns.lisp.pamphlet (|$algebraList|): Remove unused variable.
diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet
index 837ef55f..49cbcb7e 100644
--- a/src/interp/vmlisp.lisp.pamphlet
+++ b/src/interp/vmlisp.lisp.pamphlet
@@ -1975,13 +1975,28 @@ can be restored.
 
 ; A version of GET that works with lists
 
-; (defun getl (sym key )
-;   (cond ((consp sym) (cdr (assoc key sym :test #'eq)))
-;         ((symbolp sym) (get sym key))))
-(defun getl (sym key )
-  (cond ((consp sym) (cdr (assq key sym)))
-        ((symbolp sym) (get sym key))))
-
+;; GETL(SYM, KEY)
+;;   KEY: a SYMBOL
+;;   SYM: a SYMBOL or a LIST whose elements are SYMBOLs or LISTs.
+;; Returns:
+;;   when SYM is a SYMBOL, returns the KEY-property of SYM.
+;;   when SYM is a LIST, returns the either the KEY-property of the
+;;   first SYMBOL of SYM that has the KEY-property, or the CDR of the
+;;   first cons-cell whose CAR is EQ KEY.
+(defun getl (sym key)
+  (cond ((symbolp sym)
+	 (get sym key))
+	((null sym) nil)
+	((consp sym)
+	 (let ((sym-1 (car sym)))
+	   (cond ((symbolp sym-1)
+		  (get sym-1 key))
+		 ((and (consp sym-1)
+		       (symbolp (car sym-1)))
+		  (if (eq (car sym-1) key)
+		      (cdr sym-1)
+		    (getl (cdr sym) key))))))))
+		      
 ; The following should actually position the cursor at the sint'th line of the screen:
 
 (defun $showline (cvec sint) (terpri) sint (princ cvec))