mcclim-cvs January 2008

mcclim-cvs@common-lisp.net

7 participants
255 discussions

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 31 Jan '08

31 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv6356/Drei Modified Files: input-editor.lisp Log Message: Moved some input-editing functions around. The typeout area is now cleared at the end of an input-editing session. --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/31 16:50:07 1.33 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/31 19:17:56 1.34 @@ -756,21 +756,9 @@ ;;; ;;; `With-input-editor-typeout' ;;; -;;; The CLIM spec is very vague about what this function is supposed -;;; to do, but the Franz users guide suggests that it is to be used to -;;; display information to the user while editing, sort of what we -;;; normally use a minibuffer for. Perhaps the output should be put in -;;; an output record above or below the editing area, but for now, we -;;; just put it in the minibuffer. That also means the `:erase' -;;; keyword argument is meaningless. We do add some extra limitations, -;;; though (check the docstring) - -(defgeneric invoke-with-input-editor-typeout (stream continuation &key erase) - (:documentation "Call `continuation' with a single argument, a -stream to do input-editor-typeout on.")) -(defmethod invoke-with-input-editor-typeout ((editing-stream drei-input-editing-mixin) - (continuation function) &key erase) +(defmethod climi::invoke-with-input-editor-typeout ((editing-stream drei-input-editing-mixin) + (continuation function) &key erase) (let* ((encapsulated-stream (encapsulating-stream-stream editing-stream)) (new-typeout-record (with-output-to-output-record (encapsulated-stream) (funcall continuation encapsulated-stream))) @@ -801,22 +789,7 @@ (stream-add-output-record encapsulated-stream new-typeout-record) (setf stream-typeout-record new-typeout-record))) ;; Now, let there be light! - (replay new-typeout-record encapsulated-stream)))))) - -(defmacro with-input-editor-typeout ((&optional (stream t) &rest args - &key erase) - &body body) - "`Stream' is not evaluated and must be a symbol. If T (the -default), `*standard-input*' will be used. `Stream' will be bound -to an `extended-output-stream' while `body' is being evaluated." - (declare (ignore erase)) - (check-type stream symbol) - (let ((stream (if (eq stream t) '*standard-output* stream))) - `(invoke-with-input-editor-typeout - ,stream - #'(lambda (,stream) - ,@body) - ,@args))) + (replay stream-typeout-record encapsulated-stream)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[mcclim-cvs] CVS mcclim/Goatee
by thenriksen 31 Jan '08

31 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Goatee In directory clnet:/tmp/cvs-serv6356/Goatee Modified Files: editing-stream.lisp Log Message: Moved some input-editing functions around. The typeout area is now cleared at the end of an input-editing session. --- /project/mcclim/cvsroot/mcclim/Goatee/editing-stream.lisp 2006/12/01 23:02:59 1.24 +++ /project/mcclim/cvsroot/mcclim/Goatee/editing-stream.lisp 2008/01/31 19:17:57 1.25 @@ -211,6 +211,7 @@ (defmethod climi::finalize ((stream goatee-input-editing-mixin) input-sensitizer) + (call-next-method) (setf (cursor-visibility (cursor (area stream))) nil) (let ((real-stream (encapsulating-stream-stream stream)) (record (area stream)))

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 31 Jan '08

31 Jan '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv6356 Modified Files: input-editing-drei.lisp input-editing.lisp Log Message: Moved some input-editing functions around. The typeout area is now cleared at the end of an input-editing session. --- /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2008/01/30 22:29:07 1.10 +++ /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2008/01/31 19:17:57 1.11 @@ -100,12 +100,9 @@ (define-condition rescan-condition (condition) ()) -(defgeneric finalize (editing-stream input-sensitizer) - (:documentation "Do any cleanup on an editing stream, like turning off the - cursor, etc.")) - (defmethod finalize ((stream drei:drei-input-editing-mixin) input-sensitizer) + (call-next-method) (setf (cursor-visibility stream) nil) (let ((real-stream (encapsulating-stream-stream stream)) (record (drei:drei-instance stream))) @@ -124,24 +121,6 @@ (setf (stream-cursor-position real-stream) (values 0 (nth-value 3 (input-editing-stream-bounding-rectangle stream)))))) -(defmethod invoke-with-input-editing :around ((stream extended-output-stream) - continuation - input-sensitizer - initial-contents - class) - (declare (ignore continuation input-sensitizer initial-contents class)) - (letf (((cursor-visibility (stream-text-cursor stream)) nil)) - (call-next-method))) - -(defmethod invoke-with-input-editing :around (stream - continuation - input-sensitizer - initial-contents - class) - (declare (ignore continuation input-sensitizer initial-contents class)) - (with-activation-gestures (*standard-activation-gestures*) - (call-next-method))) - ;; XXX: We are supposed to implement input editing for all ;; "interactive streams", but that's not really reasonable. We only ;; care about `clim-stream-pane's, at least for Drei, currently. --- /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/01/30 23:39:19 1.62 +++ /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/01/31 19:17:57 1.63 @@ -2,7 +2,7 @@ ;;; (c) copyright 2001 by ;;; Tim Moore (moore(a)bricoworks.com) -;;; (c) copyright 2006 by +;;; (c) copyright 2006-2008 by ;;; Troels Henriksen (athas(a)sigkill.dk) ;;; This library is free software; you can redistribute it and/or @@ -219,18 +219,47 @@ (stream-scan-pointer ,stream-var)))) ,@body))) +(defmacro with-input-editor-typeout ((&optional (stream t) &rest args + &key erase) + &body body) + "`Stream' is not evaluated and must be a symbol. If T (the +default), `*standard-input*' will be used. `Stream' will be bound +to an `extended-output-stream' while `body' is being evaluated." + (declare (ignore erase)) + (check-type stream symbol) + (let ((stream (if (eq stream t) '*standard-output* stream))) + `(invoke-with-input-editor-typeout + ,stream + #'(lambda (,stream) + ,@body) + ,@args))) + +(defun clear-typeout (&optional (stream t)) + "Blank out the input-editor typeout displayed on `stream', +defaulting to T for `*standard-output*'." + (with-input-editor-typeout (stream :erase t) + (declare (ignore stream)))) + (defun input-editing-rescan-loop (editing-stream continuation) (let ((start-scan-pointer (stream-scan-pointer editing-stream))) - (loop - (block rescan - (handler-bind ((rescan-condition - #'(lambda (c) - (reset-scan-pointer editing-stream start-scan-pointer) - ;; Input-editing contexts above may be interested... - (signal c) - (return-from rescan nil)))) - (return-from input-editing-rescan-loop - (funcall continuation editing-stream))))))) + (loop (block rescan + (handler-bind ((rescan-condition + #'(lambda (c) + (reset-scan-pointer editing-stream start-scan-pointer) + ;; Input-editing contexts above may be interested... + (signal c) + (return-from rescan nil)))) + (return-from input-editing-rescan-loop + (funcall continuation editing-stream))))))) + +(defgeneric finalize (editing-stream input-sensitizer) + (:documentation "Do any cleanup on an editing stream that is no +longer supposed to be used for editing, like turning off the +cursor, etc.")) + +(defmethod finalize ((stream input-editing-stream) input-sensitizer) + (clear-typeout stream) + (redraw-input-buffer stream)) (defgeneric invoke-with-input-editing (stream continuation input-sensitizer initial-contents class) @@ -254,6 +283,28 @@ (stream-default-view stream)))) (input-editing-rescan-loop stream continuation)) +(defmethod invoke-with-input-editing :around ((stream extended-output-stream) + continuation + input-sensitizer + initial-contents + class) + (declare (ignore continuation input-sensitizer initial-contents class)) + (letf (((cursor-visibility (stream-text-cursor stream)) nil)) + (call-next-method))) + +(defmethod invoke-with-input-editing :around (stream + continuation + input-sensitizer + initial-contents + class) + (declare (ignore continuation input-sensitizer initial-contents class)) + (with-activation-gestures (*standard-activation-gestures*) + (call-next-method))) + +(defgeneric invoke-with-input-editor-typeout (stream continuation &key erase) + (:documentation "Call `continuation' with a single argument, a +stream to do input-editor-typeout on.")) + (defgeneric input-editing-stream-bounding-rectangle (stream) (:documentation "Return the bounding rectangle of `stream' as four values. This function does not appear in the spec but is

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 31 Jan '08

31 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv31269/Drei Modified Files: lisp-syntax.lisp Log Message: Handle some more incomplete lexemes at end-of-buffer in Lisp syntax. --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/30 23:24:05 1.72 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/31 18:44:36 1.73 @@ -403,8 +403,9 @@ ((#\O #\o) 8) ((#\X #\x) 16)))) (fo) - (when (char= (object-after scan) - #\-) + (when (and (not (end-of-buffer-p scan)) + (char= (object-after scan) + #\-)) (fo)) (loop until (end-of-buffer-p scan) while (digit-char-p (object-after scan) radix)

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 31 Jan '08

31 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv6137/Drei Modified Files: drei-clim.lisp input-editor.lisp Log Message: Added new and cooler with-input-editor-typeout implementation for Drei. Still not used for anything inside McCLIM, but I hope to change input completion to use it instead of menu-choose for some cases. The biggest problem, I think, is that Goatee doesn't support with-input-editor-typeout. --- /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/01/31 12:14:05 1.38 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/01/31 16:50:07 1.39 @@ -389,14 +389,20 @@ (defmethod* (setf output-record-position) ((new-x number) (new-y number) (record drei-area)) - (setf (area-position record) (list new-x new-y))) + (multiple-value-bind (old-x old-y) (output-record-position record) + (setf (area-position record) (list new-x new-y)) + (dolist (cursor (cursors record)) + (multiple-value-bind (cursor-x cursor-y) (output-record-position cursor) + (setf (output-record-position cursor) + (values (+ (- cursor-x old-x) new-x) + (+ (- cursor-y old-y) new-y))))))) (defmethod output-record-start-cursor-position ((record drei-area)) (output-record-position record)) (defmethod* (setf output-record-start-cursor-position) ((new-x number) (new-y number) (record drei-area)) - (setf (output-record-position record) (list new-x new-y))) + (setf (output-record-position record) (values new-x new-y))) (defmethod output-record-hit-detection-rectangle* ((record drei-area)) (bounding-rectangle* record)) --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/31 11:19:35 1.32 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/31 16:50:07 1.33 @@ -46,7 +46,13 @@ :initform nil :documentation "After a command has been executed, the contents of the Drei area instance shall be -replaced by the contents of this array, if non-NIL.")) +replaced by the contents of this array, if non-NIL.") + (%typeout-record :accessor typeout-record + :initform nil + :documentation "The output record (if any) +that is the typeout information for this Drei-based +input-editing-stream. `With-input-editor-typeout' manages this +output record.")) (:documentation "An mixin that helps in implementing Drei-based input-editing streams. This class should not be directly instantiated.")) @@ -763,12 +769,39 @@ (:documentation "Call `continuation' with a single argument, a stream to do input-editor-typeout on.")) -(defmethod invoke-with-input-editor-typeout ((stream drei-input-editing-mixin) +(defmethod invoke-with-input-editor-typeout ((editing-stream drei-input-editing-mixin) (continuation function) &key erase) - (declare (ignore erase)) - (with-bound-drei-special-variables ((drei-instance stream)) - (with-minibuffer-stream (minibuffer) - (funcall continuation minibuffer)))) + (let* ((encapsulated-stream (encapsulating-stream-stream editing-stream)) + (new-typeout-record (with-output-to-output-record (encapsulated-stream) + (funcall continuation encapsulated-stream))) + (editor-record (drei-instance editing-stream))) + (with-accessors ((stream-typeout-record typeout-record)) editing-stream + (with-sheet-medium (medium encapsulated-stream) + (with-bounding-rectangle* (x1 y1 x2 y2) editor-record + ;; Clear the input-editor display. + (draw-rectangle* medium x1 y1 x2 y2 :ink +background-ink+) + (setf (output-record-position new-typeout-record) + (output-record-position (or stream-typeout-record editor-record)) + (output-record-position editor-record) + (values x1 (+ y1 (- (bounding-rectangle-height new-typeout-record) + (if stream-typeout-record + (bounding-rectangle-height stream-typeout-record) + 0))))) + (when erase + (with-bounding-rectangle* (x1 y1 x2 y2) new-typeout-record + (draw-rectangle* medium x1 y1 x2 y2 :ink +background-ink+))) + ;; Reuse the old stream-typeout-record, if any. + (cond (stream-typeout-record + ;; Blank the old one. + (with-bounding-rectangle* (x1 y1 x2 y2) stream-typeout-record + (draw-rectangle* medium x1 y1 (1+ x2) y2 :ink +background-ink+)) + (clear-output-record stream-typeout-record) + (add-output-record new-typeout-record stream-typeout-record)) + (t + (stream-add-output-record encapsulated-stream new-typeout-record) + (setf stream-typeout-record new-typeout-record))) + ;; Now, let there be light! + (replay new-typeout-record encapsulated-stream)))))) (defmacro with-input-editor-typeout ((&optional (stream t) &rest args &key erase) @@ -778,12 +811,12 @@ to an `extended-output-stream' while `body' is being evaluated." (declare (ignore erase)) (check-type stream symbol) - (let ((stream (if (eq stream t) *standard-input* stream))) - `(apply #'invoke-with-input-editor-typeout - ,stream - #'(lambda (,stream) - ,@body) - ,args))) + (let ((stream (if (eq stream t) '*standard-output* stream))) + `(invoke-with-input-editor-typeout + ,stream + #'(lambda (,stream) + ,@body) + ,@args))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 31 Jan '08

31 Jan '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv796 Modified Files: mcclim.asd presentation-defs.lisp presentations.lisp Log Message: Moved with-output-as-presentation to presentations.lisp, so it can be available when input-editing.lisp is compiled. --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2008/01/10 09:38:07 1.74 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2008/01/31 12:14:05 1.75 @@ -218,8 +218,8 @@ :depends-on (:clim-basic :goatee-core :clim-postscript) :components ((:file "text-formatting") (:file "defresource") - (:file "input-editing") (:file "presentations") + (:file "input-editing" :depends-on ("presentations")) (:file "pointer-tracking" :depends-on ("input-editing")) (:file "graph-formatting") (:file "frames" :depends-on ("commands" "presentations" "presentation-defs" --- /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2007/11/19 22:14:05 1.73 +++ /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2008/01/31 12:14:05 1.74 @@ -392,40 +392,6 @@ (type-key parameters options object type stream view &key &allow-other-keys)) -(defmacro with-output-as-presentation ((stream object type - &rest key-args - &key modifier single-box - (allow-sensitive-inferiors t) - parent - (record-type - ''standard-presentation) - &allow-other-keys) - &body body) - (declare (ignore parent single-box modifier)) - (setq stream (stream-designator-symbol stream '*standard-output*)) - (multiple-value-bind (decls with-body) - (get-body-declarations body) - (with-gensyms (record-arg continuation) - (with-keywords-removed (key-args (:record-type - :allow-sensitive-inferiors)) - `(flet ((,continuation () - ,@decls - ,@with-body)) - (declare (dynamic-extent #'continuation)) - (if (and (output-recording-stream-p ,stream) - *allow-sensitive-inferiors*) - (with-new-output-record - (,stream ,record-type ,record-arg - :object ,object - :type (expand-presentation-type-abbreviation - ,type) - ,@key-args) - (let ((*allow-sensitive-inferiors* - ,allow-sensitive-inferiors)) - (,continuation))) - (,continuation))))))) - - (defun present (object &optional (type (presentation-type-of object)) &key (stream *standard-output*) --- /project/mcclim/cvsroot/mcclim/presentations.lisp 2008/01/31 10:47:08 1.83 +++ /project/mcclim/cvsroot/mcclim/presentations.lisp 2008/01/31 12:14:05 1.84 @@ -52,6 +52,39 @@ (when *print-presentation-verbose* (format stream " ~S" (presentation-object self)))))) +(defmacro with-output-as-presentation ((stream object type + &rest key-args + &key modifier single-box + (allow-sensitive-inferiors t) + parent + (record-type + ''standard-presentation) + &allow-other-keys) + &body body) + (declare (ignore parent single-box modifier)) + (setq stream (stream-designator-symbol stream '*standard-output*)) + (multiple-value-bind (decls with-body) + (get-body-declarations body) + (with-gensyms (record-arg continuation) + (with-keywords-removed (key-args (:record-type + :allow-sensitive-inferiors)) + `(flet ((,continuation () + ,@decls + ,@with-body)) + (declare (dynamic-extent #'continuation)) + (if (and (output-recording-stream-p ,stream) + *allow-sensitive-inferiors*) + (with-new-output-record + (,stream ,record-type ,record-arg + :object ,object + :type (expand-presentation-type-abbreviation + ,type) + ,@key-args) + (let ((*allow-sensitive-inferiors* + ,allow-sensitive-inferiors)) + (,continuation))) + (,continuation))))))) + (defgeneric ptype-specializer (type) (:documentation "The specializer to use for this type in a presentation method lambda list"))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 31 Jan '08

31 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv796/Drei Modified Files: drei-clim.lisp packages.lisp Log Message: Moved with-output-as-presentation to presentations.lisp, so it can be available when input-editing.lisp is compiled. --- /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/01/30 15:56:42 1.37 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/01/31 12:14:05 1.38 @@ -387,14 +387,14 @@ (defmethod output-record-position ((record drei-area)) (values-list (area-position record))) -(defmethod (setf output-record-position) ((new-x number) (new-y number) - (record drei-area)) +(defmethod* (setf output-record-position) ((new-x number) (new-y number) + (record drei-area)) (setf (area-position record) (list new-x new-y))) (defmethod output-record-start-cursor-position ((record drei-area)) (output-record-position record)) -(defmethod (setf output-record-start-cursor-position) ((new-x number) (new-y number) +(defmethod* (setf output-record-start-cursor-position) ((new-x number) (new-y number) (record drei-area)) (setf (output-record-position record) (list new-x new-y))) --- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/30 11:48:40 1.49 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/31 12:14:05 1.50 @@ -184,7 +184,7 @@ contents.")) (defpackage :drei - (:use :clim-lisp :clim :drei-buffer :drei-base :drei-abbrev + (:use :clim-lisp :clim-sys :clim :drei-buffer :drei-base :drei-abbrev :drei-syntax :flexichain :drei-undo :esa-buffer :esa-io :esa :esa-utils :drei-kill-ring) (:export #:drei-buffer #:needs-saving

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 31 Jan '08

31 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv18673/Drei Modified Files: input-editor.lisp Log Message: Only constrain point/mark when we actually have a prompt. You can now delete the leading command in the Listener! --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/30 22:11:35 1.31 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/31 11:19:35 1.32 @@ -571,10 +571,16 @@ ;; we may need to do some stuff first. (unwind-protect (accepting-from-user (drei) - ;; We narrow the buffer to the input position, so the user won't - ;; be able to erase the original command (when entering command - ;; arguments) or stuff like argument prompts. - (drei-core:with-narrowed-buffer (drei (input-position stream) t t) + ;; We narrow the buffer to the last object before + ;; input-position, so the user will not be able to + ;; delete arguments prompts or other things. + (drei-core:with-narrowed-buffer (drei + (loop for index from (1- (input-position stream)) above 0 + when (typep (buffer-object (buffer (view drei)) index) + 'noise-string) + return (1+ index) + finally (return 0)) + t t) (handler-case (process-gestures-or-command drei) (unbound-gesture-sequence (c) (display-message "~A is unbound" (gesture-name (gestures c))))

1 0

[mcclim-cvs] CVS mcclim/Apps/Listener
by rschlatte 31 Jan '08

31 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory clnet:/tmp/cvs-serv17422/Apps/Listener Modified Files: dev-commands.lisp util.lisp Log Message: cleanup parent-directory, remove filtermap --- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2008/01/26 05:09:39 1.47 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2008/01/31 11:06:40 1.48 @@ -555,9 +555,9 @@ (initfunc (clim-mop:slot-definition-initfunction slot)) (initform (clim-mop:slot-definition-initform slot)) (direct-slots (direct-slot-definitions class name)) - (readers (reduce #'append (filtermap direct-slots #'clim-mop:slot-definition-readers))) - (writers (reduce #'append (filtermap direct-slots #'clim-mop:slot-definition-writers))) - (documentation (first (filtermap direct-slots (lambda (x) (documentation x t))))) + (readers (mapcan #'clim-mop:slot-definition-readers direct-slots)) + (writers (mapcan #'clim-mop:slot-definition-writers direct-slots)) + (documentation (first (mapcan (lambda (x) (list (documentation x t))) direct-slots))) (*standard-output* stream)) (macrolet ((with-ink ((var) &body body) @@ -1146,7 +1146,7 @@ (format t " (only files of type ~a)" (pathname-type pathname))))) (when (parent-directory pathname) - (with-output-as-presentation (t (strip-filespec (parent-directory pathname)) 'clim:pathname :single-box t) + (with-output-as-presentation (t (parent-directory pathname) 'clim:pathname :single-box t) (draw-icon t (standard-icon "up-folder.xpm") :extra-spacing 3) (format t "Parent Directory~%"))) --- /project/mcclim/cvsroot/mcclim/Apps/Listener/util.lisp 2007/02/05 03:28:05 1.22 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/util.lisp 2008/01/31 11:06:40 1.23 @@ -20,11 +20,6 @@ ;;; Boston, MA 02111-1307 USA. - -(defun filtermap (list func &optional (filter #'null)) - (declare (type (function (t) t) func)) - (delete-if filter (mapcar func list))) - ;(defmacro multiple-value-prog2 (&body body) `(progn ,(first body) (multiple-value-prog1 ,@(rest body)))) ;; multiple-value-or, ugh. Normal OR drops values except from the last form. @@ -275,14 +270,15 @@ #+scl :query #+scl nil :defaults pathname)) -;; Oops, should I be doing something with relative pathnames here? (defun parent-directory (pathname) "Returns a pathname designating the directory 'up' from PATHNAME" - (let ((dir (pathname-directory (truename (strip-filespec pathname))))) + (let ((dir (pathname-directory (truename pathname)))) (when (and (eq (first dir) :absolute) - (not (zerop (length (rest dir))))) - (make-pathname :directory `(:absolute ,@(nreverse (rest (reverse (rest dir))))) - :defaults pathname)))) + (rest dir)) + ;; merge-pathnames merges :back, but not :up + (strip-filespec + (merge-pathnames (make-pathname :directory '(:relative :back)) + (truename pathname)))))) ;;;; Abbreviating item formatter

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 31 Jan '08

31 Jan '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv13034 Modified Files: NEWS presentations.lisp Log Message: Fixed erroneous call to MENU-CHOOSE. Mentioned MENU-CHOOSE change in NEWS. --- /project/mcclim/cvsroot/mcclim/NEWS 2008/01/29 19:13:07 1.33 +++ /project/mcclim/cvsroot/mcclim/NEWS 2008/01/31 10:47:07 1.34 @@ -21,6 +21,8 @@ ** Specification compliance: The :inherit-menu keyword argument to DEFINE-COMMAND-TABLE and MAKE-COMMAND-TABLE is now implemented with CLIM 2.2 semantics. The :keystrokes value is not handled yet. +** Specification compliance: :PRINTER functions for MENU-CHOOSE are + now called with the menu item, not the display object. * Changes in mcclim-0.9.5 relative to 0.9.4: ** Installation: the systems clim-listener, clim-examples, --- /project/mcclim/cvsroot/mcclim/presentations.lisp 2007/11/19 22:04:29 1.82 +++ /project/mcclim/cvsroot/mcclim/presentations.lisp 2008/01/31 10:47:08 1.83 @@ -1917,12 +1917,13 @@ :label label :associated-window window :printer #'(lambda (item stream) - (document-presentation-translator - (presentation-translator-menu-item-translator item) - (presentation-translator-menu-item-presentation item) - (presentation-translator-menu-item-context item) - frame nil window x y - :stream stream)) + (let ((object (first item))) + (document-presentation-translator + (presentation-translator-menu-item-translator object) + (presentation-translator-menu-item-presentation object) + (presentation-translator-menu-item-context object) + frame nil window x y + :stream stream))) :label label :pointer-documentation *pointer-documentation-output*) (declare (ignore object))

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-cvs January 2008