annotate lisp/tree-widget.el @ 63467:c4d3f401bf34

eval-and-compile inlined functions so they will be available at run-time too. (tree-widget-value-create): Fix last change.
author David Ponce <david@dponce.com>
date Wed, 15 Jun 2005 13:49:02 +0000
parents 1df1bb151415
children 0f66f455f7d7
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
55588
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
1 ;;; tree-widget.el --- Tree widget
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
2
63465
1df1bb151415 (tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents: 59996
diff changeset
3 ;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
55588
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
4
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
5 ;; Author: David Ponce <david@dponce.com>
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
6 ;; Maintainer: David Ponce <david@dponce.com>
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
7 ;; Created: 16 Feb 2001
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
8 ;; Keywords: extensions
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
9
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
10 ;; This file is part of GNU Emacs
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
11
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
12 ;; This program is free software; you can redistribute it and/or
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
13 ;; modify it under the terms of the GNU General Public License as
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
14 ;; published by the Free Software Foundation; either version 2, or (at
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
15 ;; your option) any later version.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
16
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
17 ;; This program is distributed in the hope that it will be useful, but
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
20 ;; General Public License for more details.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
21
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
23 ;; along with this program; see the file COPYING. If not, write to
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
24 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
25 ;; Boston, MA 02111-1307, USA.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
26
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
27 ;;; Commentary:
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
28 ;;
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
29 ;; This library provide a tree widget useful to display data
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
30 ;; structures organized in a hierarchical order.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
31 ;;
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
32 ;; The following properties are specific to the tree widget:
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
33 ;;
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
34 ;; :open
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
35 ;; Set to non-nil to unfold the tree. By default the tree is
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
36 ;; folded.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
37 ;;
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
38 ;; :node
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
39 ;; Specify the widget used to represent a tree node. By default
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
40 ;; this is an `item' widget which displays the tree-widget :tag
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
41 ;; property value if defined or a string representation of the
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
42 ;; tree-widget value.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
43 ;;
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
44 ;; :keep
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
45 ;; Specify a list of properties to keep when the tree is
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
46 ;; folded so they can be recovered when the tree is unfolded.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
47 ;; This property can be used in child widgets too.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
48 ;;
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
49 ;; :dynargs
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
50 ;; Specify a function to be called when the tree is unfolded, to
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
51 ;; dynamically provide the tree children in response to an unfold
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
52 ;; request. This function will be passed the tree widget and
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
53 ;; must return a list of child widgets. That list will be stored
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
54 ;; as the :args property of the parent tree.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
55
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
56 ;; To speed up successive unfold requests, the :dynargs function
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
57 ;; can directly return the :args value if non-nil. Refreshing
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
58 ;; child values can be achieved by giving the :args property the
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
59 ;; value nil, then redrawing the tree.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
60 ;;
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
61 ;; :has-children
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
62 ;; Specify if this tree has children. This property has meaning
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
63 ;; only when used with the above :dynargs one. It indicates that
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
64 ;; child widgets exist but will be dynamically provided when
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
65 ;; unfolding the node.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
66 ;;
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
67 ;; :open-control (default `tree-widget-open-control')
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
68 ;; :close-control (default `tree-widget-close-control')
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
69 ;; :empty-control (default `tree-widget-empty-control')
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
70 ;; :leaf-control (default `tree-widget-leaf-control')
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
71 ;; :guide (default `tree-widget-guide')
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
72 ;; :end-guide (default `tree-widget-end-guide')
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
73 ;; :no-guide (default `tree-widget-no-guide')
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
74 ;; :handle (default `tree-widget-handle')
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
75 ;; :no-handle (default `tree-widget-no-handle')
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
76 ;;
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
77 ;; The above nine properties define the widgets used to draw the tree.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
78 ;; For example, using widgets that display this values:
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
79 ;;
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
80 ;; open-control "[-] "
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
81 ;; close-control "[+] "
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
82 ;; empty-control "[X] "
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
83 ;; leaf-control "[>] "
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
84 ;; guide " |"
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
85 ;; noguide " "
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
86 ;; end-guide " `"
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
87 ;; handle "-"
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
88 ;; no-handle " "
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
89 ;;
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
90 ;; A tree will look like this:
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
91 ;;
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
92 ;; [-] 1 open-control
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
93 ;; |-[+] 1.0 guide+handle+close-control
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
94 ;; |-[X] 1.1 guide+handle+empty-control
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
95 ;; `-[-] 1.2 end-guide+handle+open-control
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
96 ;; |-[>] 1.2.1 no-guide+no-handle+guide+handle+leaf-control
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
97 ;; `-[>] 1.2.2 no-guide+no-handle+end-guide+handle+leaf-control
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
98 ;;
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
99 ;; By default, the tree widget try to use images instead of strings to
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
100 ;; draw a nice-looking tree. See the `tree-widget-themes-directory'
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
101 ;; and `tree-widget-theme' options for more details.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
102 ;;
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
103
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
104 ;;; History:
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
105 ;;
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
106
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
107 ;;; Code:
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
108 (eval-when-compile (require 'cl))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
109 (require 'wid-edit)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
110
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
111 ;;; Customization
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
112 ;;
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
113 (defgroup tree-widget nil
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
114 "Customization support for the Tree Widget Library."
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 55594
diff changeset
115 :version "22.1"
55588
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
116 :group 'widgets)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
117
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
118 (defcustom tree-widget-image-enable
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
119 (not (or (featurep 'xemacs) (< emacs-major-version 21)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
120 "*non-nil means that tree-widget will try to use images."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
121 :type 'boolean
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
122 :group 'tree-widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
123
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
124 (defcustom tree-widget-themes-directory "tree-widget"
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
125 "*Name of the directory where to lookup for image themes.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
126 When nil use the directory where the tree-widget library is located.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
127 When a relative name is specified, try to locate that sub-directory in
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
128 `load-path', then in the data directory, and use the first one found.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
129 Default is to search for a \"tree-widget\" sub-directory.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
130
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
131 The data directory is the value of:
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
132 - the variable `data-directory' on GNU Emacs;
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
133 - `(locate-data-directory \"tree-widget\")' on XEmacs."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
134 :type '(choice (const :tag "Default" "tree-widget")
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
135 (const :tag "With the library" nil)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
136 (directory :format "%{%t%}:\n%v"))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
137 :group 'tree-widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
138
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
139 (defcustom tree-widget-theme nil
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
140 "*Name of the theme to use to lookup for images.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
141 The theme name must be a subdirectory in `tree-widget-themes-directory'.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
142 If nil use the \"default\" theme.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
143 When a image is not found in the current theme, the \"default\" theme
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
144 is searched too.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
145 A complete theme should contain images with these file names:
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
146
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
147 Name Represents
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
148 ----------- ------------------------------------------------
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
149 open opened node (for example an open folder)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
150 close closed node (for example a close folder)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
151 empty empty node (a node without children)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
152 leaf leaf node (for example a document)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
153 guide a vertical guide line
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
154 no-guide an invisible guide line
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
155 end-guide the end of a vertical guide line
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
156 handle an horizontal line drawn before a node control
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
157 no-handle an invisible handle
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
158 ----------- ------------------------------------------------"
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
159 :type '(choice (const :tag "Default" nil)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
160 (string :tag "Name"))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
161 :group 'tree-widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
162
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
163 (defcustom tree-widget-image-properties-emacs
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
164 '(:ascent center :mask (heuristic t))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
165 "*Properties of GNU Emacs images."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
166 :type 'plist
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
167 :group 'tree-widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
168
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
169 (defcustom tree-widget-image-properties-xemacs
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
170 nil
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
171 "*Properties of XEmacs images."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
172 :type 'plist
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
173 :group 'tree-widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
174
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
175 ;;; Image support
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
176 ;;
63467
c4d3f401bf34 eval-and-compile inlined functions so they will
David Ponce <david@dponce.com>
parents: 63465
diff changeset
177 (eval-and-compile ;; GNU Emacs/XEmacs compatibility stuff
55588
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
178 (cond
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
179 ;; XEmacs
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
180 ((featurep 'xemacs)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
181 (defsubst tree-widget-use-image-p ()
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
182 "Return non-nil if image support is currently enabled."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
183 (and tree-widget-image-enable
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
184 widget-glyph-enable
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
185 (console-on-window-system-p)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
186 (defsubst tree-widget-create-image (type file &optional props)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
187 "Create an image of type TYPE from FILE.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
188 Give the image the specified properties PROPS.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
189 Return the new image."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
190 (apply 'make-glyph `([,type :file ,file ,@props])))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
191 (defsubst tree-widget-image-formats ()
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
192 "Return the list of image formats, file name suffixes associations.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
193 See also the option `widget-image-file-name-suffixes'."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
194 (delq nil
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
195 (mapcar
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
196 #'(lambda (fmt)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
197 (and (valid-image-instantiator-format-p (car fmt)) fmt))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
198 widget-image-file-name-suffixes)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
199 )
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
200 ;; GNU Emacs
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
201 (t
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
202 (defsubst tree-widget-use-image-p ()
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
203 "Return non-nil if image support is currently enabled."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
204 (and tree-widget-image-enable
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
205 widget-image-enable
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
206 (display-images-p)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
207 (defsubst tree-widget-create-image (type file &optional props)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
208 "Create an image of type TYPE from FILE.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
209 Give the image the specified properties PROPS.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
210 Return the new image."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
211 (apply 'create-image `(,file ,type nil ,@props)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
212 (defsubst tree-widget-image-formats ()
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
213 "Return the list of image formats, file name suffixes associations.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
214 See also the option `widget-image-conversion'."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
215 (delq nil
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
216 (mapcar
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
217 #'(lambda (fmt)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
218 (and (image-type-available-p (car fmt)) fmt))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
219 widget-image-conversion)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
220 ))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
221 )
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
222
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
223 ;; Buffer local cache of theme data.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
224 (defvar tree-widget--theme nil)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
225
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
226 (defsubst tree-widget-theme-name ()
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
227 "Return the current theme name, or nil if no theme is active."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
228 (and tree-widget--theme (aref tree-widget--theme 0)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
229
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
230 (defsubst tree-widget-set-theme (&optional name)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
231 "In the current buffer, set the theme to use for images.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
232 The current buffer should be where the tree widget is drawn.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
233 Optional argument NAME is the name of the theme to use, which defaults
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
234 to the value of the variable `tree-widget-theme'.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
235 Does nothing if NAME is the name of the current theme."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
236 (or name (setq name (or tree-widget-theme "default")))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
237 (unless (equal name (tree-widget-theme-name))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
238 (set (make-local-variable 'tree-widget--theme)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
239 (make-vector 4 nil))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
240 (aset tree-widget--theme 0 name)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
241
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
242 (defun tree-widget-themes-directory ()
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
243 "Locate the directory where to search for a theme.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
244 It is defined in variable `tree-widget-themes-directory'.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
245 Return the absolute name of the directory found, or nil if the
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
246 specified directory is not accessible."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
247 (let ((found (aref tree-widget--theme 1)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
248 (if found
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
249 ;; The directory is available in the cache.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
250 (unless (eq found 'void) found)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
251 (cond
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
252 ;; Use the directory where tree-widget is located.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
253 ((null tree-widget-themes-directory)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
254 (setq found (locate-library "tree-widget"))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
255 (when found
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
256 (setq found (file-name-directory found))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
257 (or (file-accessible-directory-p found)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
258 (setq found nil))))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
259 ;; Check accessibility of absolute directory name.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
260 ((file-name-absolute-p tree-widget-themes-directory)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
261 (setq found (expand-file-name tree-widget-themes-directory))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
262 (or (file-accessible-directory-p found)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
263 (setq found nil)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
264 ;; Locate a sub-directory in `load-path' and data directory.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
265 (t
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
266 (let ((path
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
267 (append load-path
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
268 ;; The data directory depends on which, GNU
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
269 ;; Emacs or XEmacs, is running.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
270 (list (if (fboundp 'locate-data-directory)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
271 (locate-data-directory "tree-widget")
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
272 data-directory)))))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
273 (while (and path (not found))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
274 (when (car path)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
275 (setq found (expand-file-name
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
276 tree-widget-themes-directory (car path)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
277 (or (file-accessible-directory-p found)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
278 (setq found nil)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
279 (setq path (cdr path))))))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
280 ;; Store the result in the cache for later use.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
281 (aset tree-widget--theme 1 (or found 'void))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
282 found)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
283
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
284 (defsubst tree-widget-set-image-properties (props)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
285 "In current theme, set images properties to PROPS."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
286 (aset tree-widget--theme 2 props))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
287
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
288 (defun tree-widget-image-properties (file)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
289 "Return properties of images in current theme.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
290 If the \"tree-widget-theme-setup.el\" file exists in the directory
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
291 where is located the image FILE, load it to setup theme images
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
292 properties. Typically that file should contain something like this:
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
293
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
294 (tree-widget-set-image-properties
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
295 (if (featurep 'xemacs)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
296 '(:ascent center)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
297 '(:ascent center :mask (heuristic t))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
298 ))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
299
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
300 By default, use the global properties provided in variables
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
301 `tree-widget-image-properties-emacs' or
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
302 `tree-widget-image-properties-xemacs'."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
303 ;; If properties are in the cache, use them.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
304 (or (aref tree-widget--theme 2)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
305 (progn
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
306 ;; Load tree-widget-theme-setup if available.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
307 (load (expand-file-name
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
308 "tree-widget-theme-setup"
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
309 (file-name-directory file)) t t)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
310 ;; If properties have been setup, use them.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
311 (or (aref tree-widget--theme 2)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
312 ;; By default, use supplied global properties.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
313 (tree-widget-set-image-properties
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
314 (if (featurep 'xemacs)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
315 tree-widget-image-properties-xemacs
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
316 tree-widget-image-properties-emacs))))))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
317
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
318 (defun tree-widget-find-image (name)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
319 "Find the image with NAME in current theme.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
320 NAME is an image file name sans extension.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
321 Search first in current theme, then in default theme.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
322 A theme is a sub-directory of the root theme directory specified in
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
323 variable `tree-widget-themes-directory'.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
324 Return the first image found having a supported format in those
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
325 returned by the function `tree-widget-image-formats', or nil if not
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
326 found."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
327 (when (tree-widget-use-image-p)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
328 ;; Ensure there is an active theme.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
329 (tree-widget-set-theme (tree-widget-theme-name))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
330 ;; If the image is in the cache, return it.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
331 (or (cdr (assoc name (aref tree-widget--theme 3)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
332 ;; Search the image in the current, then default themes.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
333 (let ((default-directory (tree-widget-themes-directory)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
334 (when default-directory
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
335 (let* ((theme (tree-widget-theme-name))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
336 (path (mapcar 'expand-file-name
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
337 (if (equal theme "default")
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
338 '("default")
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
339 (list theme "default"))))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
340 (formats (tree-widget-image-formats))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
341 (found
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
342 (catch 'found
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
343 (dolist (dir path)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
344 (dolist (fmt formats)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
345 (dolist (ext (cdr fmt))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
346 (let ((file (expand-file-name
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
347 (concat name ext) dir)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
348 (and (file-readable-p file)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
349 (file-regular-p file)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
350 (throw 'found
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
351 (cons (car fmt) file)))))))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
352 nil)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
353 (when found
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
354 (let ((image
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
355 (tree-widget-create-image
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
356 (car found) (cdr found)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
357 (tree-widget-image-properties (cdr found)))))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
358 ;; Store image in the cache for later use.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
359 (push (cons name image) (aref tree-widget--theme 3))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
360 image))))))))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
361
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
362 ;;; Widgets
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
363 ;;
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
364 (defvar tree-widget-button-keymap
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
365 (let (parent-keymap mouse-button1 keymap)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
366 (if (featurep 'xemacs)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
367 (setq parent-keymap widget-button-keymap
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
368 mouse-button1 [button1])
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
369 (setq parent-keymap widget-keymap
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
370 mouse-button1 [down-mouse-1]))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
371 (setq keymap (copy-keymap parent-keymap))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
372 (define-key keymap mouse-button1 'widget-button-click)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
373 keymap)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
374 "Keymap used inside node handle buttons.")
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
375
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
376 (define-widget 'tree-widget-control 'push-button
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
377 "Base `tree-widget' control."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
378 :format "%[%t%]"
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
379 :button-keymap tree-widget-button-keymap ; XEmacs
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
380 :keymap tree-widget-button-keymap ; Emacs
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
381 )
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
382
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
383 (define-widget 'tree-widget-open-control 'tree-widget-control
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
384 "Control widget that represents a opened `tree-widget' node."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
385 :tag "[-] "
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
386 ;;:tag-glyph (tree-widget-find-image "open")
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
387 :notify 'tree-widget-close-node
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
388 :help-echo "Hide node"
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
389 )
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
390
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
391 (define-widget 'tree-widget-empty-control 'tree-widget-open-control
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
392 "Control widget that represents an empty opened `tree-widget' node."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
393 :tag "[X] "
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
394 ;;:tag-glyph (tree-widget-find-image "empty")
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
395 )
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
396
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
397 (define-widget 'tree-widget-close-control 'tree-widget-control
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
398 "Control widget that represents a closed `tree-widget' node."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
399 :tag "[+] "
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
400 ;;:tag-glyph (tree-widget-find-image "close")
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
401 :notify 'tree-widget-open-node
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
402 :help-echo "Show node"
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
403 )
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
404
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
405 (define-widget 'tree-widget-leaf-control 'item
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
406 "Control widget that represents a leaf node."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
407 :tag " " ;; Need at least a char to display the image :-(
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
408 ;;:tag-glyph (tree-widget-find-image "leaf")
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
409 :format "%t"
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
410 )
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
411
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
412 (define-widget 'tree-widget-guide 'item
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
413 "Widget that represents a guide line."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
414 :tag " |"
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
415 ;;:tag-glyph (tree-widget-find-image "guide")
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
416 :format "%t"
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
417 )
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
418
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
419 (define-widget 'tree-widget-end-guide 'item
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
420 "Widget that represents the end of a guide line."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
421 :tag " `"
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
422 ;;:tag-glyph (tree-widget-find-image "end-guide")
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
423 :format "%t"
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
424 )
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
425
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
426 (define-widget 'tree-widget-no-guide 'item
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
427 "Widget that represents an invisible guide line."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
428 :tag " "
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
429 ;;:tag-glyph (tree-widget-find-image "no-guide")
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
430 :format "%t"
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
431 )
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
432
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
433 (define-widget 'tree-widget-handle 'item
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
434 "Widget that represent a node handle."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
435 :tag " "
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
436 ;;:tag-glyph (tree-widget-find-image "handle")
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
437 :format "%t"
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
438 )
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
439
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
440 (define-widget 'tree-widget-no-handle 'item
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
441 "Widget that represent an invisible node handle."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
442 :tag " "
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
443 ;;:tag-glyph (tree-widget-find-image "no-handle")
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
444 :format "%t"
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
445 )
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
446
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
447 (define-widget 'tree-widget 'default
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
448 "Tree widget."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
449 :format "%v"
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
450 :convert-widget 'widget-types-convert-widget
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
451 :value-get 'widget-value-value-get
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
452 :value-create 'tree-widget-value-create
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
453 :value-delete 'tree-widget-value-delete
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
454 )
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
455
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
456 ;;; Widget support functions
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
457 ;;
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
458 (defun tree-widget-p (widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
459 "Return non-nil if WIDGET is a `tree-widget' widget."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
460 (let ((type (widget-type widget)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
461 (while (and type (not (eq type 'tree-widget)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
462 (setq type (widget-type (get type 'widget-type))))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
463 (eq type 'tree-widget)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
464
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
465 (defsubst tree-widget-get-super (widget property)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
466 "Return WIDGET's inherited PROPERTY value."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
467 (widget-get (get (widget-type (get (widget-type widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
468 'widget-type))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
469 'widget-type)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
470 property))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
471
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
472 (defsubst tree-widget-node (widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
473 "Return the tree WIDGET :node value.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
474 If not found setup a default 'item' widget."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
475 (let ((node (widget-get widget :node)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
476 (unless node
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
477 (setq node `(item :tag ,(or (widget-get widget :tag)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
478 (widget-princ-to-string
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
479 (widget-value widget)))))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
480 (widget-put widget :node node))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
481 node))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
482
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
483 (defsubst tree-widget-open-control (widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
484 "Return the opened node control specified in WIDGET."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
485 (or (widget-get widget :open-control)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
486 'tree-widget-open-control))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
487
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
488 (defsubst tree-widget-close-control (widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
489 "Return the closed node control specified in WIDGET."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
490 (or (widget-get widget :close-control)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
491 'tree-widget-close-control))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
492
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
493 (defsubst tree-widget-empty-control (widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
494 "Return the empty node control specified in WIDGET."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
495 (or (widget-get widget :empty-control)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
496 'tree-widget-empty-control))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
497
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
498 (defsubst tree-widget-leaf-control (widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
499 "Return the leaf node control specified in WIDGET."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
500 (or (widget-get widget :leaf-control)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
501 'tree-widget-leaf-control))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
502
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
503 (defsubst tree-widget-guide (widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
504 "Return the guide line widget specified in WIDGET."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
505 (or (widget-get widget :guide)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
506 'tree-widget-guide))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
507
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
508 (defsubst tree-widget-end-guide (widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
509 "Return the end of guide line widget specified in WIDGET."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
510 (or (widget-get widget :end-guide)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
511 'tree-widget-end-guide))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
512
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
513 (defsubst tree-widget-no-guide (widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
514 "Return the invisible guide line widget specified in WIDGET."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
515 (or (widget-get widget :no-guide)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
516 'tree-widget-no-guide))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
517
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
518 (defsubst tree-widget-handle (widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
519 "Return the node handle line widget specified in WIDGET."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
520 (or (widget-get widget :handle)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
521 'tree-widget-handle))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
522
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
523 (defsubst tree-widget-no-handle (widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
524 "Return the node invisible handle line widget specified in WIDGET."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
525 (or (widget-get widget :no-handle)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
526 'tree-widget-no-handle))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
527
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
528 (defun tree-widget-keep (arg widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
529 "Save in ARG the WIDGET properties specified by :keep."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
530 (dolist (prop (widget-get widget :keep))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
531 (widget-put arg prop (widget-get widget prop))))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
532
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
533 (defun tree-widget-children-value-save (widget &optional args node)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
534 "Save WIDGET children values.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
535 Children properties and values are saved in ARGS if non-nil else in
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
536 WIDGET :args property value. Data node properties and value are saved
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
537 in NODE if non-nil else in WIDGET :node property value."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
538 (let ((args (or args (widget-get widget :args)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
539 (node (or node (tree-widget-node widget)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
540 (children (widget-get widget :children))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
541 (node-child (widget-get widget :tree-widget--node))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
542 arg child)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
543 (while (and args children)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
544 (setq arg (car args)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
545 args (cdr args)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
546 child (car children)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
547 children (cdr children))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
548 (if (tree-widget-p child)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
549 ;;;; The child is a tree node.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
550 (progn
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
551 ;; Backtrack :args and :node properties.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
552 (widget-put arg :args (widget-get child :args))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
553 (widget-put arg :node (tree-widget-node child))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
554 ;; Save :open property.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
555 (widget-put arg :open (widget-get child :open))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
556 ;; The node is open.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
557 (when (widget-get child :open)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
558 ;; Save the widget value.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
559 (widget-put arg :value (widget-value child))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
560 ;; Save properties specified in :keep.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
561 (tree-widget-keep arg child)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
562 ;; Save children.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
563 (tree-widget-children-value-save
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
564 child (widget-get arg :args) (widget-get arg :node))))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
565 ;;;; Another non tree node.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
566 ;; Save the widget value
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
567 (widget-put arg :value (widget-value child))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
568 ;; Save properties specified in :keep.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
569 (tree-widget-keep arg child)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
570 (when (and node node-child)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
571 ;; Assume that the node child widget is not a tree!
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
572 ;; Save the node child widget value.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
573 (widget-put node :value (widget-value node-child))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
574 ;; Save the node child properties specified in :keep.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
575 (tree-widget-keep node node-child))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
576 ))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
577
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
578 (defvar tree-widget-after-toggle-functions nil
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
579 "Hooks run after toggling a `tree-widget' folding.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
580 Each function will receive the `tree-widget' as its unique argument.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
581 This variable should be local to each buffer used to display
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
582 widgets.")
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
583
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
584 (defun tree-widget-close-node (widget &rest ignore)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
585 "Close the `tree-widget' node associated to this control WIDGET.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
586 WIDGET's parent should be a `tree-widget'.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
587 IGNORE other arguments."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
588 (let ((tree (widget-get widget :parent)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
589 ;; Before folding the node up, save children values so next open
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
590 ;; can recover them.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
591 (tree-widget-children-value-save tree)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
592 (widget-put tree :open nil)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
593 (widget-value-set tree nil)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
594 (run-hook-with-args 'tree-widget-after-toggle-functions tree)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
595
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
596 (defun tree-widget-open-node (widget &rest ignore)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
597 "Open the `tree-widget' node associated to this control WIDGET.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
598 WIDGET's parent should be a `tree-widget'.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
599 IGNORE other arguments."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
600 (let ((tree (widget-get widget :parent)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
601 (widget-put tree :open t)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
602 (widget-value-set tree t)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
603 (run-hook-with-args 'tree-widget-after-toggle-functions tree)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
604
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
605 (defun tree-widget-value-delete (widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
606 "Delete tree WIDGET children."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
607 ;; Delete children
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
608 (widget-children-value-delete widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
609 ;; Delete node child
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
610 (widget-delete (widget-get widget :tree-widget--node))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
611 (widget-put widget :tree-widget--node nil))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
612
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
613 (defun tree-widget-value-create (tree)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
614 "Create the TREE widget."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
615 (let* ((widget-image-enable (tree-widget-use-image-p)) ; Emacs
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
616 (widget-glyph-enable widget-image-enable) ; XEmacs
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
617 (node (tree-widget-node tree))
63465
1df1bb151415 (tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents: 59996
diff changeset
618 (flags (widget-get tree :tree-widget--guide-flags))
63467
c4d3f401bf34 eval-and-compile inlined functions so they will
David Ponce <david@dponce.com>
parents: 63465
diff changeset
619 (indent (widget-get tree :indent))
55588
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
620 children buttons)
63467
c4d3f401bf34 eval-and-compile inlined functions so they will
David Ponce <david@dponce.com>
parents: 63465
diff changeset
621 (and indent
c4d3f401bf34 eval-and-compile inlined functions so they will
David Ponce <david@dponce.com>
parents: 63465
diff changeset
622 (null flags)
c4d3f401bf34 eval-and-compile inlined functions so they will
David Ponce <david@dponce.com>
parents: 63465
diff changeset
623 (save-restriction
c4d3f401bf34 eval-and-compile inlined functions so they will
David Ponce <david@dponce.com>
parents: 63465
diff changeset
624 (widen)
c4d3f401bf34 eval-and-compile inlined functions so they will
David Ponce <david@dponce.com>
parents: 63465
diff changeset
625 (or (bolp)
c4d3f401bf34 eval-and-compile inlined functions so they will
David Ponce <david@dponce.com>
parents: 63465
diff changeset
626 (and (eq (char-before) ?<)
c4d3f401bf34 eval-and-compile inlined functions so they will
David Ponce <david@dponce.com>
parents: 63465
diff changeset
627 (save-excursion
c4d3f401bf34 eval-and-compile inlined functions so they will
David Ponce <david@dponce.com>
parents: 63465
diff changeset
628 (backward-char) (bolp)))))
c4d3f401bf34 eval-and-compile inlined functions so they will
David Ponce <david@dponce.com>
parents: 63465
diff changeset
629 (insert-char ?\ indent))
55588
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
630 (if (widget-get tree :open)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
631 ;;;; Unfolded node.
63465
1df1bb151415 (tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents: 59996
diff changeset
632 (let ((args (widget-get tree :args))
1df1bb151415 (tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents: 59996
diff changeset
633 (dynargs (widget-get tree :dynargs))
1df1bb151415 (tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents: 59996
diff changeset
634 (guide (tree-widget-guide tree))
1df1bb151415 (tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents: 59996
diff changeset
635 (noguide (tree-widget-no-guide tree))
1df1bb151415 (tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents: 59996
diff changeset
636 (endguide (tree-widget-end-guide tree))
1df1bb151415 (tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents: 59996
diff changeset
637 (handle (tree-widget-handle tree))
1df1bb151415 (tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents: 59996
diff changeset
638 (nohandle (tree-widget-no-handle tree))
1df1bb151415 (tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents: 59996
diff changeset
639 ;; Lookup for images and set widgets' tag-glyphs here,
1df1bb151415 (tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents: 59996
diff changeset
640 ;; to allow to dynamically change the image theme.
1df1bb151415 (tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents: 59996
diff changeset
641 (guidi (tree-widget-find-image "guide"))
1df1bb151415 (tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents: 59996
diff changeset
642 (noguidi (tree-widget-find-image "no-guide"))
1df1bb151415 (tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents: 59996
diff changeset
643 (endguidi (tree-widget-find-image "end-guide"))
1df1bb151415 (tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents: 59996
diff changeset
644 (handli (tree-widget-find-image "handle"))
1df1bb151415 (tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents: 59996
diff changeset
645 (nohandli (tree-widget-find-image "no-handle"))
1df1bb151415 (tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents: 59996
diff changeset
646 child)
55588
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
647 (when dynargs
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
648 ;; Request the definition of dynamic children
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
649 (setq dynargs (funcall dynargs tree))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
650 ;; Unless children have changed, reuse the widgets
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
651 (unless (eq args dynargs)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
652 (setq args (mapcar 'widget-convert dynargs))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
653 (widget-put tree :args args)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
654 ;; Insert the node control
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
655 (push (widget-create-child-and-convert
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
656 tree (if args (tree-widget-open-control tree)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
657 (tree-widget-empty-control tree))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
658 :tag-glyph (tree-widget-find-image
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
659 (if args "open" "empty")))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
660 buttons)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
661 ;; Insert the node element
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
662 (widget-put tree :tree-widget--node
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
663 (widget-create-child-and-convert tree node))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
664 ;; Insert children
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
665 (while args
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
666 (setq child (car args)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
667 args (cdr args))
63465
1df1bb151415 (tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents: 59996
diff changeset
668 (and indent (insert-char ?\ indent))
55588
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
669 ;; Insert guide lines elements
63465
1df1bb151415 (tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents: 59996
diff changeset
670 (dolist (f (reverse flags))
55588
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
671 (widget-create-child-and-convert
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
672 tree (if f guide noguide)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
673 :tag-glyph (if f guidi noguidi))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
674 (widget-create-child-and-convert
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
675 tree nohandle :tag-glyph nohandli)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
676 )
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
677 (widget-create-child-and-convert
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
678 tree (if args guide endguide)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
679 :tag-glyph (if args guidi endguidi))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
680 ;; Insert the node handle line
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
681 (widget-create-child-and-convert
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
682 tree handle :tag-glyph handli)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
683 ;; If leaf node, insert a leaf node control
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
684 (unless (tree-widget-p child)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
685 (push (widget-create-child-and-convert
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
686 tree (tree-widget-leaf-control tree)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
687 :tag-glyph (tree-widget-find-image "leaf"))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
688 buttons))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
689 ;; Insert the child element
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
690 (push (widget-create-child-and-convert
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
691 tree child
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
692 :tree-widget--guide-flags (cons (if args t) flags))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
693 children)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
694 ;;;; Folded node.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
695 ;; Insert the closed node control
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
696 (push (widget-create-child-and-convert
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
697 tree (tree-widget-close-control tree)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
698 :tag-glyph (tree-widget-find-image "close"))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
699 buttons)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
700 ;; Insert the node element
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
701 (widget-put tree :tree-widget--node
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
702 (widget-create-child-and-convert tree node)))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
703 ;; Save widget children and buttons
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
704 (widget-put tree :children (nreverse children))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
705 (widget-put tree :buttons buttons)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
706 ))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
707
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
708 ;;; Utilities
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
709 ;;
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
710 (defun tree-widget-map (widget fun)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
711 "For each WIDGET displayed child call function FUN.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
712 FUN is called with three arguments like this:
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
713
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
714 (FUN CHILD IS-NODE WIDGET)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
715
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
716 where:
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
717 - - CHILD is the child widget.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
718 - - IS-NODE is non-nil if CHILD is WIDGET node widget."
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
719 (when (widget-get widget :tree-widget--node)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
720 (funcall fun (widget-get widget :tree-widget--node) t widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
721 (dolist (child (widget-get widget :children))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
722 (if (tree-widget-p child)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
723 ;; The child is a tree node.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
724 (tree-widget-map child fun)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
725 ;; Another non tree node.
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
726 (funcall fun child nil widget)))))
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
727
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
728 (provide 'tree-widget)
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
729
55594
2a7bb55ff106 Changes from arch/CVS synchronization
Miles Bader <miles@gnu.org>
parents: 55588
diff changeset
730 ;;; arch-tag: c3a1ada2-1663-41dc-9d16-2479ed8320e8
55588
55e4f0e50320 New file.
David Ponce <david@dponce.com>
parents:
diff changeset
731 ;;; tree-widget.el ends here