November 2007 - climacs-cvs@common-lisp.net

[climacs-cvs] CVS climacs
by thenriksen 20 Nov '07

20 Nov '07

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)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[climacs-cvs] CVS climacs
by thenriksen 16 Nov '07

16 Nov '07

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv31589 Modified Files: climacs.asd groups.lisp gui.lisp misc-commands.lisp packages.lisp Log Message: Restored Climacs' Group-support. --- /project/climacs/cvsroot/climacs/climacs.asd 2007/05/01 17:09:52 1.60 +++ /project/climacs/cvsroot/climacs/climacs.asd 2007/11/16 09:29:47 1.61 @@ -39,7 +39,7 @@ (:file "prolog-syntax" :depends-on ("packages")) (:file "prolog2paiprolog" :depends-on ("prolog-syntax")) (:file "ttcn3-syntax" :depends-on ("packages")) - (:file "climacs-lisp-syntax" :depends-on ("core" #+nil groups)) + (:file "climacs-lisp-syntax" :depends-on ("core" "groups")) (:file "climacs-lisp-syntax-commands" :depends-on ("climacs-lisp-syntax" "misc-commands")) (:file "c-syntax" :depends-on ("core")) (:file "c-syntax-commands" :depends-on ("c-syntax" "misc-commands")) @@ -48,7 +48,7 @@ (:file "gui" :depends-on ("packages" "text-syntax")) (:file "core" :depends-on ("gui")) (:file "io" :depends-on ("packages" "gui")) - #+nil (:file "groups" :depends-on ("core")) + (:file "groups" :depends-on ("core")) (:file "climacs" :depends-on ("gui" "core")) (:file "developer-commands" :depends-on ("core")) --- /project/climacs/cvsroot/climacs/groups.lisp 2006/11/12 16:06:06 1.4 +++ /project/climacs/cvsroot/climacs/groups.lisp 2007/11/16 09:29:47 1.5 @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Package: CLIMACS-CORE -*- -;;; (c) copyright 2006 by +;;; (c) copyright 2006-2007 by ;;; Troels Henriksen (athas(a)sigkill.dk) ;;; This library is free software; you can redistribute it and/or @@ -24,9 +24,9 @@ (defvar *persistent-groups* (make-hash-table :test #'equal) "A hash table of groups that are persistent across invocations - of the Climacs editor. Typically, these do not designate - concrete pathnames, but contain more abstract designations such - as \"all files in the current directory\".") +of the Climacs editor. Typically, these do not designate concrete +pathnames, but contain more abstract designations such as \"all +files in the current directory\".") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -46,7 +46,7 @@ (defclass current-buffer-group (group) () (:documentation "Group class denoting the currently active - buffer.")) +buffer.")) (defclass synonym-group (group) ((%other-name :initarg :other-name @@ -69,7 +69,7 @@ :initform nil :accessor value-plist)) (:documentation "A group that will call a provided function - when it is selected or asked for pathnames.")) +when it is selected or asked for pathnames.")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -77,8 +77,8 @@ (defgeneric group-buffers (group) (:documentation "Get a list of buffers in `group'. Only already - existing buffers will be returned, use `ensure-group-buffers' - if you want all buffers defined by the group.")) +existing buffers will be returned, use `ensure-group-buffers' if +you want all buffers defined by the group.")) (defgeneric ensure-group-buffers (group) (:documentation "For each pathname in `group' that does not @@ -86,10 +86,10 @@ (defgeneric select-group (group) (:documentation "Tell the group object `group' that the user - has selected it. This method is responsible for setting the - active group. If `group' needs additional information, it - should query the user when this method is invoked. The standard - method should be sufficient for most group classes.") +has selected it. This method is responsible for setting the +active group. If `group' needs additional information, it should +query the user when this method is invoked. The standard method +should be sufficient for most group classes.") (:method ((group group)) ;; Use a synonym group so that changes to the group of this name ;; will be reflected in the active group. @@ -98,10 +98,10 @@ (defgeneric display-group-contents (group stream) (:documentation "Display the contents of `group' to - `stream'. Basically, this should describe which buffers or - files would be affected by group-aware commands if `group' was - the active group. There is no standard format for the output, - but it is intended for displaying to the user.")) +`stream'. Basically, this should describe which buffers or files +would be affected by group-aware commands if `group' was the +active group. There is no standard format for the output, but it +is intended for displaying to the user.")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -375,3 +375,14 @@ (if (get-group (other-name object)) (present (get-group (other-name object)) type :stream stream :view view) (error 'group-not-found :group-name (other-name object)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Now hook it all up. + +(setf *climacs-target-creator* + #'(lambda (drei) + (ensure-group-buffers (get-active-group)) + (make-instance 'buffer-list-target-specification + :buffers (group-buffers (get-active-group)) + :drei-instance drei))) --- /project/climacs/cvsroot/climacs/gui.lisp 2007/11/16 09:25:03 1.237 +++ /project/climacs/cvsroot/climacs/gui.lisp 2007/11/16 09:29:47 1.238 @@ -40,6 +40,10 @@ of all panes. If NIL, don't. This is off by default, as finding the line and column numbers is potentially expensive.") +(defvar *climacs-target-creator* nil + "A function for creating targets for commands potentially +acting over multiple buffers.") + (defclass climacs-buffer (drei-buffer) ((%external-format :initform *default-external-format* :accessor external-format @@ -223,7 +227,8 @@ (*current-mark* (current-mark)) (*previous-command* (previous-command *current-window*)) (*current-syntax* (and *current-buffer* - (syntax *current-buffer*))))) + (syntax *current-buffer*))) + (*default-target-creator* *climacs-target-creator*))) (defmethod frame-standard-input ((frame climacs)) (get-frame-pane frame 'minibuffer)) --- /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/11/12 16:06:06 1.26 +++ /project/climacs/cvsroot/climacs/misc-commands.lisp 2007/11/16 09:29:47 1.27 @@ -82,7 +82,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Groups -#|| ;; FIXME: Commented about because of lack of support in DREI. + (define-command (com-define-group :name t :command-table global-climacs-table) ((name 'string :prompt "Name") (buffers '(sequence drei-buffer) :prompt "Buffers")) @@ -143,4 +143,3 @@ (set-key 'com-list-group-contents 'global-climacs-table '((#\x :control) (#\g) (#\l))) -||# \ No newline at end of file --- /project/climacs/cvsroot/climacs/packages.lisp 2007/06/04 21:52:06 1.125 +++ /project/climacs/cvsroot/climacs/packages.lisp 2007/11/16 09:29:47 1.126 @@ -29,7 +29,7 @@ (defpackage :climacs-gui (:use :clim-lisp :clim :drei-buffer :drei-base :drei-abbrev :drei-syntax :drei-motion - :drei-kill-ring :drei :clim-extensions + :drei-kill-ring :drei-core :drei :clim-extensions :drei-undo :esa :drei-editing :drei-motion :esa-buffer :esa-io :esa-utils) ;;(:import-from :lisp-string) @@ -65,12 +65,13 @@ #:*mini-fg-color* #:*with-scrollbars* #:*default-external-format* + #:*climacs-target-creator* ;; The command tables #:global-climacs-table #:keyboard-macro-table #:climacs-help-table #:base-table #:buffer-table #:case-table - #:development-table - #:info-table #:pane-table + #:development-table + #:info-table #:pane-table #:window-table)) (defpackage :climacs-core

1 0

[climacs-cvs] CVS climacs
by thenriksen 16 Nov '07

16 Nov '07

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv31013 Modified Files: gui.lisp core.lisp Log Message: Made code for buffer switching in Climacs a bit more centralised, you no longer have to use `switch-to-buffer' or experience pain. --- /project/climacs/cvsroot/climacs/gui.lisp 2007/02/19 22:06:18 1.236 +++ /project/climacs/cvsroot/climacs/gui.lisp 2007/11/16 09:25:03 1.237 @@ -61,6 +61,14 @@ (setf (active pane) nil))) (windows (pane-frame climacs-pane)))) +(defmethod (setf buffer) :before ((buffer climacs-buffer) (pane climacs-pane)) + (with-accessors ((buffers buffers)) *application-frame* + (unless (member buffer buffers) + (error "Attempting to switch to a buffer not known to Climacs")) + (setf buffers (delete buffer buffers)) + (push buffer buffers) + (full-redisplay pane))) + (defmethod command-table ((drei climacs-pane)) (command-table (pane-frame drei))) --- /project/climacs/cvsroot/climacs/core.lisp 2007/08/24 13:13:00 1.12 +++ /project/climacs/cvsroot/climacs/core.lisp 2007/11/16 09:25:03 1.13 @@ -68,16 +68,7 @@ (defgeneric switch-to-buffer (pane buffer)) (defmethod switch-to-buffer ((pane drei) (buffer drei-buffer)) - (with-accessors ((buffers buffers)) *application-frame* - (let* ((position (position buffer buffers)) - (pane (current-window))) - (when position - (setf buffers (delete buffer buffers))) - (push buffer buffers) - (setf (offset (point (buffer pane))) (offset (point pane))) - (setf (buffer pane) buffer) - (full-redisplay pane) - buffer))) + (setf (buffer pane) buffer)) (defmethod switch-to-buffer ((pane typeout-pane) (buffer drei-buffer)) (let ((usable-pane (or (find-if #'(lambda (pane)

1 0