diff options
| -rw-r--r-- | lisp/tree-widget.el | 53 |
1 files changed, 21 insertions, 32 deletions
diff --git a/lisp/tree-widget.el b/lisp/tree-widget.el index e4f73d4e942..274a1b8b818 100644 --- a/lisp/tree-widget.el +++ b/lisp/tree-widget.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; tree-widget.el --- Tree widget | 1 | ;;; tree-widget.el --- Tree widget -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2004-2019 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2004-2019 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -126,7 +126,6 @@ | |||
| 126 | (defcustom tree-widget-image-enable t | 126 | (defcustom tree-widget-image-enable t |
| 127 | "Non-nil means that tree-widget will try to use images." | 127 | "Non-nil means that tree-widget will try to use images." |
| 128 | :type 'boolean | 128 | :type 'boolean |
| 129 | :group 'tree-widget | ||
| 130 | :version "27.1") | 129 | :version "27.1") |
| 131 | 130 | ||
| 132 | (defvar tree-widget-themes-load-path | 131 | (defvar tree-widget-themes-load-path |
| @@ -134,8 +133,8 @@ | |||
| 134 | (let ((dir data-directory)) | 133 | (let ((dir data-directory)) |
| 135 | (and dir (list dir (expand-file-name "images" dir))))) | 134 | (and dir (list dir (expand-file-name "images" dir))))) |
| 136 | "List of locations in which to search for the themes sub-directory. | 135 | "List of locations in which to search for the themes sub-directory. |
| 137 | Each element is an expression that will be recursively evaluated until | 136 | Each element is an expression that returns a single directory or a list |
| 138 | it returns a single directory or a list of directories. | 137 | of directories. |
| 139 | The default is to search in the `load-path' first, then in the | 138 | The default is to search in the `load-path' first, then in the |
| 140 | \"images\" sub directory in the data directory, then in the data | 139 | \"images\" sub directory in the data directory, then in the data |
| 141 | directory. | 140 | directory. |
| @@ -149,8 +148,7 @@ directory in the path specified by `tree-widget-themes-load-path'. | |||
| 149 | The default is to use the \"tree-widget\" relative name." | 148 | The default is to use the \"tree-widget\" relative name." |
| 150 | :type '(choice (const :tag "Default" "tree-widget") | 149 | :type '(choice (const :tag "Default" "tree-widget") |
| 151 | (const :tag "Where is this library" nil) | 150 | (const :tag "Where is this library" nil) |
| 152 | (directory :format "%{%t%}:\n%v")) | 151 | (directory :format "%{%t%}:\n%v"))) |
| 153 | :group 'tree-widget) | ||
| 154 | 152 | ||
| 155 | (defcustom tree-widget-theme nil | 153 | (defcustom tree-widget-theme nil |
| 156 | "Name of the theme in which to look for images. | 154 | "Name of the theme in which to look for images. |
| @@ -185,26 +183,22 @@ icon widgets used to draw the tree. By default these images are used: | |||
| 185 | \"leaf\" | 183 | \"leaf\" |
| 186 | Icon associated to a leaf node." | 184 | Icon associated to a leaf node." |
| 187 | :type '(choice (const :tag "Default" nil) | 185 | :type '(choice (const :tag "Default" nil) |
| 188 | (string :tag "Name")) | 186 | (string :tag "Name"))) |
| 189 | :group 'tree-widget) | ||
| 190 | 187 | ||
| 191 | (defcustom tree-widget-image-properties-emacs | 188 | (defcustom tree-widget-image-properties-emacs |
| 192 | '(:ascent center :mask (heuristic t)) | 189 | '(:ascent center :mask (heuristic t)) |
| 193 | "Default properties of Emacs images." | 190 | "Default properties of Emacs images." |
| 194 | :type 'plist | 191 | :type 'plist) |
| 195 | :group 'tree-widget) | ||
| 196 | 192 | ||
| 197 | (defcustom tree-widget-image-properties-xemacs | 193 | (defcustom tree-widget-image-properties-xemacs |
| 198 | nil | 194 | nil |
| 199 | "Default properties of XEmacs images." | 195 | "Default properties of XEmacs images." |
| 200 | :type 'plist | 196 | :type 'plist) |
| 201 | :group 'tree-widget) | ||
| 202 | 197 | ||
| 203 | (defcustom tree-widget-space-width 0.5 | 198 | (defcustom tree-widget-space-width 0.5 |
| 204 | "Amount of space between an icon image and a node widget. | 199 | "Amount of space between an icon image and a node widget. |
| 205 | Must be a valid space :width display property. | 200 | Must be a valid space :width display property. |
| 206 | See Info node `(elisp)Specified Space'." | 201 | See Info node `(elisp)Specified Space'." |
| 207 | :group 'tree-widget | ||
| 208 | :type '(choice (number :tag "Multiple of normal character width") | 202 | :type '(choice (number :tag "Multiple of normal character width") |
| 209 | sexp)) | 203 | sexp)) |
| 210 | 204 | ||
| @@ -220,7 +214,7 @@ See Info node `(elisp)Specified Space'." | |||
| 220 | "Create an image of type TYPE from FILE, and return it. | 214 | "Create an image of type TYPE from FILE, and return it. |
| 221 | Give the image the specified properties PROPS." | 215 | Give the image the specified properties PROPS." |
| 222 | (declare (obsolete create-image "27.1")) | 216 | (declare (obsolete create-image "27.1")) |
| 223 | (apply 'create-image `(,file ,type nil ,@props))) | 217 | (apply #'create-image `(,file ,type nil ,@props))) |
| 224 | 218 | ||
| 225 | (defsubst tree-widget-image-formats () | 219 | (defsubst tree-widget-image-formats () |
| 226 | "Return the alist of image formats/file name extensions. | 220 | "Return the alist of image formats/file name extensions. |
| @@ -252,7 +246,8 @@ The default parent theme is the \"default\" theme." | |||
| 252 | (when (file-accessible-directory-p dir) | 246 | (when (file-accessible-directory-p dir) |
| 253 | (throw 'found | 247 | (throw 'found |
| 254 | (load (expand-file-name | 248 | (load (expand-file-name |
| 255 | "tree-widget-theme-setup" dir) t))))))) | 249 | "tree-widget-theme-setup" dir) |
| 250 | t))))))) | ||
| 256 | 251 | ||
| 257 | (defun tree-widget-set-theme (&optional name) | 252 | (defun tree-widget-set-theme (&optional name) |
| 258 | "In the current buffer, set the theme to use for images. | 253 | "In the current buffer, set the theme to use for images. |
| @@ -278,25 +273,19 @@ Typically it should contain something like this: | |||
| 278 | (tree-widget-set-parent-theme name) | 273 | (tree-widget-set-parent-theme name) |
| 279 | (tree-widget-set-parent-theme "default"))) | 274 | (tree-widget-set-parent-theme "default"))) |
| 280 | 275 | ||
| 281 | (defun tree-widget--locate-sub-directory (name path &optional found) | 276 | (defun tree-widget--locate-sub-directory (name path) |
| 282 | "Locate all occurrences of the sub-directory NAME in PATH. | 277 | "Locate all occurrences of the sub-directory NAME in PATH. |
| 283 | Return a list of absolute directory names in reverse order, or nil if | 278 | Return a list of absolute directory names in reverse order, or nil if |
| 284 | not found." | 279 | not found." |
| 285 | (condition-case err | 280 | (let ((found '())) |
| 286 | (dolist (elt path) | 281 | (dolist (elt path) |
| 287 | (setq elt (eval elt)) | 282 | (with-demoted-errors "In tree-widget--locate-sub-directory: %S" |
| 288 | (cond | 283 | (let ((dirs (eval elt t))) |
| 289 | ((stringp elt) | 284 | (dolist (dir (if (listp dirs) dirs (list dirs))) |
| 290 | (and (file-accessible-directory-p | 285 | (and (file-accessible-directory-p |
| 291 | (setq elt (expand-file-name name elt))) | 286 | (setq dir (expand-file-name name dir))) |
| 292 | (push elt found))) | 287 | (push dir found)))))) |
| 293 | (elt | 288 | found)) |
| 294 | (setq found (tree-widget--locate-sub-directory | ||
| 295 | name (if (atom elt) (list elt) elt) found))))) | ||
| 296 | (error | ||
| 297 | (message "In tree-widget--locate-sub-directory: %s" | ||
| 298 | (error-message-string err)))) | ||
| 299 | found) | ||
| 300 | 289 | ||
| 301 | (defun tree-widget-themes-path () | 290 | (defun tree-widget-themes-path () |
| 302 | "Return the path where to search for a theme. | 291 | "Return the path where to search for a theme. |
| @@ -658,7 +647,7 @@ This hook should be local in the buffer setup to display widgets.") | |||
| 658 | ;; Request children at run time, when requested. | 647 | ;; Request children at run time, when requested. |
| 659 | (when (and (widget-get tree :expander) | 648 | (when (and (widget-get tree :expander) |
| 660 | (widget-apply tree :expander-p)) | 649 | (widget-apply tree :expander-p)) |
| 661 | (setq args (mapcar 'widget-convert | 650 | (setq args (mapcar #'widget-convert |
| 662 | (widget-apply tree :expander))) | 651 | (widget-apply tree :expander))) |
| 663 | (widget-put tree :args args)) | 652 | (widget-put tree :args args)) |
| 664 | ;; Defer the node widget creation after icon creation. | 653 | ;; Defer the node widget creation after icon creation. |