[mcclim-cvs] CVS mcclim/Apps/Listener

[rschlatte]

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener
In directory clnet:/tmp/cvs-serv30427/Apps/Listener

Modified Files:
	dev-commands.lisp 
Log Message:
Multiple context-menu commands for text files: Edit, Show

Also, activate code for showing file in a separate window


--- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp	2008/01/18 06:54:50	1.46
+++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp	2008/01/26 05:09:39	1.47
@@ -1285,11 +1285,7 @@
              (mv-or
               (when mime-type (mime-type-to-command mime-type pathname))
               (when command
-                (values command doc pointer-doc))
-              (when (and mime-type (subtypep mime-type 'text))
-                (values `(com-edit-file ,pathname)
-                        "Edit File"
-                        (format nil "Edit ~A" pathname))) ))))))
+                (values command doc pointer-doc))))))))
 
 (define-presentation-translator automagic-pathname-translator
   (clim:pathname clim:command filesystem-commands
@@ -1399,9 +1395,6 @@
   ((pathname 'pathname  :prompt "pathname"))
   (clim-sys:make-process (lambda () (ed pathname))))
 
-;; Leave this translator disabled for now, the automagic translator will now produce
-;; com-edit-file where there is not a more specific handler for a text mime type.
-#+IGNORE
 (define-presentation-to-command-translator edit-file
   (clim:pathname com-edit-file filesystem-commands :gesture :select
 		 :pointer-documentation ((object stream)
@@ -1410,7 +1403,9 @@
 		 :tester ((object)
 			  (and (not (wild-pathname-p object))
                                (probe-file object)
-                               (pathname-name object))))
+                               (pathname-name object)
+                               (let ((mime-type (pathname-mime-type object)))
+                                 (and mime-type (subtypep mime-type 'text))))))
   (object)
   (list object))
 
@@ -1420,6 +1415,20 @@
   ((object 'pathname :prompt "pathname"))
   (show-file object))
 
+(define-presentation-to-command-translator show-file
+  (clim:pathname com-show-file filesystem-commands :gesture :select
+		 :pointer-documentation ((object stream)
+					 (format stream "Show ~A" object))
+		 :documentation ((stream) (format stream "Show File"))
+		 :tester ((object)
+			  (and (not (wild-pathname-p object))
+                               (probe-file object)
+                               (pathname-name object)
+                               (let ((mime-type (pathname-mime-type object)))
+                                 (and mime-type (subtypep mime-type 'text))))))
+  (object)
+  (list object))
+
 (define-command (com-display-image :name t :command-table filesystem-commands
                                            :menu t)
     ((image-pathname 'pathname
@@ -1448,10 +1457,8 @@
   (list object))
 		   
 
-;; CLIM:OPEN-WINDOW-STREAM seems to be broken.
-;; Less broken since I hacked on it, but still bad..
 (defun show-file (pathname)
-  (let ( #+ignore(*standard-output* (open-window-stream :scroll-bars :both)) )
+  (let ((*standard-output* (open-window-stream :scroll-bars :both)) )
     (with-open-file (in pathname)
       (loop for line = (read-line in nil)
 	while line