Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv14851

Modified Files: climacs.lisp Log Message: Cooler `ed' - now also handles symbols, and an Edit Definition translator is now globally accessible in all CLIM applications when running CLIM-Desktop.

--- /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/05/20 18:41:27 1.5 +++ /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/05/30 21:50:40 1.6 @@ -54,22 +54,74 @@ 'base-table '((#\c :control) (#\d :control) (#\s :control)))

-(defun climacs-edit (file &key (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))) - (let ((clim-process (clim-sys:make-process #'run :name (format nil "Climacs: ~A" file)))) - (sleep 1) - (execute-frame-command frame `(com-find-file ,file)))))) +(defmacro with-climacs-frame ((frame-symbol) &body body) + (let ((frame-manager-sym (gensym))) + `(let ((,frame-manager-sym (find-frame-manager))) + (when ,frame-manager-sym + (let ((,frame-symbol (find-if (lambda (x) (typep x 'climacs)) + (frame-manager-frames ,frame-manager-sym)))) + ,@body)))))

+(defun ensure-climacs () + "Ensure Climacs is running, start it in a new process if it +isn't." + (with-climacs-frame (frame) + (unless frame + (climacs :new-process t) + ;; FIXME: The new frame must be ready, this is a hack. + (sleep 1)))) + +(defgeneric edit-in-climacs (thing) + (:documentation "Edit thing in Climacs, start Climacs if is not + running.") + (:method :before (thing) + (declare (ignore thing)) + (ensure-climacs))) + +(defmethod edit-in-climacs ((thing pathname)) + (when (wild-pathname-p thing) + (error 'file-error :pathname thing + "Cannot edit wild pathname.")) + (with-climacs-frame (frame) + (when frame + (execute-frame-command + frame `(com-find-file ,thing))))) + +(defmethod edit-in-climacs ((thing string)) + ;; Hope it is a pathname. + (edit-in-climacs (pathname thing))) + +(defmethod edit-in-climacs ((thing symbol)) + (with-climacs-frame (frame) + (when frame + (execute-frame-command + frame `(com-edit-definition ,thing)))))

;; Redefine (ed) (handler-bind ((#+sbcl sb-ext:package-lock-violation #+cmucl lisp::package-locked-error #-sbcl simple-error #'(lambda (c) + (declare (ignore c)) (invoke-restart 'continue)))) - (defun ed (foo) - (climacs-edit foo))) + (defun ed (&optional foo) + (if (not (null foo)) + (edit-in-climacs foo) + (progn + (ensure-climacs) + (with-climacs-frame (frame) + (raise-frame frame)))))) + +(define-command (com-edit-in-climacs :command-table global-command-table) + ((thing t)) + (edit-in-climacs thing))

+(define-presentation-to-command-translator global-edit-definition + (symbol com-edit-in-climacs global-command-table + :gesture :select + :tester ((object presentation) + (declare (ignore object)) + (not (eq (presentation-type presentation) 'unknown-symbol))) + :documentation "Edit definition") + (object) + (list object)) \ No newline at end of file