/[emacs]/emacs/lisp/tree-widget.el
ViewVC logotype

Diff of /emacs/lisp/tree-widget.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.8 by lute, Mon Jul 4 23:08:58 2005 UTC revision 1.9 by dpe, Mon Aug 15 13:00:09 2005 UTC
# Line 59  Line 59 
59  ;;    values, it is necessary to set the :args property to nil, then  ;;    values, it is necessary to set the :args property to nil, then
60  ;;    redraw the tree.  ;;    redraw the tree.
61  ;;  ;;
62  ;; :open-control  (default `tree-widget-open-control')  ;; :open-icon  (default `tree-widget-open-icon')
63  ;; :close-control (default `tree-widget-close-control')  ;; :close-icon (default `tree-widget-close-icon')
64  ;; :empty-control (default `tree-widget-empty-control')  ;; :empty-icon (default `tree-widget-empty-icon')
65  ;; :leaf-control  (default `tree-widget-leaf-control')  ;; :leaf-icon  (default `tree-widget-leaf-icon')
66  ;; :guide         (default `tree-widget-guide')  ;;    Those properties define the icon widgets associated to tree
67  ;; :end-guide     (default `tree-widget-end-guide')  ;;    nodes.  Icon widgets must derive from the `tree-widget-icon'
68  ;; :no-guide      (default `tree-widget-no-guide')  ;;    widget.  The :tag and :glyph-name property values are
69  ;; :handle        (default `tree-widget-handle')  ;;    respectively used when drawing the text and graphic
70  ;; :no-handle     (default `tree-widget-no-handle')  ;;    representation of the tree.  The :tag value must be a string
71  ;;    Those properties define the widgets used to draw the tree, and  ;;    that represent a node icon, like "[+]" for example.  The
72  ;;    permit to customize its look and feel.  For example, using  ;;    :glyph-name value must the name of an image found in the current
73  ;;    `item' widgets with these :tag values:  ;;    theme, like "close" for example (see also the variable
74  ;;  ;;    `tree-widget-theme').
75  ;;    open-control     "[-] "      (OC)  ;;
76  ;;    close-control    "[+] "      (CC)  ;; :guide      (default `tree-widget-guide')
77  ;;    empty-control    "[X] "      (EC)  ;; :end-guide  (default `tree-widget-end-guide')
78  ;;    leaf-control     "[>] "      (LC)  ;; :no-guide   (default `tree-widget-no-guide')
79  ;;    guide            " |"        (GU)  ;; :handle     (default `tree-widget-handle')
80  ;;    noguide          "  "        (NG)  ;; :no-handle  (default `tree-widget-no-handle')
81  ;;    end-guide        " `"        (EG)  ;;    Those properties define `item'-like widgets used to draw the
82  ;;    handle           "-"         (HA)  ;;    tree guide lines.  The :tag property value is used when drawing
83  ;;    no-handle        " "         (NH)  ;;    the text representation of the tree.  The graphic look and feel
84  ;;  ;;    is given by the images named "guide", "no-guide", "end-guide",
85  ;;    A tree will look like this:  ;;    "handle", and "no-handle" found in the current theme (see also
86  ;;  ;;    the variable `tree-widget-theme').
87  ;;    [-] 1                        (OC :node)  ;;
88  ;;     |-[+] 1.0                   (GU+HA+CC :node)  ;; These are the default :tag values for icons, and guide lines:
89  ;;     |-[X] 1.1                   (GU+HA+EC :node)  ;;
90  ;;     `-[-] 1.2                   (EG+HA+OC :node)  ;; open-icon    "[-]"
91  ;;        |-[>] 1.2.1              (NG+NH+GU+HA+LC child)  ;; close-icon   "[+]"
92  ;;        `-[>] 1.2.2              (NG+NH+EG+HA+LC child)  ;; empty-icon   "[X]"
93    ;; leaf-icon    ""
94    ;; guide        " |"
95    ;; no-guide     "  "
96    ;; end-guide    " `"
97    ;; handle       "-"
98    ;; no-handle    " "
99    ;;
100    ;; The text representation of a tree looks like this:
101    ;;
102    ;; [-] 1        (open-icon :node)
103    ;;  |-[+] 1.0   (guide+handle+close-icon :node)
104    ;;  |-[X] 1.1   (guide+handle+empty-icon :node)
105    ;;  `-[-] 1.2   (end-guide+handle+open-icon :node)
106    ;;     |- 1.2.1 (no-guide+no-handle+guide+handle+leaf-icon leaf)
107    ;;     `- 1.2.2 (no-guide+no-handle+end-guide+handle+leaf-icon leaf)
108  ;;  ;;
109  ;; By default, images will be used instead of strings to draw a  ;; By default, images will be used instead of strings to draw a
110  ;; nice-looking tree.  See the `tree-widget-image-enable',  ;; nice-looking tree.  See the `tree-widget-image-enable',
# Line 133  The default is to use the \"tree-widget\ Line 148  The default is to use the \"tree-widget\
148  (defcustom tree-widget-theme nil  (defcustom tree-widget-theme nil
149    "*Name of the theme where to look up for images.    "*Name of the theme where to look up for images.
150  It must be a sub directory of the directory specified in variable  It must be a sub directory of the directory specified in variable
151  `tree-widget-themes-directory'.  The default is \"default\".  When an  `tree-widget-themes-directory'.  The default theme is \"default\".
152  image is not found in this theme, the default theme is searched too.  When an image is not found in a theme, it is searched in the default
153  A complete theme must contain images with these file names with a  theme.
154  supported extension (see also `tree-widget-image-formats'):  
155    A complete theme must at least contain images with these file names
156    with a supported extension (see also `tree-widget-image-formats'):
157    
 \"open\"  
   Represent an expanded node.  
 \"close\"  
   Represent a collapsed node.  
 \"empty\"  
   Represent an expanded node with no child.  
 \"leaf\"  
   Represent a leaf node.  
158  \"guide\"  \"guide\"
159    A vertical guide line.    A vertical guide line.
160  \"no-guide\"  \"no-guide\"
# Line 153  supported extension (see also `tree-widg Line 162  supported extension (see also `tree-widg
162  \"end-guide\"  \"end-guide\"
163    End of a vertical guide line.    End of a vertical guide line.
164  \"handle\"  \"handle\"
165    Horizontal guide line that joins the vertical guide line to a node.    Horizontal guide line that joins the vertical guide line to an icon.
166  \"no-handle\"  \"no-handle\"
167    An invisible handle."    An invisible handle.
168    
169    Plus images whose name is given by the :glyph-name property of the
170    icon widgets used to draw the tree.  By default these images are used:
171    
172    \"open\"
173      Icon associated to an expanded tree.
174    \"close\"
175      Icon associated to a collapsed tree.
176    \"empty\"
177      Icon associated to an expanded tree with no child.
178    \"leaf\"
179      Icon associated to a leaf node."
180    :type '(choice (const  :tag "Default" nil)    :type '(choice (const  :tag "Default" nil)
181                   (string :tag "Name"))                   (string :tag "Name"))
182    :group 'tree-widget)    :group 'tree-widget)
# Line 171  supported extension (see also `tree-widg Line 192  supported extension (see also `tree-widg
192    "*Default properties of XEmacs images."    "*Default properties of XEmacs images."
193    :type 'plist    :type 'plist
194    :group 'tree-widget)    :group 'tree-widget)
195    
196    (defcustom tree-widget-space-width 0.5
197      "Amount of space between an icon image and a node widget.
198    Must be a valid space :width display property."
199      :group 'tree-widget
200      :type 'sexp)
201    
202  ;;; Image support  ;;; Image support
203  ;;  ;;
# Line 297  properties.  Typically it should contain Line 324  properties.  Typically it should contain
324       '(:ascent center :mask (heuristic t))       '(:ascent center :mask (heuristic t))
325       ))       ))
326    
327    When there is no \"tree-widget-theme-setup\" library in the current
328    theme directory, load the one from the default theme, if available.
329  Default global properties are provided for respectively Emacs and  Default global properties are provided for respectively Emacs and
330  XEmacs in the variables `tree-widget-image-properties-emacs', and  XEmacs in the variables `tree-widget-image-properties-emacs', and
331  `tree-widget-image-properties-xemacs'."  `tree-widget-image-properties-xemacs'."
# Line 308  XEmacs in the variables `tree-widget-ima Line 337  XEmacs in the variables `tree-widget-ima
337                                (file-name-directory file)) t t)                                (file-name-directory file)) t t)
338        ;; If properties have been setup, use them.        ;; If properties have been setup, use them.
339        (unless (setq plist (aref tree-widget--theme 2))        (unless (setq plist (aref tree-widget--theme 2))
340          ;; By default, use supplied global properties.          ;; Try from the default theme.
341          (setq plist (if (featurep 'xemacs)          (load (expand-file-name "../default/tree-widget-theme-setup"
342                          tree-widget-image-properties-xemacs                                  (file-name-directory file)) t t)
343                        tree-widget-image-properties-emacs))          ;; If properties have been setup, use them.
344          ;; Setup the cache.          (unless (setq plist (aref tree-widget--theme 2))
345          (tree-widget-set-image-properties plist)))            ;; By default, use supplied global properties.
346              (setq plist (if (featurep 'xemacs)
347                              tree-widget-image-properties-xemacs
348                            tree-widget-image-properties-emacs))
349              ;; Setup the cache.
350              (tree-widget-set-image-properties plist))))
351      plist))      plist))
352    
353  (defconst tree-widget--cursors  (defconst tree-widget--cursors
# Line 321  XEmacs in the variables `tree-widget-ima Line 355  XEmacs in the variables `tree-widget-ima
355    ;; This feature works since Emacs 22, and ignored on older versions,    ;; This feature works since Emacs 22, and ignored on older versions,
356    ;; and XEmacs.    ;; and XEmacs.
357    '(    '(
     ("open"      . hand )  
     ("close"     . hand )  
     ("empty"     . arrow)  
     ("leaf"      . arrow)  
358      ("guide"     . arrow)      ("guide"     . arrow)
359      ("no-guide"  . arrow)      ("no-guide"  . arrow)
360      ("end-guide" . arrow)      ("end-guide" . arrow)
# Line 357  found." Line 387  found."
387                     ;; Add the pointer shape                     ;; Add the pointer shape
388                     (cons :pointer                     (cons :pointer
389                           (cons                           (cons
390                            (cdr (assoc name tree-widget--cursors))                            (or (cdr (assoc name tree-widget--cursors))
391                                  'hand)
392                            (tree-widget-image-properties file)))))))))                            (tree-widget-image-properties file)))))))))
393            nil)))))            nil)))))
394    
# Line 395  Return the image found, or nil if not fo Line 426  Return the image found, or nil if not fo
426    "Keymap used inside node buttons.    "Keymap used inside node buttons.
427  Handle mouse button 1 click on buttons.")  Handle mouse button 1 click on buttons.")
428    
429  (define-widget 'tree-widget-control 'push-button  (define-widget 'tree-widget-icon 'push-button
430    "Basic widget other tree-widget node buttons are derived from."    "Basic widget other tree-widget icons are derived from."
431    :format        "%[%t%]"    :format        "%[%t%]"
432    :button-keymap tree-widget-button-keymap ; XEmacs    :button-keymap tree-widget-button-keymap ; XEmacs
433    :keymap        tree-widget-button-keymap ; Emacs    :keymap        tree-widget-button-keymap ; Emacs
434      :create        'tree-widget-icon-create
435      :action        'tree-widget-icon-action
436      :help-echo     'tree-widget-icon-help-echo
437    )    )
438    
439  (define-widget 'tree-widget-open-control 'tree-widget-control  (define-widget 'tree-widget-open-icon 'tree-widget-icon
440    "Button for an expanded tree-widget node."    "Icon for an expanded tree-widget node."
441    :tag       "[-] "    :tag        "[-]"
442    ;;:tag-glyph (tree-widget-find-image "open")    :glyph-name "open"
443    :notify    'tree-widget-close-node    )
444    :help-echo "Collapse node"  
445    )  (define-widget 'tree-widget-empty-icon 'tree-widget-icon
446      "Icon for an expanded tree-widget node with no child."
447  (define-widget 'tree-widget-empty-control 'tree-widget-open-control    :tag        "[X]"
448    "Button for an expanded tree-widget node with no child."    :glyph-name "empty"
449    :tag       "[X] "    )
450    ;;:tag-glyph (tree-widget-find-image "empty")  
451    )  (define-widget 'tree-widget-close-icon 'tree-widget-icon
452      "Icon for a collapsed tree-widget node."
453  (define-widget 'tree-widget-close-control 'tree-widget-control    :tag        "[+]"
454    "Button for a collapsed tree-widget node."    :glyph-name "close"
455    :tag       "[+] "    )
456    ;;:tag-glyph (tree-widget-find-image "close")  
457    :notify    'tree-widget-open-node  (define-widget 'tree-widget-leaf-icon 'tree-widget-icon
458    :help-echo "Expand node"    "Icon for a tree-widget leaf node."
459    )    :tag        ""
460      :glyph-name "leaf"
461  (define-widget 'tree-widget-leaf-control 'item    :button-face 'default
   "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"  
462    )    )
463    
464  (define-widget 'tree-widget-guide 'item  (define-widget 'tree-widget-guide 'item
# Line 454  Handle mouse button 1 click on buttons." Line 484  Handle mouse button 1 click on buttons."
484    
485  (define-widget 'tree-widget-handle 'item  (define-widget 'tree-widget-handle 'item
486    "Horizontal guide line that joins a vertical guide line to a node."    "Horizontal guide line that joins a vertical guide line to a node."
487    :tag       " "    :tag       "-"
488    ;;:tag-glyph (tree-widget-find-image "handle")    ;;:tag-glyph (tree-widget-find-image "handle")
489    :format    "%t"    :format    "%t"
490    )    )
# Line 473  Handle mouse button 1 click on buttons." Line 503  Handle mouse button 1 click on buttons."
503    :value-get      'widget-value-value-get    :value-get      'widget-value-value-get
504    :value-delete   'widget-children-value-delete    :value-delete   'widget-children-value-delete
505    :value-create   'tree-widget-value-create    :value-create   'tree-widget-value-create
506    :open-control   'tree-widget-open-control    :action         'tree-widget-action
507    :close-control  'tree-widget-close-control    :help-echo      'tree-widget-help-echo
508    :empty-control  'tree-widget-empty-control    :open-icon      'tree-widget-open-icon
509    :leaf-control   'tree-widget-leaf-control    :close-icon     'tree-widget-close-icon
510      :empty-icon     'tree-widget-empty-icon
511      :leaf-icon      'tree-widget-leaf-icon
512    :guide          'tree-widget-guide    :guide          'tree-widget-guide
513    :end-guide      'tree-widget-end-guide    :end-guide      'tree-widget-end-guide
514    :no-guide       'tree-widget-no-guide    :no-guide       'tree-widget-no-guide
# Line 553  WIDGET's :node sub-widget." Line 585  WIDGET's :node sub-widget."
585           (widget-put arg :value (widget-value child))           (widget-put arg :value (widget-value child))
586           ;; Save properties specified in :keep.           ;; Save properties specified in :keep.
587           (tree-widget-keep arg child)))))           (tree-widget-keep arg child)))))
588    
589  (defvar tree-widget-after-toggle-functions nil  ;;; Widget creation
590    "Hooks run after toggling a tree-widget expansion.  ;;
591  Each function will receive the tree-widget as its unique argument.  (defvar tree-widget-before-create-icon-functions nil
592  This hook should be local in the buffer used to display widgets.")    "Hooks run before to create a tree-widget icon.
593    Each function is passed the icon widget not yet created.
594  (defun tree-widget-close-node (widget &rest ignore)  The value of the icon widget :node property is a tree :node widget or
595    "Collapse the tree-widget, parent of WIDGET.  a leaf node widget, not yet created.
596  WIDGET is, or derives from, a tree-widget-open-control widget.  This hook can be used to dynamically change properties of the icon and
597  IGNORE other arguments."  associated node widgets.  For example, to dynamically change the look
598    (let ((tree (widget-get widget :parent)))  and feel of the tree-widget by changing the values of the :tag
599      ;; Before to collapse the node, save children values so next open  and :glyph-name properties of the icon widget.
600      ;; can recover them.  This hook should be local in the buffer setup to display widgets.")
601      (tree-widget-children-value-save tree)  
602      (widget-put tree :open nil)  (defun tree-widget-icon-create (icon)
603      (widget-value-set tree nil)    "Create the ICON widget."
604      (run-hook-with-args 'tree-widget-after-toggle-functions tree)))    (run-hook-with-args 'tree-widget-before-create-icon-functions icon)
605      (widget-put icon :tag-glyph
606  (defun tree-widget-open-node (widget &rest ignore)                (tree-widget-find-image (widget-get icon :glyph-name)))
607    "Expand the tree-widget, parent of WIDGET.    ;; Ensure there is at least one char to display the image.
608  WIDGET is, or derives from, a tree-widget-close-control widget.    (and (widget-get icon :tag-glyph)
609  IGNORE other arguments."         (equal "" (or (widget-get icon :tag) ""))
610    (let ((tree (widget-get widget :parent)))         (widget-put icon :tag " "))
611      (widget-put tree :open t)    (widget-default-create icon)
612      (widget-value-set tree t)    ;; Insert space between the icon and the node widget.
613      (run-hook-with-args 'tree-widget-after-toggle-functions tree)))    (insert-char ?  1)
614      (put-text-property
615       (1- (point)) (point)
616       'display (list 'space :width tree-widget-space-width)))
617    
618  (defun tree-widget-value-create (tree)  (defun tree-widget-value-create (tree)
619    "Create the TREE tree-widget."    "Create the TREE tree-widget."
# Line 598  IGNORE other arguments." Line 633  IGNORE other arguments."
633          (let ((args     (widget-get tree :args))          (let ((args     (widget-get tree :args))
634                (xpandr   (or (widget-get tree :expander)                (xpandr   (or (widget-get tree :expander)
635                              (widget-get tree :dynargs)))                              (widget-get tree :dynargs)))
               (leaf     (widget-get tree :leaf-control))  
636                (guide    (widget-get tree :guide))                (guide    (widget-get tree :guide))
637                (noguide  (widget-get tree :no-guide))                (noguide  (widget-get tree :no-guide))
638                (endguide (widget-get tree :end-guide))                (endguide (widget-get tree :end-guide))
639                (handle   (widget-get tree :handle))                (handle   (widget-get tree :handle))
640                (nohandle (widget-get tree :no-handle))                (nohandle (widget-get tree :no-handle))
               (leafi    (tree-widget-find-image "leaf"))  
641                (guidi    (tree-widget-find-image "guide"))                (guidi    (tree-widget-find-image "guide"))
642                (noguidi  (tree-widget-find-image "no-guide"))                (noguidi  (tree-widget-find-image "no-guide"))
643                (endguidi (tree-widget-find-image "end-guide"))                (endguidi (tree-widget-find-image "end-guide"))
644                (handli   (tree-widget-find-image "handle"))                (handli   (tree-widget-find-image "handle"))
645                (nohandli (tree-widget-find-image "no-handle"))                (nohandli (tree-widget-find-image "no-handle")))
               child)  
646            ;; Request children at run time, when not already done.            ;; Request children at run time, when not already done.
647            (when (and (not args) xpandr)            (when (and (not args) xpandr)
648              (setq args (mapcar 'widget-convert (funcall xpandr tree)))              (setq args (mapcar 'widget-convert (funcall xpandr tree)))
649              (widget-put tree :args args))              (widget-put tree :args args))
650            ;; Insert the node "open" button.            ;; Create the icon widget for the expanded tree.
651            (push (widget-create-child-and-convert            (push (widget-create-child-and-convert
652                   tree (widget-get                   tree (widget-get tree (if args :open-icon :empty-icon))
653                         tree (if args :open-control :empty-control))                   ;; At this point the node widget isn't yet created.
654                   :tag-glyph (tree-widget-find-image                   :node (setq node (widget-convert node)))
                              (if args "open" "empty")))  
655                  buttons)                  buttons)
656            ;; Insert the :node element.            ;; Create the tree node widget.
657            (push (widget-create-child-and-convert tree node)            (push (widget-create-child tree node) children)
658                  children)            ;; Update the icon :node with the created node widget.
659            ;; Insert children.            (widget-put (car buttons) :node (car children))
660              ;; Create the tree children.
661            (while args            (while args
662              (setq child (car args)              (setq node (car args)
663                    args  (cdr args))                    args (cdr args))
664              (and indent (insert-char ?\  indent))              (and indent (insert-char ?\  indent))
665              ;; Insert guide lines elements from previous levels.              ;; Insert guide lines elements from previous levels.
666              (dolist (f (reverse flags))              (dolist (f (reverse flags))
# Line 644  IGNORE other arguments." Line 676  IGNORE other arguments."
676              ;; Insert the node handle line              ;; Insert the node handle line
677              (widget-create-child-and-convert              (widget-create-child-and-convert
678               tree handle :tag-glyph handli)               tree handle :tag-glyph handli)
679              ;; If leaf node, insert a leaf node button.              (if (tree-widget-p node)
680              (unless (tree-widget-p child)                  ;; Create a sub-tree node.
681                    (push (widget-create-child-and-convert
682                           tree node :tree-widget--guide-flags
683                           (cons (if args t) flags))
684                          children)
685                  ;; Create the icon widget for a leaf node.
686                (push (widget-create-child-and-convert                (push (widget-create-child-and-convert
687                       tree leaf :tag-glyph leafi)                       tree (widget-get tree :leaf-icon)
688                      buttons))                       ;; At this point the node widget isn't yet created.
689              ;; Finally, insert the child widget.                       :node (setq node (widget-convert
690              (push (widget-create-child-and-convert                                         node :tree-widget--guide-flags
691                     tree child                                         (cons (if args t) flags)))
692                     :tree-widget--guide-flags (cons (if args t) flags))                       :tree-widget--leaf-flag t)
693                    children)))                      buttons)
694                  ;; Create the leaf node widget.
695                  (push (widget-create-child tree node) children)
696                  ;; Update the icon :node with the created node widget.
697                  (widget-put (car buttons) :node (car children)))))
698  ;;;; Collapsed node.  ;;;; Collapsed node.
699        ;; Insert the "closed" node button.        ;; Create the icon widget for the collapsed tree.
700        (push (widget-create-child-and-convert        (push (widget-create-child-and-convert
701               tree (widget-get tree :close-control)               tree (widget-get tree :close-icon)
702               :tag-glyph (tree-widget-find-image "close"))               ;; At this point the node widget isn't yet created.
703                 :node (setq node (widget-convert node)))
704              buttons)              buttons)
705        ;; Insert the :node element.        ;; Create the tree node widget.
706        (push (widget-create-child-and-convert tree node)        (push (widget-create-child tree node) children)
707              children))        ;; Update the icon :node with the created node widget.
708      ;; Save widget children and buttons.  The :node child is the first        (widget-put (car buttons) :node (car children)))
709      ;; element in children.      ;; Save widget children and buttons.  The tree-widget :node child
710        ;; is the first element in :children.
711      (widget-put tree :children (nreverse children))      (widget-put tree :children (nreverse children))
712      (widget-put tree :buttons  buttons)      (widget-put tree :buttons  buttons)))
713      ))  
714    ;;; Widget callbacks
715    ;;
716    (defsubst tree-widget-leaf-node-icon-p (icon)
717      "Return non-nil if ICON is a leaf node icon.
718    That is, if its :node property value is a leaf node widget."
719      (widget-get icon :tree-widget--leaf-flag))
720    
721    (defun tree-widget-icon-action (icon &optional event)
722      "Handle the ICON widget :action.
723    If ICON :node is a leaf node it handles the :action.  The tree-widget
724    parent of ICON handles the :action otherwise.
725    Pass the received EVENT to :action."
726      (let ((node (widget-get icon (if (tree-widget-leaf-node-icon-p icon)
727                                       :node :parent))))
728        (widget-apply node :action event)))
729    
730    (defun tree-widget-icon-help-echo (icon)
731      "Return the help-echo string of ICON.
732    If ICON :node is a leaf node it handles the :help-echo.  The tree-widget
733    parent of ICON handles the :help-echo otherwise."
734      (let* ((node (widget-get icon (if (tree-widget-leaf-node-icon-p icon)
735                                        :node :parent)))
736             (help-echo (widget-get node :help-echo)))
737        (if (functionp help-echo)
738            (funcall help-echo node)
739          help-echo)))
740    
741    (defvar tree-widget-after-toggle-functions nil
742      "Hooks run after toggling a tree-widget expansion.
743    Each function is passed a tree-widget.  If the value of the :open
744    property is non-nil the tree has been expanded, else collapsed.
745    This hook should be local in the buffer setup to display widgets.")
746    
747    (defun tree-widget-action (tree &optional event)
748      "Handle the :action of the TREE tree-widget.
749    That is, toggle expansion of the TREE tree-widget.
750    Ignore the EVENT argument."
751      (let ((open (not (widget-get tree :open))))
752        (or open
753            ;; Before to collapse the node, save children values so next
754            ;; open can recover them.
755            (tree-widget-children-value-save tree))
756        (widget-put tree :open open)
757        (widget-value-set tree open)
758        (run-hook-with-args 'tree-widget-after-toggle-functions tree)))
759    
760    (defun tree-widget-help-echo (tree)
761      "Return the help-echo string of the TREE tree-widget."
762      (if (widget-get tree :open)
763          "Collapse node"
764        "Expand node"))
765    
766  (provide 'tree-widget)  (provide 'tree-widget)
767    

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26