-;; 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
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
'allout-widgets-shifts-recorder nil 'local)
(add-hook 'allout-after-copy-or-kill-hook
'allout-widgets-after-copy-or-kill-function nil 'local)
+ (add-hook 'allout-post-undo-hook
+ 'allout-widgets-after-undo-function nil 'local)
(add-hook 'before-change-functions 'allout-widgets-before-change-handler
nil 'local)
(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.
Intended for use on allout-after-copy-or-kill-hook."
(if (car kill-ring)
(setcar kill-ring (allout-widgets-undecorate-text (car kill-ring)))))
+;;;_ > allout-widgets-after-undo-function ()
+(defun allout-widgets-after-undo-function ()
+ "Do allout-widgets processing of text after an undo.
+
+Intended for use on allout-post-undo-hook."
+ (save-excursion
+ (if (allout-goto-prefix)
+ (allout-redecorate-item (allout-get-or-create-item-widget)))))
;;;_ > allout-widgets-exposure-undo-recorder (widget from-state)
(defun allout-widgets-exposure-undo-recorder (widget)
(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 ()