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