September 2006 - mcclim-cvs@common-lisp.net

[mcclim-cvs] CVS mcclim
by afuchs 25 Sep '06

25 Sep '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv10630 Modified Files: incremental-redisplay.lisp Log Message: Fix the rectangle-edges* bug that prevented beirc from properly starting up on os x. * map-over-updating-output shouldn't call itself with a nil record; it breaks expectations of code in the same file. --- /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp 2006/05/28 21:32:43 1.64 +++ /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp 2006/09/25 00:30:01 1.65 @@ -474,15 +474,12 @@ (record standard-updating-output-record) use-old-records) (funcall function record) - (cond (use-old-records - (if (slot-boundp record 'old-children) - (map-over-updating-output function - (old-children record) - use-old-records) - nil)) - (t (map-over-updating-output function - (sub-record record) - use-old-records)))) + (let ((children (cond (use-old-records + (when (slot-boundp record 'old-children) + (old-children record))) + (t (sub-record record))))) + (when children + (map-over-updating-output function children use-old-records)))) (defmethod map-over-updating-output

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 17 Sep '06

17 Sep '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv29736 Modified Files: commands.lisp Log Message: `Lookup-keystroke-item' does not take an :errorp argument according to the spec. And if we really want it to, it should be NIL by default. --- /project/mcclim/cvsroot/mcclim/commands.lisp 2006/05/12 10:24:32 1.63 +++ /project/mcclim/cvsroot/mcclim/commands.lisp 2006/09/17 20:34:39 1.64 @@ -481,8 +481,7 @@ nil))) (defun lookup-keystroke-item (gesture command-table - &key (test #'event-matches-gesture-name-p) - (errorp t)) + &key (test #'event-matches-gesture-name-p)) (let ((command-table (find-command-table command-table))) (multiple-value-bind (item table) (find-keystroke-item gesture command-table :test test :errorp nil) @@ -495,15 +494,11 @@ (multiple-value-bind (sub-item sub-command-table) (lookup-keystroke-item gesture (command-menu-item-value item) - :test test - :errorp nil) + :test test) (when sub-command-table (return-from lookup-keystroke-item (values sub-item sub-command-table)))))) - command-table)) - (if errorp - (error 'command-not-present) - nil))) + command-table)))) (defun partial-command-from-name (command-name) (let ((parser (gethash command-name *command-parser-table*))) @@ -1369,7 +1364,8 @@ (let ((command (lookup-keystroke-command-item (accelerator-gesture-event c) command-table))) - (if (partial-command-p command) + (if (and (listp command) + (partial-command-p command)) (funcall *partial-command-parser* command-table stream command (position *unsupplied-argument-marker* command))

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 17 Sep '06

17 Sep '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv29211 Modified Files: graph-formatting.lisp Log Message: Removed weird characters in GB comment that made SBCL cry. --- /project/mcclim/cvsroot/mcclim/graph-formatting.lisp 2006/04/10 09:48:40 1.18 +++ /project/mcclim/cvsroot/mcclim/graph-formatting.lisp 2006/09/17 20:27:09 1.19 @@ -3,7 +3,7 @@ ;;; Title: Graph Formatting ;;; Created: 2002-08-13 ;;; License: LGPL (See file COPYING for details). -;;; $Id: graph-formatting.lisp,v 1.18 2006/04/10 09:48:40 crhodes Exp $ +;;; $Id: graph-formatting.lisp,v 1.19 2006/09/17 20:27:09 thenriksen Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 2002 by Gilbert Baumann @@ -39,8 +39,8 @@ ;; 'duplicate-test', if so why it is passed down and why is it not ;; restricted to the set of hash test functions? --GB 2002-08-13 -;; - What is the purpose of (SETF GRAPH-NODE-CHILDREN) and -;; (SETF GRAPH-NODE-PARENTS)? --GB 2002-08-14 +;; - What is the purpose of (SETF GRAPH-NODE-CHILDREN) and +;; (SETF GRAPH-NODE-PARENTS)? --GB 2002-08-14 ;; - FORMAT-GRAPH-FROM-ROOTS passes the various options on to the ;; instantiation of the graph-output-record class, so that the

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 13 Sep '06

13 Sep '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv14196 Modified Files: builtin-commands.lisp Log Message: Add more user-friendly `accept' presentation method for expressions on interactive streams. --- /project/mcclim/cvsroot/mcclim/builtin-commands.lisp 2006/08/05 19:54:31 1.23 +++ /project/mcclim/cvsroot/mcclim/builtin-commands.lisp 2006/09/13 10:44:15 1.24 @@ -329,6 +329,66 @@ (unread-char c stream)) (return (values object ptype)))))) +(define-presentation-method accept ((type expression) + (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) + (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*) + #+sbcl(sb-kernel:reader-package-error (e) + (progn + ;; Resignal the error. + (error e))) + ((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)) + (if (or subform-read auto-activate) + (values object ptype) + (loop + 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)))))) + (with-system-redefinition-allowed (defun read (&optional (stream *standard-input*) (eof-error-p t)

1 0