Commit 8d118843 authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

(outline-mode): Use outline-this-or-next-heading.

(outline-this-or-next-heading): New function.
(outline-mode): Fixed topic body reindentation scheme
so programming code is not indented unless
`outline-reindent-bodies' has value `force'.
(outline-infer-reindent-bodies): Implement above.
(outline-reindent-bodies): Doc fix.

(outline-init): New user interface for control of
outline-mode session setup.  Sets up `outline-find-file-hook',
`outline-layout', and `outline-auto-activation'.
parent 15fa1468
;;;_* allout.el - Extensive outline mode for use alone and with other modes. ;;;_* allout.el - Extensive outline mode for use alone and with other modes.
;;;_* Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
;; Author: Ken Manheimer <klm@nist.gov> ;; Author: Ken Manheimer <klm@nist.gov>
;; Maintainer: Ken Manheimer <klm@nist.gov> ;; Maintainer: Ken Manheimer <klm@nist.gov>
;; Created: Dec 1991 - first release to usenet ;; Created: Dec 1991 - first release to usenet
;; Version: $Id: allout.el,v 1.7 1994/05/09 06:36:19 rms Exp rms $|| ;; Version: Id: allout.el,v 4.3 1994/05/12 17:43:08 klm Exp ||
;; Keywords: outline mode ;; Keywords: outline mode
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
...@@ -383,11 +383,18 @@ lisp-archive package.]") ...@@ -383,11 +383,18 @@ lisp-archive package.]")
(make-variable-buffer-local 'outline-use-hanging-indents) (make-variable-buffer-local 'outline-use-hanging-indents)
;;;_ = outline-reindent-bodies ;;;_ = outline-reindent-bodies
(defvar outline-reindent-bodies outline-use-hanging-indents (defvar outline-reindent-bodies (if outline-use-hanging-indents
'text)
"*Non-nil enables auto-adjust of topic body hanging indent with depth shifts. "*Non-nil enables auto-adjust of topic body hanging indent with depth shifts.
Indented hanging bodies are adjusted to remain even with \(or When active, topic body lines that are indented even with or beyond
right-indented from\) the beginning of heading text.") their topic header are reindented to correspond with depth shifts of
the header.
A value of `t' enables reindent in non-programming-code buffers, ie
those that do not have the variable `comment-start' set. A value of
`force' enables reindent whether or not `comment-start' is set.")
(make-variable-buffer-local 'outline-reindent-bodies) (make-variable-buffer-local 'outline-reindent-bodies)
;;;_ = outline-inhibit-protection ;;;_ = outline-inhibit-protection
...@@ -408,14 +415,13 @@ behavior.") ...@@ -408,14 +415,13 @@ behavior.")
;;;_ - Version ;;;_ - Version
;;;_ = outline-version ;;;_ = outline-version
(defvar outline-version (defvar outline-version
(let ((rcs-rev "$Revision: 1.7 $")) (let ((rcs-rev "Revision: 4.3"))
(condition-case err (condition-case err
(save-match-data (save-match-data
(string-match "\\$Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev) (string-match "Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev)
(substring rcs-rev (match-beginning 1) (match-end 1))) (substring rcs-rev (match-beginning 1) (match-end 1)))
(error rcs-rev))) (error rcs-rev)))
"Revision number of currently loaded outline package. (Currently "Revision number of currently loaded outline package. \(allout.el)")
specific to allout.el.)")
;;;_ > outline-version ;;;_ > outline-version
(defun outline-version (&optional here) (defun outline-version (&optional here)
"Return string describing the loaded outline version." "Return string describing the loaded outline version."
...@@ -468,14 +474,14 @@ that (match-beginning 2) and (match-end 2) delimit the prefix.") ...@@ -468,14 +474,14 @@ that (match-beginning 2) and (match-end 2) delimit the prefix.")
(make-variable-buffer-local 'outline-plain-bullets-string-len) (make-variable-buffer-local 'outline-plain-bullets-string-len)
;;;_ > outline-reset-header-lead (header-lead) ;;;_ X outline-reset-header-lead (header-lead)
(defun 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: ") (interactive "sNew lead string: ")
(setq outline-header-prefix header-lead) (setq outline-header-prefix header-lead)
(setq outline-header-subtraction (1- (length outline-header-prefix))) (setq outline-header-subtraction (1- (length outline-header-prefix)))
(set-outline-regexp)) (set-outline-regexp))
;;;_ > outline-lead-with-comment-string (header-lead) ;;;_ X outline-lead-with-comment-string (header-lead)
(defun outline-lead-with-comment-string (&optional header-lead) (defun outline-lead-with-comment-string (&optional header-lead)
"*Set the topic-header leading string to specified string. "*Set the topic-header leading string to specified string.
...@@ -489,18 +495,19 @@ language comments. Returns the leading string." ...@@ -489,18 +495,19 @@ language comments. Returns the leading string."
(setq outline-reindent-bodies nil) (setq outline-reindent-bodies nil)
(outline-reset-header-lead header-lead) (outline-reset-header-lead header-lead)
header-lead) header-lead)
;;;_ > outline-infer-header-lead (&optional reset) ;;;_ > outline-infer-header-lead ()
(defun outline-infer-header-lead (&optional set) (defun outline-infer-header-lead ()
"Determine appropriate `outline-header-prefix'. "Determine appropriate `outline-header-prefix'.
Works according to settings of: Works according to settings of:
`comment-start'
`outline-header-prefix' (default) `outline-header-prefix' (default)
`outline-use-mode-specific-leader' `outline-use-mode-specific-leader'
and `outline-mode-leaders'. and `outline-mode-leaders'.
Optional arg SET means to do the processing to establish that prefix Apply this via \(re\)activation of `outline-mode', rather than
for current outline processing, if it has changed from prior setting." invoking it directly."
(let* ((use-leader (and (boundp 'outline-use-mode-specific-leader) (let* ((use-leader (and (boundp 'outline-use-mode-specific-leader)
(if (or (stringp outline-use-mode-specific-leader) (if (or (stringp outline-use-mode-specific-leader)
(memq outline-use-mode-specific-leader (memq outline-use-mode-specific-leader
...@@ -537,8 +544,18 @@ for current outline processing, if it has changed from prior setting." ...@@ -537,8 +544,18 @@ for current outline processing, if it has changed from prior setting."
(if (string= leader outline-header-prefix) (if (string= leader outline-header-prefix)
nil ; no change, nothing to do. nil ; no change, nothing to do.
(setq outline-header-prefix leader) (setq outline-header-prefix leader)
(if set (outline-reset-header-lead outline-header-prefix))
outline-header-prefix)))) outline-header-prefix))))
;;;_ > outline-infer-body-reindent ()
(defun outline-infer-body-reindent ()
"Determine proper setting for `outline-reindent-bodies'.
Depends on default setting of `outline-reindent-bodies' \(which see)
and presence of setting for `comment-start', to tell whether the
file is programming code."
(if (and outline-reindent-bodies
comment-start
(not (eq 'force outline-reindent-bodies)))
(setq outline-reindent-bodies nil)))
;;;_ > set-outline-regexp () ;;;_ > set-outline-regexp ()
(defun set-outline-regexp () (defun set-outline-regexp ()
"Generate proper topic-header regexp form for outline functions. "Generate proper topic-header regexp form for outline functions.
...@@ -740,17 +757,19 @@ protection knows to keep inactive during file write." ...@@ -740,17 +757,19 @@ protection knows to keep inactive during file write."
"Outline-mode was last deliberately deactived. "Outline-mode was last deliberately deactived.
So outline-post-command-business should not reactivate it...") So outline-post-command-business should not reactivate it...")
(make-variable-buffer-local 'outline-explicitly-deactivated) (make-variable-buffer-local 'outline-explicitly-deactivated)
;;;_ > outline-init (mode) ;;;_ > outline-init (&optional mode)
(defun outline-init (mode) (defun outline-init (&optional mode)
"Prime outline-mode to enable/disable auto-activation, wrt `outline-layout'. "Prime outline-mode to enable/disable auto-activation, wrt `outline-layout'.
MODE is one of: MODE is one of the following symbols:
- nil, for no auto-activation, - nil \(or no argument) deactivate auto-activation/layou;
- `activation', for auto-activation only, - 'activate', enable auto-activation only;
- `ask' for auto-activation and auto-layout on confirmation from user, - 'ask', enable auto-activation, and enable auto-layout but with
- anything else, for auto-activation and auto-layout, without any confirmation for layout operation solicitated from user each time;
confirmation check. - 'report', just report and return the current auto-activation state;
- anything else \(eg, t) for auto-activation and auto-layout, without
any confirmation check.
Use this function to setup your emacs session for automatic activation Use this function to setup your emacs session for automatic activation
of allout outline mode, contingent to the buffer-specific setting of of allout outline mode, contingent to the buffer-specific setting of
...@@ -767,22 +786,52 @@ the following two lines in your emacs init file: ...@@ -767,22 +786,52 @@ the following two lines in your emacs init file:
\(require 'allout) \(require 'allout)
\(outline-init t)" \(outline-init t)"
(if (not mode) (interactive)
(if (interactive-p)
(progn (progn
(setq find-file-hooks (delq 'outline-find-file-hook find-file-hooks)) (setq mode
(if (interactive-p) (completing-read
(message "Allout outline mode auto-activation inhibited."))) (concat "Select outline auto setup mode "
(add-hook 'find-file-hooks 'outline-find-file-hook) "(empty for report, ? for options) ")
(setq outline-auto-activation '(("nil")("full")("activate")("deactivate")
(cond ((eq mode 'activation) ("ask") ("report") (""))
(message "Allout outline mode auto-activation enabled.") nil
'activate) t))
((eq mode 'ask) (if (string= mode "")
(message "Allout outline mode auto-activation enabled.") (setq mode 'report)
'ask) (setq mode (intern-soft mode)))))
((message (let
"Allout outline mode auto-activation and -layout enabled.") ;; convenience aliases, for consistent ref to respective vars:
t))))) ((hook 'outline-find-file-hook)
(curr-mode 'outline-auto-activation))
(cond ((not mode)
(setq find-file-hooks (delq hook find-file-hooks))
(if (interactive-p)
(message "Allout outline mode auto-activation inhibited.")))
((eq mode 'report)
(if (not (memq hook find-file-hooks))
(outline-init nil)
;; Just punt and use the reports from each of the modes:
(outline-init (symbol-value curr-mode))))
(t (add-hook 'find-file-hooks hook)
(set curr-mode ; 'set', not 'setq'!
(cond ((eq mode 'activate)
(message
"Outline mode auto-activation enabled.")
'activate)
((eq mode 'report)
;; Return the current mode setting:
(outline-init mode))
((eq mode 'ask)
(message
(concat "Outline mode auto-activation and "
"-layout \(upon confirmation) enabled."))
'ask)
((message
"Outline mode auto-activation and -layout enabled.")
'full)))))))
;;;_ > outline-mode (&optional toggle) ;;;_ > outline-mode (&optional toggle)
;;;_ : Defun: ;;;_ : Defun:
(defun outline-mode (&optional toggle) (defun outline-mode (&optional toggle)
...@@ -1049,6 +1098,7 @@ OPEN: A topic that is not closed, though its' offspring or body may be." ...@@ -1049,6 +1098,7 @@ OPEN: A topic that is not closed, though its' offspring or body may be."
(outline-resumptions 'outline-old-style-prefixes '(())))) (outline-resumptions 'outline-old-style-prefixes '(()))))
(outline-infer-header-lead) (outline-infer-header-lead)
(outline-infer-body-reindent)
(set-outline-regexp) (set-outline-regexp)
...@@ -1128,7 +1178,8 @@ OPEN: A topic that is not closed, though its' offspring or body may be." ...@@ -1128,7 +1178,8 @@ OPEN: A topic that is not closed, though its' offspring or body may be."
(setq outline-mode t)) (setq outline-mode t))
;; Reactivation: ;; Reactivation:
((setq do-layout t)) ((setq do-layout t)
(outline-infer-body-reindent))
) ; cond ) ; cond
(if (and do-layout (if (and do-layout
...@@ -1140,16 +1191,21 @@ OPEN: A topic that is not closed, though its' offspring or body may be." ...@@ -1140,16 +1191,21 @@ OPEN: A topic that is not closed, though its' offspring or body may be."
(buffer-name) (buffer-name)
outline-layout)) outline-layout))
t t
(message "Not doing %s layout.") (message "Skipped %s layout." (buffer-name))
nil) nil)
t))) t)))
(save-excursion (save-excursion
(message "Adjusting '%s' exposure..." (buffer-name)) (message "Adjusting '%s' exposure..." (buffer-name))
(goto-char 0) (goto-char 0)
(if (not (outline-goto-prefix)) (outline-this-or-next-heading)
(outline-next-heading)) (condition-case err
(apply 'outline-expose-topic (list outline-layout)) (progn
(message "Adjusting '%s' exposure... done." (buffer-name)))) (apply 'outline-expose-topic (list outline-layout))
(message "Adjusting '%s' exposure... done." (buffer-name)))
;; Problem applying exposure - notify user, but don't
;; interrupt, eg, file visit:
(error (message "%s" (car (cdr err)))
(sit-for 1)))))
outline-mode outline-mode
) ; let* ) ; let*
) ; defun ) ; defun
...@@ -1313,6 +1369,12 @@ Returns the location of the heading, or nil if none found." ...@@ -1313,6 +1369,12 @@ Returns the location of the heading, or nil if none found."
(goto-char (or (match-beginning 2) (goto-char (or (match-beginning 2)
outline-recent-prefix-beginning)) outline-recent-prefix-beginning))
(or (match-end 2) outline-recent-prefix-end))))) (or (match-end 2) outline-recent-prefix-end)))))
;;;_ : outline-this-or-next-heading
(defun outline-this-or-next-heading ()
"Position cursor on current or next heading."
;; A throwaway non-macro that is defined after outline-next-heading
;; and usable by outline-mode.
(if (not (outline-goto-prefix)) (outline-next-heading)))
;;;_ > outline-previous-heading () ;;;_ > outline-previous-heading ()
(defmacro outline-previous-heading () (defmacro outline-previous-heading ()
"Move to the prior \(possibly invisible) heading line. "Move to the prior \(possibly invisible) heading line.
...@@ -4277,4 +4339,3 @@ function. If HOOK is void, it is first set to nil." ...@@ -4277,4 +4339,3 @@ function. If HOOK is void, it is first set to nil."
;;;End: ;;;End:
;; allout.el ends here ;; allout.el ends here
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment