mcclim-cvs February 2008

mcclim-cvs@common-lisp.net

6 participants
86 discussions

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 01 Feb '08

01 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv19569/Drei Modified Files: input-editor.lisp Log Message: When adding input-editor typeout, also move down output records that only partially overlap with the typeout. This makes excessively grotesque and highly implementor-unfriendly prompts (like the one in, say, Beirc) move down as well. Remaining bugs seem to be about miscalculating the bounding rectangle of output borders. --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/02/01 00:23:36 1.35 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/02/01 16:50:31 1.36 @@ -771,7 +771,7 @@ (map-over-output-records-overlapping-region #'(lambda (record) (multiple-value-bind (record-x record-y) (output-record-position record) - (when (>= record-y y) + (when (>= (+ record-y (bounding-rectangle-height record)) y) (setf (output-record-position record) (values record-x (+ record-y delta-y)))))) (stream-output-history sheet)

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 01 Feb '08

01 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv12728/Drei Modified Files: drei-redisplay.lisp Log Message: Fix redisplay bug where NIL would be used as a number. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/30 20:43:39 1.55 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/02/01 16:30:40 1.56 @@ -486,7 +486,7 @@ of the stroke." (loop with parts = (analyse-stroke-string stroke-string) with width = 0 - with widths = (make-array 1 :adjustable t :fill-pointer t) + with widths = (make-array 1 :adjustable t :fill-pointer t :initial-element 0) with tab-width for (start end object) in parts do (cond ((eql object #\Tab)

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 01 Feb '08

01 Feb '08

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

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 01 Feb '08

01 Feb '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv17391 Modified Files: input-editing.lisp Log Message: Completions are lists, not cons cells. --- /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/01/31 19:17:57 1.63 +++ /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/02/01 10:53:54 1.64 @@ -537,8 +537,7 @@ nil) (defun possibilities-for-menu (possibilities) - (loop for p in possibilities - for (display . object) = p + (loop for (display object) in possibilities collect `(,display :value ,object))) (defun possibility-printer (possibility ptype stream) @@ -782,7 +781,7 @@ (length initial-string)) initial-len) (incf nmatches) - (push (cons str obj) possibilities)))) + (push (list str obj) possibilities)))) (funcall generator initial-string #'suggester) (if (and (eql nmatches 1) (string-equal initial-string (caar possibilities))) @@ -798,7 +797,7 @@ (action :complete) (predicate (constantly t)) (name-key #'car) - (value-key #'cadr)) + (value-key #'cadar)) (flet ((generator (input-string suggester) (declare (ignore input-string)) (do-sequence (possibility completions)

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 01 Feb '08

01 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv8775/Drei Modified Files: input-editor.lisp Log Message: Improved the implementation of with-input-editor-typeout yet again. --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/31 19:17:56 1.34 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/02/01 00:23:36 1.35 @@ -756,40 +756,68 @@ ;;; ;;; `With-input-editor-typeout' ;;; +;;; Clears some space above the input-editing stream, moving other +;;; output records on the sheet down, and prints the output. Nothing +;;; is displayed until after the with-input-editor-typeout body is +;;; done. + +(defun sheet-move-output-vertically (sheet y delta-y) + "Move the output records of `sheet', starting at vertical +device unit offset `y' or below, down by `delta-y' device units, +then repaint `sheet'." + (unless (zerop delta-y) + (with-bounding-rectangle* (sheet-x1 sheet-y1 sheet-x2 sheet-y2) sheet + (declare (ignore sheet-x1 sheet-y1)) + (map-over-output-records-overlapping-region + #'(lambda (record) + (multiple-value-bind (record-x record-y) (output-record-position record) + (when (>= record-y y) + (setf (output-record-position record) + (values record-x (+ record-y delta-y)))))) + (stream-output-history sheet) + (make-bounding-rectangle 0 y sheet-x2 sheet-y2)) + ;; Only repaint within the visible region... + (with-bounding-rectangle* (viewport-x1 viewport-y1 viewport-x2 viewport-y2) + (or (pane-viewport-region sheet) sheet) + (declare (ignore viewport-y1)) + (repaint-sheet sheet (make-bounding-rectangle viewport-x1 (- y (abs delta-y)) + viewport-x2 viewport-y2)))))) (defmethod climi::invoke-with-input-editor-typeout ((editing-stream drei-input-editing-mixin) (continuation function) &key erase) + (declare (ignore erase)) (let* ((encapsulated-stream (encapsulating-stream-stream editing-stream)) (new-typeout-record (with-output-to-output-record (encapsulated-stream) (funcall continuation encapsulated-stream))) (editor-record (drei-instance editing-stream))) (with-accessors ((stream-typeout-record typeout-record)) editing-stream (with-sheet-medium (medium encapsulated-stream) - (with-bounding-rectangle* (x1 y1 x2 y2) editor-record - ;; Clear the input-editor display. - (draw-rectangle* medium x1 y1 x2 y2 :ink +background-ink+) - (setf (output-record-position new-typeout-record) - (output-record-position (or stream-typeout-record editor-record)) - (output-record-position editor-record) - (values x1 (+ y1 (- (bounding-rectangle-height new-typeout-record) - (if stream-typeout-record - (bounding-rectangle-height stream-typeout-record) - 0))))) - (when erase - (with-bounding-rectangle* (x1 y1 x2 y2) new-typeout-record - (draw-rectangle* medium x1 y1 x2 y2 :ink +background-ink+))) - ;; Reuse the old stream-typeout-record, if any. - (cond (stream-typeout-record - ;; Blank the old one. - (with-bounding-rectangle* (x1 y1 x2 y2) stream-typeout-record - (draw-rectangle* medium x1 y1 (1+ x2) y2 :ink +background-ink+)) - (clear-output-record stream-typeout-record) - (add-output-record new-typeout-record stream-typeout-record)) - (t - (stream-add-output-record encapsulated-stream new-typeout-record) - (setf stream-typeout-record new-typeout-record))) - ;; Now, let there be light! - (replay stream-typeout-record encapsulated-stream)))))) + (setf (output-record-position new-typeout-record) + (values 0 (bounding-rectangle-min-y (or stream-typeout-record editor-record)))) + ;; Calculate the height difference between the old typeout and the new. + (let ((delta-y (- (bounding-rectangle-height new-typeout-record) + (if stream-typeout-record + (bounding-rectangle-height stream-typeout-record) + 0)))) + (multiple-value-bind (typeout-x typeout-y) + (output-record-position new-typeout-record) + (declare (ignore typeout-x)) + ;; Clear the old typeout. + (when stream-typeout-record + (clear-output-record stream-typeout-record)) + (sheet-move-output-vertically encapsulated-stream typeout-y delta-y) + ;; Reuse the old stream-typeout-record, if any. + (cond (stream-typeout-record + (add-output-record new-typeout-record stream-typeout-record)) + (t + (stream-add-output-record encapsulated-stream new-typeout-record) + (setf stream-typeout-record new-typeout-record))) + ;; Now, let there be light! + (with-bounding-rectangle* (x1 y1 x2 y2) stream-typeout-record + (declare (ignore x2)) + (repaint-sheet encapsulated-stream + (make-bounding-rectangle + x1 y1 (bounding-rectangle-width encapsulated-stream) y2))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 01 Feb '08

01 Feb '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv8334 Modified Files: dialog.lisp Log Message: Always finalize the input-editing stream used in accepting-values. --- /project/mcclim/cvsroot/mcclim/dialog.lisp 2007/07/21 13:06:45 1.28 +++ /project/mcclim/cvsroot/mcclim/dialog.lisp 2008/02/01 00:22:04 1.29 @@ -240,6 +240,8 @@ (finalize-query-records *accepting-values-stream*) (setf (last-pass *accepting-values-stream*) t) (redisplay arecord stream))) + (dolist (query (queries *accepting-values-stream*)) + (finalize (editing-stream (record query)) nil)) (erase-output-record arecord stream) (setf (stream-cursor-position stream) (values cx cy)))))))

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-cvs February 2008