comparison lisp/allout.el @ 7527:1f09079e18c4

(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'.

7526:bf357bdc648e

;;;_* allout.el - Extensive outline mode for use alone and with other modes.

;;;_* Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.

;; Author: Ken Manheimer <[e-mail]>
;; Maintainer: Ken Manheimer <[e-mail]>
;; Created: Dec 1991 - first release to usenet
;; Version: $Id: allout.el,v 1.7 1994/05/09 06:36:19 rms Exp rms $||
;; Keywords: outline mode

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify

[This feature no longer depends in any way on the 'filladapt.el'
lisp-archive package.]")
(make-variable-buffer-local 'outline-use-hanging-indents)

;;;_  = outline-reindent-bodies
(defvar outline-reindent-bodies outline-use-hanging-indents
  "*Non-nil enables auto-adjust of topic body hanging indent with depth shifts.

Indented hanging bodies are adjusted to remain even with \(or
right-indented from\) the beginning of heading text.") 
(make-variable-buffer-local 'outline-reindent-bodies)

;;;_  = outline-inhibit-protection
(defvar outline-inhibit-protection nil
  "*Non-nil disables warnings and confirmation-checks for concealed-text edits.

;;;_ #1  Internal Outline Formatting and Configuration
;;;_  - Version
;;;_   = outline-version
(defvar outline-version
  (let ((rcs-rev "$Revision: 1.7 $"))
    (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)))

(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."
  (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)
(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."

      (setq header-lead (read-string
                         "String prefix for topic headers: ")))
  (setq outline-reindent-bodies nil)
  (outline-reset-header-lead header-lead)
  header-lead)
;;;_   > outline-infer-header-lead (&optional reset)
(defun outline-infer-header-lead (&optional set)
  "Determine appropriate `outline-header-prefix'.

Works according to settings of:

       `outline-header-prefix' (default)
       `outline-use-mode-specific-leader'
and    `outline-mode-leaders'.

Optional arg SET means to do the processing to establish that prefix
for current outline processing, if it has changed from prior setting."
  (let* ((use-leader (and (boundp 'outline-use-mode-specific-leader)
			  (if (or (stringp outline-use-mode-specific-leader)
				  (memq outline-use-mode-specific-leader
					'(outline-mode-leaders
					  comment-start

    (if (not leader)
	nil
      (if (string= leader outline-header-prefix)
	  nil				; no change, nothing to do.
	(setq outline-header-prefix leader)
	(if set (outline-reset-header-lead outline-header-prefix))
	outline-header-prefix))))
;;;_   > set-outline-regexp ()
(defun set-outline-regexp ()
  "Generate proper topic-header regexp form for outline functions.

Works with respect to `outline-plain-bullets-string' and

;;;_  = outline-explicitly-deactivated
(defvar outline-explicitly-deactivated nil
  "Outline-mode was last deliberately deactived.
So outline-post-command-business should not reactivate it...")
(make-variable-buffer-local 'outline-explicitly-deactivated)
;;;_  > outline-init (mode)
(defun outline-init (mode)
  "Prime outline-mode to enable/disable auto-activation, wrt `outline-layout'.

MODE is one of:

 - nil, for no auto-activation,
 - `activation', for auto-activation only,
 - `ask' for auto-activation and auto-layout on confirmation from user,
 - anything else, for auto-activation and auto-layout, without any
   confirmation check.

Use this function to setup your emacs session for automatic activation
of allout outline mode, contingent to the buffer-specific setting of
the `outline-layout' variable.  (See `outline-layout' and
`outline-expose-topic' docstrings for more details on auto layout).

the following two lines in your emacs init file:

\(require 'allout)
\(outline-init t)"

  (if (not mode)
      (progn
	(setq find-file-hooks (delq 'outline-find-file-hook find-file-hooks))
	(if (interactive-p)
	    (message "Allout outline mode auto-activation inhibited.")))
    (add-hook 'find-file-hooks 'outline-find-file-hook)
    (setq outline-auto-activation
	  (cond ((eq mode 'activation)
		 (message "Allout outline mode auto-activation enabled.")
		 'activate)
		((eq mode 'ask)
		 (message "Allout outline mode auto-activation enabled.")
		 'ask)
		((message
		  "Allout outline mode auto-activation and -layout enabled.")
		 t)))))
;;;_  > outline-mode (&optional toggle)
;;;_   : Defun:
(defun outline-mode (&optional toggle)
;;;_    . Doc string:
  "Toggle minor mode for controlling exposure and editing of text outlines.

	  (progn			; Inhibit all the fancy formatting:
	   (outline-resumptions 'outline-primary-bullet '("*"))
	   (outline-resumptions 'outline-old-style-prefixes '(()))))

      (outline-infer-header-lead)

      (set-outline-regexp)

				       ; Produce map from current version
				       ; of outline-keybindings-list:

      (run-hooks 'outline-mode-hook)
      (setq outline-mode t))

     ;; Reactivation:
     ((setq do-layout t))
     )					; cond

    (if (and do-layout
	     outline-auto-activation
	     (listp outline-layout)

		  (if (eq outline-auto-activation 'ask)
		      (if (y-or-n-p (format "Expose %s with layout '%s'? "
					    (buffer-name)
					    outline-layout))
			  t
			(message "Not doing %s layout.")
			nil)
		    t)))
	(save-excursion
	  (message "Adjusting '%s' exposure..." (buffer-name))
	  (goto-char 0)
	  (if (not (outline-goto-prefix))
	     (outline-next-heading))
	  (apply 'outline-expose-topic (list outline-layout))
	  (message "Adjusting '%s' exposure... done." (buffer-name))))
    outline-mode
    )					; let*
  )  					; defun

;;;_ #3 Internal Position State-Tracking - "outline-recent-*" funcs

       (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 prior \(possibly invisible) heading line.

Return the location of the beginning of the heading, or nil if not found."

;;;Local variables:
;;;outline-layout: (0 : -1 -1 0)
;;;End:

;; allout.el ends here

7527:1f09079e18c4

;;;_* allout.el - Extensive outline mode for use alone and with other modes.

;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.

;; Author: Ken Manheimer <[e-mail]>
;; Maintainer: Ken Manheimer <[e-mail]>
;; Created: Dec 1991 - first release to usenet
;; Version: Id: allout.el,v 4.3 1994/05/12 17:43:08 klm Exp ||
;; Keywords: outline mode

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify

[This feature no longer depends in any way on the 'filladapt.el'
lisp-archive package.]")
(make-variable-buffer-local 'outline-use-hanging-indents)

;;;_  = outline-reindent-bodies
(defvar outline-reindent-bodies (if outline-use-hanging-indents
				    'text)
  "*Non-nil enables auto-adjust of topic body hanging indent with depth shifts.

When active, topic body lines that are indented even with or beyond
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)

;;;_  = outline-inhibit-protection
(defvar outline-inhibit-protection nil
  "*Non-nil disables warnings and confirmation-checks for concealed-text edits.

;;;_ #1  Internal Outline Formatting and Configuration
;;;_  - Version
;;;_   = outline-version
(defvar outline-version
  (let ((rcs-rev "Revision: 4.3"))
    (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.  \(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)))

(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)


;;;_   X outline-reset-header-lead (header-lead)
(defun outline-reset-header-lead (header-lead)
  "*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))
;;;_   X 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."

      (setq header-lead (read-string
                         "String prefix for topic headers: ")))
  (setq outline-reindent-bodies nil)
  (outline-reset-header-lead header-lead)
  header-lead)
;;;_   > outline-infer-header-lead ()
(defun outline-infer-header-lead ()
  "Determine appropriate `outline-header-prefix'.

Works according to settings of:

       `comment-start'
       `outline-header-prefix' (default)
       `outline-use-mode-specific-leader'
and    `outline-mode-leaders'.

Apply this via \(re\)activation of `outline-mode', rather than
invoking it directly."
  (let* ((use-leader (and (boundp 'outline-use-mode-specific-leader)
			  (if (or (stringp outline-use-mode-specific-leader)
				  (memq outline-use-mode-specific-leader
					'(outline-mode-leaders
					  comment-start

    (if (not leader)
	nil
      (if (string= leader outline-header-prefix)
	  nil				; no change, nothing to do.
	(setq outline-header-prefix leader)
	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 ()
(defun set-outline-regexp ()
  "Generate proper topic-header regexp form for outline functions.

Works with respect to `outline-plain-bullets-string' and

;;;_  = outline-explicitly-deactivated
(defvar outline-explicitly-deactivated nil
  "Outline-mode was last deliberately deactived.
So outline-post-command-business should not reactivate it...")
(make-variable-buffer-local 'outline-explicitly-deactivated)
;;;_  > outline-init (&optional mode)
(defun outline-init (&optional mode)
  "Prime outline-mode to enable/disable auto-activation, wrt `outline-layout'.

MODE is one of the following symbols:

 - nil \(or no argument) deactivate auto-activation/layou;
 - 'activate', enable auto-activation only;
 - 'ask', enable auto-activation, and enable auto-layout but with
   confirmation for layout operation solicitated from user each time;
 - '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
of allout outline mode, contingent to the buffer-specific setting of
the `outline-layout' variable.  (See `outline-layout' and
`outline-expose-topic' docstrings for more details on auto layout).

the following two lines in your emacs init file:

\(require 'allout)
\(outline-init t)"

  (interactive)
  (if (interactive-p)
      (progn
	(setq mode
	      (completing-read
	       (concat "Select outline auto setup mode "
		       "(empty for report, ? for options) ")
	       '(("nil")("full")("activate")("deactivate")
		 ("ask") ("report") (""))
	       nil
	       t))
	(if (string= mode "")
	    (setq mode 'report)
	  (setq mode (intern-soft mode)))))
  (let
      ;; convenience aliases, for consistent ref to respective vars:
      ((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)
;;;_   : Defun:
(defun outline-mode (&optional toggle)
;;;_    . Doc string:
  "Toggle minor mode for controlling exposure and editing of text outlines.

	  (progn			; Inhibit all the fancy formatting:
	   (outline-resumptions 'outline-primary-bullet '("*"))
	   (outline-resumptions 'outline-old-style-prefixes '(()))))

      (outline-infer-header-lead)
      (outline-infer-body-reindent)

      (set-outline-regexp)

				       ; Produce map from current version
				       ; of outline-keybindings-list:

      (run-hooks 'outline-mode-hook)
      (setq outline-mode t))

     ;; Reactivation:
     ((setq do-layout t)
      (outline-infer-body-reindent))
     )					; cond

    (if (and do-layout
	     outline-auto-activation
	     (listp outline-layout)

		  (if (eq outline-auto-activation 'ask)
		      (if (y-or-n-p (format "Expose %s with layout '%s'? "
					    (buffer-name)
					    outline-layout))
			  t
			(message "Skipped %s layout." (buffer-name))
			nil)
		    t)))
	(save-excursion
	  (message "Adjusting '%s' exposure..." (buffer-name))
	  (goto-char 0)
	  (outline-this-or-next-heading)
	  (condition-case err
	      (progn 
		(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
    )					; let*
  )  					; defun

;;;_ #3 Internal Position State-Tracking - "outline-recent-*" funcs

       (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-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 ()
(defmacro outline-previous-heading ()
  "Move to the prior \(possibly invisible) heading line.

Return the location of the beginning of the heading, or nil if not found."

;;;Local variables:
;;;outline-layout: (0 : -1 -1 0)
;;;End:

;; allout.el ends here