Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv25665
Modified Files: presentation-defs.lisp input-editing-drei.lisp Log Message: Added support for navigating presentation histories in Drei. Use M-p and M-n to browse previous input for a specific presentation type.
--- /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2006/11/08 01:18:22 1.58 +++ /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2006/11/20 09:00:56 1.59 @@ -480,9 +480,12 @@
(define-presentation-method presentation-type-history-for-stream ((type t) (stream input-editing-stream)) - (if (not (stream-rescanning-p stream)) - (funcall-presentation-generic-function presentation-type-history type) - nil)) + ;; What is the purpose of this? Makes stuff harder to do, so + ;; commented out... + ;;(if (not (stream-rescanning-p stream)) + ;; (funcall-presentation-generic-function presentation-type-history type) + ;; nil) + (funcall-presentation-generic-function presentation-type-history type))
(defun presentation-history-insert (history object ptype) (goatee::ring-obj-insert (cons object ptype) history)) @@ -508,6 +511,18 @@ 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)) --- /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2006/11/08 01:18:22 1.1 +++ /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2006/11/20 09:00:56 1.2 @@ -190,3 +190,46 @@
(defmethod input-editing-stream-bounding-rectangle ((stream standard-input-editing-stream)) (bounding-rectangle* (drei:drei-instance stream))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Presentation type history support +;;; +;;; Presentation histories are pretty underspecified, so we have to +;;; 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) + (let* ((accepting-type *active-history-type*) + (history (and accepting-type + (presentation-type-history accepting-type)))) + (when history + (multiple-value-bind (object type) + (presentation-history-next history accepting-type) + (when type + (presentation-replace-input stream object type (stream-default-view stream))))))) + +(defun history-yank-previous (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-previous history accepting-type) + (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-previous)