[clim-desktop-cvs] CVS clim-desktop

[thenriksen]

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)