[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/tree-widget.el
|
From: |
David Ponce |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/tree-widget.el |
|
Date: |
Mon, 04 Jul 2005 08:33:21 -0400 |
Index: emacs/lisp/tree-widget.el
diff -c emacs/lisp/tree-widget.el:1.6 emacs/lisp/tree-widget.el:1.7
*** emacs/lisp/tree-widget.el:1.6 Thu Jun 16 05:39:56 2005
--- emacs/lisp/tree-widget.el Mon Jul 4 12:33:21 2005
***************
*** 31,105 ****
;;
;; The following properties are specific to the tree widget:
;;
! ;; :open
! ;; Set to non-nil to unfold the tree. By default the tree is
! ;; folded.
! ;;
! ;; :node
! ;; Specify the widget used to represent a tree node. By default
! ;; this is an `item' widget which displays the tree-widget :tag
! ;; property value if defined or a string representation of the
! ;; tree-widget value.
! ;;
! ;; :keep
! ;; Specify a list of properties to keep when the tree is
! ;; folded so they can be recovered when the tree is unfolded.
! ;; This property can be used in child widgets too.
! ;;
! ;; :dynargs
! ;; Specify a function to be called when the tree is unfolded, to
! ;; dynamically provide the tree children in response to an unfold
! ;; request. This function will be passed the tree widget and
! ;; must return a list of child widgets. That list will be stored
! ;; as the :args property of the parent tree.
!
! ;; To speed up successive unfold requests, the :dynargs function
! ;; can directly return the :args value if non-nil. Refreshing
! ;; child values can be achieved by giving the :args property the
! ;; value nil, then redrawing the tree.
! ;;
! ;; :has-children
! ;; Specify if this tree has children. This property has meaning
! ;; only when used with the above :dynargs one. It indicates that
! ;; child widgets exist but will be dynamically provided when
! ;; unfolding the node.
! ;;
! ;; :open-control (default `tree-widget-open-control')
! ;; :close-control (default `tree-widget-close-control')
! ;; :empty-control (default `tree-widget-empty-control')
! ;; :leaf-control (default `tree-widget-leaf-control')
! ;; :guide (default `tree-widget-guide')
! ;; :end-guide (default `tree-widget-end-guide')
! ;; :no-guide (default `tree-widget-no-guide')
! ;; :handle (default `tree-widget-handle')
! ;; :no-handle (default `tree-widget-no-handle')
! ;;
! ;; The above nine properties define the widgets used to draw the tree.
! ;; For example, using widgets that display this values:
! ;;
! ;; open-control "[-] "
! ;; close-control "[+] "
! ;; empty-control "[X] "
! ;; leaf-control "[>] "
! ;; guide " |"
! ;; noguide " "
! ;; end-guide " `"
! ;; handle "-"
! ;; no-handle " "
! ;;
! ;; A tree will look like this:
! ;;
! ;; [-] 1 open-control
! ;; |-[+] 1.0 guide+handle+close-control
! ;; |-[X] 1.1 guide+handle+empty-control
! ;; `-[-] 1.2 end-guide+handle+open-control
! ;; |-[>] 1.2.1 no-guide+no-handle+guide+handle+leaf-control
! ;; `-[>] 1.2.2 no-guide+no-handle+end-guide+handle+leaf-control
! ;;
! ;; By default, the tree widget try to use images instead of strings to
! ;; draw a nice-looking tree. See the `tree-widget-themes-directory'
! ;; and `tree-widget-theme' options for more details.
! ;;
;;; History:
;;
--- 31,100 ----
;;
;; The following properties are specific to the tree widget:
;;
! ;; :open
! ;; Set to non-nil to expand the tree. By default the tree is
! ;; collapsed.
! ;;
! ;; :node
! ;; Specify the widget used to represent the value of a tree node.
! ;; By default this is an `item' widget which displays the
! ;; tree-widget :tag property value if defined, or a string
! ;; representation of the tree-widget value.
! ;;
! ;; :keep
! ;; Specify a list of properties to keep when the tree is collapsed
! ;; so they can be recovered when the tree is expanded. This
! ;; property can be used in child widgets too.
! ;;
! ;; :expander (obsoletes :dynargs)
! ;; Specify a function to be called to dynamically provide the
! ;; tree's children in response to an expand request. This function
! ;; will be passed the tree widget and must return a list of child
! ;; widgets.
! ;;
! ;; *Please note:* Child widgets returned by the :expander function
! ;; are stored in the :args property of the tree widget. To speed
! ;; up successive expand requests, the :expander function is not
! ;; called again when the :args value is non-nil. To refresh child
! ;; values, it is necessary to set the :args property to nil, then
! ;; redraw the tree.
! ;;
! ;; :open-control (default `tree-widget-open-control')
! ;; :close-control (default `tree-widget-close-control')
! ;; :empty-control (default `tree-widget-empty-control')
! ;; :leaf-control (default `tree-widget-leaf-control')
! ;; :guide (default `tree-widget-guide')
! ;; :end-guide (default `tree-widget-end-guide')
! ;; :no-guide (default `tree-widget-no-guide')
! ;; :handle (default `tree-widget-handle')
! ;; :no-handle (default `tree-widget-no-handle')
! ;; Those properties define the widgets used to draw the tree, and
! ;; permit to customize its look and feel. For example, using
! ;; `item' widgets with these :tag values:
! ;;
! ;; open-control "[-] " (OC)
! ;; close-control "[+] " (CC)
! ;; empty-control "[X] " (EC)
! ;; leaf-control "[>] " (LC)
! ;; guide " |" (GU)
! ;; noguide " " (NG)
! ;; end-guide " `" (EG)
! ;; handle "-" (HA)
! ;; no-handle " " (NH)
! ;;
! ;; A tree will look like this:
! ;;
! ;; [-] 1 (OC :node)
! ;; |-[+] 1.0 (GU+HA+CC :node)
! ;; |-[X] 1.1 (GU+HA+EC :node)
! ;; `-[-] 1.2 (EG+HA+OC :node)
! ;; |-[>] 1.2.1 (NG+NH+GU+HA+LC child)
! ;; `-[>] 1.2.2 (NG+NH+EG+HA+LC child)
! ;;
! ;; By default, images will be used instead of strings to draw a
! ;; nice-looking tree. See the `tree-widget-image-enable',
! ;; `tree-widget-themes-directory', and `tree-widget-theme' options for
! ;; more details.
;;; History:
;;
***************
*** 111,180 ****
;;; Customization
;;
(defgroup tree-widget nil
! "Customization support for the Tree Widget Library."
:version "22.1"
:group 'widgets)
(defcustom tree-widget-image-enable
(not (or (featurep 'xemacs) (< emacs-major-version 21)))
! "*non-nil means that tree-widget will try to use images."
:type 'boolean
:group 'tree-widget)
(defcustom tree-widget-themes-directory "tree-widget"
! "*Name of the directory where to lookup for image themes.
When nil use the directory where the tree-widget library is located.
! When a relative name is specified, try to locate that sub-directory in
`load-path', then in the data directory, and use the first one found.
! Default is to search for a \"tree-widget\" sub-directory.
!
! The data directory is the value of:
! - the variable `data-directory' on GNU Emacs;
! - `(locate-data-directory \"tree-widget\")' on XEmacs."
:type '(choice (const :tag "Default" "tree-widget")
(const :tag "With the library" nil)
(directory :format "%{%t%}:\n%v"))
:group 'tree-widget)
(defcustom tree-widget-theme nil
! "*Name of the theme to use to lookup for images.
! The theme name must be a subdirectory in `tree-widget-themes-directory'.
! If nil use the \"default\" theme.
! When a image is not found in the current theme, the \"default\" theme
! is searched too.
! A complete theme should contain images with these file names:
!
! Name Represents
! ----------- ------------------------------------------------
! open opened node (for example an open folder)
! close closed node (for example a close folder)
! empty empty node (a node without children)
! leaf leaf node (for example a document)
! guide a vertical guide line
! no-guide an invisible guide line
! end-guide the end of a vertical guide line
! handle an horizontal line drawn before a node control
! no-handle an invisible handle
! ----------- ------------------------------------------------"
:type '(choice (const :tag "Default" nil)
(string :tag "Name"))
:group 'tree-widget)
(defcustom tree-widget-image-properties-emacs
'(:ascent center :mask (heuristic t))
! "*Properties of GNU Emacs images."
:type 'plist
:group 'tree-widget)
(defcustom tree-widget-image-properties-xemacs
nil
! "*Properties of XEmacs images."
:type 'plist
:group 'tree-widget)
;;; Image support
;;
! (eval-and-compile ;; GNU Emacs/XEmacs compatibility stuff
(cond
;; XEmacs
((featurep 'xemacs)
--- 106,180 ----
;;; Customization
;;
(defgroup tree-widget nil
! "Customization support for the Tree Widget library."
:version "22.1"
:group 'widgets)
(defcustom tree-widget-image-enable
(not (or (featurep 'xemacs) (< emacs-major-version 21)))
! "*Non-nil means that tree-widget will try to use images."
:type 'boolean
:group 'tree-widget)
(defcustom tree-widget-themes-directory "tree-widget"
! "*Name of the directory where to look up for image themes.
When nil use the directory where the tree-widget library is located.
! When a relative name is specified, try to locate that sub directory in
`load-path', then in the data directory, and use the first one found.
! The data directory is the value of the variable `data-directory' on
! Emacs, and what `(locate-data-directory \"tree-widget\")' returns on
! XEmacs.
! The default is to use the \"tree-widget\" relative name."
:type '(choice (const :tag "Default" "tree-widget")
(const :tag "With the library" nil)
(directory :format "%{%t%}:\n%v"))
:group 'tree-widget)
(defcustom tree-widget-theme nil
! "*Name of the theme where to look up for images.
! It must be a sub directory of the directory specified in variable
! `tree-widget-themes-directory'. The default is \"default\". When an
! image is not found in this theme, the default theme is searched too.
! A complete theme must contain images with these file names with a
! supported extension (see also `tree-widget-image-formats'):
!
! \"open\"
! Represent an expanded node.
! \"close\"
! Represent a collapsed node.
! \"empty\"
! Represent an expanded node with no child.
! \"leaf\"
! Represent a leaf node.
! \"guide\"
! A vertical guide line.
! \"no-guide\"
! An invisible vertical guide line.
! \"end-guide\"
! End of a vertical guide line.
! \"handle\"
! Horizontal guide line that joins the vertical guide line to a node.
! \"no-handle\"
! An invisible handle."
:type '(choice (const :tag "Default" nil)
(string :tag "Name"))
:group 'tree-widget)
(defcustom tree-widget-image-properties-emacs
'(:ascent center :mask (heuristic t))
! "*Default properties of Emacs images."
:type 'plist
:group 'tree-widget)
(defcustom tree-widget-image-properties-xemacs
nil
! "*Default properties of XEmacs images."
:type 'plist
:group 'tree-widget)
;;; Image support
;;
! (eval-and-compile ;; Emacs/XEmacs compatibility stuff
(cond
;; XEmacs
((featurep 'xemacs)
***************
*** 184,195 ****
widget-glyph-enable
(console-on-window-system-p)))
(defsubst tree-widget-create-image (type file &optional props)
! "Create an image of type TYPE from FILE.
! Give the image the specified properties PROPS.
! Return the new image."
(apply 'make-glyph `([,type :file ,file ,@props])))
(defsubst tree-widget-image-formats ()
! "Return the list of image formats, file name suffixes associations.
See also the option `widget-image-file-name-suffixes'."
(delq nil
(mapcar
--- 184,194 ----
widget-glyph-enable
(console-on-window-system-p)))
(defsubst tree-widget-create-image (type file &optional props)
! "Create an image of type TYPE from FILE, and return it.
! Give the image the specified properties PROPS."
(apply 'make-glyph `([,type :file ,file ,@props])))
(defsubst tree-widget-image-formats ()
! "Return the alist of image formats/file name extensions.
See also the option `widget-image-file-name-suffixes'."
(delq nil
(mapcar
***************
*** 197,203 ****
(and (valid-image-instantiator-format-p (car fmt)) fmt))
widget-image-file-name-suffixes)))
)
! ;; GNU Emacs
(t
(defsubst tree-widget-use-image-p ()
"Return non-nil if image support is currently enabled."
--- 196,202 ----
(and (valid-image-instantiator-format-p (car fmt)) fmt))
widget-image-file-name-suffixes)))
)
! ;; Emacs
(t
(defsubst tree-widget-use-image-p ()
"Return non-nil if image support is currently enabled."
***************
*** 205,217 ****
widget-image-enable
(display-images-p)))
(defsubst tree-widget-create-image (type file &optional props)
! "Create an image of type TYPE from FILE.
! Give the image the specified properties PROPS.
! Return the new image."
(apply 'create-image `(,file ,type nil ,@props)))
(defsubst tree-widget-image-formats ()
! "Return the list of image formats, file name suffixes associations.
! See also the option `widget-image-conversion'."
(delq nil
(mapcar
#'(lambda (fmt)
--- 204,215 ----
widget-image-enable
(display-images-p)))
(defsubst tree-widget-create-image (type file &optional props)
! "Create an image of type TYPE from FILE, and return it.
! Give the image the specified properties PROPS."
(apply 'create-image `(,file ,type nil ,@props)))
(defsubst tree-widget-image-formats ()
! "Return the alist of image formats/file name extensions.
! See also the option `widget-image-file-name-suffixes'."
(delq nil
(mapcar
#'(lambda (fmt)
***************
*** 229,240 ****
(defsubst tree-widget-set-theme (&optional name)
"In the current buffer, set the theme to use for images.
! The current buffer should be where the tree widget is drawn.
! Optional argument NAME is the name of the theme to use, which defaults
to the value of the variable `tree-widget-theme'.
! Does nothing if NAME is the name of the current theme."
(or name (setq name (or tree-widget-theme "default")))
! (unless (equal name (tree-widget-theme-name))
(set (make-local-variable 'tree-widget--theme)
(make-vector 4 nil))
(aset tree-widget--theme 0 name)))
--- 227,238 ----
(defsubst tree-widget-set-theme (&optional name)
"In the current buffer, set the theme to use for images.
! The current buffer must be where the tree widget is drawn.
! Optional argument NAME is the name of the theme to use. It defaults
to the value of the variable `tree-widget-theme'.
! Does nothing if NAME is already the current theme."
(or name (setq name (or tree-widget-theme "default")))
! (unless (string-equal name (tree-widget-theme-name))
(set (make-local-variable 'tree-widget--theme)
(make-vector 4 nil))
(aset tree-widget--theme 0 name)))
***************
*** 265,274 ****
(t
(let ((path
(append load-path
- ;; The data directory depends on which, GNU
- ;; Emacs or XEmacs, is running.
(list (if (fboundp 'locate-data-directory)
(locate-data-directory "tree-widget")
data-directory)))))
(while (and path (not found))
(when (car path)
--- 263,272 ----
(t
(let ((path
(append load-path
(list (if (fboundp 'locate-data-directory)
+ ;; XEmacs
(locate-data-directory "tree-widget")
+ ;; Emacs
data-directory)))))
(while (and path (not found))
(when (car path)
***************
*** 286,295 ****
(aset tree-widget--theme 2 props))
(defun tree-widget-image-properties (file)
! "Return properties of images in current theme.
! If the \"tree-widget-theme-setup.el\" file exists in the directory
! where is located the image FILE, load it to setup theme images
! properties. Typically that file should contain something like this:
(tree-widget-set-image-properties
(if (featurep 'xemacs)
--- 284,295 ----
(aset tree-widget--theme 2 props))
(defun tree-widget-image-properties (file)
! "Return the properties of an image in current theme.
! FILE is the absolute file name of an image.
!
! If there is a \"tree-widget-theme-setup\" library in the theme
! directory, where is located FILE, load it to setup theme images
! properties. Typically it should contain something like this:
(tree-widget-set-image-properties
(if (featurep 'xemacs)
***************
*** 297,444 ****
'(:ascent center :mask (heuristic t))
))
! By default, use the global properties provided in variables
! `tree-widget-image-properties-emacs' or
`tree-widget-image-properties-xemacs'."
;; If properties are in the cache, use them.
! (or (aref tree-widget--theme 2)
! (progn
! ;; Load tree-widget-theme-setup if available.
! (load (expand-file-name
! "tree-widget-theme-setup"
! (file-name-directory file)) t t)
! ;; If properties have been setup, use them.
! (or (aref tree-widget--theme 2)
! ;; By default, use supplied global properties.
! (tree-widget-set-image-properties
! (if (featurep 'xemacs)
! tree-widget-image-properties-xemacs
! tree-widget-image-properties-emacs))))))
(defun tree-widget-find-image (name)
"Find the image with NAME in current theme.
NAME is an image file name sans extension.
! Search first in current theme, then in default theme.
! A theme is a sub-directory of the root theme directory specified in
! variable `tree-widget-themes-directory'.
! Return the first image found having a supported format in those
! returned by the function `tree-widget-image-formats', or nil if not
! found."
(when (tree-widget-use-image-p)
;; Ensure there is an active theme.
(tree-widget-set-theme (tree-widget-theme-name))
! ;; If the image is in the cache, return it.
! (or (cdr (assoc name (aref tree-widget--theme 3)))
! ;; Search the image in the current, then default themes.
! (let ((default-directory (tree-widget-themes-directory)))
! (when default-directory
! (let* ((theme (tree-widget-theme-name))
! (path (mapcar 'expand-file-name
! (if (equal theme "default")
! '("default")
! (list theme "default"))))
! (formats (tree-widget-image-formats))
! (found
! (catch 'found
! (dolist (dir path)
! (dolist (fmt formats)
! (dolist (ext (cdr fmt))
! (let ((file (expand-file-name
! (concat name ext) dir)))
! (and (file-readable-p file)
! (file-regular-p file)
! (throw 'found
! (cons (car fmt) file)))))))
! nil)))
! (when found
! (let ((image
! (tree-widget-create-image
! (car found) (cdr found)
! (tree-widget-image-properties (cdr found)))))
! ;; Store image in the cache for later use.
! (push (cons name image) (aref tree-widget--theme 3))
! image))))))))
;;; Widgets
;;
(defvar tree-widget-button-keymap
! (let (parent-keymap mouse-button1 keymap)
! (if (featurep 'xemacs)
! (setq parent-keymap widget-button-keymap
! mouse-button1 [button1])
! (setq parent-keymap widget-keymap
! mouse-button1 [down-mouse-1]))
! (setq keymap (copy-keymap parent-keymap))
! (define-key keymap mouse-button1 'widget-button-click)
! keymap)
! "Keymap used inside node handle buttons.")
(define-widget 'tree-widget-control 'push-button
! "Base `tree-widget' control."
:format "%[%t%]"
:button-keymap tree-widget-button-keymap ; XEmacs
:keymap tree-widget-button-keymap ; Emacs
)
(define-widget 'tree-widget-open-control 'tree-widget-control
! "Control widget that represents a opened `tree-widget' node."
:tag "[-] "
;;:tag-glyph (tree-widget-find-image "open")
:notify 'tree-widget-close-node
! :help-echo "Hide node"
)
(define-widget 'tree-widget-empty-control 'tree-widget-open-control
! "Control widget that represents an empty opened `tree-widget' node."
:tag "[X] "
;;:tag-glyph (tree-widget-find-image "empty")
)
(define-widget 'tree-widget-close-control 'tree-widget-control
! "Control widget that represents a closed `tree-widget' node."
:tag "[+] "
;;:tag-glyph (tree-widget-find-image "close")
:notify 'tree-widget-open-node
! :help-echo "Show node"
)
(define-widget 'tree-widget-leaf-control 'item
! "Control widget that represents a leaf node."
! :tag " " ;; Need at least a char to display the image :-(
;;:tag-glyph (tree-widget-find-image "leaf")
:format "%t"
)
(define-widget 'tree-widget-guide 'item
! "Widget that represents a guide line."
:tag " |"
;;:tag-glyph (tree-widget-find-image "guide")
:format "%t"
)
(define-widget 'tree-widget-end-guide 'item
! "Widget that represents the end of a guide line."
:tag " `"
;;:tag-glyph (tree-widget-find-image "end-guide")
:format "%t"
)
(define-widget 'tree-widget-no-guide 'item
! "Widget that represents an invisible guide line."
:tag " "
;;:tag-glyph (tree-widget-find-image "no-guide")
:format "%t"
)
(define-widget 'tree-widget-handle 'item
! "Widget that represent a node handle."
:tag " "
;;:tag-glyph (tree-widget-find-image "handle")
:format "%t"
)
(define-widget 'tree-widget-no-handle 'item
! "Widget that represent an invisible node handle."
:tag " "
;;:tag-glyph (tree-widget-find-image "no-handle")
:format "%t"
--- 297,466 ----
'(:ascent center :mask (heuristic t))
))
! Default global properties are provided for respectively Emacs and
! XEmacs in the variables `tree-widget-image-properties-emacs', and
`tree-widget-image-properties-xemacs'."
;; If properties are in the cache, use them.
! (let ((plist (aref tree-widget--theme 2)))
! (unless plist
! ;; Load tree-widget-theme-setup if available.
! (load (expand-file-name "tree-widget-theme-setup"
! (file-name-directory file)) t t)
! ;; If properties have been setup, use them.
! (unless (setq plist (aref tree-widget--theme 2))
! ;; By default, use supplied global properties.
! (setq plist (if (featurep 'xemacs)
! tree-widget-image-properties-xemacs
! tree-widget-image-properties-emacs))
! ;; Setup the cache.
! (tree-widget-set-image-properties plist)))
! plist))
!
! (defconst tree-widget--cursors
! ;; Pointer shapes when the mouse pointer is over tree-widget images.
! ;; This feature works since Emacs 22, and ignored on older versions,
! ;; and XEmacs.
! '(
! ("open" . hand )
! ("close" . hand )
! ("empty" . arrow)
! ("leaf" . arrow)
! ("guide" . arrow)
! ("no-guide" . arrow)
! ("end-guide" . arrow)
! ("handle" . arrow)
! ("no-handle" . arrow)
! ))
!
! (defun tree-widget-lookup-image (name)
! "Look up in current theme for an image with NAME.
! Search first in current theme, then in default theme (see also the
! variable `tree-widget-theme').
! Return the first image found having a supported format, or nil if not
! found."
! (let ((default-directory (tree-widget-themes-directory)))
! (when default-directory
! (let (file (theme (tree-widget-theme-name)))
! (catch 'found
! (dolist (dir (if (string-equal theme "default")
! '("default") (list theme "default")))
! (dolist (fmt (tree-widget-image-formats))
! (dolist (ext (cdr fmt))
! (setq file (expand-file-name (concat name ext) dir))
! (and
! (file-readable-p file)
! (file-regular-p file)
! (throw
! 'found
! (tree-widget-create-image
! (car fmt) file
! ;; Add the pointer shape
! (cons :pointer
! (cons
! (cdr (assoc name tree-widget--cursors))
! (tree-widget-image-properties file)))))))))
! nil)))))
(defun tree-widget-find-image (name)
"Find the image with NAME in current theme.
NAME is an image file name sans extension.
! Return the image found, or nil if not found."
(when (tree-widget-use-image-p)
;; Ensure there is an active theme.
(tree-widget-set-theme (tree-widget-theme-name))
! (let ((image (assoc name (aref tree-widget--theme 3))))
! ;; The image NAME is found in the cache.
! (if image
! (cdr image)
! ;; Search the image in current, and default themes.
! (prog1
! (setq image (tree-widget-lookup-image name))
! ;; Store image reference in the cache for later use.
! (push (cons name image) (aref tree-widget--theme 3))))
! )))
;;; Widgets
;;
(defvar tree-widget-button-keymap
! (let ((km (make-sparse-keymap)))
! (if (boundp 'widget-button-keymap)
! ;; XEmacs
! (progn
! (set-keymap-parent km widget-button-keymap)
! (define-key km [button1] 'widget-button-click))
! ;; Emacs
! (set-keymap-parent km widget-keymap)
! (define-key km [down-mouse-1] 'widget-button-click))
! km)
! "Keymap used inside node buttons.
! Handle mouse button 1 click on buttons.")
(define-widget 'tree-widget-control 'push-button
! "Basic widget other tree-widget node buttons are derived from."
:format "%[%t%]"
:button-keymap tree-widget-button-keymap ; XEmacs
:keymap tree-widget-button-keymap ; Emacs
)
(define-widget 'tree-widget-open-control 'tree-widget-control
! "Button for an expanded tree-widget node."
:tag "[-] "
;;:tag-glyph (tree-widget-find-image "open")
:notify 'tree-widget-close-node
! :help-echo "Collapse node"
)
(define-widget 'tree-widget-empty-control 'tree-widget-open-control
! "Button for an expanded tree-widget node with no child."
:tag "[X] "
;;:tag-glyph (tree-widget-find-image "empty")
)
(define-widget 'tree-widget-close-control 'tree-widget-control
! "Button for a collapsed tree-widget node."
:tag "[+] "
;;:tag-glyph (tree-widget-find-image "close")
:notify 'tree-widget-open-node
! :help-echo "Expand node"
)
(define-widget 'tree-widget-leaf-control 'item
! "Representation of a tree-widget leaf node."
! :tag " " ;; Need at least one char to display the image :-(
;;:tag-glyph (tree-widget-find-image "leaf")
:format "%t"
)
(define-widget 'tree-widget-guide 'item
! "Vertical guide line."
:tag " |"
;;:tag-glyph (tree-widget-find-image "guide")
:format "%t"
)
(define-widget 'tree-widget-end-guide 'item
! "End of a vertical guide line."
:tag " `"
;;:tag-glyph (tree-widget-find-image "end-guide")
:format "%t"
)
(define-widget 'tree-widget-no-guide 'item
! "Invisible vertical guide line."
:tag " "
;;:tag-glyph (tree-widget-find-image "no-guide")
:format "%t"
)
(define-widget 'tree-widget-handle 'item
! "Horizontal guide line that joins a vertical guide line to a node."
:tag " "
;;:tag-glyph (tree-widget-find-image "handle")
:format "%t"
)
(define-widget 'tree-widget-no-handle 'item
! "Invisible handle."
:tag " "
;;:tag-glyph (tree-widget-find-image "no-handle")
:format "%t"
***************
*** 449,544 ****
:format "%v"
:convert-widget 'widget-types-convert-widget
:value-get 'widget-value-value-get
:value-create 'tree-widget-value-create
! :value-delete 'tree-widget-value-delete
)
;;; Widget support functions
;;
(defun tree-widget-p (widget)
! "Return non-nil if WIDGET is a `tree-widget' widget."
(let ((type (widget-type widget)))
(while (and type (not (eq type 'tree-widget)))
(setq type (widget-type (get type 'widget-type))))
(eq type 'tree-widget)))
! (defsubst tree-widget-get-super (widget property)
! "Return WIDGET's inherited PROPERTY value."
! (widget-get (get (widget-type (get (widget-type widget)
! 'widget-type))
! 'widget-type)
! property))
!
! (defsubst tree-widget-node (widget)
! "Return the tree WIDGET :node value.
! If not found setup a default 'item' widget."
(let ((node (widget-get widget :node)))
! (unless node
(setq node `(item :tag ,(or (widget-get widget :tag)
(widget-princ-to-string
(widget-value widget)))))
(widget-put widget :node node))
node))
- (defsubst tree-widget-open-control (widget)
- "Return the opened node control specified in WIDGET."
- (or (widget-get widget :open-control)
- 'tree-widget-open-control))
-
- (defsubst tree-widget-close-control (widget)
- "Return the closed node control specified in WIDGET."
- (or (widget-get widget :close-control)
- 'tree-widget-close-control))
-
- (defsubst tree-widget-empty-control (widget)
- "Return the empty node control specified in WIDGET."
- (or (widget-get widget :empty-control)
- 'tree-widget-empty-control))
-
- (defsubst tree-widget-leaf-control (widget)
- "Return the leaf node control specified in WIDGET."
- (or (widget-get widget :leaf-control)
- 'tree-widget-leaf-control))
-
- (defsubst tree-widget-guide (widget)
- "Return the guide line widget specified in WIDGET."
- (or (widget-get widget :guide)
- 'tree-widget-guide))
-
- (defsubst tree-widget-end-guide (widget)
- "Return the end of guide line widget specified in WIDGET."
- (or (widget-get widget :end-guide)
- 'tree-widget-end-guide))
-
- (defsubst tree-widget-no-guide (widget)
- "Return the invisible guide line widget specified in WIDGET."
- (or (widget-get widget :no-guide)
- 'tree-widget-no-guide))
-
- (defsubst tree-widget-handle (widget)
- "Return the node handle line widget specified in WIDGET."
- (or (widget-get widget :handle)
- 'tree-widget-handle))
-
- (defsubst tree-widget-no-handle (widget)
- "Return the node invisible handle line widget specified in WIDGET."
- (or (widget-get widget :no-handle)
- 'tree-widget-no-handle))
-
(defun tree-widget-keep (arg widget)
! "Save in ARG the WIDGET properties specified by :keep."
(dolist (prop (widget-get widget :keep))
(widget-put arg prop (widget-get widget prop))))
(defun tree-widget-children-value-save (widget &optional args node)
"Save WIDGET children values.
! Children properties and values are saved in ARGS if non-nil else in
! WIDGET :args property value. Data node properties and value are saved
! in NODE if non-nil else in WIDGET :node property value."
! (let ((args (or args (widget-get widget :args)))
! (node (or node (tree-widget-node widget)))
! (children (widget-get widget :children))
! (node-child (widget-get widget :tree-widget--node))
arg child)
(while (and args children)
(setq arg (car args)
--- 471,530 ----
:format "%v"
:convert-widget 'widget-types-convert-widget
:value-get 'widget-value-value-get
+ :value-delete 'widget-children-value-delete
:value-create 'tree-widget-value-create
! :open-control 'tree-widget-open-control
! :close-control 'tree-widget-close-control
! :empty-control 'tree-widget-empty-control
! :leaf-control 'tree-widget-leaf-control
! :guide 'tree-widget-guide
! :end-guide 'tree-widget-end-guide
! :no-guide 'tree-widget-no-guide
! :handle 'tree-widget-handle
! :no-handle 'tree-widget-no-handle
)
;;; Widget support functions
;;
(defun tree-widget-p (widget)
! "Return non-nil if WIDGET is a tree-widget."
(let ((type (widget-type widget)))
(while (and type (not (eq type 'tree-widget)))
(setq type (widget-type (get type 'widget-type))))
(eq type 'tree-widget)))
! (defun tree-widget-node (widget)
! "Return WIDGET's :node child widget.
! If not found, setup an `item' widget as default.
! Signal an error if the :node widget is a tree-widget.
! WIDGET is, or derives from, a tree-widget."
(let ((node (widget-get widget :node)))
! (if node
! ;; Check that the :node widget is not a tree-widget.
! (and (tree-widget-p node)
! (error "Invalid tree-widget :node %S" node))
! ;; Setup an item widget as default :node.
(setq node `(item :tag ,(or (widget-get widget :tag)
(widget-princ-to-string
(widget-value widget)))))
(widget-put widget :node node))
node))
(defun tree-widget-keep (arg widget)
! "Save in ARG the WIDGET's properties specified by :keep."
(dolist (prop (widget-get widget :keep))
(widget-put arg prop (widget-get widget prop))))
(defun tree-widget-children-value-save (widget &optional args node)
"Save WIDGET children values.
! WIDGET is, or derives from, a tree-widget.
! Children properties and values are saved in ARGS if non-nil, else in
! WIDGET's :args property value. Properties and values of the
! WIDGET's :node sub-widget are saved in NODE if non-nil, else in
! WIDGET's :node sub-widget."
! (let ((args (cons (or node (widget-get widget :node))
! (or args (widget-get widget :args))))
! (children (widget-get widget :children))
arg child)
(while (and args children)
(setq arg (car args)
***************
*** 550,556 ****
(progn
;; Backtrack :args and :node properties.
(widget-put arg :args (widget-get child :args))
! (widget-put arg :node (tree-widget-node child))
;; Save :open property.
(widget-put arg :open (widget-get child :open))
;; The node is open.
--- 536,542 ----
(progn
;; Backtrack :args and :node properties.
(widget-put arg :args (widget-get child :args))
! (widget-put arg :node (widget-get child :node))
;; Save :open property.
(widget-put arg :open (widget-get child :open))
;; The node is open.
***************
*** 563,592 ****
(tree-widget-children-value-save
child (widget-get arg :args) (widget-get arg :node))))
;;;; Another non tree node.
! ;; Save the widget value
(widget-put arg :value (widget-value child))
;; Save properties specified in :keep.
! (tree-widget-keep arg child)))
! (when (and node node-child)
! ;; Assume that the node child widget is not a tree!
! ;; Save the node child widget value.
! (widget-put node :value (widget-value node-child))
! ;; Save the node child properties specified in :keep.
! (tree-widget-keep node node-child))
! ))
(defvar tree-widget-after-toggle-functions nil
! "Hooks run after toggling a `tree-widget' folding.
! Each function will receive the `tree-widget' as its unique argument.
! This variable should be local to each buffer used to display
! widgets.")
(defun tree-widget-close-node (widget &rest ignore)
! "Close the `tree-widget' node associated to this control WIDGET.
! WIDGET's parent should be a `tree-widget'.
IGNORE other arguments."
(let ((tree (widget-get widget :parent)))
! ;; Before folding the node up, save children values so next open
;; can recover them.
(tree-widget-children-value-save tree)
(widget-put tree :open nil)
--- 549,570 ----
(tree-widget-children-value-save
child (widget-get arg :args) (widget-get arg :node))))
;;;; Another non tree node.
! ;; Save the widget value.
(widget-put arg :value (widget-value child))
;; Save properties specified in :keep.
! (tree-widget-keep arg child)))))
(defvar tree-widget-after-toggle-functions nil
! "Hooks run after toggling a tree-widget expansion.
! Each function will receive the tree-widget as its unique argument.
! This hook should be local in the buffer used to display widgets.")
(defun tree-widget-close-node (widget &rest ignore)
! "Collapse the tree-widget, parent of WIDGET.
! WIDGET is, or derives from, a tree-widget-open-control widget.
IGNORE other arguments."
(let ((tree (widget-get widget :parent)))
! ;; Before to collapse the node, save children values so next open
;; can recover them.
(tree-widget-children-value-save tree)
(widget-put tree :open nil)
***************
*** 594,724 ****
(run-hook-with-args 'tree-widget-after-toggle-functions tree)))
(defun tree-widget-open-node (widget &rest ignore)
! "Open the `tree-widget' node associated to this control WIDGET.
! WIDGET's parent should be a `tree-widget'.
IGNORE other arguments."
(let ((tree (widget-get widget :parent)))
(widget-put tree :open t)
(widget-value-set tree t)
(run-hook-with-args 'tree-widget-after-toggle-functions tree)))
- (defun tree-widget-value-delete (widget)
- "Delete tree WIDGET children."
- ;; Delete children
- (widget-children-value-delete widget)
- ;; Delete node child
- (widget-delete (widget-get widget :tree-widget--node))
- (widget-put widget :tree-widget--node nil))
-
(defun tree-widget-value-create (tree)
! "Create the TREE widget."
! (let* ((widget-image-enable (tree-widget-use-image-p)) ; Emacs
! (widget-glyph-enable widget-image-enable) ; XEmacs
! (node (tree-widget-node tree))
! (flags (widget-get tree :tree-widget--guide-flags))
(indent (widget-get tree :indent))
children buttons)
(and indent (not (widget-get tree :parent))
(insert-char ?\ indent))
(if (widget-get tree :open)
! ;;;; Unfolded node.
(let ((args (widget-get tree :args))
! (dynargs (widget-get tree :dynargs))
! (guide (tree-widget-guide tree))
! (noguide (tree-widget-no-guide tree))
! (endguide (tree-widget-end-guide tree))
! (handle (tree-widget-handle tree))
! (nohandle (tree-widget-no-handle tree))
! ;; Lookup for images and set widgets' tag-glyphs here,
! ;; to allow to dynamically change the image theme.
(guidi (tree-widget-find-image "guide"))
(noguidi (tree-widget-find-image "no-guide"))
(endguidi (tree-widget-find-image "end-guide"))
(handli (tree-widget-find-image "handle"))
(nohandli (tree-widget-find-image "no-handle"))
child)
! (when dynargs
! ;; Request the definition of dynamic children
! (setq dynargs (funcall dynargs tree))
! ;; Unless children have changed, reuse the widgets
! (unless (eq args dynargs)
! (setq args (mapcar 'widget-convert dynargs))
! (widget-put tree :args args)))
! ;; Insert the node control
(push (widget-create-child-and-convert
! tree (if args (tree-widget-open-control tree)
! (tree-widget-empty-control tree))
:tag-glyph (tree-widget-find-image
(if args "open" "empty")))
buttons)
! ;; Insert the node element
! (widget-put tree :tree-widget--node
! (widget-create-child-and-convert tree node))
! ;; Insert children
(while args
(setq child (car args)
args (cdr args))
(and indent (insert-char ?\ indent))
! ;; Insert guide lines elements
(dolist (f (reverse flags))
(widget-create-child-and-convert
tree (if f guide noguide)
:tag-glyph (if f guidi noguidi))
(widget-create-child-and-convert
! tree nohandle :tag-glyph nohandli)
! )
(widget-create-child-and-convert
tree (if args guide endguide)
:tag-glyph (if args guidi endguidi))
;; Insert the node handle line
(widget-create-child-and-convert
tree handle :tag-glyph handli)
! ;; If leaf node, insert a leaf node control
(unless (tree-widget-p child)
(push (widget-create-child-and-convert
! tree (tree-widget-leaf-control tree)
! :tag-glyph (tree-widget-find-image "leaf"))
buttons))
! ;; Insert the child element
(push (widget-create-child-and-convert
tree child
:tree-widget--guide-flags (cons (if args t) flags))
children)))
! ;;;; Folded node.
! ;; Insert the closed node control
(push (widget-create-child-and-convert
! tree (tree-widget-close-control tree)
:tag-glyph (tree-widget-find-image "close"))
buttons)
! ;; Insert the node element
! (widget-put tree :tree-widget--node
! (widget-create-child-and-convert tree node)))
! ;; Save widget children and buttons
(widget-put tree :children (nreverse children))
(widget-put tree :buttons buttons)
))
-
- ;;; Utilities
- ;;
- (defun tree-widget-map (widget fun)
- "For each WIDGET displayed child call function FUN.
- FUN is called with three arguments like this:
-
- (FUN CHILD IS-NODE WIDGET)
-
- where:
- - - CHILD is the child widget.
- - - IS-NODE is non-nil if CHILD is WIDGET node widget."
- (when (widget-get widget :tree-widget--node)
- (funcall fun (widget-get widget :tree-widget--node) t widget)
- (dolist (child (widget-get widget :children))
- (if (tree-widget-p child)
- ;; The child is a tree node.
- (tree-widget-map child fun)
- ;; Another non tree node.
- (funcall fun child nil widget)))))
(provide 'tree-widget)
! ;;; arch-tag: c3a1ada2-1663-41dc-9d16-2479ed8320e8
;;; tree-widget.el ends here
--- 572,675 ----
(run-hook-with-args 'tree-widget-after-toggle-functions tree)))
(defun tree-widget-open-node (widget &rest ignore)
! "Expand the tree-widget, parent of WIDGET.
! WIDGET is, or derives from, a tree-widget-close-control widget.
IGNORE other arguments."
(let ((tree (widget-get widget :parent)))
(widget-put tree :open t)
(widget-value-set tree t)
(run-hook-with-args 'tree-widget-after-toggle-functions tree)))
(defun tree-widget-value-create (tree)
! "Create the TREE tree-widget."
! (let* ((node (tree-widget-node tree))
! (flags (widget-get tree :tree-widget--guide-flags))
(indent (widget-get tree :indent))
+ ;; Setup widget's image support. Looking up for images, and
+ ;; setting widgets' :tag-glyph is done here, to allow to
+ ;; dynamically change the image theme.
+ (widget-image-enable (tree-widget-use-image-p)) ; Emacs
+ (widget-glyph-enable widget-image-enable) ; XEmacs
children buttons)
(and indent (not (widget-get tree :parent))
(insert-char ?\ indent))
(if (widget-get tree :open)
! ;;;; Expanded node.
(let ((args (widget-get tree :args))
! (xpandr (or (widget-get tree :expander)
! (widget-get tree :dynargs)))
! (leaf (widget-get tree :leaf-control))
! (guide (widget-get tree :guide))
! (noguide (widget-get tree :no-guide))
! (endguide (widget-get tree :end-guide))
! (handle (widget-get tree :handle))
! (nohandle (widget-get tree :no-handle))
! (leafi (tree-widget-find-image "leaf"))
(guidi (tree-widget-find-image "guide"))
(noguidi (tree-widget-find-image "no-guide"))
(endguidi (tree-widget-find-image "end-guide"))
(handli (tree-widget-find-image "handle"))
(nohandli (tree-widget-find-image "no-handle"))
child)
! ;; Request children at run time, when not already done.
! (when (and (not args) xpandr)
! (setq args (mapcar 'widget-convert (funcall xpandr tree)))
! (widget-put tree :args args))
! ;; Insert the node "open" button.
(push (widget-create-child-and-convert
! tree (widget-get
! tree (if args :open-control :empty-control))
:tag-glyph (tree-widget-find-image
(if args "open" "empty")))
buttons)
! ;; Insert the :node element.
! (push (widget-create-child-and-convert tree node)
! children)
! ;; Insert children.
(while args
(setq child (car args)
args (cdr args))
(and indent (insert-char ?\ indent))
! ;; Insert guide lines elements from previous levels.
(dolist (f (reverse flags))
(widget-create-child-and-convert
tree (if f guide noguide)
:tag-glyph (if f guidi noguidi))
(widget-create-child-and-convert
! tree nohandle :tag-glyph nohandli))
! ;; Insert guide line element for this level.
(widget-create-child-and-convert
tree (if args guide endguide)
:tag-glyph (if args guidi endguidi))
;; Insert the node handle line
(widget-create-child-and-convert
tree handle :tag-glyph handli)
! ;; If leaf node, insert a leaf node button.
(unless (tree-widget-p child)
(push (widget-create-child-and-convert
! tree leaf :tag-glyph leafi)
buttons))
! ;; Finally, insert the child widget.
(push (widget-create-child-and-convert
tree child
:tree-widget--guide-flags (cons (if args t) flags))
children)))
! ;;;; Collapsed node.
! ;; Insert the "closed" node button.
(push (widget-create-child-and-convert
! tree (widget-get tree :close-control)
:tag-glyph (tree-widget-find-image "close"))
buttons)
! ;; Insert the :node element.
! (push (widget-create-child-and-convert tree node)
! children))
! ;; Save widget children and buttons. The :node child is the first
! ;; element in children.
(widget-put tree :children (nreverse children))
(widget-put tree :buttons buttons)
))
(provide 'tree-widget)
! ;; arch-tag: c3a1ada2-1663-41dc-9d16-2479ed8320e8
;;; tree-widget.el ends here
- [Emacs-diffs] Changes to emacs/lisp/tree-widget.el,
David Ponce <=