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)