[mcclim-cvs] CVS mcclim

[thenriksen]

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