[mcclim-devel] file-browser example application

[Robert Goldman]

Andy Hefner wrote:
> On 1/5/07, Robert Goldman <rpgoldman at real-time.com> wrote:
>> I am attaching a patch which makes it work (if the patch about pathname
>> presentations, that I sent earlier today, is also present).
> 
> Did you forget to attach the patch?

Argh.  Yes.  I *always* do that!  [I note that kmail actually scans your
email and if you say "attach" anywhere in it, and there's no attachment,
it prompts you before sending...].  I will attach here
> 
>> The downside is that CL pathnames are so intractable that the only good
>> way I found to make this work was to use CL-FAD.
> 
> I hate pathnames. Even for something as seemingly trivial as Show
> Directory in the listener, they turned into an unpredictable,
> unportable mess. I vowed not to use them as the primary representation
> in the event I ever get around to adding serious shell-like features
> to the listener.

Yes, unpredictable, unportable mess.  That's the original file-browser
in a nutshell...
> 
>> BTW, I think a more elegant solution might be made that would use
>> satisfies to define the dir-pathname presentation-type more
>> declaratively.  But I couldn't figure out how to do it...
> 
> Good idea. '(and pathname (satisfies my-directory-p)) doesn't do it?

Didn't for me, and I didn't have the foggiest idea how to debug it once
it didn't....  Probably there's some way to mouse over something on the
screen and figure out what kind of presentation it is?  [Garnet had an
integrated debugger for which I was often very grateful; I don't really
have a clue how to debug CLIM yet...]

Probably for someone who groks the relationship of presentation objects
and objects presented, this will be more obvious.  I tried
'(and pathname (satisfies cl-fad:directory-pathname-p)) and nothing
worked.  But perhaps I made some simple error.

BTW, the code itself is so short that I will attach it, as well.  Might
be easier to look at that than to read the patch.


-------------- next part --------------
A non-text attachment was scrubbed...
Name: file-browser.patch
Type: text/x-patch
Size: 3032 bytes
Desc: not available
Url : http://common-lisp.net/pipermail/mcclim-devel/attachments/20070105/c544f9bc/file-browser-0001.bin
-------------- next part --------------
(eval-when (:compile-toplevel)
  (asdf:oos 'asdf:load-op :clim)
  (asdf:oos 'asdf:load-op :clim-clx))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (asdf:oos 'asdf:load-op :cl-fad))

(in-package :clim-user)

; LTAG-start:file-browser-all
(define-application-frame file-browser ()
  ((active-files :initform nil :accessor active-files))
  (:panes
   (file-browser :application
		 :display-function '(dirlist-display-files)
		 ;; Call the display-function whenever the command
		 ;; loop makes a ``full-cycle''
		 :display-time :command-loop)
   (interactor :interactor))
  (:layouts (default (vertically ()
				 file-browser
				 interactor))))

(define-presentation-type dir-pathname ()
  :inherit-from 'pathname)

(defmethod dirlist-display-files ((frame file-browser) pane)
  ;; Clear old displayed entries
  (clear-output-record (stream-output-history pane))

  (dolist (file (active-files frame))
    ;; Instead of write-string, we use present so that the link to
    ;; object file and the semantic information that file is
    ;; pathname is retained.
    (present file 
	     (if (cl-fad:directory-pathname-p file) 'dir-pathname 'pathname)
	     :stream pane)
    (terpri pane)))

(define-file-browser-command (com-edit-directory :name "Edit Directory")
  ((dir 'dir-pathname))
  ;; the following was a previous attempt to deal with the oddities of
  ;; CL pathnames.  Unfortunately, it does not work properly with all
  ;; lisp implementations.  Because of these oddities, we really need
  ;; a layer like cl-fad to keep things straight. [2007/01/05:rpg]
;;;  (let ((dir (make-pathname :directory (pathname-directory dir)
;;;			    :name :wild :type :wild :version :wild
;;;			    :defaults dir)))
    (setf (active-files *application-frame*)
	  (cl-fad:list-directory dir)))

(define-presentation-to-command-translator pathname-to-edit-command
    (dir-pathname                       ; source presentation-type
     com-edit-directory                 ; target-command
     file-browser                       ; command-table
     :gesture :select                   ; use this translator for pointer clicks
     :documentation "Edit this path")   ; used in context menu
    (object)                            ; argument List
    (list object))                        ; arguments for target-command

(define-file-browser-command (com-quit :name t) ()
  (frame-exit *application-frame*)
  )

(defmethod adopt-frame :after (frame-manager (frame file-browser))
  (declare (ignore frame-manager))
  (execute-frame-command frame
	`(com-edit-directory ,(make-pathname :directory '(:absolute)))))

; LTAG-end