Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv17221
Modified Files: presentation-defs.lisp input-editing-drei.lisp Log Message: The presentation history functions are now named more sensibly.
Also, a change to `accept': we add the object to the presentation history of the type that was asked for, not the type that was returned. Input history should work in the Listener now (but there are still issues for non-trivial forms, unfortunately).
--- /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2006/11/22 14:53:12 1.60 +++ /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2006/11/27 07:44:46 1.61 @@ -500,6 +500,18 @@ finally (return (values nil nil))))
(defun presentation-history-next (history ptype) + (let ((first-object (goatee::backward history))) + (loop + for first-time = t then nil + for cell = first-object then (goatee::backward history) + for (object . object-ptype) = (goatee::contents cell) + while (or first-time (not (eq first-object cell))) + if (presentation-subtypep object-ptype ptype) + return (values object object-ptype) + end + finally (return (values nil nil))))) + +(defun presentation-history-previous (history ptype) (let ((first-object (goatee::forward history))) (loop for first-time = t then nil @@ -511,18 +523,6 @@ end finally (return (values nil nil)))))
-(defun presentation-history-previous (history ptype) - (let ((first-object (goatee::backward history))) - (loop - for first-time = t then nil - for cell = first-object then (goatee::backward history) - for (object . object-ptype) = (goatee::contents cell) - while (or first-time (not (eq first-object cell))) - if (presentation-subtypep object-ptype ptype) - return (values object object-ptype) - end - finally (return (values nil nil))))) - (defmacro with-object-on-history ((history object ptype) &body body) `(goatee::with-object-on-ring ((cons ,object ,ptype) ,history) ,@body)) @@ -723,7 +723,7 @@ (let* ((default-from-history (and (not defaultp) provide-default)) (history (get-history)) (results - (multiple-value-list + (multiple-value-list (if history (let ((*active-history-type* real-history-type)) (cond (defaultp @@ -746,7 +746,7 @@ (when results-history (presentation-history-add results-history (car results) - (cadr results))) + real-type)) (values-list results)))))))
(defmethod stream-accept ((stream standard-extended-input-stream) type --- /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2006/11/20 09:00:56 1.2 +++ /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2006/11/27 07:44:46 1.3 @@ -199,16 +199,8 @@ ;;; rely on internal features and implement input-editor support in ;;; CLIM-INTERNALS (Goatee does the same trick).
-(defun history-yank (stream input-buffer gesture numeric-argument) - (let* ((accepting-type *active-history-type*) - (history (and accepting-type - (presentation-type-history accepting-type)))) - (when history - (multiple-value-bind (object type) - (presentation-history-head history accepting-type) - (presentation-replace-input stream object type (stream-default-view stream)))))) - (defun history-yank-next (stream input-buffer gesture numeric-argument) + (declare (ignore input-buffer gesture numeric-argument)) (let* ((accepting-type *active-history-type*) (history (and accepting-type (presentation-type-history accepting-type)))) @@ -219,6 +211,7 @@ (presentation-replace-input stream object type (stream-default-view stream)))))))
(defun history-yank-previous (stream input-buffer gesture numeric-argument) + (declare (ignore input-buffer gesture numeric-argument)) (let* ((accepting-type *active-history-type*) (history (and accepting-type (presentation-type-history accepting-type)))) @@ -228,8 +221,6 @@ (when type (presentation-replace-input stream object type (stream-default-view stream)))))))
-(add-input-editor-command '((#\y :control :meta)) 'history-yank) - -(add-input-editor-command '((#\p :meta)) 'history-yank-next) +(add-input-editor-command '((#\n :meta)) 'history-yank-next)
-(add-input-editor-command '((#\n :meta)) 'history-yank-previous) +(add-input-editor-command '((#\p :meta)) 'history-yank-previous)