;;; tree-widget.el --- Tree widget
-;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
;; This file is part of GNU Emacs
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;
;;; Code:
-(eval-when-compile (require 'cl))
(require 'wid-edit)
\f
;;; Customization
:version "22.1"
:group 'widgets)
-(defcustom tree-widget-image-enable
- (not (or (featurep 'xemacs) (< emacs-major-version 21)))
- "*Non-nil means that tree-widget will try to use images."
+(defcustom tree-widget-image-enable (if (fboundp 'display-images-p)
+ (display-images-p))
+ "Non-nil means that tree-widget will try to use images."
:type 'boolean
:group 'tree-widget)
data-directory)))
(and dir (list dir (expand-file-name "images" dir))))
)
- "List of locations where to search for the themes sub-directory.
-Each element is an expression that will be evaluated to return a
-single directory or a list of directories to search.
-
+ "List of locations in which to search for the themes sub-directory.
+Each element is an expression that will be recursively evaluated until
+it returns a single directory or a list of directories.
The default is to search in the `load-path' first, then in the
\"images\" sub directory in the data directory, then in the data
directory.
XEmacs.")
(defcustom tree-widget-themes-directory "tree-widget"
- "*Name of the directory where to look up for image themes.
+ "Name of the directory in which to look for an image theme.
When nil use the directory where the tree-widget library is located.
-When a relative name is specified, try to locate that sub directory in
-the locations specified in `tree-widget-themes-load-path'.
+When it is a relative name, search in all occurrences of that sub
+directory in the path specified by `tree-widget-themes-load-path'.
The default is to use the \"tree-widget\" relative name."
:type '(choice (const :tag "Default" "tree-widget")
- (const :tag "With the library" nil)
+ (const :tag "Where is this library" nil)
(directory :format "%{%t%}:\n%v"))
:group 'tree-widget)
(defcustom tree-widget-theme nil
- "*Name of the theme where to look up for images.
-It must be a sub directory of the directory specified in variable
-`tree-widget-themes-directory'. The default theme is \"default\".
-When an image is not found in a theme, it is searched in the default
-theme.
+ "Name of the theme in which to look for images.
+This is a sub directory of the themes directory specified by the
+`tree-widget-themes-directory' option.
+The default theme is \"default\". When an image is not found in a
+theme, it is searched in its parent theme.
A complete theme must at least contain images with these file names
with a supported extension (see also `tree-widget-image-formats'):
(defcustom tree-widget-image-properties-emacs
'(:ascent center :mask (heuristic t))
- "*Default properties of Emacs images."
+ "Default properties of Emacs images."
:type 'plist
:group 'tree-widget)
(defcustom tree-widget-image-properties-xemacs
nil
- "*Default properties of XEmacs images."
+ "Default properties of XEmacs images."
:type 'plist
:group 'tree-widget)
(unless (member name (aref tree-widget--theme 0))
(aset tree-widget--theme 0
(append (aref tree-widget--theme 0) (list name)))
- ;; Load the theme setup
- (let ((default-directory (tree-widget-themes-directory)))
- (when default-directory
- (load (expand-file-name "tree-widget-theme-setup" name) t)))))
+ ;; Load the theme setup from the first directory where the theme
+ ;; is found.
+ (catch 'found
+ (dolist (dir (tree-widget-themes-path))
+ (setq dir (expand-file-name name dir))
+ (when (file-accessible-directory-p dir)
+ (throw 'found
+ (load (expand-file-name
+ "tree-widget-theme-setup" dir) t)))))))
(defun tree-widget-set-theme (&optional name)
"In the current buffer, set the theme to use for images.
(tree-widget-set-parent-theme \"my-parent-theme\")
(tree-widget-set-image-properties
- (if (featurep 'xemacs)
- '(:ascent center)
- '(:ascent center :mask (heuristic t))
+ (if (featurep \\='xemacs)
+ \\='(:ascent center)
+ \\='(:ascent center :mask (heuristic t))
))"
(or name (setq name (or tree-widget-theme "default")))
(unless (string-equal name (tree-widget-theme-name))
(tree-widget-set-parent-theme name)
(tree-widget-set-parent-theme "default")))
-(defun tree-widget--locate-sub-directory (name path)
- "Locate the sub-directory NAME in PATH.
-Return the absolute name of the directory found, or nil if not found."
- (let (dir elt)
- (while (and (not dir) (consp path))
- (setq elt (condition-case nil (eval (car path)) (error nil))
- path (cdr path))
- (cond
- ((stringp elt)
- (setq dir (expand-file-name name elt))
- (or (file-accessible-directory-p dir)
- (setq dir nil)))
- ((and elt (not (equal elt (car path))))
- (setq dir (tree-widget--locate-sub-directory name elt)))))
- dir))
-
-(defun tree-widget-themes-directory ()
- "Locate the directory where to search for a theme.
-It is defined in variable `tree-widget-themes-directory'.
-Return the absolute name of the directory found, or nil if the
-specified directory is not accessible."
- (let ((found (aref tree-widget--theme 1)))
+(defun tree-widget--locate-sub-directory (name path &optional found)
+ "Locate all occurrences of the sub-directory NAME in PATH.
+Return a list of absolute directory names in reverse order, or nil if
+not found."
+ (condition-case err
+ (dolist (elt path)
+ (setq elt (eval elt))
+ (cond
+ ((stringp elt)
+ (and (file-accessible-directory-p
+ (setq elt (expand-file-name name elt)))
+ (push elt found)))
+ (elt
+ (setq found (tree-widget--locate-sub-directory
+ name (if (atom elt) (list elt) elt) found)))))
+ (error
+ (message "In tree-widget--locate-sub-directory: %s"
+ (error-message-string err))))
+ found)
+
+(defun tree-widget-themes-path ()
+ "Return the path where to search for a theme.
+It is specified in variable `tree-widget-themes-directory'.
+Return a list of absolute directory names, or nil when no directory
+has been found accessible."
+ (let ((path (aref tree-widget--theme 1)))
(cond
- ;; The directory was not found.
- ((eq found 'void)
- (setq found nil))
- ;; The directory is available in the cache.
- (found)
+ ;; No directory was found.
+ ((eq path 'void) nil)
+ ;; The list of directories is available in the cache.
+ (path)
;; Use the directory where this library is located.
((null tree-widget-themes-directory)
- (setq found (locate-library "tree-widget"))
- (when found
- (setq found (file-name-directory found))
- (or (file-accessible-directory-p found)
- (setq found nil))))
+ (when (setq path (locate-library "tree-widget"))
+ (setq path (file-name-directory path))
+ (setq path (and (file-accessible-directory-p path)
+ (list path)))
+ ;; Store the result in the cache for later use.
+ (aset tree-widget--theme 1 (or path 'void))
+ path))
;; Check accessibility of absolute directory name.
((file-name-absolute-p tree-widget-themes-directory)
- (setq found (expand-file-name tree-widget-themes-directory))
- (or (file-accessible-directory-p found)
- (setq found nil)))
+ (setq path (expand-file-name tree-widget-themes-directory))
+ (setq path (and (file-accessible-directory-p path)
+ (list path)))
+ ;; Store the result in the cache for later use.
+ (aset tree-widget--theme 1 (or path 'void))
+ path)
;; Locate a sub-directory in `tree-widget-themes-load-path'.
(t
- (setq found (tree-widget--locate-sub-directory
- tree-widget-themes-directory
- tree-widget-themes-load-path))))
- ;; Store the result in the cache for later use.
- (aset tree-widget--theme 1 (or found 'void))
- found))
+ (setq path (nreverse (tree-widget--locate-sub-directory
+ tree-widget-themes-directory
+ tree-widget-themes-load-path)))
+ ;; Store the result in the cache for later use.
+ (aset tree-widget--theme 1 (or path 'void))
+ path))))
(defconst tree-widget--cursors
;; Pointer shapes when the mouse pointer is over inactive
function `tree-widget-set-parent-theme').
Return the first image found having a supported format, or nil if not
found."
- (let ((default-directory (tree-widget-themes-directory)) file)
- (when default-directory
- (catch 'found
+ (let (file)
+ (catch 'found
+ (dolist (default-directory (tree-widget-themes-path))
(dolist (dir (aref tree-widget--theme 0))
(dolist (fmt (tree-widget-image-formats))
(dolist (ext (cdr fmt))
(throw 'found
(tree-widget-create-image
(car fmt) file
- (tree-widget-image-properties name)))))))
- nil))))
+ (tree-widget-image-properties name))))))))
+ nil)))
(defun tree-widget-find-image (name)
"Find the image with NAME in current theme.
(widget-get tree :dynargs)))
tree))
+(defvar widget-glyph-enable) ; XEmacs
+
(defun tree-widget-value-create (tree)
"Create the TREE tree-widget."
(let* ((node (tree-widget-node tree))
property is non-nil the tree has been expanded, else collapsed.
This hook should be local in the buffer setup to display widgets.")
-(defun tree-widget-action (tree &optional event)
+(defun tree-widget-action (tree &optional _event)
"Handle the :action of the TREE tree-widget.
That is, toggle expansion of the TREE tree-widget.
Ignore the EVENT argument."
(provide 'tree-widget)
-;; arch-tag: c3a1ada2-1663-41dc-9d16-2479ed8320e8
;;; tree-widget.el ends here