January 2008 - climacs-cvs@common-lisp.net

[climacs-cvs] CVS climacs
by thenriksen 30 Jan '08

30 Jan '08

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv2631 Modified Files: typeout.lisp Log Message: Added method for clear-redisplay-information. --- /project/climacs/cvsroot/climacs/typeout.lisp 2008/01/23 19:08:47 1.5 +++ /project/climacs/cvsroot/climacs/typeout.lisp 2008/01/30 07:32:30 1.6 @@ -45,6 +45,9 @@ "Return true if `view' is a typeout view, false otherwise." (typep view 'typeout-view)) +(defmethod clear-redisplay-information ((view typeout-view)) + (setf (dirty view) t)) + (defmethod handle-redisplay ((pane drei-pane) (view typeout-view) (region region)) (if (and (not (dirty view)) (eq (output-record-parent (output-history view))

1 0

[climacs-cvs] CVS climacs
by thenriksen 29 Jan '08

29 Jan '08

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv2225 Modified Files: file-commands.lisp gui.lisp packages.lisp window-commands.lisp Log Message: Added sweet new menu items. --- /project/climacs/cvsroot/climacs/file-commands.lisp 2008/01/26 23:06:04 1.30 +++ /project/climacs/cvsroot/climacs/file-commands.lisp 2008/01/29 23:09:22 1.31 @@ -136,35 +136,6 @@ ;;; ;;; Buffer commands -(define-command (com-switch-to-view :name t :command-table pane-table) - ;; Perhaps the default should be an undisplayed view? - ((view 'view :default (or (find (current-view) (views *application-frame*) - :test (complement #'eq)) - (any-view)))) - "Prompt for a buffer name and switch to that buffer. -If the a buffer with that name does not exist, create it. Uses -the name of the next buffer (if any) as a default." - (handler-case (switch-to-view (current-window) view) - (view-already-displayed (condition) - (other-window (window condition))))) - -(set-key `(com-switch-to-view ,*unsupplied-argument-marker*) - 'pane-table - '((#\x :control) (#\b))) - -(define-command (com-kill-view :name t :command-table pane-table) - ((view 'view :prompt "Kill view" - :default (current-view))) - "Prompt for a view name and kill that view. -If the view is of a buffer and the buffer needs saving, you will -be prompted to do so before killing it. Uses the current view -as a default." - (kill-view view)) - -(set-key `(com-kill-view ,*unsupplied-argument-marker*) - 'pane-table - '((#\x :control) (#\k))) - (define-command (com-toggle-read-only :name t :command-table buffer-table) ((buffer 'buffer :default (current-buffer *application-frame*))) (setf (read-only-p buffer) (not (read-only-p buffer)))) @@ -183,4 +154,4 @@ (modified com-toggle-modified buffer-table :gesture :menu) (object) - (list object)) \ No newline at end of file + (list object)) --- /project/climacs/cvsroot/climacs/gui.lisp 2008/01/28 17:08:50 1.257 +++ /project/climacs/cvsroot/climacs/gui.lisp 2008/01/29 23:09:22 1.258 @@ -203,8 +203,6 @@ (make-command-table 'buffer-table :errorp nil) ;;; Commands used for climacs development (make-command-table 'development-table :errorp nil) -;;; Panes -(make-command-table 'pane-table :errorp nil) ;;; Windows (make-command-table 'window-table :errorp nil) @@ -219,7 +217,6 @@ :errorp nil :inherit-from '(base-table buffer-table - pane-table window-table development-table climacs-help-table @@ -242,30 +239,10 @@ (make-command-table 'climacs-global-table :inherit-from (list (make-instance 'climacs-command-table :name 'climacs-dispatching-table)) - :menu `(("File" :menu ,(make-command-table nil - :inherit-from 'esa-io-table - :menu `(("Find File" - :command (com-find-file ,*unsupplied-argument-marker*)) - ("Find File (read-only)" - :command (com-find-file-read-only ,*unsupplied-argument-marker*)) - ("Save Buffer" - :command (com-save-buffer)) - ("Save Bufer As" - :command (com-write-buffer ,*unsupplied-argument-marker*)) - ("Set Visited File Name" - :command (com-set-visited-file-name ,*unsupplied-argument-marker*)) - (nil :divider :line) - ("Quit" :command com-quit)))) - ("Help" :menu ,(make-command-table nil - :inherit-from 'help-table - :menu `(("Where is" :command com-where-is) - ("Describe Bindings" :command (com-describe-bindings nil)) - ("Describe Bindings (sorted)" :command (com-describe-bindings t)) - ("Describe Key" :command com-describe-key) - ("Describe Command" - :command (com-describe-command ,*unsupplied-argument-marker*)) - ("Apropos Command" - :command (com-apropos-command ,*unsupplied-argument-marker*)))))) + :menu `(("File" :menu esa-io-menu-table) + ("Macros" :menu keyboard-macro-menu-table) + ("Windows" :menu window-menu-table) + ("Help" :menu help-menu-table)) :errorp nil) (define-application-frame climacs (esa-frame-mixin --- /project/climacs/cvsroot/climacs/packages.lisp 2008/01/23 18:17:05 1.136 +++ /project/climacs/cvsroot/climacs/packages.lisp 2008/01/29 23:09:22 1.137 @@ -82,8 +82,8 @@ #:global-climacs-table #:keyboard-macro-table #:climacs-help-table #:base-table #:buffer-table #:case-table #:development-table - #:info-table #:pane-table - #:window-table + #:info-table + #:window-table #:window-menu-table ;; Typeout #:typeout-view #:typeout-view-p --- /project/climacs/cvsroot/climacs/window-commands.lisp 2008/01/20 19:51:48 1.18 +++ /project/climacs/cvsroot/climacs/window-commands.lisp 2008/01/29 23:09:23 1.19 @@ -173,3 +173,46 @@ 'window-table '((#\x :control) (#\0))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Commands for switching/killing current view. + +(define-command (com-switch-to-view :name t :command-table window-table) + ;; Perhaps the default should be an undisplayed view? + ((view 'view :default (or (find (current-view) (views *application-frame*) + :test (complement #'eq)) + (any-view)))) + "Prompt for a view name and switch to that view. +If the a view with that name does not exist, create a buffer-view +with the name and switch to it. Uses the name of the next +view (if any) as a default." + (handler-case (switch-to-view (current-window) view) + (view-already-displayed (condition) + (other-window (window condition))))) + +(set-key `(com-switch-to-view ,*unsupplied-argument-marker*) + 'window-table + '((#\x :control) (#\b))) + +(define-command (com-kill-view :name t :command-table window-table) + ((view 'view :prompt "Kill view" + :default (current-view))) + "Prompt for a view name and kill that view. +If the view is of a buffer and the buffer needs saving, you will +be prompted to do so before killing it. Uses the current view +as a default." + (kill-view view)) + +(set-key `(com-kill-view ,*unsupplied-argument-marker*) + 'window-table + '((#\x :control) (#\k))) + +(define-menu-table window-menu-table (window-table) + '(com-split-window-vertically nil) + '(com-split-window-horizontally nil) + 'com-other-window + 'com-single-window + 'com-delete-window + :divider + `(com-switch-to-view ,*unsupplied-argument-marker*) + `(com-kill-view ,*unsupplied-argument-marker*))

1 0

[climacs-cvs] CVS climacs
by thenriksen 28 Jan '08

28 Jan '08

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv25135 Modified Files: gui.lisp Log Message: Added command menu. Only covers a few generic commands for now. I think McCLIM support for :inherit-menu would make this implementable in a much better way. --- /project/climacs/cvsroot/climacs/gui.lisp 2008/01/26 23:06:04 1.256 +++ /project/climacs/cvsroot/climacs/gui.lisp 2008/01/28 17:08:50 1.257 @@ -226,32 +226,61 @@ global-esa-table esa-io-table)) +;; This command table is what assembles the various other command +;; tables for the commands actually accessible by the user. (defclass climacs-command-table (standard-command-table) ()) (defmethod command-table-inherit-from ((table climacs-command-table)) - (append (when (typep (current-window) 'climacs-pane) - (view-command-tables (current-view))) + (append (view-command-tables (current-view)) '(global-climacs-table) - (when (and (typep (current-window) 'climacs-pane) - (use-editor-commands-p (current-view))) + (when (use-editor-commands-p (current-view)) '(editor-table)) (call-next-method))) +;; This is the actual command table that will be used for Climacs. +(make-command-table 'climacs-global-table + :inherit-from (list (make-instance 'climacs-command-table + :name 'climacs-dispatching-table)) + :menu `(("File" :menu ,(make-command-table nil + :inherit-from 'esa-io-table + :menu `(("Find File" + :command (com-find-file ,*unsupplied-argument-marker*)) + ("Find File (read-only)" + :command (com-find-file-read-only ,*unsupplied-argument-marker*)) + ("Save Buffer" + :command (com-save-buffer)) + ("Save Bufer As" + :command (com-write-buffer ,*unsupplied-argument-marker*)) + ("Set Visited File Name" + :command (com-set-visited-file-name ,*unsupplied-argument-marker*)) + (nil :divider :line) + ("Quit" :command com-quit)))) + ("Help" :menu ,(make-command-table nil + :inherit-from 'help-table + :menu `(("Where is" :command com-where-is) + ("Describe Bindings" :command (com-describe-bindings nil)) + ("Describe Bindings (sorted)" :command (com-describe-bindings t)) + ("Describe Key" :command com-describe-key) + ("Describe Command" + :command (com-describe-command ,*unsupplied-argument-marker*)) + ("Apropos Command" + :command (com-apropos-command ,*unsupplied-argument-marker*)))))) + :errorp nil) + (define-application-frame climacs (esa-frame-mixin standard-application-frame) ((%views :initform '() :accessor views) (%groups :initform (make-hash-table :test #'equal) :accessor groups) (%active-group :initform nil :accessor active-group) (%kill-ring :initform (make-instance 'kill-ring :max-size 7) :accessor kill-ring) - (%command-table :initform (make-instance 'climacs-command-table - :name 'climacs-dispatching-table) + (%command-table :initform (find-command-table 'climacs-global-table) :accessor find-applicable-command-table :accessor frame-command-table) (%output-stream :accessor output-stream :initform nil :initarg :output-stream)) - (:menu-bar nil) + (:menu-bar climacs-global-table) (:panes (climacs-window (let* ((*esa-instance* *application-frame*)

1 0

[climacs-cvs] CVS climacs
by thenriksen 27 Jan '08

27 Jan '08

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv13537 Modified Files: core.lisp Log Message: Always force the filepath of a buffer to be a pathname. This fixes some rare error cases reported by Cyrus Harmon. --- /project/climacs/cvsroot/climacs/core.lisp 2008/01/20 19:51:48 1.24 +++ /project/climacs/cvsroot/climacs/core.lisp 2008/01/27 08:13:54 1.25 @@ -353,7 +353,7 @@ (name buffer) (filepath-filename filepath)) (setf (current-view (current-window)) view) (evaluate-attribute-line view) - (setf (filepath buffer) filepath + (setf (filepath buffer) (pathname filepath) (read-only-p buffer) readonlyp) (beginning-of-buffer (point view)) buffer))))))) @@ -375,7 +375,7 @@ (user-homedir-pathname))))) (defmethod frame-set-visited-filename ((application-frame climacs) filepath buffer) - (setf (filepath buffer) filepath + (setf (filepath buffer) (pathname filepath) (file-saved-p buffer) nil (file-write-time buffer) nil (name buffer) (filepath-filename filepath)

1 0

[climacs-cvs] CVS climacs
by thenriksen 26 Jan '08

26 Jan '08

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv16324 Modified Files: file-commands.lisp gui.lisp Log Message: Make defaults for view-switching slightly nicer. --- /project/climacs/cvsroot/climacs/file-commands.lisp 2007/12/08 08:55:06 1.29 +++ /project/climacs/cvsroot/climacs/file-commands.lisp 2008/01/26 23:06:04 1.30 @@ -137,7 +137,9 @@ ;;; Buffer commands (define-command (com-switch-to-view :name t :command-table pane-table) - ((view 'view :default (or (second (views *application-frame*)) + ;; Perhaps the default should be an undisplayed view? + ((view 'view :default (or (find (current-view) (views *application-frame*) + :test (complement #'eq)) (any-view)))) "Prompt for a buffer name and switch to that buffer. If the a buffer with that name does not exist, create it. Uses --- /project/climacs/cvsroot/climacs/gui.lisp 2008/01/20 19:51:48 1.255 +++ /project/climacs/cvsroot/climacs/gui.lisp 2008/01/26 23:06:04 1.256 @@ -137,6 +137,11 @@ (cancel () :report "Cancel the setting of the windows view and just return nil"))) (t (call-next-method))) + ;; Move view to the front of the view-list, doesn't carry + ;; semantic significance, but makes view-switching more + ;; convenient. + (setf (views (pane-frame pane)) + (cons view (delete view (views (pane-frame pane))))) (when old-view-active (ensure-only-view-active (pane-frame pane) view)))))

1 0

[climacs-cvs] CVS climacs
by thenriksen 26 Jan '08

26 Jan '08

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv10360 Modified Files: climacs.lisp Log Message: Only execute a command when we actually have a command. --- /project/climacs/cvsroot/climacs/climacs.lisp 2008/01/23 18:17:05 1.5 +++ /project/climacs/cvsroot/climacs/climacs.lisp 2008/01/26 11:28:53 1.6 @@ -77,7 +77,8 @@ (t (error 'type-error :datum thing :expected-type '(or null string pathname symbol)))))) (if climacs-frame - (execute-frame-command climacs-frame command) + (when command + (execute-frame-command climacs-frame command)) (apply #'climacs-common command :new-process t args))) t)

1 0

[climacs-cvs] CVS climacs
by thenriksen 24 Jan '08

24 Jan '08

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv18812 Modified Files: io.lisp Log Message: Don't permit undoing the initial file load. --- /project/climacs/cvsroot/climacs/io.lisp 2008/01/13 22:23:00 1.9 +++ /project/climacs/cvsroot/climacs/io.lisp 2008/01/24 09:29:28 1.10 @@ -62,4 +62,5 @@ (defmethod frame-make-buffer-from-stream ((application-frame climacs) stream) (let* ((buffer (make-new-buffer))) (input-from-stream stream buffer 0) + (clear-undo-history buffer) buffer))

1 0

[climacs-cvs] CVS climacs
by thenriksen 23 Jan '08

23 Jan '08

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv16178 Modified Files: typeout.lisp Log Message: Small performance improvement for typeout views. --- /project/climacs/cvsroot/climacs/typeout.lisp 2008/01/23 18:17:05 1.4 +++ /project/climacs/cvsroot/climacs/typeout.lisp 2008/01/23 19:08:47 1.5 @@ -47,8 +47,8 @@ (defmethod handle-redisplay ((pane drei-pane) (view typeout-view) (region region)) (if (and (not (dirty view)) - (find (output-history view) - (output-record-children (stream-output-history pane)))) + (eq (output-record-parent (output-history view)) + (stream-output-history pane))) (replay (stream-output-history pane) pane region) (call-next-method)))

1 0

[climacs-cvs] CVS climacs
by thenriksen 23 Jan '08

23 Jan '08

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv14209 Modified Files: climacs-lisp-syntax.lisp Log Message: Fix running certain functions outside textual-drei-syntax-views. --- /project/climacs/cvsroot/climacs/climacs-lisp-syntax.lisp 2008/01/23 18:25:40 1.14 +++ /project/climacs/cvsroot/climacs/climacs-lisp-syntax.lisp 2008/01/23 19:03:21 1.15 @@ -370,7 +370,8 @@ (defun edit-definition (symbol &optional type) (let ((all-definitions (find-definitions-for-drei - (get-usable-image (current-syntax)) + (get-usable-image (when (syntax-view-p (current-view)) + (current-syntax))) symbol))) (let ((definitions (if (not type) all-definitions @@ -384,7 +385,8 @@ (goto-definition symbol definitions)))))) (defun goto-definition (name definitions) - (push (list (offset (point)) (current-view)) *find-definition-stack*) + (when (point-mark-view-p (current-view)) + (push (list (offset (point)) (current-view)) *find-definition-stack*)) (cond ((null (cdr definitions)) (let* ((def (car definitions)) (xref (make-xref def)))

1 0

[climacs-cvs] CVS climacs
by thenriksen 23 Jan '08

23 Jan '08

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv7038 Modified Files: climacs-lisp-syntax.lisp Log Message: Fix M-. for toplevel symbols. --- /project/climacs/cvsroot/climacs/climacs-lisp-syntax.lisp 2008/01/20 19:51:48 1.13 +++ /project/climacs/cvsroot/climacs/climacs-lisp-syntax.lisp 2008/01/23 18:25:40 1.14 @@ -358,13 +358,14 @@ (when form-operator (form-equal syntax form-operator symbol-form))) (find-local-binding (form) - (or (when (locally-binding-p form) - (loop for binding in (form-children (first (form-operands form))) - when (and (form-list-p binding) - (match (form-operator binding))) - return binding)) - (unless (form-at-top-level-p form) - (find-local-binding (parent form)))))) + (when form + (or (when (locally-binding-p form) + (loop for binding in (form-children (first (form-operands form))) + when (and (form-list-p binding) + (match (form-operator binding))) + return binding)) + (unless (form-at-top-level-p form) + (find-local-binding (parent form))))))) (find-local-binding (list-at-mark syntax (start-offset symbol-form))))) (defun edit-definition (symbol &optional type)

1 0