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

Modified Files: core-commands.lisp drei.lisp input-editor.lisp lisp-syntax-commands.lisp modes.lisp packages.lisp search-commands.lisp targets.lisp Log Message: Changed *drei-instance* to be a function (drei-instance).

Change of active window in Climacs will work better now.

--- /project/mcclim/cvsroot/mcclim/Drei/core-commands.lisp 2007/12/27 13:39:25 1.12 +++ /project/mcclim/cvsroot/mcclim/Drei/core-commands.lisp 2008/01/17 11:29:55 1.13 @@ -39,7 +39,7 @@ will replace the object after the point. When overwrite is off (the default), objects are inserted at point. In both cases point is positioned after the new object." - (with-slots (overwrite-mode) *drei-instance* + (with-slots (overwrite-mode) (current-view) (setf overwrite-mode (not overwrite-mode))))

(set-key 'com-overwrite-mode @@ -212,13 +212,13 @@ "Replace runs of spaces with tabs in region where possible. Uses TAB-SPACE-COUNT of the STREAM-DEFAULT-VIEW of the pane." (tabify-region (mark) (point) - (tab-space-count (view *drei-instance*)))) + (tab-space-count (current-view))))

(define-command (com-untabify-region :name t :command-table editing-table) () "Replace tabs with equivalent runs of spaces in the region. Uses TAB-SPACE-COUNT of the STREAM-DEFAULT-VIEW of the pane." (untabify-region (mark) (point) - (tab-space-count (view *drei-instance*)))) + (tab-space-count (current-view))))

(define-command (com-indent-line :name t :command-table indent-table) () (indent-current-line (current-view) (point))) @@ -531,7 +531,7 @@ inserting each in turn at point as an expansion." (with-accessors ((original-prefix original-prefix) (prefix-start-offset prefix-start-offset) - (dabbrev-expansion-mark dabbrev-expansion-mark)) *drei-instance* + (dabbrev-expansion-mark dabbrev-expansion-mark)) (current-view) (flet ((move () (cond ((beginning-of-buffer-p dabbrev-expansion-mark) (setf (offset dabbrev-expansion-mark) (offset (point))) @@ -620,8 +620,8 @@

(define-command (com-visible-region :name t :command-table marking-table) () "Toggle the visibility of the region in the current pane." - (setf (region-visible-p *drei-instance*) - (not (region-visible-p *drei-instance*)))) + (setf (region-visible-p (current-view)) + (not (region-visible-p (current-view)))))

