diff options
| author | Richard M. Stallman <rms@gnu.org> | 1994-04-30 04:47:22 +0000 |
|---|---|---|
| committer | Richard M. Stallman <rms@gnu.org> | 1994-04-30 04:47:22 +0000 |
| commit | c567ac01779e2ae8e174ec6ca85a239beeff8f66 (patch) | |
| tree | 17807aa204ae056d8c231c46366e094a1e402912 /lisp/allout.el | |
| parent | d0bd3513be11cc78d61a77c73770c371e6fd64a8 (diff) | |
| download | emacs-c567ac01779e2ae8e174ec6ca85a239beeff8f66.tar.gz | |
major code speedups, bug fixes, behavior
refinements, doc-string clarification and elaboration, etc.
Prominent new features include:
- Exposure changes and navigation are greatly accelerated.
- More elaborate and clear doc-string for outline-mode,
giving better guidance on use of the mode.
- A new exposure-layout syntax, which accomodates outlines
with multiple top-level topics. (See `outline-expose' and
`outline-new-exposure'.)
- Automatic exposure and verfication-prompting on attempts to
change text within concealed regions, before they are
applied. (Undo affecting concealed regions is only
exposed, not verified, to facilitate smooth undo sequences.)
- 'hot-spot' navigation implemented. When the cursor is on a
topic's bullet, regular-character keystrokes will be
interepreted as if they were preceded by ^C, when
appropriate, so users can navigate and adjust exposure,
etc, with single-stroke commands.
- Lucid emacs accomodated.
Diffstat (limited to 'lisp/allout.el')
| -rw-r--r-- | lisp/allout.el | 4651 |
1 files changed, 3007 insertions, 1644 deletions
diff --git a/lisp/allout.el b/lisp/allout.el index 269873e4a62..ea1ea5b9dcd 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -1,36 +1,11 @@ -;;;_* Allout - An extensive outline-mode for Emacs. -;;; Note - the lines beginning with ';;;_' are outline topic headers. -;;; Load this file (or 'eval-current-buffer') and revisit the -;;; file to give it a whirl. - -;;;_ + Provide -(provide 'outline) - -;;;_ + Package Identification Stuff - -;;;_ - Author: Ken Manheimer <klm@nist.gov> -;;;_ - Maintainer: Ken Manheimer <klm@nist.gov> -;;;_ - Created: Dec 1991 - first release to usenet -;;;_ - Version: $Id: allout.el,v 1.4 1993/12/23 04:55:44 rms Exp rms $|| -;;;_ - Keywords: outline mode - -;;;_ - LCD Archive Entry - -;; LCD Archive Entry: -;; allout|Ken Manheimer|klm@nist.gov -;; |A more thorough outline-mode -;; |27-May-1993|$Id: allout.el,v 1.4 1993/12/23 04:55:44 rms Exp rms $|| - -;;;_ - Description -;; A full-fledged outline mode, based on the original rudimentary -;; GNU emacs outline functionality. -;; -;; Ken Manheimer Nat'l Inst of Standards and Technology -;; klm@nist.gov (301)975-3539 (Formerly Nat'l Bureau of Standards) -;; NIST Shared File Service Manager and Developer +;; allout.el - An extensive outline-mode for Emacs. +;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. -;;;_ - Copyright -;; Copyright (C) 1992, 1993 Free Software Foundation, Inc. +;; Author: Ken Manheimer <klm@nist.gov> +;; Maintainer: Ken Manheimer <klm@nist.gov> +;; Created: Dec 1991 - first release to usenet +;; Version: $Id: allout.el,v 3.39 1994/03/05 17:39:51 klm Exp klm $|| +;; Keywords: outline mode ;; This file is part of GNU Emacs. @@ -48,228 +23,351 @@ ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;;_ + User Customization variables +;;; Note - the lines beginning with ';;;_' are outline topic headers. +;;; Load this file (or 'eval-current-buffer') and revisit the +;;; file to give it a whirl. -;;;_ - Topic Header configuration +;;;_* Provide +(provide 'outline) -;;;_ = outline-header-prefix +;;;_ + LCD Archive Entry + +;;;_ + Description +;; A full-fledged outline mode, based on the original rudimentary +;; GNU emacs outline functionality. +;; +;;Ken Manheimer 301 975-3539 +;;ken.manheimer@nist.gov FAX: 301 963-9137 +;; +;;Computer Systems and Communications Division +;; +;; Nat'l Institute of Standards and Technology +;; Technology A151 +;; Gaithersburg, MD 20899 + +;;;_* User Customization variables + +;;;_ + Topic Header configuration + +;;;_ = outline-header-prefix (defvar outline-header-prefix "." - "* Leading string for greater than level 0 topic headers.") + "*Outline topic header lines are identified by a leading topic +header prefix, which mostly have the value of this var at their front. +\(Level 1 topics are exceptions. They consist of only a single +character, which is typically set to the outline-primary-bullet.") (make-variable-buffer-local 'outline-header-prefix) -;;;_ = outline-header-subtraction -(defvar outline-header-subtraction (1- (length outline-header-prefix)) - "* Leading string for greater than level 0 topic headers.") -(make-variable-buffer-local 'outline-header-subtraction) - -;;;_ = outline-primary-bullet -(defvar outline-primary-bullet "*") ;; Changing this var disables any - ;; backwards compatibility with - ;; the original outline mode. +;;;_ = outline-mode-leaders +(defvar outline-mode-leaders + '((emacs-lisp-mode . "\;\;\;_") + (lisp-mode . "\;\;\;_") + (awk-mode . "#") + (csh-mode . "#") + (sh-mode . "#") + (tcl-mode . "#") + (perl-mode . "#") + (c++-mode "//_") + (c-mode "/*_")) + "Respective outline-prefix leading strings per major modes. The +strings should begin with a comment string for the mode. Preferably, +they would have an extra character, eg an \"_\" underscore, to +distinguish the lead string from regular comments that start at bol. +\'#'-commented script modes, however, may need to use a bar \'#' in +order for the script magic number \'#!' to serve as the top-level +topic.") + +;;;_ = outline-primary-bullet +(defvar outline-primary-bullet "*" + "Outline topic header lines are identified by a leading topic header +prefix, which is concluded by bullets that includes the value of this +var and the respective outline-*-bullets-string vars. + +The value of an asterisk ('*') provides for backwards compatability +with the original emacs outline mode. See outline-plain-bullets-string +and outline-distinctive-bullets-string for the range of available +bullets.") (make-variable-buffer-local 'outline-primary-bullet) -;;;_ = outline-plain-bullets-string -(defvar outline-plain-bullets-string "" - "* The bullets normally used in outline topic prefixes. See - 'outline-distinctive-bullets-string' for the other kind of - bullets. +;;;_ = outline-plain-bullets-string +(defvar outline-plain-bullets-string (concat outline-primary-bullet + "+-:.;,") + "*The bullets normally used in outline topic prefixes. See +'outline-distinctive-bullets-string' for the other kind of +bullets. - DO NOT include the close-square-bracket, ']', among any bullets. +DO NOT include the close-square-bracket, ']', as a bullet. - You must run 'set-outline-regexp' in order for changes to the - value of this var to effect outline-mode operation.") -(setq outline-plain-bullets-string (concat outline-primary-bullet - "+-:.;,")) +Outline mode has to be reactivated in order for changes to the value +of this var to take effect.") (make-variable-buffer-local 'outline-plain-bullets-string) -;;;_ = outline-distinctive-bullets-string -(defvar outline-distinctive-bullets-string "" - "* The bullets used for distinguishing outline topics. These - bullets are not offered among the regular rotation, and are not - changed when automatically rebulleting, as when shifting the - level of a topic. See 'outline-plain-bullets-string' for the - other kind of bullets. +;;;_ = outline-distinctive-bullets-string +(defvar outline-distinctive-bullets-string "=>([{}&!?#%\"X@$~\\" + "*The bullets used for distinguishing outline topics. These +bullets are not offered among the regular rotation, and are not +changed when automatically rebulleting, as when shifting the +level of a topic. See 'outline-plain-bullets-string' for the +other kind of bullets. - DO NOT include the close-square-bracket, ']', among any bullets. +DO NOT include the close-square-bracket, ']', among any bullets. - You must run 'set-outline-regexp' in order for changes - to the value of this var to effect outline-mode operation.") -(setq outline-distinctive-bullets-string "=>([{}&!?#%\"X@$~") +You must run 'set-outline-regexp' in order for changes +to the value of this var to effect outline-mode operation.") (make-variable-buffer-local 'outline-distinctive-bullets-string) -;;;_ > outline-numbered-bullet () -(defvar outline-numbered-bullet () - "* Bullet signifying outline prefixes which are to be numbered. - Leave it nil if you don't want any numbering, or set it to a - string with the bullet you want to be used.") -(setq outline-numbered-bullet "#") -(make-variable-buffer-local 'outline-numbered-bullet) - -;;;_ = outline-file-xref-bullet -(defvar outline-file-xref-bullet "@" - "* Set this var to the bullet you want to use for file cross-references. - Set it 'nil' if you want to inhibit this capability.") - -;;;_ - Miscellaneous customization - -;;;_ = outline-stylish-prefixes -(defvar outline-stylish-prefixes t - "*A true value for this var makes the topic-prefix creation and modification - functions vary the prefix bullet char according to level. Otherwise, only - asterisks ('*') and distinctive bullets are used. - - This is how an outline can look with stylish prefixes: - - * Top level - .* A topic - . + One level 3 subtopic - . . One level 4 subtopic - . + Another level 3 subtopic - . . A level 4 subtopic - . #2 A distinguished, numbered level 4 subtopic - . ! A distinguished ('!') level 4 subtopic - . #4 Another numbered level 4 subtopic - - This would be an outline with stylish prefixes inhibited: - - * Top level - .* A topic - .! A distinctive (but measly) subtopic - . * A sub-subtopic - no bullets from outline-plain-bullets-string but '*' - - Stylish and constant prefixes (as well as old-style prefixes) are - always respected by the topic maneuvering functions, regardless of - this variable setting. - - The setting of this var is not relevant when outline-old-style-prefixes - is t.") -(make-variable-buffer-local 'outline-stylish-prefixes) - -;;;_ = outline-old-style-prefixes +;;;_ = outline-old-style-prefixes (defvar outline-old-style-prefixes nil - "*Setting this var causes the topic-prefix creation and modification - functions to make only asterix-padded prefixes, so they look exactly - like the old style prefixes. + "*Non-nil restricts the topic creation and modification +functions to asterix-padded prefixes, so they look exactly +like the original emacs-outline style prefixes. - Both old and new style prefixes are always respected by the topic - maneuvering functions.") +Whatever the setting of this variable, both old and new style prefixes +are always respected by the topic maneuvering functions.") (make-variable-buffer-local 'outline-old-style-prefixes) -;;;_ = outline-enwrap-isearch-mode - ; Spiffy dynamic-exposure - ; during searches requires - ; Dan LaLiberte's isearch-mode: -(defvar outline-enwrap-isearch-mode "isearch-mode.el" - "* Set this var to the name of the (non-compiled) elisp code for - isearch-mode, if you have Dan LaLiberte's 'isearch-mode' - stuff and want isearches to reveal hidden stuff encountered in the - course of a search, and reconceal it if you go past. Set it nil if - you don't have the package, or don't want to use this feature.") - -;;;_ = outline-use-hanging-indents -(defvar outline-use-hanging-indents t - "* Set this var non-nil if you have Kyle E Jones' filladapt stuff, - and you want outline to fill topics as hanging indents to the - bullets.") -(make-variable-buffer-local 'outline-use-hanging-indents) - -;;;_ = outline-reindent-bodies -(defvar outline-reindent-bodies t - "* Set this var non-nil if you want topic depth adjustments to - reindent hanging bodies (ie, bodies lines indented to beginning of - heading text). The performance hit is small. +;;;_ = outline-stylish-prefixes - new fangled topic prefixes +(defvar outline-stylish-prefixes t + "*Non-nil allows the topic creation and modification +functions to vary the topic bullet char (the char that marks +the topic depth) just preceding the start of the topic text) +according to level. Otherwise, only asterisks ('*') and +distinctive bullets are used. + +This is how an outline can look with stylish prefixes: + + * Top level + .* A topic + . + One level 3 subtopic + . . One level 4 subtopic + . + Another level 3 subtopic + . . A level 4 subtopic + . #2 A distinguished, numbered level 4 subtopic + . ! A distinguished ('!') level 4 subtopic + . #4 Another numbered level 4 subtopic + + This would be an outline with stylish prefixes inhibited: + + * Top level + .* A topic + .! A distinctive (but measly) subtopic + . * A sub-subtopic - no bullets from outline-plain-bullets-string but '*' + +Stylish and constant prefixes (as well as old-style prefixes) are +always respected by the topic maneuvering functions, regardless of +this variable setting. + +The setting of this var is not relevant when outline-old-style-prefixes +is non-nil.") +(make-variable-buffer-local 'outline-stylish-prefixes) - Avoid this strenuously when using outline mode on program code. - It's great for text, though.") -(make-variable-buffer-local 'outline-reindent-bodies) +;;;_ = outline-numbered-bullet +(defvar outline-numbered-bullet "#" + "*Topics having this bullet have automatic maintainence of a sibling +sequence number tacked on just after the bullet. Conventionally set +to \"#\", you can set it to a bullet of your choice. A nil value +disables numbering maintainence.") +(make-variable-buffer-local 'outline-numbered-bullet) -;;;_ = outline-mode-keys -;;; You have to restart outline-mode - '(outline-mode t)' - to have -;;; any changes take hold. -(defvar outline-mode-keys () - "Assoc list of outline-mode-keybindings, for common reference in setting -up major and minor-mode keybindings.") -(setq outline-mode-keys +;;;_ = outline-file-xref-bullet +(defvar outline-file-xref-bullet "@" + "*Set this var to the bullet you want to use for file cross-references. +Set it 'nil' if you want to inhibit this capability.") + +;;;_ + LaTeX formatting +;;;_ - outline-number-pages +(defvar outline-number-pages nil + "*Non-nil turns on page numbering for LaTeX formatting of an outline.") +;;;_ - outline-label-style +(defvar outline-label-style "\\large\\bf" + "*Font and size of labels for LaTeX formatting of an outline.") +;;;_ - outline-head-line-style +(defvar outline-head-line-style "\\large\\sl " + "*Font and size of entries for LaTeX formatting of an outline.") +;;;_ - outline-body-line-style +(defvar outline-body-line-style " " + "*Font and size of entries for LaTeX formatting of an outline.") +;;;_ - outline-title-style +(defvar outline-title-style "\\Large\\bf" + "*Font and size of titles for LaTeX formatting of an outline.") +;;;_ - outline-title +(defvar outline-title '(or buffer-file-name (current-buffer-name)) + "*Expression to be evaluated to determine the title for LaTeX +formatted copy.") +;;;_ - outline-line-skip +(defvar outline-line-skip ".05cm" + "*Space between lines for LaTeX formatting of an outline.") +;;;_ - outline-indent +(defvar outline-indent ".3cm" + "*LaTeX formatted depth-indent spacing.") + +;;;_ + Miscellaneous customization + +;;;_ = outline-keybindings-list +;;; You have to reactivate outline-mode - '(outline-mode t)' - to +;;; institute changes to this var. +(defvar outline-keybindings-list () + "*List of outline-mode key / function bindings, they will be locally +bound on the outline-mode-map. The keys will be prefixed by +outline-command-prefix unless the cell contains a third, no-nil +element, in which case the initial string will be used as is.") +(setq outline-keybindings-list '( ; Motion commands: - ("\C-c\C-n" outline-next-visible-heading) - ("\C-c\C-p" outline-previous-visible-heading) - ("\C-c\C-u" outline-up-current-level) - ("\C-c\C-f" outline-forward-current-level) - ("\C-c\C-b" outline-backward-current-level) - ("\C-c\C-a" outline-beginning-of-current-entry) - ("\C-c\C-e" outline-end-of-current-entry) + ("?t" outline-latexify-exposed) + ("\C-n" outline-next-visible-heading) + ("\C-p" outline-previous-visible-heading) + ("\C-u" outline-up-current-level) + ("\C-f" outline-forward-current-level) + ("\C-b" outline-backward-current-level) + ("\C-a" outline-beginning-of-current-entry) + ("\C-e" outline-end-of-current-entry) + ;;("\C-n" outline-next-line-or-topic) + ;;("\C-p" outline-previous-line-or-topic) ; Exposure commands: - ("\C-c\C-i" outline-show-current-children) - ("\C-c\C-s" outline-show-current-subtree) - ("\C-c\C-h" outline-hide-current-subtree) - ("\C-c\C-o" outline-show-current-entry) - ("\C-c!" outline-show-all) + ("\C-i" outline-show-children) + ("\C-s" outline-show-current-subtree) + ("\C-h" outline-hide-current-subtree) + ("\C-o" outline-show-current-entry) + ("!" outline-show-all) ; Alteration commands: - ("\C-c " open-sibtopic) - ("\C-c." open-subtopic) - ("\C-c," open-supertopic) - ("\C-c'" outline-shift-in) - ("\C-c>" outline-shift-in) - ("\C-c<" outline-shift-out) - ("\C-c\C-m" outline-rebullet-topic) - ("\C-cb" outline-rebullet-current-heading) - ("\C-c#" outline-number-siblings) - ("\C-k" outline-kill-line) - ("\C-y" outline-yank) - ("\M-y" outline-yank-pop) - ("\C-c\C-k" outline-kill-topic) + (" " outline-open-sibtopic) + ("." outline-open-subtopic) + ("," outline-open-supertopic) + ("'" outline-shift-in) + (">" outline-shift-in) + ("<" outline-shift-out) + ("\C-m" outline-rebullet-topic) + ("b" outline-rebullet-current-heading) + ("#" outline-number-siblings) + ("\C-k" outline-kill-line t) + ("\C-y" outline-yank t) + ("\M-y" outline-yank-pop t) + ("\C-k" outline-kill-topic) ; Miscellaneous commands: - ("\C-c@" outline-resolve-xref) - ("\C-cc" outline-copy-exposed))) + ("\C-@" outline-mark-topic) + ("@" outline-resolve-xref) + ("?c" outline-copy-exposed))) + +;;;_ = outline-command-prefix +(defvar outline-command-prefix "\C-c" + "*Key sequence to be used as prefix for outline mode command key bindings.") -;;;_ + Code - no user customizations below. +;;;_ = outline-enwrap-isearch-mode - any non-nil value fine in Emacs 19. +(defvar outline-enwrap-isearch-mode "isearch-mode.el" + "*Set this var non-nil if you're using Emacs 19 or Lucid emacs, or +you're using Dan LaLiberte's 'isearch-mode' stuff. (If you have +LaLiberte's package available but its' typically loaded, set the +var to the name of the text, not the byte-compiled, load file.) + +The new isearch is required if you want isearches to expose hidden +stuff encountered in the course of a search, and to reconceal it if +you go past. + +Set the var nil if you're not using emacs 19 and you don't have the +elisp-archive package, or if want to disable this feature.") + +;;;_ = outline-use-hanging-indents +(defvar outline-use-hanging-indents t + "*When non-nil, the default auto-indent for text of topic bodies is +set to be even with the leading text of the header. Ie, it is +indented to be just past the header prefix. This is relevant mostly +for use with indented-text-mode, or other situations where auto-fill +occurs. + +[This feature no longer depends in any way on the 'filladapt.el' +lisp-archive package.]") +(make-variable-buffer-local 'outline-use-hanging-indents) -;;;_ #1 Outline Format and Internal Mode Configuration +;;;_ = outline-reindent-bodies +(defvar outline-reindent-bodies outline-use-hanging-indents + "*Set this var non-nil if you want topic depth adjustments to +reindent hanging bodies so they remain even with the beginning +of heading text.") +(make-variable-buffer-local 'outline-reindent-bodies) -;;;_ : Topic header format -;;;_ = outline-regexp +;;;_ = outline-sticky-header-motion +(defvar outline-sticky-header-motion t + "*Non-nil means that outline-{next,previous}-line or topic, bound +to keys typically dedicated to {next,previous}-line, will move by +topics when the cursor is moving from the first character of topic- +header text. You can always move the cursor off of that first-char +\"hot spot\" when you want to do regular next/previous line motions.") +(make-variable-buffer-local 'outline-sticky-header-motion) + +;;;_ = outline-inhibit-protection +(defvar outline-inhibit-protection nil + "*Outline mode uses emacs change-triggered functions (not available +before emacs 19) to detect unruly changes to concealed regions. Set +this var non-nil to disable the protection, potentially increasing +text-entry responsiveness a bit. + +The effect of this var occurs at outline-mode activation, so you may +have to deactivate and then reactivate if you want to toggle the +behavior.") + +;;;_* Code - no user customizations below. + +;;;_ #1 Outline Format, Internal Configuration, and Mode Activation +;;;_ - Topic header format +;;;_ = outline-regexp (defvar outline-regexp "" - "* Regular expression to match the beginning of a heading line. - Any line whose beginning matches this regexp is considered a - heading. This var is set according to the user configuration vars - by set-outline-regexp.") + "*Regular expression to match the beginning of a heading line. +Any line whose beginning matches this regexp is considered a +heading. This var is set according to the user configuration vars +by set-outline-regexp.") (make-variable-buffer-local 'outline-regexp) -;;;_ = outline-bullets-string +;;;_ = outline-bullets-string (defvar outline-bullets-string "" - " A string dictating the valid set of outline topic bullets. This - var should *not* be set by the user - it is set by 'set-outline-regexp', - and is composed from the elements of 'outline-plain-bullets-string' - and 'outline-distinctive-bullets-string'.") + "A string dictating the valid set of outline topic bullets. This +var should *not* be set by the user - it is set by 'set-outline-regexp', +and is composed from the elements of 'outline-plain-bullets-string' +and 'outline-distinctive-bullets-string'.") (make-variable-buffer-local 'outline-bullets-string) -;;;_ = outline-line-boundary-regexp +;;;_ = outline-bullets-string-len +(defvar outline-bullets-string-len 0 + "Length of current buffers' outline-plain-bullets-string.") +(make-variable-buffer-local 'outline-bullets-string-len) +;;;_ = outline-line-boundary-regexp (defvar outline-line-boundary-regexp () - " outline-regexp with outline-style beginning of line anchor (ie, - C-j, *or* C-m, for prefixes of hidden topics). This is properly - set when outline-regexp is produced by 'set-outline-regexp', so - that (match-beginning 2) and (match-end 2) delimit the prefix.") + "outline-regexp with outline-style beginning of line anchor (ie, +C-j, *or* C-m, for prefixes of hidden topics). This is properly +set when outline-regexp is produced by 'set-outline-regexp', so +that (match-beginning 2) and (match-end 2) delimit the prefix.") (make-variable-buffer-local 'outline-line-boundary-regexp) -;;;_ = outline-bob-regexp +;;;_ = outline-bob-regexp (defvar outline-bob-regexp () - " Like outline-line-boundary-regexp, this is an outline-regexp for - outline headers at the beginning of the buffer. (match-beginning 2) - and (match-end 2) - delimit the prefix.") -(make-variable-buffer-local 'outline-line-bob-regexp) -;;;_ > outline-reset-header-lead (header-lead) + "Like outline-line-boundary-regexp, this is an outline-regexp for +outline headers at the beginning of the buffer. (match-beginning 2) +and (match-end 2) delimit the prefix.") +(make-variable-buffer-local 'outline-bob-regexp) +;;;_ = current-bullet +(defvar current-bullet nil + "Variable local to outline-rebullet-heading,but referenced by +outline-make-topic-prefix, also. Should be resolved with explicitly +parameterized communication between the two, if suitable.") +;;;_ = outline-header-subtraction +(defvar outline-header-subtraction (1- (length outline-header-prefix)) + "Length of outline-header prefix to subtract when computing depth +from prefix length.") +(make-variable-buffer-local 'outline-header-subtraction) +;;;_ = outline-plain-bullets-string-len +(defvar outline-plain-bullets-string-len (length outline-plain-bullets-string) + "Length of outline-plain-bullets-string, updated by set-outline-regexp.") +(make-variable-buffer-local 'outline-plain-bullets-string-len) + + +;;;_ > outline-reset-header-lead (header-lead) (defun outline-reset-header-lead (header-lead) - "* Reset the leading string used to identify topic headers." + "*Reset the leading string used to identify topic headers." (interactive "sNew lead string: ") - ;;() (setq outline-header-prefix header-lead) (setq outline-header-subtraction (1- (length outline-header-prefix))) - (set-outline-regexp) - ) -;;;_ > outline-lead-with-comment-string (header-lead) + (set-outline-regexp)) +;;;_ > outline-lead-with-comment-string (header-lead) (defun outline-lead-with-comment-string (&optional header-lead) - "* Set the topic-header leading string to specified string. Useful - when for encapsulating outline structure in programming language - comments. Returns the leading string." + "*Set the topic-header leading string to specified string. Useful +when for encapsulating outline structure in programming language +comments. Returns the leading string." (interactive "P") (if (not (stringp header-lead)) @@ -278,10 +376,10 @@ up major and minor-mode keybindings.") (setq outline-reindent-bodies nil) (outline-reset-header-lead header-lead) header-lead) -;;;_ > set-outline-regexp () +;;;_ > set-outline-regexp () (defun set-outline-regexp () - " Generate proper topic-header regexp form for outline functions, from - outline-plain-bullets-string and outline-distinctive-bullets-string." + "Generate proper topic-header regexp form for outline functions, from +outline-plain-bullets-string and outline-distinctive-bullets-string." (interactive) ;; Derive outline-bullets-string from user configured components: @@ -290,6 +388,7 @@ up major and minor-mode keybindings.") 'outline-distinctive-bullets-string)) cur-string cur-len + cur-char cur-char-string index new-string) @@ -325,157 +424,38 @@ up major and minor-mode keybindings.") outline-primary-bullet "+\\|\^l")) (setq outline-line-boundary-regexp - (concat "\\([\C-j\C-m]\\)\\(" outline-regexp "\\)")) + (concat "\\([\n\r]\\)\\(" outline-regexp "\\)")) (setq outline-bob-regexp (concat "\\(\\`\\)\\(" outline-regexp "\\)")) ) - -;;;_ : Key bindings -;;;_ = Generic minor keybindings control -;;;_ ; Stallman's suggestion -(defvar outline-mode-map nil "") - -(if outline-mode-map - nil - (setq outline-mode-map (nconc (make-sparse-keymap) text-mode-map)) - (define-key outline-mode-map "\C-c\C-n" 'outline-next-visible-heading) - (define-key outline-mode-map "\C-c\C-p" 'outline-previous-visible-heading) - (define-key outline-mode-map "\C-c\C-i" 'show-children) - (define-key outline-mode-map "\C-c\C-s" 'show-subtree) - (define-key outline-mode-map "\C-c\C-h" 'hide-subtree) - (define-key outline-mode-map "\C-c\C-u" 'outline-up-heading) - (define-key outline-mode-map "\C-c\C-f" 'outline-forward-same-level) - (define-key outline-mode-map "\C-c\C-b" 'outline-backward-same-level)) - -(defvar outline-minor-mode nil - "Non-nil if using Outline mode as a minor mode of some other mode.") -(make-variable-buffer-local 'outline-minor-mode) -(put 'outline-minor-mode 'permanent-local t) -(setq minor-mode-alist (append minor-mode-alist - (list '(outline-minor-mode " Outl")))) - -(defvar outline-minor-mode-map nil) -(if outline-minor-mode-map - nil - (setq outline-minor-mode-map (make-sparse-keymap)) - (define-key outline-minor-mode-map "\C-c" - (lookup-key outline-mode-map "\C-c"))) - -(or (assq 'outline-minor-mode minor-mode-map-alist) - (setq minor-mode-map-alist - (cons (cons 'outline-minor-mode outline-minor-mode-map) - minor-mode-map-alist))) - -(defun outline-minor-mode (&optional arg) - "Toggle Outline minor mode. -With arg, turn Outline minor mode on if arg is positive, off otherwise. -See the command `outline-mode' for more information on this mode." - (interactive "P") - (setq outline-minor-mode - (if (null arg) (not outline-minor-mode) - (> (prefix-numeric-value arg) 0))) - (if outline-minor-mode - (progn - (setq selective-display t) - (run-hooks 'outline-minor-mode-hook)) - (setq selective-display nil))) -;;;_ ; minor-bind-keys (keys-assoc) -(defun minor-bind-keys (keys-assoc) - " Establish BINDINGS assoc list in current buffer, returning a list - for subsequent use by minor-unbind-keys to resume overloaded local - bindings." - (interactive) - ;; Cycle thru key list, registering prevailing local binding for key, if - ;; any (for prospective resumption by outline-minor-unbind-keys), then - ;; overloading it with outline-mode one. - (let ((local-map (or (current-local-map) - (make-sparse-keymap))) - key new-func unbinding-registry prevailing-func) - (while keys-assoc - (setq curr-key (car (car keys-assoc))) - (setq new-func (car (cdr (car keys-assoc)))) - (setq prevailing-func (local-key-binding curr-key)) - (if (not (symbolp prevailing-func)) - (setq prevailing-func nil)) - ;; Register key being changed, prevailing local binding, & new binding: - (setq unbinding-registry - (cons (list curr-key (local-key-binding curr-key) new-func) - unbinding-registry)) - ; Make the binding: - - (define-key local-map curr-key new-func) - ; Increment for next iteration: - (setq keys-assoc (cdr keys-assoc))) - ; Establish modified map: - (use-local-map local-map) - ; Return the registry: - unbinding-registry) - ) - -;;;_ ; minor-relinquish-keys (unbinding-registry) -(defun minor-relinquish-keys (unbinding-registry) - " Given registry of MODAL-BINDINGS, as produced by minor-bind-keys, - resume the former local keybindings of those keys that retain the - local bindings set by minor-bind-keys. Changed local bindings are - left alone, so other minor (user or modal) bindings are not disrupted. - - Returns a list of those registrations which were not, because of - tampering subsequent to the registration by minor-bind-keys, resumed." - (interactive) - (let (residue curr-item curr-key curr-resume curr-relinquish) - (while unbinding-registry - (setq curr-item (car unbinding-registry)) - (setq curr-key (car curr-item)) - (setq curr-resume (car (cdr curr-item))) - (setq curr-relinquish (car (cdr (cdr curr-item)))) - (if (equal (local-key-binding curr-key) curr-relinquish) - (if curr-resume - ;; Was a local binding to be resumed - do so: - (local-set-key curr-key curr-resume) - (local-unset-key curr-key)) - ;; Bindings been tampered with since registration - leave it be, and - ;; register so on residue list: - (setq residue (cons residue curr-item))) - (setq unbinding-registry (cdr unbinding-registry))) - residue) - ) -;;;_ = outline-minor-prior-keys -(defvar outline-minor-prior-keys () - "Former key bindings assoc-list, for resumption from outline minor-mode.") -(make-variable-buffer-local 'outline-minor-prior-keys) - - ; Both major and minor mode - ; bindings are dictated by - ; this list - put your - ; settings here. -;;;_ > outline-minor-bind-keys () -(defun outline-minor-bind-keys () - " Establish outline-mode keybindings as MINOR modality of current buffer." - (setq outline-minor-prior-keys - (minor-bind-keys outline-mode-keys))) -;;;_ > outline-minor-relinquish-keys () -(defun outline-minor-relinquish-keys () - " Resurrect local keybindings as they were before outline-minor-bind-keys." - (minor-relinquish-keys outline-minor-prior-keys) -) - -;;;_ : Mode-Specific Variables Maintenance -;;;_ = outline-mode-prior-settings +;;;_ - Key bindings +;;;_ = outline-prior-bindings +(defvar outline-prior-bindings nil + "Variable for use in V18, with outline-added-bindings, for +resurrecting, on mode deactivation, bindings that existed before +activation.") +;;;_ = outline-added-bindings +(defvar outline-added-bindings nil + "Variable for use in V18, with outline-prior-bindings, for +resurrecting, on mode deactivation, bindings that existed before +activation.") +;;;_ - Mode-Specific Variable Maintenance Utilities +;;;_ = outline-mode-prior-settings (defvar outline-mode-prior-settings nil "For internal use by outline mode, registers settings to be resumed on mode deactivation.") (make-variable-buffer-local 'outline-mode-prior-settings) -;;;_ > outline-resumptions (name &optional value) +;;;_ > outline-resumptions (name &optional value) (defun outline-resumptions (name &optional value) - " Registers information for later reference, or performs resumption of - outline-mode specific values. First arg is NAME of variable affected. - optional second arg is list containing outline-mode-specific VALUE to - be impose on named variable, and to be registered. (It's a list so you - can specify registrations of null values.) If no value is specified, - the registered value is returned (encapsulated in the list, so the - caller can distinguish nil vs no value), and the registration is popped - from the list." + "Registers information for later reference, or performs resumption of +outline-mode specific values. First arg is NAME of variable affected. +optional second arg is list containing outline-mode-specific VALUE to +be imposed on named variable, and to be registered. (It's a list so you +can specify registrations of null values.) If no value is specified, +the registered value is returned (encapsulated in the list, so the +caller can distinguish nil vs no value), and the registration is popped +from the list." (let ((on-list (assq name outline-mode-prior-settings)) prior-capsule ; By 'capsule' i mean a list @@ -494,8 +474,9 @@ on mode deactivation.") (cons (list name (if (boundp name) (list (symbol-value name)))) outline-mode-prior-settings))) - ; And impose the new value: - (set name (car value))) + ; And impose the new value, locally: + (progn (make-local-variable name) + (set name (car value)))) ;; Relinquishing: (if (not on-list) @@ -521,25 +502,102 @@ on mode deactivation.") (cdr outline-mode-prior-settings))) (setq outline-mode-prior-settings rebuild))))) ) +;;;_ - Version +;;;_ = outline-version +(defvar outline-version + (let ((rcs-rev "$Revision: 3.39 $")) + (condition-case err + (save-match-data + (string-match "\\$Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev) + (substring rcs-rev (match-beginning 1) (match-end 1))) + (error rcs-rev))) + "Revision number of currently loaded outline package. (Currently +specific to allout.el.)") +;;;_ > outline-version +(defun outline-version (&optional here) + "Return string describing the loaded outline version." + (interactive "P") + (let ((msg (concat "Allout Outline Mode v " outline-version))) + (if here (insert-string msg)) + (message "%s" msg) + msg)) -;;;_ : Overall -;;;_ = outline-mode +;;;_ - Mode activation +;;;_ = outline-mode (defvar outline-mode () "Allout outline mode minor-mode flag.") (make-variable-buffer-local 'outline-mode) -;;;_ > outline-mode (&optional toggle) +;;;_ = outline-mode-map +(defvar outline-mode-map nil "Keybindings for (allout) outline minor mode.") +;;;_ > outline-mode-p () +(defmacro outline-mode-p () + '(and (boundp 'outline-mode) outline-mode)) + +;;;_ = outline-during-write-cue nil +(defvar outline-during-write-cue nil + "Indication, for outline-post-command-business, that we are in the +process of writing a file, and need to inhibit change protection. See +also, outline-write-file-hook, outline-before-change-protect, +outline-post-command-business functions.") + +;;;_ > outline-write-file-hook () +(defun outline-write-file-hook () + "In outline mode, run as a local-write-file-hooks activity. +Currently just sets 'outline-during-write-cue', so outline-change- +protection knows to keep inactive during file write." + (setq outline-during-write-cue t) + nil) + +;;;_ = outline-override-protect nil +(defvar outline-override-protect nil + "In emacs v19 &c, outline-allout mode regulates alteration of concealed text +so it's affected as a unit, or not at all. This is for use by competant +(eg, native outline) functions to temporarily override that protection. It's +automatically reset to nil after every buffer modification.") +(make-variable-buffer-local 'outline-override-protect) +;;;_ > outline-unprotected (expr) +(defmacro outline-unprotected (expr) + "Evaluate EXPRESSION with outline-override-protect +let-bound 't'." + (` (let ((outline-override-protect t)) + (, expr)))) +;;;_ = outline-undo-aggregation +(defvar outline-undo-aggregation 30 + "Amount of successive self-insert actions to bunch together per undo. +This is purely a kludge variable, regulating the compensation for a bug in +the way that before-change-function and undo interact.") +(make-variable-buffer-local 'outline-undo-aggregation) + +;;;_ > produce-outline-mode-map (keymap-alist &optional base-map) +(defun produce-outline-mode-map (keymap-list &optional base-map) + "Produce keymap for use as outline-mode-map, from keymap-list. +Built on top of optional BASE-MAP, or empty sparse map if none specified. +See doc string for outline-keybindings-list for format of binding list." + (let ((map (or base-map (make-sparse-keymap)))) + (mapcar (lambda (cell) + (apply 'define-key map (if (null (cdr (cdr cell))) + (cons (concat outline-command-prefix + (car cell)) + (cdr cell)) + (list (car cell) (car (cdr cell)))))) + keymap-list) + map)) +;;;_ > outline-mode (&optional toggle) +;;;_ . Defun: +(defvar outline-v18/9-file-var-hack nil + "Horrible hack used to prevent invalid multiple triggering of outline +mode from prop-line file-var activation. Used by outline-mode function +to track repeats.") (defun outline-mode (&optional toggle) - " Set minor mode for editing outlines with selective display. - - Look below the description of the bindings for explanation of the - terminology use in outline-mode commands. +;;;_ . Doc string: + "Toggle minor mode for controlling exposure of and editing text +outlines. Optional arg forces mode activation iff arg is positive. - (Note - this is not a proper minor mode, because it does affect key - bindings. It's not too improper, however, because it does resurrect - any bindings which have not been tampered with since it changed them.) +Look below the description of the bindings for explanation of the +terminology use in outline-mode commands. Exposure Commands Movement Commands C-c C-h outline-hide-current-subtree C-c C-n outline-next-visible-heading -C-c C-i outline-show-current-children C-c C-p outline-previous-visible-heading +C-c C-i outline-show-children C-c C-p outline-previous-visible-heading C-c C-s outline-show-current-subtree C-c C-u outline-up-current-level C-c C-o outline-show-current-entry C-c C-f outline-forward-current-level C-c ! outline-show-all C-c C-b outline-backward-current-level @@ -548,9 +606,9 @@ C-c ! outline-show-all C-c C-b outline-backward-current-level Topic Header Generation Commands -C-c<SP> open-sibtopic Create a new sibling after current topic -C-c . open-subtopic ... an offspring of current topic -C-c , open-supertopic ... a sibling of the current topic's parent +C-c<SP> outline-open-sibtopic Create a new sibling after current topic +C-c . outline-open-subtopic ... an offspring of current topic +C-c , outline-open-supertopic ... a sibling of the current topics' parent Level and Prefix Adjustment Commands C-c > outline-shift-in Shift current topic and all offspring deeper @@ -578,153 +636,267 @@ C-c @ outline-resolve-xref pop-to-buffer named by xref (cf C-c c outline-copy-exposed Copy outline sans all hidden stuff to another buffer whose name is derived from the current one - \"XXX exposed\" -M-x outlinify-sticky Activate outline mode for current buffer +M-x outlineify-sticky Activate outline mode for current buffer and establish -*- outline -*- mode specifier as well as file local vars to automatically set exposure. Try it. - Terminology +\\<outline-mode-map> + HOT-SPOT Operation (Not available in Emacs v18.) + +Hot-spot operation enables succinct outline operation. When the +cursor is located on the bullet character of a topic, literal +characters invoke the commands of the corresponding control chars in +the outline-mode keymap. Thus, 'f' would invoke the command bound to +<outline-command-prefix>-\C-f \(typically 'outline-forward-current- +level'). + +Thus, by positioning the cursor on a topic bullet, you can do each of +the outline navigation and manipulation commands with a single +keystroke. Non-literal char do not get this special interpretation, +even on the hot-spot, so you can use them to get off of it, and back +to normal operation. -Topic: A basic cohesive component of an emacs outline, which can - be closed (made hidden), opened (revealed), generated, - traversed, and shifted as units, using outline-mode functions. - A topic is composed of a HEADER, a BODY, and SUBTOPICs (see below). - -Exposure: Hidden (~closed~) topics are represented by ellipses ('...') - at the end of the visible SUPERTOPIC which contains them, - rather than by their actual text. Hidden topics are still - susceptible to editing and regular movement functions, they - just are not displayed normally, effectively collapsed into - the ellipses which represent them. Outline mode provides - the means to selectively expose topics based on their - NESTING. - - SUBTOPICS of a topic can be hidden and subsequently revealed - based on their DEPTH relative to the supertopic from which - the exposure is being done. - - The BODIES of a topic do not generally become visible except - during exposure of entire subtrees (see documentation for - '-current-subtree'), or when the entry is explicitly exposed - with the 'outline-show-entry' function, or (if you have a - special version of isearch installed) when encountered by - incremental searches. - - The CURRENT topic is the more recent visible one before or - including the text cursor. - -Header: The initial portion of an outline topic. It is composed of a - topic header PREFIX at the beginning of the line, followed by - text to the end of the EFFECTIVE LINE. - -Body: Any subsequent lines of text following a topic header and preceding - the next one. This is also referred to as the entry for a topic. - -Prefix: The text which distinguishes topic headers from normal text - lines. There are two forms, both of which start at the beginning - of the topic header (EFFECTIVE) line. The length of the prefix - represents the DEPTH of the topic. The fundamental sort begins - either with solely an asterisk ('*') or else dot ('.') followed - by zero or more spaces and then an outline BULLET. [Note - you - can now designate your own, arbitrary HEADER-LEAD string, by - setting the variable 'outline-header-prefix'.] The second form - is for backwards compatibility with the original emacs outline - mode, and consists solely of asterisks. Both sorts are - recognized by all outline commands. The first sort is generated - by outline topic production commands if the emacs variable - outline-old-style-prefixes is nil, otherwise the second style is - used. - -Bullet: An outline prefix bullet is one of the characters on either - of the outline bullet string vars, 'outline-plain-bullets-string' - and 'outline-distinctive-bullets-string'. (See their - documentation for more details.) The default choice of bullet - for any prefix depends on the DEPTH of the topic. - -Depth and Nesting: - The length of a topic header prefix, from the initial - character to the bullet (inclusive), represents the depth of - the topic. A topic is considered to contain the subsequent - topics of greater depth up to the next topic of the same - depth, and the contained topics are recursively considered to - be nested within all containing topics. Contained topics are - called subtopics. Immediate subtopics are called 'children'. - Containing topics are supertopicsimmediate supertopics are - 'parents'. Contained topics of the same depth are called - siblings. - -Effective line: The regular ascii text in which form outlines are - saved are manipulated in outline-mode to engage emacs' - selective-display faculty. The upshot is that the - effective end of an outline line can be terminated by - either a normal Unix newline char, \n, or the special - outline-mode eol, ^M. This only matters at the user - level when you're doing searches which key on the end of - line character." +Note that the command outline-beginning-of-current-entry \(\\[outline-beginning-of-current-entry]\) +will move to the hot-spot when the cursor is already located at the +beginning of the current entry, so you can simply hit \\[outline-beginning-of-current-entry] +twice in a row to get to the hot-spot. + + Terminology +Topic hierarchy constituents - TOPICS and SUBTOPICS: + +TOPIC: A basic, coherent component of an emacs outline. It can + contain other topics, and it can be subsumed by other topics, +CURRENT topic: + The visible topic most immediately containing the cursor. +DEPTH: The degree of nesting of a topic, it increases with + containment. Also called the +LEVEL: The same as DEPTH. + +ANCESTORS: + The topics that contain a topic. +PARENT: A topic's immediate ancestor. It has a depth one less than + the topic. +OFFSPRING: + The topics contained by a topic, +CHILDREN: + The immediate offspring of a topic. +SIBLINGS: + Topics having the same parent. + +Topic text constituents: + +HEADER: The first line of a topic, include the topic PREFIX and header + text. +PREFIX: The leading text of a topic which which distinguishes it from + normal text. It has a strict form, which consists of a + prefix-lead string, padding, and a bullet. The bullet may be + followed by a number, indicating the ordinal number of the + topic among its siblings, a space, and then the header text. + + The relative length of the PREFIX determines the nesting depth + of the topic. +PREFIX-LEAD: + The string at the beginning of a topic prefix, normally a '.'. + It can be customized by changing the setting of + 'outline-header-prefix' and then reinitializing outline-mode. + + By setting the prefix-lead to the comment-string of a + programming language, you can embed outline-structuring in + program code without interfering with the language processing + of that code. +PREFIX-PADDING: + Spaces or asterisks which separate the prefix-lead and the + bullet, according to the depth of the topic. +BULLET: A character at the end of the topic prefix, it must be one of + the characters listed on 'outline-plain-bullets-string' or + 'outline-distinctive-bullets-string'. (See the documentation + for these variables for more details.) The default choice of + bullet when generating varies in a cycle with the depth of the + topic. +ENTRY: The text contained in a topic before any offspring. +BODY: Same as ENTRY. + + +EXPOSURE: + The state of a topic which determines the on-screen visibility + of its' offspring and contained text. +CONCEALED: + Topics and entry text whose display is inhibited. Contiguous + units of concealed text is represented by '...' ellipses. + (Ref the 'selective-display' var.) + + Concealed topics are effectively collapsed within an ancestor. +CLOSED: A topic whose immediate offspring and body-text is concealed. +OPEN: A topic that is not closed." + +;;;_ . Code (interactive "P") - (let* ((active (and (boundp 'outline-mode) outline-mode)) - (toggle (and toggle - (or (and (listp toggle)(car toggle)) - toggle))) - (explicit-activation (and toggle - (or (symbolp toggle) - (and (natnump toggle) - (not (zerop toggle))))))) - + (let* ((active (and (not (equal major-mode 'outline)) + (outline-mode-p))) + ; Massage universal-arg 'toggle' val: + (toggle (and toggle + (or (and (listp toggle)(car toggle)) + toggle))) + ; Activation specficially demanded? + (explicit-activation (or + ;; + (and toggle + (or (symbolp toggle) + (and (natnump toggle) + (not (zerop toggle))))))) + ;; outline-mode already called once during this complex command? + (same-complex-command (eq outline-v18/9-file-var-hack + (car command-history)))) + + ; See comments below re v19.18,.19 bug. + (setq outline-v18/9-file-var-hack (car command-history)) + (cond - ((and (not explicit-activation) (or active toggle)) - ;; Activation not explicitly requested, and either in active - ;; state or deactivation specifically requested: - (outline-minor-relinquish-keys) + ;; Hitting v19.18, 19.19 bug? + ;; Emacs v 19.18, 19.19 file-var code invokes prop-line-designated + ;; modes twice when file is visited. We have to avoid toggling mode + ;; off on second invocation, so we detect it as best we can, and + ;; skip everything. + ((and same-complex-command ; Still in same complex command + ; as last time outline-mode invoked. + active ; Already activated. + (not explicit-activation) ; Prop-line file-vars don't have args. + (string-match "^19.1[89]" ; Bug only known to be in v19.18 and + emacs-version)); 19.19. + t) + + ;; Deactivate? + ((and (not explicit-activation) + (or active toggle)) + ; Activation not explicitly + ; requested, and either in + ; active state or *de*activation + ; specifically requested: + (if (string-match "^18\." emacs-version) + ; Revoke those keys that remain + ; as we set them: + (let ((curr-loc (current-local-map))) + (mapcar '(lambda (cell) + (if (eq (lookup-key curr-loc (car cell)) + (car (cdr cell))) + (define-key curr-loc (car cell) + (assq (car cell) outline-prior-bindings)))) + outline-added-bindings) + (outline-resumptions 'outline-added-bindings) + (outline-resumptions 'outline-prior-bindings))) + + (if outline-old-style-prefixes + (progn + (outline-resumptions 'outline-primary-bullet) + (outline-resumptions 'outline-old-style-prefixes))) (outline-resumptions 'selective-display) - (outline-resumptions 'indent-tabs-mode) + (if (and (boundp 'before-change-function) before-change-function) + (outline-resumptions 'before-change-function)) + (setq pre-command-hook (delq 'outline-pre-command-business + pre-command-hook)) + (setq post-command-hook (delq 'outline-post-command-business + post-command-hook)) + (setq local-write-file-hooks + (delq 'outline-write-file-hook + local-write-file-hooks)) (outline-resumptions 'paragraph-start) (outline-resumptions 'paragraph-separate) + (outline-resumptions (if (string-match "^18" emacs-version) + 'auto-fill-hook + 'auto-fill-function)) + (outline-resumptions 'outline-former-auto-filler) (setq outline-mode nil)) - ;; Deactivation *not* indicated. + ;; Activate? ((not active) - ;; Not already active - activate: - (outline-minor-bind-keys) - (outline-resumptions 'selective-display '(t)) - (outline-resumptions 'indent-tabs-mode '(nil)) - (or (assq 'outline-mode minor-mode-alist) - (setq minor-mode-alist - (cons '(outline-mode " Outline") minor-mode-alist))) + (if outline-old-style-prefixes + (progn ; Inhibit all the fancy formatting: + (outline-resumptions 'outline-primary-bullet '("*")) + (outline-resumptions 'outline-old-style-prefixes '(())))) (set-outline-regexp) - + ; Produce map from current version + ; of outline-keybindings-list: + (if (boundp 'minor-mode-map-alist) + + (progn ; V19, and maybe lucid and + ; epoch, minor-mode key bindings: + (setq outline-mode-map + (produce-outline-mode-map outline-keybindings-list)) + (fset 'outline-mode-map outline-mode-map) + ; Include on minor-mode-map-alist, + ; if not already there: + (if (not (member '(outline-mode . outline-mode-map) + minor-mode-map-alist)) + (setq minor-mode-map-alist + (cons '(outline-mode . outline-mode-map) + minor-mode-map-alist)))) + + ; V18 minor-mode key bindings: + ; Stash record of added bindings + ; for later revocation: + (outline-resumptions 'outline-added-bindings + (list outline-keybindings-list)) + (outline-resumptions 'outline-prior-bindings + (list (current-local-map))) + ; and add them: + (use-local-map (produce-outline-mode-map outline-keybindings-list + (current-local-map))) + ) + + ; selective-display is the + ; emacs conditional exposure + ; mechanism: + (outline-resumptions 'selective-display '(t)) + (if outline-inhibit-protection + t + (outline-resumptions 'before-change-function + '(outline-before-change-protect))) + (add-hook 'post-command-hook 'outline-post-command-business) + (add-hook 'pre-command-hook 'outline-pre-command-business) + ; Temporarily set by any outline + ; functions that can be trusted to + ; deal properly with concealed text. + (add-hook 'local-write-file-hooks 'outline-write-file-hook) + ; Custom auto-fill func, to support + ; respect for topic headline, + ; hanging-indents, etc: + (let* ((fill-func-var (if (string-match "^18" emacs-version) + 'auto-fill-hook + 'auto-fill-function)) + (fill-func (symbol-value fill-func-var))) + ;; Register prevailing fill func for use by outline-auto-fill: + (outline-resumptions 'outline-former-auto-filler (list fill-func)) + ;; Register outline-auto-fill to be used if filling is active: + (outline-resumptions fill-func-var '(outline-auto-fill))) + ;; Paragraphs are broken by topic headlines. (make-local-variable 'paragraph-start) (outline-resumptions 'paragraph-start - (list (concat paragraph-start "\\|^\\(" - outline-regexp "\\)"))) + (list (concat paragraph-start "\\|^\\(" + outline-regexp "\\)"))) (make-local-variable 'paragraph-separate) (outline-resumptions 'paragraph-separate - (list (concat paragraph-separate "\\|^\\(" - outline-regexp "\\)"))) + (list (concat paragraph-separate "\\|^\\(" + outline-regexp "\\)"))) + + (or (assq 'outline-mode minor-mode-alist) + (setq minor-mode-alist + (cons '(outline-mode " Outl") minor-mode-alist))) (if outline-enwrap-isearch-mode - (outline-enwrap-isearch)) - (if (and outline-use-hanging-indents - (boundp 'filladapt-prefix-table)) - ;; Add outline-prefix recognition to filladapt - not standard: - (progn (setq filladapt-prefix-table - (cons (cons (concat "\\(" outline-regexp "\\) ") - 'filladapt-hanging-list) - filladapt-prefix-table)) - (setq filladapt-hanging-list-prefixes - (cons outline-regexp - filladapt-hanging-list-prefixes)))) + (outline-enwrap-isearch)) (run-hooks 'outline-mode-hook) (setq outline-mode t)) - ) ; cond - ) ; let* - ) ; defun + ) ; cond + outline-mode + ) ; let* + ) ; defun -;;;_ #2 Internal Position State-Tracking Variables +;;;_ #2 Internal Position State-Tracking Variables ;;; All basic outline functions which directly do string matches to ;;; evaluate heading prefix location set the variables ;;; outline-recent-prefix-beginning and outline-recent-prefix-end when @@ -732,404 +904,387 @@ Effective line: The regular ascii text in which form outlines are ;;; this state, providing the means to avoid redundant searches for ;;; just established data. This optimization can provide significant ;;; speed improvement, but it must be employed carefully. -;;;_ = outline-recent-prefix-beginning +;;;_ = outline-recent-prefix-beginning (defvar outline-recent-prefix-beginning 0 - " Buffer point of the start of the last topic prefix encountered.") + "Buffer point of the start of the last topic prefix encountered.") (make-variable-buffer-local 'outline-recent-prefix-beginning) -;;;_ = outline-recent-prefix-end +;;;_ = outline-recent-prefix-end (defvar outline-recent-prefix-end 0 - " Buffer point of the end of the last topic prefix encountered.") + "Buffer point of the end of the last topic prefix encountered.") (make-variable-buffer-local 'outline-recent-prefix-end) - -;;;_ #3 Exposure Control - -;;;_ : Fundamental -;;;_ > outline-flag-region (from to flag) -(defun outline-flag-region (from to flag) - " Hides or shows lines from FROM to TO, according to FLAG. - Uses emacs selective-display, where text is show if FLAG put at - beginning of line is `\\n' (newline character), while text is - hidden if FLAG is `\\^M' (control-M). - - returns nil iff no changes were effected." - (let ((buffer-read-only nil)) - (subst-char-in-region from to - (if (= flag ?\n) ?\^M ?\n) - flag t))) -;;;_ > outline-flag-current-subtree (flag) -(defun outline-flag-current-subtree (flag) - (save-excursion - (outline-back-to-current-heading) - (outline-flag-region (point) - (progn (outline-end-of-current-subtree) (point)) - flag))) - -;;;_ : Topic-specific -;;;_ > outline-hide-current-entry () -(defun outline-hide-current-entry () - "Hide the body directly following this heading." - (interactive) - (outline-back-to-current-heading) - (save-excursion - (outline-flag-region (point) - (progn (outline-end-of-current-entry) (point)) - ?\^M))) -;;;_ > outline-show-current-entry (&optional arg) -(defun outline-show-current-entry (&optional arg) - "Show body directly following this heading, or hide it if repeat count." - (interactive "P") - (if arg - (outline-hide-current-entry) - (save-excursion - (outline-flag-region (point) - (progn (outline-end-of-current-entry) (point)) - ?\n)))) -;;;_ > outline-show-entry () -; outline-show-entry basically for isearch dynamic exposure, as is... -(defun outline-show-entry () - " Like outline-show-current-entry, but reveals an entry that is nested - within hidden topics." - (interactive) - (save-excursion - (outline-goto-prefix) - (outline-flag-region (if (not (bobp)) (1- (point)) (point)) - (progn (outline-pre-next-preface) (point)) ?\n))) -;;;_ > outline-hide-current-entry-completely () -; ... outline-hide-current-entry-completely also for isearch dynamic exposure: -(defun outline-hide-current-entry-completely () - "Like outline-hide-current-entry, but conceal topic completely." - (interactive) - (save-excursion - (outline-goto-prefix) - (outline-flag-region (if (not (bobp)) (1- (point)) (point)) - (progn (outline-pre-next-preface) - (if (looking-at "\C-m") - (point) - (1- (point)))) - ?\C-m))) -;;;_ > outline-show-current-subtree () -(defun outline-show-current-subtree () - "Show everything after this heading at deeper levels." - (interactive) - (outline-flag-current-subtree ?\n)) -;;;_ > outline-hide-current-subtree (&optional just-close) -(defun outline-hide-current-subtree (&optional just-close) - - " Hide everything after this heading at deeper levels, or if it's - already closed, and optional arg JUST-CLOSE is nil, hide the current - level." - - (interactive) - (let ((orig-eol (save-excursion - (end-of-line)(outline-goto-prefix)(end-of-line)(point)))) - (outline-flag-current-subtree ?\^M) - (if (and (= orig-eol (save-excursion (goto-char orig-eol) - (end-of-line) - (point))) - ;; Structure didn't change - try hiding current level: - (if (not just-close) - (outline-up-current-level 1 t))) - (outline-hide-current-subtree)))) -;;;_ > outline-show-current-branches () -(defun outline-show-current-branches () - "Show all subheadings of this heading, but not their bodies." - (interactive) - (outline-show-current-children 1000)) -;;;_ > outline-hide-current-leaves () -(defun outline-hide-current-leaves () - "Hide all body after this heading at deeper levels." - (interactive) - (outline-back-to-current-heading) - (outline-hide-region-body (point) (progn (outline-end-of-current-subtree) - (point)))) -;;;_ > outline-show-current-children (&optional level) -(defun outline-show-current-children (&optional level) - " Show all direct subheadings of this heading. Optional LEVEL specifies - how many levels below the current level should be shown." - (interactive "p") - (or level (setq level 1)) - (save-excursion - (save-restriction - (beginning-of-line) - (setq level (+ level (progn (outline-back-to-current-heading) - (outline-recent-depth)))) - (narrow-to-region (point) - (progn (outline-end-of-current-subtree) (1+ (point)))) - (goto-char (point-min)) - (while (and (not (eobp)) - (outline-next-heading)) - (if (<= (outline-recent-depth) level) - (save-excursion - (let ((end (1+ (point)))) - (forward-char -1) - (if (memq (preceding-char) '(?\n ?\^M)) - (forward-char -1)) - (outline-flag-region (point) end ?\n)))))))) - -;;;_ : Region and beyond -;;;_ > outline-show-all () -(defun outline-show-all () - "Show all of the text in the buffer." - (interactive) - (outline-flag-region (point-min) (point-max) ?\n)) -;;;_ > outline-hide-bodies () -(defun outline-hide-bodies () - "Hide all of buffer except headings." - (interactive) - (outline-hide-region-body (point-min) (point-max))) -;;;_ > outline-hide-region-body (start end) -(defun outline-hide-region-body (start end) - "Hide all body lines in the region, but not headings." - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (while (not (eobp)) - (outline-flag-region (point) - (progn (outline-pre-next-preface) (point)) ?\^M) - (if (not (eobp)) - (forward-char - (if (looking-at "[\n\^M][\n\^M]") - 2 1))))))) -;;;_ > outline-expose () -(defun outline-expose (spec &rest followers) - - "Dictate wholesale exposure scheme for current topic, according to SPEC. - -SPEC is either a number or a list of specs. Optional successive args -dictate exposure for subsequent siblings of current topic. - -Numbers, the symbols '*' and '+', and the null list dictate different -exposure depths for the corresponding topic. Numbers indicate the -depth to open, with negative numbers first forcing a close, and then -opening to their absolute value. Positive numbers jsut reopen, and 0 -just closes. '*' completely opens the topic, including bodies, and -'+' shows all the sub headers, but not the bodies. - -If the spec is a list, the first element must be a number which -dictates the exposure depth of the topic as a whole. Subsequent -elements of the list are nested SPECs, dictating the specific exposure -for the corresponding offspring of the topic, as the SPEC as a whole -does for the parent topic. - -Optional FOLLOWER elements dictate exposure for subsequent siblings -of the parent topic." - - (interactive "xExposure spec: ") - (save-excursion - (let ((start-point (progn (outline-goto-prefix)(point))) - done) - (cond ((null spec) nil) - ((symbolp spec) - (if (eq spec '*) (outline-show-current-subtree)) - (if (eq spec '+) (outline-show-current-branches))) - ((numberp spec) - (if (zerop spec) - ;; Just hide if zero: - (outline-hide-current-subtree t) - (if (> 0 spec) - ;; Close before opening if negative: - (progn (outline-hide-current-subtree) - (setq spec (* -1 spec)))) - (outline-show-current-children spec))) - ((listp spec) - (outline-expose (car spec)) - (if (and (outline-descend-to-depth (+ (outline-current-depth) 1)) - (not (outline-hidden-p))) - (while (and (setq spec (cdr spec)) - (not done)) - (outline-expose (car spec)) - (setq done (not (outline-next-sibling))))))))) - (while (and followers (outline-next-sibling)) - (outline-expose (car followers)) - (setq followers (cdr followers))) - ) -;;;_ > outline-exposure '() -(defmacro outline-exposure (&rest spec) - " Literal frontend for 'outline-expose', passes arguments unevaluated, - so you needn't quote them." - (cons 'outline-expose (mapcar '(lambda (x) (list 'quote x)) spec))) - -;;;_ #4 Navigation - -;;;_ : Position Assessment - -;;;_ . Residual state - from most recent outline context operation. -;;;_ > outline-recent-depth () -(defun outline-recent-depth () - " Return depth of last heading encountered by an outline maneuvering - function. - - All outline functions which directly do string matches to assess - headings set the variables outline-recent-prefix-beginning and - outline-recent-prefix-end if successful. This function uses those settings - to return the current depth." - - (max 1 - (- outline-recent-prefix-end - outline-recent-prefix-beginning - outline-header-subtraction))) -;;;_ > outline-recent-prefix () -(defun outline-recent-prefix () - " Like outline-recent-depth, but returns text of last encountered prefix. - - All outline functions which directly do string matches to assess - headings set the variables outline-recent-prefix-beginning and - outline-recent-prefix-end if successful. This function uses those settings - to return the current depth." - (buffer-substring outline-recent-prefix-beginning outline-recent-prefix-end)) -;;;_ > outline-recent-bullet () -(defun outline-recent-bullet () - " Like outline-recent-prefix, but returns bullet of last encountered - prefix. - - All outline functions which directly do string matches to assess - headings set the variables outline-recent-prefix-beginning and - outline-recent-prefix-end if successful. This function uses those settings - to return the current depth of the most recently matched topic." - (buffer-substring (1- outline-recent-prefix-end) outline-recent-prefix-end)) - -;;;_ . Active position evaluation - if you can't use the residual state. -;;;_ > outline-on-current-heading-p () +;;;_ > outline-prefix-data (beg end) +(defmacro outline-prefix-data (beg end) + "Register outline-prefix state data - BEGINNING and END of prefix - +for reference by 'outline-recent' funcs. Returns BEGINNING." + (` (setq outline-recent-prefix-end (, end) + outline-recent-prefix-beginning (, beg)))) +;;;_ > outline-recent-depth () +(defmacro outline-recent-depth () + "Return depth of last heading encountered by an outline maneuvering +function. + +All outline functions which directly do string matches to assess +headings set the variables outline-recent-prefix-beginning and +outline-recent-prefix-end if successful. This function uses those settings +to return the current depth." + + '(max 1 (- outline-recent-prefix-end + outline-recent-prefix-beginning + outline-header-subtraction))) +;;;_ > outline-recent-prefix () +(defmacro outline-recent-prefix () + "Like outline-recent-depth, but returns text of last encountered prefix. + +All outline functions which directly do string matches to assess +headings set the variables outline-recent-prefix-beginning and +outline-recent-prefix-end if successful. This function uses those settings +to return the current depth." + '(buffer-substring outline-recent-prefix-beginning + outline-recent-prefix-end)) +;;;_ > outline-recent-bullet () +(defmacro outline-recent-bullet () + "Like outline-recent-prefix, but returns bullet of last encountered +prefix. + +All outline functions which directly do string matches to assess +headings set the variables outline-recent-prefix-beginning and +outline-recent-prefix-end if successful. This function uses those settings +to return the current depth of the most recently matched topic." + '(buffer-substring (1- outline-recent-prefix-end) + outline-recent-prefix-end)) + +;;;_ #3 Navigation + +;;;_ - Position Assessment +;;;_ : Location Predicates +;;;_ > outline-on-current-heading-p () (defun outline-on-current-heading-p () - " Return prefix beginning point if point is on same line as current - visible topic's header line." + "Return prefix beginning point if point is on same line as current +visible topics' header line." (save-excursion (beginning-of-line) (and (looking-at outline-regexp) - (setq outline-recent-prefix-end (match-end 0) - outline-recent-prefix-beginning (match-beginning 0))))) -;;;_ > outline-hidden-p () -(defun outline-hidden-p () + (outline-prefix-data (match-beginning 0) (match-end 0))))) +;;;_ > outline-e-o-prefix-p () +(defun outline-e-o-prefix-p () + "True if point is located where current topic prefix ends, heading +begins." + (and (save-excursion (beginning-of-line) + (looking-at outline-regexp)) + (= (point)(save-excursion (outline-end-of-prefix)(point))))) +;;;_ > outline-hidden-p () +(defmacro outline-hidden-p () "True if point is in hidden text." + '(save-excursion + (and (re-search-backward "[\n\r]" () t) + (= ?\r (following-char))))) +;;;_ > outline-visible-p () +(defmacro outline-visible-p () + "True if point is not in hidden text." (interactive) - (save-excursion - (and (re-search-backward "[\C-j\C-m]" (point-min) t) - (looking-at "\C-m")))) -;;;_ > outline-current-depth () -(defun outline-current-depth () - " Return the depth to which the current containing visible topic is - nested in the outline." - (save-excursion - (if (outline-back-to-current-heading) - (max 1 - (- outline-recent-prefix-end - outline-recent-prefix-beginning - outline-header-subtraction)) - 0))) -;;;_ > outline-depth () -(defun outline-depth () - " Like outline-current-depth, but respects hidden as well as visible - topics." - (save-excursion - (if (outline-goto-prefix) - (outline-recent-depth) - (progn - (setq outline-recent-prefix-end (point) - outline-recent-prefix-beginning (point)) - 0)))) -;;;_ > outline-get-current-prefix () + '(not (outline-hidden-p))) +;;;_ : Location attributes +;;;_ > outline-depth () +(defmacro outline-depth () + "Like outline-current-depth, but respects hidden as well as visible +topics." + '(save-excursion + (if (outline-goto-prefix) + (outline-recent-depth) + (progn + ;; Oops, no prefix, zero prefix data: + (outline-prefix-data (point)(point)) + ;; ... and return 0: + 0)))) +;;;_ > outline-current-depth () +(defmacro outline-current-depth () + "Return the depth to which the current containing visible topic is +nested in the outline." + '(save-excursion + (if (outline-back-to-current-heading) + (max 1 + (- outline-recent-prefix-end + outline-recent-prefix-beginning + outline-header-subtraction)) + 0))) +;;;_ > outline-get-current-prefix () (defun outline-get-current-prefix () - " Topic prefix of the current topic." + "Topic prefix of the current topic." (save-excursion (if (outline-goto-prefix) - (outline-recent-prefix)))) -;;;_ > outline-get-bullet () + (outline-recent-prefix)))) +;;;_ > outline-get-bullet () (defun outline-get-bullet () - " Return bullet of containing topic (visible or not)." + "Return bullet of containing topic (visible or not)." (save-excursion (and (outline-goto-prefix) - (outline-recent-bullet)))) -;;;_ > outline-current-bullet () + (outline-recent-bullet)))) +;;;_ > outline-current-bullet () (defun outline-current-bullet () - " Return bullet of current (visible) topic heading, or none if none found." + "Return bullet of current (visible) topic heading, or none if none found." (condition-case err (save-excursion - (outline-back-to-current-heading) - (buffer-substring (- outline-recent-prefix-end 1) - outline-recent-prefix-end)) + (outline-back-to-current-heading) + (buffer-substring (- outline-recent-prefix-end 1) + outline-recent-prefix-end)) ;; Quick and dirty provision, ostensibly for missing bullet: (args-out-of-range nil)) ) -;;;_ > outline-get-prefix-bullet (prefix) +;;;_ > outline-get-prefix-bullet (prefix) (defun outline-get-prefix-bullet (prefix) - " Return the bullet of the header prefix string PREFIX." + "Return the bullet of the header prefix string PREFIX." ;; Doesn't make sense if we're old-style prefixes, but this just ;; oughtn't be called then, so forget about it... (if (string-match outline-regexp prefix) (substring prefix (1- (match-end 0)) (match-end 0)))) -;;;_ : Within Topic -;;;_ > outline-goto-prefix () +;;;_ - Navigation macros +;;;_ > outline-next-heading () +(defmacro outline-next-heading () + "Move to the heading for the topic \(possibly invisible) before this one. + +Returns the location of the heading, or nil if none found." + + '(if (and (bobp) (not (eobp))) + (forward-char 1)) + + '(if (re-search-forward outline-line-boundary-regexp nil 0) + (progn ; Got valid location state - set vars: + (outline-prefix-data + (goto-char (or (match-beginning 2) + outline-recent-prefix-beginning)) + (or (match-end 2) outline-recent-prefix-end))))) +;;;_ > outline-previous-heading () +(defmacro outline-previous-heading () + "Move to the next \(possibly invisible) heading line. + +Return the location of the beginning of the heading, or nil if not found." + + '(if (bobp) + nil + (outline-goto-prefix) + (if + ;; searches are unbounded and return nil if failed: + (or (re-search-backward outline-line-boundary-regexp nil 0) + (looking-at outline-bob-regexp)) + (progn;; Got some valid location state - set vars: + (outline-prefix-data + (goto-char (or (match-beginning 2) + outline-recent-prefix-beginning)) + (or (match-end 2) outline-recent-prefix-end)))))) + +;;;_ - Subtree Charting +;;;_ " These routines either produce or assess charts, which are +;;; nested lists of the locations of topics within a subtree. +;;; +;;; Use of charts enables efficient navigation of subtrees, by +;;; requiring only a single regexp-search based traversal, to scope +;;; out the subtopic locations. The chart then serves as the basis +;;; for whatever assessment or adjustment of the subtree that is +;;; required, without requiring redundant topic-traversal procedures. + +;;;_ > outline-chart-subtree (&optional orig-level prev-level) +(defun outline-chart-subtree (&optional orig-level prev-level) + "Produce a location 'chart' of subtopics of the containing topic. +The entries for each immediate child consists of an integer for the +point of the beginning of the topic, followed by a 'chart' of the +immediate offspring of the subtopic, if any. + +Use of charts enables efficient navigation of subtrees, by requiring +only a single regexp-search based traversal, to scope out the subtopic +locations. The chart then serves as the basis for whatever assessment +or adjustment of the subtree that is required, without requiring +redundant topic-traversal procedures. + +The function parameters are for internal recursion, and should not be +designated by external callers." + + ;; We're constantly looking ahead. Impressive, huh? + + (let ((original (not orig-level)) ; 'here' passed only during recursion. + chart here level) + ; Initialize if not passed in: + (if original + (progn (setq orig-level (outline-depth)) + (outline-next-heading))) + ; Consider only contents of orig topic: + (if (not prev-level) + (setq prev-level (1+ orig-level))) + + ;; Loop, rather than recurse, over the current levels' siblings, to + ;; avoid overloading the typically quite constrained emacs max-lisp- + ;; eval-depth. + (while (and (not (eobp)) + (< orig-level (setq level (outline-recent-depth))) + ; Still within original topic: + (cond ((= prev-level level) + (setq chart ; Register this one and move on: + (cons (point) chart)) + (outline-next-heading)) + + ((< prev-level level) ; Do higher level, then + ; continue with this one: + (setq chart (cons (outline-chart-subtree orig-level + level) + chart)))))) + + (if original ; We're at the end of the level... + ; Position to the end of the branch: + (progn (and (not (eobp)) (forward-char -1)) + (and (memq (preceding-char) '(?\n ?\^M)) + (memq (aref (buffer-substring (max 1 (- (point) 3)) + (point)) + 1) + '(?\n ?\^M)) + (forward-char -1)))) + + chart ; (nreverse chart) not necessary, + ; and maybe not preferable. + )) +;;;_ > outline-chart-topic (&optional orig-level prev-level) +(defmacro outline-chart-topic () + "Return a location 'chart' for the current topic and its subtopics,if any. +See 'outline-chart-subtree' for an explanation of charts." + + '(if (outline-goto-prefix) + (let ((here (point)) + (subtree (outline-chart-subtree orig-level prev-level))) + (if subtree + (list here subtree) + (list here))))) +;;;_ > outline-chart-siblings (&optional start end) +(defun outline-chart-siblings (&optional start end) + "Produce a list of locations of this and succeeding sibling topics. +Effectively a top-level chart of siblings. See 'outline-chart-subtree' +for an explanation of charts." + (save-excursion + (if (outline-goto-prefix) + (let ((chart (list (point)))) + (while (outline-next-sibling) + (setq chart (cons (point) chart))) + (if chart (setq chart (nreverse chart)))))) + ) +;;;_ > outline-chart-to-reveal (chart depth) +(defun outline-chart-to-reveal (chart depth) + + "Return a flat list of the points in subtree CHART, up to DEPTH, which +are hidden. + +Note that point can wind up at any of the points on chart, or at the +start point." + + (let (result here) + (while (and (or (eq depth t) (> depth 0)) + chart) + (setq here (car chart)) + (if (listp here) + (let ((further (outline-chart-to-reveal here (or (eq depth t) + (1- depth))))) + ;; We're on the start of a subtree - recurse with it, if there's + ;; more depth to go: + (if further (setq result (append further result))) + (setq chart (cdr chart))) + (goto-char here) + (if (= (preceding-char) ?\r) + (setq result (cons here result))) + (setq chart (cdr chart)))) + result)) +;;;_ > outline-chart-spec (chart spec &optional exposing) +(defun outline-chart-spec (chart spec &optional exposing) + "Given a topic/subtree CHART and an exposure SPEC, produce a list of +exposure directive, indicating the locations to be exposed and the +prescribed exposure status. Optional arg EXPOSING is an integer, with +0 indicating pending concealment, anything higher indicating depth to +which subtopic headers should be exposed, and negative numbers +indicating (negative of) the depth to which subtopic headers and +bodies should be exposed. + +The produced list can have two types of entries. Bare numbers +indicate points in the buffer where topic headers that should be +exposed reside. + - bare negative numbers indicates that the topic starting at the + point which is the negative of the number should be opened, + including their entries. + - bare positive values indicate that this topic header should be + openned. + - Lists signify the beginning and end points of regions that should + be flagged, and the flag to employ. (For concealment: '\(\?r\)', and + exposure:" + (while spec + (cond ((listp spec) + ) + ) + (setq spec (cdr spec))) + ) + +;;;_ - Within Topic +;;;_ > outline-goto-prefix () (defun outline-goto-prefix () - " Put point at beginning of outline prefix for current topic, visible - or not. - - Returns a list of char address of the beginning of the prefix and the - end of it, or nil if none." - - (cond ((and (or (save-excursion (beginning-of-line) (bobp)) - (memq (preceding-char) '(?\n ?\^M))) - (looking-at outline-regexp)) - (setq outline-recent-prefix-end (match-end 0) - outline-recent-prefix-beginning - (goto-char (match-beginning 0)))) - ((re-search-backward outline-line-boundary-regexp - ;; unbounded search, - ;; stay at limit and return nil if failed: - nil 1) - (setq outline-recent-prefix-end (match-end 2) - outline-recent-prefix-beginning - (goto-char (match-beginning 2)))) - ;; We should be at the beginning of the buffer if the last - ;; condition failed. line-boundary-regexp doesn't cover topic - ;; at bob - Check for it. - ((looking-at outline-regexp) - (setq outline-recent-prefix-end (match-end 0) - outline-recent-prefix-beginning - (goto-char (match-beginning 0))))) - ) -;;;_ > outline-end-of-prefix () -(defun outline-end-of-prefix () - " Position cursor at beginning of header text." + "Put point at beginning of outline prefix for immediately containing +topic, visible or not. + +Returns a the point at the beginning of the prefix, or nil if none." + + (if (= (point-min)(point-max)) + nil + (let (done) + (while (and (not done) + (re-search-backward "[\n\r]" nil 1)) + (forward-char 1) + (if (looking-at outline-regexp) + (setq done (outline-prefix-data (match-beginning 0) + (match-end 0))) + (forward-char -1))) + (if (and (bobp) + (looking-at outline-regexp)) + (outline-prefix-data (match-beginning 0)(match-end 0)) + done)))) +;;;_ > outline-end-of-prefix () +(defun outline-end-of-prefix (&optional ignore-decorations) + "Position cursor at beginning of header text, or just after bullet +if optional IGNORE-DECORATIONS non-nil." + (if (not (outline-goto-prefix)) nil (let ((match-data (match-data))) (goto-char (match-end 0)) - (while (looking-at "[0-9]") (forward-char 1)) - (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1)) + (if ignore-decorations + t + (while (looking-at "[0-9]") (forward-char 1)) + (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1))) (store-match-data match-data)) ;; Reestablish where we are: - (outline-current-depth)) - ) -;;;_ > outline-back-to-current-heading () + (outline-current-depth))) +;;;_ > outline-current-bullet-pos () +(defun outline-current-bullet-pos () + "Return position of current \(visible) topic's bullet." + + (if (not (outline-current-depth)) + nil + (1- (match-end 0)))) +;;;_ > outline-back-to-current-heading () (defun outline-back-to-current-heading () - " Move to heading line of current visible topic, or beginning of heading - if already on visible heading line." + "Move to heading line of current visible topic, or beginning of heading +if already on visible heading line." (beginning-of-line) (prog1 (or (outline-on-current-heading-p) (and (re-search-backward (concat "^\\(" outline-regexp "\\)") nil 'move) - (setq outline-recent-prefix-end (match-end 1) - outline-recent-prefix-beginning (match-beginning 1)))) - (if (interactive-p) (outline-end-of-prefix)) - ) - ) -;;;_ > outline-pre-next-preface () + (outline-prefix-data (match-beginning 1)(match-end 1)))) + (if (interactive-p) (outline-end-of-prefix)))) +;;;_ > outline-pre-next-preface () (defun outline-pre-next-preface () "Skip forward to just before the next heading line. - Returns that character position." +Returns that character position." (if (re-search-forward outline-line-boundary-regexp nil 'move) - (progn (goto-char (match-beginning 0)) - (setq outline-recent-prefix-end (match-end 2) - outline-recent-prefix-beginning (match-beginning 2)))) - ) -;;;_ > outline-end-of-current-subtree () + (prog1 (goto-char (match-beginning 0)) + (outline-prefix-data (match-beginning 2)(match-end 2))))) +;;;_ > outline-end-of-current-subtree () (defun outline-end-of-current-subtree () - " Put point at the end of the last leaf in the currently visible topic." + "Put point at the end of the last leaf in the currently visible topic." (interactive) (outline-back-to-current-heading) (let ((opoint (point)) @@ -1138,16 +1293,28 @@ of the parent topic." (while (and (not (eobp)) (> (outline-recent-depth) level)) (outline-next-heading)) - (if (not (eobp)) (forward-char -1)) - (if (memq (preceding-char) '(?\n ?\^M)) (forward-char -1)))) -;;;_ > outline-beginning-of-current-entry () + (and (not (eobp)) (forward-char -1)) + (and (memq (preceding-char) '(?\n ?\^M)) + (memq (aref (buffer-substring (max 1 (- (point) 3)) (point)) 1) + '(?\n ?\^M)) + (forward-char -1)) + (point))) +;;;_ > outline-beginning-of-current-entry () (defun outline-beginning-of-current-entry () - " Position the point at the beginning of the body of the current topic." + "When not already there, position the point at the beginning of the +body of the current topic. + +If already there, move cursor to bullet for hot-spot operation. +\(See outline-mode doc string for details on hot-spot operation.)" (interactive) - (outline-end-of-prefix)) -;;;_ > outline-beginning-of-current-entry () + (let ((start-point (point))) + (outline-end-of-prefix) + (if (and (interactive-p) + (= (point) start-point)) + (goto-char (outline-current-bullet-pos))))) +;;;_ > outline-end-of-current-entry () (defun outline-end-of-current-entry () - " Position the point at the end of the current topic's entry." + "Position the point at the end of the current topics' entry." (interactive) (outline-show-entry) (prog1 (outline-pre-next-preface) @@ -1155,10 +1322,10 @@ of the parent topic." (forward-char -1))) ) -;;;_ : Depth-wise -;;;_ > outline-ascend-to-depth (depth) +;;;_ - Depth-wise +;;;_ > outline-ascend-to-depth (depth) (defun outline-ascend-to-depth (depth) - " Ascend to depth DEPTH, returning depth if successful, nil if not." + "Ascend to depth DEPTH, returning depth if successful, nil if not." (if (and (> depth 0)(<= depth (outline-depth))) (let ((last-good (point))) (while (and (< depth (outline-depth)) @@ -1170,13 +1337,11 @@ of the parent topic." depth) (goto-char last-good) nil)) - (if (interactive-p) (outline-end-of-prefix)) - ) - ) -;;;_ > outline-descend-to-depth (depth) + (if (interactive-p) (outline-end-of-prefix)))) +;;;_ > outline-descend-to-depth (depth) (defun outline-descend-to-depth (depth) - " Descend to depth DEPTH within current topic, returning depth if - successful, nil if not." + "Descend to depth DEPTH within current topic, returning depth if +successful, nil if not." (let ((start-point (point)) (start-depth (outline-depth))) (while @@ -1190,11 +1355,11 @@ of the parent topic." (goto-char start-point) nil)) ) -;;;_ > outline-up-current-level (arg &optional dont-complain) +;;;_ > outline-up-current-level (arg &optional dont-complain) (defun outline-up-current-level (arg &optional dont-complain) - " Move to the heading line of which the present line is a subheading. - With argument, move up ARG levels. Don't return an error if - second, optional argument DONT-COMPLAIN, is non-nil." + "Move to the heading line of which the present line is a subheading. +With argument, move up ARG levels. Don't return an error if +second, optional argument DONT-COMPLAIN, is non-nil." (interactive "p") (outline-back-to-current-heading) (let ((present-level (outline-recent-depth))) @@ -1216,387 +1381,432 @@ of the parent topic." (if (interactive-p) (outline-end-of-prefix))) ) -;;;_ : Linear -;;;_ > outline-next-visible-heading (arg) -(defun outline-next-visible-heading (arg) - " Move to the next visible heading line. - - With argument, repeats, backward if negative." - (interactive "p") - (if (< arg 0) (beginning-of-line) (end-of-line)) - (if (re-search-forward (concat "^\\(" outline-regexp "\\)") - nil - 'go - arg) - (progn (outline-end-of-prefix) - (setq outline-recent-prefix-end (match-end 1) - outline-recent-prefix-beginning (match-beginning 1)))) - ) -;;;_ > outline-previous-visible-heading (arg) -(defun outline-previous-visible-heading (arg) - " Move to the previous heading line. +;;;_ - Linear +;;;_ > outline-next-sibling (&optional depth backward) +(defun outline-next-sibling (&optional depth backward) + "Like outline-forward-current-level, but respects invisible topics. - With argument, repeats or can move forward if negative. - A heading line is one that starts with a `*' (or that outline-regexp - matches)." - (interactive "p") - (outline-next-visible-heading (- arg)) - ) -;;;_ > outline-next-heading (&optional backward) -(defun outline-next-heading (&optional backward) - " Move to the heading for the topic (possibly invisible) before this one. +Traverse at optional DEPTH, or current depth if none specified. - Optional arg BACKWARD means search for most recent prior heading. +Go backward if optional arg BACKWARD is non-nil. - Returns the location of the heading, or nil if none found." +Return depth if successful, nil otherwise." (if (and backward (bobp)) nil - (if backward (outline-goto-prefix) - (if (and (bobp) (not (eobp))) - (forward-char 1))) - - (if (if backward - ;; searches are unbounded and return nil if failed: - (or (re-search-backward outline-line-boundary-regexp - nil - 0) - (looking-at outline-bob-regexp)) - (re-search-forward outline-line-boundary-regexp - nil - 0)) - (progn;; Got some valid location state - set vars: - (setq outline-recent-prefix-end - (or (match-end 2) outline-recent-prefix-end)) - (goto-char (setq outline-recent-prefix-beginning - (or (match-beginning 2) - outline-recent-prefix-beginning)))) - ) - ) - ) -;;;_ > outline-previous-heading () -(defun outline-previous-heading () - " Move to the next (possibly invisible) heading line. - - Optional repeat-count arg means go that number of headings. - - Return the location of the beginning of the heading, or nil if not found." - - (outline-next-heading t) - ) -;;;_ > outline-next-sibling (&optional backward) -(defun outline-next-sibling (&optional backward) - " Like outline-forward-current-level, but respects invisible topics. - - Go backward if optional arg BACKWARD is non-nil. - - Return depth if successful, nil otherwise." - - (if (and backward (bobp)) - nil - (let ((start-depth (outline-depth)) + (let ((start-depth (or depth (outline-depth))) (start-point (point)) - last-good) + last-depth) (while (and (not (if backward (bobp) (eobp))) (if backward (outline-previous-heading) (outline-next-heading)) - (> (outline-recent-depth) start-depth))) + (> (setq last-depth (outline-recent-depth)) start-depth))) (if (and (not (eobp)) - (and (> (outline-depth) 0) + (and (> (or last-depth (outline-depth)) 0) (= (outline-recent-depth) start-depth))) outline-recent-prefix-beginning (goto-char start-point) - nil) - ) - ) - ) -;;;_ > outline-previous-sibling (&optional arg) -(defun outline-previous-sibling (&optional arg) - " Like outline-forward-current-level, but goes backwards and respects - invisible topics. + (if depth (outline-depth) start-depth) + nil)))) +;;;_ > outline-previous-sibling (&optional depth backward) +(defun outline-previous-sibling (&optional depth backward) + "Like outline-forward-current-level, but goes backwards and respects +invisible topics. - Optional repeat count means go number backward. +Optional DEPTH specifies depth to traverse, default current depth. - Note that the beginning of a level is (currently) defined by this - implementation to be the first of previous successor topics of - equal or greater depth. +Optional BACKWARD reverses direction. - Return depth if successful, nil otherwise." - (outline-next-sibling t) +Return depth if successful, nil otherwise." + (outline-next-sibling depth (not backward)) ) -;;;_ > outline-beginning-of-level () +;;;_ > outline-snug-back () +(defun outline-snug-back () + "Position cursor at end of previous topic, presuming that we are at +the start of a topic prefix." + (if (or (bobp) (eobp)) + nil + (forward-char -1)) + (if (or (bobp) (not (memq (preceding-char) '(?\n ?\^M)))) + nil + (forward-char -1) + (if (or (bobp) (not (memq (preceding-char) '(?\n ?\^M)))) + (forward-char -1))) + (point)) +;;;_ > outline-beginning-of-level () (defun outline-beginning-of-level () - " Go back to the first sibling at this level, visible or not." + "Go back to the first sibling at this level, visible or not." (outline-end-of-level 'backward)) -;;;_ > outline-end-of-level (&optional backward) +;;;_ > outline-end-of-level (&optional backward) (defun outline-end-of-level (&optional backward) - " Go to the last sibling at this level, visible or not." + "Go to the last sibling at this level, visible or not." - (while (outline-previous-sibling)) - (prog1 (outline-recent-depth) - (if (interactive-p) (outline-end-of-prefix))) -) -;;;_ > outline-forward-current-level (arg &optional backward) -(defun outline-forward-current-level (arg &optional backward) - " Position the point at the next heading of the same level, taking - optional repeat-count. + (let ((depth (outline-depth))) + (while (outline-previous-sibling depth nil)) + (prog1 (outline-recent-depth) + (if (interactive-p) (outline-end-of-prefix))))) +;;;_ > outline-next-visible-heading (arg) +(defun outline-next-visible-heading (arg) + "Move to the next visible heading line, or as far as possible in +indicated direction if no more headings to be found. - Returns that position, else nil if is not found." - (interactive "p") - (outline-back-to-current-heading) - (let ((amt (if arg (if (< arg 0) - ;; Negative arg - invert direction. - (progn (setq backward (not backward)) - (abs arg)) - arg);; Positive arg - just use it. - 1)));; No arg - use 1: - (while (and (> amt 0) - (outline-next-sibling backward)) - (setq amt (1- amt))) - (if (interactive-p) (outline-end-of-prefix)) - (if (> amt 0) - (error "This is the %s topic on level %d." - (if backward "first" "last") - (outline-current-depth)) - t) - ) - ) -;;;_ > outline-backward-current-level (arg) -(defun outline-backward-current-level (arg) - " Position the point at the previous heading of the same level, taking - optional repeat-count. +With argument, repeats, backward if negative." - Returns that position, else nil if is not found." (interactive "p") - (unwind-protect - (outline-forward-current-level arg t) - (outline-end-of-prefix)) -) - -;;;_ : Search with Dynamic Exposure (requires isearch-mode) -;;;_ = outline-search-reconceal -(defvar outline-search-reconceal nil - "Used for outline isearch provisions, to track whether current search -match was concealed outside of search. The value is the location of the -match, if it was concealed, regular if the entire topic was concealed, in -a list if the entry was concealed.") -;;;_ = outline-search-quitting -(defconst outline-search-quitting nil - "Variable used by isearch-terminate/outline-provisions and -isearch-done/outline-provisions to distinguish between a conclusion -and cancellation of a search.") - -;;;_ > outline-enwrap-isearch () -(defun outline-enwrap-isearch () - " Impose isearch-mode wrappers so isearch progressively exposes and - reconceals hidden topics when working in outline mode, but works - elsewhere. + (let* ((backward (if (< arg 0) (setq arg (* -1 arg)))) + (step (if backward -1 1)) + prev got) + + (while (> arg 0) ; limit condition + (while (and (not (if backward (bobp)(eobp))) ; boundary condition + (progn + ;; Move, skipping over all those concealed lines: + (forward-line step) + (not (setq got (looking-at outline-regexp)))))) + ;; Register this got, it may be the last: + (if got (setq prev got)) + (setq arg (1- arg))) + (cond (got ; Last move was to a prefix: + (outline-prefix-data (match-beginning 0) (match-end 0)) + (outline-end-of-prefix)) + (prev ; Last move wasn't, but prev was: + (outline-prefix-data (match-beginning 0) (match-end 0))) + ((not backward) (end-of-line) nil)))) +;;;_ > outline-previous-visible-heading (arg) +(defun outline-previous-visible-heading (arg) + "Move to the previous heading line. - The function checks to ensure that the rebindings are done only once." +With argument, repeats or can move forward if negative. +A heading line is one that starts with a `*' (or that outline-regexp +matches)." + (interactive "p") + (outline-next-visible-heading (- arg))) +;;;_ > outline-forward-current-level (arg) +(defun outline-forward-current-level (arg) + "Position the point at the next heading of the same level, taking +optional repeat-count. - ; Should isearch-mode be employed, - (if (or (not outline-enwrap-isearch-mode) - ; or are preparations already done? - (fboundp 'real-isearch-terminate)) +Non-nil optional arg BACKWARD reverses direction. - ;; ... no - skip this all: +Returns that position, else nil if is not found." + (interactive "p") + (if (and (< arg 0) (bobp)) nil + (let ((start-depth (save-excursion + (outline-back-to-current-heading) + (outline-depth))) + (start-point (point)) + (backward (> 0 arg)) + last-depth + (last-good (point))) + (if backward (setq arg (* -1 arg))) + (while (> arg 0) + (while (and (not (if backward (bobp) (eobp))) + (if backward (outline-previous-visible-heading 1) + (outline-next-visible-heading 1)) + (> (setq last-depth (outline-recent-depth)) start-depth))) + (if (and last-depth (= last-depth start-depth) ) + (setq last-good (point) + arg (1- arg)) + (setq arg -1))) + (if (and (not (eobp)) + (and (> (or last-depth (outline-depth)) 0) + (= (outline-recent-depth) start-depth))) + outline-recent-prefix-beginning + (goto-char last-good) + (if (not (interactive-p)) + nil + (outline-end-of-prefix) + (error "This is the %s topic on level %d." + (if backward "first" "last") + (outline-recent-depth))))))) +;;;_ > outline-backward-current-level (arg) +(defun outline-backward-current-level (arg) + "Position the point at the previous heading of the same level, taking +optional repeat-count. - ;; ... yes: - - ; Ensure load of isearch-mode: - (if (or (and (fboundp 'isearch-mode) - (fboundp 'isearch-quote-char)) - (condition-case error - (load-library outline-enwrap-isearch-mode) - (file-error (message "Skipping isearch-mode provisions - %s '%s'" - (car (cdr error)) - (car (cdr (cdr error)))) - (sit-for 1) - ;; Inhibit subsequent tries and return nil: - (setq outline-enwrap-isearch-mode nil)))) - ;; Isearch-mode loaded, encapsulate specific entry points for - ;; outline dynamic-exposure business: - (progn - - ; stash crucial isearch-mode - ; funcs under known, private - ; names, then register wrapper - ; functions under the old - ; names, in their stead: - ; 'isearch-quit' is pre v 1.2: - (fset 'real-isearch-terminate - ; 'isearch-quit is pre v 1.2: - (or (if (fboundp 'isearch-quit) - (symbol-function 'isearch-quit)) - (if (fboundp 'isearch-abort) - ; 'isearch-abort' is v 1.2 and on: - (symbol-function 'isearch-abort)))) - (fset 'isearch-quit 'isearch-terminate/outline-provisions) - (fset 'isearch-abort 'isearch-terminate/outline-provisions) - (fset 'real-isearch-done (symbol-function 'isearch-done)) - (fset 'isearch-done 'isearch-done/outline-provisions) - (fset 'real-isearch-update (symbol-function 'isearch-update)) - (fset 'isearch-update 'isearch-update/outline-provisions) - (make-variable-buffer-local 'outline-search-reconceal)) - ) - ) - ) -;;;_ > outline-isearch-arrival-business () -(defun outline-isearch-arrival-business () - " Do outline business like exposing current point, if necessary, - registering reconcealment requirements in outline-search-reconceal - accordingly. - - Set outline-search-reconceal to nil if current point is not - concealed, to value of point if entire topic is concealed, and a - list containing point if only the topic body is concealed. - - This will be used to determine whether outline-hide-current-entry - or outline-hide-current-entry-completely will be necessary to - restore the prior concealment state." - - (if (and (boundp 'outline-mode) outline-mode) - (setq outline-search-reconceal - (if (outline-hidden-p) - (save-excursion - (if (re-search-backward outline-line-boundary-regexp nil 1) - ;; Nil value means we got to b-o-b - wouldn't need - ;; to advance. - (forward-char 1)) - ; We'll return point or list - ; containing point, depending - ; on concealment state of - ; topic prefix. - (prog1 (if (outline-hidden-p) (point) (list (point))) - ; And reveal the current - ; search target: - (outline-show-entry))))))) -;;;_ > outline-isearch-advancing-business () -(defun outline-isearch-advancing-business () - " Do outline business like deexposing current point, if necessary, - according to reconceal state registration." - (if (and (boundp 'outline-mode) outline-mode outline-search-reconceal) - (save-excursion - (if (listp outline-search-reconceal) - ;; Leave the topic visible: - (progn (goto-char (car outline-search-reconceal)) - (outline-hide-current-entry)) - ;; Rehide the entire topic: - (goto-char outline-search-reconceal) - (outline-hide-current-entry-completely)))) - ) -;;;_ > isearch-terminate/outline-provisions () -(defun isearch-terminate/outline-provisions () - (interactive) - (if (and (boundp 'outline-mode) - outline-mode - outline-enwrap-isearch-mode) - (outline-isearch-advancing-business)) - (let ((outline-search-quitting t) - (outline-search-reconceal nil)) - (real-isearch-terminate))) -;;;_ > isearch-done/outline-provisions () -(defun isearch-done/outline-provisions (&optional nopush) - (interactive) - (if (and (boundp 'outline-mode) - outline-mode - outline-enwrap-isearch-mode) - (progn (save-excursion - (if (and outline-search-reconceal - (not (listp outline-search-reconceal))) - ;; The topic was concealed - reveal it, its siblings, - ;; and any ancestors that are still concealed: - (progn - (message "(exposing destination)")(sit-for 0) - ;; Ensure target topic's siblings are exposed: - (outline-ascend-to-depth (1- (outline-current-depth))) - ;; Ensure that the target topic's ancestors are exposed - (while (outline-hidden-p) - (outline-show-current-children)) - (outline-show-current-children) - (outline-show-current-entry))) - (outline-isearch-arrival-business)) - (if (not (and (boundp 'outline-search-quitting) - outline-search-quitting)) - (outline-show-current-children)))) - (if nopush - ;; isearch-done in newer version of isearch mode takes arg: - (real-isearch-done nopush) - (real-isearch-done))) -;;;_ > isearch-update/outline-provisions () -(defun isearch-update/outline-provisions () - " Wrapper around isearch which exposes and conceals hidden outline - portions encountered in the course of searching." - (if (not (and (boundp 'outline-mode) - outline-mode - outline-enwrap-isearch-mode)) - ;; Just do the plain business: - (real-isearch-update) - - ;; Ah - provide for outline conditions: - (outline-isearch-advancing-business) - (real-isearch-update) - (cond (isearch-success (outline-isearch-arrival-business)) - ((not isearch-success) (outline-isearch-advancing-business))) - ) - ) - -;;;_ #5 Manipulation - -;;;_ : Topic Format Assessment -;;;_ > outline-solicit-alternate-bullet (depth &optional current-bullet) +Returns that position, else nil if is not found." + (interactive "p") + (unwind-protect + (if (interactive-p) + (let ((current-prefix-arg (* -1 arg))) + (call-interactively 'outline-forward-current-level)) + (outline-forward-current-level (* -1 arg))) + (outline-end-of-prefix))) + +;;;_ #4 Alteration + +;;;_ - Fundamental +;;;_ > outline-before-change-protect (beg end) +(defun outline-before-change-protect (beg end) + "Reveal concealed text pending improper (non-integral) changes, and +offer user choice to commit or forego the change. Unchanged text is +reconcealed. User has option to have changed text reconcealed. + +Undo commands are specially treated - the user is not prompted for +choice, the undoes are always committed (based on presumption that the +things being undone were already subject to this regulation routine), +and undoes always leave the changed stuff exposed. + +Changes to concealed regions are ignored while file is being written. +\(This is for the sake of functions that do change the file during +writes, like crypt and zip modes.) + +Locally bound in outline buffers to 'before-change-function', which +in emacs 19 is run before any change to the buffer. (Has no effect +in Emacs 18, which doesn't support before-change-function.) + +Any functions which set ['this-command' to 'undo', or which set] +'outline-override-protect' non-nil (as does, eg, outline-flag-chars) +are exempt from this restriction." + (if (and (outline-mode-p) + ; outline-override-protect + ; set by functions that know what + ; they're doing, eg outline internals: + (not outline-override-protect) + (not outline-during-write-cue) + (save-match-data ; Preserve operation position state. + ; Both beginning and end chars must + ; be exposed: + (save-excursion (if (memq this-command '(newline open-line)) + ;; Compensate for stupid emacs {new, + ;; open-}line display optimization: + (setq beg (1+ beg) + end (1+ end))) + (goto-char beg) + (or (outline-hidden-p) + (and (not (= beg end)) + (goto-char end) + (outline-hidden-p)))))) + (save-match-data + (if (equal this-command 'undo) + ;; Allow undo without inhibition. + ;; - Undoing new and open-line hits stupid emacs redisplay + ;; optimization (em 19 cmds.c, ~ line 200). + ;; - Presumably, undoing what was properly protected when + ;; done. + ;; - Undo may be users' only recourse in protection faults. + ;; So, expose what getting changed: + (progn (message "Undo! - exposing concealed target...") + (sit-for 0) + (if (outline-hidden-p) + (outline-show-children)) + (message "Undo!") + (sit-for 0)) + (let (response + (rehide-completely (save-excursion (outline-goto-prefix) + (outline-hidden-p))) + rehide-place) + + (save-excursion + (if (condition-case err + ;; Condition case to catch keyboard quits during reads. + (progn + ; Give them a peek where + (save-excursion + (if (eolp) (setq rehide-place + (outline-goto-prefix))) + (outline-show-entry)) + ; Present the message, but... + ; leave the cursor at the location + ; until they respond: + ; Then interpret the response: + (while + (progn + (message (concat "Change inside concealed" + " region - do it? " + "(n or 'y'/'r'eclose)")) + (setq response (read-char)) + (not + (cond ((memq response '(?r ?R)) + (setq response 'reclose)) + ((memq response '(?y ?Y ? )) + (setq response t)) + ((memq response '(?n ?N 127)) + (setq response nil) + t) + ((eq response ??) + (message + "'r' means 'yes, then reclose") + nil) + (t (message "Please answer y, n, or r") + (sit-for 1) + nil))))) + response) + (quit nil)) + ; Continue: + (if (eq response 'reclose) + (save-excursion + (if rehide-place (goto-char rehide-place)) + (if rehide-completely + (outline-hide-current-entry-completely) + (outline-hide-current-entry))) + (if (outline-ascend-to-depth (1- (outline-recent-depth))) + (outline-show-children) + (outline-show-to-offshoot))) + ; Prevent: + (if rehide-completely + (save-excursion + (if rehide-place (goto-char rehide-place)) + (outline-hide-current-entry-completely)) + (outline-hide-current-entry)) + (error (concat + "Change within concealed region prevented."))))))) + ) ; if + ) ; defun +;;;_ = outline-post-goto-bullet +(defvar outline-post-goto-bullet nil + "Outline internal var, when set tells post-processing to reposition +on topic bullet, and then unset it. Set by outline-pre-command- +business when implementing hot-spot operation, where literal +characters typed over a topic bullet are mapped to the command +of the corresponding control-key on the outline-mode-map.") +(make-variable-buffer-local 'outline-post-goto-bullet) +;;;_ > outline-post-command-business () +(defun outline-post-command-business () + "A post-command-hook function for outline buffers, takes care of some +loose ends left by outline-before-change-protect. + +- Nulls outline-override-protect, so it's not left open. + +- Implements (and clears) outline-post-goto-bullet, for hot-spot + outline commands. + +- Massages buffer-undo-list so successive, standard character self-inserts are + aggregated. This kludge compensates for lack of undo bunching when + before-change-function is used." + + ; Apply any external change func: + (if (outline-mode-p) ; In outline-mode. + (progn + (setq outline-override-protect nil) + (and outline-during-write-cue + (setq outline-during-write-cue nil)) + ;; Undo bunching business: + (if (and (listp buffer-undo-list) ; Undo history being kept. + (equal this-command 'self-insert-command) + (equal last-command 'self-insert-command)) + (let* ((prev-stuff (cdr buffer-undo-list)) + (before-prev-stuff (cdr (cdr prev-stuff))) + cur-cell cur-from cur-to + prev-cell prev-from prev-to) + (if (and before-prev-stuff ; Goes back far enough to bother, + (not (car prev-stuff)) ; and break before current, + (not (car before-prev-stuff)) ; !and break before prev! + (setq prev-cell (car (cdr prev-stuff))) ; contents now, + (setq cur-cell (car buffer-undo-list)) ; contents prev. + + ;; cur contents denote a single char insertion: + (numberp (setq cur-from (car cur-cell))) + (numberp (setq cur-to (cdr cur-cell))) + (= 1 (- cur-to cur-from)) + + ;; prev contents denote fewer than aggregate-limit + ;; insertions: + (numberp (setq prev-from (car prev-cell))) + (numberp (setq prev-to (cdr prev-cell))) + ; Below threshold: + (> outline-undo-aggregation (- prev-to prev-from))) + (setq buffer-undo-list + (cons (cons prev-from cur-to) + (cdr (cdr (cdr buffer-undo-list)))))))) + ;; Implement -post-goto-bullet, if set: (must be after undo business) + (if (and outline-post-goto-bullet + (outline-current-bullet-pos)) + (progn (goto-char (outline-current-bullet-pos)) + (setq outline-post-goto-bullet nil))) + ))) +;;;_ > outline-pre-command-business () +(defun outline-pre-command-business () + "A pre-command-hook function for outline buffers. Implements +special behavior when cursor is on bullet char. + +Self-insert characters are reinterpreted control-character references +into the outline-mode-map. The outline-mode post-command hook will +position a cursor that has moved as a result of such reinterpretation, +on the destination topic's bullet, when the cursor wound up in the + +The upshot is that you can get easy, single (unmodified) key outline +maneuvering and general operations by positioning the cursor on the +bullet char, and it continues until you deliberately some non-outline +motion command to relocate the cursor off of a bullet char." + + (if (and (eq this-command 'self-insert-command) + (eq (point)(outline-current-bullet-pos))) + + (let* ((this-key-num (if (numberp last-command-event) + last-command-event)) + mapped-binding) + + ; Map upper-register literals + ; to lower register: + (if (<= 96 this-key-num) + (setq this-key-num (- this-key-num 32))) + ; Check if we have a literal: + (if (and (<= 64 this-key-num) + (>= 96 this-key-num)) + (setq mapped-binding + (lookup-key 'outline-mode-map + (concat outline-command-prefix + (char-to-string (- this-key-num 64)))))) + (if mapped-binding + (setq outline-post-goto-bullet t + this-command mapped-binding))))) + +;;;_ - Topic Format Assessment +;;;_ > outline-solicit-alternate-bullet (depth &optional current-bullet) (defun outline-solicit-alternate-bullet (depth &optional current-bullet) - " Prompt for and return a bullet char as an alternative to the - current one, but offer one suitable for current depth DEPTH - as default." + "Prompt for and return a bullet char as an alternative to the +current one. Offer one suitable for current depth DEPTH as default." (let* ((default-bullet (or current-bullet (outline-bullet-for-depth depth))) + (sans-escapes (regexp-sans-escapes outline-bullets-string)) (choice (solicit-char-in-string (format "Select bullet: %s ('%s' default): " - outline-bullets-string + sans-escapes default-bullet) - (string-sans-char outline-bullets-string ?\\) + sans-escapes t))) (if (string= choice "") default-bullet choice)) ) -;;;_ > outline-sibling-index (&optional depth) +;;;_ > outline-sibling-index (&optional depth) (defun outline-sibling-index (&optional depth) - " Item number of this prospective topic among it's siblings. + "Item number of this prospective topic among its siblings. - If optional arg depth is greater than current depth, then we're - opening a new level, and return 0. +If optional arg depth is greater than current depth, then we're +opening a new level, and return 0. - If less than this depth, ascend to that depth and count..." +If less than this depth, ascend to that depth and count..." (save-excursion (cond ((and depth (<= depth 0) 0)) ((or (not depth) (= depth (outline-depth))) (let ((index 1)) - (while (outline-previous-sibling) (setq index (1+ index))) + (while (outline-previous-sibling (outline-recent-depth) nil) + (setq index (1+ index))) index)) ((< depth (outline-recent-depth)) (outline-ascend-to-depth depth) (outline-sibling-index)) (0)))) -;;;_ > outline-distinctive-bullet (bullet) +;;;_ > outline-distinctive-bullet (bullet) (defun outline-distinctive-bullet (bullet) - " True if bullet is one of those on outline-distinctive-bullets-string." + "True if bullet is one of those on outline-distinctive-bullets-string." (string-match (regexp-quote bullet) outline-distinctive-bullets-string)) -;;;_ > outline-numbered-type-prefix (&optional prefix) +;;;_ > outline-numbered-type-prefix (&optional prefix) (defun outline-numbered-type-prefix (&optional prefix) - " True if current header prefix bullet is numbered bullet." + "True if current header prefix bullet is numbered bullet." (and outline-numbered-bullet (string= outline-numbered-bullet (if prefix (outline-get-prefix-bullet prefix) (outline-get-bullet))))) -;;;_ > outline-bullet-for-depth (&optional depth) +;;;_ > outline-bullet-for-depth (&optional depth) (defun outline-bullet-for-depth (&optional depth) - " Return outline topic bullet suited to DEPTH, or for current depth if none - specified." + "Return outline topic bullet suited to DEPTH, or for current depth if none +specified." ;; Find bullet in plain-bullets-string modulo DEPTH. (if outline-stylish-prefixes (char-to-string (aref outline-plain-bullets-string @@ -1605,8 +1815,8 @@ and cancellation of a search.") outline-primary-bullet) ) -;;;_ : Topic Production -;;;_ > outline-make-topic-prefix (&optional prior-bullet +;;;_ - Topic Production +;;;_ > outline-make-topic-prefix (&optional prior-bullet (defun outline-make-topic-prefix (&optional prior-bullet new depth @@ -1617,47 +1827,48 @@ and cancellation of a search.") ;; opening a new topic after current topic, lower or higher, or we're ;; changing level of current topic. ;; Solicit dominates specified bullet-char. - " Generate a topic prefix suitable for optional arg DEPTH, or current - depth if not specified. - - All the arguments are optional. - - PRIOR-BULLET indicates the bullet of the prefix being changed, or - nil if none. This bullet may be preserved (other options - notwithstanding) if it is on the outline-distinctive-bullets-string, - for instance. - - Second arg NEW indicates that a new topic is being opened after the - topic at point, if non-nil. Default bullet for new topics, eg, may - be set (contingent to other args) to numbered bullets if previous - sibling is one. The implication otherwise is that the current topic - is being adjusted - shifted or rebulleted - and we don't consider - bullet or previous sibling. - - Third arg DEPTH forces the topic prefix to that depth, regardless of - the current topics' depth. - - Fourth arg SOLICIT non-nil provokes solicitation from the user of a - choice among the valid bullets. (This overrides other all the - options, including, eg, a distinctive PRIOR-BULLET.) - - Fifth arg, NUMBER-CONTROL, matters only if 'outline-numbered-bullet' - is non-nil *and* soliciting was not explicitly invoked. Then - NUMBER-CONTROL non-nil forces prefix to either numbered or - denumbered format, depending on the value of the sixth arg, INDEX. - - (Note that NUMBER-CONTROL does *not* apply to level 1 topics. Sorry...) - - If NUMBER-CONTROL is non-nil and sixth arg INDEX is non-nil then - the prefix of the topic is forced to be numbered. Non-nil - NUMBER-CONTROL and nil INDEX forces non-numbered format on the - bullet. Non-nil NUMBER-CONTROL and non-nil, non-number INDEX means - that the index for the numbered prefix will be derived, by counting - siblings back to start of level. If INDEX is a number, then that - number is used as the index for the numbered prefix (allowing, eg, - sequential renumbering to not require this function counting back the - index for each successive sibling)." - +;;;_ . Doc string: + "Generate a topic prefix suitable for optional arg DEPTH, or current +depth if not specified. + +All the arguments are optional. + +PRIOR-BULLET indicates the bullet of the prefix being changed, or +nil if none. This bullet may be preserved (other options +notwithstanding) if it is on the outline-distinctive-bullets-string, +for instance. + +Second arg NEW indicates that a new topic is being opened after the +topic at point, if non-nil. Default bullet for new topics, eg, may +be set (contingent to other args) to numbered bullets if previous +sibling is one. The implication otherwise is that the current topic +is being adjusted - shifted or rebulleted - and we don't consider +bullet or previous sibling. + +Third arg DEPTH forces the topic prefix to that depth, regardless of +the current topics' depth. + +Fourth arg SOLICIT non-nil provokes solicitation from the user of a +choice among the valid bullets. (This overrides other all the +options, including, eg, a distinctive PRIOR-BULLET.) + +Fifth arg, NUMBER-CONTROL, matters only if 'outline-numbered-bullet' +is non-nil *and* soliciting was not explicitly invoked. Then +NUMBER-CONTROL non-nil forces prefix to either numbered or +denumbered format, depending on the value of the sixth arg, INDEX. + +\(Note that NUMBER-CONTROL does *not* apply to level 1 topics. Sorry...) + +If NUMBER-CONTROL is non-nil and sixth arg INDEX is non-nil then +the prefix of the topic is forced to be numbered. Non-nil +NUMBER-CONTROL and nil INDEX forces non-numbered format on the +bullet. Non-nil NUMBER-CONTROL and non-nil, non-number INDEX means +that the index for the numbered prefix will be derived, by counting +siblings back to start of level. If INDEX is a number, then that +number is used as the index for the numbered prefix (allowing, eg, +sequential renumbering to not requre this function counting back the +index for each successive sibling)." +;;;_ . Code: ;; The options are ordered in likely frequence of use, most common ;; highest, least lowest. Ie, more likely to be doing prefix ;; adjustments than soliciting, and yet more than numbering. @@ -1751,34 +1962,34 @@ and cancellation of a search.") ((outline-sibling-index)))))) ) ) -;;;_ > open-topic (relative-depth &optional before) -(defun open-topic (relative-depth &optional before) - " Open a new topic at depth DEPTH. New topic is situated after current - one, unless optional flag BEFORE is non-nil, or unless current line - is complete empty (not even whitespace), in which case open is done - on current line. - - Nuances: - - - Creation of new topics is with respect to the visible topic - containing the cursor, regardless of intervening concealed ones. - - - New headers are generally created after/before the body of a - topic. However, they are created right at cursor location if the - cursor is on a blank line, even if that breaks the current topic - body. This is intentional, to provide a simple means for - deliberately dividing topic bodies. - - - Double spacing of topic lists is preserved. Also, the first - level two topic is created double-spaced (and so would be - subsequent siblings, if that's left intact). Otherwise, - single-spacing is used. - - - Creation of sibling or nested topics is with respect to the topic - you're starting from, even when creating backwards. This way you - can easily create a sibling in front of the current topic without - having to go to its preceding sibling, and then open forward - from there." +;;;_ > outline-open-topic (relative-depth &optional before) +(defun outline-open-topic (relative-depth &optional before) + "Open a new topic at depth DEPTH. New topic is situated after current +one, unless optional flag BEFORE is non-nil, or unless current line +is complete empty (not even whitespace), in which case open is done +on current line. + +Nuances: + +- Creation of new topics is with respect to the visible topic + containing the cursor, regardless of intervening concealed ones. + +- New headers are generally created after/before the body of a + topic. However, they are created right at cursor location if the + cursor is on a blank line, even if that breaks the current topic + body. This is intentional, to provide a simple means for + deliberately dividing topic bodies. + +- Double spacing of topic lists is preserved. Also, the first + level two topic is created double-spaced (and so would be + subsequent siblings, if that's left intact). Otherwise, + single-spacing is used. + +- Creation of sibling or nested topics is with respect to the topic + you're starting from, even when creating backwards. This way you + can easily create a sibling in front of the current topic without + having to go to its preceeding sibling, and then open forward + from there." (let* ((depth (+ (outline-current-depth) relative-depth)) (opening-on-blank (if (looking-at "^\$") @@ -1800,8 +2011,7 @@ and cancellation of a search.") outline-numbered-bullet)))) (point))) dbl-space - doing-beginning - ) + doing-beginning) (if (not opening-on-blank) ; Positioning and vertical @@ -1810,12 +2020,16 @@ and cancellation of a search.") (progn (goto-char ref-topic) (setq dbl-space ; Determine double space action: - (or (and (not (> relative-depth 0)) - ;; not descending, + (or (and (<= relative-depth 0) ; not descending; (save-excursion - ;; preceded by a blank line? - (forward-line -1) - (looking-at "^\\s-*$"))) + ;; at b-o-b or preceeded by a blank line? + (or (> 0 (forward-line -1)) + (looking-at "^\\s-*$") + (bobp))) + (save-excursion + ;; succeeded by a blank line? + (outline-end-of-current-subtree) + (bolp))) (and (= ref-depth 1) (or before (= depth 1) @@ -1825,19 +2039,28 @@ and cancellation of a search.") (not (outline-pre-next-preface))))))) ; Position to prior heading, - ; if inserting backwards: - (if before (progn (outline-back-to-current-heading) + ; if inserting backwards, and + ; not going outwards: + (if (and before (>= relative-depth 0)) + (progn (outline-back-to-current-heading) (setq doing-beginning (bobp)) - (if (and (not (outline-previous-sibling)) - (not (bobp))) - (outline-previous-heading)))) + (if (not (bobp)) + (outline-previous-heading))) + (if (and before (bobp)) + (outline-unprotected (open-line 1)))) - (if (and (<= depth ref-depth) - (= ref-depth (outline-current-depth))) + (if (<= relative-depth 0) ;; Not going inwards, don't snug up: (if doing-beginning - (open-line (if dbl-space 2 1)) - (outline-end-of-current-subtree)) + (outline-unprotected (open-line (if dbl-space 2 1))) + (if before + (progn (end-of-line) + (outline-pre-next-preface) + (while (= ?\r (following-char)) + (forward-char 1)) + (if (not (looking-at "^$")) + (outline-unprotected (open-line 1)))) + (outline-end-of-current-subtree))) ;; Going inwards - double-space if first offspring is, ;; otherwise snug up. (end-of-line) ; So we skip any concealed progeny. @@ -1854,10 +2077,24 @@ and cancellation of a search.") (progn (forward-line -1) (looking-at "^\\s-*$")))) (progn (forward-line 1) - (open-line 1))) + (outline-unprotected (open-line 1)))) (end-of-line)) ;;(if doing-beginning (goto-char doing-beginning)) - (if (not (bobp)) (newline (if dbl-space 2 1))) + (if (not (bobp)) + (progn (if (and (not (> depth ref-depth)) + (not before)) + (outline-unprotected (open-line 1)) + (if (> depth ref-depth) + (outline-unprotected (newline 1)) + (if dbl-space + (outline-unprotected (open-line 1)) + (if (not before) + (outline-unprotected (newline 1)))))) + (if dbl-space + (outline-unprotected (newline 1))) + (if (and (not (eobp)) + (not (bolp))) + (forward-char 1)))) )) (insert-string (concat (outline-make-topic-prefix opening-numbered t @@ -1874,58 +2111,111 @@ and cancellation of a search.") t) (end-of-line) ) ) -;;;_ > open-subtopic (arg) -(defun open-subtopic (arg) - " Open new topic header at deeper level than the current one. - - Negative universal arg means to open deeper, but place the new topic - prior to the current one." +;;;_ . open-topic contingencies +;;;_ ; base topic - one from which open was issued +;;;_ , beginning char +;;;_ , amount of space before will be used, unless openning in place +;;;_ , end char will be used, unless opening before (and it still may) +;;;_ ; absolute depth of new topic +;;;_ ! insert in place - overrides most stuff +;;;_ ; relative depth of new re base +;;;_ ; before or after base topic +;;;_ ; spacing around topic, if any, prior to new topic and at same depth +;;;_ ; buffer boundaries - special provisions for beginning and end ob +;;;_ ; level 1 topics have special provisions also - double space. +;;;_ ; location of new topic +;;;_ . +;;;_ > outline-open-subtopic (arg) +(defun outline-open-subtopic (arg) + "Open new topic header at deeper level than the current one. + +Negative universal arg means to open deeper, but place the new topic +prior to the current one." (interactive "p") - (open-topic 1 (> 0 arg))) -;;;_ > open-sibtopic (arg) -(defun open-sibtopic (arg) - " Open new topic header at same level as the current one. Negative - universal arg means to place the new topic prior to the current - one." + (outline-open-topic 1 (> 0 arg))) +;;;_ > outline-open-sibtopic (arg) +(defun outline-open-sibtopic (arg) + "Open new topic header at same level as the current one. Negative +universal arg means to place the new topic prior to the current +one." (interactive "p") - (open-topic 0 (> 0 arg))) -;;;_ > open-supertopic (arg) -(defun open-supertopic (arg) - " Open new topic header at shallower level than the current one. - Negative universal arg means to open shallower, but place the new - topic prior to the current one." + (outline-open-topic 0 (> 0 arg))) +;;;_ > outline-open-supertopic (arg) +(defun outline-open-supertopic (arg) + "Open new topic header at shallower level than the current one. +Negative universal arg means to open shallower, but place the new +topic prior to the current one." (interactive "p") - (open-topic -1 (> 0 arg))) - -;;;_ : Outline Alteration -;;;_ . Topic Form Modification -;;;_ > outline-reindent-body (old-depth new-depth) -(defun outline-reindent-body (old-depth new-depth) - " Reindent body lines which were indented at old-depth to new-depth. - - Note that refill of indented paragraphs is not done, and tabs are - not accommodated. ('untabify' your outline if you want to preserve - hanging body indents.)" + (outline-open-topic -1 (> 0 arg))) + +;;;_ - Outline Alteration +;;;_ : Topic Modification +;;;_ = outline-former-auto-filler +(defvar outline-former-auto-filler nil + "Name of modal fill function being wrapped by outline-auto-fill.") +;;;_ > outline-auto-fill () +(defun outline-auto-fill () + "Do normal autofill, maintaining outline hanging topic indentation +if outline-use-hanging-indents is set." + (let ((fill-prefix (if outline-use-hanging-indents + ;; Check for topic header indentation: + (save-excursion + (beginning-of-line) + (if (looking-at outline-regexp) + ;; ... construct indentation to account for + ;; length of topic prefix: + (make-string (progn (outline-end-of-prefix) + (current-column)) + ?\ )))))) + (if (or outline-former-auto-filler outline-use-hanging-indents) + (do-auto-fill)))) +;;;_ > outline-reindent-body (old-depth new-depth &optional number) +(defun outline-reindent-body (old-depth new-depth &optional number) + "Reindent body lines which were indented at old-depth to new-depth. + +Optional arg NUMBER indicates numbering is being added, and it must +be accomodated. + +Note that refill of indented paragraphs is not done." (save-excursion - (save-restriction - (outline-goto-prefix) - (forward-char 1) - (let* ((old-spaces-expr (make-string (1+ old-depth) ?\ )) - (new-spaces-expr (concat (make-string (1+ new-depth) ?\ ) - ;; spaces followed by non-space: - "\\1"))) - (while (and (re-search-forward "[\C-j\C-m]" nil t) - (not (looking-at outline-regexp))) - (if (looking-at old-spaces-expr) - (replace-match new-spaces-expr))))))) -;;;_ > outline-rebullet-current-heading (arg) + (outline-end-of-prefix) + (let* ((new-margin (current-column)) + excess old-indent-begin old-indent-end + curr-ind + ;; We want the column where the header-prefix text started + ;; *before* the prefix was changed, so we infer it relative + ;; to the new margin and the shift in depth: + (old-margin (+ old-depth (- new-margin new-depth)))) + + ;; Process lines up to (but excluding) next topic header: + (outline-unprotected + (save-match-data + (while + (and (re-search-forward "[\n\r]\\(\\s-*\\)" + nil + t) + ;; Register the indent data, before we reset the + ;; match data with a subsequent 'looking-at': + (setq old-indent-begin (match-beginning 1) + old-indent-end (match-end 1)) + (not (looking-at outline-regexp))) + (if (> 0 (setq excess (- (current-column) + old-margin))) + ;; Text starts left of old margin - don't adjust: + nil + ;; Text was hanging at or right of old left margin - + ;; reindent it, preserving its existing indentation + ;; beyond the old margin: + (delete-region old-indent-begin old-indent-end) + (indent-to (+ new-margin excess))))))))) +;;;_ > outline-rebullet-current-heading (arg) (defun outline-rebullet-current-heading (arg) - " Like non-interactive version 'outline-rebullet-heading', but work on - (only) visible heading containing point. + "Like non-interactive version 'outline-rebullet-heading', but work on +\(only) visible heading containing point. - With repeat count, solicit for bullet." +With repeat count, solicit for bullet." (interactive "P") (save-excursion (outline-back-to-current-heading) (outline-end-of-prefix) @@ -1936,48 +2226,44 @@ and cancellation of a search.") t) ;;; do-successors ) ) -;;;_ > outline-rebullet-heading (&optional solicit ...) -(defvar current-bullet nil - "Variable local to outline-rebullet-heading,but referenced by -outline-make-topic-prefix, also. Should be resolved with explicitly -parameterized communication between the two, if suitable.") +;;;_ > outline-rebullet-heading (&optional solicit ...) (defun outline-rebullet-heading (&optional solicit new-depth number-control index do-successors) - " Adjust bullet of current topic prefix. + "Adjust bullet of current topic prefix. - All args are optional. +All args are optional. - If SOLICIT is non-nil then the choice of bullet is solicited from - user. Otherwise the distinctiveness of the bullet or the topic - depth determines it. +If SOLICIT is non-nil then the choice of bullet is solicited from +user. Otherwise the distinctiveness of the bullet or the topic +depth determines it. - Second arg DEPTH forces the topic prefix to that depth, regardless - of the topic's current depth. +Second arg DEPTH forces the topic prefix to that depth, regardless +of the topics current depth. - Third arg NUMBER-CONTROL can force the prefix to or away from - numbered form. It has effect only if 'outline-numbered-bullet' is - non-nil and soliciting was not explicitly invoked (via first arg). - Its effect, numbering or denumbering, then depends on the setting - of the forth arg, INDEX. +Third arg NUMBER-CONTROL can force the prefix to or away from +numbered form. It has effect only if 'outline-numbered-bullet' is +non-nil and soliciting was not explicitly invoked (via first arg). +Its effect, numbering or denumbering, then depends on the setting +of the forth arg, INDEX. - If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the - prefix of the topic is forced to be non-numbered. Null index and - non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and - non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil - INDEX is a number, then that number is used for the numbered - prefix. Non-nil and non-number means that the index for the - numbered prefix will be derived by outline-make-topic-prefix. +If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the +prefix of the topic is forced to be non-numbered. Null index and +non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and +non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil +INDEX is a number, then that number is used for the numbered +prefix. Non-nil and non-number means that the index for the +numbered prefix will be derived by outline-make-topic-prefix. - Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding - siblings. +Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding +siblings. - Cf vars 'outline-stylish-prefixes', 'outline-old-style-prefixes', - and 'outline-numbered-bullet', which all affect the behavior of - this function." +Cf vars 'outline-stylish-prefixes', 'outline-old-style-prefixes', +and 'outline-numbered-bullet', which all affect the behavior of +this function." (let* ((current-depth (outline-depth)) (new-depth (or new-depth current-depth)) @@ -1991,52 +2277,56 @@ parameterized communication between the two, if suitable.") number-control index))) - ;; Don't need to reinsert identical one: + ;; Is new one is identical to old? (if (and (= current-depth new-depth) (string= current-bullet (substring new-prefix (1- (length new-prefix))))) + ;; Nothing to do: t ;; New prefix probably different from old: - ;; get rid of old one: - (delete-region mb me) + ; get rid of old one: + (outline-unprotected (delete-region mb me)) (goto-char mb) - ;; Dispense with number if numbered-bullet prefix: + ; Dispense with number if + ; numbered-bullet prefix: (if (and outline-numbered-bullet (string= outline-numbered-bullet current-bullet) (looking-at "[0-9]+")) - (delete-region (match-beginning 0)(match-end 0))) + (outline-unprotected + (delete-region (match-beginning 0)(match-end 0)))) - ;; Put in new prefix: - (insert-string new-prefix) - ) + ; Put in new prefix: + (outline-unprotected (insert-string new-prefix)) - ;; Reindent the body if elected and depth changed: - (if (and outline-reindent-bodies - (not (= new-depth current-depth))) - (outline-reindent-body current-depth new-depth)) + ;; Reindent the body if elected and margin changed: + (if (and outline-reindent-bodies + (not (= new-depth current-depth))) + (outline-reindent-body current-depth new-depth)) - ;; Recursively rectify successive siblings if selected: - (if do-successors - (save-excursion - (while (outline-next-sibling) - (setq index - (cond ((numberp index) (1+ index)) - ((not number-control) (outline-sibling-index)))) - (if (outline-numbered-type-prefix) - (outline-rebullet-heading nil ;;; solicit - new-depth ;;; new-depth - number-control;;; number-control - index ;;; index - nil))))) ;;;(dont!)do-successors - ) - ) -;;;_ > outline-rebullet-topic (arg) + ;; Recursively rectify successive siblings of orig topic if + ;; caller elected for it: + (if do-successors + (save-excursion + (while (outline-next-sibling new-depth nil) + (setq index + (cond ((numberp index) (1+ index)) + ((not number-control) (outline-sibling-index)))) + (if (outline-numbered-type-prefix) + (outline-rebullet-heading nil ;;; solicit + new-depth ;;; new-depth + number-control;;; number-control + index ;;; index + nil))))) ;;;(dont!)do-successors + ) ; (if (and (= current-depth new-depth)...)) + ) ; let* ((current-depth (outline-depth))...) + ) ; defun +;;;_ > outline-rebullet-topic (arg) (defun outline-rebullet-topic (arg) - " Like outline-rebullet-topic-grunt, but start from topic visible at point. - Descends into invisible as well as visible topics, however. + "Like outline-rebullet-topic-grunt, but start from topic visible at point. +Descends into invisible as well as visible topics, however. - With repeat count, shift topic depth by that amount." +With repeat count, shift topic depth by that amount." (interactive "P") (let ((start-col (current-column)) (was-eol (eolp))) @@ -2051,26 +2341,25 @@ parameterized communication between the two, if suitable.") (error "Attempt to shift topic below level 1")) (outline-rebullet-topic-grunt arg) (if (not (zerop arg)) (message "Shifting... done."))) - (move-to-column (max 0 (+ start-col arg)))) - ) -;;;_ > outline-rebullet-topic-grunt (&optional relative-depth ...) + (move-to-column (max 0 (+ start-col arg))))) +;;;_ > outline-rebullet-topic-grunt (&optional relative-depth ...) (defun outline-rebullet-topic-grunt (&optional relative-depth starting-depth starting-point index do-successors) - " Rebullet the topic at point, visible or invisible, and all - contained subtopics. See outline-rebullet-heading for rebulleting - behavior. + "Rebullet the topic at point, visible or invisible, and all +contained subtopics. See outline-rebullet-heading for rebulleting +behavior. - All arguments are optional. +All arguments are optional. - First arg RELATIVE-DEPTH means to shift the depth of the entire - topic that amount. +First arg RELATIVE-DEPTH means to shift the depth of the entire +topic that amount. - The rest of the args are for internal recursive use by the function - itself. The are STARTING-DEPTH, STARTING-POINT, and INDEX." +The rest of the args are for internal recursive use by the function +itself. The are STARTING-DEPTH, STARTING-POINT, and INDEX." (let* ((relative-depth (or relative-depth 0)) (new-depth (outline-depth)) @@ -2138,92 +2427,104 @@ parameterized communication between the two, if suitable.") (outline-rebullet-heading nil nil nil nil t))))) ) ) -;;;_ > outline-number-siblings (&optional denumber) +;;;_ > outline-renumber-to-depth (&optional depth) +(defun outline-renumber-to-depth (&optional depth) + "Renumber siblings at current depth, from point, and shallower +if optional arg DEPTH is less than current depth. + +Returns final depth." + + ;; Proceed by level, processing subsequent siblings on each, + ;; ascending until we get shallower than the start depth: + + (let ((ascender (outline-depth))) + (while (and (not (eobp)) + (outline-depth) + (>= (outline-recent-depth) depth) + (>= ascender depth)) + ; Skip over all topics at + ; lesser depths, which can not + ; have been disturbed: + (while (and (not (eobp)) + (> (outline-recent-depth) ascender)) + (outline-next-heading)) + ; Prime ascender for ascension: + (setq ascender (1- (outline-recent-depth))) + (if (>= (outline-recent-depth) depth) + (outline-rebullet-heading nil ;;; solicit + nil ;;; depth + nil ;;; number-control + nil ;;; index + t))));;; do-successors + (outline-recent-depth)) +;;;_ > outline-number-siblings (&optional denumber) (defun outline-number-siblings (&optional denumber) - " Assign numbered topic prefix to this topic and its siblings. + "Assign numbered topic prefix to this topic and its siblings. - With universal argument, denumber - assign default bullet to this - topic and its siblings. +With universal argument, denumber - assign default bullet to this +topic and its siblings. - With repeated universal argument (`^U^U'), solicit bullet for each - rebulleting each topic at this level." +With repeated universal argument (`^U^U'), solicit bullet for each +rebulleting each topic at this level." (interactive "P") (save-excursion (outline-back-to-current-heading) (outline-beginning-of-level) - (let ((index (if (not denumber) 1)) + (let ((depth (outline-recent-depth)) + (index (if (not denumber) 1)) (use-bullet (equal '(16) denumber)) (more t)) (while more (outline-rebullet-heading use-bullet ;;; solicit - nil ;;; depth + depth ;;; depth t ;;; number-control index ;;; index nil) ;;; do-successors (if index (setq index (1+ index))) - (setq more (outline-next-sibling))) - ) - ) - ) -;;;_ > outline-shift-in (arg) + (setq more (outline-next-sibling depth nil)))))) +;;;_ > outline-shift-in (arg) (defun outline-shift-in (arg) - " Decrease prefix depth of current heading and any topics collapsed - within it." + "Decrease prefix depth of current heading and any topics collapsed +within it." (interactive "p") (outline-rebullet-topic arg)) -;;;_ > outline-shift-out (arg) +;;;_ > outline-shift-out (arg) (defun outline-shift-out (arg) - " Decrease prefix depth of current heading and any topics collapsed - within it." + "Decrease prefix depth of current heading and any topics collapsed +within it." (interactive "p") (outline-rebullet-topic (* arg -1))) -;;;_ . Surgery (kill-ring) functions with special provisions for outlines: -;;;_ > outline-kill-line (&optional arg) +;;;_ : Surgery (kill-ring) functions with special provisions for outlines: +;;;_ > outline-kill-line (&optional arg) (defun outline-kill-line (&optional arg) - " Kill line, adjusting subsequent lines suitably for outline mode." + "Kill line, adjusting subsequent lines suitably for outline mode." (interactive "*P") - (if (not (and - (boundp 'outline-mode) outline-mode ; active outline mode, - outline-numbered-bullet ; numbers may need adjustment, - (bolp) ; may be clipping topic head, - (looking-at outline-regexp))) ; are clipping topic head. + (if (not (and (outline-mode-p) ; active outline mode, + outline-numbered-bullet ; numbers may need adjustment, + (bolp) ; may be clipping topic head, + (looking-at outline-regexp))) ; are clipping topic head. ;; Above conditions do not obtain - just do a regular kill: (kill-line arg) ;; Ah, have to watch out for adjustments: - (let* ((depth (outline-depth)) - (ascender depth)) + (let* ((depth (outline-depth))) + ; Do the kill: (kill-line arg) + ; Provide some feedback: (sit-for 0) (save-excursion + ; Start with the topic + ; following killed line: (if (not (looking-at outline-regexp)) (outline-next-heading)) - (if (> (outline-depth) depth) - ;; An intervening parent was removed from after a subtree: - (setq depth (outline-recent-depth))) - (while (and (> (outline-depth) 0) - (> (outline-recent-depth) ascender) - (outline-ascend-to-depth (setq ascender - (1- ascender))))) - ;; Have to try going forward until we find another at - ;; desired depth: - (if (and outline-numbered-bullet - (outline-descend-to-depth depth)) - (outline-rebullet-heading nil ;;; solicit - depth ;;; depth - nil ;;; number-control - nil ;;; index - t) ;;; do-successors - ) - ) - ) - ) - ) -;;;_ > outline-kill-topic () + (outline-renumber-to-depth depth))))) +;;;_ > outline-kill-topic () (defun outline-kill-topic () - " Kill topic together with subtopics." + "Kill topic together with subtopics. + +Leaves primary topic's trailing vertical whitespace, if any." ;; Some finagling is done to make complex topic kills appear faster ;; than they actually are. A redisplay is performed immediately @@ -2232,162 +2533,204 @@ parameterized communication between the two, if suitable.") ;; a lag *after* the kill has been performed. (interactive) - (let* ((beg (outline-back-to-current-heading)) + (let* ((beg (prog1 (outline-back-to-current-heading)(beginning-of-line))) (depth (outline-recent-depth))) (outline-end-of-current-subtree) (if (not (eobp)) - (forward-char 1)) + (if (or (not (looking-at "^$")) + ;; A blank line - cut it with this topic *unless* this + ;; is the last topic at this level, in which case + ;; we'll leave the blank line as part of the + ;; containing topic: + (save-excursion + (and (outline-next-heading) + (>= (outline-recent-depth) depth)))) + (forward-char 1))) + (kill-region beg (point)) (sit-for 0) (save-excursion - (if (and outline-numbered-bullet - (outline-descend-to-depth depth)) - (outline-rebullet-heading nil ;;; solicit - depth ;;; depth - nil ;;; number-control - nil ;;; index - t) ;;; do-successors - ) - ) - ) - ) -;;;_ > outline-yank (&optional arg) -(defun outline-yank (&optional arg) - " Like regular yank, except does depth adjustment of yanked topics, when: + (outline-renumber-to-depth depth)))) +;;;_ > outline-yank-processing () +(defun outline-yank-processing (&optional arg) - 1 the stuff being yanked starts with a valid outline header prefix, and - 2 it is being yanked at the end of a line which consists of only a valid + "Incidental outline-specific business to be done just after text yanks. +Does depth adjustment of yanked topics, when: + +1 the stuff being yanked starts with a valid outline header prefix, and +2 it is being yanked at the end of a line which consists of only a valid topic prefix. - If these two conditions hold then the depth of the yanked topics - are all adjusted the amount it takes to make the first one at the - depth of the header into which it's being yanked. +Also, adjusts numbering of subsequent siblings when appropropriate. - The point is left in from of yanked, adjusted topics, rather than - at the end (and vice-versa with the mark). Non-adjusted yanks, - however, (ones that don't qualify for adjustment) are handled - exactly like normal yanks. +Depth adjustment alters the depth of all the topics being yanked +the amount it takes to make the first topic have the depth of the +header into which it's being yanked. - Outline-yank-pop is used with outline-yank just as normal yank-pop - is used with normal yank in non-outline buffers." +The point is left in front of yanked, adjusted topics, rather than +at the end (and vice-versa with the mark). Non-adjusted yanks, +however, are left exactly like normal, non-outline-specific yanks." + + (interactive "*P") + ; Get to beginning, leaving + ; region around subject: + (if (< (mark-marker) (point)) + (exchange-point-and-mark)) + (let* ((subj-beg (point)) + (subj-end (mark-marker)) + ;; 'resituate' if yanking an entire topic into topic header: + (resituate (and (outline-e-o-prefix-p) + (looking-at (concat "\\(" outline-regexp "\\)")) + (outline-prefix-data (match-beginning 1) + (match-end 1)))) + ;; 'rectify-numbering' if resituating (where several topics may + ;; be resituating) or yanking a topic into a topic slot (bol): + (rectify-numbering (or resituate + (and (bolp) (looking-at outline-regexp))))) + (if resituate + ; The yanked stuff is a topic: + (let* ((prefix-len (- (match-end 1) subj-beg)) + (subj-depth (outline-recent-depth)) + (prefix-bullet (outline-recent-bullet)) + (adjust-to-depth + ;; Nil if adjustment unnecessary, otherwise depth to which + ;; adjustment should be made: + (save-excursion + (and (goto-char subj-end) + (eolp) + (goto-char subj-beg) + (and (looking-at outline-regexp) + (progn + (beginning-of-line) + (not (= (point) subj-beg))) + (looking-at outline-regexp) + (outline-prefix-data (match-beginning 0) + (match-end 0))) + (outline-recent-depth)))) + done + (more t)) + (setq rectify-numbering outline-numbered-bullet) + (if adjust-to-depth + ; Do the adjustment: + (progn + (message "... yanking") (sit-for 0) + (save-restriction + (narrow-to-region subj-beg subj-end) + ; Trim off excessive blank + ; line at end, if any: + (goto-char (point-max)) + (if (looking-at "^$") + (outline-unprotected (delete-char -1))) + ; Work backwards, with each + ; shallowest level, + ; successively excluding the + ; last processed topic from + ; the narrow region: + (while more + (outline-back-to-current-heading) + ; go as high as we can in each bunch: + (while (outline-ascend-to-depth (1- (outline-depth)))) + (save-excursion + (outline-rebullet-topic-grunt (- adjust-to-depth + subj-depth)) + (outline-depth)) + (if (setq more (not (bobp))) + (progn (widen) + (forward-char -1) + (narrow-to-region subj-beg (point)))))) + (message "") + ;; Preserve new bullet if it's a distinctive one, otherwise + ;; use old one: + (if (string-match (regexp-quote prefix-bullet) + outline-distinctive-bullets-string) + ; Delete from bullet of old to + ; before bullet of new: + (progn + (beginning-of-line) + (delete-region (point) subj-beg) + (set-marker (mark-marker) subj-end) + (goto-char subj-beg) + (outline-end-of-prefix)) + ; Delete base subj prefix, + ; leaving old one: + (delete-region (point) (+ (point) + prefix-len + (- adjust-to-depth subj-depth))) + ; and delete residual subj + ; prefix digits and space: + (while (looking-at "[0-9]") (delete-char 1)) + (if (looking-at " ") (delete-char 1)))) + (exchange-point-and-mark)))) + (if rectify-numbering + (progn + (save-excursion + ; Give some preliminary feedback: + (message "... reconciling numbers") (sit-for 0) + ; ... and renumber, in case necessary: + (goto-char subj-beg) + (if (outline-goto-prefix) + (outline-rebullet-heading nil ;;; solicit + (outline-depth) ;;; depth + nil ;;; number-control + nil ;;; index + t)) + (message "")))) + (if (not resituate) + (exchange-point-and-mark)))) +;;;_ > outline-yank (&optional arg) +(defun outline-yank (&optional arg) + "Like yank, with depth and numbering adjustment of yanked topics in +outline mode. Non-topic yanks work no differntly than normal yanks. + +If a topic is being yanked into a bare topic prefix, the depth of the +yanked topic is adjusted to the depth of the topic prefix. + + 1 we're yanking in an outline-mode buffer + 2 the stuff being yanked starts with a valid outline header prefix, and + 3 it is being yanked at the end of a line which consists of only a valid + topic prefix. + +If these conditions hold then the depth of the yanked topics are all +adjusted the amount it takes to make the first one at the depth of the +header into which it's being yanked. + +The point is left in front of yanked, adjusted topics, rather than +at the end (and vice-versa with the mark). Non-adjusted yanks, +however, (ones that don't qualify for adjustment) are handled +exactly like normal yanks. + +Numbering of yanked topics, and the succesive siblings at the depth +into which they're being yanked, is adjusted. + +Outline-yank-pop works with outline-yank just like normal yank-pop +works with normal yank in non-outline buffers." (interactive "*P") (setq this-command 'yank) - (if (not (and (boundp 'outline-mode) outline-mode)) - - ;; Outline irrelevant - just do regular yank: - (yank arg) - - ;; Outline *is* relevant: - (let ((beginning (point)) - topic-yanked - established-depth) ; Depth of the prefix into which we're yanking. - ;; Get current depth and numbering ... Oops, not doing anything - ;; with the number just yet... - (if (and (eolp) - (save-excursion (beginning-of-line) - (looking-at outline-regexp))) - (setq established-depth (- (match-end 0) (match-beginning 0)))) - (yank arg) - (exchange-dot-and-mark) - (if (and established-depth ; the established stuff qualifies. - ;; The yanked stuff also qualifies - is topic(s): - (looking-at (concat "\\(" outline-regexp "\\)"))) - ;; Ok, adjust the depth of the yanked stuff. Note that the - ;; stuff may have more than a single root, so we have to - ;; iterate over all the top level ones yanked, and do them in - ;; such a way that the adjustment of one new one won't affect - ;; any of the other new ones. We use the focus of the - ;; narrowed region to successively exclude processed siblings. - (let* ((yanked-beg (match-beginning 1)) - (yanked-end (match-end 1)) - (yanked-bullet (buffer-substring (1- yanked-end) yanked-end)) - (yanked-depth (- yanked-end yanked-beg)) - (depth-diff (- established-depth yanked-depth)) - done - (more t)) - (setq topic-yanked t) - (save-excursion - (save-restriction - (narrow-to-region yanked-beg (mark)) - ;; First trim off excessive blank line at end, if any: - (goto-char (point-max)) - (if (looking-at "^$") (delete-char -1)) - (goto-char (point-min)) - ;; Work backwards, with each shallowest level, - ;; successively excluding the last processed topic - ;; from the narrow region: - (goto-char (point-max)) - (while more - (outline-back-to-current-heading) - ;; go as high as we can in each bunch: - (while (outline-ascend-to-depth - (1- (outline-depth)))) - (save-excursion - (outline-rebullet-topic-grunt depth-diff - (outline-depth) - (point))) - (if (setq more (not (bobp))) - (progn (widen) - (forward-char -1) - (narrow-to-region yanked-beg (point))))))) - ;; Preserve new bullet if it's a distinctive one, otherwise - ;; use old one: - (if (string-match yanked-bullet outline-distinctive-bullets-string) - (delete-region (save-excursion - (beginning-of-line) - (point)) - yanked-beg) - (delete-region yanked-beg (+ yanked-beg established-depth)) - ;; and extraneous digits and a space: - (while (looking-at "[0-9]") (delete-char 1)) - (if (looking-at " ") (delete-char 1)) - ) - (goto-char yanked-beg) - ) - ;; Not established-depth or looking-at... - (setq topic-yanked (looking-at outline-regexp)) - (exchange-dot-and-mark)) - (if (and topic-yanked outline-numbered-bullet) - (progn - ;; Renumber, in case necessary: - (sit-for 0) - (save-excursion - (goto-char beginning) - (if (outline-goto-prefix) - (outline-rebullet-heading nil ;;; solicit - (outline-depth) ;;; depth - nil ;;; number-control - nil ;;; index - t) ;;; do-successors - ) - ) - ) - ) - ) - ) - ) -;;;_ > outline-yank-pop (&optional arg) + (yank arg) + (if (outline-mode-p) + (outline-yank-processing))) +;;;_ > outline-yank-pop (&optional arg) (defun outline-yank-pop (&optional arg) - " Just like yank-pop, but works like outline-yank when popping - topics just after fresh outline prefixes. Adapts level of popped - stuff to level of fresh prefix." + "Just like yank-pop, but works like outline-yank when popping +topics just after fresh outline prefixes. Adapts level of popped +stuff to level of fresh prefix. + +Note - prefix changes to distinctive bullets will stick, if followed +by pops to non-distinctive yanks. Bug..." (interactive "*p") - (if (not (eq last-command 'yank)) - (error "Previous command was not a yank")) (setq this-command 'yank) - (delete-region (point) (mark)) - (rotate-yank-pointer arg) - (outline-yank) - ) + (yank-pop arg) + (if (outline-mode-p) + (outline-yank-processing))) -;;;_ : Specialty bullet functions -;;;_ . File Cross references -;;;_ > outline-resolve-xref () +;;;_ - Specialty bullet functions +;;;_ : File Cross references +;;;_ > outline-resolve-xref () (defun outline-resolve-xref () - " Pop to file associated with current heading, if it has an xref bullet - (according to setting of 'outline-file-xref-bullet')." + "Pop to file associated with current heading, if it has an xref bullet +\(according to setting of 'outline-file-xref-bullet')." (interactive) (if (not outline-file-xref-bullet) (error @@ -2425,17 +2768,17 @@ parameterized communication between the two, if suitable.") ) ) ) -;;;_ > outline-to-entry-end - Unmaintained compatibility - ignore this! +;;;_ > outline-to-entry-end - Unmaintained compatability - ignore this! ;------------------------------------------------------------------- ; Something added solely for use by a "smart menu" package someone got ; off the net. I have no idea whether this is appropriate code. (defvar next-entry-exists nil "Used by outline-to-entry-end, dunno why.") (defun outline-to-entry-end (&optional include-sub-entries curr-entry-level) - " Go to end of whole entry if optional INCLUDE-SUB-ENTRIES is non-nil. - CURR-ENTRY-LEVEL is an integer representing the length of the current level - string which matched to 'outline-regexp'. If INCLUDE-SUB-ENTRIES is nil, - CURR-ENTRY-LEVEL is not needed." + "Go to end of whole entry if optional INCLUDE-SUB-ENTRIES is non-nil. +CURR-ENTRY-LEVEL is an integer representing the length of the current level +string which matched to 'outline-regexp'. If INCLUDE-SUB-ENTRIES is nil, +CURR-ENTRY-LEVEL is not needed." (while (and (setq next-entry-exists (re-search-forward outline-regexp nil t)) include-sub-entries @@ -2445,57 +2788,1023 @@ parameterized communication between the two, if suitable.") (if next-entry-exists (progn (beginning-of-line) (point)) (goto-char (point-max)))) + ;;; Outline topic prefix and level adjustment funcs: -;;;_ #6 miscellaneous -;;;_ > outline-copy-exposed (&optional workbuf) -(defun outline-copy-exposed (&optional workbuf) - " Duplicate buffer to other buffer, sans hidden stuff. +;;;_ #5 Exposure Control and Processing + +;;;_ - Fundamental +;;;_ > outline-flag-region (from to flag) +(defmacro outline-flag-region (from to flag) + "Hides or shows lines from FROM to TO, according to +emacs selective-display FLAG char. Ie, text following flag C-m +\(carriage-return) is hidden until the next C-j (newline) char. + +Returns nil iff no changes were effected." + (` (let ((buffer-read-only nil) + (outline-override-protect t)) + (subst-char-in-region (, from) (, to) + (if (= (, flag) ?\n) ?\r ?\n) + (, flag) t)))) +;;;_ > outline-flag-current-subtree (flag) +(defun outline-flag-current-subtree (flag) + (save-excursion + (outline-back-to-current-heading) + (outline-flag-region (point) + (progn (outline-end-of-current-subtree) (1- (point))) + flag))) + +;;;_ - Mapping and processing of topics +;;;_ " See also chart functions, in navigation +;;;_ > outline-listify-exposed (&optional start end) +(defun outline-listify-exposed (&optional start end) + + "Produce a list representing exposed topics in current region. +This list can then be used by 'outline-process-exposed' to manipulate +the subject region. + +List is composed of elements that may themselves be lists representing +exposed components in subtopic. + +Each component list contains: + - a number representing the depth of the topic, + - a string representing the header-prefix (ref. 'outline-header-prefix'), + - a string representing the bullet character, + - and a series of strings, each containing one line of the exposed + portion of the topic entry." + + (interactive "r") + (save-excursion + (let* (strings pad result depth bullet beg next done) ; State vars. + (goto-char start) + (beginning-of-line) + (if (not (outline-goto-prefix)) ; Get initial position within a topic: + (outline-next-visible-heading 1)) + (while (and (not done) + (not (eobp)) ; Loop until we've covered the region. + (not (> (point) end))) + (setq depth (outline-recent-depth) ; Current topics' depth, + bullet (outline-recent-bullet) ; ... bullet, + beg (progn (outline-end-of-prefix t) (point))) ; and beginning. + (setq done ; The boundary for the current topic: + (not (outline-next-visible-heading 1))) + (beginning-of-line) + (setq next (point)) + (goto-char beg) + (setq strings nil) + (while (> next (point)) ; Get all the exposed text in + (setq strings + (cons (buffer-substring + beg + ;To hidden text or end of line: + (progn + (search-forward "\r" + (save-excursion (end-of-line) + (point)) + 1) + (if (= (preceding-char) ?\r) + (1- (point)) + (point)))) + strings)) + (if (< (point) next) ; Resume from after hid text, if any. + (forward-line 1)) + (setq beg (point))) + ;; Accumulate list for this topic: + (setq result + (cons (append (list depth + outline-header-prefix + bullet) + (nreverse strings)) + result))) + ;; Put the list with first at front, to last at back: + (nreverse result)))) +;;;_ > outline-process-exposed (arg &optional tobuf) +(defun outline-process-exposed (&optional func from to frombuf tobuf) + "Apply FUNCTION \(default 'outline-insert-listified) to exposed +portions FROM position TO position \(default region, or the entire +buffer if no region active) in buffer FROMBUF \(default current +buffer) to buffer TOBUF \(default is buffer named like frombuf but +with \"*\" prepended and \" exposed*\" appended). + +The function must as its arguments the elements of the list +representations of topic entries produced by outline-listify-exposed." + + ; Resolve arguments, + ; defaulting if necessary: + (if (not func) (setq func 'outline-insert-listified)) + (if (not (and from to)) + (if mark-active + (setq from (region-beginning) to (region-end)) + (setq from (point-min) to (point-max)))) + (if frombuf + (if (not (bufferp frombuf)) + ;; Specified but not a buffer - get it: + (let ((got (get-buffer frombuf))) + (if (not got) + (error (concat "outline-process-exposed: source buffer " + frombuf + " not found.")) + (setq frombuf got)))) + ;; not specified - default it: + (setq frombuf (current-buffer))) + (if tobuf + (if (not (bufferp tobuf)) + (setq tobuf (get-buffer-create tobuf))) + ;; not specified - default it: + (setq tobuf (concat "*" (buffer-name frombuf) " exposed*"))) + + (let* ((listified (progn (set-buffer frombuf) + (outline-listify-exposed from to))) + (prefix outline-header-prefix) ; ... as set in frombuf. + curr) + (set-buffer tobuf) + (while listified + (setq curr (car listified)) + (setq listified (cdr listified)) + (apply func (list (car curr) ; depth + (car (cdr curr)) ; header-prefix + (car (cdr (cdr curr))) ; bullet + (cdr (cdr (cdr curr)))))) ; list of text lines + (pop-to-buffer tobuf))) + +;;;_ - Topic-specific +;;;_ > outline-show-entry () +; outline-show-entry basically for isearch dynamic exposure, as is... +(defun outline-show-entry () + "Like outline-show-current-entry, but reveals an entry that is nested +within hidden topics. + +This is a way to give restricted peek at a concealed locality without the +expense of exposing its context, but can leave the outline with aberrant +exposure. outline-hide-current-entry-completely or outline-show-offshoot +should be used after the peek to rectify the exposure." + + (interactive) + (save-excursion + (outline-goto-prefix) + (outline-flag-region (if (bobp) (point) (1- (point))) + (or (outline-pre-next-preface) (point)) + ?\n))) +;;;_ > outline-show-children (&optional level strict) +(defun outline-show-children (&optional level strict) + + "If point is visible, show all direct subheadings of this heading. +Otherwise, do outline-show-to-offshoot, and then show subheadings. + +Optional LEVEL specifies how many levels below the current level +should be shown, or all levels if t. Default is 1. + +Optional STRICT means don't resort to -show-to-offshoot, no matter +what. This is basically so -show-to-offshoot, which is called by +this function, can employ the pure offspring-revealing capabilities of +it." + + (interactive "p") + (if (and (not strict) + (outline-hidden-p)) + + (progn (outline-show-to-offshoot) ; Point's concealed, open to expose it. + ;; Then recurse, but with "strict" set so we don't + ;; infinite regress: + (outline-show-children level t)) + + (save-excursion + (save-restriction + (let* ((start-pt (point)) + (chart (outline-chart-subtree)) + (e-o-subtree (point)) + (to-reveal (outline-chart-to-reveal chart (or level 1)))) + (goto-char start-pt) + (if (and strict (= (preceding-char) ?\r)) + ;; Concealed root would already have been taken care of, + ;; unless strict was set. + (outline-flag-region (point) (outline-snug-back) ?\n)) + (while to-reveal + (goto-char (car to-reveal)) + (outline-flag-region (point) (outline-snug-back) ?\n) + (setq to-reveal (cdr to-reveal)))))))) +;;;_ x outline-show-current-children (&optional level strict) +(defun outline-show-current-children (&optional level strict) + "This command was misnamed, 'outline-show-children' is the proper +name. Use it instead. + +\(The \"current\" in the name is supposed to imply that it works on +the visible topic containing point, while it really works with respect +to the most immediate topic, concealed or not. I'll leave this old +name around for a bit, but i'll soon activate an annoying message to +warn people about the change, and then deprecate this alias." + + (interactive "p") + ;;(beep) + ;;(message (format "Use '%s' instead of '%s' (%s)." + ;; "outline-show-children" + ;; "outline-show-current-children" + ;; (buffer-name (current-buffer)))) + (outline-show-children level strict)) +;;;_ > outline-hide-point-reconcile () +(defun outline-hide-reconcile () + "Like outline-hide-current-entry, but hides completely if contained within +hidden region. + +Specifically intended for aberrant exposure states, like entries that were +exposed by outline-show-entry but are within otherwise concealed regions." + (interactive) + (save-excursion + (outline-goto-prefix) + (outline-flag-region (if (not (bobp)) (1- (point)) (point)) + (progn (outline-pre-next-preface) + (if (= ?\r (following-char)) + (point) + (1- (point)))) + ?\r))) +;;;_ > outline-show-to-offshoot () +(defun outline-show-to-offshoot () + "Like outline-show-entry, but reveals opens all concealed ancestors, +as well. + +Like outline-hide-current-entry-completely, useful for rectifying aberrant +exposure states produced by outline-show-entry." + + (interactive) + (save-excursion + (let ((orig-pt (point)) + (orig-pref (outline-goto-prefix)) + (last-at (point)) + bag-it) + (while (or bag-it (= (preceding-char) ?\r)) + (beginning-of-line) + (if (= last-at (setq last-at (point))) + ;; Oops, we're not making any progress! Show the current + ;; topic completely, and bag this try. + (progn (beginning-of-line) + (outline-show-current-subtree) + (goto-char orig-pt) + (setq bag-it t) + (beep) + (message "%s: %s" + "outline-show-to-offshoot: " + "Aberrant nesting encountered."))) + (outline-show-children) + (goto-char orig-pref)) + (goto-char orig-pt) + (outline-show-entry)))) +;;;_ > outline-hide-current-entry () +(defun outline-hide-current-entry () + "Hide the body directly following this heading." + (interactive) + (outline-back-to-current-heading) + (save-excursion + (outline-flag-region (point) + (progn (outline-end-of-current-entry) (point)) + ?\^M))) +;;;_ > outline-show-current-entry (&optional arg) +(defun outline-show-current-entry (&optional arg) + + "Show body following current heading, or hide the entry if repeat +count." + + (interactive "P") + (if arg + (outline-hide-current-entry) + (save-excursion + (outline-flag-region (point) + (progn (outline-end-of-current-entry) (point)) + ?\n)))) +;;;_ > outline-hide-current-entry-completely () +; ... outline-hide-current-entry-completely also for isearch dynamic exposure: +(defun outline-hide-current-entry-completely () + "Like outline-hide-current-entry, but conceal topic completely. + +Specifically intended for aberrant exposure states, like entries that were +exposed by outline-show-entry but are within otherwise concealed regions." + (interactive) + (save-excursion + (outline-goto-prefix) + (outline-flag-region (if (not (bobp)) (1- (point)) (point)) + (progn (outline-pre-next-preface) + (if (= ?\r (following-char)) + (point) + (1- (point)))) + ?\r))) +;;;_ > outline-show-current-subtree () +(defun outline-show-current-subtree () + "Show everything after this heading at deeper levels." + (interactive) + (outline-flag-current-subtree ?\n)) +;;;_ > outline-hide-current-subtree (&optional just-close) +(defun outline-hide-current-subtree (&optional just-close) + + "Hide everything after this heading at deeper levels, or if it's +already closed, and optional arg JUST-CLOSE is nil, hide the current +level." + + (interactive) + (let ((orig-eol (save-excursion + (end-of-line)(outline-goto-prefix)(end-of-line)(point)))) + (outline-flag-current-subtree ?\^M) + (if (and (= orig-eol (save-excursion (goto-char orig-eol) + (end-of-line) + (point))) + ;; Structure didn't change - try hiding current level: + (if (not just-close) + (outline-up-current-level 1 t))) + (outline-hide-current-subtree)))) +;;;_ > outline-show-current-branches () +(defun outline-show-current-branches () + "Show all subheadings of this heading, but not their bodies." + (interactive) + (beginning-of-line) + (outline-show-children t)) +;;;_ > outline-hide-current-leaves () +(defun outline-hide-current-leaves () + "Hide the bodies of the current topic and all its' offspring." + (interactive) + (outline-back-to-current-heading) + (outline-hide-region-body (point) (progn (outline-end-of-current-subtree) + (point)))) + +;;;_ - Region and beyond +;;;_ > outline-show-all () +(defun outline-show-all () + "Show all of the text in the buffer." + (interactive) + (outline-flag-region (point-min) (point-max) ?\n)) +;;;_ > outline-hide-bodies () +(defun outline-hide-bodies () + "Hide all of buffer except headings." + (interactive) + (outline-hide-region-body (point-min) (point-max))) +;;;_ > outline-hide-region-body (start end) +(defun outline-hide-region-body (start end) + "Hide all body lines in the region, but not headings." + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (not (eobp)) + (outline-flag-region (point) + (progn (outline-pre-next-preface) (point)) ?\^M) + (if (not (eobp)) + (forward-char + (if (looking-at "[\n\r][\n\r]") + 2 1))))))) +;;;_ > outline-expose-topic (spec &optional prev-spec) +(defun outline-expose-topic (spec &optional prev-spec) + + "Dictate wholesale exposure scheme for current level. + +Unless you want the args to be evaluated, you probably want to use the +frontend `outline-new-exposure', instead. + +Cursor is left at start position. + +SPEC is either a number or, recursively, a list. + +A simple spec \(either a number, one of a few symbols, or the null +list) dictates the overall exposure for the current topic. + +Non null lists are complex specs, designating exposure for the current +topic and its respective siblings. The ':' repeat spec is used to +specify exposure for any number of successive siblings, up to the +trailing ones for which there are explicit specs following the ':'. + +Simple (numeric and null-list) specs are interpreted as follows: + + - Numbers indicate the relative depth to open the corresponding topic. + - negative numbers force the topic to be closed before opening to the + absolute value of the number, so all siblings are open only to + that level. + - positive numbers open to the relative depth indicated by the + number, but do not force already opened subtopics to be closed. + - 0 means to close topic - hide all offspring. + - ':' 'repeat' + apply prior element to all siblings at current level, *up to* + those siblings that would be covered by specs following the ':' + on the list. Ie, apply to all topics at level but the last + ones. \(Only first of multiple colons at same level is + respected - subsequent ones are discarded.) + - '*' completely opens the topic, including bodies. + - '+' shows all the sub headers, but not the bodies + - '-' exposes the body and immediate offspring of the corresponding topic. + +If the spec is a list, the first element must be a number, which +dictates the exposure depth of the topic as a whole. Subsequent +elements of the list are nested SPECs, dictating the specific exposure +for the corresponding offspring of the topic. + +Examples: +\(outline-expose-topic '(-1 : 0)) + Close this and all following topics at current level, exposing + only their immediate children, but close down the last topic + at this current level completely. +\(outline-expose-topic '(-1 () : 1 0)) + Close current topic so only the immediate subtopics are shown; + show the children in the second to last topic, and completely + close the last one. +\(outline-expose-topic -2 ': -1 '*)) + Expose children and grandchildren of all topics at current + level except the last two; expose children of the second to + last and completely open the last one." + + (interactive "xExposure spec: ") + (let ((depth (outline-current-depth)) + done + max-pos) + (cond ((null spec) nil) + ((symbolp spec) + (cond ((eq spec '*) (outline-show-current-subtree)) + ((eq spec '+) (outline-show-current-branches)) + ((eq spec '-) (outline-show-current-entry)) + ((eq spec ':) + ;; Whoops. ':' should have been caught at superior + ;; level. + (error + "outline-expose-topic: improper exposure spec - bare ':'")))) + ((numberp spec) + (if (>= 0 spec) + (save-excursion (outline-hide-current-subtree t) + (end-of-line) + (if (or (not max-pos) + (> (point) max-pos)) + (setq max-pos (point))) + (if (> 0 spec) + (setq spec (* -1 spec))))) + (if (> spec 0) + (outline-show-children spec))) + ((listp spec) + (if (eq (car spec) ':) + (setq spec + ;; Expand the 'repeat' spec to an explicit version, + ;; w.r.t. remaining siblings: + (let* (;; Assign rest-spec to preserve first elem in cdr. + (rest-spec (delq ': (cdr spec))) + ;; residue: # of sibs not covered by remaining spec + (residue (- (length (outline-chart-siblings)) + (length rest-spec)))) + (if (>= 0 residue) + ;; remaining spec covers all - just use it: + rest-spec + ;; cover residue by prev-spec, rest by rest-spec: + (nconc (make-list residue prev-spec) rest-spec))))) + (setq max-pos (or (outline-expose-topic (car spec) prev-spec) + max-pos)) + (setq prev-spec (car spec)) + (setq spec (cdr spec)) + (and + (if max-pos + ;; Capitalize on max-pos state to get us nearer next sibling: + (progn (goto-char (min (point-max) max-pos)) + (outline-next-heading)) + (outline-next-sibling depth)) + (let ((got (outline-expose-topic spec prev-spec))) + (if (and got (or (not max-pos) (> got max-pos))) + (setq max-pos got)))))) + max-pos)) +;;;_ > outline-old-expose-topic (spec &rest followers) +(defun outline-old-expose-topic (spec &rest followers) + + "Dictate wholesale exposure scheme for current topic, according to SPEC. + +SPEC is either a number or a list. Optional successive args +dictate exposure for subsequent siblings of current topic. + +A simple spec (either a number, a special symbol, or the null list) +dictates the overall exposure for a topic. Non null lists are +composite specs whose first element dictates the overall exposure for +a topic, with the subsequent elements in the list interpreted as specs +that dictate the exposure for the successive offspring of the topic. + +Simple (numeric and null-list) specs are interpreted as follows: + + - Numbers indicate the relative depth to open the corresponding topic: + - negative numbers force the topic to be close before opening to the + absolute value of the number. + - positive numbers just open to the relative depth indicated by the number. + - 0 just closes + - '*' completely opens the topic, including bodies. + - '+' shows all the sub headers, but not the bodies + - '-' exposes the body and immediate offspring of the corresponding topic. - Without repeat count, this simple-minded function just generates - the new buffer by concatenating the current buffer name with \" - exposed\", and doing a 'get-buffer' on it." +If the spec is a list, the first element must be a number, which +dictates the exposure depth of the topic as a whole. Subsequent +elements of the list are nested SPECs, dictating the specific exposure +for the corresponding offspring of the topic. + +Optional FOLLOWER arguments dictate exposure for succeeding siblings." + + (interactive "xExposure spec: ") + (let ((depth (outline-current-depth)) + done + max-pos) + (cond ((null spec) nil) + ((symbolp spec) + (if (eq spec '*) (outline-show-current-subtree)) + (if (eq spec '+) (outline-show-current-branches)) + (if (eq spec '-) (outline-show-current-entry))) + ((numberp spec) + (if (>= 0 spec) + (save-excursion (outline-hide-current-subtree t) + (end-of-line) + (if (or (not max-pos) + (> (point) max-pos)) + (setq max-pos (point))) + (if (> 0 spec) + (setq spec (* -1 spec))))) + (if (> spec 0) + (outline-show-children spec))) + ((listp spec) + ;(let ((got (outline-old-expose-topic (car spec)))) + ; (if (and got (or (not max-pos) (> got max-pos))) + ; (setq max-pos got))) + (let ((new-depth (+ (outline-current-depth) 1)) + got) + (setq max-pos (outline-old-expose-topic (car spec))) + (setq spec (cdr spec)) + (if (and spec + (outline-descend-to-depth new-depth) + (not (outline-hidden-p))) + (progn (setq got (apply 'outline-old-expose-topic spec)) + (if (and got (or (not max-pos) (> got max-pos))) + (setq max-pos got))))))) + (while (and followers + (progn (if (and max-pos (< (point) max-pos)) + (progn (goto-char max-pos) + (setq max-pos nil))) + (end-of-line) + (outline-next-sibling depth))) + (outline-old-expose-topic (car followers)) + (setq followers (cdr followers))) + max-pos)) +;;;_ > outline-new-exposure '() +(defmacro outline-new-exposure (&rest spec) + "Literal frontend for `outline-expose-topic', doesn't evaluate arguments. +All arguments that would need to be quoted in outline-expose-topic need not +be in outline-exposure. + +Cursor is left at start position. + +Use this instead of obsolete 'outline-exposure'. + +Examples: +\(outline-exposure (-1 () () () 1) 0) + Close current topic at current level so only the immediate + subtopics are shown, except also show the children of the + third subtopic; and close the next topic at the current level. +\(outline-exposure : -1 0) + Close all topics at current level to expose only their + immediate children, except for the last topic at the current + level, in which even its' immediate children are hidden. +\(outline-exposure -2 : -1 *) + Expose children and grandchildren of first topic at current + level, and expose children of subsequent topics at current + level *except* for the last, which should be opened completely." + (list 'save-excursion + '(if (not (or (outline-goto-prefix) + (outline-next-heading))) + (error "outline-exposure: Can't find any outline topics.")) + (list 'outline-expose-topic (list 'quote spec)))) +;;;_ > outline-exposure '() +(defmacro outline-exposure (&rest spec) + "Being deprecated - use more recent 'outline-new-exposure' instead. + +Literal frontend for `outline-old-expose-topic', doesn't evaluate arguments +and retains start position." + (list 'save-excursion + '(if (not (or (outline-goto-prefix) + (outline-next-heading))) + (error "Can't find any outline topics.")) + (cons 'outline-old-expose-topic + (mapcar '(lambda (x) (list 'quote x)) spec)))) + +;;;_ #6 Search with Dynamic Exposure (requires v19 isearch or isearch-mode) +;;;_ = outline-search-reconceal +(defvar outline-search-reconceal nil + "Used for outline isearch provisions, to track whether current search +match was concealed outside of search. The value is the location of the +match, if it was concealed, regular if the entire topic was concealed, in +a list if the entry was concealed.") +;;;_ = outline-search-quitting +(defconst outline-search-quitting nil + "Variable used by isearch-terminate/outline-provisions and +isearch-done/outline-provisions to distinguish between a conclusion +and cancellation of a search.") + + +;;;_ > outline-enwrap-isearch () +(defun outline-enwrap-isearch () + "Impose isearch-mode wrappers so isearch progressively exposes and +reconceals hidden topics when working in outline mode, but works +elsewhere. +The function checks to ensure that the rebindings are done only once." + + ; Should isearch-mode be employed, + (if (or (not outline-enwrap-isearch-mode) + ; or are preparations already done? + (fboundp 'real-isearch-terminate)) + + ;; ... no - skip this all: + nil + + ;; ... yes: + + ; Ensure load of isearch-mode: + (if (or (and (fboundp 'isearch-mode) + (fboundp 'isearch-quote-char)) + (condition-case error + (load-library outline-enwrap-isearch-mode) + (file-error (message "Skipping isearch-mode provisions - %s '%s'" + (car (cdr error)) + (car (cdr (cdr error)))) + (sit-for 1) + ;; Inhibit subsequent tries and return nil: + (setq outline-enwrap-isearch-mode nil)))) + ;; Isearch-mode loaded, encapsulate specific entry points for + ;; outline dynamic-exposure business: + (progn + + ; stash crucial isearch-mode + ; funcs under known, private + ; names, then register wrapper + ; functions under the old + ; names, in their stead: + ; 'isearch-quit' is pre v 1.2: + (fset 'real-isearch-terminate + ; 'isearch-quit is pre v 1.2: + (or (if (fboundp 'isearch-quit) + (symbol-function 'isearch-quit)) + (if (fboundp 'isearch-abort) + ; 'isearch-abort' is v 1.2 and on: + (symbol-function 'isearch-abort)))) + (fset 'isearch-quit 'isearch-terminate/outline-provisions) + (fset 'isearch-abort 'isearch-terminate/outline-provisions) + (fset 'real-isearch-done (symbol-function 'isearch-done)) + (fset 'isearch-done 'isearch-done/outline-provisions) + (fset 'real-isearch-update (symbol-function 'isearch-update)) + (fset 'isearch-update 'isearch-update/outline-provisions) + (make-variable-buffer-local 'outline-search-reconceal))))) +;;;_ > outline-isearch-arrival-business () +(defun outline-isearch-arrival-business () + "Do outline business like exposing current point, if necessary, +registering reconcealment requirements in outline-search-reconceal +accordingly. + +Set outline-search-reconceal to nil if current point is not +concealed, to value of point if entire topic is concealed, and a +list containing point if only the topic body is concealed. + +This will be used to determine whether outline-hide-current-entry +or outline-hide-current-entry-completely will be necessary to +restore the prior concealment state." + + (if (outline-mode-p) + (setq outline-search-reconceal + (if (outline-hidden-p) + (save-excursion + (if (re-search-backward outline-line-boundary-regexp nil 1) + ;; Nil value means we got to b-o-b - wouldn't need + ;; to advance. + (forward-char 1)) + ; We'll return point or list + ; containing point, depending + ; on concealment state of + ; topic prefix. + (prog1 (if (outline-hidden-p) (point) (list (point))) + ; And reveal the current + ; search target: + (outline-show-entry))))))) +;;;_ > outline-isearch-advancing-business () +(defun outline-isearch-advancing-business () + "Do outline business like deexposing current point, if necessary, +according to reconceal state registration." + (if (and (outline-mode-p) outline-search-reconceal) + (save-excursion + (if (listp outline-search-reconceal) + ;; Leave the topic visible: + (progn (goto-char (car outline-search-reconceal)) + (outline-hide-current-entry)) + ;; Rehide the entire topic: + (goto-char outline-search-reconceal) + (outline-hide-current-entry-completely))))) +;;;_ > isearch-terminate/outline-provisions () +(defun isearch-terminate/outline-provisions () (interactive) - (if (not workbuf) (setq workbuf (concat (buffer-name) " exposed"))) - (let ((buf (current-buffer))) - (if (not (get-buffer workbuf)) - (generate-new-buffer workbuf)) - (pop-to-buffer workbuf) + (if (and (outline-mode-p) outline-enwrap-isearch-mode) + (outline-isearch-advancing-business)) + (let ((outline-search-quitting t) + (outline-search-reconceal nil)) + (real-isearch-terminate))) +;;;_ > isearch-done/outline-provisions () +(defun isearch-done/outline-provisions (&optional nopush) + (interactive) + (if (and (outline-mode-p) outline-enwrap-isearch-mode) + (progn (if (and outline-search-reconceal + (not (listp outline-search-reconceal))) + ;; The topic was concealed - reveal it, its siblings, + ;; and any ancestors that are still concealed: + (save-excursion + (message "(exposing destination)")(sit-for 0) + (outline-goto-prefix) + ; There may be a closed blank + ; line between prior and + ; current topic that would be + ; missed - provide for it: + (if (not (bobp)) + (progn (forward-char -1) ; newline + (if (eq ?\r (preceding-char)) + (outline-flag-region (1- (point)) + (point) + ?\n)) + (forward-char 1))) + ; Goto parent + (outline-ascend-to-depth (1- (outline-recent-depth))) + (outline-show-children))) + (if (and (boundp 'outline-search-quitting) + outline-search-quitting) + nil + ; We're concluding abort: + (outline-isearch-arrival-business) + (outline-show-children)))) + (if nopush + ;; isearch-done in newer version of isearch mode takes arg: + (real-isearch-done nopush) + (real-isearch-done))) +;;;_ > isearch-update/outline-provisions () +(defun isearch-update/outline-provisions () + "Wrapper around isearch which exposes and conceals hidden outline +portions encountered in the course of searching." + (if (not (and (outline-mode-p) outline-enwrap-isearch-mode)) + ;; Just do the plain business: + (real-isearch-update) + + ;; Ah - provide for outline conditions: + (outline-isearch-advancing-business) + (real-isearch-update) + (cond (isearch-success (outline-isearch-arrival-business)) + ((not isearch-success) (outline-isearch-advancing-business))))) + +;;;_ #7 Copying and printing + +;;;_ - Copy exposed +;;;_ > outline-insert-listified (depth prefix bullet text) +(defun outline-insert-listified (depth prefix bullet text) + (insert-string (concat (if (> depth 1) prefix "") + (make-string (1- depth) ?\ ) + bullet)) + (while text + (insert-string (car text)) + (if (setq text (cdr text)) + (insert-string "\n"))) + (insert-string "\n")) +;;;_ > outline-copy-exposed (arg &optional tobuf) +(defun outline-copy-exposed (arg &optional tobuf) + "Duplicate exposed portions of current topic to buffer with +current buffers' name with \" exposed\" appended to it. + +With repeat count, copy the exposed portions of entire buffer." + + (interactive "P") + (if (not tobuf) + (setq tobuf (get-buffer-create (concat "*" (buffer-name) " exposed*")))) + (let* ((start-pt (point)) + (beg (if arg (point-min) (outline-back-to-current-heading))) + (end (if arg (point-max) (outline-end-of-current-subtree))) + (buf (current-buffer))) + (save-excursion (set-buffer tobuf)(erase-buffer)) + (outline-process-exposed 'outline-insert-listified + beg + end + (current-buffer) + tobuf) + (goto-char (point-min)) + (pop-to-buffer buf) + (goto-char start-pt))) + +;;;_ - LaTeX formatting +;;;_ > outline-latex-verb-quote (str &optional flow) +(defun outline-latex-verb-quote (str &optional flow) + "Return copy of STRING which expresses the original characters +\(including carriage returns) of the string across latex processing." + (mapconcat '(lambda (char) + ;;;mess: (cond ((memq char '(?"" ?$ ?% ?# ?& ?- ?" ?` ?^ ?- ?*));;;")))) + (cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*)) + (concat "\\char" (number-to-string char) "{}")) + ((= char ?\n) "\\\\") + (t (char-to-string char)))) + str + "")) +;;;_ > outline-latex-verbatim-quote-curr-line () +(defun outline-latex-verbatim-quote-curr-line () + "Adjust line contents so it is unaltered \(from the original line) +across latex processing, within the context of a 'verbatim' +environment. Leaves point at the end of the line." + (beginning-of-line) + (let ((beg (point)) + (end (progn (end-of-line)(point)))) + (goto-char beg) + (while (re-search-forward "\\\\" + ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#" + end ; bounded by end-of-line + 1) ; no matches, move to end & return nil + (goto-char (match-beginning 0)) + (insert-string "\\") + (setq end (1+ end)) + (goto-char (1+ (match-end 0)))))) +;;;_ > outline-insert-latex-header (buf) +(defun outline-insert-latex-header (buf) + "Insert initial latex commands at point in BUFFER." + ;; Much of this is being derived from the stuff in appendix of E in + ;; the TeXBook, pg 421. + (set-buffer buf) + (let ((doc-style (format "\n\\documentstyle{%s}\n" + "report")) + (page-numbering (if outline-number-pages + "\\pagestyle{empty}\n" + "")) + (linesdef (concat "\\def\\beginlines{" + "\\par\\begingroup\\nobreak\\medskip" + "\\parindent=0pt\n" + " \\kern1pt\\nobreak \\obeylines \\obeyspaces " + "\\everypar{\\strut}}\n" + "\\def\\endlines{" + "\\kern1pt\\endgroup\\medbreak\\noindent}\n")) + (titlecmd (format "\\newcommand{\\titlecmd}[1]{{%s #1}}\n" + outline-title-style)) + (labelcmd (format "\\newcommand{\\labelcmd}[1]{{%s #1}}\n" + outline-label-style)) + (headlinecmd (format "\\newcommand{\\headlinecmd}[1]{{%s #1}}\n" + outline-head-line-style)) + (bodylinecmd (format "\\newcommand{\\bodylinecmd}[1]{{%s #1}}\n" + outline-body-line-style)) + (setlength (format "%s%s%s%s" + "\\newlength{\\stepsize}\n" + "\\setlength{\\stepsize}{" + outline-indent + "}\n")) + (oneheadline (format "%s%s%s%s%s%s%s" + "\\newcommand{\\OneHeadLine}[3]{%\n" + "\\noindent%\n" + "\\hspace*{#2\\stepsize}%\n" + "\\labelcmd{#1}\\hspace*{.2cm}" + "\\headlinecmd{#3}\\\\[" + outline-line-skip + "]\n}\n")) + (onebodyline (format "%s%s%s%s%s%s" + "\\newcommand{\\OneBodyLine}[2]{%\n" + "\\noindent%\n" + "\\hspace*{#1\\stepsize}%\n" + "\\bodylinecmd{#2}\\\\[" + outline-line-skip + "]\n}\n")) + (begindoc "\\begin{document}\n\\begin{center}\n") + (title (format "%s%s%s%s" + "\\titlecmd{" + (outline-latex-verb-quote (if outline-title + (condition-case err + (eval outline-title) + (error "<unnamed buffer>")) + "Unnamed Outline")) + "}\n" + "\\end{center}\n\n")) + (hsize "\\hsize = 7.5 true in\n") + (hoffset "\\hoffset = -1.5 true in\n") + (vspace "\\vspace{.1cm}\n\n")) + (insert (concat doc-style + page-numbering + titlecmd + labelcmd + headlinecmd + bodylinecmd + setlength + oneheadline + onebodyline + begindoc + title + hsize + hoffset + vspace) + ))) +;;;_ > outline-insert-latex-trailer (buf) +(defun outline-insert-latex-trailer (buf) + "Insert concluding latex commands at point in BUFFER." + (set-buffer buf) + (insert "\n\\end{document}\n")) +;;;_ > outline-latexify-one-item (depth prefix bullet text) +(defun outline-latexify-one-item (depth prefix bullet text) + "Insert LaTeX commands for formatting one item - a topic header and +its' body - of an outline. Args are the topics' numeric DEPTH, the +header PREFIX lead string, the BULLET string, and a list of TEXT +strings for the body." + (let* ((head-line (if text (car text))) + (body-lines (cdr text)) + (curr-line) + body-content bop) + ; Do the head line: + (insert-string (concat "\\OneHeadLine{\\verb\1 " + (outline-latex-verb-quote bullet) + "\1}{" + depth + "}{\\verb\1 " + (if head-line + (outline-latex-verb-quote head-line) + "") + "\1}\n")) + (if (not body-lines) + nil + ;;(insert-string "\\beginlines\n") + (insert-string "\\begin{verbatim}\n") + (while body-lines + (setq curr-line (car body-lines)) + (if (and (not body-content) + (not (string-match "^\\s-*$" curr-line))) + (setq body-content t)) + ; Mangle any occurrences of + ; "\end{verbatim}" in text, + ; it's special: + (if (and body-content + (setq bop (string-match "\\end{verbatim}" curr-line))) + (setq curr-line (concat (substring curr-line 0 bop) + ">" + (substring curr-line bop)))) + ;;(insert-string "|" (car body-lines) "|") + (insert-string curr-line) + (outline-latex-verbatim-quote-curr-line) + (insert-string "\n") + (setq body-lines (cdr body-lines))) + (if body-content + (setq body-content nil) + (forward-char -1) + (insert-string "\\ ") + (forward-char 1)) + ;;(insert-string "\\endlines\n") + (insert-string "\\end{verbatim}\n") + ))) +;;;_ > outline-latexify-exposed (arg &optional tobuf) +(defun outline-latexify-exposed (arg &optional tobuf) + "Copy exposed portions of current topic to TOBUF, formatted for +latex processing. tobuf defaults to a buffer named the same as the +current buffer, but with \"*\" prepended and \" latex-formed*\" +appended. + +With repeat count, copy the exposed portions of entire buffer." + + (interactive "P") + (if (not tobuf) + (setq tobuf + (get-buffer-create (concat "*" (buffer-name) " latexified*")))) + (let* ((start-pt (point)) + (beg (if arg (point-min) (outline-back-to-current-heading))) + (end (if arg (point-max) (outline-end-of-current-subtree))) + (buf (current-buffer))) + (set-buffer tobuf) (erase-buffer) - (insert-buffer buf) - ;; (replace-regexp "\^M[^\^M\^J]*" "") - (while (re-search-forward "\^M[^\^M\^J]*" nil t) - (replace-match "" nil nil)) + (outline-insert-latex-header tobuf) + (goto-char (point-max)) + (outline-process-exposed 'outline-latexify-one-item + beg + end + buf + tobuf) + (goto-char (point-max)) + (outline-insert-latex-trailer tobuf) (goto-char (point-min)) - ) - ) -;;;_ > outlinify-sticky () -(defun outlinify-sticky (&optional arg) - " Activate outline mode and establish file eval to set initial exposure. + (pop-to-buffer buf) + (goto-char start-pt))) + + +;;;_ #8 miscellaneous +;;;_ > outline-mark-topic () +(defun outline-mark-topic () + "Put the region around topic currently containing point." + (interactive) + (beginning-of-line) + (outline-goto-prefix) + (push-mark (point)) + (outline-end-of-current-subtree) + (exchange-point-and-mark)) +;;;_ > outlineify-sticky () +(defun outlineify-sticky (&optional arg) + "Activate outline mode and establish file eval to set initial exposure. - Invoke with a string argument to designate a string to prepend to - topic prefixs, or with a universal argument to be prompted for the - string to be used. Suitable defaults are provided for lisp, - emacs-lisp, c, c++, awk, sh, csh, and perl modes." - - (interactive "P") (outline-mode t) - (cond (arg - (if (stringp arg) - ;; Use arg as the header-prefix: - (outline-lead-with-comment-string arg) - ;; Otherwise, let function solicit string: - (setq arg (outline-lead-with-comment-string)))) - ((member major-mode '(emacs-lisp-mode lisp-mode)) - (setq arg (outline-lead-with-comment-string ";;;_"))) - ((member major-mode '(awk-mode csh-mode sh-mode perl-mode)) - ;; Bare '#' (ie, not '#_') so we don't break the magic number: - (setq arg (outline-lead-with-comment-string "#"))) - ((eq major-mode 'c++-mode) - (setq arg (outline-lead-with-comment-string "//_"))) - ((eq major-mode 'c-mode) - ;; User's will have to know to close off the comments: - (setq arg (outline-lead-with-comment-string "/*_")))) +Invoke with a string argument to designate a string to prepend to +topic prefixs, or with a universal argument to be prompted for the +string to be used. Suitable defaults are provided for lisp, +emacs-lisp, c, c++, awk, sh, csh, and perl modes." + + (interactive "P") (outline-mode t) + + + (let ((leader-cell (assoc major-mode outline-mode-leaders))) + (cond (arg (if (stringp arg) + ;; Use arg as the header-prefix: + (outline-lead-with-comment-string arg) + ;; Otherwise, let function solicit string: + (setq arg (outline-lead-with-comment-string)))) + + (leader-cell + (outline-lead-with-comment-string (cdr leader-cell)) + (setq arg (cdr leader-cell))))) + (let* ((lead-prefix (format "%s%s" (concat outline-header-prefix (if arg " " "")) outline-primary-bullet)) @@ -2521,7 +3830,7 @@ parameterized communication between the two, if suitable.") ; File-vars stuff, at the bottom: (goto-char (point-max)) ; Insert preamble: - (insert-string (format "\n\n%s\n%s %s %s\n%s %s " + (insert-string (format "\n\n%s\n%s %s %s\n%s %s\n" lead-line lead-prefix "local" @@ -2530,7 +3839,7 @@ parameterized communication between the two, if suitable.") "eval:")) ; Insert outline-mode activation: (insert-string - (format "%s\n\t\t%s\n\t\t\t%s\n" + (format "\t %s\n\t\t%s\n\t\t\t%s\n" "(condition-case err" "(save-excursion" "(outline-mode t)")) @@ -2539,24 +3848,24 @@ parameterized communication between the two, if suitable.") (if arg (insert-string (format "\t\t\t(%s \"%s\")\n" "outline-lead-with-comment-string" arg))) - ; Insert announcement and + ; Insert ammouncement and ; exposure control: (insert-string (format "\t\t\t%s %s\n\t\t\t%s %s\n\t\t%s %s" - "(message \"Adjusting '%s' visibility\"" + "(message \"Adjusting '%s' exposure\"" "(buffer-name))" "(goto-char 0)" "(outline-exposure -1 0))" "(error (message " "\"Failed file var 'allout' provisions\")))")) ; Insert postamble: - (insert-string (format "\n%s End: )\n" + (insert-string (format "\n%s End:\n)\n" lead-prefix))))) -;;;_ > solicit-char-in-string (prompt string &optional do-defaulting) +;;;_ > solicit-char-in-string (prompt string &optional do-defaulting) (defun solicit-char-in-string (prompt string &optional do-defaulting) - " Solicit (with first arg PROMPT) choice of a character from string STRING. + "Solicit (with first arg PROMPT) choice of a character from string STRING. - Optional arg DO-DEFAULTING indicates to accept empty input (CR)." +Optional arg DO-DEFAULTING indicates to accept empty input (CR)." (let ((new-prompt prompt) got) @@ -2568,9 +3877,9 @@ parameterized communication between the two, if suitable.") ;; treatment for '?' character. (Might oughta change minibuffer ;; keymap instead, oh well.) (setq got - (char-to-string (let ((cursor-in-echo-area t)) (read-char)))) + (char-to-string (let ((cursor-in-echo-area nil)) (read-char)))) - (if (null (string-match got string)) + (if (null (string-match (regexp-quote got) string)) (if (and do-defaulting (string= got "\^M")) ;; We're defaulting, return null string to indicate that: (setq got "") @@ -2588,13 +3897,68 @@ parameterized communication between the two, if suitable.") ;; got something out of loop - return it: got) ) -;;;_ > string-sans-char (string char) -(defun string-sans-char (string char) - " Return a copy of STRING that lacks all instances of CHAR." - (cond ((string= string "") "") - ((= (aref string 0) char) (string-sans-char (substring string 1) char)) - ((concat (substring string 0 1) - (string-sans-char (substring string 1) char))))) +;;;_ > regexp-sans-escapes (string) +(defun regexp-sans-escapes (regexp &optional successive-backslashes) + "Return a copy of REGEXP with all character escapes stripped out. +Representations of actual backslashes - '\\\\\\\\' - are left as a +single backslash. + +Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion." + + (if (string= regexp "") + "" + ;; Set successive-backslashes to number if current char is + ;; backslash, or else to nil: + (setq successive-backslashes + (if (= (aref regexp 0) ?\\) + (if successive-backslashes (1+ successive-backslashes) 1) + nil)) + (if (or (not successive-backslashes) (= 2 successive-backslashes)) + ;; Include first char: + (concat (substring regexp 0 1) + (regexp-sans-escapes (substring regexp 1))) + ;; Exclude first char, but maintain count: + (regexp-sans-escapes (substring regexp 1) successive-backslashes)))) +;;;_ - add-hook definition for v18 +;;;_ > add-hook (hook function &optional append) +(if (not (fboundp 'add-hook)) + (defun add-hook (hook function &optional append) + "Add to the value of HOOK the function FUNCTION unless already present (it +becomes the first hook on the list unless optional APPEND is non-nil, in +which case it becomes the last). HOOK should be a symbol, and FUNCTION may be +any valid function. HOOK's value should be a list of functions, not a single +function. If HOOK is void, it is first set to nil." + (or (boundp hook) (set hook nil)) + (or (if (consp function) + ;; Clever way to tell whether a given lambda-expression + ;; is equal to anything in the hook. + (let ((tail (assoc (cdr function) (symbol-value hook)))) + (equal function tail)) + (memq function (symbol-value hook))) + (set hook + (if append + (nconc (symbol-value hook) (list function)) + (cons function (symbol-value hook))))))) + +;;;_ #9 Under development +;;;_ > outline-bullet-isearch (&optional bullet) +(defun outline-bullet-isearch (&optional bullet) + "Isearch \(regexp\) for topic with bullet BULLET." + (interactive) + (if (not bullet) + (setq bullet (solicit-char-in-string + "ISearch for topic with bullet: " + (regexp-sans-escapes outline-bullets-string)))) + + (let ((isearch-regexp t) + (isearch-string (concat "^" + outline-header-prefix + "[ \t]*" + bullet))) + (isearch-repeat 'forward) + (isearch-mode t))) +;;;_ - Re hooking up with isearch - use isearch-op-fun rather than + wrapping the isearch functions. ;;;_* Local emacs vars. '( @@ -2606,10 +3970,9 @@ eval: (save-excursion (message "Allout outline-mode not loaded, not adjusting buffer exposure") (sit-for 1)) - (message "Adjusting '%s' visibility" (buffer-name)) - (outline-lead-with-comment-string ";;;_") + (message "Adjusting '%s' exposure" (buffer-name)) + (outline-lead-with-comment-string "\;\;\;_") (goto-char 0) - (outline-exposure (-1 () () () 1) 0))) -End: -) + (outline-new-exposure 0 : -1 -1 0))) +End:) |