climacs-cvs

climacs-cvs@common-lisp.net

847 discussions

[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

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

23 Jan '08

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv3677 Modified Files: climacs-lisp-syntax-commands.lisp climacs.lisp packages.lisp typeout.lisp Log Message: Added code by Rudi Schlatte to integrated Climacs with CL:ED. Only SBCL is supported for now. --- /project/climacs/cvsroot/climacs/climacs-lisp-syntax-commands.lisp 2008/01/21 17:19:34 1.9 +++ /project/climacs/cvsroot/climacs/climacs-lisp-syntax-commands.lisp 2008/01/23 18:17:05 1.10 @@ -139,6 +139,11 @@ (presentation) (list (presentation-object presentation))) +(define-command (com-edit-definition :name t :command-table climacs-lisp-table) + ((symbol 'symbol)) + "Edit definition of the symbol." + (edit-definition symbol)) + (define-command (com-edit-this-definition :command-table climacs-lisp-table) () "Edit definition of the symbol at point. --- /project/climacs/cvsroot/climacs/climacs.lisp 2006/11/12 16:06:06 1.4 +++ /project/climacs/cvsroot/climacs/climacs.lisp 2008/01/23 18:17:05 1.5 @@ -30,21 +30,25 @@ (in-package :climacs) -(defun climacs (&key new-process (process-name "Climacs") +(defun find-climacs-frame () + (let ((frame-manager (find-frame-manager))) + (when frame-manager + (find-if (lambda (x) (and (typep x 'climacs) + (eq (clim:frame-state x) :enabled))) + (frame-manager-frames frame-manager))))) + +(defun climacs (&rest args &key new-process (process-name "Climacs") (width 900) (height 400)) "Starts up a climacs session" - (let ((frame (make-application-frame 'climacs :width width :height height))) - (flet ((run () - (run-frame-top-level frame))) - (if new-process - (clim-sys:make-process #'run :name process-name) - (run))))) + (declare (ignore new-process process-name width height)) + (apply #'climacs-common nil args)) -(defun climacs-rv (&key new-process (process-name "Climacs") - (width 900) (height 400)) +(defun climacs-rv (&rest args &key new-process (process-name "Climacs") + (width 900) (height 400)) "Starts up a climacs session with alternative colors." ;; SBCL doesn't inherit dynamic bindings when starting new ;; processes, so start a new processes and THEN setup the colors. + (declare (ignore width height)) (flet ((run () (let ((*background-color* +black+) (*foreground-color* +gray+) @@ -52,7 +56,45 @@ (*info-fg-color* +gray+) (*mini-bg-color* +black+) (*mini-fg-color* +white+)) - (climacs :new-process nil :width width :height height)))) + (apply #'climacs-common nil :new-process nil args)))) (if new-process - (clim-sys:make-process #'run :name process-name) - (run)))) + (clim-sys:make-process #'run :name process-name) + (run)))) + +(defun edit-file (thing &rest args + &key (process-name "Climacs") (width 900) (height 400)) + "Edit THING in an existing climacs process or start a new one. THING +can be a filename (edit the file) or symbol (edit its function definition)." + (declare (ignore process-name width height)) + (let ((climacs-frame (find-climacs-frame)) + (command + (typecase thing + (null nil) + (symbol (list 'drei-lisp-syntax::com-edit-definition thing)) + ((or string pathname) + (truename thing) ; raise file-error if file doesn't exist + (list 'esa-io::com-find-file thing)) + (t (error 'type-error :datum thing + :expected-type '(or null string pathname symbol)))))) + (if climacs-frame + (execute-frame-command climacs-frame command) + (apply #'climacs-common command :new-process t args))) + t) + +(defun climacs-common (command &key new-process (process-name "Climacs") + (width 900) (height 400)) + (let* ((frame (make-application-frame 'climacs :width width :height height)) + (*application-frame* frame) + (esa:*esa-instance* frame)) + (adopt-frame (find-frame-manager) *application-frame*) + (when command (execute-frame-command *application-frame* command)) + (flet ((run () (run-frame-top-level frame))) + (if new-process + (clim-sys:make-process #'run :name process-name) + (run))))) + +;;; Append to end of *ed-functions* so we don't overwrite the user's +;;; preferred editor +#+sbcl +(unless (member 'edit-file sb-ext:*ed-functions*) + (setf sb-ext:*ed-functions* (append sb-ext:*ed-functions* (list 'edit-file)))) --- /project/climacs/cvsroot/climacs/packages.lisp 2008/01/21 17:19:34 1.135 +++ /project/climacs/cvsroot/climacs/packages.lisp 2008/01/23 18:17:05 1.136 @@ -199,5 +199,6 @@ (:use :clim-lisp :clim :clim-sys :clim-extensions :climacs-gui :drei) (:export #:climacs #:climacs-rv - #:edit-definition) + #:edit-definition + #:edit-file) (:documentation "Package containing entry points to Climacs.")) \ No newline at end of file --- /project/climacs/cvsroot/climacs/typeout.lisp 2008/01/21 17:08:48 1.3 +++ /project/climacs/cvsroot/climacs/typeout.lisp 2008/01/23 18:17:05 1.4 @@ -111,7 +111,7 @@ "Call `continuation' with a single argument, a stream meant for typeout. `Climacs' is the Climacs instance in which the typeout pane should be shown, and `label' is the name -of the created typeout view." +of the created typeout view. Returns NIL." (let* ((typeout-view (ensure-typeout-view climacs label)) (pane-with-typeout (or (find typeout-view (windows climacs) :key #'view) @@ -127,7 +127,8 @@ (setf (last-cursor-position typeout-view) (multiple-value-list (stream-cursor-position pane-with-typeout))))))) (add-output-record new-record (output-history typeout-view)) - (setf (dirty typeout-view) t)))) + (setf (dirty typeout-view) t) + nil))) (defmacro with-typeout ((stream &optional (label "Typeout")) &body body) "Evaluate `body' with `stream' bound to a stream that can be

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

climacs-cvs