[mcclim-cvs] CVS mcclim
thenriksen
thenriksen at common-lisp.net
Mon Nov 19 22:35:04 UTC 2007
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
More information about the Mcclim-cvs
mailing list