[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, 15 Aug 2005 09:00:09 -0400 |
Index: emacs/lisp/tree-widget.el
diff -c emacs/lisp/tree-widget.el:1.8 emacs/lisp/tree-widget.el:1.9
*** emacs/lisp/tree-widget.el:1.8 Mon Jul 4 23:08:58 2005
--- emacs/lisp/tree-widget.el Mon Aug 15 13:00:09 2005
***************
*** 59,95 ****
;; 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',
--- 59,110 ----
;; values, it is necessary to set the :args property to nil, then
;; redraw the tree.
;;
! ;; :open-icon (default `tree-widget-open-icon')
! ;; :close-icon (default `tree-widget-close-icon')
! ;; :empty-icon (default `tree-widget-empty-icon')
! ;; :leaf-icon (default `tree-widget-leaf-icon')
! ;; Those properties define the icon widgets associated to tree
! ;; nodes. Icon widgets must derive from the `tree-widget-icon'
! ;; widget. The :tag and :glyph-name property values are
! ;; respectively used when drawing the text and graphic
! ;; representation of the tree. The :tag value must be a string
! ;; that represent a node icon, like "[+]" for example. The
! ;; :glyph-name value must the name of an image found in the current
! ;; theme, like "close" for example (see also the variable
! ;; `tree-widget-theme').
! ;;
! ;; :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 `item'-like widgets used to draw the
! ;; tree guide lines. The :tag property value is used when drawing
! ;; the text representation of the tree. The graphic look and feel
! ;; is given by the images named "guide", "no-guide", "end-guide",
! ;; "handle", and "no-handle" found in the current theme (see also
! ;; the variable `tree-widget-theme').
! ;;
! ;; These are the default :tag values for icons, and guide lines:
! ;;
! ;; open-icon "[-]"
! ;; close-icon "[+]"
! ;; empty-icon "[X]"
! ;; leaf-icon ""
! ;; guide " |"
! ;; no-guide " "
! ;; end-guide " `"
! ;; handle "-"
! ;; no-handle " "
! ;;
! ;; The text representation of a tree looks like this:
! ;;
! ;; [-] 1 (open-icon :node)
! ;; |-[+] 1.0 (guide+handle+close-icon :node)
! ;; |-[X] 1.1 (guide+handle+empty-icon :node)
! ;; `-[-] 1.2 (end-guide+handle+open-icon :node)
! ;; |- 1.2.1 (no-guide+no-handle+guide+handle+leaf-icon leaf)
! ;; `- 1.2.2 (no-guide+no-handle+end-guide+handle+leaf-icon leaf)
;;
;; By default, images will be used instead of strings to draw a
;; nice-looking tree. See the `tree-widget-image-enable',
***************
*** 133,151 ****
(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\"
--- 148,160 ----
(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 theme is \"default\".
! When an image is not found in a theme, it is searched in the default
! theme.
!
! A complete theme must at least contain images with these file names
! with a supported extension (see also `tree-widget-image-formats'):
\"guide\"
A vertical guide line.
\"no-guide\"
***************
*** 153,161 ****
\"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)
--- 162,182 ----
\"end-guide\"
End of a vertical guide line.
\"handle\"
! Horizontal guide line that joins the vertical guide line to an icon.
\"no-handle\"
! An invisible handle.
!
! Plus images whose name is given by the :glyph-name property of the
! icon widgets used to draw the tree. By default these images are used:
!
! \"open\"
! Icon associated to an expanded tree.
! \"close\"
! Icon associated to a collapsed tree.
! \"empty\"
! Icon associated to an expanded tree with no child.
! \"leaf\"
! Icon associated to a leaf node."
:type '(choice (const :tag "Default" nil)
(string :tag "Name"))
:group 'tree-widget)
***************
*** 171,176 ****
--- 192,203 ----
"*Default properties of XEmacs images."
:type 'plist
:group 'tree-widget)
+
+ (defcustom tree-widget-space-width 0.5
+ "Amount of space between an icon image and a node widget.
+ Must be a valid space :width display property."
+ :group 'tree-widget
+ :type 'sexp)
;;; Image support
;;
***************
*** 297,302 ****
--- 324,331 ----
'(:ascent center :mask (heuristic t))
))
+ When there is no \"tree-widget-theme-setup\" library in the current
+ theme directory, load the one from the default theme, if available.
Default global properties are provided for respectively Emacs and
XEmacs in the variables `tree-widget-image-properties-emacs', and
`tree-widget-image-properties-xemacs'."
***************
*** 308,319 ****
(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
--- 337,353 ----
(file-name-directory file)) t t)
;; If properties have been setup, use them.
(unless (setq plist (aref tree-widget--theme 2))
! ;; Try from the default theme.
! (load (expand-file-name "../default/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
***************
*** 321,330 ****
;; 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)
--- 355,360 ----
***************
*** 357,363 ****
;; Add the pointer shape
(cons :pointer
(cons
! (cdr (assoc name tree-widget--cursors))
(tree-widget-image-properties file)))))))))
nil)))))
--- 387,394 ----
;; Add the pointer shape
(cons :pointer
(cons
! (or (cdr (assoc name tree-widget--cursors))
! 'hand)
(tree-widget-image-properties file)))))))))
nil)))))
***************
*** 395,434 ****
"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
--- 426,464 ----
"Keymap used inside node buttons.
Handle mouse button 1 click on buttons.")
! (define-widget 'tree-widget-icon 'push-button
! "Basic widget other tree-widget icons are derived from."
:format "%[%t%]"
:button-keymap tree-widget-button-keymap ; XEmacs
:keymap tree-widget-button-keymap ; Emacs
+ :create 'tree-widget-icon-create
+ :action 'tree-widget-icon-action
+ :help-echo 'tree-widget-icon-help-echo
)
! (define-widget 'tree-widget-open-icon 'tree-widget-icon
! "Icon for an expanded tree-widget node."
! :tag "[-]"
! :glyph-name "open"
! )
!
! (define-widget 'tree-widget-empty-icon 'tree-widget-icon
! "Icon for an expanded tree-widget node with no child."
! :tag "[X]"
! :glyph-name "empty"
! )
!
! (define-widget 'tree-widget-close-icon 'tree-widget-icon
! "Icon for a collapsed tree-widget node."
! :tag "[+]"
! :glyph-name "close"
! )
!
! (define-widget 'tree-widget-leaf-icon 'tree-widget-icon
! "Icon for a tree-widget leaf node."
! :tag ""
! :glyph-name "leaf"
! :button-face 'default
)
(define-widget 'tree-widget-guide 'item
***************
*** 454,460 ****
(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"
)
--- 484,490 ----
(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"
)
***************
*** 473,482 ****
: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
--- 503,514 ----
:value-get 'widget-value-value-get
:value-delete 'widget-children-value-delete
:value-create 'tree-widget-value-create
! :action 'tree-widget-action
! :help-echo 'tree-widget-help-echo
! :open-icon 'tree-widget-open-icon
! :close-icon 'tree-widget-close-icon
! :empty-icon 'tree-widget-empty-icon
! :leaf-icon 'tree-widget-leaf-icon
:guide 'tree-widget-guide
:end-guide 'tree-widget-end-guide
:no-guide 'tree-widget-no-guide
***************
*** 553,584 ****
(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)
! (widget-value-set tree nil)
! (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."
--- 585,619 ----
(widget-put arg :value (widget-value child))
;; Save properties specified in :keep.
(tree-widget-keep arg child)))))
!
! ;;; Widget creation
! ;;
! (defvar tree-widget-before-create-icon-functions nil
! "Hooks run before to create a tree-widget icon.
! Each function is passed the icon widget not yet created.
! The value of the icon widget :node property is a tree :node widget or
! a leaf node widget, not yet created.
! This hook can be used to dynamically change properties of the icon and
! associated node widgets. For example, to dynamically change the look
! and feel of the tree-widget by changing the values of the :tag
! and :glyph-name properties of the icon widget.
! This hook should be local in the buffer setup to display widgets.")
!
! (defun tree-widget-icon-create (icon)
! "Create the ICON widget."
! (run-hook-with-args 'tree-widget-before-create-icon-functions icon)
! (widget-put icon :tag-glyph
! (tree-widget-find-image (widget-get icon :glyph-name)))
! ;; Ensure there is at least one char to display the image.
! (and (widget-get icon :tag-glyph)
! (equal "" (or (widget-get icon :tag) ""))
! (widget-put icon :tag " "))
! (widget-default-create icon)
! ;; Insert space between the icon and the node widget.
! (insert-char ? 1)
! (put-text-property
! (1- (point)) (point)
! 'display (list 'space :width tree-widget-space-width)))
(defun tree-widget-value-create (tree)
"Create the TREE tree-widget."
***************
*** 598,634 ****
(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))
--- 633,666 ----
(let ((args (widget-get tree :args))
(xpandr (or (widget-get tree :expander)
(widget-get tree :dynargs)))
(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))
(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")))
;; 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))
! ;; Create the icon widget for the expanded tree.
(push (widget-create-child-and-convert
! tree (widget-get tree (if args :open-icon :empty-icon))
! ;; At this point the node widget isn't yet created.
! :node (setq node (widget-convert node)))
buttons)
! ;; Create the tree node widget.
! (push (widget-create-child tree node) children)
! ;; Update the icon :node with the created node widget.
! (widget-put (car buttons) :node (car children))
! ;; Create the tree children.
(while args
! (setq node (car args)
! args (cdr args))
(and indent (insert-char ?\ indent))
;; Insert guide lines elements from previous levels.
(dolist (f (reverse flags))
***************
*** 644,673 ****
;; 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)
--- 676,767 ----
;; Insert the node handle line
(widget-create-child-and-convert
tree handle :tag-glyph handli)
! (if (tree-widget-p node)
! ;; Create a sub-tree node.
! (push (widget-create-child-and-convert
! tree node :tree-widget--guide-flags
! (cons (if args t) flags))
! children)
! ;; Create the icon widget for a leaf node.
(push (widget-create-child-and-convert
! tree (widget-get tree :leaf-icon)
! ;; At this point the node widget isn't yet created.
! :node (setq node (widget-convert
! node :tree-widget--guide-flags
! (cons (if args t) flags)))
! :tree-widget--leaf-flag t)
! buttons)
! ;; Create the leaf node widget.
! (push (widget-create-child tree node) children)
! ;; Update the icon :node with the created node widget.
! (widget-put (car buttons) :node (car children)))))
;;;; Collapsed node.
! ;; Create the icon widget for the collapsed tree.
(push (widget-create-child-and-convert
! tree (widget-get tree :close-icon)
! ;; At this point the node widget isn't yet created.
! :node (setq node (widget-convert node)))
buttons)
! ;; Create the tree node widget.
! (push (widget-create-child tree node) children)
! ;; Update the icon :node with the created node widget.
! (widget-put (car buttons) :node (car children)))
! ;; Save widget children and buttons. The tree-widget :node child
! ;; is the first element in :children.
(widget-put tree :children (nreverse children))
! (widget-put tree :buttons buttons)))
!
! ;;; Widget callbacks
! ;;
! (defsubst tree-widget-leaf-node-icon-p (icon)
! "Return non-nil if ICON is a leaf node icon.
! That is, if its :node property value is a leaf node widget."
! (widget-get icon :tree-widget--leaf-flag))
!
! (defun tree-widget-icon-action (icon &optional event)
! "Handle the ICON widget :action.
! If ICON :node is a leaf node it handles the :action. The tree-widget
! parent of ICON handles the :action otherwise.
! Pass the received EVENT to :action."
! (let ((node (widget-get icon (if (tree-widget-leaf-node-icon-p icon)
! :node :parent))))
! (widget-apply node :action event)))
!
! (defun tree-widget-icon-help-echo (icon)
! "Return the help-echo string of ICON.
! If ICON :node is a leaf node it handles the :help-echo. The tree-widget
! parent of ICON handles the :help-echo otherwise."
! (let* ((node (widget-get icon (if (tree-widget-leaf-node-icon-p icon)
! :node :parent)))
! (help-echo (widget-get node :help-echo)))
! (if (functionp help-echo)
! (funcall help-echo node)
! help-echo)))
!
! (defvar tree-widget-after-toggle-functions nil
! "Hooks run after toggling a tree-widget expansion.
! Each function is passed a tree-widget. If the value of the :open
! property is non-nil the tree has been expanded, else collapsed.
! This hook should be local in the buffer setup to display widgets.")
!
! (defun tree-widget-action (tree &optional event)
! "Handle the :action of the TREE tree-widget.
! That is, toggle expansion of the TREE tree-widget.
! Ignore the EVENT argument."
! (let ((open (not (widget-get tree :open))))
! (or open
! ;; Before to collapse the node, save children values so next
! ;; open can recover them.
! (tree-widget-children-value-save tree))
! (widget-put tree :open open)
! (widget-value-set tree open)
! (run-hook-with-args 'tree-widget-after-toggle-functions tree)))
!
! (defun tree-widget-help-echo (tree)
! "Return the help-echo string of the TREE tree-widget."
! (if (widget-get tree :open)
! "Collapse node"
! "Expand node"))
(provide 'tree-widget)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to emacs/lisp/tree-widget.el,
David Ponce <=