[clim-desktop-cvs] CVS clim-desktop

[thenriksen]

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))))
+          , at 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