Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv31186

Modified Files: builtin-commands.lisp Log Message: Fixed the OpenMCL-conditional-thing in expression reading to not cause compiler warnings. I cannot test my fix on OpenMCL, but it works elsewhere.

--- /project/mcclim/cvsroot/mcclim/builtin-commands.lisp 2007/09/17 19:21:19 1.27 +++ /project/mcclim/cvsroot/mcclim/builtin-commands.lisp 2007/11/19 22:35:04 1.28 @@ -304,28 +304,29 @@ &key) (let* ((object nil) (ptype nil)) - (if (and #-openmcl nil subform-read) - (multiple-value-bind (val valid) - (funcall *sys-%read-list-expression* stream *dot-ok* *termch*) - (if valid - (setq object val) - (return-from accept (values nil 'list-terminator)))) - ;; We don't want activation gestures like :return causing an eof - ;; while reading a form. Also, we don't want spaces within forms or - ;; strings causing a premature return either! - ;; XXX This loses when rescanning (possibly in other contexts too) an - ;; activated input buffer (e.g., reading an expression from the accept - ;; method for OR where the previous readers have already given - ;; up). We should call *sys-read-preserving-whitespace* and handle the - ;; munching of whitespace ourselves according to the - ;; PRESERVE-WHITESPACE parameter. Fix after .9.2.2. - (with-delimiter-gestures (nil :override t) - (with-activation-gestures (nil :override t) - (setq object (funcall (if preserve-whitespace - *sys-read-preserving-whitespace* - *sys-read*) - stream - *eof-error-p* *eof-value* *recursivep*))))) + #.(funcall (if #+openmcl t #-openmcl nil #'identity #'fourth) + `(if subform-read + (multiple-value-bind (val valid) + (funcall *sys-%read-list-expression* stream *dot-ok* *termch*) + (if valid + (setq object val) + (return-from accept (values nil 'list-terminator)))) + ;; We don't want activation gestures like :return causing an eof + ;; while reading a form. Also, we don't want spaces within forms or + ;; strings causing a premature return either! + ;; XXX This loses when rescanning (possibly in other contexts too) an + ;; activated input buffer (e.g., reading an expression from the accept + ;; method for OR where the previous readers have already given + ;; up). We should call *sys-read-preserving-whitespace* and handle the + ;; munching of whitespace ourselves according to the + ;; PRESERVE-WHITESPACE parameter. Fix after .9.2.2. + (with-delimiter-gestures (nil :override t) + (with-activation-gestures (nil :override t) + (setq object (funcall (if preserve-whitespace + *sys-read-preserving-whitespace* + *sys-read*) + stream + *eof-error-p* *eof-value* *recursivep*)))))) (setq ptype (presentation-type-of object)) (unless (presentation-subtypep ptype 'expression) (setq ptype 'expression)) @@ -343,45 +344,46 @@ (stream input-editing-stream) (view textual-view) &key) - ;; This method is specialized to - ;; input-editing-streams and has thus been - ;; made slightly more tolerant of input - ;; errors. It is slightly hacky, but seems - ;; to work fine. - (let* ((object nil) + ;; This method is specialized to + ;; input-editing-streams and has thus been + ;; made slightly more tolerant of input + ;; errors. It is slightly hacky, but seems + ;; to work fine. + (let* ((object nil) (ptype nil)) - (if (and #-openmcl nil subform-read) - (multiple-value-bind (val valid) - (funcall *sys-%read-list-expression* stream *dot-ok* *termch*) - (if valid - (setq object val) - (return-from accept (values nil 'list-terminator)))) - ;; We don't want activation gestures like :return causing an - ;; eof while reading a form. Also, we don't want spaces within - ;; forms or strings causing a premature return either! - (with-delimiter-gestures (nil :override t) - (with-activation-gestures (nil :override t) - (setq object - ;; We loop in our accept of user input, if a reader - ;; error is signalled, we merely ignore it and ask - ;; for more input. This is so a single malplaced #( - ;; or #, won't throw up a debugger with a - ;; READER-ERROR and remove whatever the user wrote - ;; to the stream. - (loop for potential-object = - (handler-case (funcall - (if preserve-whitespace - *sys-read-preserving-whitespace* - *sys-read*) - stream - *eof-error-p* - *eof-value* - *recursivep*) - ((and reader-error) (e) - (declare (ignore e)) - nil)) - unless (null potential-object) - return potential-object))))) + #.(funcall (if #+openmcl t #-openmcl nil #'identity #'fourth) + `(if (and #-openmcl nil subform-read) + (multiple-value-bind (val valid) + (funcall *sys-%read-list-expression* stream *dot-ok* *termch*) + (if valid + (setq object val) + (return-from accept (values nil 'list-terminator)))) + ;; We don't want activation gestures like :return causing an + ;; eof while reading a form. Also, we don't want spaces within + ;; forms or strings causing a premature return either! + (with-delimiter-gestures (nil :override t) + (with-activation-gestures (nil :override t) + (setq object + ;; We loop in our accept of user input, if a reader + ;; error is signalled, we merely ignore it and ask + ;; for more input. This is so a single malplaced #( + ;; or #, won't throw up a debugger with a + ;; READER-ERROR and remove whatever the user wrote + ;; to the stream. + (loop for potential-object = + (handler-case (funcall + (if preserve-whitespace + *sys-read-preserving-whitespace* + *sys-read*) + stream + *eof-error-p* + *eof-value* + *recursivep*) + ((and reader-error) (e) + (declare (ignore e)) + nil)) + unless (null potential-object) + return potential-object)))))) (setq ptype (presentation-type-of object)) (unless (presentation-subtypep ptype 'expression) (setq ptype 'expression)) @@ -391,9 +393,9 @@ for c = (read-char stream) until (or (activation-gesture-p c) (delimiter-gesture-p c)) finally - (when (delimiter-gesture-p c) - (unread-char c stream)) - (return (values object ptype)))))) + (when (delimiter-gesture-p c) + (unread-char c stream)) + (return (values object ptype))))))

(with-system-redefinition-allowed