(define-command (com-move-past-close-and-reindent :name t :command-table editing-table) () --- /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2008/01/16 21:30:04 1.27 +++ /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2008/01/17 11:29:55 1.28 @@ -63,16 +63,26 @@ ;;; ;;; Convenience stuff.

-(defvar *drei-instance* nil - "The currently running Drei instance.") +(defgeneric drei-instance-of (object) + (:documentation "Return the Drei instance of `object'. For an +editor frame, this would be the active editor instance. If +`object' itself is a Drei instance, this function should just +return `object'.")) + +(defun drei-instance (&optional (object *esa-instance*)) + "Return the currently running Drei instance. This function +calls `drei-instance-of' on its argument." + (drei-instance-of object))

-(defun current-view (&optional (object *drei-instance*)) +(defun (setf drei-instance) (new-instance &optional (object *esa-instance*)) + (setf (drei-instance-of object) new-instance)) + +(defun current-view (&optional (object (drei-instance))) "Return the view of the provided object. If no object is -provided, the currently running Drei instance (`*drei-instance*') -will be used." +provided, the currently running Drei instance will be used." (view object))

-(defun (setf current-view) (new-view &optional (object *drei-instance*)) +(defun (setf current-view) (new-view &optional (object (drei-instance))) (setf (view object) new-view))

(defun point (&optional (object (current-view))) @@ -183,14 +193,14 @@ "Prompt for a command name and arguments, then run it." (let ((item (handler-case (accept - `(command :command-table ,(command-table *drei-instance*)) + `(command :command-table ,(command-table (drei-instance))) ;; this gets erased immediately anyway :prompt "" :prompt-mode :raw) ((or command-not-accessible command-not-present) () (beep) (display-message "No such command") (return-from com-drei-extended-command nil))))) - (execute-drei-command *drei-instance* item))) + (execute-drei-command (drei-instance) item)))

(set-key 'com-drei-extended-command 'exclusive-gadget-table @@ -207,11 +217,11 @@ "This method allows users of Drei to extend syntaxes with new, app-specific commands, as long as they inherit from a Drei class and specialise a method for it." - (additional-command-tables *drei-instance* command-table)) + (additional-command-tables (drei-instance) command-table))

(defmethod command-table-inherit-from ((table drei-command-table)) (append (view-command-tables (current-view)) - (additional-command-tables *drei-instance* table) + (additional-command-tables (drei-instance) table) (when (use-editor-commands-p (current-view)) '(editor-table))))

@@ -343,6 +353,9 @@ (defmethod esa-current-window ((drei drei)) drei)

+(defmethod drei-instance-of ((object drei)) + object) + (defmethod print-object ((object drei) stream) (print-unreadable-object (object stream :type t :identity t) (format stream "~A" (type-of (view object))))) @@ -404,21 +417,21 @@ ;; at, for example, the buffer level, after all. `(handler-case (progn ,@body) (user-condition-mixin (c) - (handle-drei-condition *drei-instance* c)) + (handle-drei-condition (drei-instance) c)) (offset-before-beginning (c) - (handle-drei-condition *drei-instance* c)) + (handle-drei-condition (drei-instance) c)) (offset-after-end (c) - (handle-drei-condition *drei-instance* c)) + (handle-drei-condition (drei-instance) c)) (motion-before-beginning (c) - (handle-drei-condition *drei-instance* c)) + (handle-drei-condition (drei-instance) c)) (motion-after-end (c) - (handle-drei-condition *drei-instance* c)) + (handle-drei-condition (drei-instance) c)) (no-expression (c) - (handle-drei-condition *drei-instance* c)) + (handle-drei-condition (drei-instance) c)) (no-such-operation (c) - (handle-drei-condition *drei-instance* c)) + (handle-drei-condition (drei-instance) c)) (buffer-read-only (c) - (handle-drei-condition *drei-instance* c)))) + (handle-drei-condition (drei-instance) c))))

(defmacro with-bound-drei-special-variables ((drei-instance &key (kill-ring nil kill-ring-p) @@ -429,7 +442,7 @@ (prompt nil prompt-p)) &body body) "Evaluate `body' with a set of Drei special -variables (`*drei-instance*', `*kill-ring*', `*minibuffer*', +variables (`(drei-instance)', `*kill-ring*', `*minibuffer*', `*command-parser*', `*partial-command-parser*', `*previous-command*', `*extended-command-prompt*') bound to their proper values, taken from `drei-instance'. The keyword arguments @@ -438,18 +451,17 @@ value in `drei-instance'. This macro binds all of the usual Drei special variables, but also some CLIM special variables needed for ESA-style command parsing." - `(let* ((*drei-instance* ,drei-instance) - (*esa-instance* *drei-instance*) + `(let* ((*esa-instance* ,drei-instance) (*kill-ring* ,(if kill-ring-p kill-ring - `(kill-ring *drei-instance*))) + `(kill-ring (drei-instance)))) (*minibuffer* ,(if minibuffer-p minibuffer - `(or (minibuffer *drei-instance*) *minibuffer*))) + `(or (minibuffer (drei-instance)) *minibuffer*))) (*command-parser* ,(if command-parser-p command-parser ''esa-command-parser)) (*partial-command-parser* ,(if partial-command-parser-p partial-command-parser ''esa-partial-command-parser)) (*previous-command* ,(if previous-command-p previous-command - `(previous-command *drei-instance*))) + `(previous-command (drei-instance)))) (*extended-command-prompt* ,(if prompt-p prompt "Extended command: "))) ,@body)) --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2007/12/13 07:57:15 1.21 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/17 11:29:55 1.22 @@ -33,7 +33,7 @@ ;; `drei-input-editing-mixin' class does not have a scan pointer. We ;; assume that the subclass defines a scan pointer. (defclass drei-input-editing-mixin () - ((%drei-instance :accessor drei-instance + ((%drei-instance :accessor drei-instance-of :initarg :drei-instance) (%input-position :accessor input-position :initform 0) --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-commands.lisp 2008/01/14 09:14:48 1.15 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-commands.lisp 2008/01/17 11:29:55 1.16 @@ -65,7 +65,7 @@ #'(lambda (mark) (proper-line-indentation (current-view) mark)) fill-column - (tab-space-count (view *drei-instance*)) + (tab-space-count (current-view)) (current-syntax) t)))))

--- /project/mcclim/cvsroot/mcclim/Drei/modes.lisp 2007/12/28 10:08:33 1.1 +++ /project/mcclim/cvsroot/mcclim/Drei/modes.lisp 2008/01/17 11:29:55 1.2 @@ -137,6 +137,6 @@ `(define-command (,command-name :name ,name :command-table ,command-table) () ,(concatenate 'string "Toggle " string-form " mode.") - (if (mode-enabled-p *drei-instance* ',mode-name) - (disable-mode *drei-instance* ',mode-name) - (enable-mode *drei-instance* ',mode-name)))) + (if (mode-enabled-p (drei-instance) ',mode-name) + (disable-mode (drei-instance) ',mode-name) + (enable-mode (drei-instance) ',mode-name)))) --- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/13 22:22:05 1.41 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/17 11:29:55 1.42 @@ -302,9 +302,7 @@ #:mark #:mark-of #:current-syntax #:current-view - - ;; Info variables. - #:*drei-instance* + #:drei-instance #:drei-instance-of

;; Configuration. #:*foreground-color* --- /project/mcclim/cvsroot/mcclim/Drei/search-commands.lisp 2007/12/08 08:53:49 1.5 +++ /project/mcclim/cvsroot/mcclim/Drei/search-commands.lisp 2008/01/17 11:29:55 1.6 @@ -61,7 +61,7 @@ ((string 'string :prompt "String Search")) "Prompt for a string and search forward for it. If found, leaves point after string. If not, leaves point where it is." - (simple-search-forward *drei-instance* + (simple-search-forward (drei-instance) #'(lambda (mark) (search-forward mark string :test (case-relevant-test string))))) @@ -70,7 +70,7 @@ ((string 'string :prompt "Reverse String Search")) "Prompt for a string and search backward for it. If found, leaves point before string. If not, leaves point where it is." - (simple-search-backward *drei-instance* + (simple-search-backward (drei-instance) #'(lambda (mark) (search-backward mark string :test (case-relevant-test string))))) @@ -83,7 +83,7 @@ ((word 'string :prompt "Search word")) "Prompt for a whitespace delimited word and search forward for it. If found, leaves point after the word. If not, leaves point where it is." - (simple-search-forward *drei-instance* + (simple-search-forward (drei-instance) #'(lambda (mark) (search-word-forward mark word))))

@@ -91,7 +91,7 @@ ((word 'string :prompt "Search word")) "Prompt for a whitespace delimited word and search backward for it. If found, leaves point before the word. If not, leaves point where it is." - (simple-search-backward *drei-instance* + (simple-search-backward (drei-instance) #'(lambda (mark) (search-backward mark word))))

@@ -166,7 +166,7 @@

(define-command (com-isearch-forward :name t :command-table search-table) () (display-message "Isearch: ") - (isearch-command-loop *drei-instance* t)) + (isearch-command-loop (drei-instance) t))

(set-key 'com-isearch-forward 'search-table @@ -174,14 +174,14 @@

(define-command (com-isearch-backward :name t :command-table search-table) () (display-message "Isearch backward: ") - (isearch-command-loop *drei-instance* nil)) + (isearch-command-loop (drei-instance) nil))

(set-key 'com-isearch-backward 'search-table '((#\r :control)))

(defun isearch-append-char (char) - (let* ((states (isearch-states *drei-instance*)) + (let* ((states (isearch-states (drei-instance))) (string (concatenate 'string (search-string (first states)) (string char))) @@ -189,7 +189,7 @@ (forwardp (search-forward-p (first states)))) (unless (or forwardp (end-of-buffer-p mark)) (incf (offset mark))) - (isearch-from-mark *drei-instance* mark string forwardp))) + (isearch-from-mark (drei-instance) mark string forwardp)))

(define-command (com-isearch-append-char :name t :command-table isearch-drei-table) () (isearch-append-char *current-gesture*)) @@ -198,7 +198,7 @@ (isearch-append-char #\Newline))

(defun isearch-append-text (movement-function) - (let* ((states (isearch-states *drei-instance*)) + (let* ((states (isearch-states (drei-instance))) (start (clone-mark (point))) (mark (clone-mark (search-mark (first states)))) (forwardp (search-forward-p (first states)))) @@ -212,7 +212,7 @@ point-offset)))) (unless (or forwardp (end-of-buffer-p mark)) (incf (offset mark) (- point-offset start-offset))) - (isearch-from-mark *drei-instance* mark string forwardp)))) + (isearch-from-mark (drei-instance) mark string forwardp))))

(define-command (com-isearch-append-word :name t :command-table isearch-drei-table) () (isearch-append-text #'(lambda (mark) (forward-word mark (current-syntax))))) @@ -221,7 +221,7 @@ (isearch-append-text #'end-of-line))

(define-command (com-isearch-append-kill :name t :command-table isearch-drei-table) () - (let* ((states (isearch-states *drei-instance*)) + (let* ((states (isearch-states (drei-instance))) (yank (handler-case (kill-ring-yank *kill-ring*) (empty-kill-ring () ""))) @@ -232,19 +232,19 @@ (forwardp (search-forward-p (first states)))) (unless (or forwardp (end-of-buffer-p mark)) (incf (offset mark) (length yank))) - (isearch-from-mark *drei-instance* mark string forwardp))) + (isearch-from-mark (drei-instance) mark string forwardp)))

(define-command (com-isearch-delete-char :name t :command-table isearch-drei-table) () - (cond ((null (second (isearch-states *drei-instance*))) + (cond ((null (second (isearch-states (drei-instance)))) (display-message "Isearch: ") (beep)) (t - (pop (isearch-states *drei-instance*)) - (loop until (endp (rest (isearch-states *drei-instance*))) - until (search-success-p (first (isearch-states *drei-instance*))) - do (pop (isearch-states *drei-instance*))) - (let ((state (first (isearch-states *drei-instance*)))) - (setf (offset (point *drei-instance*)) + (pop (isearch-states (drei-instance))) + (loop until (endp (rest (isearch-states (drei-instance)))) + until (search-success-p (first (isearch-states (drei-instance)))) + do (pop (isearch-states (drei-instance)))) + (let ((state (first (isearch-states (drei-instance))))) + (setf (offset (point (drei-instance))) (if (search-forward-p state) (+ (offset (search-mark state)) (length (search-string state))) @@ -255,26 +255,26 @@ (display-string (search-string state)))))))

(define-command (com-isearch-search-forward :name t :command-table isearch-drei-table) () - (let* ((states (isearch-states *drei-instance*)) + (let* ((states (isearch-states (drei-instance))) (string (if (null (second states)) - (isearch-previous-string *drei-instance*) + (isearch-previous-string (drei-instance)) (search-string (first states)))) (mark (clone-mark (point)))) - (isearch-from-mark *drei-instance* mark string t))) + (isearch-from-mark (drei-instance) mark string t)))

(define-command (com-isearch-search-backward :name t :command-table isearch-drei-table) () - (let* ((states (isearch-states *drei-instance*)) + (let* ((states (isearch-states (drei-instance))) (string (if (null (second states)) - (isearch-previous-string *drei-instance*) + (isearch-previous-string (drei-instance)) (search-string (first states)))) (mark (clone-mark (point)))) - (isearch-from-mark *drei-instance* mark string nil))) + (isearch-from-mark (drei-instance) mark string nil)))

(define-command (com-isearch-exit :name t :command-table isearch-drei-table) () - (let* ((states (isearch-states *drei-instance*)) + (let* ((states (isearch-states (drei-instance))) (string (search-string (first states))) (search-forward-p (search-forward-p (first states)))) - (setf (isearch-mode *drei-instance*) nil) + (setf (isearch-mode (drei-instance)) nil) (when (string= string "") (execute-frame-command *application-frame* (funcall @@ -343,7 +343,7 @@ t))))

(define-command (com-query-replace :name t :command-table search-table) () - (let* ((drei *drei-instance*) + (let* ((drei (drei-instance)) (old-state (query-replace-state drei)) (old-string1 (when old-state (string1 old-state))) (old-string2 (when old-state (string2 old-state))) @@ -394,7 +394,7 @@ '((#% :shift :meta)))

(define-command (com-query-replace-replace :name t :command-table query-replace-drei-table) () - (let ((state (query-replace-state *drei-instance*))) + (let ((state (query-replace-state (drei-instance)))) (with-accessors ((string1 string1) (string2 string2) (occurrences occurrences) @@ -410,13 +410,13 @@ (if (query-replace-find-next-match state) (display-message "Replace ~A with ~A:" string1 string2) - (setf (query-replace-mode *drei-instance*) nil)))))) + (setf (query-replace-mode (drei-instance)) nil))))))

(define-command (com-query-replace-replace-and-quit :name t :command-table query-replace-drei-table) () - (let ((state (query-replace-state *drei-instance*))) + (let ((state (query-replace-state (drei-instance)))) (with-accessors ((string1 string1) (string2 string2) (occurrences occurrences) @@ -429,13 +429,13 @@ string2 (no-upper-p string1)) (incf occurrences) - (setf (query-replace-mode *drei-instance*) nil))))) + (setf (query-replace-mode (drei-instance)) nil)))))

(define-command (com-query-replace-replace-all :name t :command-table query-replace-drei-table) () - (let ((state (query-replace-state *drei-instance*))) + (let ((state (query-replace-state (drei-instance)))) (with-accessors ((string1 string1) (string2 string2) (occurrences occurrences) @@ -449,19 +449,19 @@ (no-upper-p string1)) (incf occurrences) while (query-replace-find-next-match state) - finally (setf (query-replace-mode *drei-instance*) nil)))))) + finally (setf (query-replace-mode (drei-instance)) nil))))))

(define-command (com-query-replace-skip :name t :command-table query-replace-drei-table) () - (let ((state (query-replace-state *drei-instance*))) + (let ((state (query-replace-state (drei-instance)))) (with-accessors ((string1 string1) (string2 string2)) state (if (query-replace-find-next-match state) (display-message "Replace ~A with ~A:" string1 string2) - (setf (query-replace-mode *drei-instance*) nil))))) + (setf (query-replace-mode (drei-instance)) nil)))))

(define-command (com-query-replace-exit :name t :command-table query-replace-drei-table) () - (setf (query-replace-mode *drei-instance*) nil)) + (setf (query-replace-mode (drei-instance)) nil))

(defun query-replace-set-key (gesture command) (add-command-to-command-table command 'query-replace-drei-table @@ -497,7 +497,7 @@ :delimiter-gestures nil :activation-gestures '(:newline :return)))) - (simple-search-forward *drei-instance* + (simple-search-forward (drei-instance) #'(lambda (mark) (re-search-forward mark (normalise-minibuffer-regex string))))))

@@ -506,7 +506,7 @@ :delimiter-gestures nil :activation-gestures '(:newline :return)))) - (simple-search-backward *drei-instance* + (simple-search-backward (drei-instance) #'(lambda (mark) (re-search-backward mark (normalise-minibuffer-regex string))))))

--- /project/mcclim/cvsroot/mcclim/Drei/targets.lisp 2007/12/08 08:53:49 1.2 +++ /project/mcclim/cvsroot/mcclim/Drei/targets.lisp 2008/01/17 11:29:55 1.3 @@ -27,7 +27,7 @@ (in-package :drei-core)

(defclass target-specification () - ((%drei :reader drei-instance + ((%drei :reader drei-instance-of :initarg :drei-instance :initform (error "A Drei instance must be provided for a target specification"))) (:documentation "The base class for target specifications,