/[mcclim]/mcclim/Doc/Guided-Tour/file-browser.lisp-type-abbrev
ViewVC logotype

Contents of /mcclim/Doc/Guided-Tour/file-browser.lisp-type-abbrev

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Tue Jan 9 03:28:19 2007 UTC (7 years, 3 months ago) by rgoldman
Branch: MAIN
CVS Tags: McCLIM-0-9-5, McCLIM-0-9-4, McCLIM-0-9-6, mcclim-0-9-4, HEAD
Alternative version of file-browser, more elegant, but relies on features not working yet in McCLIM.
1 (eval-when (:compile-toplevel)
2 (asdf:oos 'asdf:load-op :clim)
3 (asdf:oos 'asdf:load-op :clim-clx))
4
5 (eval-when (:compile-toplevel :load-toplevel :execute)
6 (asdf:oos 'asdf:load-op :cl-fad))
7
8 (in-package :clim-user)
9
10 ; LTAG-start:file-browser-all
11 (define-application-frame file-browser ()
12 ((active-files :initform nil :accessor active-files))
13 (:panes
14 (file-browser :application
15 :display-function '(dirlist-display-files)
16 ;; Call the display-function whenever the command
17 ;; loop makes a ``full-cycle''
18 :display-time :command-loop)
19 (interactor :interactor))
20 (:layouts (default (vertically ()
21 file-browser
22 interactor))))
23
24 (define-presentation-type-abbreviation dir-pathname ()
25 '((and pathname (satisfies cl-fad:directory-pathname-p)) :description "Directory"))
26
27 (defmethod dirlist-display-files ((frame file-browser) pane)
28 ;; Clear old displayed entries
29 (clear-output-record (stream-output-history pane))
30
31 (dolist (file (active-files frame))
32 ;; Instead of write-string, we use present so that the link to
33 ;; object file and the semantic information that file is
34 ;; pathname is retained.
35 (present file 'pathname
36 ;; (if (cl-fad:directory-pathname-p file) 'dir-pathname 'pathname)
37 :stream pane)
38 (terpri pane)))
39
40 ;;; shouldn't this bletch if it is given an argument that is a
41 ;;; well-formed directory name, but for a directory that doesn't
42 ;;; exist? cl-fad:directory-exists-p is relevant
43 ;;; here... [2007/01/07:rpg]
44 (define-file-browser-command (com-edit-directory :name "Edit Directory")
45 ((dir 'dir-pathname))
46 ;; the following was a previous attempt to deal with the oddities of
47 ;; CL pathnames. Unfortunately, it does not work properly with all
48 ;; lisp implementations. Because of these oddities, we really need
49 ;; a layer like cl-fad to keep things straight. [2007/01/05:rpg]
50 ;;; (let ((dir (make-pathname :directory (pathname-directory dir)
51 ;;; :name :wild :type :wild :version :wild
52 ;;; :defaults dir)))
53 (setf (active-files *application-frame*)
54 (cl-fad:list-directory dir)))
55
56 (define-presentation-to-command-translator pathname-to-edit-command
57 ((and pathname (satisfies cl-fad:directory-pathname-p)) ; source presentation-type
58 com-edit-directory ; target-command
59 file-browser ; command-table
60 :gesture :select ; use this translator for pointer clicks
61 :documentation "Edit this path") ; used in context menu
62 (object) ; argument List
63 (list object)) ; arguments for target-command
64
65 (define-file-browser-command (com-quit :name t) ()
66 (frame-exit *application-frame*)
67 )
68
69 (defmethod adopt-frame :after (frame-manager (frame file-browser))
70 (declare (ignore frame-manager))
71 (execute-frame-command frame
72 `(com-edit-directory ,(make-pathname :directory '(:absolute)))))
73
74 ; LTAG-end

  ViewVC Help
Powered by ViewVC 1.1.5