PA> Just in case anyone is doing the same... PA> PA> I'm currently hacking an X implementation of the tree-view widget. PA> This uses tree widget code donated by Glynn Clements. PA> PA> Don't expect anything too soon - I've only just got my guts around the PA> lwlib stuff. :-/ would that be like the tree-dir stuff Jens L. did some time ago? something I've long wished for was something like the hierarchical folder view that MUAs like Netscape Messenger, Eudora, and others have for use with the momma-MUA (wasn't that an Abba song?), VM -- John A. Turner, Ph.D. Senior Research Associate Blue Sky Studios, 44 S. Broadway, White Plains, NY 10601 http://www.blueskystudios.com/ (914) 259-6319

PA> Don't know, can you point me in a direction? PA> PA> I'm just planning to provide support for the tree-view glyph under X, PA> matching the msw support. as Jens mentioned, your implementation will be quite different nevertheless, I've attached the last version I have of Jens' famous treedir so you can see for yourself... -JT ;;; TreeDir. Display a graphical tree of directories (c) 1997 Jens Lautenbacher ;;; ;;; Version: 0.3 for XEmacs 19.15 or higher (may work with 19.1[34], too) ;;; ;;; Synced up with: Not in FSF Emacs ;;; ;;; This file is not yet part of XEmacs, but the same license applies. ;;; ;;; XEmacs is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 2, or (at your option) ;;; any later version. ; ;;; XEmacs is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ; ;;; You should have received a copy of the GNU General Public License ;;; along with XEmacs; see the file COPYING. If not, write to the ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307, USA. ;;; ;;; Comments: This is really alpha code. I'm still struggeling with extents ;;; and their start-open, end-open and others of their damned properties. ;;; ;;; (require 'atomic-extents) (defgroup treedir nil "Display directories as a graphical tree display" :group 'dired) (defface treedir-tree-face '((((class color)) (:foreground blue))) "Face used for the tree structure elements" :group 'treedir) (defface treedir-folder-face '((((class color)) (:bold t))) "Face used for the tree folder elements" :group 'treedir) (defface treedir-dir-face '((((class color)) (:foreground "seagreen"))) "Face used for the shown (not selected) directories." :group 'treedir) (defface treedir-dir-selected-face '((((class color)) (:foreground "red" :bold t))) "Face used for the selected directories" :group 'treedir) (defface treedir-dir-cursor-face '((((class color)) (:underline t))) "Face used for the directories under the \"cursor\"" :group 'treedir) (defcustom treedir-display-with-subdir-scan t "Set this to nil to speed up the display of the tree. This will inhibit the scan for existing subdirs and will therefor not display `+' or `-' signs in the folder glyphs." :type 'boolean :group 'treedir) (defcustom treedir-display-subdir-on-display-dir t "Set this to nil to inhibit the expanding of the subdirs when displaying the selected directory in dired." :type 'boolean :group 'treedir) (defvar treedir-graphical (and (eq window-system 'x) (featurep 'xpm))) (defvar treedir-glyph-dir (concat data-directory "treedir/")) (defvar treedir-folder-glyph (make-glyph (if treedir-graphical (concat treedir-glyph-dir "folder.xpm") "[ ]"))) (set-glyph-face treedir-folder-glyph 'treedir-folder-face) (defvar treedir-folder-plus-glyph (make-glyph (if treedir-graphical (concat treedir-glyph-dir "folder+.xpm") "[+]"))) (set-glyph-face treedir-folder-plus-glyph 'treedir-folder-face) (defvar treedir-folder-minus-glyph (make-glyph (if treedir-graphical (concat treedir-glyph-dir "folder-.xpm") "[-]"))) (set-glyph-face treedir-folder-minus-glyph 'treedir-folder-face) (defvar treedir-folder-none-glyph (make-glyph (if treedir-graphical (concat treedir-glyph-dir "folder-no.xpm") "[?]"))) (set-glyph-face treedir-folder-none-glyph 'treedir-folder-face) (defvar treedir-branch-glyph (make-glyph (if treedir-graphical (concat treedir-glyph-dir "branch.xpm") " |-"))) (set-glyph-face treedir-branch-glyph 'treedir-tree-face) (defvar treedir-line-glyph (make-glyph (if treedir-graphical (concat treedir-glyph-dir "line.xpm") " | "))) (set-glyph-face treedir-line-glyph 'treedir-tree-face) (defvar treedir-corner-glyph (make-glyph (if treedir-graphical (concat treedir-glyph-dir "corner.xpm") " `-"))) (set-glyph-face treedir-corner-glyph 'treedir-tree-face) (defvar treedir-empty-glyph (make-glyph (if treedir-graphical (concat treedir-glyph-dir "empty.xpm") " "))) (defvar treedir-map nil) (defvar treedir-selected-folder nil) (defvar treedir-buffer nil) (defvar treedir-at-folder-ext nil) (defvar treedir-before-folder-ext nil) (defvar treedir-after-folder-ext nil) ;; these three guys are more or less stolen from annotation.el and ;; modified to fit in our scheme were all three buttons should trigger ;; actions (defun treedir-activate-function-button1 (event) (interactive "e") (let ((extent (event-glyph-extent event)) (mouse-down t) (up-glyph nil)) ;; make the glyph look pressed (cond ((annotation-down-glyph extent) (setq up-glyph (annotation-glyph extent)) (set-annotation-glyph extent (annotation-down-glyph extent)))) (while mouse-down (setq event (next-event event)) (if (button-release-event-p event) (setq mouse-down nil))) ;; make the glyph look released (cond ((annotation-down-glyph extent) (set-annotation-glyph extent up-glyph))) (if (eq extent (event-glyph-extent event)) (if (extent-property extent 'treedir-action1) (funcall (extent-property extent 'treedir-action1) extent))))) (defun treedir-activate-function-button2 (event) (interactive "e") (let ((extent (event-glyph-extent event)) (mouse-down t) (up-glyph nil)) ;; make the glyph look pressed (cond ((annotation-down-glyph extent) (setq up-glyph (annotation-glyph extent)) (set-annotation-glyph extent (annotation-down-glyph extent)))) (while mouse-down (setq event (next-event event)) (if (button-release-event-p event) (setq mouse-down nil))) ;; make the glyph look released (cond ((annotation-down-glyph extent) (set-annotation-glyph extent up-glyph))) (if (eq extent (event-glyph-extent event)) (if (extent-property extent 'treedir-action2) (funcall (extent-property extent 'treedir-action2) extent))))) (defun treedir-activate-function-button3 (event) (interactive "e") (let ((extent (event-glyph-extent event)) (mouse-down t) (up-glyph nil)) ;; make the glyph look pressed (cond ((annotation-down-glyph extent) (setq up-glyph (annotation-glyph extent)) (set-annotation-glyph extent (annotation-down-glyph extent)))) (while mouse-down (setq event (next-event event)) (if (button-release-event-p event) (setq mouse-down nil))) ;; make the glyph look released (cond ((annotation-down-glyph extent) (set-annotation-glyph extent up-glyph))) (if (eq extent (event-glyph-extent event)) (if (extent-property extent 'action3) (funcall (extent-property extent 'treedir-action3) extent))))) (defun treedir-insert-line-glyph () (let (ext) (setq ext (make-annotation treedir-line-glyph nil 'text nil nil treedir-line-glyph nil)) (set-extent-property ext 'end-open t))) (defun treedir-insert-corner-glyph () (let (ext) (setq ext (make-annotation treedir-corner-glyph nil 'text nil nil treedir-corner-glyph nil)) (set-extent-property ext 'end-open t))) (defun treedir-insert-branch-glyph () (let (ext) (setq ext (make-annotation treedir-branch-glyph nil 'text nil nil treedir-branch-glyph nil)) (set-extent-property ext 'end-open t))) (defun treedir-insert-empty-glyph () (let (ext) (setq ext (make-annotation treedir-empty-glyph nil 'text nil nil treedir-empty-glyph nil)) (set-extent-property ext 'end-open t))) (defun treedir-prepare-for-dir-level (spez &optional last) (let ((flag (treedir-buffer-read-only-p)) elem) (if flag (treedir-read-write)) (end-of-line) (insert-string "\n ") (if spez (while (setq elem (pop spez)) (if (eq elem 1) (treedir-insert-line-glyph) (treedir-insert-empty-glyph)))) (if last (treedir-insert-corner-glyph) (treedir-insert-branch-glyph)) (if flag (treedir-read-only)))) (defun treedir-get-sub-directories (dir-or-folder &optional no-sort) (let* ((dir (if (extentp dir-or-folder) (extent-property dir-or-folder 'treedir-dirname) dir-or-folder)) (list (if (file-accessible-directory-p dir) (directory-files dir nil nil no-sort 'dir))) result elem) (while (setq elem (pop list)) (if (and (not (equal elem "..")) (not (equal elem "."))) (push elem result))) (reverse result))) (defun treedir-insert-subdirs (ext) (let* ((subdirs (treedir-get-sub-directories (extent-property ext 'treedir-dirname))) (length (length subdirs)) (pos (extent-start-position ext)) (i 1) elem last) (goto-char pos) (end-of-line) (while (setq elem (pop subdirs)) (if (= i length) (setq last t)) (treedir-prepare-for-dir-level (extent-property ext 'treedir-spez) last) (treedir-create-folder elem ext last) (setq i (1+ i))) (goto-char pos))) (defun treedir-create-folder (name &optional parent last) (let* ((flag (treedir-buffer-read-only-p)) (treedir-text (directory-file-name name)) ext treedir-dirname treedir-spez) (if flag (treedir-read-write)) (setq ext (make-annotation nil nil 'text nil nil nil nil)) (if (not parent) (setq treedir-dirname (file-name-as-directory name) treedir-spez nil last t) (setq treedir-dirname (concat (extent-property parent 'treedir-dirname) (file-name-as-directory name)) treedir-spez (if last (append (extent-property parent 'treedir-spez) '(0)) (append (extent-property parent 'treedir-spez) '(1)))) (push ext (extent-property parent 'treedir-child-list))) (set-extent-property ext 'treedir-dirname treedir-dirname) (set-extent-property ext 'treedir-spez treedir-spez) (set-extent-property ext 'treedir-parent parent) (set-extent-property ext 'treedir-action1 'treedir-action1) (set-extent-property ext 'treedir-action2 'treedir-action2) (set-extent-property ext 'treedir-action3 'treedir-action3) (set-extent-property ext 'treedir-hidden t) (set-extent-property ext 'end-open t) (set-extent-property ext 'treedir-last last) (set-extent-property ext 'treedir-child-list nil) (set-extent-property ext 'treedir-text treedir-text) (set-extent-property ext 'treedir-text-extent (treedir-show-folder-name ext)) (treedir-update-folder-glyph ext) (if flag (treedir-read-only)) ext)) (defun treedir-update-folder-glyph (ext) (let* ((dirname (extent-property ext 'treedir-dirname)) (subp (if treedir-display-with-subdir-scan (treedir-get-sub-directories dirname 'no-sort))) (accessp (file-accessible-directory-p dirname)) (hiddenp (extent-property ext 'treedir-hidden))) (if (not accessp) (progn (set-annotation-glyph ext treedir-folder-none-glyph) (set-annotation-down-glyph ext treedir-folder-none-glyph)) (if (not subp) (progn (set-annotation-glyph ext treedir-folder-glyph) (set-annotation-down-glyph ext treedir-folder-glyph)) (if hiddenp (progn (set-annotation-glyph ext treedir-folder-plus-glyph) (set-annotation-down-glyph ext treedir-folder-plus-glyph)) (set-annotation-glyph ext treedir-folder-minus-glyph) (set-annotation-down-glyph ext treedir-folder-minus-glyph)))))) (defun treedir-show-folder-name (ext) (let ((flag (treedir-buffer-read-only-p)) text-ext point) (if flag (treedir-read-write)) (insert-string " ") (setq point (point)) (insert-string (extent-property ext 'treedir-text)) (setq text-ext (make-extent point (point))) (set-extent-face text-ext 'treedir-dir-face) (set-extent-property text-ext 'folder-ext ext) (set-extent-property text-ext 'start-open t) (set-extent-property text-ext 'highlight t) (if flag (treedir-read-only)) text-ext)) (defun treedir-action2 (ext) (pop-to-buffer treedir-buffer) (save-selected-window (if treedir-display-subdir-on-display-dir (treedir-action1 ext 'only-unhide)) (dired-other-window (extent-property ext 'treedir-dirname)) (if treedir-selected-folder (set-extent-face (extent-property treedir-selected-folder 'treedir-text-extent) 'treedir-dir-face)) (setq treedir-selected-folder ext) (set-extent-face (extent-property ext 'treedir-text-extent) 'treedir-dir-selected-face))) (defun treedir-action1 (ext &optional only-unhide) (pop-to-buffer treedir-buffer) (save-selected-window (if (extent-property ext 'treedir-hidden) (treedir-unhide-folder ext) (if (not only-unhide) (treedir-rehide-folder ext))) (goto-char (extent-start-position ext)))) (defun treedir-unhide-folder (ext) (if (treedir-get-sub-directories ext 'no-sort) (progn (treedir-insert-subdirs ext) (set-extent-property ext 'treedir-hidden nil))) (treedir-update-folder-glyph ext)) (defun treedir-rehide-folder (ext) (let* ((childs (extent-property ext 'treedir-child-list)) (count (length childs)) (flag (treedir-buffer-read-only-p)) elem) (if flag (treedir-read-write)) (if childs (while (setq elem (pop childs)) (if (not (extent-property elem 'treedir-hidden)) (treedir-rehide-folder elem)))) (goto-char (extent-start-position ext)) (forward-line) (kill-line count) (set-extent-property ext 'treedir-hidden t) (set-extent-property ext 'treedir-child-list nil) (treedir-update-folder-glyph ext) (if flag (treedir-read-only)))) (defun treedir-init-edit-extents () (setq treedir-before-folder-ext (make-extent 1 1 treedir-buffer)) (setq treedir-at-folder-ext (make-extent 1 1 treedir-buffer)) (setq treedir-after-folder-ext (make-extent 1 1 treedir-buffer)) (set-extent-property treedir-before-folder-ext 'read-only t) (set-extent-property treedir-at-folder-ext 'read-only t) (set-extent-property treedir-at-folder-ext 'end-open nil) (set-extent-property treedir-at-folder-ext 'face 'treedir-dir-cursor-face) (set-extent-property treedir-at-folder-ext 'atomic t) (set-extent-property treedir-after-folder-ext 'read-only t) (set-extent-property treedir-after-folder-ext 'end-open nil) (set-extent-property treedir-after-folder-ext 'start-open t)) (defun treedir-read-write () (set-extent-property treedir-before-folder-ext 'read-only nil) (set-extent-property treedir-at-folder-ext 'read-only nil) (set-extent-property treedir-after-folder-ext 'read-only nil)) (defun treedir-read-only () (set-extent-property treedir-before-folder-ext 'read-only t) (set-extent-property treedir-at-folder-ext 'read-only t) (set-extent-property treedir-after-folder-ext 'read-only t)) (defun treedir-buffer-read-only-p () (extent-property treedir-before-folder-ext 'read-only)) (defun treedir-set-cursor () (let ((ext (treedir-label-ext-at-current-line))) (if ext (progn (set-extent-endpoints treedir-before-folder-ext (point-min) (extent-start-position ext) treedir-buffer) (set-extent-endpoints treedir-after-folder-ext (extent-end-position ext) (point-max) treedir-buffer) (set-extent-endpoints treedir-at-folder-ext (extent-start-position ext) (extent-end-position ext) treedir-buffer))))) (defun treedir-label-ext-at-current-line () (save-excursion (end-of-line) (extent-at (point) treedir-buffer 'folder-ext nil 'before))) (defun treedir-folder-ext-at-current-line () (save-excursion (end-of-line) (extent-property (extent-at (point) treedir-buffer 'folder-ext nil 'before) 'folder-ext))) (defun treedir-dirname-at-current-line () (extent-property (treedir-folder-ext-at-current-line) 'treedir-dirname)) (defun treedir-parent-of-folder-at-current-line () (extent-property (treedir-folder-ext-at-current-line) 'treedir-parent)) (defun treedir-key-action1 () (interactive) (treedir-action1 (treedir-folder-ext-at-current-line))) (defun treedir-key-action2 () (interactive) (treedir-action2 (treedir-folder-ext-at-current-line))) (defun treedir (dir) (interactive "DShow directory tree from: ") (let ((pop-up-windows nil)) (setq treedir-buffer (get-buffer-create "*TreeDir*")) (pop-to-buffer treedir-buffer) (save-excursion (if treedir-before-folder-ext (progn (delete-extent treedir-before-folder-ext) (delete-extent treedir-at-folder-ext) (delete-extent treedir-after-folder-ext))) (setq buffer-read-only nil) (erase-buffer treedir-buffer) (insert-string " ") (kill-all-local-variables) (suppress-keymap (setq treedir-keymap (make-sparse-keymap))) (set-keymap-name treedir-keymap 'treedir-map) (define-key treedir-keymap [space] 'treedir-key-action1) (define-key treedir-keymap [return] 'treedir-key-action2) (setq major-mode 'treedir) (setq mode-name "TreeDir") (put 'treedir 'mode-class 'special) (use-local-map treedir-keymap) (make-local-variable 'annotation-local-map-default) (make-local-hook 'post-command-hook) (add-hook 'post-command-hook 'treedir-set-cursor nil t) (setq truncate-lines 't) (setq annotation-local-map-default (let ((map (make-sparse-keymap))) (set-keymap-name map 'annotation-local-map) (define-key map 'button1 'treedir-activate-function-button1) (define-key map 'button2 'treedir-activate-function-button2) (define-key map 'button3 'treedir-activate-function-button3) map)) (split-window-horizontally 30) (treedir-init-edit-extents) (treedir-action2 (treedir-create-folder dir)) (pop-to-buffer treedir-buffer) (beginning-of-buffer) (set-specifier text-cursor-visible-p nil treedir-buffer) (treedir-set-cursor)))) (provide 'treedir) ;; treedir ends here