Don't quote lambda expressions with `quote'.

[bpt/emacs.git] / lisp / allout-widgets.el

diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el
index 1d2523f..647b609 100644 (file)
--- a/lisp/allout-widgets.el
+++ b/lisp/allout-widgets.el
@@ -1,4 +1,4 @@
-;; allout-widgets.el --- Show allout outline structure with graphical widgets.
+;; allout-widgets.el --- Visually highlight allout outline structure.
 
 ;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011 Ken Manheimer
 
@@ -154,12 +154,12 @@ See `allout-widgets-mode' for allout widgets mode features."
 ;; (make-variable-buffer-local 'allout-widgets-allow-unruly-edits)
 ;;;_  = allout-widgets-auto-activation - below, for eval-order dependencies
 ;;;_  = allout-widgets-icons-dark-subdir
-(defcustom allout-widgets-icons-dark-subdir "icons/allout-widgets-dark-bg/"
+(defcustom allout-widgets-icons-dark-subdir "icons/allout-widgets/dark-bg/"
   "Directory on `image-load-path' holding allout icons for dark backgrounds."
   :type 'string
   :group 'allout-widgets)
 ;;;_  = allout-widgets-icons-light-subdir
-(defcustom allout-widgets-icons-light-subdir "icons/allout-widgets-light-bg/"
+(defcustom allout-widgets-icons-light-subdir "icons/allout-widgets/light-bg/"
   "Directory on `image-load-path' holding allout icons for light backgrounds."
   :type 'string
   :group 'allout-widgets)
@@ -246,6 +246,7 @@ Table is maintained iff `allout-widgets-maintain-tally' is non-nil.
 The table contents will be out of sync if any widgets are created
 or deleted while this variable is nil.")
 (make-variable-buffer-local 'allout-widgets-tally)
+(defvar allout-widgets-mode-inhibit)    ; defined below
 ;;;_   > allout-widgets-tally-string
 (defun allout-widgets-tally-string ()
   "Return a string giving the number of tracked widgets, or empty string if not tracking.
@@ -301,7 +302,7 @@ buffers where this is set to enable and disable widget
 enhancements, directly.")
 ;;;###autoload
 (put 'allout-widgets-mode-inhibit 'safe-local-variable
-     (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
+     (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
 (make-variable-buffer-local 'allout-widgets-mode-inhibit)
 ;;;_    = allout-inhibit-body-modification-hook
 (defvar allout-inhibit-body-modification-hook nil
@@ -1923,8 +1924,8 @@ reapplying this method will rectify the glyphs."
 
         (setq icon-state
               (cond (does-encrypt (if is-encrypted
-                                      'encrypted-locked
-                                    'encrypted-unlocked))
+                                      'locked-encrypted
+                                    'unlocked-encrypted))
                     (expanded 'opened)
                     (has-subitems 'closed)
                     (t 'empty)))
@@ -2013,7 +2014,7 @@ Optional FORCE means force reassignment of the region property."
   ;; item body), to bias the registered values.
   ;;
   ;; This is not necessary/useful when the item is being decorated, because
-  ;; that always must be preceeded by a fresh item parse.
+  ;; that always must be preceded by a fresh item parse.
 
   (if (not (eq field :body-end))
       (widget-get item-widget :from)
@@ -2100,6 +2101,7 @@ previously established or is not moved."
     (cond ((not overlay) (when start
                            (setq overlay (make-overlay start end nil t nil))
                            (overlay-put overlay 'button item-widget)
+                           (overlay-put overlay 'evaporate t)
                            (widget-put item-widget :span-overlay overlay)
                            t))
           ;; report:
@@ -2343,6 +2345,19 @@ The elements of LIST are not copied, just the list structure itself."
        (while (consp list) (push (pop list) res))
        (prog1 (nreverse res) (setcdr res list)))
     (car list)))
+;;;_  . allout-widgets-count-buttons-in-region (start end)
+(defun allout-widgets-count-buttons-in-region (start end)
+  "Debugging/diagnostic tool - count overlays with 'button' property in region."
+  (interactive "r")
+  (setq start (or start (point-min))
+        end (or end (point-max)))
+  (if (> start end) (let ((interim start)) (setq start end end interim)))
+  (let ((button-overlays (delq nil
+                               (mapcar (function (lambda (o)
+                                                   (if (overlay-get o 'button)
+                                                       o)))
+                                       (overlays-in start end)))))
+    (length button-overlays)))
 
 ;;;_ : Run unit tests:
 (defun allout-widgets-run-unit-tests ()