[mcclim-cvs] CVS mcclim

[thenriksen]

Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv3669

Modified Files:
	input-editing.lisp 
Log Message:
Added in-line completion using input-editor typeout instead of calling menu-choose.

Does not work in Goatee.

May fail under some circumstances that input-editor typeout doesn't handle well yet.

May behave illogically because the list of completions is kept alive
for fairly long, yet the presentations on it become untouchable almost
immediately. This is because they are of a specially created
completion presentation type, and not the more general presentation
type of the object they represent. This knowledge is not accessible to
the input-editing machinery (also, it seems presentation type options
are compared for equality using EQ/EQL, so two content-wise identical
possibility-lists can have different completion presentation types).


--- /project/mcclim/cvsroot/mcclim/input-editing.lisp	2008/02/01 10:53:54	1.64
+++ /project/mcclim/cvsroot/mcclim/input-editing.lisp	2008/02/01 12:01:10	1.65
@@ -544,9 +544,30 @@
   "A default function for printing a possibility. Suitable for
 used as value of `:possibility-printer' in calls to
 `complete-input'"
-  (destructuring-bind (string object) possibility
-    (with-output-as-presentation (stream object ptype)
-      (write-string string stream))))
+  (with-output-as-presentation (stream possibility ptype)
+    (write-string (first possibility) stream)))
+
+(defun print-possibilities (possibilities possibility-printer stream)
+  "Write `possibitilies' to `stream', using
+`possibility-printer'. `Possibilities' must be a list of
+input-completion possibilities. `Stream' must be an input-editing
+stream. Output will be done to its typeout."
+  (with-input-editor-typeout (stream :erase t)
+    (surrounding-output-with-border (stream :shape :drop-shadow :background +cornsilk1+)
+      (surrounding-output-with-border (stream :shape :rectangle)
+        (let* ((possibility-count (length possibilities))
+               (row-length (sqrt possibility-count))
+               (ptype `(completion ,possibilities)))
+          (formatting-table (stream)
+            (loop until (null possibilities)
+                  do (formatting-row (stream)
+                       (loop for cell-index from 0 below row-length
+                             until (null possibilities)
+                             do (formatting-cell (stream)
+                                  (funcall possibility-printer
+                                           (pop possibilities)
+                                           ptype
+                                           stream)))))))))))
 
 ;;; Helper returns gesture (or nil if gesture shouldn't be part of the input)
 ;;; and completion mode, if any.
@@ -631,23 +652,17 @@
                      (format *trace-output* "nmatches = ~A, mode = ~A~%"
                              nmatches mode))
                    (when (and (> nmatches 0) (eq mode :possibilities))
-                     (multiple-value-bind (menu-object item event)
-                         (menu-choose (possibilities-for-menu possibilities)
-                          :label "Possibilities"
-                          :n-columns 1
-                          :printer #'(lambda (possibility stream)
-                                       ;; We have to get a
-                                       ;; presentation type from
-                                       ;; somewhere...
-                                       (destructuring-bind (string &key value) possibility
-                                           (funcall possibility-printer
-                                                    (list string value)
-                                                    (presentation-type-of value)
-                                                    stream))))
-                       (declare (ignore event))
-                       (if item
+                     (print-possibilities possibilities possibility-printer stream)
+                     (let ((possibility
+                            (handler-case
+                                (with-input-context (`(completion ,possibilities) :override nil)
+                                    (object type event)
+                                    (prog1 nil (read-gesture :stream stream :peek-p t))
+                                  (t object))
+                              (abort-gesture () nil))))
+                       (if possibility
                            (setf (values input success object nmatches)
-                                 (values (car item) t menu-object 1))
+                                 (values (first possibility) t (second possibility) 1))
                            (setf success nil
                                  nmatches 0))))
                    (unless (and (eq mode :complete) (not success))