aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorEli Zaretskii2006-02-17 10:53:13 +0000
committerEli Zaretskii2006-02-17 10:53:13 +0000
commit96b83743d41a5e9259d8f1ea911efccfcadb37f9 (patch)
tree498f5e623b60c9b9e1ce89f4ee426b265c7b36c5
parenta2a385a7ab3e8936efeda645d4d4a6d1c674d8ea (diff)
downloademacs-96b83743d41a5e9259d8f1ea911efccfcadb37f9.tar.gz
emacs-96b83743d41a5e9259d8f1ea911efccfcadb37f9.zip
Use allout invisible-text overlays instead of
selective display for concealed text. Also, lots of general cleanup, and improved compatibility code. (allout-version) Incremented, corrected, revised, and refined module commentary. (provide 'allout): Moved to the bottom, added a require of overlay. (allout-encrypt-unencrypted-on-saves): Defaults to t instead of `except-current'. (allout-write-file-hook-handler): Minimize delay. (count-trailing-whitespace-region): New function so auto-encryption of current topic can resituate cursor exactly. PGP/GPG encryption trims trailing whitespace from lines, which must be accounted for across encryption then decryption. (allout-command-prefix): Now defaults to "\C-c<space>" rather than just plain "\C-c", to avoid intruding on user's keybinding space. (allout-toggle-current-subtree-encryption): Pass along fetch-pass parameter, so user request to provide a new password is done. (allout-outside-normal-auto-fill-function, allout-auto-fill): Refined mechanism for auto-filling behavior while in allout mode. (allout-mode): Explicitly specify the mode map in the docstring. Clarify provision for various write-file hook var names. Adjusted for invisible-text overlays instead of selective-display. (allout-depth): Really return 0 if not within any topic. This rectifies `allout-beginning-of-level' and sequence numbering errors that occur when cutting and pasting numbered topics. Changed from a in-line subst to a regular function, as well. (allout-pre-next-prefix): Renamed from allout-pre-next-preface. (allout-end-of-subtree, allout-end-of-subtree) (allout-end-of-entry, allout-end-of-current-heading) (allout-next-visible-heading, allout-open-topic, allout-show-entry) (allout-show-children, allout-show-to-offshoot) (allout-hide-current-entry, allout-show-current-entry): Rectified handling of trailing blank lines between items. (allout-line-boundary-regexp, set-allout-regexp, allout-depth) (allout-current-depth, allout-unprotected, allout-hidden-p) (allout-on-current-heading-p, allout-listify-exposed) (allout-chart-subtree, allout-goto-prefix) (allout-back-to-current-heading, allout-get-body-text) (allout-snug-back, allout-flag-current-subtree, allout-show-all) (allout-hide-region-body, allout-toggle-subtree-encryption) (allout-encrypt-string, allout-encrypted-key-info) (allout-next-topic-pending-encryption, allout-encrypt-decrypted) (allout-file-vars-section-data): Adjusted for use with invisible-text overlays instead of selective-display. (allout-kill-line, allout-kill-topic, allout-yank-processing): Reworked for use with invisible text overlays. (allout-current-topic-collapsed-p): New function. (allout-hide-current-subtree): Use allout-current-topic-collapsed-p to know when to close the containing topic. (allout-pre-command-business, allout-post-command-business): Simplify undo-batching and dynamic isearch exposure. (allout-set-overlay-category): New for invisible-text overlays. Sets properties of allout-overlay-category, used by allout-flag-region to set invisible-text overlay properties. (allout-get-invisibility-overlay): Get the first qualifying invisibility overlay, so we can find the extent of it. (allout-back-to-visible-text): Get to just before the beginnining of the current invisibility overlay, if any. (allout-overlay-insert-in-front-handler) (allout-overlay-interior-modification-handler) (allout-before-change-handler, allout-isearch-end-handler): New functions to handle extraordinary actions affecting concealed text. (allout-flag-region): Use overlays instead of selective-display for invisible text - by inheritence from the properties of allout-overlay-category in mainline emacs, and applied property-by-property in xemacs, some recent versions of which don't inherit the properties from the category. Provisions to respond to concealed-text edits simplified drastically. (allout-isearch-rectification, allout-isearch-was-font-lock) (allout-isearch-expose, allout-enwrap-isearch) (allout-isearch-abort, allout-pre-was-isearching) (allout-isearch-prior-pos, allout-isearch-did-quit) (allout-isearch-dynamic-expose) (allout-hide-current-entry-completely): Functions deleted. (allout-undo-aggregation): Explicit undo aggregation no longer necessary due to transition away from selective-display. (set-allout-regexp, allout-up-current-level) (allout-next-visible-heading, allout-forward-current-level) (allout-open-topic, allout-reindent-body, allout-rebullet-topic) (allout-kill-line, allout-yank-processing, allout-show-children) (allout-expose-topic, allout-old-expose-topic) (allout-listify-exposed, allout-insert-latex-header) (allout-toggle-subtree-encryption, allout-encrypt-string) (remove-from-invisibility-spec, allout-hide-current-subtree): Ditched unused variables.
-rw-r--r--lisp/ChangeLog110
-rw-r--r--lisp/allout.el1646
2 files changed, 951 insertions, 805 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ec4aa9f3048..1b41eba4893 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,113 @@
12006-02-17 Ken Manheimer <ken.manheimer@gmail.com>
2
3 * allout.el: Use allout invisible-text overlays instead of
4 selective display for concealed text. Also, lots of general
5 cleanup, and improved compatibility code.
6
7 (allout-version) Incremented, corrected, revised, and refined
8 module commentary.
9
10 (provide 'allout): Moved to the bottom, added a require of overlay.
11
12 (allout-encrypt-unencrypted-on-saves): Defaults to t instead of
13 `except-current'.
14 (allout-write-file-hook-handler): Minimize delay.
15 (count-trailing-whitespace-region): New function so
16 auto-encryption of current topic can resituate cursor exactly.
17 PGP/GPG encryption trims trailing whitespace from lines, which
18 must be accounted for across encryption then decryption.
19
20 (allout-command-prefix): Now defaults to "\C-c<space>" rather than
21 just plain "\C-c", to avoid intruding on user's keybinding space.
22
23 (allout-toggle-current-subtree-encryption): Pass along fetch-pass
24 parameter, so user request to provide a new password is done.
25
26 (allout-outside-normal-auto-fill-function, allout-auto-fill):
27 Refined mechanism for auto-filling behavior while in allout mode.
28
29 (allout-mode): Explicitly specify the mode map in the docstring.
30 Clarify provision for various write-file hook var names.
31 Adjusted for invisible-text overlays instead of selective-display.
32
33 (allout-depth): Really return 0 if not within any topic. This
34 rectifies `allout-beginning-of-level' and sequence numbering
35 errors that occur when cutting and pasting numbered topics.
36 Changed from a in-line subst to a regular function, as well.
37
38 (allout-pre-next-prefix): Renamed from allout-pre-next-preface.
39
40 (allout-end-of-subtree, allout-end-of-subtree)
41 (allout-end-of-entry, allout-end-of-current-heading)
42 (allout-next-visible-heading, allout-open-topic, allout-show-entry)
43 (allout-show-children, allout-show-to-offshoot)
44 (allout-hide-current-entry, allout-show-current-entry): Rectified
45 handling of trailing blank lines between items.
46
47 (allout-line-boundary-regexp, set-allout-regexp, allout-depth)
48 (allout-current-depth, allout-unprotected, allout-hidden-p)
49 (allout-on-current-heading-p, allout-listify-exposed)
50 (allout-chart-subtree, allout-goto-prefix)
51 (allout-back-to-current-heading, allout-get-body-text)
52 (allout-snug-back, allout-flag-current-subtree, allout-show-all)
53 (allout-hide-region-body, allout-toggle-subtree-encryption)
54 (allout-encrypt-string, allout-encrypted-key-info)
55 (allout-next-topic-pending-encryption, allout-encrypt-decrypted)
56 (allout-file-vars-section-data): Adjusted for use with
57 invisible-text overlays instead of selective-display.
58
59 (allout-kill-line, allout-kill-topic, allout-yank-processing):
60 Reworked for use with invisible text overlays.
61
62 (allout-current-topic-collapsed-p): New function.
63
64 (allout-hide-current-subtree): Use allout-current-topic-collapsed-p
65 to know when to close the containing topic.
66
67 (allout-pre-command-business, allout-post-command-business):
68 Simplify undo-batching and dynamic isearch exposure.
69
70 (allout-set-overlay-category): New for invisible-text overlays.
71 Sets properties of allout-overlay-category, used by
72 allout-flag-region to set invisible-text overlay properties.
73 (allout-get-invisibility-overlay): Get the first qualifying
74 invisibility overlay, so we can find the extent of it.
75 (allout-back-to-visible-text): Get to just before the beginnining
76 of the current invisibility overlay, if any.
77
78 (allout-overlay-insert-in-front-handler)
79 (allout-overlay-interior-modification-handler)
80 (allout-before-change-handler, allout-isearch-end-handler): New
81 functions to handle extraordinary actions affecting concealed
82 text.
83
84 (allout-flag-region): Use overlays instead of selective-display
85 for invisible text - by inheritence from the properties of
86 allout-overlay-category in mainline emacs, and applied
87 property-by-property in xemacs, some recent versions of which
88 don't inherit the properties from the category. Provisions to
89 respond to concealed-text edits simplified drastically.
90
91 (allout-isearch-rectification, allout-isearch-was-font-lock)
92 (allout-isearch-expose, allout-enwrap-isearch)
93 (allout-isearch-abort, allout-pre-was-isearching)
94 (allout-isearch-prior-pos, allout-isearch-did-quit)
95 (allout-isearch-dynamic-expose)
96 (allout-hide-current-entry-completely): Functions deleted.
97
98 (allout-undo-aggregation): Explicit undo aggregation no longer
99 necessary due to transition away from selective-display.
100
101 (set-allout-regexp, allout-up-current-level)
102 (allout-next-visible-heading, allout-forward-current-level)
103 (allout-open-topic, allout-reindent-body, allout-rebullet-topic)
104 (allout-kill-line, allout-yank-processing, allout-show-children)
105 (allout-expose-topic, allout-old-expose-topic)
106 (allout-listify-exposed, allout-insert-latex-header)
107 (allout-toggle-subtree-encryption, allout-encrypt-string)
108 (remove-from-invisibility-spec, allout-hide-current-subtree):
109 Ditched unused variables.
110
12006-02-17 Agustin Martin <agustin.martin@hispalinux.es> 1112006-02-17 Agustin Martin <agustin.martin@hispalinux.es>
2 112
3 * textmodes/ispell.el (ispell-change-dictionary): Call 113 * textmodes/ispell.el (ispell-change-dictionary): Call
diff --git a/lisp/allout.el b/lisp/allout.el
index 78e61dacde2..85affa095e3 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -1,12 +1,12 @@
1;;; allout.el --- extensive outline mode for use alone and with other modes 1;;; allout.el --- extensive outline mode for use alone and with other modes
2 2
3;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004, 3;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004,
4;; 2005, 2006 Free Software Foundation, Inc. 4;; 2005 Free Software Foundation, Inc.
5 5
6;; Author: Ken Manheimer <ken dot manheimer at gmail dot com> 6;; Author: Ken Manheimer <ken dot manheimer at gmail dot com>
7;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com> 7;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com>
8;; Created: Dec 1991 - first release to usenet 8;; Created: Dec 1991 - first release to usenet
9;; Version: 2.1 9;; Version: 2.2
10;; Keywords: outlines wp languages 10;; Keywords: outlines wp languages
11 11
12;; This file is part of GNU Emacs. 12;; This file is part of GNU Emacs.
@@ -28,36 +28,39 @@
28 28
29;;; Commentary: 29;;; Commentary:
30 30
31;; Allout outline mode provides extensive outline formatting and 31;; Allout outline minor mode provides extensive outline formatting and
32;; and manipulation beyond standard emacs outline mode. It provides 32;; and manipulation beyond standard emacs outline mode. Some features:
33;; for structured editing of outlines, as well as navigation and
34;; exposure. It also provides for syntax-sensitive text like
35;; programming languages. (For an example, see the allout code
36;; itself, which is organized in ;; an outline framework.)
37;; 33;;
38;; Some features: 34;; - Classic outline-mode topic-oriented navigation and exposure adjustment
39;; 35;; - Topic-oriented editing including coherent topic and subtopic
40;; - classic outline-mode topic-oriented navigation and exposure adjustment 36;; creation, promotion, demotion, cut/paste across depths, etc.
41;; - topic-oriented editing including coherent topic and subtopic 37;; - Incremental search with dynamic exposure and reconcealment of text
42;; creation, promotion, demotion, cut/paste across depths, etc 38;; - Customizable bullet format - enables programming-language specific
43;; - incremental search with dynamic exposure and reconcealment of text 39;; outlining, for code-folding editing. (Allout code itself is to try it;
44;; - customizable bullet format enbles programming-language specific 40;; formatted as an outline - do ESC-x eval-current-buffer in allout.el; but
45;; outlining, for ultimate code-folding editing. (allout code itself is 41;; emacs local file variables need to be enabled when the
46;; formatted as an outline - do ESC-x eval-current-buffer in allout.el 42;; file was visited - see `enable-local-variables'.)
47;; to try it out.) 43;; - Configurable per-file initial exposure settings
48;; - configurable per-file initial exposure settings 44;; - Symmetric-key and key-pair topic encryption, plus symmetric passphrase
49;; - symmetric-key and key-pair topic encryption, plus symmetric passphrase
50;; mnemonic support, with verification against an established passphrase 45;; mnemonic support, with verification against an established passphrase
51;; (using a stashed encrypted dummy string) and user-supplied hint 46;; (using a stashed encrypted dummy string) and user-supplied hint
52;; maintenance. (see allout-toggle-current-subtree-encryption docstring.) 47;; maintenance. (See allout-toggle-current-subtree-encryption docstring.)
53;; - automatic topic-number maintenance 48;; - Automatic topic-number maintenance
54;; - "hot-spot" operation, for single-keystroke maneuvering and 49;; - "Hot-spot" operation, for single-keystroke maneuvering and
55;; exposure control (see the allout-mode docstring) 50;; exposure control (see the allout-mode docstring)
56;; - easy rendering of exposed portions into numbered, latex, indented, etc 51;; - Easy rendering of exposed portions into numbered, latex, indented, etc
57;; outline styles 52;; outline styles
53;; - Careful attention to whitespace - enabling blank lines between items
54;; and maintenance of hanging indentation (in paragraph auto-fill and
55;; across topic promotion and demotion) of topic bodies consistent with
56;; indentation of their topic header.
58;; 57;;
59;; and more. 58;; and more.
60;; 59;;
60;; See the `allout-mode' function's docstring for an introduction to the
61;; mode. The development version and helpful notes are available at
62;; http://myriadicity.net/Sundry/EmacsAllout .
63;;
61;; The outline menubar additions provide quick reference to many of 64;; The outline menubar additions provide quick reference to many of
62;; the features, and see the docstring of the variable `allout-init' 65;; the features, and see the docstring of the variable `allout-init'
63;; for instructions on priming your emacs session for automatic 66;; for instructions on priming your emacs session for automatic
@@ -75,20 +78,18 @@
75 78
76;;; Code: 79;;; Code:
77 80
78;;;_* Provide
79;(provide 'outline)
80(provide 'allout)
81
82;;;_* Dependency autoloads 81;;;_* Dependency autoloads
82(require 'overlay)
83(eval-when-compile (progn (require 'pgg) 83(eval-when-compile (progn (require 'pgg)
84 (require 'pgg-gpg) 84 (require 'pgg-gpg)
85 (fset 'allout-real-isearch-abort 85 (require 'overlay)
86 (symbol-function 'isearch-abort))
87 )) 86 ))
88(autoload 'pgg-gpg-symmetric-key-p "pgg-gpg" 87(autoload 'pgg-gpg-symmetric-key-p "pgg-gpg"
89 "True if decoded armor MESSAGE-KEYS has symmetric encryption indicator.") 88 "True if decoded armor MESSAGE-KEYS has symmetric encryption indicator.")
90 89
91;;;_* USER CUSTOMIZATION VARIABLES: 90;;;_* USER CUSTOMIZATION VARIABLES:
91
92;;;_ > defgroup allout
92(defgroup allout nil 93(defgroup allout nil
93 "Extensive outline mode for use alone and with other modes." 94 "Extensive outline mode for use alone and with other modes."
94 :prefix "allout-" 95 :prefix "allout-"
@@ -151,7 +152,7 @@ lines at the bottom of an Emacs Lisp file:
151will, modulo the above-mentioned conditions, cause the mode to be 152will, modulo the above-mentioned conditions, cause the mode to be
152activated when the file is visited, followed by the equivalent of 153activated when the file is visited, followed by the equivalent of
153`\(allout-expose-topic 0 : -1 -1 0)'. \(This is the layout used for 154`\(allout-expose-topic 0 : -1 -1 0)'. \(This is the layout used for
154the allout.el, itself.) 155the allout.el source file.)
155 156
156Also, allout's mode-specific provisions will make topic prefixes default 157Also, allout's mode-specific provisions will make topic prefixes default
157to the comment-start string, if any, of the language of the file. This 158to the comment-start string, if any, of the language of the file. This
@@ -450,7 +451,7 @@ variable for details about allout ajustment of file variables."
450 :group 'allout) 451 :group 'allout)
451(make-variable-buffer-local 'allout-passphrase-hint-handling) 452(make-variable-buffer-local 'allout-passphrase-hint-handling)
452;;;_ = allout-encrypt-unencrypted-on-saves 453;;;_ = allout-encrypt-unencrypted-on-saves
453(defcustom allout-encrypt-unencrypted-on-saves 'except-current 454(defcustom allout-encrypt-unencrypted-on-saves t
454 "*When saving, should topics pending encryption be encrypted? 455 "*When saving, should topics pending encryption be encrypted?
455 456
456The idea is to prevent file-system exposure of any un-encrypted stuff, and 457The idea is to prevent file-system exposure of any un-encrypted stuff, and
@@ -485,8 +486,11 @@ disable auto-saves for that file."
485;;;_ + Miscellaneous customization 486;;;_ + Miscellaneous customization
486 487
487;;;_ = allout-command-prefix 488;;;_ = allout-command-prefix
488(defcustom allout-command-prefix "\C-c" 489(defcustom allout-command-prefix "\C-c "
489 "*Key sequence to be used as prefix for outline mode command key bindings." 490 "*Key sequence to be used as prefix for outline mode command key bindings.
491
492Default is '\C-c<space>'; just '\C-c' is more short-and-sweet, if you're
493willing to let allout use a bunch of \C-c keybindings."
490 :type 'string 494 :type 'string
491 :group 'allout) 495 :group 'allout)
492 496
@@ -538,23 +542,12 @@ unless optional third, non-nil element is present.")
538 ("=t" allout-latexify-exposed) 542 ("=t" allout-latexify-exposed)
539 ("=p" allout-flatten-exposed-to-buffer))) 543 ("=p" allout-flatten-exposed-to-buffer)))
540 544
541;;;_ = allout-isearch-dynamic-expose
542(defcustom allout-isearch-dynamic-expose t
543 "*Non-nil enable dynamic exposure of hidden incremental-search
544targets as they're encountered."
545 :type 'boolean
546 :group 'allout)
547(make-variable-buffer-local 'allout-isearch-dynamic-expose)
548
549;;;_ = allout-use-hanging-indents 545;;;_ = allout-use-hanging-indents
550(defcustom allout-use-hanging-indents t 546(defcustom allout-use-hanging-indents t
551 "*If non-nil, topic body text auto-indent defaults to indent of the header. 547 "*If non-nil, topic body text auto-indent defaults to indent of the header.
552Ie, it is indented to be just past the header prefix. This is 548Ie, it is indented to be just past the header prefix. This is
553relevant mostly for use with indented-text-mode, or other situations 549relevant mostly for use with indented-text-mode, or other situations
554where auto-fill occurs. 550where auto-fill occurs."
555
556\[This feature no longer depends in any way on the `filladapt.el'
557lisp-archive package.\]"
558 :type 'boolean 551 :type 'boolean
559 :group 'allout) 552 :group 'allout)
560(make-variable-buffer-local 'allout-use-hanging-indents) 553(make-variable-buffer-local 'allout-use-hanging-indents)
@@ -597,7 +590,7 @@ For details, see `allout-toggle-current-subtree-encryption's docstring."
597;;;_ #1 Internal Outline Formatting and Configuration 590;;;_ #1 Internal Outline Formatting and Configuration
598;;;_ : Version 591;;;_ : Version
599;;;_ = allout-version 592;;;_ = allout-version
600(defvar allout-version "2.1" 593(defvar allout-version "2.2"
601 "Version of currently loaded outline package. \(allout.el)") 594 "Version of currently loaded outline package. \(allout.el)")
602;;;_ > allout-version 595;;;_ > allout-version
603(defun allout-version (&optional here) 596(defun allout-version (&optional here)
@@ -636,9 +629,9 @@ and `allout-distinctive-bullets-string'.")
636(defvar allout-line-boundary-regexp () 629(defvar allout-line-boundary-regexp ()
637 "`allout-regexp' with outline style beginning-of-line anchor. 630 "`allout-regexp' with outline style beginning-of-line anchor.
638 631
639\(Ie, C-j, *or* C-m, for prefixes of hidden topics). This is properly 632This is properly set when `allout-regexp' is produced by
640set when `allout-regexp' is produced by `set-allout-regexp', so 633`set-allout-regexp', so that (match-beginning 2) and (match-end
641that (match-beginning 2) and (match-end 2) delimit the prefix.") 6342) delimit the prefix.")
642(make-variable-buffer-local 'allout-line-boundary-regexp) 635(make-variable-buffer-local 'allout-line-boundary-regexp)
643;;;_ = allout-bob-regexp 636;;;_ = allout-bob-regexp
644(defvar allout-bob-regexp () 637(defvar allout-bob-regexp ()
@@ -753,11 +746,9 @@ Works with respect to `allout-plain-bullets-string' and
753 cur-string 746 cur-string
754 cur-len 747 cur-len
755 cur-char 748 cur-char
756 cur-char-string 749 index)
757 index
758 new-string)
759 (while strings 750 (while strings
760 (setq new-string "") (setq index 0) 751 (setq index 0)
761 (setq cur-len (length (setq cur-string (symbol-value (car strings))))) 752 (setq cur-len (length (setq cur-string (symbol-value (car strings)))))
762 (while (< index cur-len) 753 (while (< index cur-len)
763 (setq cur-char (aref cur-string index)) 754 (setq cur-char (aref cur-string index))
@@ -788,7 +779,7 @@ Works with respect to `allout-plain-bullets-string' and
788 allout-primary-bullet 779 allout-primary-bullet
789 "+\\|\^l")) 780 "+\\|\^l"))
790 (setq allout-line-boundary-regexp 781 (setq allout-line-boundary-regexp
791 (concat "\\([\n\r]\\)\\(" allout-regexp "\\)")) 782 (concat "\\(\n\\)\\(" allout-regexp "\\)"))
792 (setq allout-bob-regexp 783 (setq allout-bob-regexp
793 (concat "\\(\\`\\)\\(" allout-regexp "\\)")) 784 (concat "\\(\\`\\)\\(" allout-regexp "\\)"))
794 ) 785 )
@@ -955,42 +946,28 @@ from the list."
955 (setq allout-mode-prior-settings rebuild))))) 946 (setq allout-mode-prior-settings rebuild)))))
956 ) 947 )
957;;;_ : Mode-specific incidentals 948;;;_ : Mode-specific incidentals
958;;;_ = allout-pre-was-isearching nil
959(defvar allout-pre-was-isearching nil
960 "Cue for isearch-dynamic-exposure mechanism, implemented in
961allout-pre- and -post-command-hooks.")
962(make-variable-buffer-local 'allout-pre-was-isearching)
963;;;_ = allout-isearch-prior-pos nil
964(defvar allout-isearch-prior-pos nil
965 "Cue for isearch-dynamic-exposure tracking, used by
966`allout-isearch-expose'.")
967(make-variable-buffer-local 'allout-isearch-prior-pos)
968;;;_ = allout-isearch-did-quit
969(defvar allout-isearch-did-quit nil
970 "Distinguishes isearch conclusion and cancellation.
971
972Maintained by allout-isearch-abort \(which is wrapped around the real
973isearch-abort), and monitored by allout-isearch-expose for action.")
974(make-variable-buffer-local 'allout-isearch-did-quit)
975;;;_ > allout-unprotected (expr) 949;;;_ > allout-unprotected (expr)
976(defmacro allout-unprotected (expr) 950(defmacro allout-unprotected (expr)
977 "Enable internal outline operations to alter read-only text." 951 "Enable internal outline operations to alter invisible text."
978 `(let ((was-inhibit-r-o inhibit-read-only)) 952 `(let ((inhibit-read-only t))
979 (unwind-protect 953 ,expr))
980 (progn 954;;;_ = allout-mode-hook
981 (setq inhibit-read-only t) 955(defvar allout-mode-hook nil
982 ,expr) 956 "*Hook that's run when allout mode starts.")
983 (setq inhibit-read-only was-inhibit-r-o) 957;;;_ = allout-overlay-category
984 ) 958(defvar allout-overlay-category nil
985 ) 959 "Symbol for use in allout invisible-text overlays as the category.")
986 ) 960;;;_ = allout-view-change-hook
987;;;_ = allout-undo-aggregation 961(defvar allout-view-change-hook nil
988(defvar allout-undo-aggregation 30 962 "*Hook that's run after allout outline visibility changes.")
989 "Amount of successive self-insert actions to bunch together per undo. 963
990 964;;;_ = allout-outside-normal-auto-fill-function
991This is purely a kludge variable, regulating the compensation for a bug in 965(defvar allout-outside-normal-auto-fill-function nil
992the way that `before-change-functions' and undo interact.") 966 "Value of normal-auto-fill-function outside of allout mode.
993(make-variable-buffer-local 'allout-undo-aggregation) 967
968Used by allout-auto-fill to do the mandated normal-auto-fill-function
969wrapped within allout's automatic fill-prefix setting.")
970(make-variable-buffer-local 'allout-outside-normal-auto-fill-function)
994;;;_ = file-var-bug hack 971;;;_ = file-var-bug hack
995(defvar allout-v18/19-file-var-hack nil 972(defvar allout-v18/19-file-var-hack nil
996 "Horrible hack used to prevent invalid multiple triggering of outline 973 "Horrible hack used to prevent invalid multiple triggering of outline
@@ -1059,7 +1036,7 @@ was encrypted automatically as part of a file write or autosave.")
1059 (allout-next-topic-pending-encryption except-mark)) 1036 (allout-next-topic-pending-encryption except-mark))
1060 (progn 1037 (progn
1061 (message "auto-encrypting pending topics") 1038 (message "auto-encrypting pending topics")
1062 (sit-for 2) 1039 (sit-for 0)
1063 (condition-case failure 1040 (condition-case failure
1064 (setq allout-after-save-decrypt 1041 (setq allout-after-save-decrypt
1065 (allout-encrypt-decrypted except-mark)) 1042 (allout-encrypt-decrypted except-mark))
@@ -1184,7 +1161,6 @@ the following two lines in your Emacs init file:
1184 ((message 1161 ((message
1185 "Outline mode auto-activation and -layout enabled.") 1162 "Outline mode auto-activation and -layout enabled.")
1186 'full))))))) 1163 'full)))))))
1187
1188;;;_ > allout-setup-menubar () 1164;;;_ > allout-setup-menubar ()
1189(defun allout-setup-menubar () 1165(defun allout-setup-menubar ()
1190 "Populate the current buffer's menubar with `allout-mode' stuff." 1166 "Populate the current buffer's menubar with `allout-mode' stuff."
@@ -1197,12 +1173,37 @@ the following two lines in your Emacs init file:
1197 (setq cur (car menus) 1173 (setq cur (car menus)
1198 menus (cdr menus)) 1174 menus (cdr menus))
1199 (easy-menu-add cur)))) 1175 (easy-menu-add cur))))
1176;;;_ > allout-set-overlay-category
1177(defun allout-set-overlay-category ()
1178 "Set the properties of the allout invisible-text overlay."
1179 (setplist 'allout-overlay-category nil)
1180 (put 'allout-overlay-category 'invisible 'allout)
1181 (put 'allout-overlay-category 'evaporate t)
1182 ;; XXX We use isearch-open-invisible *and* isearch-mode-end-hook. The
1183 ;; latter would be sufficient, but it seems that a separate behavior -
1184 ;; the _transient_ opening of invisible text during isearch - is keyed to
1185 ;; presence of the isearch-open-invisible property - even though this
1186 ;; property controls the isearch _arrival_ behavior. This is the case at
1187 ;; least in emacs 21, 22.0, and xemacs 21.4.
1188 (put 'allout-overlay-category 'isearch-open-invisible
1189 'allout-isearch-end-handler)
1190 (if (featurep 'xemacs)
1191 (put 'allout-overlay-category 'start-open t)
1192 (put 'allout-overlay-category 'insert-in-front-hooks
1193 '(allout-overlay-insert-in-front-handler)))
1194 (if (featurep 'xemacs)
1195 (progn (make-variable-buffer-local 'before-change-functions)
1196 (add-hook 'before-change-functions
1197 'allout-before-change-handler))
1198 (put 'allout-overlay-category 'modification-hooks
1199 '(allout-overlay-interior-modification-handler))))
1200;;;_ > allout-mode (&optional toggle) 1200;;;_ > allout-mode (&optional toggle)
1201;;;_ : Defun: 1201;;;_ : Defun:
1202;;;###autoload 1202;;;###autoload
1203(defun allout-mode (&optional toggle) 1203(defun allout-mode (&optional toggle)
1204;;;_ . Doc string: 1204;;;_ . Doc string:
1205 "Toggle minor mode for controlling exposure and editing of text outlines. 1205 "Toggle minor mode for controlling exposure and editing of text outlines.
1206\\<allout-mode-map>
1206 1207
1207Optional arg forces mode to re-initialize iff arg is positive num or 1208Optional arg forces mode to re-initialize iff arg is positive num or
1208symbol. Allout outline mode always runs as a minor mode. 1209symbol. Allout outline mode always runs as a minor mode.
@@ -1244,62 +1245,69 @@ The bindings are dictated by the `allout-keybindings-list' and
1244\\[allout-forward-current-level] allout-forward-current-level | \\[allout-show-current-entry] allout-show-current-entry 1245\\[allout-forward-current-level] allout-forward-current-level | \\[allout-show-current-entry] allout-show-current-entry
1245\\[allout-backward-current-level] allout-backward-current-level | \\[allout-show-all] allout-show-all 1246\\[allout-backward-current-level] allout-backward-current-level | \\[allout-show-all] allout-show-all
1246\\[allout-end-of-entry] allout-end-of-entry 1247\\[allout-end-of-entry] allout-end-of-entry
1247\\[allout-beginning-of-current-entry,] allout-beginning-of-current-entry, alternately, goes to hot-spot 1248\\[allout-beginning-of-current-entry] allout-beginning-of-current-entry, alternately, goes to hot-spot
1248 1249
1249 Topic Header Production: 1250 Topic Header Production:
1250 ----------------------- 1251 -----------------------
1251\\[allout-open-sibtopic] allout-open-sibtopic Create a new sibling after current topic. 1252\\[allout-open-sibtopic] allout-open-sibtopic Create a new sibling after current topic.
1252\\[allout-open-subtopic] allout-open-subtopic ... an offspring of current topic. 1253\\[allout-open-subtopic] allout-open-subtopic ... an offspring of current topic.
1253\\[allout-open-supertopic] allout-open-supertopic ... a sibling of the current topic's parent. 1254\\[allout-open-supertopic] allout-open-supertopic ... a sibling of the current topic's parent.
1254 1255
1255 Topic Level and Prefix Adjustment: 1256 Topic Level and Prefix Adjustment:
1256 --------------------------------- 1257 ---------------------------------
1257\\[allout-shift-in] allout-shift-in Shift current topic and all offspring deeper. 1258\\[allout-shift-in] allout-shift-in Shift current topic and all offspring deeper.
1258\\[allout-shift-out] allout-shift-out ... less deep. 1259\\[allout-shift-out] allout-shift-out ... less deep.
1259\\[allout-rebullet-current-heading] allout-rebullet-current-heading Prompt for alternate bullet for 1260\\[allout-rebullet-current-heading] allout-rebullet-current-heading Prompt for alternate bullet for
1260 current topic. 1261 current topic.
1261\\[allout-rebullet-topic] allout-rebullet-topic Reconcile bullets of topic and its offspring 1262\\[allout-rebullet-topic] allout-rebullet-topic Reconcile bullets of topic and its offspring
1262 - distinctive bullets are not changed, others 1263 - distinctive bullets are not changed, others
1263 alternated according to nesting depth. 1264 alternated according to nesting depth.
1264\\[allout-number-siblings] allout-number-siblings Number bullets of topic and siblings - the 1265\\[allout-number-siblings] allout-number-siblings Number bullets of topic and siblings - the
1265 offspring are not affected. With repeat 1266 offspring are not affected. With repeat
1266 count, revoke numbering. 1267 count, revoke numbering.
1267 1268
1268 Topic-oriented Killing and Yanking: 1269 Topic-oriented Killing and Yanking:
1269 ---------------------------------- 1270 ----------------------------------
1270\\[allout-kill-topic] allout-kill-topic Kill current topic, including offspring. 1271\\[allout-kill-topic] allout-kill-topic Kill current topic, including offspring.
1271\\[allout-kill-line] allout-kill-line Like kill-line, but reconciles numbering, etc. 1272\\[allout-kill-line] allout-kill-line Like kill-line, but reconciles numbering, etc.
1272\\[allout-yank] allout-yank Yank, adjusting depth of yanked topic to 1273\\[allout-yank] allout-yank Yank, adjusting depth of yanked topic to
1273 depth of heading if yanking into bare topic 1274 depth of heading if yanking into bare topic
1274 heading (ie, prefix sans text). 1275 heading (ie, prefix sans text).
1275\\[allout-yank-pop] allout-yank-pop Is to allout-yank as yank-pop is to yank 1276\\[allout-yank-pop] allout-yank-pop Is to allout-yank as yank-pop is to yank
1277
1278 Topic-oriented Encryption:
1279 -------------------------
1280\\[allout-toggle-current-subtree-encryption] allout-toggle-current-subtree-encryption Encrypt/Decrypt topic content
1276 1281
1277 Misc commands: 1282 Misc commands:
1278 ------------- 1283 -------------
1279M-x outlineify-sticky Activate outline mode for current buffer, 1284M-x outlineify-sticky Activate outline mode for current buffer,
1280 and establish a default file-var setting 1285 and establish a default file-var setting
1281 for `allout-layout'. 1286 for `allout-layout'.
1282\\[allout-mark-topic] allout-mark-topic 1287\\[allout-mark-topic] allout-mark-topic
1283\\[allout-copy-exposed-to-buffer] allout-copy-exposed-to-buffer 1288\\[allout-copy-exposed-to-buffer] allout-copy-exposed-to-buffer
1284 Duplicate outline, sans concealed text, to 1289 Duplicate outline, sans concealed text, to
1285 buffer with name derived from derived from that 1290 buffer with name derived from derived from that
1286 of current buffer - \"*BUFFERNAME exposed*\". 1291 of current buffer - \"*BUFFERNAME exposed*\".
1287\\[allout-flatten-exposed-to-buffer] allout-flatten-exposed-to-buffer 1292\\[allout-flatten-exposed-to-buffer] allout-flatten-exposed-to-buffer
1288 Like above 'copy-exposed', but convert topic 1293 Like above 'copy-exposed', but convert topic
1289 prefixes to section.subsection... numeric 1294 prefixes to section.subsection... numeric
1290 format. 1295 format.
1291ESC ESC (allout-init t) Setup Emacs session for outline mode 1296\\[eval-expression] (allout-init t) Setup Emacs session for outline mode
1292 auto-activation. 1297 auto-activation.
1293 1298
1294 Encrypted Entries 1299 Topic Encryption
1295 1300
1296Outline mode supports easily togglable gpg encryption of topics, with 1301Outline mode supports gpg encryption of topics, with support for
1297niceties like support for symmetric and key-pair modes, passphrase timeout, 1302symmetric and key-pair modes, passphrase timeout, passphrase
1298passphrase consistency checking, user-provided hinting for symmetric key 1303consistency checking, user-provided hinting for symmetric key
1299mode, and auto-encryption of topics pending encryption on save. The aim is 1304mode, and auto-encryption of topics pending encryption on save.
1300to enable reliable topic privacy while preventing accidents like neglected 1305\(Topics pending encryption are, by default, automatically
1301encryption, encryption with a mistaken passphrase, forgetting which 1306encrypted during file saves; if you're editing the contents of
1302passphrase was used, and other practical pitfalls. 1307such a topic, it is automatically decrypted for continued
1308editing.) The aim is reliable topic privacy while preventing
1309accidents like neglected encryption before saves, forgetting
1310which passphrase was used, and other practical pitfalls.
1303 1311
1304See `allout-toggle-current-subtree-encryption' function docstring and 1312See `allout-toggle-current-subtree-encryption' function docstring and
1305`allout-encrypt-unencrypted-on-saves' customization variable for details. 1313`allout-encrypt-unencrypted-on-saves' customization variable for details.
@@ -1309,22 +1317,21 @@ See `allout-toggle-current-subtree-encryption' function docstring and
1309Hot-spot operation provides a means for easy, single-keystroke outline 1317Hot-spot operation provides a means for easy, single-keystroke outline
1310navigation and exposure control. 1318navigation and exposure control.
1311 1319
1312\\<allout-mode-map>
1313When the text cursor is positioned directly on the bullet character of 1320When the text cursor is positioned directly on the bullet character of
1314a topic, regular characters (a to z) invoke the commands of the 1321a topic, regular characters (a to z) invoke the commands of the
1315corresponding allout-mode keymap control chars. For example, \"f\" 1322corresponding allout-mode keymap control chars. For example, \"f\"
1316would invoke the command typically bound to \"C-c C-f\" 1323would invoke the command typically bound to \"C-c<space>C-f\"
1317\(\\[allout-forward-current-level] `allout-forward-current-level'). 1324\(\\[allout-forward-current-level] `allout-forward-current-level').
1318 1325
1319Thus, by positioning the cursor on a topic bullet, you can execute 1326Thus, by positioning the cursor on a topic bullet, you can
1320the outline navigation and manipulation commands with a single 1327execute the outline navigation and manipulation commands with a
1321keystroke. Non-literal chars never get this special translation, so 1328single keystroke. Regular navigation keys (eg, \\[forward-char], \\[next-line]) never get
1322you can use them to get away from the hot-spot, and back to normal 1329this special translation, so you can use them to get out of the
1323operation. 1330hot-spot and back to normal operation.
1324 1331
1325Note that the command `allout-beginning-of-current-entry' \(\\[allout-beginning-of-current-entry]\) 1332Note that the command `allout-beginning-of-current-entry' \(\\[allout-beginning-of-current-entry]\)
1326will move to the hot-spot when the cursor is already located at the 1333will move to the hot-spot when the cursor is already located at the
1327beginning of the current entry, so you can simply hit \\[allout-beginning-of-current-entry] 1334beginning of the current entry, so you usually can hit \\[allout-beginning-of-current-entry]
1328twice in a row to get to the hot-spot. 1335twice in a row to get to the hot-spot.
1329 1336
1330 Terminology 1337 Terminology
@@ -1332,7 +1339,7 @@ twice in a row to get to the hot-spot.
1332Topic hierarchy constituents - TOPICS and SUBTOPICS: 1339Topic hierarchy constituents - TOPICS and SUBTOPICS:
1333 1340
1334TOPIC: A basic, coherent component of an Emacs outline. It can 1341TOPIC: A basic, coherent component of an Emacs outline. It can
1335 contain other topics, and it can be subsumed by other topics, 1342 contain and be contained by other topics.
1336CURRENT topic: 1343CURRENT topic:
1337 The visible topic most immediately containing the cursor. 1344 The visible topic most immediately containing the cursor.
1338DEPTH: The degree of nesting of a topic; it increases with 1345DEPTH: The degree of nesting of a topic; it increases with
@@ -1376,13 +1383,13 @@ PREFIX-LEAD:
1376 docstring for more detail. 1383 docstring for more detail.
1377PREFIX-PADDING: 1384PREFIX-PADDING:
1378 Spaces or asterisks which separate the prefix-lead and the 1385 Spaces or asterisks which separate the prefix-lead and the
1379 bullet, according to the depth of the topic. 1386 bullet, determining the depth of the topic.
1380BULLET: A character at the end of the topic prefix, it must be one of 1387BULLET: A character at the end of the topic prefix, it must be one of
1381 the characters listed on `allout-plain-bullets-string' or 1388 the characters listed on `allout-plain-bullets-string' or
1382 `allout-distinctive-bullets-string'. (See the documentation 1389 `allout-distinctive-bullets-string'. (See the documentation
1383 for these variables for more details.) The default choice of 1390 for these variables for more details.) The default choice of
1384 bullet when generating varies in a cycle with the depth of the 1391 bullet when generating topics varies in a cycle with the depth of
1385 topic. 1392 the topic.
1386ENTRY: The text contained in a topic before any offspring. 1393ENTRY: The text contained in a topic before any offspring.
1387BODY: Same as ENTRY. 1394BODY: Same as ENTRY.
1388 1395
@@ -1393,7 +1400,6 @@ EXPOSURE:
1393CONCEALED: 1400CONCEALED:
1394 Topics and entry text whose display is inhibited. Contiguous 1401 Topics and entry text whose display is inhibited. Contiguous
1395 units of concealed text is represented by `...' ellipses. 1402 units of concealed text is represented by `...' ellipses.
1396 (Ref the `selective-display' var.)
1397 1403
1398 Concealed topics are effectively collapsed within an ancestor. 1404 Concealed topics are effectively collapsed within an ancestor.
1399CLOSED: A topic whose immediate offspring and body-text is concealed. 1405CLOSED: A topic whose immediate offspring and body-text is concealed.
@@ -1415,9 +1421,11 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1415 ;; allout-mode already called once during this complex command? 1421 ;; allout-mode already called once during this complex command?
1416 (same-complex-command (eq allout-v18/19-file-var-hack 1422 (same-complex-command (eq allout-v18/19-file-var-hack
1417 (car command-history))) 1423 (car command-history)))
1418 (write-file-hook-var-name (if (boundp 'write-file-functions) 1424 (write-file-hook-var-name (cond ((boundp 'write-file-functions)
1419 'write-file-functions 1425 'write-file-functions)
1420 'local-write-file-hooks)) 1426 ((boundp 'write-file-hooks)
1427 'write-file-hooks)
1428 (t 'local-write-file-hooks)))
1421 do-layout 1429 do-layout
1422 ) 1430 )
1423 1431
@@ -1465,9 +1473,8 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1465 (progn 1473 (progn
1466 (allout-resumptions 'allout-primary-bullet) 1474 (allout-resumptions 'allout-primary-bullet)
1467 (allout-resumptions 'allout-old-style-prefixes))) 1475 (allout-resumptions 'allout-old-style-prefixes)))
1468 (allout-resumptions 'selective-display) 1476 ;;(allout-resumptions 'selective-display)
1469 (if (and (boundp 'before-change-functions) before-change-functions) 1477 (remove-from-invisibility-spec '(allout . t))
1470 (allout-resumptions 'before-change-functions))
1471 (set write-file-hook-var-name 1478 (set write-file-hook-var-name
1472 (delq 'allout-write-file-hook-handler 1479 (delq 'allout-write-file-hook-handler
1473 (symbol-value write-file-hook-var-name))) 1480 (symbol-value write-file-hook-var-name)))
@@ -1476,9 +1483,8 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1476 auto-save-hook)) 1483 auto-save-hook))
1477 (allout-resumptions 'paragraph-start) 1484 (allout-resumptions 'paragraph-start)
1478 (allout-resumptions 'paragraph-separate) 1485 (allout-resumptions 'paragraph-separate)
1479 (allout-resumptions (if (string-match "^18" emacs-version) 1486 (allout-resumptions 'auto-fill-function)
1480 'auto-fill-hook 1487 (allout-resumptions 'normal-auto-fill-function)
1481 'auto-fill-function))
1482 (allout-resumptions 'allout-former-auto-filler) 1488 (allout-resumptions 'allout-former-auto-filler)
1483 (setq allout-mode nil)) 1489 (setq allout-mode nil))
1484 1490
@@ -1490,6 +1496,8 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1490 (allout-resumptions 'allout-primary-bullet '("*")) 1496 (allout-resumptions 'allout-primary-bullet '("*"))
1491 (allout-resumptions 'allout-old-style-prefixes '(())))) 1497 (allout-resumptions 'allout-old-style-prefixes '(()))))
1492 1498
1499 (allout-set-overlay-category) ; Doesn't hurt to redo this.
1500
1493 (allout-infer-header-lead) 1501 (allout-infer-header-lead)
1494 (allout-infer-body-reindent) 1502 (allout-infer-body-reindent)
1495 1503
@@ -1525,25 +1533,24 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1525 (current-local-map))) 1533 (current-local-map)))
1526 ) 1534 )
1527 1535
1528 ; selective-display is the 1536 (add-to-invisibility-spec '(allout . t))
1529 ; emacs conditional exposure 1537 (make-local-variable 'line-move-ignore-invisible)
1530 ; mechanism: 1538 (setq line-move-ignore-invisible t)
1531 (allout-resumptions 'selective-display '(t))
1532 (add-hook 'pre-command-hook 'allout-pre-command-business) 1539 (add-hook 'pre-command-hook 'allout-pre-command-business)
1533 (add-hook 'post-command-hook 'allout-post-command-business) 1540 (add-hook 'post-command-hook 'allout-post-command-business)
1541 (add-hook 'isearch-mode-end-hook 'allout-isearch-end-handler)
1534 (add-hook write-file-hook-var-name 'allout-write-file-hook-handler) 1542 (add-hook write-file-hook-var-name 'allout-write-file-hook-handler)
1535 (add-hook 'auto-save-hook 'allout-auto-save-hook-handler) 1543 (add-hook 'auto-save-hook 'allout-auto-save-hook-handler)
1536 ; Custom auto-fill func, to support 1544 ; Custom auto-fill func, to support
1537 ; respect for topic headline, 1545 ; respect for topic headline,
1538 ; hanging-indents, etc: 1546 ; hanging-indents, etc:
1539 (let* ((fill-func-var (if (string-match "^18" emacs-version) 1547 ;; Register prevailing fill func for use by allout-auto-fill:
1540 'auto-fill-hook 1548 (allout-resumptions 'allout-former-auto-filler (list auto-fill-function))
1541 'auto-fill-function)) 1549 ;; Register allout-auto-fill to be used if filling is active:
1542 (fill-func (symbol-value fill-func-var))) 1550 (allout-resumptions 'auto-fill-function '(allout-auto-fill))
1543 ;; Register prevailing fill func for use by allout-auto-fill: 1551 (allout-resumptions 'allout-outside-normal-auto-fill-function
1544 (allout-resumptions 'allout-former-auto-filler (list fill-func)) 1552 (list normal-auto-fill-function))
1545 ;; Register allout-auto-fill to be used if filling is active: 1553 (allout-resumptions 'normal-auto-fill-function '(allout-auto-fill))
1546 (allout-resumptions fill-func-var '(allout-auto-fill)))
1547 ;; Paragraphs are broken by topic headlines. 1554 ;; Paragraphs are broken by topic headlines.
1548 (make-local-variable 'paragraph-start) 1555 (make-local-variable 'paragraph-start)
1549 (allout-resumptions 'paragraph-start 1556 (allout-resumptions 'paragraph-start
@@ -1563,10 +1570,6 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1563 (if allout-layout 1570 (if allout-layout
1564 (setq do-layout t)) 1571 (setq do-layout t))
1565 1572
1566 (if (and allout-isearch-dynamic-expose
1567 (not (fboundp 'allout-real-isearch-abort)))
1568 (allout-enwrap-isearch))
1569
1570 (run-hooks 'allout-mode-hook) 1573 (run-hooks 'allout-mode-hook)
1571 (setq allout-mode t)) 1574 (setq allout-mode t))
1572 1575
@@ -1605,6 +1608,82 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1605;;;_ > allout-minor-mode 1608;;;_ > allout-minor-mode
1606(defalias 'allout-minor-mode 'allout-mode) 1609(defalias 'allout-minor-mode 'allout-mode)
1607 1610
1611;;;_ > allout-overlay-insert-in-front-handler (ol after beg end
1612;;; &optional prelen)
1613(defun allout-overlay-insert-in-front-handler (ol after beg end
1614 &optional prelen)
1615 "Shift the overlay so stuff inserted in front of it are excluded."
1616 (if after
1617 (move-overlay ol (1+ beg) (overlay-end ol))))
1618;;;_ > allout-overlay-interior-modification-handler (ol after beg end
1619;;; &optional prelen)
1620(defun allout-overlay-interior-modification-handler (ol after beg end
1621 &optional prelen)
1622 "Get confirmation before making arbitrary changes to invisible text.
1623
1624We expose the invisible text and ask for confirmation. Refusal or
1625keyboard-quit abandons the changes, with keyboard-quit additionally
1626reclosing the opened text.
1627
1628No confirmation is necessary when inhibit-read-only is set - eg, allout
1629internal functions use this feature cohesively bunch changes."
1630
1631 (when (and (not inhibit-read-only) (not after))
1632 (let ((start (point))
1633 (ol-start (overlay-start ol))
1634 (ol-end (overlay-end ol))
1635 (msg "Change within concealed text disallowed.")
1636 opened
1637 first)
1638 (goto-char beg)
1639 (while (< (point) end)
1640 (when (allout-hidden-p)
1641 (allout-show-to-offshoot)
1642 (if (allout-hidden-p)
1643 (save-excursion (forward-char 1)
1644 (allout-show-to-offshoot)))
1645 (when (not first)
1646 (setq opened t)
1647 (setq first (point))))
1648 (goto-char (if (featurep 'xemacs)
1649 (next-property-change (1+ (point)) nil end)
1650 (next-char-property-change (1+ (point)) end))))
1651 (when first
1652 (goto-char first)
1653 (condition-case nil
1654 (if (not
1655 (yes-or-no-p
1656 (substitute-command-keys
1657 (concat "Modify this concealed text? (\"no\" aborts,"
1658 " \\[keyboard-quit] also reconceals) "))))
1659 (progn (goto-char start)
1660 (error "Concealed-text change refused.")))
1661 (quit (allout-flag-region ol-start ol-end nil)
1662 (allout-flag-region ol-start ol-end t)
1663 (error "Concealed-text change abandoned, text reconcealed."))))
1664 (goto-char start))))
1665;;;_ > allout-before-change-handler (beg end)
1666(defun allout-before-change-handler (beg end)
1667 "Protect against changes to invisible text.
1668
1669See allout-overlay-interior-modification-handler for details.
1670
1671This before-change handler is used only where modification-hooks
1672overlay property is not supported."
1673 (if (not allout-mode)
1674 nil
1675 (allout-overlay-interior-modification-handler nil nil beg end nil)))
1676;;;_ > allout-isearch-end-handler (&optional overlay)
1677(defun allout-isearch-end-handler (&optional overlay)
1678 "Reconcile allout outline exposure on arriving in hidden text after isearch.
1679
1680Optional OVERLAY parameter is for when this function is used by
1681`isearch-open-invisible' overlay property. It is otherwise unused, so this
1682function can also be used as an `isearch-mode-end-hook'."
1683
1684 (if (and (allout-mode-p) (allout-hidden-p))
1685 (allout-show-to-offshoot)))
1686
1608;;;_ #3 Internal Position State-Tracking - "allout-recent-*" funcs 1687;;;_ #3 Internal Position State-Tracking - "allout-recent-*" funcs
1609;;; All the basic outline functions that directly do string matches to 1688;;; All the basic outline functions that directly do string matches to
1610;;; evaluate heading prefix location set the variables 1689;;; evaluate heading prefix location set the variables
@@ -1668,6 +1747,10 @@ to return the current depth of the most recently matched topic."
1668;;;_ #4 Navigation 1747;;;_ #4 Navigation
1669 1748
1670;;;_ - Position Assessment 1749;;;_ - Position Assessment
1750;;;_ > allout-hidden-p (&optional pos)
1751(defsubst allout-hidden-p (&optional pos)
1752 "Non-nil if the character after point is invisible."
1753 (get-char-property (or pos (point)) 'invisible))
1671;;;_ : Location Predicates 1754;;;_ : Location Predicates
1672;;;_ > allout-on-current-heading-p () 1755;;;_ > allout-on-current-heading-p ()
1673(defun allout-on-current-heading-p () 1756(defun allout-on-current-heading-p ()
@@ -1675,7 +1758,7 @@ to return the current depth of the most recently matched topic."
1675 1758
1676Actually, returns prefix beginning point." 1759Actually, returns prefix beginning point."
1677 (save-excursion 1760 (save-excursion
1678 (beginning-of-line) 1761 (allout-beginning-of-current-line)
1679 (and (looking-at allout-regexp) 1762 (and (looking-at allout-regexp)
1680 (allout-prefix-data (match-beginning 0) (match-end 0))))) 1763 (allout-prefix-data (match-beginning 0) (match-end 0)))))
1681;;;_ > allout-on-heading-p () 1764;;;_ > allout-on-heading-p ()
@@ -1686,39 +1769,36 @@ Actually, returns prefix beginning point."
1686 (and (save-excursion (beginning-of-line) 1769 (and (save-excursion (beginning-of-line)
1687 (looking-at allout-regexp)) 1770 (looking-at allout-regexp))
1688 (= (point)(save-excursion (allout-end-of-prefix)(point))))) 1771 (= (point)(save-excursion (allout-end-of-prefix)(point)))))
1689;;;_ > allout-hidden-p ()
1690(defmacro allout-hidden-p ()
1691 "True if point is in hidden text."
1692 '(save-excursion
1693 (and (re-search-backward "[\n\r]" () t)
1694 (= ?\r (following-char)))))
1695;;;_ > allout-visible-p ()
1696(defmacro allout-visible-p ()
1697 "True if point is not in hidden text."
1698 (interactive)
1699 '(not (allout-hidden-p)))
1700;;;_ : Location attributes 1772;;;_ : Location attributes
1701;;;_ > allout-depth () 1773;;;_ > allout-depth ()
1702(defsubst allout-depth () 1774(defun allout-depth ()
1703 "Like `allout-current-depth', but respects hidden as well as visible topics." 1775 "Return depth of topic most immediately containing point.
1776
1777Return zero if point is not within any topic.
1778
1779Like `allout-current-depth', but respects hidden as well as visible topics."
1704 (save-excursion 1780 (save-excursion
1705 (if (allout-goto-prefix) 1781 (let ((start-point (point)))
1706 (allout-recent-depth) 1782 (if (and (allout-goto-prefix)
1707 (progn 1783 (not (< start-point (point))))
1708 ;; Oops, no prefix, zero prefix data: 1784 (allout-recent-depth)
1709 (allout-prefix-data (point)(point)) 1785 (progn
1710 ;; ... and return 0: 1786 ;; Oops, no prefix, zero prefix data:
1711 0)))) 1787 (allout-prefix-data (point)(point))
1788 ;; ... and return 0:
1789 0)))))
1712;;;_ > allout-current-depth () 1790;;;_ > allout-current-depth ()
1713(defmacro allout-current-depth () 1791(defun allout-current-depth ()
1714 "Return nesting depth of visible topic most immediately containing point." 1792 "Return depth of visible topic most immediately containing point.
1715 '(save-excursion 1793
1716 (if (allout-back-to-current-heading) 1794Return zero if point is not within any topic."
1717 (max 1 1795 (save-excursion
1718 (- allout-recent-prefix-end 1796 (if (allout-back-to-current-heading)
1719 allout-recent-prefix-beginning 1797 (max 1
1720 allout-header-subtraction)) 1798 (- allout-recent-prefix-end
1721 0))) 1799 allout-recent-prefix-beginning
1800 allout-header-subtraction))
1801 0)))
1722;;;_ > allout-get-current-prefix () 1802;;;_ > allout-get-current-prefix ()
1723(defun allout-get-current-prefix () 1803(defun allout-get-current-prefix ()
1724 "Topic prefix of the current topic." 1804 "Topic prefix of the current topic."
@@ -1734,7 +1814,7 @@ Actually, returns prefix beginning point."
1734;;;_ > allout-current-bullet () 1814;;;_ > allout-current-bullet ()
1735(defun allout-current-bullet () 1815(defun allout-current-bullet ()
1736 "Return bullet of current (visible) topic heading, or none if none found." 1816 "Return bullet of current (visible) topic heading, or none if none found."
1737 (condition-case err 1817 (condition-case nil
1738 (save-excursion 1818 (save-excursion
1739 (allout-back-to-current-heading) 1819 (allout-back-to-current-heading)
1740 (buffer-substring (- allout-recent-prefix-end 1) 1820 (buffer-substring (- allout-recent-prefix-end 1)
@@ -1783,7 +1863,31 @@ Outermost is first."
1783 rev-sibls) 1863 rev-sibls)
1784 ) 1864 )
1785 1865
1786;;;_ - Navigation macros 1866;;;_ - Navigation routines
1867;;;_ > allout-beginning-of-current-line ()
1868(defun allout-beginning-of-current-line ()
1869 "Like beginning of line, but to visible text."
1870
1871 ;; XXX We would use `(move-beginning-of-line 1)', but it gets
1872 ;; stuck on some hidden newlines, eg at column 80, as of GNU Emacs 22.0.50.
1873 ;; Conversely, `beginning-of-line' can make no progress in other
1874 ;; situations. Both are necessary, in the order used below.
1875 (move-beginning-of-line 1)
1876 (beginning-of-line)
1877 (while (or (not (bolp)) (allout-hidden-p))
1878 (beginning-of-line)
1879 (if (or (allout-hidden-p) (not (bolp)))
1880 (forward-char -1))))
1881;;;_ > allout-end-of-current-line ()
1882(defun allout-end-of-current-line ()
1883 "Move to the end of line, past concealed text if any."
1884 ;; XXX This is for symmetry with `allout-beginning-of-current-line' -
1885 ;; `move-end-of-line' doesn't suffer the same problem as
1886 ;; `move-beginning-of-line'.
1887 (end-of-line)
1888 (while (allout-hidden-p)
1889 (end-of-line)
1890 (if (allout-hidden-p) (forward-char 1))))
1787;;;_ > allout-next-heading () 1891;;;_ > allout-next-heading ()
1788(defsubst allout-next-heading () 1892(defsubst allout-next-heading ()
1789 "Move to the heading for the topic \(possibly invisible) before this one. 1893 "Move to the heading for the topic \(possibly invisible) before this one.
@@ -1798,7 +1902,7 @@ Returns the location of the heading, or nil if none found."
1798 (goto-char (or (match-beginning 2) 1902 (goto-char (or (match-beginning 2)
1799 allout-recent-prefix-beginning)) 1903 allout-recent-prefix-beginning))
1800 (or (match-end 2) allout-recent-prefix-end)))) 1904 (or (match-end 2) allout-recent-prefix-end))))
1801;;;_ : allout-this-or-next-heading 1905;;;_ > allout-this-or-next-heading
1802(defun allout-this-or-next-heading () 1906(defun allout-this-or-next-heading ()
1803 "Position cursor on current or next heading." 1907 "Position cursor on current or next heading."
1804 ;; A throwaway non-macro that is defined after allout-next-heading 1908 ;; A throwaway non-macro that is defined after allout-next-heading
@@ -1822,6 +1926,21 @@ Return the location of the beginning of the heading, or nil if not found."
1822 (goto-char (or (match-beginning 2) 1926 (goto-char (or (match-beginning 2)
1823 allout-recent-prefix-beginning)) 1927 allout-recent-prefix-beginning))
1824 (or (match-end 2) allout-recent-prefix-end)))))) 1928 (or (match-end 2) allout-recent-prefix-end))))))
1929;;;_ > allout-get-invisibility-overlay ()
1930(defun allout-get-invisibility-overlay ()
1931 "Return the overlay at point that dictates allout invisibility."
1932 (let ((overlays (overlays-at (point)))
1933 got)
1934 (while (and overlays (not got))
1935 (if (equal (overlay-get (car overlays) 'invisible) 'allout)
1936 (setq got (car overlays))))
1937 got))
1938;;;_ > allout-back-to-visible-text ()
1939(defun allout-back-to-visible-text ()
1940 "Move to most recent prior character that is visible, and return point."
1941 (if (allout-hidden-p)
1942 (goto-char (overlay-start (allout-get-invisibility-overlay))))
1943 (point))
1825 1944
1826;;;_ - Subtree Charting 1945;;;_ - Subtree Charting
1827;;;_ " These routines either produce or assess charts, which are 1946;;;_ " These routines either produce or assess charts, which are
@@ -1912,11 +2031,11 @@ starting point, and PREV-DEPTH is depth of prior topic."
1912 ; the original level. Position 2031 ; the original level. Position
1913 ; to the end of it: 2032 ; to the end of it:
1914 (progn (and (not (eobp)) (forward-char -1)) 2033 (progn (and (not (eobp)) (forward-char -1))
1915 (and (memq (preceding-char) '(?\n ?\r)) 2034 (and (= (preceding-char) ?\n)
1916 (memq (aref (buffer-substring (max 1 (- (point) 3)) 2035 (= (aref (buffer-substring (max 1 (- (point) 3))
1917 (point)) 2036 (point))
1918 1) 2037 1)
1919 '(?\n ?\r)) 2038 ?\n)
1920 (forward-char -1)) 2039 (forward-char -1))
1921 (setq allout-recent-end-of-subtree (point)))) 2040 (setq allout-recent-end-of-subtree (point))))
1922 2041
@@ -1954,7 +2073,7 @@ start point."
1954 (if further (setq result (append further result))) 2073 (if further (setq result (append further result)))
1955 (setq chart (cdr chart))) 2074 (setq chart (cdr chart)))
1956 (goto-char here) 2075 (goto-char here)
1957 (if (= (preceding-char) ?\r) 2076 (if (allout-hidden-p)
1958 (setq result (cons here result))) 2077 (setq result (cons here result)))
1959 (setq chart (cdr chart)))) 2078 (setq chart (cdr chart))))
1960 result)) 2079 result))
@@ -2003,7 +2122,7 @@ Returns the point at the beginning of the prefix, or nil if none."
2003 2122
2004 (let (done) 2123 (let (done)
2005 (while (and (not done) 2124 (while (and (not done)
2006 (re-search-backward "[\n\r]" nil 1)) 2125 (search-backward "\n" nil 1))
2007 (forward-char 1) 2126 (forward-char 1)
2008 (if (looking-at allout-regexp) 2127 (if (looking-at allout-regexp)
2009 (setq done (allout-prefix-data (match-beginning 0) 2128 (setq done (allout-prefix-data (match-beginning 0)
@@ -2042,19 +2161,30 @@ otherwise skip white space between bullet and ensuing text."
2042 (1- (match-end 0)))) 2161 (1- (match-end 0))))
2043;;;_ > allout-back-to-current-heading () 2162;;;_ > allout-back-to-current-heading ()
2044(defun allout-back-to-current-heading () 2163(defun allout-back-to-current-heading ()
2045 "Move to heading line of current topic, or beginning if already on the line." 2164 "Move to heading line of current topic, or beginning if already on the line.
2046 2165
2047 (beginning-of-line) 2166Return value of point, unless we started outside of (before any) topics,
2048 (prog1 (or (allout-on-current-heading-p) 2167in which case we return nil."
2049 (and (re-search-backward (concat "^\\(" allout-regexp "\\)") 2168
2050 nil 2169 (allout-beginning-of-current-line)
2051 'move) 2170 (if (or (allout-on-current-heading-p)
2052 (allout-prefix-data (match-beginning 1)(match-end 1)))) 2171 (and (re-search-backward (concat "^\\(" allout-regexp "\\)")
2053 (if (interactive-p) (allout-end-of-prefix)))) 2172 nil 'move)
2173 (progn (while (allout-hidden-p)
2174 (allout-beginning-of-current-line)
2175 (if (not (looking-at allout-regexp))
2176 (re-search-backward (concat
2177 "^\\(" allout-regexp "\\)")
2178 nil 'move)))
2179 (allout-prefix-data (match-beginning 1)
2180 (match-end 1)))))
2181 (if (interactive-p)
2182 (allout-end-of-prefix)
2183 (point))))
2054;;;_ > allout-back-to-heading () 2184;;;_ > allout-back-to-heading ()
2055(defalias 'allout-back-to-heading 'allout-back-to-current-heading) 2185(defalias 'allout-back-to-heading 'allout-back-to-current-heading)
2056;;;_ > allout-pre-next-preface () 2186;;;_ > allout-pre-next-prefix ()
2057(defun allout-pre-next-preface () 2187(defun allout-pre-next-prefix ()
2058 "Skip forward to just before the next heading line. 2188 "Skip forward to just before the next heading line.
2059 2189
2060Returns that character position." 2190Returns that character position."
@@ -2062,12 +2192,16 @@ Returns that character position."
2062 (if (re-search-forward allout-line-boundary-regexp nil 'move) 2192 (if (re-search-forward allout-line-boundary-regexp nil 'move)
2063 (prog1 (goto-char (match-beginning 0)) 2193 (prog1 (goto-char (match-beginning 0))
2064 (allout-prefix-data (match-beginning 2)(match-end 2))))) 2194 (allout-prefix-data (match-beginning 2)(match-end 2)))))
2065;;;_ > allout-end-of-subtree (&optional current) 2195;;;_ > allout-end-of-subtree (&optional current include-trailing-blank)
2066(defun allout-end-of-subtree (&optional current) 2196(defun allout-end-of-subtree (&optional current include-trailing-blank)
2067 "Put point at the end of the last leaf in the containing topic. 2197 "Put point at the end of the last leaf in the containing topic.
2068 2198
2069If optional CURRENT is true (default false), then put point at the end of 2199Optional CURRENT means put point at the end of the containing
2070the containing visible topic. 2200visible topic.
2201
2202Optional INCLUDE-TRAILING-BLANK means include a trailing blank line, if
2203any, as part of the subtree. Otherwise, that trailing blank will be
2204excluded as delimiting whitespace between topics.
2071 2205
2072Returns the value of point." 2206Returns the value of point."
2073 (interactive "P") 2207 (interactive "P")
@@ -2080,18 +2214,21 @@ Returns the value of point."
2080 (> (allout-recent-depth) level)) 2214 (> (allout-recent-depth) level))
2081 (allout-next-heading)) 2215 (allout-next-heading))
2082 (and (not (eobp)) (forward-char -1)) 2216 (and (not (eobp)) (forward-char -1))
2083 (and (memq (preceding-char) '(?\n ?\r)) 2217 (if (and (not include-trailing-blank) (= ?\n (preceding-char)))
2084 (memq (aref (buffer-substring (max 1 (- (point) 3)) (point)) 1)
2085 '(?\n ?\r))
2086 (forward-char -1)) 2218 (forward-char -1))
2087 (setq allout-recent-end-of-subtree (point)))) 2219 (setq allout-recent-end-of-subtree (point))))
2088;;;_ > allout-end-of-current-subtree () 2220;;;_ > allout-end-of-current-subtree (&optional include-trailing-blank)
2089(defun allout-end-of-current-subtree () 2221(defun allout-end-of-current-subtree (&optional include-trailing-blank)
2222
2090 "Put point at end of last leaf in currently visible containing topic. 2223 "Put point at end of last leaf in currently visible containing topic.
2091 2224
2225Optional INCLUDE-TRAILING-BLANK means include a trailing blank line, if
2226any, as part of the subtree. Otherwise, that trailing blank will be
2227excluded as delimiting whitespace between topics.
2228
2092Returns the value of point." 2229Returns the value of point."
2093 (interactive) 2230 (interactive)
2094 (allout-end-of-subtree t)) 2231 (allout-end-of-subtree t include-trailing-blank))
2095;;;_ > allout-beginning-of-current-entry () 2232;;;_ > allout-beginning-of-current-entry ()
2096(defun allout-beginning-of-current-entry () 2233(defun allout-beginning-of-current-entry ()
2097 "When not already there, position point at beginning of current topic header. 2234 "When not already there, position point at beginning of current topic header.
@@ -2104,18 +2241,23 @@ If already there, move cursor to bullet for hot-spot operation.
2104 (if (and (interactive-p) 2241 (if (and (interactive-p)
2105 (= (point) start-point)) 2242 (= (point) start-point))
2106 (goto-char (allout-current-bullet-pos))))) 2243 (goto-char (allout-current-bullet-pos)))))
2107;;;_ > allout-end-of-entry () 2244;;;_ > allout-end-of-entry (&optional inclusive)
2108(defun allout-end-of-entry () 2245(defun allout-end-of-entry (&optional inclusive)
2109 "Position the point at the end of the current topics' entry." 2246 "Position the point at the end of the current topics' entry.
2247
2248Optional INCLUSIVE means also include trailing empty line, if any. When
2249unset, whitespace between items separates them even when the items are
2250collapsed."
2110 (interactive) 2251 (interactive)
2111 (prog1 (allout-pre-next-preface) 2252 (allout-pre-next-prefix)
2112 (if (and (not (bobp))(looking-at "^$")) 2253 (if (and (not inclusive) (not (bobp)) (= ?\n (preceding-char)))
2113 (forward-char -1)))) 2254 (forward-char -1))
2255 (point))
2114;;;_ > allout-end-of-current-heading () 2256;;;_ > allout-end-of-current-heading ()
2115(defun allout-end-of-current-heading () 2257(defun allout-end-of-current-heading ()
2116 (interactive) 2258 (interactive)
2117 (allout-beginning-of-current-entry) 2259 (allout-beginning-of-current-entry)
2118 (re-search-forward "[\n\r]" nil t) 2260 (search-forward "\n" nil t)
2119 (forward-char -1)) 2261 (forward-char -1))
2120(defalias 'allout-end-of-heading 'allout-end-of-current-heading) 2262(defalias 'allout-end-of-heading 'allout-end-of-current-heading)
2121;;;_ > allout-get-body-text () 2263;;;_ > allout-get-body-text ()
@@ -2123,13 +2265,13 @@ If already there, move cursor to bullet for hot-spot operation.
2123 "Return the unmangled body text of the topic immediately containing point." 2265 "Return the unmangled body text of the topic immediately containing point."
2124 (save-excursion 2266 (save-excursion
2125 (allout-end-of-prefix) 2267 (allout-end-of-prefix)
2126 (if (not (re-search-forward "[\n\r]" nil t)) 2268 (if (not (search-forward "\n" nil t))
2127 nil 2269 nil
2128 (backward-char 1) 2270 (backward-char 1)
2129 (let ((pre-body (point))) 2271 (let ((pre-body (point)))
2130 (if (not pre-body) 2272 (if (not pre-body)
2131 nil 2273 nil
2132 (allout-end-of-entry) 2274 (allout-end-of-entry t)
2133 (if (not (= pre-body (point))) 2275 (if (not (= pre-body (point)))
2134 (buffer-substring-no-properties (1+ pre-body) (point)))) 2276 (buffer-substring-no-properties (1+ pre-body) (point))))
2135 ) 2277 )
@@ -2189,8 +2331,7 @@ DONT-COMPLAIN is non-nil."
2189 (allout-back-to-current-heading) 2331 (allout-back-to-current-heading)
2190 (let ((present-level (allout-recent-depth)) 2332 (let ((present-level (allout-recent-depth))
2191 (last-good (point)) 2333 (last-good (point))
2192 failed 2334 failed)
2193 return)
2194 ;; Loop for iterating arg: 2335 ;; Loop for iterating arg:
2195 (while (and (> (allout-recent-depth) 1) 2336 (while (and (> (allout-recent-depth) 1)
2196 (> arg 0) 2337 (> arg 0)
@@ -2260,11 +2401,9 @@ Presumes point is at the start of a topic prefix."
2260 (if (or (bobp) (eobp)) 2401 (if (or (bobp) (eobp))
2261 nil 2402 nil
2262 (forward-char -1)) 2403 (forward-char -1))
2263 (if (or (bobp) (not (memq (preceding-char) '(?\n ?\r)))) 2404 (if (or (bobp) (not (= ?\n (preceding-char))))
2264 nil 2405 nil
2265 (forward-char -1) 2406 (forward-char -1))
2266 (if (or (bobp) (not (memq (preceding-char) '(?\n ?\r))))
2267 (forward-char -1)))
2268 (point)) 2407 (point))
2269;;;_ > allout-beginning-of-level () 2408;;;_ > allout-beginning-of-level ()
2270(defun allout-beginning-of-level () 2409(defun allout-beginning-of-level ()
@@ -2282,19 +2421,19 @@ Presumes point is at the start of a topic prefix."
2282(defun allout-next-visible-heading (arg) 2421(defun allout-next-visible-heading (arg)
2283 "Move to the next ARG'th visible heading line, backward if arg is negative. 2422 "Move to the next ARG'th visible heading line, backward if arg is negative.
2284 2423
2285Move as far as possible in indicated direction \(beginning or end of 2424Move to buffer limit in indicated direction if headings are exhausted."
2286buffer) if headings are exhausted."
2287 2425
2288 (interactive "p") 2426 (interactive "p")
2289 (let* ((backward (if (< arg 0) (setq arg (* -1 arg)))) 2427 (let* ((backward (if (< arg 0) (setq arg (* -1 arg))))
2290 (step (if backward -1 1)) 2428 (step (if backward -1 1))
2291 (start-point (point))
2292 prev got) 2429 prev got)
2293 2430
2294 (while (> arg 0) ; limit condition 2431 (while (> arg 0) ; limit condition
2295 (while (and (not (if backward (bobp)(eobp))) ; boundary condition 2432 (while (and (not (if backward (bobp)(eobp))) ; boundary condition
2296 ;; Move, skipping over all those concealed lines: 2433 ;; Move, skipping over all those concealed lines:
2297 (< -1 (forward-line step)) 2434 (prog1 (condition-case nil (or (line-move step) t)
2435 (error nil))
2436 (allout-beginning-of-current-line))
2298 (not (setq got (looking-at allout-regexp))))) 2437 (not (setq got (looking-at allout-regexp)))))
2299 ;; Register this got, it may be the last: 2438 ;; Register this got, it may be the last:
2300 (if got (setq prev got)) 2439 (if got (setq prev got))
@@ -2323,7 +2462,6 @@ Takes optional repeat-count, goes backward if count is negative.
2323Returns resulting position, else nil if none found." 2462Returns resulting position, else nil if none found."
2324 (interactive "p") 2463 (interactive "p")
2325 (let ((start-depth (allout-current-depth)) 2464 (let ((start-depth (allout-current-depth))
2326 (start-point (point))
2327 (start-arg arg) 2465 (start-arg arg)
2328 (backward (> 0 arg)) 2466 (backward (> 0 arg))
2329 last-depth 2467 last-depth
@@ -2386,51 +2524,17 @@ are mapped to the command of the corresponding control-key on the
2386- Implement (and clear) `allout-post-goto-bullet', for hot-spot 2524- Implement (and clear) `allout-post-goto-bullet', for hot-spot
2387 outline commands. 2525 outline commands.
2388 2526
2389- Decrypt topic currently being edited if it was encrypted for a save. 2527- Decrypt topic currently being edited if it was encrypted for a save."
2390
2391- Massage buffer-undo-list so successive, standard character self-inserts are
2392 aggregated. This kludge compensates for lack of undo bunching when
2393 before-change-functions is used."
2394 2528
2395 ; Apply any external change func: 2529 ; Apply any external change func:
2396 (if (not (allout-mode-p)) ; In allout-mode. 2530 (if (not (allout-mode-p)) ; In allout-mode.
2397 nil 2531 nil
2398 (if allout-isearch-dynamic-expose
2399 (allout-isearch-rectification))
2400 ;; Undo bunching business:
2401 (if (and (listp buffer-undo-list) ; Undo history being kept.
2402 (equal this-command 'self-insert-command)
2403 (equal last-command 'self-insert-command))
2404 (let* ((prev-stuff (cdr buffer-undo-list))
2405 (before-prev-stuff (cdr (cdr prev-stuff)))
2406 cur-cell cur-from cur-to
2407 prev-cell prev-from prev-to)
2408 (if (and before-prev-stuff ; Goes back far enough to bother,
2409 (not (car prev-stuff)) ; and break before current,
2410 (not (car before-prev-stuff)) ; !and break before prev!
2411 (setq prev-cell (car (cdr prev-stuff))) ; contents now,
2412 (setq cur-cell (car buffer-undo-list)) ; contents prev.
2413
2414 ;; cur contents denote a single char insertion:
2415 (numberp (setq cur-from (car cur-cell)))
2416 (numberp (setq cur-to (cdr cur-cell)))
2417 (= 1 (- cur-to cur-from))
2418
2419 ;; prev contents denote fewer than aggregate-limit
2420 ;; insertions:
2421 (numberp (setq prev-from (car prev-cell)))
2422 (numberp (setq prev-to (cdr prev-cell)))
2423 ; Below threshold:
2424 (> allout-undo-aggregation (- prev-to prev-from)))
2425 (setq buffer-undo-list
2426 (cons (cons prev-from cur-to)
2427 (cdr (cdr (cdr buffer-undo-list))))))))
2428 2532
2429 (if (and (boundp 'allout-after-save-decrypt) 2533 (if (and (boundp 'allout-after-save-decrypt)
2430 allout-after-save-decrypt) 2534 allout-after-save-decrypt)
2431 (allout-after-saves-handler)) 2535 (allout-after-saves-handler))
2432 2536
2433 ;; Implement -post-goto-bullet, if set: (must be after undo business) 2537 ;; Implement -post-goto-bullet, if set:
2434 (if (and allout-post-goto-bullet 2538 (if (and allout-post-goto-bullet
2435 (allout-current-bullet-pos)) 2539 (allout-current-bullet-pos))
2436 (progn (goto-char (allout-current-bullet-pos)) 2540 (progn (goto-char (allout-current-bullet-pos))
@@ -2456,10 +2560,6 @@ return to regular interpretation of self-insert characters."
2456 (if (not (allout-mode-p)) 2560 (if (not (allout-mode-p))
2457 ;; Shouldn't be invoked if not in allout-mode, but just in case: 2561 ;; Shouldn't be invoked if not in allout-mode, but just in case:
2458 nil 2562 nil
2459 ;; Register isearch status:
2460 (if (and (boundp 'isearch-mode) isearch-mode)
2461 (setq allout-pre-was-isearching t)
2462 (setq allout-pre-was-isearching nil))
2463 ;; Hot-spot navigation provisions: 2563 ;; Hot-spot navigation provisions:
2464 (if (and (eq this-command 'self-insert-command) 2564 (if (and (eq this-command 'self-insert-command)
2465 (eq (point)(allout-current-bullet-pos))) 2565 (eq (point)(allout-current-bullet-pos)))
@@ -2499,110 +2599,6 @@ See `allout-init' for setup instructions."
2499 (not (allout-mode-p)) 2599 (not (allout-mode-p))
2500 allout-layout) 2600 allout-layout)
2501 (allout-mode t))) 2601 (allout-mode t)))
2502;;;_ > allout-isearch-rectification
2503(defun allout-isearch-rectification ()
2504 "Rectify outline exposure before, during, or after isearch.
2505
2506Called as part of `allout-post-command-business'."
2507
2508 (let ((isearching (and (boundp 'isearch-mode) isearch-mode)))
2509 (cond ((and isearching (not allout-pre-was-isearching))
2510 (allout-isearch-expose 'start))
2511 ((and isearching allout-pre-was-isearching)
2512 (allout-isearch-expose 'continue))
2513 ((and (not isearching) allout-pre-was-isearching)
2514 (allout-isearch-expose 'final))
2515 ;; Not and wasn't isearching:
2516 (t (setq allout-isearch-prior-pos nil)
2517 (setq allout-isearch-did-quit nil)))))
2518;;;_ = allout-isearch-was-font-lock
2519(defvar allout-isearch-was-font-lock
2520 (and (boundp 'font-lock-mode) font-lock-mode))
2521;;;_ > allout-isearch-expose (mode)
2522(defun allout-isearch-expose (mode)
2523 "MODE is either 'clear, 'start, 'continue, or 'final."
2524 ;; allout-isearch-prior-pos encodes exposure status of prior pos:
2525 ;; (pos was-vis header-pos end-pos)
2526 ;; pos - point of concern
2527 ;; was-vis - t, else 'topic if entire topic was exposed, 'entry otherwise
2528 ;; Do reclosure or prior pos, as necessary:
2529 (if (eq mode 'start)
2530 (setq allout-isearch-was-font-lock (and (boundp 'font-lock-mode)
2531 font-lock-mode)
2532 font-lock-mode nil)
2533 (if (eq mode 'final)
2534 (setq font-lock-mode allout-isearch-was-font-lock))
2535 (if (and allout-isearch-prior-pos
2536 (listp allout-isearch-prior-pos))
2537 ;; Conceal prior peek:
2538 (allout-flag-region (car (cdr allout-isearch-prior-pos))
2539 (car (cdr (cdr allout-isearch-prior-pos)))
2540 ?\r)))
2541 (if (allout-visible-p)
2542 (setq allout-isearch-prior-pos nil)
2543 (if (not (eq mode 'final))
2544 (setq allout-isearch-prior-pos (cons (point) (allout-show-entry)))
2545 (if allout-isearch-did-quit
2546 nil
2547 (setq allout-isearch-prior-pos nil)
2548 (allout-show-children))))
2549 (setq allout-isearch-did-quit nil))
2550;;;_ > allout-enwrap-isearch ()
2551(defun allout-enwrap-isearch ()
2552 "Impose `allout-mode' isearch-abort wrapper for dynamic exposure in isearch.
2553
2554The function checks to ensure that the rebinding is done only once."
2555
2556 (add-hook 'isearch-mode-end-hook 'allout-isearch-rectification)
2557 (if (fboundp 'allout-real-isearch-abort)
2558 ;;
2559 nil
2560 ; Ensure load of isearch-mode:
2561 (if (or (and (fboundp 'isearch-mode)
2562 (fboundp 'isearch-abort))
2563 (condition-case error
2564 (load-library "isearch-mode")
2565 ('file-error (message
2566 "Skipping isearch-mode provisions - %s '%s'"
2567 (car (cdr error))
2568 (car (cdr (cdr error))))
2569 (sit-for 1)
2570 ;; Inhibit subsequent tries and return nil:
2571 (setq allout-isearch-dynamic-expose nil))))
2572 ;; Isearch-mode loaded, encapsulate specific entry points for
2573 ;; outline dynamic-exposure business:
2574 (progn
2575 ;; stash crucial isearch-mode funcs under known, private
2576 ;; names, then register wrapper functions under the old
2577 ;; names, in their stead:
2578 (fset 'allout-real-isearch-abort (symbol-function 'isearch-abort))
2579 (fset 'isearch-abort 'allout-isearch-abort)))))
2580;;;_ > allout-isearch-abort ()
2581(defun allout-isearch-abort ()
2582 "Wrapper for allout-real-isearch-abort \(which see), to register
2583actual quits."
2584 (interactive)
2585 (setq allout-isearch-did-quit nil)
2586 (condition-case what
2587 (allout-real-isearch-abort)
2588 ('quit (setq allout-isearch-did-quit t)
2589 (signal 'quit nil))))
2590
2591;;; Prevent unnecessary font-lock while isearching!
2592(defvar isearch-was-font-locking nil)
2593(defun isearch-inhibit-font-lock ()
2594 "Inhibit `font-lock' while isearching - for use on `isearch-mode-hook'."
2595 (if (and (allout-mode-p) (boundp 'font-lock-mode) font-lock-mode)
2596 (setq isearch-was-font-locking t
2597 font-lock-mode nil)))
2598(add-hook 'isearch-mode-hook 'isearch-inhibit-font-lock)
2599(defun isearch-reenable-font-lock ()
2600 "Reenable font-lock after isearching - for use on `isearch-mode-end-hook'."
2601 (if (and (boundp 'font-lock-mode) font-lock-mode)
2602 (if (and (allout-mode-p) isearch-was-font-locking)
2603 (setq isearch-was-font-locking nil
2604 font-lock-mode t))))
2605(add-hook 'isearch-mode-end-hook 'isearch-reenable-font-lock)
2606 2602
2607;;;_ - Topic Format Assessment 2603;;;_ - Topic Format Assessment
2608;;;_ > allout-solicit-alternate-bullet (depth &optional current-bullet) 2604;;;_ > allout-solicit-alternate-bullet (depth &optional current-bullet)
@@ -2807,15 +2803,20 @@ index for each successive sibling)."
2807 ((allout-sibling-index)))))) 2803 ((allout-sibling-index))))))
2808 ) 2804 )
2809 ) 2805 )
2810;;;_ > allout-open-topic (relative-depth &optional before use_recent_bullet) 2806;;;_ > allout-open-topic (relative-depth &optional before offer-recent-bullet)
2811(defun allout-open-topic (relative-depth &optional before use_recent_bullet) 2807(defun allout-open-topic (relative-depth &optional before offer-recent-bullet)
2812 "Open a new topic at depth DEPTH. 2808 "Open a new topic at depth DEPTH.
2813 2809
2814New topic is situated after current one, unless optional flag BEFORE 2810New topic is situated after current one, unless optional flag BEFORE
2815is non-nil, or unless current line is complete empty (not even 2811is non-nil, or unless current line is completely empty - lacking even
2816whitespace), in which case open is done on current line. 2812whitespace - in which case open is done on the current line.
2813
2814When adding an offspring, it will be added immediately after the parent if
2815the other offspring are exposed, or after the last child if the offspring
2816are hidden. \(The intervening offspring will be exposed in the latter
2817case.)
2817 2818
2818If USE_RECENT_BULLET is true, offer to use the bullet of the prior sibling. 2819If OFFER-RECENT-BULLET is true, offer to use the bullet of the prior sibling.
2819 2820
2820Nuances: 2821Nuances:
2821 2822
@@ -2839,12 +2840,12 @@ Nuances:
2839 having to go to its preceding sibling, and then open forward 2840 having to go to its preceding sibling, and then open forward
2840 from there." 2841 from there."
2841 2842
2843 (allout-beginning-of-current-line)
2842 (let* ((depth (+ (allout-current-depth) relative-depth)) 2844 (let* ((depth (+ (allout-current-depth) relative-depth))
2843 (opening-on-blank (if (looking-at "^\$") 2845 (opening-on-blank (if (looking-at "^\$")
2844 (not (setq before nil)))) 2846 (not (setq before nil))))
2845 ;; bunch o vars set while computing ref-topic 2847 ;; bunch o vars set while computing ref-topic
2846 opening-numbered 2848 opening-numbered
2847 opening-encrypted
2848 ref-depth 2849 ref-depth
2849 ref-bullet 2850 ref-bullet
2850 (ref-topic (save-excursion 2851 (ref-topic (save-excursion
@@ -2864,13 +2865,6 @@ Nuances:
2864 (allout-descend-to-depth depth)) 2865 (allout-descend-to-depth depth))
2865 (if (allout-numbered-type-prefix) 2866 (if (allout-numbered-type-prefix)
2866 allout-numbered-bullet)))) 2867 allout-numbered-bullet))))
2867 (setq opening-encrypted
2868 (save-excursion
2869 (and allout-topic-encryption-bullet
2870 (or (<= relative-depth 0)
2871 (allout-descend-to-depth depth))
2872 (if (allout-numbered-type-prefix)
2873 allout-numbered-bullet))))
2874 (point))) 2868 (point)))
2875 dbl-space 2869 dbl-space
2876 doing-beginning) 2870 doing-beginning)
@@ -2891,122 +2885,98 @@ Nuances:
2891 (save-excursion 2885 (save-excursion
2892 ;; succeeded by a blank line? 2886 ;; succeeded by a blank line?
2893 (allout-end-of-current-subtree) 2887 (allout-end-of-current-subtree)
2894 (bolp))) 2888 (looking-at "\n\n")))
2895 (and (= ref-depth 1) 2889 (and (= ref-depth 1)
2896 (or before 2890 (or before
2897 (= depth 1) 2891 (= depth 1)
2898 (save-excursion 2892 (save-excursion
2899 ;; Don't already have following 2893 ;; Don't already have following
2900 ;; vertical padding: 2894 ;; vertical padding:
2901 (not (allout-pre-next-preface))))))) 2895 (not (allout-pre-next-prefix)))))))
2902 2896
2903 ; Position to prior heading, 2897 ;; Position to prior heading, if inserting backwards, and not
2904 ; if inserting backwards, and 2898 ;; going outwards:
2905 ; not going outwards:
2906 (if (and before (>= relative-depth 0)) 2899 (if (and before (>= relative-depth 0))
2907 (progn (allout-back-to-current-heading) 2900 (progn (allout-back-to-current-heading)
2908 (setq doing-beginning (bobp)) 2901 (setq doing-beginning (bobp))
2909 (if (not (bobp)) 2902 (if (not (bobp))
2910 (allout-previous-heading))) 2903 (allout-previous-heading)))
2911 (if (and before (bobp)) 2904 (if (and before (bobp))
2912 (allout-unprotected (allout-open-line-not-read-only)))) 2905 (open-line 1)))
2913 2906
2914 (if (<= relative-depth 0) 2907 (if (<= relative-depth 0)
2915 ;; Not going inwards, don't snug up: 2908 ;; Not going inwards, don't snug up:
2916 (if doing-beginning 2909 (if doing-beginning
2917 (allout-unprotected 2910 (if (not dbl-space)
2918 (if (not dbl-space) 2911 (open-line 1)
2919 (allout-open-line-not-read-only) 2912 (open-line 2))
2920 (allout-open-line-not-read-only)
2921 (allout-open-line-not-read-only)))
2922 (if before 2913 (if before
2923 (progn (end-of-line) 2914 (progn (end-of-line)
2924 (allout-pre-next-preface) 2915 (allout-pre-next-prefix)
2925 (while (= ?\r (following-char)) 2916 (while (and (= ?\n (following-char))
2917 (save-excursion
2918 (forward-char 1)
2919 (allout-hidden-p)))
2926 (forward-char 1)) 2920 (forward-char 1))
2927 (if (not (looking-at "^$")) 2921 (if (not (looking-at "^$"))
2928 (allout-unprotected 2922 (open-line 1)))
2929 (allout-open-line-not-read-only)))) 2923 (allout-end-of-current-subtree)
2930 (allout-end-of-current-subtree))) 2924 (if (looking-at "\n\n") (forward-char 1))))
2931 ;; Going inwards - double-space if first offspring is, 2925 ;; Going inwards - double-space if first offspring is
2932 ;; otherwise snug up. 2926 ;; double-spaced, otherwise snug up.
2933 (end-of-line) ; So we skip any concealed progeny. 2927 (allout-end-of-entry)
2934 (allout-pre-next-preface) 2928 (line-move 1)
2929 (allout-beginning-of-current-line)
2930 (backward-char 1)
2935 (if (bolp) 2931 (if (bolp)
2936 ;; Blank lines between current header body and next 2932 ;; Blank lines between current header body and next
2937 ;; header - get to last substantive (non-white-space) 2933 ;; header - get to last substantive (non-white-space)
2938 ;; line in body: 2934 ;; line in body:
2939 (re-search-backward "[^ \t\n]" nil t)) 2935 (progn (setq dbl-space t)
2936 (re-search-backward "[^ \t\n]" nil t)))
2937 (if (looking-at "\n\n")
2938 (setq dbl-space t))
2940 (if (save-excursion 2939 (if (save-excursion
2941 (allout-next-heading) 2940 (allout-next-heading)
2942 (if (> (allout-recent-depth) ref-depth) 2941 (when (> (allout-recent-depth) ref-depth)
2943 ;; This is an offspring. 2942 ;; This is an offspring.
2944 (progn (forward-line -1) 2943 (forward-line -1)
2945 (looking-at "^\\s-*$")))) 2944 (looking-at "^\\s-*$")))
2946 (progn (forward-line 1) 2945 (progn (forward-line 1)
2947 (allout-unprotected 2946 (open-line 1)
2948 (allout-open-line-not-read-only))
2949 (forward-line 1))) 2947 (forward-line 1)))
2950 (end-of-line)) 2948 (allout-end-of-current-line))
2949
2951 ;;(if doing-beginning (goto-char doing-beginning)) 2950 ;;(if doing-beginning (goto-char doing-beginning))
2952 (if (not (bobp)) 2951 (if (not (bobp))
2953 ;; We insert a newline char rather than using open-line to 2952 ;; We insert a newline char rather than using open-line to
2954 ;; avoid rear-stickiness inheritence of read-only property. 2953 ;; avoid rear-stickiness inheritence of read-only property.
2955 (progn (if (and (not (> depth ref-depth)) 2954 (progn (if (and (not (> depth ref-depth))
2956 (not before)) 2955 (not before))
2957 (allout-unprotected 2956 (open-line 1)
2958 (allout-open-line-not-read-only)) 2957 (if (and (not dbl-space) (> depth ref-depth))
2959 (if (> depth ref-depth) 2958 (newline 1)
2960 (allout-unprotected
2961 (allout-open-line-not-read-only))
2962 (if dbl-space 2959 (if dbl-space
2963 (allout-unprotected 2960 (open-line 1)
2964 (allout-open-line-not-read-only))
2965 (if (not before) 2961 (if (not before)
2966 (allout-unprotected (newline 1)))))) 2962 (newline 1)))))
2967 (if dbl-space 2963 (if (and dbl-space (not (> relative-depth 0)))
2968 (allout-unprotected (newline 1))) 2964 (newline 1))
2969 (if (and (not (eobp)) 2965 (if (and (not (eobp))
2970 (not (bolp))) 2966 (not (bolp)))
2971 (forward-char 1)))) 2967 (forward-char 1))))
2972 )) 2968 ))
2973 (insert (concat (allout-make-topic-prefix opening-numbered 2969 (insert (concat (allout-make-topic-prefix opening-numbered t depth)
2974 t 2970 " "))
2975 depth) 2971
2976 " ")) 2972 (allout-rebullet-heading (and offer-recent-bullet ref-bullet)
2977 2973 depth nil nil t)
2978 ;;(if doing-beginning (save-excursion (newline (if dbl-space 2 1)))) 2974 (if (> relative-depth 0)
2979 2975 (save-excursion (goto-char ref-topic)
2980 2976 (allout-show-children)))
2981 (allout-rebullet-heading (and use_recent_bullet ;;; solicit
2982 ref-bullet)
2983 depth ;;; depth
2984 nil ;;; number-control
2985 nil ;;; index
2986 t)
2987 (end-of-line) 2977 (end-of-line)
2988 ) 2978 )
2989 ) 2979 )
2990;;;_ . open-topic contingencies
2991;;;_ ; base topic - one from which open was issued
2992;;;_ , beginning char
2993;;;_ , amount of space before will be used, unless opening in place
2994;;;_ , end char will be used, unless opening before (and it still may)
2995;;;_ ; absolute depth of new topic
2996;;;_ ! insert in place - overrides most stuff
2997;;;_ ; relative depth of new re base
2998;;;_ ; before or after base topic
2999;;;_ ; spacing around topic, if any, prior to new topic and at same depth
3000;;;_ ; buffer boundaries - special provisions for beginning and end ob
3001;;;_ ; level 1 topics have special provisions also - double space.
3002;;;_ ; location of new topic
3003;;;_ > allout-open-line-not-read-only ()
3004(defun allout-open-line-not-read-only ()
3005 "Open line and remove inherited read-only text prop from new char, if any."
3006 (open-line 1)
3007 (if (plist-get (text-properties-at (point)) 'read-only)
3008 (allout-unprotected
3009 (remove-text-properties (point) (+ 1 (point)) '(read-only nil)))))
3010;;;_ > allout-open-subtopic (arg) 2980;;;_ > allout-open-subtopic (arg)
3011(defun allout-open-subtopic (arg) 2981(defun allout-open-subtopic (arg)
3012 "Open new topic header at deeper level than the current one. 2982 "Open new topic header at deeper level than the current one.
@@ -3055,9 +3025,12 @@ Maintains outline hanging topic indentation if
3055 ;; length of topic prefix: 3025 ;; length of topic prefix:
3056 (make-string (progn (allout-end-of-prefix) 3026 (make-string (progn (allout-end-of-prefix)
3057 (current-column)) 3027 (current-column))
3058 ?\ )))))) 3028 ?\ )))))
3029 (use-auto-fill-function (or allout-outside-normal-auto-fill-function
3030 auto-fill-function
3031 'do-auto-fill)))
3059 (if (or allout-former-auto-filler allout-use-hanging-indents) 3032 (if (or allout-former-auto-filler allout-use-hanging-indents)
3060 (do-auto-fill)))) 3033 (funcall use-auto-fill-function))))
3061;;;_ > allout-reindent-body (old-depth new-depth &optional number) 3034;;;_ > allout-reindent-body (old-depth new-depth &optional number)
3062(defun allout-reindent-body (old-depth new-depth &optional number) 3035(defun allout-reindent-body (old-depth new-depth &optional number)
3063 "Reindent body lines which were indented at OLD-DEPTH to NEW-DEPTH. 3036 "Reindent body lines which were indented at OLD-DEPTH to NEW-DEPTH.
@@ -3071,7 +3044,6 @@ Note that refill of indented paragraphs is not done."
3071 (allout-end-of-prefix) 3044 (allout-end-of-prefix)
3072 (let* ((new-margin (current-column)) 3045 (let* ((new-margin (current-column))
3073 excess old-indent-begin old-indent-end 3046 excess old-indent-begin old-indent-end
3074 curr-ind
3075 ;; We want the column where the header-prefix text started 3047 ;; We want the column where the header-prefix text started
3076 ;; *before* the prefix was changed, so we infer it relative 3048 ;; *before* the prefix was changed, so we infer it relative
3077 ;; to the new margin and the shift in depth: 3049 ;; to the new margin and the shift in depth:
@@ -3081,7 +3053,7 @@ Note that refill of indented paragraphs is not done."
3081 (allout-unprotected 3053 (allout-unprotected
3082 (save-match-data 3054 (save-match-data
3083 (while 3055 (while
3084 (and (re-search-forward "[\n\r]\\(\\s-*\\)" 3056 (and (re-search-forward "\n\\(\\s-*\\)"
3085 nil 3057 nil
3086 t) 3058 t)
3087 ;; Register the indent data, before we reset the 3059 ;; Register the indent data, before we reset the
@@ -3231,8 +3203,7 @@ Descends into invisible as well as visible topics, however.
3231 3203
3232With repeat count, shift topic depth by that amount." 3204With repeat count, shift topic depth by that amount."
3233 (interactive "P") 3205 (interactive "P")
3234 (let ((start-col (current-column)) 3206 (let ((start-col (current-column)))
3235 (was-eol (eolp)))
3236 (save-excursion 3207 (save-excursion
3237 ;; Normalize arg: 3208 ;; Normalize arg:
3238 (cond ((null arg) (setq arg 0)) 3209 (cond ((null arg) (setq arg 0))
@@ -3414,8 +3385,8 @@ depth, however."
3414 (if (and (> predecessor-depth 0) 3385 (if (and (> predecessor-depth 0)
3415 (> (+ current-depth arg) 3386 (> (+ current-depth arg)
3416 (1+ predecessor-depth))) 3387 (1+ predecessor-depth)))
3417 (error (concat "May not shift deeper than offspring depth" 3388 (error (concat "Disallowed shift deeper than"
3418 " of previous topic"))))))) 3389 " containing topic's children.")))))))
3419 (allout-rebullet-topic arg)) 3390 (allout-rebullet-topic arg))
3420;;;_ > allout-shift-out (arg) 3391;;;_ > allout-shift-out (arg)
3421(defun allout-shift-out (arg) 3392(defun allout-shift-out (arg)
@@ -3436,84 +3407,72 @@ depth, however."
3436 3407
3437 (interactive "*P") 3408 (interactive "*P")
3438 3409
3439 (let ((start-point (point)) 3410 (if (or (not (allout-mode-p))
3440 (leading-kill-ring-entry (car kill-ring)) 3411 (not (bolp))
3441 binding) 3412 (not (looking-at allout-regexp)))
3442 3413 ;; Above conditions do not obtain - just do a regular kill:
3443 (condition-case err 3414 (kill-line arg)
3444 3415 ;; Ah, have to watch out for adjustments:
3445 (if (not (and (allout-mode-p) ; active outline mode, 3416 (let* ((beg (point))
3446 allout-numbered-bullet ; numbers may need adjustment, 3417 (beg-hidden (allout-hidden-p))
3447 (bolp) ; may be clipping topic head, 3418 (end-hidden (save-excursion (allout-end-of-current-line)
3448 (looking-at allout-regexp))) ; are clipping topic head. 3419 (allout-hidden-p)))
3449 ;; Above conditions do not obtain - just do a regular kill: 3420 (depth (allout-depth))
3450 (kill-line arg) 3421 (collapsed (allout-current-topic-collapsed-p)))
3451 ;; Ah, have to watch out for adjustments: 3422
3452 (let* ((depth (allout-depth)) 3423 (if collapsed
3453 (start-point (point)) 3424 (put-text-property beg (1+ beg) 'allout-was-collapsed t)
3454 binding) 3425 (remove-text-properties beg (1+ beg) '(allout-was-collapsed t)))
3455 ; Do the kill, presenting option 3426
3456 ; for read-only text: 3427 (if (and (not beg-hidden) (not end-hidden))
3457 (kill-line arg) 3428 (allout-unprotected (kill-line arg))
3429 (kill-line arg))
3458 ; Provide some feedback: 3430 ; Provide some feedback:
3459 (sit-for 0) 3431 (sit-for 0)
3460 (save-excursion 3432 (if allout-numbered-bullet
3461 ; Start with the topic 3433 (save-excursion ; Renumber subsequent topics if needed:
3462 ; following killed line:
3463 (if (not (looking-at allout-regexp)) 3434 (if (not (looking-at allout-regexp))
3464 (allout-next-heading)) 3435 (allout-next-heading))
3465 (allout-renumber-to-depth depth)))) 3436 (allout-renumber-to-depth depth))))))
3466 ;; condition case handler:
3467 (text-read-only
3468 (goto-char start-point)
3469 (setq binding (where-is-internal 'allout-kill-topic nil t))
3470 (cond ((not binding) (setq binding ""))
3471 ((arrayp binding)
3472 (setq binding (mapconcat 'key-description (list binding) ", ")))
3473 (t (setq binding (format "%s" binding))))
3474 ;; ensure prior kill-ring leader is properly restored:
3475 (if (eq leading-kill-ring-entry (cadr kill-ring))
3476 ;; Aborted kill got pushed on front - ditch it:
3477 (let ((got (car kill-ring)))
3478 (setq kill-ring (cdr kill-ring))
3479 got)
3480 ;; Aborted kill got appended to prior - resurrect prior:
3481 (setcar kill-ring leading-kill-ring-entry))
3482 ;; make last-command skip this failed command, so kill-appending
3483 ;; conditions track:
3484 (setq this-command last-command)
3485 (error (concat "read-only text hit - use %s allout-kill-topic to"
3486 " discard collapsed stuff")
3487 binding)))
3488 )
3489 )
3490;;;_ > allout-kill-topic () 3437;;;_ > allout-kill-topic ()
3491(defun allout-kill-topic () 3438(defun allout-kill-topic ()
3492 "Kill topic together with subtopics. 3439 "Kill topic together with subtopics.
3493 3440
3494Leaves primary topic's trailing vertical whitespace, if any." 3441Trailing whitespace is killed with a topic if that whitespace:
3442
3443 - would separate the topic from a subsequent sibling
3444 - would separate the topic from the end of buffer
3445 - would not be added to whitespace already separating the topic from the
3446 previous one.
3447
3448Completely collapsed topics are marked as such, for re-collapse
3449when yank with allout-yank into an outline as a heading."
3495 3450
3496 ;; Some finagling is done to make complex topic kills appear faster 3451 ;; Some finagling is done to make complex topic kills appear faster
3497 ;; than they actually are. A redisplay is performed immediately 3452 ;; than they actually are. A redisplay is performed immediately
3498 ;; after the region is disposed of, though the renumbering process 3453 ;; after the region is deleted, though the renumbering process
3499 ;; has yet to be performed. This means that there may appear to be 3454 ;; has yet to be performed. This means that there may appear to be
3500 ;; a lag *after* the kill has been performed. 3455 ;; a lag *after* a kill has been performed.
3501 3456
3502 (interactive) 3457 (interactive)
3503 (let* ((beg (prog1 (allout-back-to-current-heading)(beginning-of-line))) 3458 (let* ((collapsed (allout-current-topic-collapsed-p))
3459 (beg (prog1 (allout-back-to-current-heading) (beginning-of-line)))
3504 (depth (allout-recent-depth))) 3460 (depth (allout-recent-depth)))
3505 (allout-end-of-current-subtree) 3461 (allout-end-of-current-subtree)
3462 (if (and (/= (current-column) 0) (not (eobp)))
3463 (forward-char 1))
3506 (if (not (eobp)) 3464 (if (not (eobp))
3507 (if (or (not (looking-at "^$")) 3465 (if (and (looking-at "\n")
3508 ;; A blank line - cut it with this topic *unless* this 3466 (or (save-excursion
3509 ;; is the last topic at this level, in which case 3467 (or (not (allout-next-heading))
3510 ;; we'll leave the blank line as part of the 3468 (= depth (allout-recent-depth))))
3511 ;; containing topic: 3469 (and (> (- beg (point-min)) 3)
3512 (save-excursion 3470 (string= (buffer-substring (- beg 2) beg) "\n\n"))))
3513 (and (allout-next-heading)
3514 (>= (allout-recent-depth) depth))))
3515 (forward-char 1))) 3471 (forward-char 1)))
3516 3472
3473 (if collapsed
3474 (put-text-property beg (1+ beg) 'allout-was-collapsed t)
3475 (remove-text-properties beg (1+ beg) '(allout-was-collapsed t)))
3517 (allout-unprotected (kill-region beg (point))) 3476 (allout-unprotected (kill-region beg (point)))
3518 (sit-for 0) 3477 (sit-for 0)
3519 (save-excursion 3478 (save-excursion
@@ -3521,7 +3480,7 @@ Leaves primary topic's trailing vertical whitespace, if any."
3521;;;_ > allout-yank-processing () 3480;;;_ > allout-yank-processing ()
3522(defun allout-yank-processing (&optional arg) 3481(defun allout-yank-processing (&optional arg)
3523 3482
3524 "Incidental outline-specific business to be done just after text yanks. 3483 "Incidental allout-specific business to be done just after text yanks.
3525 3484
3526Does depth adjustment of yanked topics, when: 3485Does depth adjustment of yanked topics, when:
3527 3486
@@ -3542,10 +3501,12 @@ however, are left exactly like normal, non-allout-specific yanks."
3542 (interactive "*P") 3501 (interactive "*P")
3543 ; Get to beginning, leaving 3502 ; Get to beginning, leaving
3544 ; region around subject: 3503 ; region around subject:
3545 (if (< (my-mark-marker t) (point)) 3504 (if (< (allout-mark-marker t) (point))
3546 (exchange-point-and-mark)) 3505 (exchange-point-and-mark))
3547 (let* ((subj-beg (point)) 3506 (let* ((subj-beg (point))
3548 (subj-end (my-mark-marker t)) 3507 (into-bol (bolp))
3508 (subj-end (allout-mark-marker t))
3509 (was-collapsed (get-text-property subj-beg 'allout-was-collapsed))
3549 ;; 'resituate' if yanking an entire topic into topic header: 3510 ;; 'resituate' if yanking an entire topic into topic header:
3550 (resituate (and (allout-e-o-prefix-p) 3511 (resituate (and (allout-e-o-prefix-p)
3551 (looking-at (concat "\\(" allout-regexp "\\)")) 3512 (looking-at (concat "\\(" allout-regexp "\\)"))
@@ -3554,7 +3515,7 @@ however, are left exactly like normal, non-allout-specific yanks."
3554 ;; `rectify-numbering' if resituating (where several topics may 3515 ;; `rectify-numbering' if resituating (where several topics may
3555 ;; be resituating) or yanking a topic into a topic slot (bol): 3516 ;; be resituating) or yanking a topic into a topic slot (bol):
3556 (rectify-numbering (or resituate 3517 (rectify-numbering (or resituate
3557 (and (bolp) (looking-at allout-regexp))))) 3518 (and into-bol (looking-at allout-regexp)))))
3558 (if resituate 3519 (if resituate
3559 ; The yanked stuff is a topic: 3520 ; The yanked stuff is a topic:
3560 (let* ((prefix-len (- (match-end 1) subj-beg)) 3521 (let* ((prefix-len (- (match-end 1) subj-beg))
@@ -3575,7 +3536,6 @@ however, are left exactly like normal, non-allout-specific yanks."
3575 (allout-prefix-data (match-beginning 0) 3536 (allout-prefix-data (match-beginning 0)
3576 (match-end 0))) 3537 (match-end 0)))
3577 (allout-recent-depth)))) 3538 (allout-recent-depth))))
3578 done
3579 (more t)) 3539 (more t))
3580 (setq rectify-numbering allout-numbered-bullet) 3540 (setq rectify-numbering allout-numbered-bullet)
3581 (if adjust-to-depth 3541 (if adjust-to-depth
@@ -3616,7 +3576,7 @@ however, are left exactly like normal, non-allout-specific yanks."
3616 (progn 3576 (progn
3617 (beginning-of-line) 3577 (beginning-of-line)
3618 (delete-region (point) subj-beg) 3578 (delete-region (point) subj-beg)
3619 (set-marker (my-mark-marker t) subj-end) 3579 (set-marker (allout-mark-marker t) subj-end)
3620 (goto-char subj-beg) 3580 (goto-char subj-beg)
3621 (allout-end-of-prefix)) 3581 (allout-end-of-prefix))
3622 ; Delete base subj prefix, 3582 ; Delete base subj prefix,
@@ -3643,6 +3603,9 @@ however, are left exactly like normal, non-allout-specific yanks."
3643 nil ;;; index 3603 nil ;;; index
3644 t)) 3604 t))
3645 (message "")))) 3605 (message ""))))
3606 (when (and (or into-bol resituate) was-collapsed)
3607 (remove-text-properties subj-beg (1+ subj-beg) '(allout-was-collapsed))
3608 (allout-hide-current-subtree))
3646 (if (not resituate) 3609 (if (not resituate)
3647 (exchange-point-and-mark)))) 3610 (exchange-point-and-mark))))
3648;;;_ > allout-yank (&optional arg) 3611;;;_ > allout-yank (&optional arg)
@@ -3678,7 +3641,8 @@ works with normal `yank' in non-outline buffers."
3678 (setq this-command 'yank) 3641 (setq this-command 'yank)
3679 (yank arg) 3642 (yank arg)
3680 (if (allout-mode-p) 3643 (if (allout-mode-p)
3681 (allout-yank-processing))) 3644 (allout-yank-processing))
3645)
3682;;;_ > allout-yank-pop (&optional arg) 3646;;;_ > allout-yank-pop (&optional arg)
3683(defun allout-yank-pop (&optional arg) 3647(defun allout-yank-pop (&optional arg)
3684 "Yank-pop like `allout-yank' when popping to bare outline prefixes. 3648 "Yank-pop like `allout-yank' when popping to bare outline prefixes.
@@ -3736,93 +3700,51 @@ by pops to non-distinctive yanks. Bug..."
3736;;;_ - Fundamental 3700;;;_ - Fundamental
3737;;;_ > allout-flag-region (from to flag) 3701;;;_ > allout-flag-region (from to flag)
3738(defun allout-flag-region (from to flag) 3702(defun allout-flag-region (from to flag)
3739 "Hide or show lines from FROM to TO, via Emacs selective-display FLAG char. 3703 "Conceal text from FROM to TO if FLAG is non-nil, else reveal it.
3740Ie, text following flag C-m \(carriage-return) is hidden until the 3704
3741next C-j (newline) char. 3705Text is shown if flag is nil and hidden otherwise."
3742 3706 ;; We use outline invisibility spec.
3743Returns the endpoint of the region." 3707 (remove-overlays from to 'category 'allout-overlay-category)
3744 ;; "OFR-" prefixes to avoid collisions with vars in code calling the macro. 3708 (when flag
3745 ;; ie, elisp macro vars are not 'hygenic', so distinct names are necessary. 3709 (let ((o (make-overlay from to)))
3746 (let ((was-inhibit-r-o inhibit-read-only) 3710 (overlay-put o 'category 'allout-overlay-category)
3747 (was-undo-list buffer-undo-list) 3711 (when (featurep 'xemacs)
3748 (was-modified (buffer-modified-p)) 3712 (let ((props (symbol-plist 'allout-overlay-category)))
3749 trans) 3713 (while props
3750 (unwind-protect 3714 (overlay-put o (pop props) (pop props)))))))
3751 (save-excursion 3715 (run-hooks 'allout-view-change-hook))
3752 (setq inhibit-read-only t)
3753 (setq buffer-undo-list t)
3754 (if (> from to)
3755 (setq trans from from to to trans))
3756 (subst-char-in-region from to
3757 (if (= flag ?\n) ?\r ?\n)
3758 flag t)
3759 ;; adjust character read-protection on all the affected lines.
3760 ;; we handle the region line-by-line.
3761 (goto-char to)
3762 (end-of-line)
3763 (setq to (min (+ 2 (point)) (point-max)))
3764 (goto-char from)
3765 (beginning-of-line)
3766 (while (< (point) to)
3767 ;; handle from start of exposed to beginning of hidden, or eol:
3768 (remove-text-properties (point)
3769 (progn (if (re-search-forward "[\r\n]"
3770 nil t)
3771 (forward-char -1))
3772 (point))
3773 '(read-only nil))
3774 ;; handle from start of hidden, if any, to eol:
3775 (if (and (not (eobp)) (= (char-after (point)) ?\r))
3776 (put-text-property (point) (progn (end-of-line) (point))
3777 'read-only t))
3778 ;; Handle the end-of-line to beginning of next line:
3779 (if (not (eobp))
3780 (progn (forward-char 1)
3781 (remove-text-properties (1- (point)) (point)
3782 '(read-only nil)))))
3783 )
3784 (if (not was-modified)
3785 (set-buffer-modified-p nil))
3786 (setq inhibit-read-only was-inhibit-r-o)
3787 (setq buffer-undo-list was-undo-list)
3788 )
3789 )
3790 )
3791;;;_ > allout-flag-current-subtree (flag) 3716;;;_ > allout-flag-current-subtree (flag)
3792(defun allout-flag-current-subtree (flag) 3717(defun allout-flag-current-subtree (flag)
3793 "Hide or show subtree of currently-visible topic. 3718 "Conceal currently-visible topic's subtree if FLAG non-nil, else reveal it."
3794
3795See `allout-flag-region' for more details."
3796 3719
3797 (save-excursion 3720 (save-excursion
3798 (allout-back-to-current-heading) 3721 (allout-back-to-current-heading)
3799 (let ((from (point)) 3722 (end-of-line)
3800 (to (progn (allout-end-of-current-subtree) (1- (point))))) 3723 (allout-flag-region (point)
3801 (allout-flag-region from to flag)))) 3724 ;; Exposing must not leave trailing blanks hidden,
3725 ;; but can leave them exposed when hiding, so we
3726 ;; can use flag's inverse as the
3727 ;; include-trailing-blank cue:
3728 (allout-end-of-current-subtree (not flag))
3729 flag)))
3802 3730
3803;;;_ - Topic-specific 3731;;;_ - Topic-specific
3804;;;_ > allout-show-entry () 3732;;;_ > allout-show-entry (&optional inclusive)
3805(defun allout-show-entry () 3733(defun allout-show-entry (&optional inclusive)
3806 "Like `allout-show-current-entry', reveals entries nested in hidden topics. 3734 "Like `allout-show-current-entry', reveals entries nested in hidden topics.
3807 3735
3808This is a way to give restricted peek at a concealed locality without the 3736This is a way to give restricted peek at a concealed locality without the
3809expense of exposing its context, but can leave the outline with aberrant 3737expense of exposing its context, but can leave the outline with aberrant
3810exposure. `allout-hide-current-entry-completely' or `allout-show-offshoot' 3738exposure. `allout-show-offshoot' should be used after the peek to rectify
3811should be used after the peek to rectify the exposure." 3739the exposure."
3812 3740
3813 (interactive) 3741 (interactive)
3814 (save-excursion 3742 (save-excursion
3815 (let ((at (point)) 3743 (let (beg end)
3816 beg end)
3817 (allout-goto-prefix) 3744 (allout-goto-prefix)
3818 (setq beg (if (= (preceding-char) ?\r) (1- (point)) (point))) 3745 (setq beg (if (allout-hidden-p) (1- (point)) (point)))
3819 (re-search-forward "[\n\r]" nil t) 3746 (setq end (allout-pre-next-prefix))
3820 (setq end (1- (if (< at (point)) 3747 (allout-flag-region beg end nil)
3821 ;; We're on topic head line - show only it:
3822 (point)
3823 ;; or we're in body - include it:
3824 (max beg (or (allout-pre-next-preface) (point))))))
3825 (allout-flag-region beg end ?\n)
3826 (list beg end)))) 3748 (list beg end))))
3827;;;_ > allout-show-children (&optional level strict) 3749;;;_ > allout-show-children (&optional level strict)
3828(defun allout-show-children (&optional level strict) 3750(defun allout-show-children (&optional level strict)
@@ -3843,67 +3765,59 @@ Returns point at end of subtree that was opened, if any. (May get a
3843point of non-opened subtree?)" 3765point of non-opened subtree?)"
3844 3766
3845 (interactive "p") 3767 (interactive "p")
3846 (let (max-pos) 3768 (let ((start-point (point)))
3847 (if (and (not strict) 3769 (if (and (not strict)
3848 (allout-hidden-p)) 3770 (allout-hidden-p))
3849 3771
3850 (progn (allout-show-to-offshoot) ; Point's concealed, open to 3772 (progn (allout-show-to-offshoot) ; Point's concealed, open to
3851 ; expose it. 3773 ; expose it.
3852 ;; Then recurse, but with "strict" set so we don't 3774 ;; Then recurse, but with "strict" set so we don't
3853 ;; infinite regress: 3775 ;; infinite regress:
3854 (setq max-pos (allout-show-children level t))) 3776 (allout-show-children level t))
3855 3777
3856 (save-excursion 3778 (save-excursion
3857 (save-restriction 3779 (allout-beginning-of-current-line)
3858 (let* ((start-pt (point)) 3780 (save-restriction
3859 (chart (allout-chart-subtree (or level 1))) 3781 (let* ((chart (allout-chart-subtree (or level 1)))
3860 (to-reveal (allout-chart-to-reveal chart (or level 1)))) 3782 (to-reveal (allout-chart-to-reveal chart (or level 1))))
3861 (goto-char start-pt) 3783 (goto-char start-point)
3862 (if (and strict (= (preceding-char) ?\r)) 3784 (when (and strict (allout-hidden-p))
3863 ;; Concealed root would already have been taken care of, 3785 ;; Concealed root would already have been taken care of,
3864 ;; unless strict was set. 3786 ;; unless strict was set.
3865 (progn 3787 (allout-flag-region (point) (allout-snug-back) nil)
3866 (allout-flag-region (point) (allout-snug-back) ?\n) 3788 (when allout-show-bodies
3867 (if allout-show-bodies 3789 (goto-char (car to-reveal))
3868 (progn (goto-char (car to-reveal)) 3790 (allout-show-current-entry)))
3869 (allout-show-current-entry))))) 3791 (while to-reveal
3870 (while to-reveal 3792 (goto-char (car to-reveal))
3871 (goto-char (car to-reveal)) 3793 (allout-flag-region (save-excursion (allout-snug-back) (point))
3872 (allout-flag-region (point) (allout-snug-back) ?\n) 3794 (progn (search-forward "\n" nil t)
3873 (if allout-show-bodies 3795 (1- (point)))
3874 (progn (goto-char (car to-reveal)) 3796 nil)
3875 (allout-show-current-entry))) 3797 (when allout-show-bodies
3876 (setq to-reveal (cdr to-reveal))))))))) 3798 (goto-char (car to-reveal))
3877;;;_ > allout-hide-point-reconcile () 3799 (allout-show-current-entry))
3878(defun allout-hide-reconcile () 3800 (setq to-reveal (cdr to-reveal)))))))
3879 "Like `allout-hide-current-entry'; hides completely if within hidden region. 3801 ;; Compensate for `save-excursion's maintenance of point
3880 3802 ;; within invisible text:
3881Specifically intended for aberrant exposure states, like entries that were 3803 (goto-char start-point)))
3882exposed by `allout-show-entry' but are within otherwise concealed regions."
3883 (interactive)
3884 (save-excursion
3885 (allout-goto-prefix)
3886 (allout-flag-region (if (not (bobp)) (1- (point)) (point))
3887 (progn (allout-pre-next-preface)
3888 (if (= ?\r (following-char))
3889 (point)
3890 (1- (point))))
3891 ?\r)))
3892;;;_ > allout-show-to-offshoot () 3804;;;_ > allout-show-to-offshoot ()
3893(defun allout-show-to-offshoot () 3805(defun allout-show-to-offshoot ()
3894 "Like `allout-show-entry', but reveals all concealed ancestors, as well. 3806 "Like `allout-show-entry', but reveals all concealed ancestors, as well.
3895 3807
3896As with `allout-hide-current-entry-completely', useful for rectifying 3808Useful for coherently exposing to a random point in a hidden region."
3897aberrant exposure states produced by `allout-show-entry'."
3898
3899 (interactive) 3809 (interactive)
3900 (save-excursion 3810 (save-excursion
3901 (let ((orig-pt (point)) 3811 (let ((orig-pt (point))
3902 (orig-pref (allout-goto-prefix)) 3812 (orig-pref (allout-goto-prefix))
3903 (last-at (point)) 3813 (last-at (point))
3904 bag-it) 3814 bag-it)
3905 (while (or bag-it (= (preceding-char) ?\r)) 3815 (while (or bag-it (allout-hidden-p))
3906 (beginning-of-line) 3816 (while (allout-hidden-p)
3817 ;; XXX We would use `(move-beginning-of-line 1)', but it gets
3818 ;; stuck on hidden newlines at column 80, as of GNU Emacs 22.0.50.
3819 (beginning-of-line)
3820 (if (allout-hidden-p) (forward-char -1)))
3907 (if (= last-at (setq last-at (point))) 3821 (if (= last-at (setq last-at (point)))
3908 ;; Oops, we're not making any progress! Show the current 3822 ;; Oops, we're not making any progress! Show the current
3909 ;; topic completely, and bag this try. 3823 ;; topic completely, and bag this try.
@@ -3926,38 +3840,24 @@ aberrant exposure states produced by `allout-show-entry'."
3926 (interactive) 3840 (interactive)
3927 (allout-back-to-current-heading) 3841 (allout-back-to-current-heading)
3928 (save-excursion 3842 (save-excursion
3929 (allout-flag-region (point) 3843 (end-of-line)
3844 (allout-flag-region (point)
3930 (progn (allout-end-of-entry) (point)) 3845 (progn (allout-end-of-entry) (point))
3931 ?\r))) 3846 t)))
3932;;;_ > allout-show-current-entry (&optional arg) 3847;;;_ > allout-show-current-entry (&optional arg)
3933(defun allout-show-current-entry (&optional arg) 3848(defun allout-show-current-entry (&optional arg)
3934 3849
3935 "Show body following current heading, or hide the entry if repeat count." 3850 "Show body following current heading, or hide entry with universal argument."
3936 3851
3937 (interactive "P") 3852 (interactive "P")
3938 (if arg 3853 (if arg
3939 (allout-hide-current-entry) 3854 (allout-hide-current-entry)
3855 (save-excursion (allout-show-to-offshoot))
3940 (save-excursion 3856 (save-excursion
3941 (allout-flag-region (point) 3857 (allout-flag-region (point)
3942 (progn (allout-end-of-entry) (point)) 3858 (progn (allout-end-of-entry t) (point))
3943 ?\n) 3859 nil)
3944 ))) 3860 )))
3945;;;_ > allout-hide-current-entry-completely ()
3946; ... allout-hide-current-entry-completely also for isearch dynamic exposure:
3947(defun allout-hide-current-entry-completely ()
3948 "Like `allout-hide-current-entry', but conceal topic completely.
3949
3950Specifically intended for aberrant exposure states, like entries that were
3951exposed by `allout-show-entry' but are within otherwise concealed regions."
3952 (interactive)
3953 (save-excursion
3954 (allout-goto-prefix)
3955 (allout-flag-region (if (not (bobp)) (1- (point)) (point))
3956 (progn (allout-pre-next-preface)
3957 (if (= ?\r (following-char))
3958 (point)
3959 (1- (point))))
3960 ?\r)))
3961;;;_ > allout-show-current-subtree (&optional arg) 3861;;;_ > allout-show-current-subtree (&optional arg)
3962(defun allout-show-current-subtree (&optional arg) 3862(defun allout-show-current-subtree (&optional arg)
3963 "Show everything within the current topic. With a repeat-count, 3863 "Show everything within the current topic. With a repeat-count,
@@ -3970,11 +3870,27 @@ expose this topic and its siblings."
3970 (error "No topics") 3870 (error "No topics")
3971 ;; got to first, outermost topic - set to expose it and siblings: 3871 ;; got to first, outermost topic - set to expose it and siblings:
3972 (message "Above outermost topic - exposing all.") 3872 (message "Above outermost topic - exposing all.")
3973 (allout-flag-region (point-min)(point-max) ?\n)) 3873 (allout-flag-region (point-min)(point-max) nil))
3874 (allout-beginning-of-current-line)
3974 (if (not arg) 3875 (if (not arg)
3975 (allout-flag-current-subtree ?\n) 3876 (allout-flag-current-subtree nil)
3976 (allout-beginning-of-level) 3877 (allout-beginning-of-level)
3977 (allout-expose-topic '(* :)))))) 3878 (allout-expose-topic '(* :))))))
3879;;;_ > allout-current-topic-collapsed-p (&optional include-single-liners)
3880(defun allout-current-topic-collapsed-p (&optional include-single-liners)
3881 "True if the currently visible containing topic is already collapsed.
3882
3883If optional INCLUDE-SINGLE-LINERS is true, then include single-line
3884topics \(which intrinsically can be considered both collapsed and
3885not\), as collapsed. Otherwise they are considered uncollapsed."
3886 (save-excursion
3887 (and
3888 (= (progn (allout-back-to-current-heading)
3889 (move-end-of-line 1)
3890 (point))
3891 (allout-end-of-current-subtree))
3892 (or include-single-liners
3893 (progn (backward-char 1) (allout-hidden-p))))))
3978;;;_ > allout-hide-current-subtree (&optional just-close) 3894;;;_ > allout-hide-current-subtree (&optional just-close)
3979(defun allout-hide-current-subtree (&optional just-close) 3895(defun allout-hide-current-subtree (&optional just-close)
3980 "Close the current topic, or containing topic if this one is already closed. 3896 "Close the current topic, or containing topic if this one is already closed.
@@ -3982,35 +3898,21 @@ expose this topic and its siblings."
3982If this topic is closed and it's a top level topic, close this topic 3898If this topic is closed and it's a top level topic, close this topic
3983and its siblings. 3899and its siblings.
3984 3900
3985If optional arg JUST-CLOSE is non-nil, do not treat the parent or 3901If optional arg JUST-CLOSE is non-nil, do not close the parent or
3986siblings, even if the target topic is already closed." 3902siblings, even if the target topic is already closed."
3987 3903
3988 (interactive) 3904 (interactive)
3989 (let ((from (point)) 3905 (let* ((from (point))
3990 (orig-eol (progn (end-of-line) 3906 (sibs-msg "Top-level topic already closed - closing siblings...")
3991 (if (not (allout-goto-prefix)) 3907 (current-exposed (not (allout-current-topic-collapsed-p t))))
3992 (error "No topics found") 3908 (cond (current-exposed (allout-flag-current-subtree t))
3993 (end-of-line)(point))))) 3909 (just-close nil)
3994 (allout-flag-current-subtree ?\r) 3910 ((allout-up-current-level 1 t) (allout-hide-current-subtree))
3995 (goto-char from) 3911 (t (goto-char 0)
3996 (if (and (= orig-eol (progn (goto-char orig-eol) 3912 (message sibs-msg)
3997 (end-of-line) 3913 (allout-expose-topic '(0 :))
3998 (point))) 3914 (message (concat sibs-msg " Done."))))
3999 (not just-close) 3915 (goto-char from)))
4000 ;; Structure didn't change - try hiding current level:
4001 (goto-char from)
4002 (if (allout-up-current-level 1 t)
4003 t
4004 (goto-char 0)
4005 (let ((msg
4006 "Top-level topic already closed - closing siblings..."))
4007 (message msg)
4008 (allout-expose-topic '(0 :))
4009 (message (concat msg " Done.")))
4010 nil)
4011 (/= (allout-recent-depth) 0))
4012 (allout-hide-current-subtree))
4013 (goto-char from)))
4014;;;_ > allout-show-current-branches () 3916;;;_ > allout-show-current-branches ()
4015(defun allout-show-current-branches () 3917(defun allout-show-current-branches ()
4016 "Show all subheadings of this heading, but not their bodies." 3918 "Show all subheadings of this heading, but not their bodies."
@@ -4031,7 +3933,7 @@ siblings, even if the target topic is already closed."
4031 "Show all of the text in the buffer." 3933 "Show all of the text in the buffer."
4032 (interactive) 3934 (interactive)
4033 (message "Exposing entire buffer...") 3935 (message "Exposing entire buffer...")
4034 (allout-flag-region (point-min) (point-max) ?\n) 3936 (allout-flag-region (point-min) (point-max) nil)
4035 (message "Exposing entire buffer... Done.")) 3937 (message "Exposing entire buffer... Done."))
4036;;;_ > allout-hide-bodies () 3938;;;_ > allout-hide-bodies ()
4037(defun allout-hide-bodies () 3939(defun allout-hide-bodies ()
@@ -4046,11 +3948,11 @@ siblings, even if the target topic is already closed."
4046 (narrow-to-region start end) 3948 (narrow-to-region start end)
4047 (goto-char (point-min)) 3949 (goto-char (point-min))
4048 (while (not (eobp)) 3950 (while (not (eobp))
4049 (allout-flag-region (point) 3951 (end-of-line)
4050 (progn (allout-pre-next-preface) (point)) ?\r) 3952 (allout-flag-region (point) (allout-end-of-entry) t)
4051 (if (not (eobp)) 3953 (if (not (eobp))
4052 (forward-char 3954 (forward-char
4053 (if (looking-at "[\n\r][\n\r]") 3955 (if (looking-at "\n\n")
4054 2 1))))))) 3956 2 1)))))))
4055 3957
4056;;;_ > allout-expose-topic (spec) 3958;;;_ > allout-expose-topic (spec)
@@ -4117,9 +4019,7 @@ Examples:
4117 (let ((depth (allout-depth)) 4019 (let ((depth (allout-depth))
4118 (max-pos 0) 4020 (max-pos 0)
4119 prev-elem curr-elem 4021 prev-elem curr-elem
4120 stay done 4022 stay)
4121 snug-back
4122 )
4123 (while spec 4023 (while spec
4124 (setq prev-elem curr-elem 4024 (setq prev-elem curr-elem
4125 curr-elem (car spec) 4025 curr-elem (car spec)
@@ -4147,7 +4047,7 @@ Examples:
4147 (setq spec (append (make-list residue prev-elem) 4047 (setq spec (append (make-list residue prev-elem)
4148 spec))))))) 4048 spec)))))))
4149 ((numberp curr-elem) 4049 ((numberp curr-elem)
4150 (if (and (>= 0 curr-elem) (allout-visible-p)) 4050 (if (and (>= 0 curr-elem) (not (allout-hidden-p)))
4151 (save-excursion (allout-hide-current-subtree t) 4051 (save-excursion (allout-hide-current-subtree t)
4152 (if (> 0 curr-elem) 4052 (if (> 0 curr-elem)
4153 nil 4053 nil
@@ -4207,7 +4107,6 @@ Optional FOLLOWERS arguments dictate exposure for succeeding siblings."
4207 4107
4208 (interactive "xExposure spec: ") 4108 (interactive "xExposure spec: ")
4209 (let ((depth (allout-current-depth)) 4109 (let ((depth (allout-current-depth))
4210 done
4211 max-pos) 4110 max-pos)
4212 (cond ((null spec) nil) 4111 (cond ((null spec) nil)
4213 ((symbolp spec) 4112 ((symbolp spec)
@@ -4387,7 +4286,7 @@ header and body. The elements of that list are:
4387 (save-excursion 4286 (save-excursion
4388 (let* 4287 (let*
4389 ;; state vars: 4288 ;; state vars:
4390 (strings prefix pad result depth new-depth out gone-out bullet beg 4289 (strings prefix result depth new-depth out gone-out bullet beg
4391 next done) 4290 next done)
4392 4291
4393 (goto-char start) 4292 (goto-char start)
@@ -4419,16 +4318,11 @@ header and body. The elements of that list are:
4419 beg 4318 beg
4420 ;To hidden text or end of line: 4319 ;To hidden text or end of line:
4421 (progn 4320 (progn
4422 (search-forward "\r" 4321 (end-of-line)
4423 (save-excursion (end-of-line) 4322 (allout-back-to-visible-text)))
4424 (point))
4425 1)
4426 (if (= (preceding-char) ?\r)
4427 (1- (point))
4428 (point))))
4429 strings)) 4323 strings))
4430 (if (< (point) next) ; Resume from after hid text, if any. 4324 (when (< (point) next) ; Resume from after hid text, if any.
4431 (forward-line 1)) 4325 (line-move 1))
4432 (setq beg (point))) 4326 (setq beg (point)))
4433 ;; Accumulate list for this topic: 4327 ;; Accumulate list for this topic:
4434 (setq strings (nreverse strings)) 4328 (setq strings (nreverse strings))
@@ -4488,7 +4382,7 @@ header and body. The elements of that list are:
4488;;;_ > allout-process-exposed (&optional func from to frombuf 4382;;;_ > allout-process-exposed (&optional func from to frombuf
4489;;; tobuf format) 4383;;; tobuf format)
4490(defun allout-process-exposed (&optional func from to frombuf tobuf 4384(defun allout-process-exposed (&optional func from to frombuf tobuf
4491 format &optional start-num) 4385 format start-num)
4492 "Map function on exposed parts of current topic; results to another buffer. 4386 "Map function on exposed parts of current topic; results to another buffer.
4493 4387
4494All args are options; default values itemized below. 4388All args are options; default values itemized below.
@@ -4694,13 +4588,6 @@ environment. Leaves point at the end of the line."
4694 (page-numbering (if allout-number-pages 4588 (page-numbering (if allout-number-pages
4695 "\\pagestyle{empty}\n" 4589 "\\pagestyle{empty}\n"
4696 "")) 4590 ""))
4697 (linesdef (concat "\\def\\beginlines{"
4698 "\\par\\begingroup\\nobreak\\medskip"
4699 "\\parindent=0pt\n"
4700 " \\kern1pt\\nobreak \\obeylines \\obeyspaces "
4701 "\\everypar{\\strut}}\n"
4702 "\\def\\endlines{"
4703 "\\kern1pt\\endgroup\\medbreak\\noindent}\n"))
4704 (titlecmd (format "\\newcommand{\\titlecmd}[1]{{%s #1}}\n" 4591 (titlecmd (format "\\newcommand{\\titlecmd}[1]{{%s #1}}\n"
4705 allout-title-style)) 4592 allout-title-style))
4706 (labelcmd (format "\\newcommand{\\labelcmd}[1]{{%s #1}}\n" 4593 (labelcmd (format "\\newcommand{\\labelcmd}[1]{{%s #1}}\n"
@@ -4733,7 +4620,7 @@ environment. Leaves point at the end of the line."
4733 (title (format "%s%s%s%s" 4620 (title (format "%s%s%s%s"
4734 "\\titlecmd{" 4621 "\\titlecmd{"
4735 (allout-latex-verb-quote (if allout-title 4622 (allout-latex-verb-quote (if allout-title
4736 (condition-case err 4623 (condition-case nil
4737 (eval allout-title) 4624 (eval allout-title)
4738 ('error "<unnamed buffer>")) 4625 ('error "<unnamed buffer>"))
4739 "Unnamed Outline")) 4626 "Unnamed Outline"))
@@ -4913,7 +4800,7 @@ solicited whenever the passphrase is changed."
4913 (interactive "P") 4800 (interactive "P")
4914 (save-excursion 4801 (save-excursion
4915 (allout-back-to-current-heading) 4802 (allout-back-to-current-heading)
4916 (allout-toggle-subtree-encryption) 4803 (allout-toggle-subtree-encryption fetch-pass)
4917 ) 4804 )
4918 ) 4805 )
4919;;;_ > allout-toggle-subtree-encryption (&optional fetch-pass) 4806;;;_ > allout-toggle-subtree-encryption (&optional fetch-pass)
@@ -4948,20 +4835,23 @@ See `allout-toggle-current-subtree-encryption' for more details."
4948 (progn (if (= (point-max) after-bullet-pos) 4835 (progn (if (= (point-max) after-bullet-pos)
4949 (error "no body to encrypt")) 4836 (error "no body to encrypt"))
4950 (allout-encrypted-topic-p))) 4837 (allout-encrypted-topic-p)))
4951 (was-collapsed (if (not (re-search-forward "[\n\r]" nil t)) 4838 (was-collapsed (if (not (search-forward "\n" nil t))
4952 nil 4839 nil
4953 (backward-char 1) 4840 (backward-char 1)
4954 (looking-at "\r"))) 4841 (allout-hidden-p)))
4955 (subtree-beg (1+ (point))) 4842 (subtree-beg (1+ (point)))
4956 (subtree-end (allout-end-of-subtree)) 4843 (subtree-end (allout-end-of-subtree))
4957 (subject-text (buffer-substring-no-properties subtree-beg 4844 (subject-text (buffer-substring-no-properties subtree-beg
4958 subtree-end)) 4845 subtree-end))
4959 (subtree-end-char (char-after (1- subtree-end))) 4846 (subtree-end-char (char-after (1- subtree-end)))
4960 (subtree-trailling-char (char-after subtree-end)) 4847 (subtree-trailing-char (char-after subtree-end))
4961 (place-holder (if (or (string= "" subject-text) 4848 ;; kluge - result-text needs to be nil, but we also want to
4962 (string= "\n" subject-text)) 4849 ;; check for the error condition
4963 (error "No topic contents to %scrypt" 4850 (result-text (if (or (string= "" subject-text)
4964 (if was-encrypted "de" "en")))) 4851 (string= "\n" subject-text))
4852 (error "No topic contents to %scrypt"
4853 (if was-encrypted "de" "en"))
4854 nil))
4965 ;; Assess key parameters: 4855 ;; Assess key parameters:
4966 (key-info (or 4856 (key-info (or
4967 ;; detect the type by which it is already encrypted 4857 ;; detect the type by which it is already encrypted
@@ -4972,8 +4862,7 @@ See `allout-toggle-current-subtree-encryption' for more details."
4972 '(symmetric nil))) 4862 '(symmetric nil)))
4973 (for-key-type (car key-info)) 4863 (for-key-type (car key-info))
4974 (for-key-identity (cadr key-info)) 4864 (for-key-identity (cadr key-info))
4975 (fetch-pass (and fetch-pass (member fetch-pass '(16 (16))))) 4865 (fetch-pass (and fetch-pass (member fetch-pass '(16 (16))))))
4976 result-text)
4977 4866
4978 (setq result-text 4867 (setq result-text
4979 (allout-encrypt-string subject-text was-encrypted 4868 (allout-encrypt-string subject-text was-encrypted
@@ -4987,12 +4876,12 @@ See `allout-toggle-current-subtree-encryption' for more details."
4987 (delete-region subtree-beg subtree-end) 4876 (delete-region subtree-beg subtree-end)
4988 (insert result-text) 4877 (insert result-text)
4989 (if was-collapsed 4878 (if was-collapsed
4990 (allout-flag-region subtree-beg (1- (point)) ?\r)) 4879 (allout-flag-region (1- subtree-beg) (point) t))
4991 ;; adjust trailling-blank-lines to preserve topic spacing: 4880 ;; adjust trailing-blank-lines to preserve topic spacing:
4992 (if (not was-encrypted) 4881 (if (not was-encrypted)
4993 (if (and (member subtree-end-char '(?\r ?\n)) 4882 (if (and (= subtree-end-char ?\n)
4994 (member subtree-trailling-char '(?\r ?\n))) 4883 (= subtree-trailing-char ?\n))
4995 (insert subtree-trailling-char))) 4884 (insert subtree-trailing-char)))
4996 ;; Ensure that the item has an encrypted-entry bullet: 4885 ;; Ensure that the item has an encrypted-entry bullet:
4997 (if (not (string= (buffer-substring-no-properties 4886 (if (not (string= (buffer-substring-no-properties
4998 (1- after-bullet-pos) after-bullet-pos) 4887 (1- after-bullet-pos) after-bullet-pos)
@@ -5060,8 +4949,7 @@ Returns the resulting string, or nil if the transformation fails."
5060 target-prompt-id 4949 target-prompt-id
5061 (or (buffer-file-name allout-buffer) 4950 (or (buffer-file-name allout-buffer)
5062 target-prompt-id)))) 4951 target-prompt-id))))
5063 (comment "Processed by allout driving pgg") 4952 result-text status)
5064 work-buffer result result-text status)
5065 4953
5066 (if (and fetch-pass (not passphrase)) 4954 (if (and fetch-pass (not passphrase))
5067 ;; Force later fetch by evicting passphrase from the cache. 4955 ;; Force later fetch by evicting passphrase from the cache.
@@ -5083,7 +4971,7 @@ Returns the resulting string, or nil if the transformation fails."
5083 retried fetch-pass))) 4971 retried fetch-pass)))
5084 (with-temp-buffer 4972 (with-temp-buffer
5085 4973
5086 (insert (subst-char-in-string ?\r ?\n text)) 4974 (insert text)
5087 4975
5088 (cond 4976 (cond
5089 4977
@@ -5319,7 +5207,7 @@ An error is raised if the text is not encrypted."
5319 (require 'pgg-parse) 5207 (require 'pgg-parse)
5320 (save-excursion 5208 (save-excursion
5321 (with-temp-buffer 5209 (with-temp-buffer
5322 (insert (subst-char-in-string ?\r ?\n text)) 5210 (insert text)
5323 (let* ((parsed-armor (pgg-parse-armor-region (point-min) (point-max))) 5211 (let* ((parsed-armor (pgg-parse-armor-region (point-min) (point-max)))
5324 (type (if (pgg-gpg-symmetric-key-p parsed-armor) 5212 (type (if (pgg-gpg-symmetric-key-p parsed-armor)
5325 'symmetric 5213 'symmetric
@@ -5442,21 +5330,21 @@ must also have content."
5442 (while (not done) 5330 (while (not done)
5443 5331
5444 (if (not (re-search-forward 5332 (if (not (re-search-forward
5445 (format "\\(\\`\\|[\n\r]\\)%s *%s[^*]" 5333 (format "\\(\\`\\|\n\\)%s *%s[^*]"
5446 (regexp-quote allout-header-prefix) 5334 (regexp-quote allout-header-prefix)
5447 (regexp-quote allout-topic-encryption-bullet)) 5335 (regexp-quote allout-topic-encryption-bullet))
5448 nil t)) 5336 nil t))
5449 (setq got nil 5337 (setq got nil
5450 done t) 5338 done t)
5451 (goto-char (setq got (match-beginning 0))) 5339 (goto-char (setq got (match-beginning 0)))
5452 (if (looking-at "[\n\r]") 5340 (if (looking-at "\n")
5453 (forward-char 1)) 5341 (forward-char 1))
5454 (setq got (point))) 5342 (setq got (point)))
5455 5343
5456 (cond ((not got) 5344 (cond ((not got)
5457 (setq done t)) 5345 (setq done t))
5458 5346
5459 ((not (re-search-forward "[\n\r]")) 5347 ((not (search-forward "\n"))
5460 (setq got nil 5348 (setq got nil
5461 done t)) 5349 done t))
5462 5350
@@ -5498,26 +5386,28 @@ save. See `allout-encrypt-unencrypted-on-saves' for more info."
5498 5386
5499 (interactive "p") 5387 (interactive "p")
5500 (save-excursion 5388 (save-excursion
5501 (let ((current-mark (point-marker)) 5389 (let* ((current-mark (point-marker))
5502 was-modified 5390 (current-mark-position (marker-position current-mark))
5503 bo-subtree 5391 was-modified
5504 editing-topic editing-point) 5392 bo-subtree
5393 editing-topic editing-point)
5505 (goto-char (point-min)) 5394 (goto-char (point-min))
5506 (while (allout-next-topic-pending-encryption except-mark) 5395 (while (allout-next-topic-pending-encryption except-mark)
5507 (setq was-modified (buffer-modified-p)) 5396 (setq was-modified (buffer-modified-p))
5508 (if (save-excursion 5397 (when (save-excursion
5509 (and (boundp 'allout-encrypt-unencrypted-on-saves) 5398 (and (boundp 'allout-encrypt-unencrypted-on-saves)
5510 allout-encrypt-unencrypted-on-saves 5399 allout-encrypt-unencrypted-on-saves
5511 (setq bo-subtree (re-search-forward "[\n\r]")) 5400 (setq bo-subtree (re-search-forward "$"))
5512 ;; Not collapsed: 5401 (not (allout-hidden-p))
5513 (string= (match-string 0) "\n") 5402 (>= current-mark (point))
5514 (>= current-mark (point)) 5403 (allout-end-of-current-subtree)
5515 (allout-end-of-current-subtree) 5404 (<= current-mark (point))))
5516 (<= current-mark (point))))
5517 (setq editing-topic (point) 5405 (setq editing-topic (point)
5518 ;; we had to wait for this 'til now so prior topics are 5406 ;; we had to wait for this 'til now so prior topics are
5519 ;; encrypted, any relevant text shifts are in place: 5407 ;; encrypted, any relevant text shifts are in place:
5520 editing-point (marker-position current-mark))) 5408 editing-point (- current-mark-position
5409 (count-trailing-whitespace-region
5410 bo-subtree current-mark-position))))
5521 (allout-toggle-subtree-encryption) 5411 (allout-toggle-subtree-encryption)
5522 (if (not was-modified) 5412 (if (not was-modified)
5523 (set-buffer-modified-p nil)) 5413 (set-buffer-modified-p nil))
@@ -5579,11 +5469,11 @@ Returns list `(beginning-point prefix-string suffix-string)'."
5579 (setq beg (- (point) 16)) 5469 (setq beg (- (point) 16))
5580 (setq suffix (buffer-substring-no-properties 5470 (setq suffix (buffer-substring-no-properties
5581 (point) 5471 (point)
5582 (progn (if (re-search-forward "[\n\r]" nil t) 5472 (progn (if (search-forward "\n" nil t)
5583 (forward-char -1)) 5473 (forward-char -1))
5584 (point)))) 5474 (point))))
5585 (setq prefix (buffer-substring-no-properties 5475 (setq prefix (buffer-substring-no-properties
5586 (progn (if (re-search-backward "[\n\r]" nil t) 5476 (progn (if (search-backward "\n" nil t)
5587 (forward-char 1)) 5477 (forward-char 1))
5588 (point)) 5478 (point))
5589 beg)) 5479 beg))
@@ -5639,7 +5529,7 @@ enable-local-variables must be true for any of this to happen."
5639 (allout-show-to-offshoot) 5529 (allout-show-to-offshoot)
5640 (if (search-forward (concat "\n" prefix varname ":") nil t) 5530 (if (search-forward (concat "\n" prefix varname ":") nil t)
5641 (let* ((value-beg (point)) 5531 (let* ((value-beg (point))
5642 (line-end (progn (if (re-search-forward "[\n\r]" nil t) 5532 (line-end (progn (if (search-forward "\n" nil t)
5643 (forward-char -1)) 5533 (forward-char -1))
5644 (point))) 5534 (point)))
5645 (value-end (- line-end (length suffix)))) 5535 (value-end (- line-end (length suffix))))
@@ -5710,26 +5600,29 @@ Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion."
5710 (regexp-sans-escapes (substring regexp 1))) 5600 (regexp-sans-escapes (substring regexp 1)))
5711 ;; Exclude first char, but maintain count: 5601 ;; Exclude first char, but maintain count:
5712 (regexp-sans-escapes (substring regexp 1) successive-backslashes)))) 5602 (regexp-sans-escapes (substring regexp 1) successive-backslashes))))
5713;;;_ - add-hook definition for divergent emacsen 5603;;;_ > count-trailing-whitespace-region (beg end)
5714;;;_ > add-hook (hook function &optional append) 5604(defun count-trailing-whitespace-region (beg end)
5715(if (not (fboundp 'add-hook)) 5605 "Return number of trailing whitespace chars between BEG and END.
5716 (defun add-hook (hook function &optional append) 5606
5717 "Add to the value of HOOK the function FUNCTION unless already present. 5607If BEG is bigger than END we return 0."
5718\(It becomes the first hook on the list unless optional APPEND is non-nil, in 5608 (if (> beg end)
5719which case it becomes the last). HOOK should be a symbol, and FUNCTION may be 5609 0
5720any valid function. HOOK's value should be a list of functions, not a single 5610 (save-excursion
5721function. If HOOK is void, it is first set to nil." 5611 (goto-char beg)
5722 (or (boundp hook) (set hook nil)) 5612 (let ((count 0))
5723 (or (if (consp function) 5613 (while (re-search-forward "[ ][ ]*$" end t)
5724 ;; Clever way to tell whether a given lambda-expression 5614 (goto-char (1+ (match-beginning 0)))
5725 ;; is equal to anything in the hook. 5615 (setq count (1+ count)))
5726 (let ((tail (assoc (cdr function) (symbol-value hook)))) 5616 count))))
5727 (equal function tail)) 5617;;;_ > allout-mark-marker to accommodate divergent emacsen:
5728 (memq function (symbol-value hook))) 5618(defun allout-mark-marker (&optional force buffer)
5729 (set hook 5619 "Accommodate the different signature for `mark-marker' across Emacsen.
5730 (if append 5620
5731 (nconc (symbol-value hook) (list function)) 5621XEmacs takes two optional args, while mainline GNU Emacs does not,
5732 (cons function (symbol-value hook))))))) 5622so pass them along when appropriate."
5623 (if (featurep 'xemacs)
5624 (apply 'mark-marker force buffer)
5625 (mark-marker)))
5733;;;_ > subst-char-in-string if necessary 5626;;;_ > subst-char-in-string if necessary
5734(if (not (fboundp 'subst-char-in-string)) 5627(if (not (fboundp 'subst-char-in-string))
5735 (defun subst-char-in-string (fromchar tochar string &optional inplace) 5628 (defun subst-char-in-string (fromchar tochar string &optional inplace)
@@ -5742,17 +5635,159 @@ Unless optional argument INPLACE is non-nil, return a new string."
5742 (if (eq (aref newstr i) fromchar) 5635 (if (eq (aref newstr i) fromchar)
5743 (aset newstr i tochar))) 5636 (aset newstr i tochar)))
5744 newstr))) 5637 newstr)))
5745;;;_ : my-mark-marker to accommodate divergent emacsen: 5638;;;_ > wholenump if necessary
5746(defun my-mark-marker (&optional force buffer) 5639(if (not (fboundp 'wholenump))
5747 "Accommodate the different signature for `mark-marker' across Emacsen. 5640 (defalias 'wholenump 'natnump))
5748 5641;;;_ > remove-overlays if necessary
5749XEmacs takes two optional args, while mainline GNU Emacs does not, 5642(if (not (fboundp 'remove-overlays))
5750so pass them along when appropriate." 5643 (defun remove-overlays (&optional beg end name val)
5751 (if (featurep 'xemacs) 5644 "Clear BEG and END of overlays whose property NAME has value VAL.
5752 (apply 'mark-marker force buffer) 5645Overlays might be moved and/or split.
5753 (mark-marker))) 5646BEG and END default respectively to the beginning and end of buffer."
5754 5647 (unless beg (setq beg (point-min)))
5755;;;_ #10 Under development 5648 (unless end (setq end (point-max)))
5649 (if (< end beg)
5650 (setq beg (prog1 end (setq end beg))))
5651 (save-excursion
5652 (dolist (o (overlays-in beg end))
5653 (when (eq (overlay-get o name) val)
5654 ;; Either push this overlay outside beg...end
5655 ;; or split it to exclude beg...end
5656 ;; or delete it entirely (if it is contained in beg...end).
5657 (if (< (overlay-start o) beg)
5658 (if (> (overlay-end o) end)
5659 (progn
5660 (move-overlay (copy-overlay o)
5661 (overlay-start o) beg)
5662 (move-overlay o end (overlay-end o)))
5663 (move-overlay o (overlay-start o) beg))
5664 (if (> (overlay-end o) end)
5665 (move-overlay o end (overlay-end o))
5666 (delete-overlay o)))))))
5667 )
5668;;;_ > copy-overlay if necessary - xemacs ~ 21.4
5669(if (not (fboundp 'copy-overlay))
5670 (defun copy-overlay (o)
5671 "Return a copy of overlay O."
5672 (let ((o1 (make-overlay (overlay-start o) (overlay-end o)
5673 ;; FIXME: there's no easy way to find the
5674 ;; insertion-type of the two markers.
5675 (overlay-buffer o)))
5676 (props (overlay-properties o)))
5677 (while props
5678 (overlay-put o1 (pop props) (pop props)))
5679 o1)))
5680;;;_ > add-to-invisibility-spec if necessary - xemacs ~ 21.4
5681(if (not (fboundp 'add-to-invisibility-spec))
5682 (defun add-to-invisibility-spec (element)
5683 "Add ELEMENT to `buffer-invisibility-spec'.
5684See documentation for `buffer-invisibility-spec' for the kind of elements
5685that can be added."
5686 (if (eq buffer-invisibility-spec t)
5687 (setq buffer-invisibility-spec (list t)))
5688 (setq buffer-invisibility-spec
5689 (cons element buffer-invisibility-spec))))
5690;;;_ > remove-from-invisibility-spec if necessary - xemacs ~ 21.4
5691(if (not (fboundp 'remove-from-invisibility-spec))
5692 (defun remove-from-invisibility-spec (element)
5693 "Remove ELEMENT from `buffer-invisibility-spec'."
5694 (if (consp buffer-invisibility-spec)
5695 (setq buffer-invisibility-spec (delete element
5696 buffer-invisibility-spec)))))
5697;;;_ > move-beginning-of-line if necessary - older emacs, xemacs
5698(if (not (fboundp 'move-beginning-of-line))
5699 (defun move-beginning-of-line (arg)
5700 "Move point to beginning of current line as displayed.
5701\(This disregards invisible newlines such as those
5702which are part of the text that an image rests on.)
5703
5704With argument ARG not nil or 1, move forward ARG - 1 lines first.
5705If point reaches the beginning or end of buffer, it stops there.
5706To ignore intangibility, bind `inhibit-point-motion-hooks' to t.
5707
5708This function does not move point across a field boundary unless that
5709would move point to a different line than the original, unconstrained
5710result. If N is nil or 1, and a front-sticky field starts at point,
5711the point does not move. To ignore field boundaries bind
5712`inhibit-field-text-motion' to t."
5713 (interactive "p")
5714 (or arg (setq arg 1))
5715 (if (/= arg 1)
5716 (condition-case nil (line-move (1- arg)) (error nil)))
5717
5718 (let ((orig (point)))
5719 ;; Move to beginning-of-line, ignoring fields and invisibles.
5720 (skip-chars-backward "^\n")
5721 (while (and (not (bobp)) (line-move-invisible-p (1- (point))))
5722 (goto-char (if (featurep 'xemacs)
5723 (previous-property-change (point))
5724 (previous-char-property-change (point))))
5725 (skip-chars-backward "^\n"))
5726 (vertical-motion 0)
5727 (if (/= orig (point))
5728 (goto-char (constrain-to-field (point) orig (/= arg 1) t nil)))))
5729)
5730;;;_ > move-end-of-line if necessary - older emacs, xemacs
5731(if (not (fboundp 'move-end-of-line))
5732 (defun move-end-of-line (arg)
5733 "Move point to end of current line as displayed.
5734\(This disregards invisible newlines such as those
5735which are part of the text that an image rests on.)
5736
5737With argument ARG not nil or 1, move forward ARG - 1 lines first.
5738If point reaches the beginning or end of buffer, it stops there.
5739To ignore intangibility, bind `inhibit-point-motion-hooks' to t.
5740
5741This function does not move point across a field boundary unless that
5742would move point to a different line than the original, unconstrained
5743result. If N is nil or 1, and a rear-sticky field ends at point,
5744the point does not move. To ignore field boundaries bind
5745`inhibit-field-text-motion' to t."
5746 (interactive "p")
5747 (or arg (setq arg 1))
5748 (let ((orig (point))
5749 done)
5750 (while (not done)
5751 (let ((newpos
5752 (save-excursion
5753 (let ((goal-column 0))
5754 (and (condition-case nil
5755 (or (line-move arg) t)
5756 (error nil))
5757 (not (bobp))
5758 (progn
5759 (while (and (not (bobp)) (line-move-invisible-p (1- (point))))
5760 (goto-char (previous-char-property-change (point))))
5761 (backward-char 1)))
5762 (point)))))
5763 (goto-char newpos)
5764 (if (and (> (point) newpos)
5765 (eq (preceding-char) ?\n))
5766 (backward-char 1)
5767 (if (and (> (point) newpos) (not (eobp))
5768 (not (eq (following-char) ?\n)))
5769 ;; If we skipped something intangible
5770 ;; and now we're not really at eol,
5771 ;; keep going.
5772 (setq arg 1)
5773 (setq done t)))))
5774 (if (/= orig (point))
5775 (goto-char (constrain-to-field (point) orig (/= arg 1) t
5776 nil)))))
5777 )
5778;;;_ > line-move-invisible-p if necessary
5779(if (not (fboundp 'line-move-invisible-p))
5780 (defun line-move-invisible-p (pos)
5781 "Return non-nil if the character after POS is currently invisible."
5782 (let ((prop
5783 (get-char-property pos 'invisible)))
5784 (if (eq buffer-invisibility-spec t)
5785 prop
5786 (or (memq prop buffer-invisibility-spec)
5787 (assq prop buffer-invisibility-spec))))))
5788
5789
5790;;;_ #10 Unfinished
5756;;;_ > allout-bullet-isearch (&optional bullet) 5791;;;_ > allout-bullet-isearch (&optional bullet)
5757(defun allout-bullet-isearch (&optional bullet) 5792(defun allout-bullet-isearch (&optional bullet)
5758 "Isearch \(regexp) for topic with bullet BULLET." 5793 "Isearch \(regexp) for topic with bullet BULLET."
@@ -5769,8 +5804,9 @@ so pass them along when appropriate."
5769 bullet))) 5804 bullet)))
5770 (isearch-repeat 'forward) 5805 (isearch-repeat 'forward)
5771 (isearch-mode t))) 5806 (isearch-mode t)))
5772;;;_ ? Re hooking up with isearch - use isearch-op-fun rather than 5807
5773;;; wrapping the isearch functions. 5808;;;_ #11 Provide
5809(provide 'allout)
5774 5810
5775;;;_* Local emacs vars. 5811;;;_* Local emacs vars.
5776;;; The following `allout-layout' local variable setting: 5812;;; The following `allout-layout' local variable setting: