-;; 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
;; (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)
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.
The number varies according to the evanescence of objects on a
hash table with weak keys, so tracking of widget erasures is often delayed."
- (when (and allout-widgets-maintain-tally (not allout-widgets-mode-inhibit))
+ (when (and allout-widgets-maintain-tally
+ (not allout-widgets-mode-inhibit)
+ allout-widgets-tally)
(format ":%s" (hash-table-count allout-widgets-tally))))
;;;_ = allout-widgets-track-decoration nil
(defcustom allout-widgets-track-decoration nil
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
(message replaced-message)
(message "")))))
- ;; Detect undecorated items, eg during isearch into previously
- ;; unexposed topics, and decorate "economically". Some
- ;; undecorated stuff is often exposed, to reduce lag, but the
- ;; item containing the cursor is decorated. We constrain
- ;; recursion to avoid being trapped by unexpectedly undecoratable
- ;; items.
- (when (and (not recursing)
- (not (allout-current-decorated-p))
- (or (not (equal (allout-depth) 0))
- (not allout-container-item-widget)))
- (let ((buffer-undo-list t))
- (allout-widgets-exposure-change-recorder
- allout-recent-prefix-beginning allout-recent-prefix-end nil)
- (allout-widgets-post-command-business 'recursing)))
+ ;; alas, decorated intermediate matches are not easily undecorated
+ ;; when they're automatically rehidden by isearch, so we're
+ ;; dropping this nicety.
+ ;; ;; Detect undecorated items, eg during isearch into previously
+ ;; ;; unexposed topics, and decorate "economically". Some
+ ;; ;; undecorated stuff is often exposed, to reduce lag, but the
+ ;; ;; item containing the cursor is decorated. We constrain
+ ;; ;; recursion to avoid being trapped by unexpectedly undecoratable
+ ;; ;; items.
+ ;; (when (and (not recursing)
+ ;; (not (allout-current-decorated-p))
+ ;; (or (not (equal (allout-depth) 0))
+ ;; (not allout-container-item-widget)))
+ ;; (let ((buffer-undo-list t))
+ ;; (allout-widgets-exposure-change-recorder
+ ;; allout-recent-prefix-beginning allout-recent-prefix-end nil)
+ ;; (allout-widgets-post-command-business 'recursing)))
;; Detect and rectify fouled outline structure - decorated item
;; not at beginning of line.
(setq icon-state
(cond (does-encrypt (if is-encrypted
- 'encrypted-locked
- 'encrypted-unlocked))
+ 'locked-encrypted
+ 'unlocked-encrypted))
(expanded 'opened)
(has-subitems 'closed)
(t 'empty)))
;; 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)
(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:
(defun allout-elapsed-time-seconds (end start)
"Return seconds between `current-time' style time START/END triples."
(let ((elapsed (time-subtract end start)))
- (+ (* (car elapsed) (expt 2.0 16))
- (cadr elapsed)
- (/ (caddr elapsed) (expt 10.0 6)))))
+ (float-time elapsed)))
;;;_ > allout-frame-property (frame property)
(defalias 'allout-frame-property
(cond ((fboundp 'frame-parameter)
(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 ()
HCoop / bpt / emacs.git / blobdiff