Mercurial > emacs
comparison lisp/allout.el @ 68953:0ddd5b380ffb
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.
author | Eli Zaretskii <eliz@gnu.org> |
---|---|
date | Fri, 17 Feb 2006 10:52:30 +0000 |
parents | 3bd95f4f2941 |
children | af2db645bc9d |
comparison
equal
deleted
inserted
replaced
68952:608f15136cdb | 68953:0ddd5b380ffb |
---|---|
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. |
13 | 13 |
14 ;; GNU Emacs is free software; you can redistribute it and/or modify | 14 ;; GNU Emacs is free software; you can redistribute it and/or modify |
26 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | 26 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
27 ;; Boston, MA 02110-1301, USA. | 27 ;; Boston, MA 02110-1301, USA. |
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. |
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 . | |
60 ;; | 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 |
64 ;; activation of allout-mode. | 67 ;; activation of allout-mode. |
73 | 76 |
74 ;; ken manheimer (ken dot manheimer at gmail dot com) | 77 ;; ken manheimer (ken dot manheimer at gmail dot com) |
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-" |
95 :group 'outlines) | 96 :group 'outlines) |
96 | 97 |
149 ;;;End: | 150 ;;;End: |
150 | 151 |
151 will, modulo the above-mentioned conditions, cause the mode to be | 152 will, modulo the above-mentioned conditions, cause the mode to be |
152 activated when the file is visited, followed by the equivalent of | 153 activated 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 |
154 the allout.el, itself.) | 155 the allout.el source file.) |
155 | 156 |
156 Also, allout's mode-specific provisions will make topic prefixes default | 157 Also, allout's mode-specific provisions will make topic prefixes default |
157 to the comment-start string, if any, of the language of the file. This | 158 to the comment-start string, if any, of the language of the file. This |
158 is modulo the setting of `allout-use-mode-specific-leader', which see.") | 159 is modulo the setting of `allout-use-mode-specific-leader', which see.") |
159 (make-variable-buffer-local 'allout-layout) | 160 (make-variable-buffer-local 'allout-layout) |
448 (const needed) | 449 (const needed) |
449 (const disabled)) | 450 (const disabled)) |
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 |
456 The idea is to prevent file-system exposure of any un-encrypted stuff, and | 457 The idea is to prevent file-system exposure of any un-encrypted stuff, and |
457 mostly covers both deliberate file writes and auto-saves. | 458 mostly covers both deliberate file writes and auto-saves. |
458 | 459 |
483 (make-variable-buffer-local 'allout-encrypt-unencrypted-on-saves) | 484 (make-variable-buffer-local 'allout-encrypt-unencrypted-on-saves) |
484 | 485 |
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 | |
492 Default is '\C-c<space>'; just '\C-c' is more short-and-sweet, if you're | |
493 willing to let allout use a bunch of \C-c keybindings." | |
490 :type 'string | 494 :type 'string |
491 :group 'allout) | 495 :group 'allout) |
492 | 496 |
493 ;;;_ = allout-keybindings-list | 497 ;;;_ = allout-keybindings-list |
494 ;;; You have to reactivate allout-mode - `(allout-mode t)' - to | 498 ;;; You have to reactivate allout-mode - `(allout-mode t)' - to |
536 ("=c" allout-copy-exposed-to-buffer) | 540 ("=c" allout-copy-exposed-to-buffer) |
537 ("=i" allout-indented-exposed-to-buffer) | 541 ("=i" allout-indented-exposed-to-buffer) |
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 | |
544 targets 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. |
552 Ie, it is indented to be just past the header prefix. This is | 548 Ie, it is indented to be just past the header prefix. This is |
553 relevant mostly for use with indented-text-mode, or other situations | 549 relevant mostly for use with indented-text-mode, or other situations |
554 where auto-fill occurs. | 550 where auto-fill occurs." |
555 | |
556 \[This feature no longer depends in any way on the `filladapt.el' | |
557 lisp-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) |
561 | 554 |
562 ;;;_ = allout-reindent-bodies | 555 ;;;_ = allout-reindent-bodies |
595 ;;;_* CODE - no user customizations below. | 588 ;;;_* CODE - no user customizations below. |
596 | 589 |
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) |
604 "Return string describing the loaded outline version." | 597 "Return string describing the loaded outline version." |
605 (interactive "P") | 598 (interactive "P") |
634 (make-variable-buffer-local 'allout-bullets-string-len) | 627 (make-variable-buffer-local 'allout-bullets-string-len) |
635 ;;;_ = allout-line-boundary-regexp | 628 ;;;_ = allout-line-boundary-regexp |
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 | 632 This is properly set when `allout-regexp' is produced by |
640 set when `allout-regexp' is produced by `set-allout-regexp', so | 633 `set-allout-regexp', so that (match-beginning 2) and (match-end |
641 that (match-beginning 2) and (match-end 2) delimit the prefix.") | 634 2) 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 () |
645 "Like `allout-line-boundary-regexp', for headers at beginning of buffer. | 638 "Like `allout-line-boundary-regexp', for headers at beginning of buffer. |
646 \(match-beginning 2) and \(match-end 2) delimit the prefix.") | 639 \(match-beginning 2) and \(match-end 2) delimit the prefix.") |
751 'allout-distinctive-bullets-string | 744 'allout-distinctive-bullets-string |
752 'allout-primary-bullet)) | 745 'allout-primary-bullet)) |
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)) |
764 (setq allout-bullets-string | 755 (setq allout-bullets-string |
765 (concat allout-bullets-string | 756 (concat allout-bullets-string |
786 allout-bullets-string | 777 allout-bullets-string |
787 "]\\)\\|\\" | 778 "]\\)\\|\\" |
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 ) |
795 ;;;_ : Key bindings | 786 ;;;_ : Key bindings |
796 ;;;_ = allout-mode-map | 787 ;;;_ = allout-mode-map |
953 (setq allout-mode-prior-settings | 944 (setq allout-mode-prior-settings |
954 (cdr allout-mode-prior-settings))) | 945 (cdr allout-mode-prior-settings))) |
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 | |
961 allout-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 | |
972 Maintained by allout-isearch-abort \(which is wrapped around the real | |
973 isearch-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 |
991 This is purely a kludge variable, regulating the compensation for a bug in | 965 (defvar allout-outside-normal-auto-fill-function nil |
992 the 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 |
968 Used by allout-auto-fill to do the mandated normal-auto-fill-function | |
969 wrapped 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 |
997 mode from prop-line file-var activation. Used by `allout-mode' function | 974 mode from prop-line file-var activation. Used by `allout-mode' function |
998 to track repeats.") | 975 to track repeats.") |
1057 (point-marker)))) | 1034 (point-marker)))) |
1058 (if (save-excursion (goto-char (point-min)) | 1035 (if (save-excursion (goto-char (point-min)) |
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)) |
1066 (error (progn | 1043 (error (progn |
1067 (message | 1044 (message |
1182 "-layout \(upon confirmation) enabled.")) | 1159 "-layout \(upon confirmation) enabled.")) |
1183 'ask) | 1160 'ask) |
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." |
1191 (let ((menus (list allout-mode-exposure-menu | 1167 (let ((menus (list allout-mode-exposure-menu |
1192 allout-mode-editing-menu | 1168 allout-mode-editing-menu |
1195 cur) | 1171 cur) |
1196 (while menus | 1172 (while menus |
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 |
1207 Optional arg forces mode to re-initialize iff arg is positive num or | 1208 Optional arg forces mode to re-initialize iff arg is positive num or |
1208 symbol. Allout outline mode always runs as a minor mode. | 1209 symbol. Allout outline mode always runs as a minor mode. |
1209 | 1210 |
1210 Allout outline mode provides extensive outline oriented formatting and | 1211 Allout outline mode provides extensive outline oriented formatting and |
1242 \\[allout-previous-visible-heading] allout-previous-visible-heading | \\[allout-show-children] allout-show-children | 1243 \\[allout-previous-visible-heading] allout-previous-visible-heading | \\[allout-show-children] allout-show-children |
1243 \\[allout-up-current-level] allout-up-current-level | \\[allout-show-current-subtree] allout-show-current-subtree | 1244 \\[allout-up-current-level] allout-up-current-level | \\[allout-show-current-subtree] allout-show-current-subtree |
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 ------------- |
1279 M-x outlineify-sticky Activate outline mode for current buffer, | 1284 M-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. |
1291 ESC 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 |
1296 Outline mode supports easily togglable gpg encryption of topics, with | 1301 Outline mode supports gpg encryption of topics, with support for |
1297 niceties like support for symmetric and key-pair modes, passphrase timeout, | 1302 symmetric and key-pair modes, passphrase timeout, passphrase |
1298 passphrase consistency checking, user-provided hinting for symmetric key | 1303 consistency checking, user-provided hinting for symmetric key |
1299 mode, and auto-encryption of topics pending encryption on save. The aim is | 1304 mode, and auto-encryption of topics pending encryption on save. |
1300 to enable reliable topic privacy while preventing accidents like neglected | 1305 \(Topics pending encryption are, by default, automatically |
1301 encryption, encryption with a mistaken passphrase, forgetting which | 1306 encrypted during file saves; if you're editing the contents of |
1302 passphrase was used, and other practical pitfalls. | 1307 such a topic, it is automatically decrypted for continued |
1308 editing.) The aim is reliable topic privacy while preventing | |
1309 accidents like neglected encryption before saves, forgetting | |
1310 which passphrase was used, and other practical pitfalls. | |
1303 | 1311 |
1304 See `allout-toggle-current-subtree-encryption' function docstring and | 1312 See `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. |
1306 | 1314 |
1307 HOT-SPOT Operation | 1315 HOT-SPOT Operation |
1308 | 1316 |
1309 Hot-spot operation provides a means for easy, single-keystroke outline | 1317 Hot-spot operation provides a means for easy, single-keystroke outline |
1310 navigation and exposure control. | 1318 navigation and exposure control. |
1311 | 1319 |
1312 \\<allout-mode-map> | |
1313 When the text cursor is positioned directly on the bullet character of | 1320 When the text cursor is positioned directly on the bullet character of |
1314 a topic, regular characters (a to z) invoke the commands of the | 1321 a topic, regular characters (a to z) invoke the commands of the |
1315 corresponding allout-mode keymap control chars. For example, \"f\" | 1322 corresponding allout-mode keymap control chars. For example, \"f\" |
1316 would invoke the command typically bound to \"C-c C-f\" | 1323 would 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 |
1319 Thus, by positioning the cursor on a topic bullet, you can execute | 1326 Thus, by positioning the cursor on a topic bullet, you can |
1320 the outline navigation and manipulation commands with a single | 1327 execute the outline navigation and manipulation commands with a |
1321 keystroke. Non-literal chars never get this special translation, so | 1328 single keystroke. Regular navigation keys (eg, \\[forward-char], \\[next-line]) never get |
1322 you can use them to get away from the hot-spot, and back to normal | 1329 this special translation, so you can use them to get out of the |
1323 operation. | 1330 hot-spot and back to normal operation. |
1324 | 1331 |
1325 Note that the command `allout-beginning-of-current-entry' \(\\[allout-beginning-of-current-entry]\) | 1332 Note that the command `allout-beginning-of-current-entry' \(\\[allout-beginning-of-current-entry]\) |
1326 will move to the hot-spot when the cursor is already located at the | 1333 will move to the hot-spot when the cursor is already located at the |
1327 beginning of the current entry, so you can simply hit \\[allout-beginning-of-current-entry] | 1334 beginning of the current entry, so you usually can hit \\[allout-beginning-of-current-entry] |
1328 twice in a row to get to the hot-spot. | 1335 twice in a row to get to the hot-spot. |
1329 | 1336 |
1330 Terminology | 1337 Terminology |
1331 | 1338 |
1332 Topic hierarchy constituents - TOPICS and SUBTOPICS: | 1339 Topic hierarchy constituents - TOPICS and SUBTOPICS: |
1333 | 1340 |
1334 TOPIC: A basic, coherent component of an Emacs outline. It can | 1341 TOPIC: 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. |
1336 CURRENT topic: | 1343 CURRENT topic: |
1337 The visible topic most immediately containing the cursor. | 1344 The visible topic most immediately containing the cursor. |
1338 DEPTH: The degree of nesting of a topic; it increases with | 1345 DEPTH: The degree of nesting of a topic; it increases with |
1339 containment. Also called the: | 1346 containment. Also called the: |
1340 LEVEL: The same as DEPTH. | 1347 LEVEL: The same as DEPTH. |
1374 program code without interfering with the language processing | 1381 program code without interfering with the language processing |
1375 of that code. See `allout-use-mode-specific-leader' | 1382 of that code. See `allout-use-mode-specific-leader' |
1376 docstring for more detail. | 1383 docstring for more detail. |
1377 PREFIX-PADDING: | 1384 PREFIX-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. |
1380 BULLET: A character at the end of the topic prefix, it must be one of | 1387 BULLET: 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. |
1386 ENTRY: The text contained in a topic before any offspring. | 1393 ENTRY: The text contained in a topic before any offspring. |
1387 BODY: Same as ENTRY. | 1394 BODY: Same as ENTRY. |
1388 | 1395 |
1389 | 1396 |
1390 EXPOSURE: | 1397 EXPOSURE: |
1391 The state of a topic which determines the on-screen visibility | 1398 The state of a topic which determines the on-screen visibility |
1392 of its offspring and contained text. | 1399 of its offspring and contained text. |
1393 CONCEALED: | 1400 CONCEALED: |
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. |
1399 CLOSED: A topic whose immediate offspring and body-text is concealed. | 1405 CLOSED: A topic whose immediate offspring and body-text is concealed. |
1400 OPEN: A topic that is not closed, though its offspring or body may be." | 1406 OPEN: A topic that is not closed, though its offspring or body may be." |
1401 ;;;_ . Code | 1407 ;;;_ . Code |
1413 (and (wholenump toggle) | 1419 (and (wholenump toggle) |
1414 (not (zerop toggle)))))) | 1420 (not (zerop toggle)))))) |
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 |
1424 ; See comments below re v19.18,.19 bug. | 1432 ; See comments below re v19.18,.19 bug. |
1425 (setq allout-v18/19-file-var-hack (car command-history)) | 1433 (setq allout-v18/19-file-var-hack (car command-history)) |
1463 | 1471 |
1464 (if allout-old-style-prefixes | 1472 (if allout-old-style-prefixes |
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))) |
1474 (setq auto-save-hook | 1481 (setq auto-save-hook |
1475 (delq 'allout-auto-save-hook-handler | 1482 (delq 'allout-auto-save-hook-handler |
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 |
1485 ;; Activation: | 1491 ;; Activation: |
1486 ((not active) | 1492 ((not active) |
1487 (setq allout-explicitly-deactivated nil) | 1493 (setq allout-explicitly-deactivated nil) |
1488 (if allout-old-style-prefixes | 1494 (if allout-old-style-prefixes |
1489 (progn ; Inhibit all the fancy formatting: | 1495 (progn ; Inhibit all the fancy formatting: |
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 '(())))) |
1498 | |
1499 (allout-set-overlay-category) ; Doesn't hurt to redo this. | |
1492 | 1500 |
1493 (allout-infer-header-lead) | 1501 (allout-infer-header-lead) |
1494 (allout-infer-body-reindent) | 1502 (allout-infer-body-reindent) |
1495 | 1503 |
1496 (set-allout-regexp) | 1504 (set-allout-regexp) |
1523 ; and add them: | 1531 ; and add them: |
1524 (use-local-map (produce-allout-mode-map allout-keybindings-list | 1532 (use-local-map (produce-allout-mode-map allout-keybindings-list |
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 |
1550 (list (concat paragraph-start "\\|^\\(" | 1557 (list (concat paragraph-start "\\|^\\(" |
1551 allout-regexp "\\)"))) | 1558 allout-regexp "\\)"))) |
1560 | 1567 |
1561 (allout-setup-menubar) | 1568 (allout-setup-menubar) |
1562 | 1569 |
1563 (if allout-layout | 1570 (if allout-layout |
1564 (setq do-layout t)) | 1571 (setq do-layout t)) |
1565 | |
1566 (if (and allout-isearch-dynamic-expose | |
1567 (not (fboundp 'allout-real-isearch-abort))) | |
1568 (allout-enwrap-isearch)) | |
1569 | 1572 |
1570 (run-hooks 'allout-mode-hook) | 1573 (run-hooks 'allout-mode-hook) |
1571 (setq allout-mode t)) | 1574 (setq allout-mode t)) |
1572 | 1575 |
1573 ;; Reactivation: | 1576 ;; Reactivation: |
1603 ) ; let* | 1606 ) ; let* |
1604 ) ; defun | 1607 ) ; defun |
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 | |
1624 We expose the invisible text and ask for confirmation. Refusal or | |
1625 keyboard-quit abandons the changes, with keyboard-quit additionally | |
1626 reclosing the opened text. | |
1627 | |
1628 No confirmation is necessary when inhibit-read-only is set - eg, allout | |
1629 internal 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 | |
1669 See allout-overlay-interior-modification-handler for details. | |
1670 | |
1671 This before-change handler is used only where modification-hooks | |
1672 overlay 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 | |
1680 Optional OVERLAY parameter is for when this function is used by | |
1681 `isearch-open-invisible' overlay property. It is otherwise unused, so this | |
1682 function 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 |
1611 ;;; `allout-recent-prefix-beginning' and `allout-recent-prefix-end' | 1690 ;;; `allout-recent-prefix-beginning' and `allout-recent-prefix-end' |
1612 ;;; when successful. Functions starting with `allout-recent-' all | 1691 ;;; when successful. Functions starting with `allout-recent-' all |
1666 allout-recent-prefix-end)) | 1745 allout-recent-prefix-end)) |
1667 | 1746 |
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 () |
1674 "Return non-nil if point is on current visible topics' header line. | 1757 "Return non-nil if point is on current visible topics' header line. |
1675 | 1758 |
1676 Actually, returns prefix beginning point." | 1759 Actually, 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 () |
1682 (defalias 'allout-on-heading-p 'allout-on-current-heading-p) | 1765 (defalias 'allout-on-heading-p 'allout-on-current-heading-p) |
1683 ;;;_ > allout-e-o-prefix-p () | 1766 ;;;_ > allout-e-o-prefix-p () |
1684 (defun allout-e-o-prefix-p () | 1767 (defun allout-e-o-prefix-p () |
1685 "True if point is located where current topic prefix ends, heading begins." | 1768 "True if point is located where current topic prefix ends, heading begins." |
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 | |
1777 Return zero if point is not within any topic. | |
1778 | |
1779 Like `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) | 1794 Return 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." |
1725 (save-excursion | 1805 (save-excursion |
1726 (if (allout-goto-prefix) | 1806 (if (allout-goto-prefix) |
1732 (and (allout-goto-prefix) | 1812 (and (allout-goto-prefix) |
1733 (allout-recent-bullet)))) | 1813 (allout-recent-bullet)))) |
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) |
1741 allout-recent-prefix-end)) | 1821 allout-recent-prefix-end)) |
1742 ;; Quick and dirty provision, ostensibly for missing bullet: | 1822 ;; Quick and dirty provision, ostensibly for missing bullet: |
1781 (setq depth (1- depth)) | 1861 (setq depth (1- depth)) |
1782 (setq next-index (allout-sibling-index depth))) | 1862 (setq next-index (allout-sibling-index depth))) |
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. |
1790 | 1894 |
1791 Returns the location of the heading, or nil if none found." | 1895 Returns the location of the heading, or nil if none found." |
1796 (if (re-search-forward allout-line-boundary-regexp nil 0) | 1900 (if (re-search-forward allout-line-boundary-regexp nil 0) |
1797 (allout-prefix-data ; Got valid location state - set vars: | 1901 (allout-prefix-data ; Got valid location state - set vars: |
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 |
1805 ;; and usable by allout-mode. | 1909 ;; and usable by allout-mode. |
1806 (if (not (allout-goto-prefix)) (allout-next-heading))) | 1910 (if (not (allout-goto-prefix)) (allout-next-heading))) |
1820 (progn ; Got valid location state - set vars: | 1924 (progn ; Got valid location state - set vars: |
1821 (allout-prefix-data | 1925 (allout-prefix-data |
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 |
1828 ;;; nested lists of the locations of topics within a subtree. | 1947 ;;; nested lists of the locations of topics within a subtree. |
1829 ;;; | 1948 ;;; |
1910 | 2029 |
1911 (if original ; We're at the last sibling on | 2030 (if original ; We're at the last sibling on |
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 |
1923 chart ; (nreverse chart) not necessary, | 2042 chart ; (nreverse chart) not necessary, |
1924 ; and maybe not preferable. | 2043 ; and maybe not preferable. |
1952 ;; We're on the start of a subtree - recurse with it, if there's | 2071 ;; We're on the start of a subtree - recurse with it, if there's |
1953 ;; more depth to go: | 2072 ;; more depth to go: |
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)) |
1961 ;;;_ X allout-chart-spec (chart spec &optional exposing) | 2080 ;;;_ X allout-chart-spec (chart spec &optional exposing) |
1962 ;; (defun allout-chart-spec (chart spec &optional exposing) | 2081 ;; (defun allout-chart-spec (chart spec &optional exposing) |
2001 | 2120 |
2002 Returns the point at the beginning of the prefix, or nil if none." | 2121 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) |
2010 (match-end 0))) | 2129 (match-end 0))) |
2011 (forward-char -1))) | 2130 (forward-char -1))) |
2040 (if (not (allout-current-depth)) | 2159 (if (not (allout-current-depth)) |
2041 nil | 2160 nil |
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) | 2166 Return value of point, unless we started outside of (before any) topics, |
2048 (prog1 (or (allout-on-current-heading-p) | 2167 in 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 |
2060 Returns that character position." | 2190 Returns that character position." |
2061 | 2191 |
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 |
2069 If optional CURRENT is true (default false), then put point at the end of | 2199 Optional CURRENT means put point at the end of the containing |
2070 the containing visible topic. | 2200 visible topic. |
2201 | |
2202 Optional INCLUDE-TRAILING-BLANK means include a trailing blank line, if | |
2203 any, as part of the subtree. Otherwise, that trailing blank will be | |
2204 excluded as delimiting whitespace between topics. | |
2071 | 2205 |
2072 Returns the value of point." | 2206 Returns the value of point." |
2073 (interactive "P") | 2207 (interactive "P") |
2074 (if current | 2208 (if current |
2075 (allout-back-to-current-heading) | 2209 (allout-back-to-current-heading) |
2078 (allout-next-heading) | 2212 (allout-next-heading) |
2079 (while (and (not (eobp)) | 2213 (while (and (not (eobp)) |
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. |
2224 | |
2225 Optional INCLUDE-TRAILING-BLANK means include a trailing blank line, if | |
2226 any, as part of the subtree. Otherwise, that trailing blank will be | |
2227 excluded as delimiting whitespace between topics. | |
2091 | 2228 |
2092 Returns the value of point." | 2229 Returns 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. |
2098 | 2235 |
2099 If already there, move cursor to bullet for hot-spot operation. | 2236 If already there, move cursor to bullet for hot-spot operation. |
2102 (let ((start-point (point))) | 2239 (let ((start-point (point))) |
2103 (allout-end-of-prefix) | 2240 (allout-end-of-prefix) |
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 | |
2248 Optional INCLUSIVE means also include trailing empty line, if any. When | |
2249 unset, whitespace between items separates them even when the items are | |
2250 collapsed." | |
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 () |
2122 (defun allout-get-body-text () | 2264 (defun allout-get-body-text () |
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 ) |
2136 ) | 2278 ) |
2137 ) | 2279 ) |
2187 DONT-COMPLAIN is non-nil." | 2329 DONT-COMPLAIN is non-nil." |
2188 (interactive "p") | 2330 (interactive "p") |
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) |
2197 (not (bobp)) | 2338 (not (bobp)) |
2198 (not failed)) | 2339 (not failed)) |
2258 | 2399 |
2259 Presumes point is at the start of a topic prefix." | 2400 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 () |
2271 "Go back to the first sibling at this level, visible or not." | 2410 "Go back to the first sibling at this level, visible or not." |
2272 (allout-end-of-level 'backward)) | 2411 (allout-end-of-level 'backward)) |
2280 (if (interactive-p) (allout-end-of-prefix))))) | 2419 (if (interactive-p) (allout-end-of-prefix))))) |
2281 ;;;_ > allout-next-visible-heading (arg) | 2420 ;;;_ > allout-next-visible-heading (arg) |
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 |
2285 Move as far as possible in indicated direction \(beginning or end of | 2424 Move to buffer limit in indicated direction if headings are exhausted." |
2286 buffer) 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)) |
2301 (setq arg (1- arg))) | 2440 (setq arg (1- arg))) |
2302 (cond (got ; Last move was to a prefix: | 2441 (cond (got ; Last move was to a prefix: |
2321 Takes optional repeat-count, goes backward if count is negative. | 2460 Takes optional repeat-count, goes backward if count is negative. |
2322 | 2461 |
2323 Returns resulting position, else nil if none found." | 2462 Returns 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 |
2330 (last-good (point)) | 2468 (last-good (point)) |
2331 at-boundary) | 2469 at-boundary) |
2384 "Outline `post-command-hook' function. | 2522 "Outline `post-command-hook' function. |
2385 | 2523 |
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)) |
2437 (setq allout-post-goto-bullet nil))) | 2541 (setq allout-post-goto-bullet nil))) |
2438 )) | 2542 )) |
2454 return to regular interpretation of self-insert characters." | 2558 return to regular interpretation of self-insert characters." |
2455 | 2559 |
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))) |
2466 (let* ((this-key-num (cond | 2566 (let* ((this-key-num (cond |
2467 ((numberp last-command-char) | 2567 ((numberp last-command-char) |
2497 See `allout-init' for setup instructions." | 2597 See `allout-init' for setup instructions." |
2498 (if (and allout-auto-activation | 2598 (if (and allout-auto-activation |
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 | |
2506 Called 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 | |
2554 The 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 | |
2583 actual 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) |
2609 (defun allout-solicit-alternate-bullet (depth &optional current-bullet) | 2605 (defun allout-solicit-alternate-bullet (depth &optional current-bullet) |
2610 | 2606 |
2805 (format "%d" (cond ((and index (numberp index)) index) | 2801 (format "%d" (cond ((and index (numberp index)) index) |
2806 (new (1+ (allout-sibling-index depth))) | 2802 (new (1+ (allout-sibling-index depth))) |
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 |
2814 New topic is situated after current one, unless optional flag BEFORE | 2810 New topic is situated after current one, unless optional flag BEFORE |
2815 is non-nil, or unless current line is complete empty (not even | 2811 is non-nil, or unless current line is completely empty - lacking even |
2816 whitespace), in which case open is done on current line. | 2812 whitespace - in which case open is done on the current line. |
2817 | 2813 |
2818 If USE_RECENT_BULLET is true, offer to use the bullet of the prior sibling. | 2814 When adding an offspring, it will be added immediately after the parent if |
2815 the other offspring are exposed, or after the last child if the offspring | |
2816 are hidden. \(The intervening offspring will be exposed in the latter | |
2817 case.) | |
2818 | |
2819 If OFFER-RECENT-BULLET is true, offer to use the bullet of the prior sibling. | |
2819 | 2820 |
2820 Nuances: | 2821 Nuances: |
2821 | 2822 |
2822 - Creation of new topics is with respect to the visible topic | 2823 - Creation of new topics is with respect to the visible topic |
2823 containing the cursor, regardless of intervening concealed ones. | 2824 containing the cursor, regardless of intervening concealed ones. |
2837 you're starting from, even when creating backwards. This way you | 2838 you're starting from, even when creating backwards. This way you |
2838 can easily create a sibling in front of the current topic without | 2839 can easily create a sibling in front of the current topic without |
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 |
2851 (cond ((< relative-depth 0) | 2852 (cond ((< relative-depth 0) |
2852 (allout-ascend-to-depth depth)) | 2853 (allout-ascend-to-depth depth)) |
2862 (and allout-numbered-bullet | 2863 (and allout-numbered-bullet |
2863 (or (<= relative-depth 0) | 2864 (or (<= relative-depth 0) |
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) |
2877 | 2871 |
2878 (if (not opening-on-blank) | 2872 (if (not opening-on-blank) |
2889 (looking-at "^\\s-*$") | 2883 (looking-at "^\\s-*$") |
2890 (bobp))) | 2884 (bobp))) |
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. |
3013 | 2983 |
3014 Negative universal arg means to open deeper, but place the new topic | 2984 Negative universal arg means to open deeper, but place the new topic |
3053 (if (looking-at allout-regexp) | 3023 (if (looking-at allout-regexp) |
3054 ;; ... construct indentation to account for | 3024 ;; ... construct indentation to account for |
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. |
3064 | 3037 |
3065 Optional arg NUMBER indicates numbering is being added, and it must | 3038 Optional arg NUMBER indicates numbering is being added, and it must |
3069 | 3042 |
3070 (save-excursion | 3043 (save-excursion |
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: |
3078 (old-margin (+ old-depth (- new-margin new-depth)))) | 3050 (old-margin (+ old-depth (- new-margin new-depth)))) |
3079 | 3051 |
3080 ;; Process lines up to (but excluding) next topic header: | 3052 ;; Process lines up to (but excluding) next topic header: |
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 |
3088 ;; match data with a subsequent `looking-at': | 3060 ;; match data with a subsequent `looking-at': |
3089 (setq old-indent-begin (match-beginning 1) | 3061 (setq old-indent-begin (match-beginning 1) |
3229 | 3201 |
3230 Descends into invisible as well as visible topics, however. | 3202 Descends into invisible as well as visible topics, however. |
3231 | 3203 |
3232 With repeat count, shift topic depth by that amount." | 3204 With 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)) |
3239 ((listp arg) (setq arg (car arg)))) | 3210 ((listp arg) (setq arg (car arg)))) |
3240 ;; Fill the user in, in case we're shifting a big topic: | 3211 ;; Fill the user in, in case we're shifting a big topic: |
3412 (allout-recent-depth) | 3383 (allout-recent-depth) |
3413 0)))) | 3384 0)))) |
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) |
3422 "Decrease depth of current heading and any topics collapsed within it. | 3393 "Decrease depth of current heading and any topics collapsed within it. |
3423 | 3394 |
3434 (defun allout-kill-line (&optional arg) | 3405 (defun allout-kill-line (&optional arg) |
3435 "Kill line, adjusting subsequent lines suitably for outline mode." | 3406 "Kill line, adjusting subsequent lines suitably for outline mode." |
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 |
3494 Leaves primary topic's trailing vertical whitespace, if any." | 3441 Trailing 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 | |
3448 Completely collapsed topics are marked as such, for re-collapse | |
3449 when 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 |
3520 (allout-renumber-to-depth depth)))) | 3479 (allout-renumber-to-depth depth)))) |
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 |
3526 Does depth adjustment of yanked topics, when: | 3485 Does depth adjustment of yanked topics, when: |
3527 | 3486 |
3528 1 the stuff being yanked starts with a valid outline header prefix, and | 3487 1 the stuff being yanked starts with a valid outline header prefix, and |
3529 2 it is being yanked at the end of a line which consists of only a valid | 3488 2 it is being yanked at the end of a line which consists of only a valid |
3540 however, are left exactly like normal, non-allout-specific yanks." | 3499 however, are left exactly like normal, non-allout-specific yanks." |
3541 | 3500 |
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 "\\)")) |
3552 (allout-prefix-data (match-beginning 1) | 3513 (allout-prefix-data (match-beginning 1) |
3553 (match-end 1)))) | 3514 (match-end 1)))) |
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)) |
3561 (subj-depth (allout-recent-depth)) | 3522 (subj-depth (allout-recent-depth)) |
3562 (prefix-bullet (allout-recent-bullet)) | 3523 (prefix-bullet (allout-recent-bullet)) |
3573 (not (= (point) subj-beg))) | 3534 (not (= (point) subj-beg))) |
3574 (looking-at allout-regexp) | 3535 (looking-at allout-regexp) |
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 |
3582 ; Do the adjustment: | 3542 ; Do the adjustment: |
3583 (progn | 3543 (progn |
3614 ; Delete from bullet of old to | 3574 ; Delete from bullet of old to |
3615 ; before bullet of new: | 3575 ; before bullet of new: |
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, |
3623 ; leaving old one: | 3583 ; leaving old one: |
3624 (delete-region (point) (+ (point) | 3584 (delete-region (point) (+ (point) |
3641 (allout-depth) ;;; depth | 3601 (allout-depth) ;;; depth |
3642 nil ;;; number-control | 3602 nil ;;; number-control |
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) |
3649 (defun allout-yank (&optional arg) | 3612 (defun allout-yank (&optional arg) |
3650 "`allout-mode' yank, with depth and numbering adjustment of yanked topics. | 3613 "`allout-mode' yank, with depth and numbering adjustment of yanked topics. |
3676 | 3639 |
3677 (interactive "*P") | 3640 (interactive "*P") |
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. |
3685 | 3649 |
3686 Adapts level of popped topics to level of fresh prefix. | 3650 Adapts level of popped topics to level of fresh prefix. |
3734 ;;;_ #6 Exposure Control | 3698 ;;;_ #6 Exposure Control |
3735 | 3699 |
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. |
3740 Ie, text following flag C-m \(carriage-return) is hidden until the | 3704 |
3741 next C-j (newline) char. | 3705 Text is shown if flag is nil and hidden otherwise." |
3742 | 3706 ;; We use outline invisibility spec. |
3743 Returns 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 | |
3795 See `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 |
3808 This is a way to give restricted peek at a concealed locality without the | 3736 This is a way to give restricted peek at a concealed locality without the |
3809 expense of exposing its context, but can leave the outline with aberrant | 3737 expense of exposing its context, but can leave the outline with aberrant |
3810 exposure. `allout-hide-current-entry-completely' or `allout-show-offshoot' | 3738 exposure. `allout-show-offshoot' should be used after the peek to rectify |
3811 should be used after the peek to rectify the exposure." | 3739 the 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) |
3829 | 3751 |
3830 "If point is visible, show all direct subheadings of this heading. | 3752 "If point is visible, show all direct subheadings of this heading. |
3841 | 3763 |
3842 Returns point at end of subtree that was opened, if any. (May get a | 3764 Returns point at end of subtree that was opened, if any. (May get a |
3843 point of non-opened subtree?)" | 3765 point 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: |
3881 Specifically intended for aberrant exposure states, like entries that were | 3803 (goto-char start-point))) |
3882 exposed 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 |
3896 As with `allout-hide-current-entry-completely', useful for rectifying | 3808 Useful for coherently exposing to a random point in a hidden region." |
3897 aberrant 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. |
3910 (progn (beginning-of-line) | 3824 (progn (beginning-of-line) |
3911 (allout-show-current-subtree) | 3825 (allout-show-current-subtree) |
3924 (defun allout-hide-current-entry () | 3838 (defun allout-hide-current-entry () |
3925 "Hide the body directly following this heading." | 3839 "Hide the body directly following this heading." |
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 | |
3950 Specifically intended for aberrant exposure states, like entries that were | |
3951 exposed 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, |
3964 expose this topic and its siblings." | 3864 expose this topic and its siblings." |
3965 (interactive "P") | 3865 (interactive "P") |
3968 ;; Outside any topics - try to get to the first: | 3868 ;; Outside any topics - try to get to the first: |
3969 (if (not (allout-next-heading)) | 3869 (if (not (allout-next-heading)) |
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 | |
3883 If optional INCLUDE-SINGLE-LINERS is true, then include single-line | |
3884 topics \(which intrinsically can be considered both collapsed and | |
3885 not\), 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. |
3981 | 3897 |
3982 If this topic is closed and it's a top level topic, close this topic | 3898 If this topic is closed and it's a top level topic, close this topic |
3983 and its siblings. | 3899 and its siblings. |
3984 | 3900 |
3985 If optional arg JUST-CLOSE is non-nil, do not treat the parent or | 3901 If optional arg JUST-CLOSE is non-nil, do not close the parent or |
3986 siblings, even if the target topic is already closed." | 3902 siblings, 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." |
4017 (interactive) | 3919 (interactive) |
4018 (beginning-of-line) | 3920 (beginning-of-line) |
4029 ;;;_ > allout-show-all () | 3931 ;;;_ > allout-show-all () |
4030 (defun allout-show-all () | 3932 (defun allout-show-all () |
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 () |
4038 "Hide all of buffer except headings." | 3940 "Hide all of buffer except headings." |
4039 (interactive) | 3941 (interactive) |
4044 (save-excursion | 3946 (save-excursion |
4045 (save-restriction | 3947 (save-restriction |
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) |
4057 (defun allout-expose-topic (spec) | 3959 (defun allout-expose-topic (spec) |
4058 "Apply exposure specs to successive outline topic items. | 3960 "Apply exposure specs to successive outline topic items. |
4115 (if (not (listp spec)) | 4017 (if (not (listp spec)) |
4116 nil | 4018 nil |
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) |
4126 spec (cdr spec)) | 4026 spec (cdr spec)) |
4127 (cond ; Do current element: | 4027 (cond ; Do current element: |
4145 (if (< 0 residue) | 4045 (if (< 0 residue) |
4146 ;; Some residue - cover it with prev-elem: | 4046 ;; Some residue - cover it with prev-elem: |
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 |
4154 (if (> allout-recent-end-of-subtree max-pos) | 4054 (if (> allout-recent-end-of-subtree max-pos) |
4155 (setq max-pos | 4055 (setq max-pos |
4205 | 4105 |
4206 Optional FOLLOWERS arguments dictate exposure for succeeding siblings." | 4106 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) |
4214 (if (eq spec '*) (allout-show-current-subtree)) | 4113 (if (eq spec '*) (allout-show-current-subtree)) |
4215 (if (eq spec '+) (allout-show-current-branches)) | 4114 (if (eq spec '+) (allout-show-current-branches)) |
4385 | 4284 |
4386 (interactive "r") | 4285 (interactive "r") |
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) |
4394 (beginning-of-line) | 4293 (beginning-of-line) |
4395 ;; Goto initial topic, and register preceeding stuff, if any: | 4294 ;; Goto initial topic, and register preceeding stuff, if any: |
4417 (setq strings | 4316 (setq strings |
4418 (cons (buffer-substring | 4317 (cons (buffer-substring |
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)) |
4435 (setq result | 4329 (setq result |
4436 (cons | 4330 (cons |
4486 '(region-active-p) | 4380 '(region-active-p) |
4487 'mark-active)) | 4381 'mark-active)) |
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 |
4494 All args are options; default values itemized below. | 4388 All args are options; default values itemized below. |
4495 | 4389 |
4496 Apply FUNCTION to exposed portions FROM position TO position in buffer | 4390 Apply FUNCTION to exposed portions FROM position TO position in buffer |
4692 (let ((doc-style (format "\n\\documentstyle{%s}\n" | 4586 (let ((doc-style (format "\n\\documentstyle{%s}\n" |
4693 "report")) | 4587 "report")) |
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" |
4707 allout-label-style)) | 4594 allout-label-style)) |
4708 (headlinecmd (format "\\newcommand{\\headlinecmd}[1]{{%s #1}}\n" | 4595 (headlinecmd (format "\\newcommand{\\headlinecmd}[1]{{%s #1}}\n" |
4731 "]\n}\n")) | 4618 "]\n}\n")) |
4732 (begindoc "\\begin{document}\n\\begin{center}\n") | 4619 (begindoc "\\begin{document}\n\\begin{center}\n") |
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")) |
4740 "}\n" | 4627 "}\n" |
4741 "\\end{center}\n\n")) | 4628 "\\end{center}\n\n")) |
4911 the hint string is stored in the local-variables section of the file, and | 4798 the hint string is stored in the local-variables section of the file, and |
4912 solicited whenever the passphrase is changed." | 4799 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) |
4920 (defun allout-toggle-subtree-encryption (&optional fetch-pass) | 4807 (defun allout-toggle-subtree-encryption (&optional fetch-pass) |
4921 "Encrypt clear text or decrypt encoded topic contents \(body and subtopics.) | 4808 "Encrypt clear text or decrypt encoded topic contents \(body and subtopics.) |
4946 (after-bullet-pos (point)) | 4833 (after-bullet-pos (point)) |
4947 (was-encrypted | 4834 (was-encrypted |
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 |
4968 (and was-encrypted | 4858 (and was-encrypted |
4969 (allout-encrypted-key-info subject-text)) | 4859 (allout-encrypted-key-info subject-text)) |
4970 (and (member fetch-pass '(4 (4))) | 4860 (and (member fetch-pass '(4 (4))) |
4971 '(keypair nil)) | 4861 '(keypair nil)) |
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 |
4980 (current-buffer) | 4869 (current-buffer) |
4981 for-key-type for-key-identity fetch-pass)) | 4870 for-key-type for-key-identity fetch-pass)) |
4985 (progn | 4874 (progn |
4986 (set-buffer allout-buffer) | 4875 (set-buffer allout-buffer) |
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) |
4999 allout-topic-encryption-bullet)) | 4888 allout-topic-encryption-bullet)) |
5000 (progn (goto-char (1- after-bullet-pos)) | 4889 (progn (goto-char (1- after-bullet-pos)) |
5058 key-type | 4947 key-type |
5059 (if (equal key-type 'keypair) | 4948 (if (equal key-type 'keypair) |
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. |
5068 (pgg-remove-passphrase-from-cache target-cache-id t)) | 4956 (pgg-remove-passphrase-from-cache target-cache-id t)) |
5069 | 4957 |
5081 key-type | 4969 key-type |
5082 allout-buffer | 4970 allout-buffer |
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 |
5090 ;; symmetric: | 4978 ;; symmetric: |
5091 ((equal key-type 'symmetric) | 4979 ((equal key-type 'symmetric) |
5317 | 5205 |
5318 An error is raised if the text is not encrypted." | 5206 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 |
5326 'keypair)) | 5214 'keypair)) |
5327 secret-keys first-secret-key for-key-owner) | 5215 secret-keys first-secret-key for-key-owner) |
5440 must also have content." | 5328 must also have content." |
5441 (let (done got content-beg) | 5329 (let (done got content-beg) |
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 |
5463 ((eobp) | 5351 ((eobp) |
5464 (setq got nil | 5352 (setq got nil |
5496 and exactly resituate the cursor if this is being done as part of a file | 5384 and exactly resituate the cursor if this is being done as part of a file |
5497 save. See `allout-encrypt-unencrypted-on-saves' for more info." | 5385 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)) |
5524 ) | 5414 ) |
5525 (if (not was-modified) | 5415 (if (not was-modified) |
5577 (not (search-forward "Local Variables:" nil t))) | 5467 (not (search-forward "Local Variables:" nil t))) |
5578 nil | 5468 nil |
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)) |
5590 (list beg prefix suffix)) | 5480 (list beg prefix suffix)) |
5591 ) | 5481 ) |
5637 ;; of new value: | 5527 ;; of new value: |
5638 (goto-char beg) | 5528 (goto-char beg) |
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)))) |
5646 (if (> value-end value-beg) | 5536 (if (> value-end value-beg) |
5647 (delete-region value-beg value-end))) | 5537 (delete-region value-beg value-end))) |
5708 ;; Include first char: | 5598 ;; Include first char: |
5709 (concat (substring regexp 0 1) | 5599 (concat (substring regexp 0 1) |
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. | 5607 If 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) |
5719 which case it becomes the last). HOOK should be a symbol, and FUNCTION may be | 5609 0 |
5720 any valid function. HOOK's value should be a list of functions, not a single | 5610 (save-excursion |
5721 function. 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)) | 5621 XEmacs takes two optional args, while mainline GNU Emacs does not, |
5732 (cons function (symbol-value hook))))))) | 5622 so 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) |
5736 "Replace FROMCHAR with TOCHAR in STRING each time it occurs. | 5629 "Replace FROMCHAR with TOCHAR in STRING each time it occurs. |
5737 Unless optional argument INPLACE is non-nil, return a new string." | 5630 Unless optional argument INPLACE is non-nil, return a new string." |
5740 (while (> i 0) | 5633 (while (> i 0) |
5741 (setq i (1- i)) | 5634 (setq i (1- i)) |
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 |
5749 XEmacs takes two optional args, while mainline GNU Emacs does not, | 5642 (if (not (fboundp 'remove-overlays)) |
5750 so 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) | 5645 Overlays might be moved and/or split. |
5753 (mark-marker))) | 5646 BEG 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'. | |
5684 See documentation for `buffer-invisibility-spec' for the kind of elements | |
5685 that 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 | |
5702 which are part of the text that an image rests on.) | |
5703 | |
5704 With argument ARG not nil or 1, move forward ARG - 1 lines first. | |
5705 If point reaches the beginning or end of buffer, it stops there. | |
5706 To ignore intangibility, bind `inhibit-point-motion-hooks' to t. | |
5707 | |
5708 This function does not move point across a field boundary unless that | |
5709 would move point to a different line than the original, unconstrained | |
5710 result. If N is nil or 1, and a front-sticky field starts at point, | |
5711 the 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 | |
5735 which are part of the text that an image rests on.) | |
5736 | |
5737 With argument ARG not nil or 1, move forward ARG - 1 lines first. | |
5738 If point reaches the beginning or end of buffer, it stops there. | |
5739 To ignore intangibility, bind `inhibit-point-motion-hooks' to t. | |
5740 | |
5741 This function does not move point across a field boundary unless that | |
5742 would move point to a different line than the original, unconstrained | |
5743 result. If N is nil or 1, and a rear-sticky field ends at point, | |
5744 the 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." |
5759 (interactive) | 5794 (interactive) |
5760 (if (not bullet) | 5795 (if (not bullet) |
5767 allout-header-prefix | 5802 allout-header-prefix |
5768 "[ \t]*" | 5803 "[ \t]*" |
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: |
5777 ;;; - closes all topics from the first topic to just before the third-to-last, | 5813 ;;; - closes all topics from the first topic to just before the third-to-last, |
5778 ;;; - shows the children of the third to last (config vars) | 5814 ;;; - shows the children of the third to last (config vars) |