;; allout-widgets.el --- Visually highlight allout outline structure.
-;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011 Ken Manheimer
+;; Copyright (C) 2005-2011 Free Software Foundation, Inc.
-;; Author: Ken Manheimer <ken dot manheimer at gmail dot com>
-;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com>
+;; Author: Ken Manheimer <ken dot manheimer at gmail...>
+;; Maintainer: Ken Manheimer <ken dot manheimer at gmail...>
;; Version: 1.0
;; Created: Dec 2005
-;; Version: 1.0
;; Keywords: outlines
-;; Website: http://myriadicity.net/Sundry/EmacsAllout
+;; Website: http://myriadicity.net/software-and-systems/craft/emacs-allout
;;; Commentary:
;; systematically couple overlays, graphics, and other features with
;; allout-governed text.
-;;;_: Code (structured with comments that delinieate an allout outline)
+;;;_: Code (structured with comments that delineate an allout outline)
;;;_ : General Environment
(require 'allout)
;;;_ > allout-widgets-setup (varname value)
;;;###autoload
(defun allout-widgets-setup (varname value)
- "Commission or decommision allout-widgets-mode along with allout-mode.
+ "Commission or decommission allout-widgets-mode along with allout-mode.
Meant to be used by customization of `allout-widgets-auto-activation'."
(set-default varname value)
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
;;;_ > define-minor-mode allout-widgets-mode (arg)
;;;###autoload
(define-minor-mode allout-widgets-mode
- "Allout-mode extension, providing graphical decoration of outline structure.
-
-This is meant to operate along with allout-mode, via `allout-mode-hook'.
+ "Toggle Allout Widgets mode.
+With a prefix argument ARG, enable Allout Widgets mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil.
-If optional argument ARG is greater than 0, enable.
-If optional argument ARG is less than 0, disable.
-Anything else, toggle between active and inactive.
+Allout Widgets mode is an extension of Allout mode that provides
+graphical decoration of outline structure. It is meant to
+operate along with `allout-mode', via `allout-mode-hook'.
The graphics include:
'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.
(forward-char -1)))))))
(error
- ;; zero work list so we don't get stuck futily retrying.
+ ;; zero work list so we don't get stuck futilely retrying.
;; error recording done by allout-widgets-hook-error-handler.
(setq allout-widgets-changes-record nil))))
;;;_ , major change handlers:
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)
(defun allout-range-overlaps (from to ranges)
"Return a pair indicating overlap of FROM and TO subtree range in RANGES.
-First element of result indicates whether candadate range FROM, TO
+First element of result indicates whether candidate range FROM, TO
overlapped any of the existing ranges.
Second element of result is a new version of RANGES incorporating the
:from nil ; item beginning - marker
:to nil ; item end - marker
- :span-overlay nil ; overlay by which actual postion is determined
+ :span-overlay nil ; overlay by which actual position is determined
;; also serves as guide-end:
:icon-start nil
(set-buffer-modified-p was-modified)
(goto-char steady-point)
- ;; must null the marker or the buffer gets clogged with impedence:
+ ;; must null the marker or the buffer gets clogged with impedance:
(set-marker steady-point nil)
item-widget)))
(defun allout-redecorate-item (item-widget)
"Resituate ITEM-WIDGET decorations, disregarding context.
-Use this to redecorate only the item, when you know that it's
+Use this to redecorate only the item, when you know that its
situation with respect to siblings, parent, and offspring is
unchanged from its last decoration. Use
`allout-decorate-item-and-context' instead to reassess and adjust
-relevent context, when suitable."
+relevant context, when suitable."
(if (not (equal (widget-get item-widget :last-decorated-tick)
allout-command-counter))
(let ((was-modified (buffer-modified-p))
(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)
HCoop / bpt / emacs.git / blobdiff