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

Modified Files: swine.lisp climacs.lisp Log Message: Added translators and commands to only lookup some definitions of a symbol (eg, a class definition) and cleaned the rest of the cross-application Climacs calling code.

--- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/31 18:01:04 1.17 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/06/01 19:59:11 1.18 @@ -1005,13 +1005,31 @@ (climacs-gui::goto-position (point (climacs-gui::current-window)) offset)) (pop-find-definition-stack)))))

-(defun edit-definition (symbol) - (let ((definitions (find-definitions-for-climacs symbol))) - (cond ((null definitions) - (climacs-gui::display-message "No known definitions for: ~A" symbol) - (beep)) - (t - (goto-definition symbol definitions))))) +;; KLUDGE: We need to put more info in the definition objects to begin with. +(defun definition-type (definition) + (let ((data (read-from-string (first definition)))) + (case (first data) + ((or cl:defclass) + 'cl:class) + ((or cl:defgeneric + cl:defmethod + cl:defun + cl:defmacro) + 'cl:function) + (t t)))) + +(defun edit-definition (symbol &optional type) + (let ((all-definitions (find-definitions-for-climacs symbol))) + (let ((definitions (if (not type) + all-definitions + (remove-if-not #'(lambda (definition) + (eq (definition-type definition) type)) + all-definitions)))) + (cond ((null definitions) + (climacs-gui::display-message "No known definitions for: ~A" symbol) + (beep)) + (t + (goto-definition symbol definitions))))))

;; XXX, get Swine into Climacs proper. (export 'edit-definition) --- /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/05/31 11:11:08 1.9 +++ /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/06/01 19:59:11 1.10 @@ -29,6 +29,8 @@ 'base-table '((#\c :control) (#\d :control) (#\s :control)))

+;; The following code relates to calling Climacs from other applications. + (defmacro with-climacs-frame ((frame-symbol) &body body) (let ((frame-manager-sym (gensym))) `(let ((,frame-manager-sym (find-frame-manager))) @@ -46,14 +48,14 @@ ;; FIXME: The new frame must be ready, this is a hack. (sleep 1))))

-(defgeneric edit-in-climacs (thing) +(defgeneric edit-in-climacs (thing &key &allow-other-keys) (:documentation "Edit thing in Climacs, start Climacs if is not - running.") - (:method :before (thing) - (declare (ignore thing)) - (ensure-climacs))) + running.") + (:method :before (thing &key &allow-other-keys) + (declare (ignore thing)) + (ensure-climacs)))

-(defmethod edit-in-climacs ((thing pathname)) +(defmethod edit-in-climacs ((thing pathname) &key &allow-other-keys) (when (wild-pathname-p thing) (error 'file-error :pathname thing "Cannot edit wild pathname.")) @@ -62,15 +64,35 @@ (execute-frame-command frame `(com-find-file ,thing)))))

-(defmethod edit-in-climacs ((thing string)) +(defmethod edit-in-climacs ((thing string) &key &allow-other-keys) ;; Hope it is a pathname. (edit-in-climacs (pathname thing)))

-(defmethod edit-in-climacs ((thing symbol)) +(defmethod edit-in-climacs ((thing symbol) &key type &allow-other-keys) (with-climacs-frame (frame) (when frame (execute-frame-command - frame `(com-edit-definition ,thing))))) + frame `(com-edit-definition-of-type ,thing ,type))))) + +;; These commands should only be called from within Climacs: + +(define-command (com-edit-definition :name t :command-table global-climacs-table) + ((symbol 'symbol + :prompt "Edit symbol")) + "Edit the definition of a symbol as a given type. + +If the symbol has been defined more than once (eg. to a function +as well as a class, or as numerous methods), a +mouse-click-sensitive list of available definitions will be +displayed." + (climacs-lisp-syntax:edit-definition symbol)) + +(define-command (com-edit-definition-of-type :name t :command-table global-climacs-table) + ((symbol 'symbol + :prompt "Edit symbol") + (type 'symbol)) + "Edit the definition of a symbol as a given type." + (climacs-lisp-syntax:edit-definition symbol type))

;; Redefine (ed) (handler-bind ((#+sbcl sb-ext:package-lock-violation @@ -87,40 +109,50 @@ (with-climacs-frame (frame) (raise-frame frame))))))

-(define-command (com-edit-definition :name t :command-table global-climacs-table) +;; The following commands can be safely called from outside Climacs: + +(define-command (com-edit-class-definition :name t :command-table global-command-table) ((symbol 'symbol :prompt "Edit symbol")) - "Edit the definition of a symbol. + "Edit the class definition of a symbol." + (edit-in-climacs symbol :type 'class))

-If the symbol has been defined more than once (eg. to a function -as well as a class, or as numerous methods), a -mouse-click-sensitive list of available definitions will be -displayed." - (climacs-lisp-syntax:edit-definition symbol)) +(define-command (com-edit-function-definition :name t :command-table global-command-table) + ((symbol 'symbol + :prompt "Edit symbol")) + "Edit the function definition of a symbol." + (edit-in-climacs symbol :type 'function))

(define-command (com-edit-in-climacs :command-table global-command-table) ((thing t)) (edit-in-climacs thing))

-(define-presentation-to-command-translator global-edit-symbol-definition - (symbol com-edit-in-climacs global-command-table +(define-presentation-to-command-translator global-edit-symbol-definition-translator + (symbol com-edit-definition global-command-table :tester ((object presentation) (declare (ignore object)) - (not (eq (presentation-type presentation) 'unknown-symbol))) + (and (not (eq (presentation-type presentation) 'unknown-symbol)))) :gesture :edit :documentation "Edit Definition") (object) (list object))

-(define-presentation-to-command-translator global-edit-command-name-definition - (command-name com-edit-in-climacs global-command-table +(define-presentation-to-command-translator global-edit-class-name-definition-translator + (class-name com-edit-class-definition global-command-table + :gesture :edit + :documentation "Edit Class Definition") + (object) + (list object)) + +(define-presentation-to-command-translator global-edit-command-name-definition-translator + (command-name com-edit-function-definition global-command-table :gesture :edit :documentation "Edit Definition Of Command") (object) (list object))

-(define-presentation-to-command-translator global-edit-command-definition - (command com-edit-in-climacs global-command-table +(define-presentation-to-command-translator global-edit-command-definition-translator + (command com-edit-function-definition global-command-table :gesture :edit :documentation "Edit Definition Of Command") (object)