This is an automated email from the git hooks/post-receive script.
bengen pushed a commit to branch master
in repository sepia.
commit 08874ec8448449cfd27ca57696a0df6d2b3e708c
Author: Hilko Bengen <ben...@debian.org>
Date: Sun Jun 22 23:10:08 2008 +0200
drop emacs21 compatibility
---
debian/changelog | 3 +-
debian/control | 7 +-
debian/copyright | 15 -
debian/emacsen-install | 2 +-
debian/emacsen-remove | 2 +-
tree-widget.el | 823 -------------------------------------------------
6 files changed, 7 insertions(+), 845 deletions(-)
diff --git a/debian/changelog b/debian/changelog
index 641821b..af7e9dd 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,10 +1,11 @@
sepia (0.96.02-1) UNRELEASED; urgency=low
* New Upstream Version
+ * Dropped Emacs21 compatibility stuff
* Depend on w3m-el since sepia-w3m.el will not compile otherwise.
* Fix stricture in Perl 5.10 (patch from upstream)
- -- Hilko Bengen <ben...@debian.org> Wed, 18 Jun 2008 10:14:48 +0200
+ -- Hilko Bengen <ben...@debian.org> Sun, 22 Jun 2008 23:08:09 +0200
sepia (0.96-2.1) unstable; urgency=low
diff --git a/debian/control b/debian/control
index 37972cf..f20bc11 100644
--- a/debian/control
+++ b/debian/control
@@ -4,15 +4,14 @@ Priority: optional
Build-Depends: debhelper (>= 5.0.0)
Build-Depends-Indep: texinfo, perl (>= 5.8.8-7), libpadwalker-perl (>= 1.0),
libmodule-info-perl, libsub-uplevel-perl, liblexical-persistence-perl,
libmodule-corelist-perl, libdevel-size-perl, libtest-expect-perl
Maintainer: Hilko Bengen <ben...@debian.org>
-Standards-Version: 3.7.3
+Standards-Version: 3.8.0
Package: sepia
Architecture: all
Depends: ${perl:Depends},
- emacs22 | emacs21,
+ emacs22,
w3m-el,
- libpadwalker-perl (>= 1.0), libmodule-info-perl, libsub-uplevel-perl,
- emacs-goodies-el | emacs22
+ libpadwalker-perl (>= 1.0), libmodule-info-perl, libsub-uplevel-perl
Recommends: perl-doc
Description: Simple Emacs-Perl InterAction
Sepia is a set of features to make Emacs a better tool for Perl
diff --git a/debian/copyright b/debian/copyright
index 02a2f09..9e4acb3 100644
--- a/debian/copyright
+++ b/debian/copyright
@@ -24,21 +24,6 @@ snippet.el is
by the Free Software Foundation; either version 2, or (at your
option) any later version.
-
-For GNU Emacs 21 compatibility, tree-widget.el from the GNU Emacs CVS
-repository has been added.
-
-tree-widget.el is
-
- Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
-
- 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.
-
Perl is distributed under your choice of the GNU General Public License or
the Artistic License. On Debian GNU/Linux systems, the complete text of the
GNU General Public License can be found in `/usr/share/common-licenses/GPL'
diff --git a/debian/emacsen-install b/debian/emacsen-install
index 108d016..a354a56 100644
--- a/debian/emacsen-install
+++ b/debian/emacsen-install
@@ -9,7 +9,7 @@ FLAVOR=$1
PACKAGE=sepia
case ${FLAVOR} in
- emacs21|emacs22)
+ emacs22)
echo install/${PACKAGE}: Handling install for emacsen flavor ${FLAVOR}
;;
*)
diff --git a/debian/emacsen-remove b/debian/emacsen-remove
index 6773e3e..413c9f2 100644
--- a/debian/emacsen-remove
+++ b/debian/emacsen-remove
@@ -5,7 +5,7 @@ FLAVOR=$1
PACKAGE=sepia
case ${FLAVOR} in
- emacs21|emacs22)
+ emacs22)
echo install/${PACKAGE}: Handling remove for emacsen flavor ${FLAVOR}
;;
*)
diff --git a/tree-widget.el b/tree-widget.el
deleted file mode 100644
index 54bbbc9..0000000
--- a/tree-widget.el
+++ /dev/null
@@ -1,823 +0,0 @@
-;;; tree-widget.el --- Tree widget
-
-;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
-
-;; Author: David Ponce <da...@dponce.com>
-;; Maintainer: David Ponce <da...@dponce.com>
-;; Created: 16 Feb 2001
-;; Keywords: extensions
-
-;; 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.
-
-;; 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.
-
-;; 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.
-
-;;; Commentary:
-;;
-;; This library provide a tree widget useful to display data
-;; structures organized in a hierarchical order.
-;;
-;; The following properties are specific to the tree widget:
-;;
-;; :open
-;; Set to non-nil to expand the tree. By default the tree is
-;; collapsed.
-;;
-;; :node
-;; Specify the widget used to represent the value of a tree node.
-;; By default this is an `item' widget which displays the
-;; tree-widget :tag property value if defined, or a string
-;; representation of the tree-widget value.
-;;
-;; :keep
-;; Specify a list of properties to keep when the tree is collapsed
-;; so they can be recovered when the tree is expanded. This
-;; property can be used in child widgets too.
-;;
-;; :expander (obsoletes :dynargs)
-;; Specify a function to be called to dynamically provide the
-;; tree's children in response to an expand request. This function
-;; will be passed the tree widget and must return a list of child
-;; widgets. Child widgets returned by the :expander function are
-;; stored in the :args property of the tree widget.
-;;
-;; :expander-p
-;; Specify a predicate which must return non-nil to indicate that
-;; the :expander function above has to be called. By default, to
-;; speed up successive expand requests, the :expander-p predicate
-;; return non-nil when the :args value is nil. So, by default, to
-;; refresh child values, it is necessary to set the :args property
-;; to nil, then redraw the tree.
-;;
-;; :open-icon (default `tree-widget-open-icon')
-;; :close-icon (default `tree-widget-close-icon')
-;; :empty-icon (default `tree-widget-empty-icon')
-;; :leaf-icon (default `tree-widget-leaf-icon')
-;; Those properties define the icon widgets associated to tree
-;; nodes. Icon widgets must derive from the `tree-widget-icon'
-;; widget. The :tag and :glyph-name property values are
-;; respectively used when drawing the text and graphic
-;; representation of the tree. The :tag value must be a string
-;; that represent a node icon, like "[+]" for example. The
-;; :glyph-name value must the name of an image found in the current
-;; theme, like "close" for example (see also the variable
-;; `tree-widget-theme').
-;;
-;; :guide (default `tree-widget-guide')
-;; :end-guide (default `tree-widget-end-guide')
-;; :no-guide (default `tree-widget-no-guide')
-;; :handle (default `tree-widget-handle')
-;; :no-handle (default `tree-widget-no-handle')
-;; Those properties define `item'-like widgets used to draw the
-;; tree guide lines. The :tag property value is used when drawing
-;; the text representation of the tree. The graphic look and feel
-;; is given by the images named "guide", "no-guide", "end-guide",
-;; "handle", and "no-handle" found in the current theme (see also
-;; the variable `tree-widget-theme').
-;;
-;; These are the default :tag values for icons, and guide lines:
-;;
-;; open-icon "[-]"
-;; close-icon "[+]"
-;; empty-icon "[X]"
-;; leaf-icon ""
-;; guide " |"
-;; no-guide " "
-;; end-guide " `"
-;; handle "-"
-;; no-handle " "
-;;
-;; The text representation of a tree looks like this:
-;;
-;; [-] 1 (open-icon :node)
-;; |-[+] 1.0 (guide+handle+close-icon :node)
-;; |-[X] 1.1 (guide+handle+empty-icon :node)
-;; `-[-] 1.2 (end-guide+handle+open-icon :node)
-;; |- 1.2.1 (no-guide+no-handle+guide+handle+leaf-icon leaf)
-;; `- 1.2.2 (no-guide+no-handle+end-guide+handle+leaf-icon leaf)
-;;
-;; By default, images will be used instead of strings to draw a
-;; nice-looking tree. See the `tree-widget-image-enable',
-;; `tree-widget-themes-directory', and `tree-widget-theme' options for
-;; more details.
-
-;;; History:
-;;
-
-;;; Code:
-(eval-when-compile (require 'cl))
-(require 'wid-edit)
-
-;;; Customization
-;;
-(defgroup tree-widget nil
- "Customization support for the Tree Widget library."
- :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."
- :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 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.
-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 in which to look for an image theme.
-When nil use the directory where the tree-widget library is located.
-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 "Where is this library" nil)
- (directory :format "%{%t%}:\n%v"))
- :group 'tree-widget)
-
-(defcustom tree-widget-theme nil
- "*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'):
-
-\"guide\"
- A vertical guide line.
-\"no-guide\"
- An invisible vertical guide line.
-\"end-guide\"
- End of a vertical guide line.
-\"handle\"
- Horizontal guide line that joins the vertical guide line to an icon.
-\"no-handle\"
- An invisible handle.
-
-Plus images whose name is given by the :glyph-name property of the
-icon widgets used to draw the tree. By default these images are used:
-
-\"open\"
- Icon associated to an expanded tree.
-\"close\"
- Icon associated to a collapsed tree.
-\"empty\"
- Icon associated to an expanded tree with no child.
-\"leaf\"
- Icon associated to a leaf node."
- :type '(choice (const :tag "Default" nil)
- (string :tag "Name"))
- :group 'tree-widget)
-
-(defcustom tree-widget-image-properties-emacs
- '(:ascent center :mask (heuristic t))
- "*Default properties of Emacs images."
- :type 'plist
- :group 'tree-widget)
-
-(defcustom tree-widget-image-properties-xemacs
- nil
- "*Default properties of XEmacs images."
- :type 'plist
- :group 'tree-widget)
-
-(defcustom tree-widget-space-width 0.5
- "Amount of space between an icon image and a node widget.
-Must be a valid space :width display property."
- :group 'tree-widget
- :type 'sexp)
-
-;;; Image support
-;;
-(eval-and-compile ;; Emacs/XEmacs compatibility stuff
- (cond
- ;; XEmacs
- ((featurep 'xemacs)
- (defsubst tree-widget-use-image-p ()
- "Return non-nil if image support is currently enabled."
- (and tree-widget-image-enable
- widget-glyph-enable
- (console-on-window-system-p)))
- (defsubst tree-widget-create-image (type file &optional props)
- "Create an image of type TYPE from FILE, and return it.
-Give the image the specified properties PROPS."
- (apply 'make-glyph `([,type :file ,file ,@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 (valid-image-instantiator-format-p (car fmt)) fmt))
- widget-image-file-name-suffixes)))
- )
- ;; Emacs
- (t
- (defsubst tree-widget-use-image-p ()
- "Return non-nil if image support is currently enabled."
- (and tree-widget-image-enable
- widget-image-enable
- (display-images-p)))
- (defsubst tree-widget-create-image (type file &optional props)
- "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)))
- ))
- )
-
-;; Buffer local cache of theme data.
-(defvar tree-widget--theme nil)
-
-(defsubst tree-widget-theme-name ()
- "Return the current theme name, or nil if no theme is active."
- (and tree-widget--theme (car (aref tree-widget--theme 0))))
-
-(defsubst tree-widget-set-parent-theme (name)
- "Set to NAME the parent theme of the current theme.
-The default parent theme is the \"default\" theme."
- (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 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.
-The current buffer must be where the tree widget is drawn.
-Optional argument NAME is the name of the theme to use. It defaults
-to the value of the variable `tree-widget-theme'.
-Does nothing if NAME is already the current theme.
-
-If there is a \"tree-widget-theme-setup\" library in the theme
-directory, load it to setup a parent theme or the images properties.
-Typically it should contain something like this:
-
- (tree-widget-set-parent-theme \"my-parent-theme\")
- (tree-widget-set-image-properties
- (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))
- (set (make-local-variable 'tree-widget--theme)
- (make-vector 4 nil))
- (tree-widget-set-parent-theme name)
- (tree-widget-set-parent-theme "default")))
-
-(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
- ;; 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)
- (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 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 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
- ;; 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)
- ("no-handle" . arrow)
- ))
-
-(defsubst tree-widget-set-image-properties (props)
- "In current theme, set images properties to PROPS.
-Does nothing if images properties have already been set for that
-theme."
- (or (aref tree-widget--theme 2)
- (aset tree-widget--theme 2 props)))
-
-(defsubst tree-widget-image-properties (name)
- "Return the properties of image NAME in current theme.
-Default global properties are provided for respectively Emacs and
-XEmacs in the variables `tree-widget-image-properties-emacs', and
-`tree-widget-image-properties-xemacs'."
- ;; Add the pointer shape
- (cons :pointer
- (cons (or (cdr (assoc name tree-widget--cursors)) 'hand)
- (tree-widget-set-image-properties
- (if (featurep 'xemacs)
- tree-widget-image-properties-xemacs
- tree-widget-image-properties-emacs)))))
-
-(defun tree-widget-lookup-image (name)
- "Look up in current theme for an image with NAME.
-Search first in current theme, then in parent themes (see also the
-function `tree-widget-set-parent-theme').
-Return the first image found having a supported format, or nil if not
-found."
- (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))
- (setq file (expand-file-name (concat name ext) dir))
- (and (file-readable-p file)
- (file-regular-p file)
- (throw 'found
- (tree-widget-create-image
- (car fmt) file
- (tree-widget-image-properties name))))))))
- nil))
-
-(defun tree-widget-find-image (name)
- "Find the image with NAME in current theme.
-NAME is an image file name sans extension.
-Return the image found, or nil if not found."
- (when (tree-widget-use-image-p)
- ;; Ensure there is an active theme.
- (tree-widget-set-theme (tree-widget-theme-name))
- (let ((image (assoc name (aref tree-widget--theme 3))))
- ;; The image NAME is found in the cache.
- (if image
- (cdr image)
- ;; Search the image in current, and default themes.
- (prog1
- (setq image (tree-widget-lookup-image name))
- ;; Store image reference in the cache for later use.
- (push (cons name image) (aref tree-widget--theme 3))))
- )))
-
-;;; Widgets
-;;
-(defun tree-widget-button-click (event)
- "Move to the position clicked on, and if it is a button, invoke it.
-EVENT is the mouse event received."
- (interactive "e")
- (mouse-set-point event)
- (let ((pos (widget-event-point event)))
- (if (get-char-property pos 'button)
- (widget-button-click event))))
-
-(defvar tree-widget-button-keymap
- (let ((km (make-sparse-keymap)))
- (if (boundp 'widget-button-keymap)
- ;; XEmacs
- (progn
- (set-keymap-parent km widget-button-keymap)
- (define-key km [button1] 'tree-widget-button-click))
- ;; Emacs
- (set-keymap-parent km widget-keymap)
- (define-key km [down-mouse-1] 'tree-widget-button-click))
- km)
- "Keymap used inside node buttons.
-Handle mouse button 1 click on buttons.")
-
-(define-widget 'tree-widget-icon 'push-button
- "Basic widget other tree-widget icons are derived from."
- :format "%[%t%]"
- :button-keymap tree-widget-button-keymap ; XEmacs
- :keymap tree-widget-button-keymap ; Emacs
- :create 'tree-widget-icon-create
- :action 'tree-widget-icon-action
- :help-echo 'tree-widget-icon-help-echo
- )
-
-(define-widget 'tree-widget-open-icon 'tree-widget-icon
- "Icon for an expanded tree-widget node."
- :tag "[-]"
- :glyph-name "open"
- )
-
-(define-widget 'tree-widget-empty-icon 'tree-widget-icon
- "Icon for an expanded tree-widget node with no child."
- :tag "[X]"
- :glyph-name "empty"
- )
-
-(define-widget 'tree-widget-close-icon 'tree-widget-icon
- "Icon for a collapsed tree-widget node."
- :tag "[+]"
- :glyph-name "close"
- )
-
-(define-widget 'tree-widget-leaf-icon 'tree-widget-icon
- "Icon for a tree-widget leaf node."
- :tag ""
- :glyph-name "leaf"
- :button-face 'default
- )
-
-(define-widget 'tree-widget-guide 'item
- "Vertical guide line."
- :tag " |"
- ;;:tag-glyph (tree-widget-find-image "guide")
- :format "%t"
- )
-
-(define-widget 'tree-widget-end-guide 'item
- "End of a vertical guide line."
- :tag " `"
- ;;:tag-glyph (tree-widget-find-image "end-guide")
- :format "%t"
- )
-
-(define-widget 'tree-widget-no-guide 'item
- "Invisible vertical guide line."
- :tag " "
- ;;:tag-glyph (tree-widget-find-image "no-guide")
- :format "%t"
- )
-
-(define-widget 'tree-widget-handle 'item
- "Horizontal guide line that joins a vertical guide line to a node."
- :tag "-"
- ;;:tag-glyph (tree-widget-find-image "handle")
- :format "%t"
- )
-
-(define-widget 'tree-widget-no-handle 'item
- "Invisible handle."
- :tag " "
- ;;:tag-glyph (tree-widget-find-image "no-handle")
- :format "%t"
- )
-
-(define-widget 'tree-widget 'default
- "Tree widget."
- :format "%v"
- :convert-widget 'tree-widget-convert-widget
- :value-get 'widget-value-value-get
- :value-delete 'widget-children-value-delete
- :value-create 'tree-widget-value-create
- :action 'tree-widget-action
- :help-echo 'tree-widget-help-echo
- :expander-p 'tree-widget-expander-p
- :open-icon 'tree-widget-open-icon
- :close-icon 'tree-widget-close-icon
- :empty-icon 'tree-widget-empty-icon
- :leaf-icon 'tree-widget-leaf-icon
- :guide 'tree-widget-guide
- :end-guide 'tree-widget-end-guide
- :no-guide 'tree-widget-no-guide
- :handle 'tree-widget-handle
- :no-handle 'tree-widget-no-handle
- )
-
-;;; Widget support functions
-;;
-(defun tree-widget-p (widget)
- "Return non-nil if WIDGET is a tree-widget."
- (let ((type (widget-type widget)))
- (while (and type (not (eq type 'tree-widget)))
- (setq type (widget-type (get type 'widget-type))))
- (eq type 'tree-widget)))
-
-(defun tree-widget-node (widget)
- "Return WIDGET's :node child widget.
-If not found, setup an `item' widget as default.
-Signal an error if the :node widget is a tree-widget.
-WIDGET is, or derives from, a tree-widget."
- (let ((node (widget-get widget :node)))
- (if node
- ;; Check that the :node widget is not a tree-widget.
- (and (tree-widget-p node)
- (error "Invalid tree-widget :node %S" node))
- ;; Setup an item widget as default :node.
- (setq node `(item :tag ,(or (widget-get widget :tag)
- (widget-princ-to-string
- (widget-value widget)))))
- (widget-put widget :node node))
- node))
-
-(defun tree-widget-keep (arg widget)
- "Save in ARG the WIDGET's properties specified by :keep."
- (dolist (prop (widget-get widget :keep))
- (widget-put arg prop (widget-get widget prop))))
-
-(defun tree-widget-children-value-save (widget &optional args node)
- "Save WIDGET children values.
-WIDGET is, or derives from, a tree-widget.
-Children properties and values are saved in ARGS if non-nil, else in
-WIDGET's :args property value. Properties and values of the
-WIDGET's :node sub-widget are saved in NODE if non-nil, else in
-WIDGET's :node sub-widget."
- (let ((args (cons (or node (widget-get widget :node))
- (or args (widget-get widget :args))))
- (children (widget-get widget :children))
- arg child)
- (while (and args children)
- (setq arg (car args)
- args (cdr args)
- child (car children)
- children (cdr children))
- (if (tree-widget-p child)
-;;;; The child is a tree node.
- (progn
- ;; Backtrack :args and :node properties.
- (widget-put arg :args (widget-get child :args))
- (widget-put arg :node (widget-get child :node))
- ;; Save :open property.
- (widget-put arg :open (widget-get child :open))
- ;; The node is open.
- (when (widget-get child :open)
- ;; Save the widget value.
- (widget-put arg :value (widget-value child))
- ;; Save properties specified in :keep.
- (tree-widget-keep arg child)
- ;; Save children.
- (tree-widget-children-value-save
- child (widget-get arg :args) (widget-get arg :node))))
-;;;; Another non tree node.
- ;; Save the widget value.
- (widget-put arg :value (widget-value child))
- ;; Save properties specified in :keep.
- (tree-widget-keep arg child)))))
-
-;;; Widget creation
-;;
-(defvar tree-widget-before-create-icon-functions nil
- "Hooks run before to create a tree-widget icon.
-Each function is passed the icon widget not yet created.
-The value of the icon widget :node property is a tree :node widget or
-a leaf node widget, not yet created.
-This hook can be used to dynamically change properties of the icon and
-associated node widgets. For example, to dynamically change the look
-and feel of the tree-widget by changing the values of the :tag
-and :glyph-name properties of the icon widget.
-This hook should be local in the buffer setup to display widgets.")
-
-(defun tree-widget-icon-create (icon)
- "Create the ICON widget."
- (run-hook-with-args 'tree-widget-before-create-icon-functions icon)
- (widget-put icon :tag-glyph
- (tree-widget-find-image (widget-get icon :glyph-name)))
- ;; Ensure there is at least one char to display the image.
- (and (widget-get icon :tag-glyph)
- (equal "" (or (widget-get icon :tag) ""))
- (widget-put icon :tag " "))
- (widget-default-create icon)
- ;; Insert space between the icon and the node widget.
- (insert-char ? 1)
- (put-text-property
- (1- (point)) (point)
- 'display (list 'space :width tree-widget-space-width)))
-
-(defun tree-widget-convert-widget (widget)
- "Convert :args as widget types in WIDGET."
- (let ((tree (widget-types-convert-widget widget)))
- ;; Compatibility
- (widget-put tree :expander (or (widget-get tree :expander)
- (widget-get tree :dynargs)))
- tree))
-
-(defun tree-widget-value-create (tree)
- "Create the TREE tree-widget."
- (let* ((node (tree-widget-node tree))
- (flags (widget-get tree :tree-widget--guide-flags))
- (indent (widget-get tree :indent))
- ;; Setup widget's image support. Looking up for images, and
- ;; setting widgets' :tag-glyph is done here, to allow to
- ;; dynamically change the image theme.
- (widget-image-enable (tree-widget-use-image-p)) ; Emacs
- (widget-glyph-enable widget-image-enable) ; XEmacs
- children buttons)
- (and indent (not (widget-get tree :parent))
- (insert-char ?\ indent))
- (if (widget-get tree :open)
-;;;; Expanded node.
- (let ((args (widget-get tree :args))
- (guide (widget-get tree :guide))
- (noguide (widget-get tree :no-guide))
- (endguide (widget-get tree :end-guide))
- (handle (widget-get tree :handle))
- (nohandle (widget-get tree :no-handle))
- (guidi (tree-widget-find-image "guide"))
- (noguidi (tree-widget-find-image "no-guide"))
- (endguidi (tree-widget-find-image "end-guide"))
- (handli (tree-widget-find-image "handle"))
- (nohandli (tree-widget-find-image "no-handle")))
- ;; Request children at run time, when requested.
- (when (and (widget-get tree :expander)
- (widget-apply tree :expander-p))
- (setq args (mapcar 'widget-convert
- (widget-apply tree :expander)))
- (widget-put tree :args args))
- ;; Defer the node widget creation after icon creation.
- (widget-put tree :node (widget-convert node))
- ;; Create the icon widget for the expanded tree.
- (push (widget-create-child-and-convert
- tree (widget-get tree (if args :open-icon :empty-icon))
- ;; Pass the node widget to child.
- :node (widget-get tree :node))
- buttons)
- ;; Create the tree node widget.
- (push (widget-create-child tree (widget-get tree :node))
- children)
- ;; Update the icon :node with the created node widget.
- (widget-put (car buttons) :node (car children))
- ;; Create the tree children.
- (while args
- (setq node (car args)
- args (cdr args))
- (and indent (insert-char ?\ indent))
- ;; Insert guide lines elements from previous levels.
- (dolist (f (reverse flags))
- (widget-create-child-and-convert
- tree (if f guide noguide)
- :tag-glyph (if f guidi noguidi))
- (widget-create-child-and-convert
- tree nohandle :tag-glyph nohandli))
- ;; Insert guide line element for this level.
- (widget-create-child-and-convert
- tree (if args guide endguide)
- :tag-glyph (if args guidi endguidi))
- ;; Insert the node handle line
- (widget-create-child-and-convert
- tree handle :tag-glyph handli)
- (if (tree-widget-p node)
- ;; Create a sub-tree node.
- (push (widget-create-child-and-convert
- tree node :tree-widget--guide-flags
- (cons (if args t) flags))
- children)
- ;; Create the icon widget for a leaf node.
- (push (widget-create-child-and-convert
- tree (widget-get tree :leaf-icon)
- ;; At this point the node widget isn't yet created.
- :node (setq node (widget-convert
- node :tree-widget--guide-flags
- (cons (if args t) flags)))
- :tree-widget--leaf-flag t)
- buttons)
- ;; Create the leaf node widget.
- (push (widget-create-child tree node) children)
- ;; Update the icon :node with the created node widget.
- (widget-put (car buttons) :node (car children)))))
-;;;; Collapsed node.
- ;; Defer the node widget creation after icon creation.
- (widget-put tree :node (widget-convert node))
- ;; Create the icon widget for the collapsed tree.
- (push (widget-create-child-and-convert
- tree (widget-get tree :close-icon)
- ;; Pass the node widget to child.
- :node (widget-get tree :node))
- buttons)
- ;; Create the tree node widget.
- (push (widget-create-child tree (widget-get tree :node))
- children)
- ;; Update the icon :node with the created node widget.
- (widget-put (car buttons) :node (car children)))
- ;; Save widget children and buttons. The tree-widget :node child
- ;; is the first element in :children.
- (widget-put tree :children (nreverse children))
- (widget-put tree :buttons buttons)))
-
-;;; Widget callbacks
-;;
-(defsubst tree-widget-leaf-node-icon-p (icon)
- "Return non-nil if ICON is a leaf node icon.
-That is, if its :node property value is a leaf node widget."
- (widget-get icon :tree-widget--leaf-flag))
-
-(defun tree-widget-icon-action (icon &optional event)
- "Handle the ICON widget :action.
-If ICON :node is a leaf node it handles the :action. The tree-widget
-parent of ICON handles the :action otherwise.
-Pass the received EVENT to :action."
- (let ((node (widget-get icon (if (tree-widget-leaf-node-icon-p icon)
- :node :parent))))
- (widget-apply node :action event)))
-
-(defun tree-widget-icon-help-echo (icon)
- "Return the help-echo string of ICON.
-If ICON :node is a leaf node it handles the :help-echo. The tree-widget
-parent of ICON handles the :help-echo otherwise."
- (let* ((node (widget-get icon (if (tree-widget-leaf-node-icon-p icon)
- :node :parent)))
- (help-echo (widget-get node :help-echo)))
- (if (functionp help-echo)
- (funcall help-echo node)
- help-echo)))
-
-(defvar tree-widget-after-toggle-functions nil
- "Hooks run after toggling a tree-widget expansion.
-Each function is passed a tree-widget. If the value of the :open
-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)
- "Handle the :action of the TREE tree-widget.
-That is, toggle expansion of the TREE tree-widget.
-Ignore the EVENT argument."
- (let ((open (not (widget-get tree :open))))
- (or open
- ;; Before to collapse the node, save children values so next
- ;; open can recover them.
- (tree-widget-children-value-save tree))
- (widget-put tree :open open)
- (widget-value-set tree open)
- (run-hook-with-args 'tree-widget-after-toggle-functions tree)))
-
-(defun tree-widget-help-echo (tree)
- "Return the help-echo string of the TREE tree-widget."
- (if (widget-get tree :open)
- "Collapse node"
- "Expand node"))
-
-(defun tree-widget-expander-p (tree)
- "Return non-nil if the TREE tree-widget :expander has to be called.
-That is, if TREE :args is nil."
- (null (widget-get tree :args)))
-
-(provide 'tree-widget)
-
-;; arch-tag: c3a1ada2-1663-41dc-9d16-2479ed8320e8
-;;; tree-widget.el ends here
--
Alioth's /usr/local/bin/git-commit-notice on
/srv/git.debian.org/git/pkg-perl/packages/sepia.git
_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
