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