Andy Hefner wrote:
On 1/5/07, Robert Goldman rpgoldman@real-time.com wrote:
[...snip...]
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?
I made a stab at it, but no, it didn't seem to work. I am attaching two different versions of the file-browser: one that works, using a new presentation-type, dir-pathname, and one that tries to do the job with (and pathname (satisfies cl-fad:directory-pathname-p)), that doesn't work.
Probably there's some simple idiocy I've committed that makes this not work, either a bug, or a misunderstanding of presentation types and the relationship between presentation and the presented object. If anyone can correct this, I will appreciate it, and will see to it that the answer, duly credited, appears in the Guided-Tour paper, to enlighten future seekers after CLIMmy wisdom.
Best, R
(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 'pathname ;; (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 '(and pathname (satisfies cl-fad:directory-pathname-p)))) ;; 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 ((and pathname (satisfies cl-fad:directory-pathname-p)) ; 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
(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