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)
