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

Modified Files: drei.lisp input-editor.lisp views.lisp Log Message: WITH-INPUT-EDITING now works really well with Drei.

--- /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2008/01/30 11:48:40 1.35 +++ /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2008/01/30 21:21:43 1.36 @@ -234,8 +234,7 @@ ;;; The basic Drei class.

(defclass drei () - ((%view :initform (make-instance 'textual-drei-syntax-view) - :initarg :view + ((%view :initarg :view :accessor view :documentation "The CLIM view that will be used whenever this Drei is being displayed. During redisplay, the @@ -345,16 +344,18 @@ (cursors drei))))

(defmethod initialize-instance :after ((drei drei) &rest args &key - active single-line (editable-p t) - no-cursors) + view active single-line (editable-p t) + no-cursors initial-contents) (declare (ignore args)) - (with-accessors ((buffer buffer) - (point point) (mark mark)) (view drei) - (setf (active (view drei)) active) - (setf (single-line-p (implementation buffer)) single-line) - (setf (read-only-p buffer) (not editable-p)) - (setf (no-cursors (view drei)) no-cursors) - (add-view-cursors drei))) + (unless view ; Unless a view object has been provided... + ;; Create it with the provided initargs. + (setf (view drei) (make-instance 'textual-drei-syntax-view + :active active + :single-line single-line + :read-only (not editable-p) + :no-cursors no-cursors + :initial-contents initial-contents))) + (add-view-cursors drei))

(defmethod (setf view) :after (new-val (drei drei)) ;; Delete the old cursors, then add the new ones, provided the --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/30 15:57:35 1.27 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/30 21:21:43 1.28 @@ -53,7 +53,7 @@

(defmethod initialize-instance :after ((obj drei-input-editing-mixin) &rest args - &key stream (initial-contents "") + &key stream (cursor-visibility t) (min-width 0)) (check-type min-width (or (integer 0) (eql t))) @@ -66,9 +66,6 @@ (apply #'make-instance 'drei-area :editor-pane stream - :buffer (make-instance 'drei-buffer - :name "Input-editor buffer" - :initial-contents initial-contents) :x-position cx :y-position cy :active cursor-visibility @@ -76,8 +73,10 @@ :allow-other-keys t args))) ;; XXX Really add it here? - (stream-add-output-record stream (drei-instance obj)) - (display-drei (drei-instance obj))))) + (stream-add-output-record stream (drei-instance obj))))) + +(defmethod stream-default-view ((stream drei-input-editing-mixin)) + (view (drei-instance stream)))

(defmethod stream-insertion-pointer ((stream drei-input-editing-mixin)) @@ -155,17 +154,23 @@ ;; we can support fancy accept methods such as the one for ;; `command-or-form' (unless (stream-rescanning-p stream) - (call-next-method) + ;; Put the prompt in the proper place, but be super careful not to + ;; mess with the insertion pointer. + (let ((ip-clone (clone-mark (point (view (drei-instance stream)))))) + (unwind-protect (progn (setf (stream-insertion-pointer stream) + (stream-scan-pointer stream)) + (call-next-method)) + (setf (stream-insertion-pointer stream) (offset ip-clone))) + (redraw-input-buffer stream)) ;; We skip ahead of any noise strings to put us past the ;; prompt. This is safe, because the noise strings are to be ;; ignored anyway, but we need to be ahead to set the input ;; position properly (ie. after the prompt). - (loop - with buffer = (buffer (view (drei-instance stream))) - until (>= (stream-scan-pointer stream) (size buffer)) - while (or (typep #1=(buffer-object buffer (stream-scan-pointer stream)) 'noise-string) - (delimiter-gesture-p #1#)) - do (incf (stream-scan-pointer stream))) + (loop with buffer = (buffer (view (drei-instance stream))) + until (>= (stream-scan-pointer stream) (size buffer)) + while (or (typep #1=(buffer-object buffer (stream-scan-pointer stream)) 'noise-string) + (delimiter-gesture-p #1#)) + do (incf (stream-scan-pointer stream))) (setf (input-position stream) (stream-scan-pointer stream))))

(defmethod stream-accept :after ((stream drei-input-editing-mixin) type &key &allow-other-keys) @@ -670,6 +675,9 @@ (defmethod input-editor-format ((stream drei-input-editing-mixin) format-string &rest format-args) + "Insert a noise string at the insertion-pointer of `stream'." + ;; Since everything inserted with this method is noise strings, we + ;; do not bother to modify the scan pointer or queue rescans. (let* ((drei (drei-instance stream)) (output (apply #'format nil format-string format-args))) (when (or (stream-rescanning-p stream) @@ -679,14 +687,12 @@ ;; malfunction. Of course, the newlines inserted this way aren't ;; actually noise-strings. FIXME. (loop for (seq . rest) on (split-sequence #\Newline output) - when (plusp (length seq)) - do (insert-object (point (view drei)) (make-instance 'noise-string - :string seq)) - unless (null rest) - do (insert-object (point (view drei)) #\Newline)) - ;; Since everything inserted with this method is noise strings, we - ;; do not bother to modify the scan pointer or queue rescans. - (display-drei drei))) + when (plusp (length seq)) + do (insert-object (point (view drei)) + (make-instance 'noise-string + :string seq)) + unless (null rest) + do (insert-object (point (view drei)) #\Newline))))

(defmethod redraw-input-buffer ((stream drei-input-editing-mixin) &optional (start-position 0)) --- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/30 07:31:34 1.31 +++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/30 21:21:43 1.32 @@ -287,7 +287,9 @@ ;;; Readonly

(defclass read-only-mixin () - ((read-only-p :initform nil :accessor read-only-p))) + ((read-only-p :initform nil + :accessor read-only-p + :initarg :read-only)))

(define-condition buffer-read-only (user-condition-mixin simple-error) ((buffer :reader condition-buffer :initarg :buffer)) @@ -376,13 +378,17 @@ (:default-initargs :implementation (make-instance 'extended-standard-buffer)))

(defmethod initialize-instance :after ((buffer drei-buffer) &rest args - &key initial-contents) + &key read-only single-line + initial-contents) (declare (ignore args)) - (with-accessors ((point point)) buffer + (with-accessors ((point point) + (implementation implementation)) buffer (when initial-contents (check-type initial-contents array) (insert-buffer-sequence buffer 0 initial-contents)) - (setf point (make-buffer-mark buffer 0 :right)) + (setf point (make-buffer-mark buffer (size buffer) :right)) + (setf (read-only-p implementation) read-only + (single-line-p implementation) single-line) ;; Hack: we need to be told whenever the undo facilities in the ;; implementation buffer changes the buffer contents. (add-observer (implementation buffer) buffer))) @@ -520,7 +526,6 @@

(defclass drei-buffer-view (drei-view) ((%buffer :accessor buffer - :initform (make-instance 'drei-buffer) :initarg :buffer :type drei-buffer :accessor buffer @@ -571,11 +576,20 @@ with top and bot marks delimiting the visible region. These marks are automatically set if applicable."))

-(defmethod initialize-instance :after ((view drei-buffer-view) &rest initargs) +(defmethod initialize-instance :after ((view drei-buffer-view) &rest initargs + &key buffer single-line read-only + initial-contents) (declare (ignore initargs)) - (with-accessors ((top top) (bot bot) (buffer buffer)) view - (setf top (make-buffer-mark buffer 0 :left) - bot (make-buffer-mark buffer (size buffer) :right)))) + (with-accessors ((top top) (bot bot)) view + (unless buffer + ;; So many fun things are defined on (setf buffer) that we use + ;; slot-value here. This is just a glorified initform anyway. + (setf (slot-value view '%buffer) (make-instance 'drei-buffer + :single-line single-line + :read-only read-only + :initial-contents initial-contents))) + (setf top (make-buffer-mark (buffer view) 0 :left) + bot (make-buffer-mark (buffer view) (size (buffer view)) :right))))

(defmethod (setf top) :after (new-value (view drei-buffer-view)) (invalidate-all-strokes view))