comparison lisp/tree-widget.el @ 65747:cfaa6269b03d

(tree-widget-themes-load-path): New variable. (tree-widget-themes-directory): Doc fix. (tree-widget-image-formats) [Emacs]: Doc fix. (tree-widget--locate-sub-directory): New function. (tree-widget-themes-directory): Use it.

65746:6f5a2198d5e4

  (not (or (featurep 'xemacs) (< emacs-major-version 21)))
  "*Non-nil means that tree-widget will try to use images."
  :type  'boolean
  :group 'tree-widget)

(defcustom tree-widget-themes-directory "tree-widget"
  "*Name of the directory where to look up for image themes.
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
`load-path', then in the data directory, and use the first one found.
The data directory is the value of the variable `data-directory' on
Emacs, and what `(locate-data-directory \"tree-widget\")' returns on
XEmacs.
The default is to use the \"tree-widget\" relative name."
  :type '(choice (const :tag "Default" "tree-widget")
                 (const :tag "With the library" nil)
                 (directory :format "%{%t%}:\n%v"))
  :group 'tree-widget)

      "Create an image of type TYPE from FILE, and return it.
Give the image the specified properties PROPS."
      (apply 'create-image `(,file ,type nil ,@props)))
    (defsubst tree-widget-image-formats ()
      "Return the alist of image formats/file name extensions.
See also the option `widget-image-file-name-suffixes'."
      (delq nil
            (mapcar
             #'(lambda (fmt)
                 (and (image-type-available-p (car fmt)) fmt))
             widget-image-conversion)))

  (unless (string-equal name (tree-widget-theme-name))
    (set (make-local-variable 'tree-widget--theme)
         (make-vector 4 nil))
    (aset tree-widget--theme 0 name)))

(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)))
    (if found
        ;; The directory is available in the cache.
        (unless (eq found 'void) found)
      (cond
       ;; Use the directory where tree-widget 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))))
       ;; 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)))
       ;; Locate a sub-directory in `load-path' and data directory.
       (t
        (let ((path
               (append load-path
                       (list (if (fboundp 'locate-data-directory)
                                 ;; XEmacs
                                 (locate-data-directory "tree-widget")
                               ;; Emacs
                               data-directory)))))
          (while (and path (not found))
            (when (car path)
              (setq found (expand-file-name
                           tree-widget-themes-directory (car path)))
              (or (file-accessible-directory-p found)
                  (setq found nil)))
            (setq path (cdr path))))))
      ;; Store the result in the cache for later use.
      (aset tree-widget--theme 1 (or found 'void))
      found)))

(defsubst tree-widget-set-image-properties (props)
  "In current theme, set images properties to PROPS."
  (aset tree-widget--theme 2 props))

          ;; Setup the cache.
          (tree-widget-set-image-properties plist))))
    plist))

(defconst tree-widget--cursors
  ;; Pointer shapes when the mouse pointer is over tree-widget images.
  ;; This feature works since Emacs 22, and ignored on older versions,
  ;; and XEmacs.
  '(
    ("guide"     . arrow)
    ("no-guide"  . arrow)
    ("end-guide" . arrow)
    ("handle"    . arrow)

65747:cfaa6269b03d

  (not (or (featurep 'xemacs) (< emacs-major-version 21)))
  "*Non-nil means that tree-widget will try to use images."
  :type  'boolean
  :group 'tree-widget)

(defvar tree-widget-themes-load-path
  '(load-path
    (let ((dir (if (fboundp 'locate-data-directory)
                   (locate-data-directory "tree-widget") ;; XEmacs
                 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.

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.
The data directory is the value of the variable `data-directory' on
Emacs, and what `(locate-data-directory \"tree-widget\")' returns on
XEmacs.")

(defcustom tree-widget-themes-directory "tree-widget"
  "*Name of the directory where to look up for image themes.
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'.
The default is to use the \"tree-widget\" relative name."
  :type '(choice (const :tag "Default" "tree-widget")
                 (const :tag "With the library" nil)
                 (directory :format "%{%t%}:\n%v"))
  :group 'tree-widget)

      "Create an image of type TYPE from FILE, and return it.
Give the image the specified properties PROPS."
      (apply 'create-image `(,file ,type nil ,@props)))
    (defsubst tree-widget-image-formats ()
      "Return the alist of image formats/file name extensions.
See also the option `widget-image-conversion'."
      (delq nil
            (mapcar
             #'(lambda (fmt)
                 (and (image-type-available-p (car fmt)) fmt))
             widget-image-conversion)))

  (unless (string-equal name (tree-widget-theme-name))
    (set (make-local-variable 'tree-widget--theme)
         (make-vector 4 nil))
    (aset tree-widget--theme 0 name)))

(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)))
    (cond
     ;; The directory was not found.
     ((eq found 'void)
      (setq found nil))
     ;; The directory is available in the cache.
     (found)
     ;; 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))))
     ;; 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)))
     ;; 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))

(defsubst tree-widget-set-image-properties (props)
  "In current theme, set images properties to PROPS."
  (aset tree-widget--theme 2 props))

          ;; Setup the cache.
          (tree-widget-set-image-properties plist))))
    plist))

(defconst tree-widget--cursors
  ;; Pointer shapes when the mouse pointer is over inactive
  ;; tree-widget images.  This feature works since Emacs 22, and
  ;; ignored on older versions, and XEmacs.
  '(
    ("guide"     . arrow)
    ("no-guide"  . arrow)
    ("end-guide" . arrow)
    ("handle"    . arrow)