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

Modified Files: core-commands.lisp drei-clim.lisp drei.lisp input-editor.lisp packages.lisp search-commands.lisp syntax.lisp Log Message: Go some way towards fixing the minibuffer debacle.

Drei will no longer attempt to create a minibuffer on its own pane.

Commands that need the minibuffer, when none is available, will fail somewhat gracefully.

Pointer documentation isn't broken yet, even with all the pointer-documentation-pane abuse I'm doing. I'll have to work on that.

--- /project/mcclim/cvsroot/mcclim/Drei/core-commands.lisp 2008/01/21 17:08:28 1.15 +++ /project/mcclim/cvsroot/mcclim/Drei/core-commands.lisp 2008/01/30 11:48:40 1.16 @@ -67,6 +67,7 @@ (define-command (com-zap-to-object :name t :command-table deletion-table) () "Prompt for an object and kill to the next occurence of that object after point. Characters can be entered in #\ format." + (require-minibuffer) (let* ((item (handler-case (accept 't :prompt "Zap to Object") (error () (progn (beep) (display-message "Not a valid object") @@ -81,6 +82,7 @@ FIXME: Accepts a string (that is, zero or more characters) terminated by a #\NEWLINE. If a zero length string signals an error. If a string of length >1, uses the first character of the string." + (require-minibuffer) (let* ((item-string (handler-case (accept 'string :prompt "Zap to Character") ; Figure out how to get #\d and d. (or 'string 'character)? (error () (progn (beep) (display-message "Not a valid string. ") --- /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/01/28 16:53:21 1.35 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/01/30 11:48:40 1.36 @@ -179,7 +179,8 @@ (defmethod stream-default-view ((stream drei-pane)) (view stream))

-(defmethod display-drei ((drei drei-pane)) +(defmethod display-drei ((drei drei-pane) &rest args) + (declare (ignore args)) (redisplay-frame-pane (pane-frame drei) drei))

(defmethod editor-pane ((drei drei-pane)) @@ -227,8 +228,7 @@ keyboard focus")) (:metaclass modual-class) (:default-initargs - :command-executor 'execute-drei-command - :redisplay-minibuffer t) + :command-executor 'execute-drei-command) (:documentation "An actual, instantiable Drei gadget with event-based command processing."))

@@ -285,26 +285,20 @@ (defmethod handle-gesture ((drei drei-gadget-pane) gesture) (let ((*command-processor* drei) (*abort-gestures* *esa-abort-gestures*)) - ;; It is important that the minibuffer of the Drei object is - ;; actually the minibuffer that will be used for output, or it - ;; will not be properly redisplayed by `display-drei'. (accepting-from-user (drei) - (letf (((minibuffer drei) (or (minibuffer drei) *minibuffer* - (unless (eq drei *standard-input*) - *standard-input*)))) - (handler-case (process-gesture drei gesture) - (unbound-gesture-sequence (c) - (display-message "~A is unbound" (gesture-name (gestures c)))) - (abort-gesture () - (display-message "Aborted"))) - (display-drei drei) - (when (modified-p (view drei)) - (when (gadget-value-changed-callback drei) - (value-changed-callback drei - (gadget-client drei) - (gadget-id drei) - (gadget-value drei))) - (setf (modified-p (view drei)) nil)))))) + (handler-case (process-gesture drei gesture) + (unbound-gesture-sequence (c) + (display-message "~A is unbound" (gesture-name (gestures c)))) + (abort-gesture () + (display-message "Aborted"))) + (display-drei drei :redisplay-minibuffer t) + (when (modified-p (view drei)) + (when (gadget-value-changed-callback drei) + (value-changed-callback drei + (gadget-client drei) + (gadget-id drei) + (gadget-value drei))) + (setf (modified-p (view drei)) nil)))))

;;; This is the method that functions as the entry point for all Drei ;;; gadget logic. @@ -314,8 +308,7 @@ (let ((gesture (convert-to-gesture event))) (when (proper-gesture-p gesture) (with-bound-drei-special-variables (gadget :prompt (format nil "~A " (gesture-name gesture))) - (let ((*standard-input* (or *minibuffer* *standard-input*))) - (handle-gesture gadget gesture)))))))) + (handle-gesture gadget gesture)))))))

(defmethod handle-event :before ((gadget drei-gadget-pane) (event pointer-button-press-event)) @@ -362,8 +355,7 @@ record of the Drei area instance.")) (:metaclass modual-class) (:default-initargs - :command-executor 'execute-drei-command - :redisplay-minibuffer t) + :command-executor 'execute-drei-command) (:documentation "A Drei editable area implemented as an output record."))

@@ -380,7 +372,8 @@ (defmethod esa-current-window ((drei drei-area)) (editor-pane drei))

-(defmethod display-drei ((drei drei-area)) +(defmethod display-drei ((drei drei-area) &rest args) + (declare (ignore args)) (display-drei-area drei))

;;; Implementation of the displayed-output-record and region protocol @@ -503,9 +496,8 @@ (:documentation "A constellation of a Drei gadget instance and a minibuffer."))

-(defmethod display-drei :after ((drei drei)) - (when (and *minibuffer* (not (eq *minibuffer* (editor-pane drei))) - (redisplay-minibuffer drei)) +(defmethod display-drei :after ((drei drei) &key redisplay-minibuffer) + (when (and *minibuffer* redisplay-minibuffer) ;; We need to use :force-p t to remove any existing output from ;; the pane. (redisplay-frame-pane (pane-frame *minibuffer*) *minibuffer* :force-p t))) --- /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2008/01/30 07:31:33 1.34 +++ /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2008/01/30 11:48:40 1.35 @@ -194,6 +194,7 @@ (define-command (com-drei-extended-command :command-table exclusive-gadget-table) () "Prompt for a command name and arguments, then run it." + (require-minibuffer) (let ((item (handler-case (accept `(command :command-table ,(command-table (drei-instance))) @@ -287,14 +288,6 @@ :initarg :cursors-visible :documentation "If true, the cursors of this Drei instance will be visible. If false, they will not.") - (%redisplay-minibuffer :accessor redisplay-minibuffer - :initform nil - :initarg :redisplay-minibuffer - :documentation "If true, the minibuffer -associated with this Drei instance will be redisplayed as the -last part of the Drei redisplay process. If false, it is the task -of the Drei-using application to make sure the minibuffer is -redisplayed as appropriate.") (%isearch-mode :initform nil :accessor isearch-mode) (%isearch-states :initform '() :accessor isearch-states) (%isearch-previous-string :initform nil :accessor isearch-previous-string) @@ -388,13 +381,37 @@ (format stream "~A" (type-of (view object)))))

;; Main redisplay entry point. -(defgeneric display-drei (drei) +(defgeneric display-drei (drei &key redisplay-minibuffer) (:documentation "`Drei' must be an object of type `drei' and `frame' must be a CLIM frame containing the editor pane of `drei'. If you define a new subclass of `drei', you must define a method for this generic function. In most cases, methods defined on this function will merely be a trampoline to a function -specific to the given Drei variant.")) +specific to the given Drei variant. + +If `redisplay-minibuffer' is true, also redisplay `*minibuffer*' +if it is non-NIL.")) + +(define-condition no-available-minibuffer (user-condition-mixin error) + ((%drei :reader drei + :initarg :drei + :initform (error "A drei instance must be provided") + :documentation "The Drei instance that does not have an +available minibuffer.")) + (:documentation "This error is signalled when a command wants +to use the minibuffer, but none is available.")) + +(defun no-available-minibuffer (drei-instance) + "Signal an `no-available-minibuffer' error for +`drei-instance'." + (error 'no-available-minibuffer :drei drei-instance)) + +(defun require-minibuffer (&optional (drei-instance (drei-instance))) + "Check that the provided Drei instance (defaulting to the one +currently running) has an available minibuffer. If not, signal an +error of type `no-available-minibuffer'." + (unless *minibuffer* + (no-available-minibuffer drei-instance)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -419,9 +436,6 @@ (defmethod handle-drei-condition (drei (condition motion-after-end)) (beep) (display-message "End of buffer"))

-(defmethod handle-drei-condition (drei (condition no-expression)) - (beep) (display-message "No expression around point")) - (defmethod handle-drei-condition (drei (condition no-such-operation)) (beep) (display-message "Operation unavailable for syntax"))

@@ -453,13 +467,27 @@ (handle-drei-condition (drei-instance) c)) (motion-after-end (c) (handle-drei-condition (drei-instance) c)) - (no-expression (c) - (handle-drei-condition (drei-instance) c)) (no-such-operation (c) - (handle-drei-condition (drei-instance) c)) - (buffer-read-only (c) (handle-drei-condition (drei-instance) c))))

+(defun find-available-minibuffer (drei-instance) + "Find a pane usable as the minibuffer for `drei-instance'. The +default will be to use the minibuffer specified for +`drei-instance' (if there is one), secondarily the value of +`*minibuffer*' will be used. Thirdly, the value of +`*pointer-documentation-output*' will be used. If the found panes +are not available (for example, if they are the editor-panes of +`drei-instance'), it is possible for this function to return +NIL." + (flet ((available-minibuffer-p (pane) + (and (or (typep pane 'minibuffer-pane) + (typep pane 'pointer-documentation-pane)) + (not (eq pane (editor-pane drei-instance)))))) + (find-if #'available-minibuffer-p + (list (minibuffer drei-instance) + *minibuffer* + *pointer-documentation-output*)))) + (defmacro with-bound-drei-special-variables ((drei-instance &key (kill-ring nil kill-ring-p) (minibuffer nil minibuffer-p) @@ -482,7 +510,7 @@ (*kill-ring* ,(if kill-ring-p kill-ring `(kill-ring (drei-instance)))) (*minibuffer* ,(if minibuffer-p minibuffer - `(or (minibuffer (drei-instance)) *minibuffer*))) + `(find-available-minibuffer (drei-instance)))) (*command-parser* ,(if command-parser-p command-parser ''esa-command-parser)) (*partial-command-parser* ,(if partial-command-parser-p partial-command-parser @@ -490,7 +518,8 @@ (*previous-command* ,(if previous-command-p previous-command `(previous-command (drei-instance)))) (*extended-command-prompt* ,(if prompt-p prompt - "Extended command: "))) + "Extended command: ")) + (*standard-input* (or *minibuffer* *standard-input*))) ,@body))

(defgeneric invoke-performing-drei-operations (drei continuation &key with-undo redisplay) @@ -510,7 +539,7 @@ (pane (redisplay-frame-pane *application-frame* drei)) (t - (display-drei drei)))))) + (display-drei drei :redisplay-minibuffer t))))))

(defmacro performing-drei-operations ((drei &rest args &key with-undo (redisplay t)) @@ -581,9 +610,7 @@ `(invoke-accepting-from-user ,drei #'(lambda () ,@body)))

;;; Plain `execute-frame-command' is not good enough for us. Our -;;; event-handler method uses this function to invoke commands, note -;;; that it is also responsible for updating the syntax of the buffer -;;; in the pane. +;;; event-handler method uses this function to invoke commands. (defgeneric execute-drei-command (drei-instance command) (:documentation "Execute `command' for `drei'. This is the standard function for executing Drei commands - it will take care @@ -592,9 +619,8 @@ recording the operations performed by `command' for undo."))

(defmethod execute-drei-command ((drei drei) command) - (let ((*standard-input* (or *minibuffer* *standard-input*))) - (performing-drei-operations (drei :redisplay nil - :with-undo t) - (handling-drei-conditions - (apply (command-name command) (command-arguments command))) - (setf (previous-command drei) command)))) + (performing-drei-operations (drei :redisplay nil + :with-undo t) + (handling-drei-conditions + (apply (command-name command) (command-arguments command))) + (setf (previous-command drei) command))) --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/27 09:36:07 1.25 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/30 11:48:40 1.26 @@ -73,8 +73,6 @@ :y-position cy :active cursor-visibility :max-width max-width - :minibuffer (or *minibuffer* - *pointer-documentation-output*) :allow-other-keys t args))) ;; XXX Really add it here? @@ -561,19 +559,8 @@ (let* ((drei (drei-instance stream)) (*command-processor* drei) (was-directly-processing (directly-processing-p drei)) - (minibuffer (or (minibuffer drei) *minibuffer*)) (*drei-input-editing-stream* stream)) - (with-bound-drei-special-variables (drei - ;; If the minibuffer is the - ;; stream we are encapsulating - ;; for the - ;; input-editing-stream, we - ;; don't want to use it as a - ;; minibuffer. - :minibuffer (if (eq minibuffer *standard-input*) - *pointer-documentation-output* - minibuffer) - :prompt "M-x ") + (with-bound-drei-special-variables (drei :prompt "M-x ") (update-drei-buffer stream) ;; Commands are permitted to signal immediate rescans, but ;; we may need to do some stuff first. @@ -589,14 +576,13 @@ (abort-gesture (c) (if (member (abort-gesture-event c) *abort-gestures* - :test #'event-matches-gesture-name-p) + :test #'event-matches-gesture-name-p) (signal 'abort-gesture :event (abort-gesture-event c)) (when was-directly-processing (display-message "Aborted"))))))) (update-drei-buffer stream)) (let ((first-mismatch (prefix-size (view drei)))) - ;; Will also take care of redisplaying minibuffer. - (display-drei drei) + (display-drei drei :redisplay-minibuffer t) (cond ((null first-mismatch) ;; No change actually took place, even though IP may ;; have moved. @@ -873,7 +859,7 @@ ;; and signal a rescan. (setf (activation-gesture stream) nil) (handle-drei-condition drei e) - (display-drei drei) + (display-drei drei :redisplay-minibuffer t) (immediate-rescan stream)))) (ptype (presentation-type-of object))) (return-from control-loop --- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/30 07:31:33 1.48 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/30 11:48:40 1.49 @@ -167,7 +167,7 @@ #:parse-stack-top #:target-parse-tree #:parse-state-empty-p #:parse-stack-next #:parse-stack-symbol #:parse-stack-parse-trees #:map-over-parse-trees - #:no-such-operation #:no-expression + #:no-such-operation #:name-for-info-pane #:display-syntax-name #:syntax-line-indentation @@ -213,6 +213,7 @@ #:user-condition-mixin #:buffer-read-only #:buffer-single-line + #:no-available-minibuffer

;; Views and their facilities. #:drei-view #:modified-p #:no-cursors @@ -289,6 +290,7 @@ #:performing-drei-operations #:invoke-performing-drei-operations #:with-bound-drei-special-variables #:accepting-from-user #:invoke-accepting-from-user + #:require-minibuffer

;; Gadget interface stuff. #:handle-gesture --- /project/mcclim/cvsroot/mcclim/Drei/search-commands.lisp 2008/01/26 12:37:25 1.7 +++ /project/mcclim/cvsroot/mcclim/Drei/search-commands.lisp 2008/01/30 11:48:40 1.8 @@ -309,6 +309,7 @@ (define-command (com-replace-string :name t :command-table search-table) () "Replace all occurrences of `string' with `newstring'." + (require-minibuffer) ;; We have to do it this way if we want to refer to STRING in NEWSTRING (let* ((string (accept 'string :prompt "Replace String")) (newstring (accept'string :prompt (format nil "Replace ~A with" string)))) @@ -343,6 +344,7 @@ t))))

(define-command (com-query-replace :name t :command-table search-table) () + (require-minibuffer) (let* ((drei (drei-instance)) (old-state (query-replace-state drei)) (old-string1 (when old-state (string1 old-state))) @@ -493,6 +495,7 @@ do (princ char result))))

(define-command (com-regex-search-forward :name t :command-table search-table) () + (require-minibuffer) (let ((string (accept 'string :prompt "RE search" :delimiter-gestures nil :activation-gestures @@ -502,6 +505,7 @@ (re-search-forward mark (normalise-minibuffer-regex string))))))

(define-command (com-regex-search-backward :name t :command-table search-table) () + (require-minibuffer) (let ((string (accept 'string :prompt "RE search backward" :delimiter-gestures nil :activation-gestures --- /project/mcclim/cvsroot/mcclim/Drei/syntax.lisp 2008/01/29 19:13:06 1.16 +++ /project/mcclim/cvsroot/mcclim/Drei/syntax.lisp 2008/01/30 11:48:40 1.17 @@ -73,14 +73,6 @@ (:documentation "This condition is signaled whenever an attempt is made to execute an operation that is unavailable for the particular syntax" ))

-(define-condition no-expression (simple-error) - () - (:report (lambda (condition stream) - (declare (ignore condition)) - (format stream "No expression at point"))) - (:documentation "This condition is signaled whenever an attempt is -made to execute a by-experssion motion command and no expression is available." )) - (defgeneric update-syntax (syntax unchanged-prefix unchanged-suffix &optional begin end) (:documentation "Inform the syntax module that it must update