;;; CHANGOUT.EL --- change level of headers in outline docs

;; Copyright (C) 1996 Stephen Eglen

;; Author: Stephen Eglen <stephene@cogs.susx.ac.uk>
;; Maintainer: Stephen Eglen <stephene@cogs.susx.ac.uk>
;; Created: 03 Sep 1996
;; Version: 1.0
;; Keywords:

 
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 1, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; A copy of the GNU General Public License can be obtained from this
;; program's author (send electronic mail to
;; <stephene@cogs.susx.ac.uk>) or from the Free Software Foundation,
;; Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;; LCD Archive Entry:
;; changout|Stephen Eglen|<stephene@cogs.susx.ac.uk>
;; |change level of headers in outline docs
;; |$Date: 1996/09/03 11:39:56 $|$Revision: 1.1 $|~/packages/changout.el

;; Copy of this file should be  available on:
;; http://www.cogs.susx.ac.uk/users/stephene/emacs/

;;; Code:

(defconst changout-version (substring "$Revision: 1.1 $" 11 -2)
  "$Id: changout.el,v 1.1 1996/09/03 11:39:56 stephene Exp stephene $

Report bugs to: Stephen Eglen <stephene@cogs.susx.ac.uk>")

;;; Description

;; Simple functions for changing the level of headings in an outline
;; document. Currently only works for heading levels indicated with
;; *. Also provides a function for marking the current subtree
;; (mark-subtree)

;;; Installation
;; Add the following line to .emacs
;; (require 'changout)

;;; Example usage

; Given the following example text:

;* chap 1
;** intro
;** methods

;* chap 2

;; Increasing levels:

;To increase each level in the region by 2 stars, mark the region and
;do M-2 inc-levels:

;*** chap 1
;**** intro
;**** methods

;*** chap 2
;The variable max-level (if non-nil) sets the maximum level that each
;heading can be.  

;; Decreasing levels:

;dec-level works the other way be removing the number of stars,
;guaranteeing that the level is not decremented below min-level.  So,
;on the example text, if you have min-level set to 1 and ask for 2
;levels to be deleted you get:

;* chap 1
;* intro
;* methods

;* chap 2

;Finally, set-level allows you to set the level of all functions in the
;region to N.

;;; Todo
;;; Other outline markers
;; It would be good to get this working for outlines other than those
;; marked with *.  It doesnt make sense for some outlines (eg the outlines
;; found in elisp code -- why would you want to change the depth of
;; heading of a defun for example?) but maybe it does for other outlines,
;; for example the latex commands \section \subsection \subsection
;; \paragraph and so on.

;;; Checking ranges

;; Currently the program does not check to see if headings are all in
;; the range [minlevel, maxlevel].  Levels that are smaller than
;; min-level are not incremented up to the min-level, and levels
;; larger than max-level are not decremented down to max-level.

;;; Code


;;; Variables

(defvar max-level nil
 "*Maximum level that will be created when incrementing, if this value is non
-nil.")

(defvar min-level 1
 "*Minimum level that will be preserved when decrementing.")

;;; Interactive functions
(defun inc-levels (beg end num)
  "increase the outline level of all headings in the region"
  (interactive "r\np")
  (change-levels beg end 'inc num)
)

(defun set-levels (beg end num)
  "increase the outline level of all headings in the region"
  (interactive "r\np")
  (change-levels beg end 'set num)
)

(defun dec-levels (beg end num)
  "decrease the outline level of all headings in the region"
  (interactive "r\np")
  (change-levels beg end 'dec num)
  )

(defun mark-subtree ()
  "mark the current subtree in an outlined document, similar to the
mark-paragraph function.  Point is set to the start of the current
subtree, and mark at the end."

  (interactive)
  (let ( (beg))
    (if (outline-on-heading-p)
	;; we are already looking at a heading
	(beginning-of-line)
      ;; else go back to previous heading
      (outline-previous-visible-heading 1)
      )
    (setq beg (point))
    (outline-end-of-subtree)
    (push-mark (point))
    (goto-char beg)
    ))


;; Testing
(setq max-level 4)
(setq preserve-one-level nil)

;;; Workhorse functions

(defun change-levels (beg end change num)
  "change the outline level of all headings in the region.  CHNAGE can
be one of: 'set, 'inc or 'dec, with NUM as the corresponding numeric argument. 
For example, 'set 2 means set the heading level to 2 for all headings in
the region."
  (save-excursion
    (let ( (str "")
	   (p nil)
	   (level nil)
	   (num2 nil)
	   (endmarker (make-marker))
	   )

      ;; before we enter the loop, do some things that only need
      ;; doing once.
      (cond 
       ;; decrement
       ( (eq change 'dec)
	 (setq num ( - 0 num))
	 )
       ;; set
       ( (eq change 'set)
	 (setq str (make-string num ?*)))
       )				; end cond

      ;; start searching
      (goto-char beg)
      (set-marker endmarker end)
      (while (re-search-forward (concat "^\\(" outline-regexp "\\)")
				(marker-position endmarker)
				t nil) 
	(setq level (outline-level))
	;(message "level %d" level)
	(cond
	 ( (eq change 'inc)
	   (if (and max-level  (> (+ level num) max-level) )
	       ;; then
	       (setq num2 (- max-level level))
	     ;; else its ok.
	     (setq num2 num)
	     )
	   (setq str (make-string num2 ?*))
	   (insert str)
	   )
	 
	 ( (eq change 'dec)
	   ;; delete some of the markers
	   (if (> level min-level )
	       (if (< (+ level num) min-level )
		   ;; preserve one level
		   ;; num and num2 are negative here, so that
		   ;; delete-char will delete backwards.
		   (progn
		     (setq num2 (- min-level level ))
		     (delete-char num2))
		 ;; else delete the chars normally
		 (delete-char num) ) )
	   )
	 
	 ( (eq change 'set)
	   ;; set the current level to num
	   ;; delete old outline and insert new one.
	   (setq p (point))
	   (beginning-of-line)
	   (delete-region p (point))
	   (insert str) )
	 ( t t)				; do nothing
	 )				; end cond
	)				;end while
      
      ;; kill this marker off when finished with.
      (set-marker endmarker nil)
      ));; let, save-excursion
  )


(provide 'changeout)


;;; Change log:
;; $Log: changout.el,v $
; Revision 1.1  1996/09/03  11:39:56  stephene
; Initial revision
;