mcclim-cvs

mcclim-cvs@common-lisp.net

1697 discussions

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

03 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv26552/Drei Modified Files: basic-commands.lisp drei.lisp Log Message: Changed how self-insert gestures work in Drei a bit. --- /project/mcclim/cvsroot/mcclim/Drei/basic-commands.lisp 2008/01/18 11:00:22 1.11 +++ /project/mcclim/cvsroot/mcclim/Drei/basic-commands.lisp 2008/02/03 08:38:25 1.12 @@ -511,14 +511,20 @@ ;;; These are what do the basic keypress->character inserted in buffer ;;; mapping. -(define-command com-self-insert ((count 'integer :default 1)) - (loop repeat count do (insert-character *current-gesture*))) +(define-command com-self-insert + ((count 'integer :default 1)) + "Insert the gesture used to invoke this command into the +current buffer `count' times. `Count' should get its value from +the numeric arguments." + (loop repeat count + do (insert-character *current-gesture*))) -(loop for code from (char-code #\Space) to (char-code #\~) - do (set-key `(com-self-insert ,*numeric-argument-marker*) - 'self-insert-table - (list (list (code-char code))))) +(defmethod command-for-unbound-gestures ((view textual-drei-syntax-view) gestures) + (when (and (= (length gestures)) + (characterp (first gestures)) + (graphic-char-p (first gestures))) + `(com-self-insert ,*numeric-argument-marker*))) (set-key `(com-self-insert ,*numeric-argument-marker*) - 'self-insert-table + 'self-insert-table '((#\Newline))) --- /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2008/01/30 21:21:43 1.36 +++ /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2008/02/03 08:38:25 1.37 @@ -381,6 +381,9 @@ (print-unreadable-object (object stream :type t :identity t) (format stream "~A" (type-of (view object))))) +(defmethod command-for-unbound-gestures ((drei drei) gestures) + (command-for-unbound-gestures (view drei) gestures)) + ;; Main redisplay entry point. (defgeneric display-drei (drei &key redisplay-minibuffer) (:documentation "`Drei' must be an object of type `drei' and

1 0

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

03 Feb '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv20204 Modified Files: input-editing.lisp Log Message: Fix minor bug in complete-from-possibilities. --- /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/02/02 19:03:16 1.67 +++ /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/02/03 08:06:31 1.68 @@ -886,7 +886,7 @@ (action :complete) (predicate (constantly t)) (name-key #'car) - (value-key #'cadar)) + (value-key #'second)) (flet ((generator (input-string suggester) (declare (ignore input-string)) (do-sequence (possibility completions)

1 0

[mcclim-cvs] CVS mcclim/Drei
by dmurray 03 Feb '08

03 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv11501/Drei Modified Files: views.lisp drei-redisplay.lisp core-commands.lisp Log Message: Slightly more general tab-stops. May break the tabify abstraction - which I don't understand - but doesn't seem to break the code. --- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/31 08:34:15 1.33 +++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/02/03 07:16:48 1.34 @@ -60,7 +60,12 @@ :initform nil) (%use-tabs :accessor use-tabs :initform *use-tabs-for-indentation* - :initarg :use-tabs))) + :initarg :use-tabs) + (%tab-stops :accessor tab-stops + :initform '() + :initarg :tab-stops + :documentation "A list of tab-stops in device units. +If empty, tabs every TAB-WIDTH are assumed."))) (defun maybe-update-recordings (stream tabify) (with-accessors ((space-width recorded-space-width) @@ -87,7 +92,28 @@ (* (tab-space-count tabify) (space-width stream tabify)) (recorded-tab-width tabify)))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defgeneric next-tab-stop (stream tabify x) + (:documentation "Return the distance to the next tab-stop after `x' +on `stream' in device units (most likely pixels).") + (:method ((stream extended-output-stream) (tabify tabify-mixin) x) + (flet ((round-up (x width) + (- width (mod x width)))) + (if (tab-stops tabify) + (let ((next (find-if (lambda (pos) (> pos x)) (tab-stops tabify)))) + (or (and next (- next x)) (round-up x (space-width stream tabify)))) + (round-up x (tab-width stream tabify)))))) + +(defgeneric (setf tab-stop-columns) (column-list tabify) + (:documentation "Set the TAB-STOPS of view at the character column offsets +in `column-list'.") + (:method (column-list (tabify tabify-mixin)) + (setf (tab-stops tabify) + (and column-list + (sort (mapcar (lambda (col) (* col (space-width (recorded-stream tabify) tabify))) + column-list) + #'<))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Undo --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/02/02 19:03:26 1.58 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/02/03 07:16:49 1.59 @@ -487,13 +487,11 @@ (loop with parts = (analyse-stroke-string stroke-string) with width = 0 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) - (incf width - (- (or tab-width - (setf tab-width (tab-width stream (stream-default-view stream)))) - (mod (+ width x-position) tab-width))) + (incf width + (next-tab-stop stream (stream-default-view stream) + (+ width x-position))) (vector-push-extend width widths)) (object (multiple-value-bind (w) --- /project/mcclim/cvsroot/mcclim/Drei/core-commands.lisp 2008/01/30 11:48:40 1.16 +++ /project/mcclim/cvsroot/mcclim/Drei/core-commands.lisp 2008/02/03 07:16:49 1.17 @@ -222,6 +222,12 @@ (untabify-region (mark) (point) (tab-space-count (current-view)))) +(define-command (com-set-tab-stops :name t :command-table editing-table) + ((tab-stops '(sequence (integer 0)) :prompt "List of tab stops")) + "Accept a list of tab positions (in columns) for the view." + (setf (drei::tab-stop-columns (current-view)) + tab-stops)) + (define-command (com-indent-line :name t :command-table indent-table) () (indent-current-line (current-view) (point)))

1 0

[mcclim-cvs] CVS mcclim/ESA
by thenriksen 02 Feb '08

02 Feb '08

Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv27482/ESA Modified Files: packages.lisp Log Message: Fixed ambiguous symbol import in ESA-UTILS on CLISP. --- /project/mcclim/cvsroot/mcclim/ESA/packages.lisp 2008/01/29 22:59:30 1.15 +++ /project/mcclim/cvsroot/mcclim/ESA/packages.lisp 2008/02/02 19:03:35 1.16 @@ -24,6 +24,7 @@ (defpackage :esa-utils (:use :clim-lisp :clim-mop :clim) + (:shadowing-import-from :clim-lisp #:describe-object) (:export #:with-gensyms #:once-only #:unlisted

1 0

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

02 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv27440/Drei Modified Files: drei-clim.lisp drei-redisplay.lisp Log Message: Implement "cursors are children of their Drei instance (if applicable)"-policy. --- /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/02/01 17:10:53 1.40 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/02/02 19:03:26 1.41 @@ -56,11 +56,12 @@ ;;; of what CLIM already provides. That seemed a bit (=a lot) hairy, ;;; though. -;;; Cursors are output records. When a cursor is created, it adds -;;; itself to its output stream. The owner of the cursor (a Drei -;;; instance) is responsible for removing the cursor once it is done -;;; with it. Cursors can be active/inactive and enabled/disabled and -;;; have the same activity-status as their associated view. +;;; Cursors are output records. After a cursor is created, The owning +;;; Drei instance instnace should add it to the output stream. The +;;; owner of the cursor (a Drei instance) is responsible for removing +;;; the cursor once it is done with it. Cursors can be active/inactive +;;; and enabled/disabled and have the same activity-status as their +;;; associated view. (defclass drei-cursor (standard-sequence-output-record) ((%view :reader view :initarg :view @@ -96,10 +97,6 @@ Drei buffer. The most important role for instances of subclasses of this class is to visually represent the position of point.")) -(defmethod initialize-instance :after ((object drei-cursor) &rest initargs) - (declare (ignore initargs)) - (stream-add-output-record (output-stream object) object)) - (defgeneric active (cursor) (:documentation "Whether the cursor is active or not. An active cursor is drawn using the active ink, and an @@ -204,6 +201,14 @@ (defmethod (setf view) :after (new-val (drei drei-pane)) (window-clear drei)) +(defmethod (setf cursors) :around (new-cursors (drei drei-pane)) + (let ((old-cursors (cursors drei))) + (call-next-method) + (dolist (old-cursor old-cursors) + (erase-output-record old-cursor drei nil)) + (dolist (new-cursor new-cursors) + (stream-add-output-record drei new-cursor)))) + (defmethod note-sheet-grafted :after ((pane drei-pane)) (setf (stream-default-view pane) (view pane))) @@ -374,6 +379,10 @@ (defmethod (setf view) :after ((new-view drei-view) (drei drei-area)) (setf (extend-pane-bottom new-view) t)) +(defmethod (setf cursors) :after (new-cursors (drei drei-area)) + (dolist (new-cursor (cursors drei)) + (setf (output-record-parent new-cursor) drei))) + (defmethod esa-current-window ((drei drei-area)) (editor-pane drei)) @@ -415,24 +424,28 @@ +foreground-ink+) (defmethod output-record-children ((record drei-area)) - '()) + (cursors record)) (defmethod output-record-count ((record drei-area)) - 0) + (length (cursors record))) (defmethod map-over-output-records-containing-position (function (record drei-area) x y &optional (x-offset 0) (y-offset 0) &rest function-args) - (declare (ignore function x y x-offset y-offset function-args)) - nil) + (declare (ignore x-offset y-offset)) + (dolist (cursor (cursors record)) + (when (region-contains-position-p cursor x y) + (apply function cursor function-args)))) (defmethod map-over-output-records-overlapping-region (function (record drei-area) region &optional (x-offset 0) (y-offset 0) &rest function-args) - (declare (ignore function region x-offset y-offset function-args)) - nil) + (declare (ignore x-offset y-offset)) + (dolist (cursor (cursors record)) + (when (region-intersects-region-p cursor region) + (apply function cursor function-args)))) (defmethod bounding-rectangle* ((drei drei-area)) (with-accessors ((pane editor-pane) @@ -457,6 +470,16 @@ (t 0))) (max y2 (+ y1 height))))))) +(defmethod replay-output-record :after ((drei drei-area) (stream extended-output-stream) + &optional (x-offset 0) (y-offset 0) (region +everywhere+)) + (declare (ignore x-offset y-offset region)) + (dolist (cursor (cursors drei)) + (replay cursor stream))) + +(defmethod recompute-extent-for-changed-child ((drei drei-area) (child output-record) + old-min-x old-min-y old-max-x old-max-y) + nil) + (defmethod rectangle-edges* ((rectangle drei-area)) (bounding-rectangle* rectangle)) --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/02/01 22:28:15 1.57 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/02/02 19:03:26 1.58 @@ -930,18 +930,18 @@ (change-space-requirements pane :width (max (bounding-rectangle-max-x cursor) (bounding-rectangle-max-x pane)) - :width (max (if (extend-pane-bottom view) - (bounding-rectangle-max-y cursor) - 0) - (bounding-rectangle-max-y pane))) + :height (max (if (extend-pane-bottom view) + (bounding-rectangle-max-y cursor) + 0) + (bounding-rectangle-max-y pane))) ;; And draw the cursor again. (call-next-method))) (defmethod display-drei-view-cursor :around ((stream extended-output-stream) (view drei-buffer-view) (cursor drei-cursor)) + (clear-output-record cursor) (when (visible-p cursor) - (clear-output-record cursor) (prog1 (call-next-method) (with-bounding-rectangle* (x1 y1 x2 y2) cursor (do-displayed-lines (line view) @@ -1011,13 +1011,6 @@ ;;; ;;; Drei area redisplay. -(defmethod erase-output-record :after ((drei drei-area) (stream extended-output-stream) - &optional (errorp nil errorp-supplied)) - (dolist (cursor (cursors drei)) - (apply #'erase-output-record cursor stream - (when errorp-supplied - (list errorp))))) - ;; XXX: Full redraw for every replay, should probably use the `region' ;; parameter to only invalidate some strokes. (defmethod replay-output-record ((drei drei-area) (stream extended-output-stream) &optional @@ -1025,14 +1018,11 @@ (declare (ignore x-offset y-offset region)) (letf (((stream-cursor-position stream) (output-record-start-cursor-position drei))) (invalidate-all-strokes (view drei)) - (display-drei-view-contents stream (view drei))) - (dolist (cursor (cursors drei)) - (replay cursor stream))) + (display-drei-view-contents stream (view drei)))) (defmethod replay-output-record ((cursor drei-cursor) stream &optional (x-offset 0) (y-offset 0) (region +everywhere+)) (declare (ignore x-offset y-offset region)) - (clear-output-record cursor) (with-output-recording-options (stream :record t :draw t) (display-drei-view-cursor stream (view cursor) cursor)))

1 0

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

02 Feb '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv27411 Modified Files: input-editing.lisp Log Message: Redraw the input buffer after displaying typeout, causes scrolling and stuff if necessary. --- /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/02/01 20:28:46 1.66 +++ /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/02/02 19:03:16 1.67 @@ -726,6 +726,7 @@ nmatches mode)) (when (and (> nmatches 0) (eq mode :possibilities)) (print-possibilities possibilities possibility-printer stream) + (redraw-input-buffer stream) (let ((possibility (handler-case (with-input-context (`(completion ,possibilities) :override nil)

1 0

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

02 Feb '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv27372 Modified Files: recording.lisp Log Message: Output recording bandaids: Use CLIM 2.2 region default for replay. Don't assume every parent output record is a compound-output-record. --- /project/mcclim/cvsroot/mcclim/recording.lisp 2008/01/21 22:24:32 1.137 +++ /project/mcclim/cvsroot/mcclim/recording.lisp 2008/02/02 19:03:00 1.138 @@ -401,7 +401,8 @@ (with-bounding-rectangle* (min-x min-y max-x max-y) record (call-next-method) (let ((parent (output-record-parent record))) - (when (and parent (not (slot-value parent 'in-moving-p))) + (when (and parent (not (and (typep parent 'compound-output-record) + (slot-value parent 'in-moving-p)))) ; XXX (recompute-extent-for-changed-child parent record min-x min-y max-x max-y)))) (values nx ny)) @@ -461,7 +462,8 @@ (gs-ink-mixin gs-clip-mixin gs-line-style-mixin gs-text-style-mixin) ()) -(defun replay (record stream &optional region) +(defun replay (record stream &optional (region (or (pane-viewport-region stream) + (sheet-region stream)))) (if (typep stream 'encapsulating-stream) (replay record (encapsulating-stream-stream stream) region) (progn

1 0

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

02 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv27256/Drei Modified Files: input-editor.lisp Log Message: Fixed copy/pasting of text containing spaces in Drei. --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/02/01 20:28:45 1.37 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/02/02 19:02:03 1.38 @@ -483,62 +483,59 @@ (activation-gesture activation-gesture)) stream (let ((buffer (buffer (view (drei-instance stream)))) (last-was-noisy nil)) ; T if last passed gesture is noise-string - (loop - (loop - while (< scan-pointer insertion-pointer) - while (< scan-pointer (size buffer)) - do (let ((gesture (buffer-object buffer scan-pointer))) - ;; Skip noise strings. - (cond ((typep gesture 'noise-string) - (incf scan-pointer) - (setf last-was-noisy t)) - ((and (not peek-p) - (typep gesture 'accept-result)) - (incf scan-pointer) - #+(or mcclim building-mcclim) - (climi::throw-object-ptype (object gesture) - (result-type gesture))) - ;; Note that this implies that - ;; `stream-read-gesture' may return accept - ;; results, which might as well be arbitrary - ;; objects to the code calling - ;; `stream-read-gesture', since it can't really - ;; do anything with them except for asserting - ;; that they exist. According to the spec, - ;; "accept results are treated as a single - ;; gesture", and this kind of behavior is - ;; necessary to make sure `stream-read-gesture' - ;; doesn't simply claim that there are no more - ;; gestures in the input-buffer when the - ;; remaining gesture(s) is an accept result. - ((typep gesture 'accept-result) - (return-from stream-read-gesture gesture)) - (t - (unless peek-p - (incf scan-pointer)) - (return-from stream-read-gesture gesture)) - (t (incf scan-pointer) - (setf last-was-noisy nil))))) - (unless last-was-noisy ; This prevents double-prompting. - (setf (stream-rescanning stream) nil)) - (when activation-gesture - (return-from stream-read-gesture - (prog1 activation-gesture - (unless peek-p - (setf activation-gesture nil))))) - ;; In McCLIM, stream-process-gesture is responsible for - ;; inserting characters into the buffer, changing the - ;; insertion pointer and possibly setting up the - ;; activation-gesture slot. - (loop - with gesture and type - do (setf (values gesture type) - (apply #'stream-read-gesture - (encapsulating-stream-stream stream) rest-args)) - when (null gesture) - do (return-from stream-read-gesture (values gesture type)) - when (stream-process-gesture stream gesture type) - do (loop-finish))))))) + (loop (loop while (< scan-pointer insertion-pointer) + while (< scan-pointer (size buffer)) + do (let ((gesture (buffer-object buffer scan-pointer))) + ;; Skip noise strings. + (cond ((typep gesture 'noise-string) + (incf scan-pointer) + (setf last-was-noisy t)) + ((and (not peek-p) + (typep gesture 'accept-result)) + (incf scan-pointer) + #+(or mcclim building-mcclim) + (climi::throw-object-ptype (object gesture) + (result-type gesture))) + ;; Note that this implies that + ;; `stream-read-gesture' may return accept + ;; results, which might as well be arbitrary + ;; objects to the code calling + ;; `stream-read-gesture', since it can't really + ;; do anything with them except for asserting + ;; that they exist. According to the spec, + ;; "accept results are treated as a single + ;; gesture", and this kind of behavior is + ;; necessary to make sure `stream-read-gesture' + ;; doesn't simply claim that there are no more + ;; gestures in the input-buffer when the + ;; remaining gesture(s) is an accept result. + ((typep gesture 'accept-result) + (return-from stream-read-gesture gesture)) + (t + (unless peek-p + (incf scan-pointer)) + (return-from stream-read-gesture gesture)) + (t (incf scan-pointer) + (setf last-was-noisy nil))))) + (unless last-was-noisy ; This prevents double-prompting. + (setf (stream-rescanning stream) nil)) + (when activation-gesture + (return-from stream-read-gesture + (prog1 activation-gesture + (unless peek-p + (setf activation-gesture nil))))) + ;; In McCLIM, stream-process-gesture is responsible for + ;; inserting characters into the buffer, changing the + ;; insertion pointer and possibly setting up the + ;; activation-gesture slot. + (loop with gesture and type + do (setf (values gesture type) + (apply #'stream-read-gesture + (encapsulating-stream-stream stream) rest-args)) + when (null gesture) + do (return-from stream-read-gesture (values gesture type)) + when (stream-process-gesture stream gesture type) + do (loop-finish))))))) (defmethod stream-unread-gesture ((stream drei-input-editing-mixin) gesture)

1 0

[mcclim-cvs] CVS mcclim/ESA
by thenriksen 02 Feb '08

02 Feb '08

Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv27256/ESA Modified Files: esa-command-parser.lisp Log Message: Fixed copy/pasting of text containing spaces in Drei. --- /project/mcclim/cvsroot/mcclim/ESA/esa-command-parser.lisp 2008/01/04 21:56:29 1.4 +++ /project/mcclim/cvsroot/mcclim/ESA/esa-command-parser.lisp 2008/02/02 19:02:05 1.5 @@ -111,7 +111,7 @@ (keyword-args (climi::keyword-args info))) ;; keyword arguments not yet supported (declare (ignore keyword-args)) - (let (result) + (let (result arg-parsed) ;; only required args for now. (do* ((required-args required-args (cdr required-args)) (arg (car required-args) (car required-args)) @@ -120,9 +120,11 @@ ((null required-args) (cons command-name (nreverse result))) (destructuring-bind (name ptype &rest args) arg (push (cond ((eq command-arg *unsupplied-argument-marker*) + (setf arg-parsed t) (esa-parse-one-arg stream name ptype args)) ((eq command-arg *numeric-argument-marker*) (or numeric-argument (getf args :default))) (t (eval command-arg))) result) - (maybe-clear-input))))))))))) + (when arg-parsed + (maybe-clear-input))))))))))))

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-serv20235 Modified Files: commands.lisp Log Message: Fix typo, with-bounding-rectangle -> with-bounding-rectangle*. --- /project/mcclim/cvsroot/mcclim/commands.lisp 2008/02/01 20:28:46 1.76 +++ /project/mcclim/cvsroot/mcclim/commands.lisp 2008/02/02 00:10:18 1.77 @@ -1233,7 +1233,7 @@ *command-parser-table*)))) (if (encapsulating-stream-p stream) (let ((interactor (encapsulating-stream-stream stream))) - (with-bounding-rectangle (x1 y1 x2 y2) (input-editing-stream-output-record stream) + (with-bounding-rectangle* (x1 y1 x2 y2) (input-editing-stream-output-record stream) (declare (ignore y1 x2)) ;; Start the dialog below the editor area (letf (((stream-cursor-position interactor) (values x1 y2)))

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-cvs