[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Thu Jan 17 11:29:56 UTC 2008
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 , at 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: ")))
, at 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,
More information about the Mcclim-cvs
mailing list