[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Wed Jan 30 11:48:40 UTC 2008
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*)))
, at 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 () , at 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
More information about the Mcclim-cvs
mailing list