[mcclim-cvs] CVS mcclim

[thenriksen]

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)
      , at 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)