Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv6934

Modified Files: c-syntax-commands.lisp climacs-lisp-syntax-commands.lisp climacs-lisp-syntax.lisp core.lisp file-commands.lisp gui.lisp java-syntax-commands.lisp misc-commands.lisp Log Message: Fixed Climacs to adapt to changes in Drei.

--- /project/climacs/cvsroot/climacs/c-syntax-commands.lisp 2007/05/01 20:54:53 1.2 +++ /project/climacs/cvsroot/climacs/c-syntax-commands.lisp 2007/11/20 12:59:53 1.3 @@ -57,7 +57,7 @@ () "Fill paragraph at point. Will have no effect unless there is a string at point." - (let* ((pane *current-window*) + (let* ((pane (current-window)) (buffer (buffer pane)) (implementation (implementation buffer)) (syntax (syntax buffer)) @@ -82,7 +82,7 @@

(define-command (com-indent-expression :name t :command-table c-table) ((count 'integer :prompt "Number of expressions")) - (let* ((pane *current-window*) + (let* ((pane (current-window)) (point (point pane)) (mark (clone-mark point)) (syntax (syntax (buffer pane)))) --- /project/climacs/cvsroot/climacs/climacs-lisp-syntax-commands.lisp 2007/02/19 16:23:49 1.4 +++ /project/climacs/cvsroot/climacs/climacs-lisp-syntax-commands.lisp 2007/11/20 12:59:53 1.5 @@ -37,7 +37,7 @@ '(climacs-lisp-table))

(define-command (com-package :name t :command-table climacs-lisp-table) () - (let ((package (package-at-mark *current-syntax* *current-point*))) + (let ((package (package-at-mark (current-syntax) (point)))) (esa:display-message (format nil "~A" (if (packagep package) (package-name package) package))))) @@ -45,12 +45,12 @@ (define-command (com-set-base :name t :command-table climacs-lisp-table) ((base '(integer 2 36))) "Set the base for the current buffer." - (setf (base *current-syntax*) base)) + (setf (base (current-syntax)) base))

(define-command (com-set-package :name t :command-table climacs-lisp-table) ((package 'package)) "Set the package for the current buffer." - (setf (option-specified-package *current-syntax*) package)) + (setf (option-specified-package (current-syntax)) package))

(define-command (com-macroexpand-1 :name t :command-table climacs-lisp-table) () @@ -58,9 +58,9 @@

The expanded expression will be displayed in a "*Macroexpansion*"-buffer." - (let*((token (expression-at-mark *current-point* *current-syntax*))) + (let*((token (expression-at-mark (point) (current-syntax)))) (if token - (macroexpand-token *current-syntax* token) + (macroexpand-token (current-syntax) token) (esa:display-message "Nothing to expand at point."))))

(define-command (com-macroexpand-all :name t :command-table climacs-lisp-table) @@ -69,9 +69,9 @@

The expanded expression will be displayed in a "*Macroexpansion*"-buffer." - (let ((token (expression-at-mark *current-point* *current-syntax*))) + (let ((token (expression-at-mark (point) (current-syntax)))) (if token - (macroexpand-token *current-syntax* token t) + (macroexpand-token (current-syntax) token t) (esa:display-message "Nothing to expand at point."))))

(define-command (com-compile-and-load-file :name t :command-table climacs-lisp-table) @@ -79,14 +79,14 @@ "Compile and load the current file.

Compiler notes will be displayed in a seperate buffer." - (compile-file-interactively *current-buffer* t)) + (compile-file-interactively (current-buffer) t))

(define-command (com-compile-file :name t :command-table climacs-lisp-table) () "Compile the file open in the current buffer.

This command does not load the file after it has been compiled." - (compile-file-interactively *current-buffer* nil)) + (compile-file-interactively (current-buffer) nil))

(define-command (com-goto-location :name t :command-table climacs-lisp-table) ((note 'compiler-note)) @@ -116,8 +116,8 @@ () "Edit definition of the symbol at point. If there is no symbol at point, this is a no-op." - (let* ((token (this-form *current-syntax* *current-point*)) - (this-symbol (form-to-object *current-syntax* token))) + (let* ((token (this-form (current-syntax) (point))) + (this-symbol (form-to-object (current-syntax) token))) (when (and this-symbol (symbolp this-symbol)) (edit-definition this-symbol))))

@@ -131,7 +131,7 @@ () "Compile and load definition at point." (evaluating-interactively - (compile-definition-interactively *current-point* *current-syntax*))) + (compile-definition-interactively (point) (current-syntax))))

(esa:set-key 'com-eval-defun 'climacs-lisp-table --- /project/climacs/cvsroot/climacs/climacs-lisp-syntax.lisp 2007/08/13 21:58:57 1.4 +++ /project/climacs/cvsroot/climacs/climacs-lisp-syntax.lisp 2007/11/20 12:59:53 1.5 @@ -170,7 +170,7 @@ :fill-pointer 0) when (char= (char string count) #\Newline) do (loop while (and (< count (length string)) - (whitespacep *current-syntax* (char string count))) + (whitespacep (current-syntax) (char string count))) do (incf count) ;; Just ignore whitespace if it is last in the ;; string. @@ -241,7 +241,7 @@ (when path (namestring path))))))) (if buffer - (climacs-core:switch-to-buffer *current-window* buffer) + (climacs-core:switch-to-buffer (current-window) buffer) (find-file (file-name location))) (goto-position (point (current-window)) (char-position (source-position location))))) @@ -259,7 +259,7 @@ all)) (expansion-string (with-output-to-string (s) (pprint expansion s)))) - (let ((buffer (climacs-core:switch-to-buffer *current-window* "*Macroexpansion*"))) + (let ((buffer (climacs-core:switch-to-buffer (current-window) "*Macroexpansion*"))) (set-syntax buffer "Lisp")) (let ((point (point (current-window))) (header-string (one-line-ify (subseq string 0 @@ -322,7 +322,7 @@ (offset (first offset+buffer)) (buffer (second offset+buffer))) (if (find buffer (buffers *application-frame*)) - (progn (climacs-core:switch-to-buffer *current-window* buffer) + (progn (climacs-core:switch-to-buffer (current-window) buffer) (goto-position (point (current-window)) offset)) (pop-find-definition-stack)))))

--- /project/climacs/cvsroot/climacs/core.lisp 2007/11/16 09:25:03 1.13 +++ /project/climacs/cvsroot/climacs/core.lisp 2007/11/20 12:59:54 1.14 @@ -104,9 +104,9 @@ ;; Always need one buffer. (when (null buffers) (make-new-buffer :name "*scratch*")) - (setf (buffer (current-window)) (car buffers)) + (setf (current-buffer) (car buffers)) (full-redisplay (current-window)) - (buffer (current-window)))) + (current-buffer)))

(defmethod kill-buffer ((name string)) (let ((buffer (find name (buffers *application-frame*) @@ -114,7 +114,7 @@ (when buffer (kill-buffer buffer))))

(defmethod kill-buffer ((symbol (eql 'nil))) - (kill-buffer (buffer (current-window)))) + (kill-buffer (current-buffer)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -311,7 +311,7 @@ (t (let ((existing-buffer (find-buffer-with-pathname filepath))) (if (and existing-buffer (if readonlyp (read-only-p existing-buffer) t)) - (switch-to-buffer *current-window* existing-buffer) + (switch-to-buffer (current-window) existing-buffer) (progn (when readonlyp (unless (probe-file filepath) @@ -324,7 +324,7 @@ (make-new-buffer))) (pane (current-window))) (setf (offset (point (buffer pane))) (offset (point pane)) - (buffer (current-window)) buffer + (current-buffer) buffer (syntax buffer) (make-instance (syntax-class-name-for-filepath filepath) :buffer buffer) (file-write-time buffer) (file-write-date filepath)) --- /project/climacs/cvsroot/climacs/file-commands.lisp 2006/12/18 17:54:40 1.27 +++ /project/climacs/cvsroot/climacs/file-commands.lisp 2007/11/20 12:59:54 1.28 @@ -43,7 +43,7 @@ An example attribute-list is:

;; -*- Syntax: Lisp; Base: 10 -*- " - (evaluate-attribute-line (buffer (current-window)))) + (evaluate-attribute-line (current-buffer)))

(define-command (com-update-attribute-list :name t :command-table buffer-table) () @@ -65,26 +65,25 @@

This command automatically comments the attribute line as appropriate for the syntax of the buffer." - (update-attribute-line (buffer (current-window))) - (evaluate-attribute-line (buffer (current-window)))) + (update-attribute-line (current-buffer)) + (evaluate-attribute-line (current-buffer)))

(define-command (com-insert-file :name t :command-table buffer-table) ((filename 'pathname :prompt "Insert File" - :default (directory-of-buffer (buffer (current-window))) - :default-type 'pathname - :insert-default t)) + :default (directory-of-buffer (current-buffer)) + :default-type 'pathname + :insert-default t)) "Prompt for a filename and insert its contents at point. Leaves mark after the inserted contents." - (let ((pane (current-window))) - (when (probe-file filename) - (setf (mark pane) (clone-mark (point pane) :left)) - (with-open-file (stream filename :direction :input) - (input-from-stream stream - (buffer pane) - (offset (point pane)))) - (psetf (offset (mark pane)) (offset (point pane)) - (offset (point pane)) (offset (mark pane)))) - (redisplay-frame-panes *application-frame*))) + (when (probe-file filename) + (setf (mark) (clone-mark (point) :left)) + (with-open-file (stream filename :direction :input) + (input-from-stream stream + (current-buffer) + (offset (point)))) + (psetf (offset (mark)) (offset (point)) + (offset (point)) (offset (mark)))) + (redisplay-frame-panes *application-frame*))

(set-key `(com-insert-file ,*unsupplied-argument-marker*) 'buffer-table @@ -93,23 +92,21 @@ (define-command (com-revert-buffer :name t :command-table buffer-table) () "Replace the contents of the current buffer with the visited file. Signals an error if the file does not exist." - (let* ((pane (current-window)) - (buffer (buffer pane)) - (filepath (filepath buffer)) - (save (offset (point pane)))) + (let* ((save (offset (point))) + (filepath (filepath (current-buffer)))) (when (accept 'boolean :prompt (format nil "Revert buffer from file ~A?" - (filepath buffer))) + filepath)) (cond ((directory-pathname-p filepath) (display-message "~A is a directory name." filepath) (beep)) ((probe-file filepath) - (unless (check-file-times buffer filepath "Revert" "reverted") + (unless (check-file-times (current-buffer) filepath "Revert" "reverted") (return-from com-revert-buffer)) - (erase-buffer buffer) + (erase-buffer (current-buffer)) (with-open-file (stream filepath :direction :input) - (input-from-stream stream buffer 0)) - (setf (offset (point pane)) (min (size buffer) save) - (file-saved-p buffer) nil)) + (input-from-stream stream (current-buffer) 0)) + (setf (offset (point)) (min (size (current-buffer)) save) + (file-saved-p (current-buffer)) nil)) (t (display-message "No file ~A" filepath) (beep)))))) @@ -154,7 +151,7 @@ (define-command (com-kill-buffer :name t :command-table pane-table) ((buffer 'buffer :prompt "Kill buffer" - :default (buffer (current-window)))) + :default (current-buffer))) "Prompt for a buffer name and kill that buffer. If the buffer needs saving, will prompt you to do so before killing it. Uses the current buffer as a default." (kill-buffer buffer)) --- /project/climacs/cvsroot/climacs/gui.lisp 2007/11/16 09:29:47 1.238 +++ /project/climacs/cvsroot/climacs/gui.lisp 2007/11/20 12:59:54 1.239 @@ -83,9 +83,9 @@

(defmethod buffer ((pane typeout-pane)))

-(defmethod point ((pane typeout-pane))) +(defmethod point-of ((pane typeout-pane)))

-(defmethod mark ((pane typeout-pane))) +(defmethod mark-of ((pane typeout-pane)))

(defmethod full-redisplay ((pane typeout-pane)))

@@ -168,7 +168,7 @@ ())

(defmethod command-table-inherit-from ((table climacs-command-table)) - (append (when *current-syntax* (list (command-table *current-syntax*))) + (append (when (current-syntax) (list (command-table (current-syntax)))) '(global-climacs-table) (call-next-method)))

@@ -223,19 +223,15 @@ command-unparser partial-command-parser prompt) - :bindings ((*current-point* (current-point)) - (*current-mark* (current-mark)) - (*previous-command* (previous-command *current-window*)) - (*current-syntax* (and *current-buffer* - (syntax *current-buffer*))) - (*default-target-creator* *climacs-target-creator*))) + :bindings ((*previous-command* (previous-command (current-window))) + (*default-target-creator* *climacs-target-creator*)))

(defmethod frame-standard-input ((frame climacs)) (get-frame-pane frame 'minibuffer))

-(defmethod frame-current-buffer ((application-frame climacs)) +(defmethod esa-current-buffer ((application-frame climacs)) "Return the current buffer." - (buffer (frame-current-window application-frame))) + (buffer (esa-current-window application-frame)))

(defun any-buffer () "Return some buffer, any buffer, as long as it is a buffer!" @@ -313,15 +309,16 @@ (display-drei drei))

(defmethod execute-frame-command :around ((frame climacs) command) - (if (eq frame *application-frame*) - (progn - (handling-drei-conditions - (with-undo ((buffers frame)) - (call-next-method))) - (loop for buffer in (buffers frame) - do (when (modified-p buffer) - (clear-modify buffer)))) - (call-next-method))) + (let ((*drei-instance* (esa-current-window frame))) + (if (eq frame *application-frame*) + (progn + (handling-drei-conditions + (with-undo ((buffers frame)) + (call-next-method))) + (loop for buffer in (buffers frame) + do (when (modified-p buffer) + (clear-modify buffer)))) + (call-next-method))))

(defmethod execute-frame-command :after ((frame climacs) command) (when (eq frame *application-frame*) --- /project/climacs/cvsroot/climacs/java-syntax-commands.lisp 2007/05/01 17:46:38 1.1 +++ /project/climacs/cvsroot/climacs/java-syntax-commands.lisp 2007/11/20 12:59:54 1.2 @@ -58,7 +58,7 @@ () "Fill paragraph at point. Will have no effect unless there is a string at point." - (let* ((pane *current-window*) + (let* ((pane (current-window)) (buffer (buffer pane)) (implementation (implementation buffer)) (syntax (syntax buffer)) @@ -83,14 +83,11 @@

(define-command (com-indent-expression :name t :command-table java-table) ((count 'integer :prompt "Number of expressions")) - (let* ((pane *current-window*) - (point (point pane)) - (mark (clone-mark point)) - (syntax (syntax (buffer pane)))) + (let* ((mark (clone-mark (point)))) (if (plusp count) - (loop repeat count do (forward-expression mark syntax)) - (loop repeat (- count) do (backward-expression mark syntax))) - (indent-region pane (clone-mark point) mark))) + (loop repeat count do (forward-expression mark (current-syntax))) + (loop repeat (- count) do (backward-expression mark (current-syntax)))) + (indent-region *drei-instance* (point) mark)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; --- /project/climacs/cvsroot/climacs/misc-commands.lisp 2007/11/16 09:29:47 1.27 +++ /project/climacs/cvsroot/climacs/misc-commands.lisp 2007/11/20 12:59:54 1.28 @@ -46,18 +46,16 @@ and the percentage of the buffers objects before point.

FIXME: gives no information at end of buffer." - (let* ((pane (current-window)) - (point (point pane)) - (buffer (buffer pane)) - (offset (offset point)) - (size (size buffer)) - (char (or (end-of-buffer-p point) (object-after point))) - (column (column-number point))) + (let* ((char (or (end-of-buffer-p (point)) (object-after (point)))) + (column (column-number (point)))) (display-message "Char: ~:[none~*~;~:*~:C (#o~O ~:*~D ~:*#x~X)~] point=~D of ~D (~D%) column ~D" (and (characterp char) char) (and (characterp char) (char-code char)) - offset size - (if size (round (* 100 (/ offset size))) 100) + (offset (point)) (size (current-buffer)) + (if (size (current-buffer)) + (round (* 100 (/ (offset (point)) + (size (current-buffer))))) + 100) column)))

(set-key 'com-what-cursor-position @@ -77,7 +75,7 @@ :prompt "Name of syntax")) "Prompts for a syntax to set for the current buffer. Setting a syntax will cause the buffer to be reparsed using the new syntax." - (set-syntax *current-buffer* syntax)) + (set-syntax (current-buffer) syntax))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;