Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv17530

Modified Files: lisp-syntax.lisp Log Message: Added :read keyword parameter to `token-to-object'.

--- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/22 18:23:03 1.77 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/31 13:55:15 1.78 @@ -2015,13 +2015,13 @@ :case case :no-error t))

-(defgeneric token-to-object (syntax token &rest args &key no-error package quote &allow-other-keys) +(defgeneric token-to-object (syntax token &rest args &key no-error package quote read &allow-other-keys) (:documentation "Return the Lisp object `token' would evaluate to if read. An attempt will be made to construct objects from incomplete tokens. This function may signal an error if `no-error' is nil and `token' cannot be converted to a Lisp object. Otherwise, nil will be returned.") - (:method :around (syntax token &rest args &key no-error package quote) + (:method :around (syntax token &rest args &key no-error package quote read) ;; Ensure that every symbol that is READ will be looked up ;; in the correct package. Also handle quoting. (handler-case (let ((*package* (if (and (slot-boundp syntax 'package) @@ -2033,11 +2033,13 @@ package (find-package package))) (find-package :common-lisp))))) - (if quote - (progn - (setf (getf args :quote) nil) - `',(call-next-method)) - (call-next-method))) + (cond (read + (read-from-string (token-string syntax token))) + (quote + (setf (getf args :quote) nil) + `',(call-next-method)) + (t + (call-next-method)))) (t () ;; Needs more usable error. (unless no-error