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