From xemacs-m  Fri Jan 10 19:43:58 1997
Received: from palrel1.hp.com (palrel1.hp.com [15.253.72.10])
          by xemacs.org (8.8.4/8.8.4) with ESMTP
	  id TAA26087 for <xemacs-beta@xemacs.org>; Fri, 10 Jan 1997 19:43:52 -0600 (CST)
Received: from mordor.rsn.hp.com (holder@mordor.rsn.hp.com [15.99.150.126]) by palrel1.hp.com with ESMTP (8.7.5/8.7.3) id RAA12531 for <xemacs-beta@xemacs.org>; Fri, 10 Jan 1997 17:43:50 -0800 (PST)
Received: (from holder@localhost) by mordor.rsn.hp.com (8.7.5/8.7.3) id TAA02199; Fri, 10 Jan 1997 19:50:13 -0600 (CST)
To: xemacs-beta@xemacs.org
Subject: New bench.el
From: Shane Holder <holder@mordor.rsn.hp.com>
Date: 10 Jan 1997 19:50:11 -0600
Message-ID: <fawafqht1yk.fsf@mordor.rsn.hp.com>
Lines: 13702
X-Mailer: Red Gnus v0.78/XEmacs 19.15


Here's a new bench.el, along with 2 test files, bench-small.el, and
bench-large.el.  If you run (bench-test 1) it will use bench-small.el,
(bench 1) will use bench-large.el.  If you're going to post results
please use bench and not bench-test.

Extract this thing in /tmp and follow the directions in the comments.

Questions/comments happily accepted.

Shane
-------------------------------------------------------------------------
# This is a shell archive.  Remove anything before this line,
# then unpack it by saving it in a file and typing "sh file".
#
# Wrapped by Shane Holder <holder@mordor> on Fri Jan 10 19:46:35 1997
#
# This archive contains:
#	bench.el	bench-small.el	bench-large.el	
#

LANG=""; export LANG
PATH=/bin:/usr/bin:/usr/sbin:/usr/ccs/bin:$PATH; export PATH

echo x - bench.el
cat >bench.el <<'@EOF'
;;; $Id: bench.el,v 1.2 1997/01/11 01:42:07 holder Exp $	
;;; $Source: /home/holder/lib/elisp/bench/RCS/bench.el,v $
;;; $Revision: 1.2 $
;;; $Author: holder $
;;; $Date: 1997/01/11 01:42:07 $
;;; bench.el --- a crude benchmark for emacsen
;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc.

;; Author: Shane Holder <holder@rsn.hp.com>
;; Adapted-By: Steve Baur <steve@altair.xemacs.org>
;; Further adapted by: Shane Holder <holder@rsn.hp.com>

;; This file is part of XEmacs.

;; XEmacs 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 2, or (at your option)
;; any later version.

;; XEmacs 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.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Commentary:

;; Adapted from Shane Holder's bench.el by steve@altair.xemacs.org.

;; To run
;; Extract the shar file in /tmp, or modify bench-lisp-file to
;; point to the gnus.el file.
;; At the shell prompt emacs -q --no-site-file <= don't load users .emacs or site-file
;; M-x byte-compile-file "/tmp/bench.el"
;; M-x load-file "/tmp/bench.elc"
;; In the scratch buffer (bench 1)


;; All bench marks must be named bench-mark-<something>
;; Results are put in bench-mark-<something-times which is a list of
;;  times for the runs.
;; If the bench mark is not simple then there needs to be a
;;  corresponding bench-handler-<something>

;;; Code:

;; Use elp to profile benchmarks
(require 'cl)				;Emacs doesn't have when and cdar

;-----------------------------------------------------------------------------
(defvar bench-mark-hanoi-times nil)

(defun bench-handler-hanoi (times)
  (let ((start-time))
  (while (> times 0)
;    (setq start-time (bench-get-time))
    (bench-mark-hanoi)
;    (setq bench-mark-hanoi-times (cons (- (bench-get-time) start-time ) bench-mark-hanoi-times ))
    (setq times (- times 1))))
)

(defun bench-mark-hanoi ()
  "How long to complete the tower of hanoi."
  (hanoi 4))

;-----------------------------------------------------------------------------
(defvar bench-mark-font-lock-buffer nil "buffer used for bench-mark-fontlock")

(defun bench-handler-font-lock (times)
  (setq bench-mark-font-lock-buffer (find-file bench-lisp-file))
  (while (> times 0)
    (bench-mark-font-lock)
    (font-lock-mode)			; Turn it off
    (setq times (- times 1)))
  (kill-buffer bench-mark-font-lock-buffer)
)

(defun bench-mark-font-lock ()
  "How long to fonitfy a large file."
  (font-lock-fontify-buffer)
)

;-----------------------------------------------------------------------------
(defvar bench-mark-scrolling-buffer nil "buffer used for bench-mark-scrolling")

(defun bench-handler-scrolling (times)
  (setq bench-mark-scrolling-buffer (find-file bench-lisp-file))
  (set-buffer bench-mark-scrolling-buffer)
;  (setq scroll-step 1)
  (font-lock-mode -1)
  (goto-char (point-min))		;Start at point min
  (let ((temp-times times))
    (while (> temp-times 0)
      (bench-mark-scrolling-down)
      (bench-mark-scrolling-up)
      (setq temp-times (- temp-times 1))))

  (font-lock-fontify-buffer)

  (goto-char (point-min))		;Start at point min
  (let ((temp-times times))
    (while (> temp-times 0)
      (bench-mark-scrolling-down-fontified)
      (bench-mark-scrolling-up-fontified)
      (setq temp-times (- temp-times 1))))
  (kill-buffer bench-mark-scrolling-buffer)
)

(defun bench-mark-scrolling-down ()
  "How long does it take to scroll down through a large file.
Expect point to be at point min"
  (let ((buffer-read-only t))
    (while (< (point) (point-max))
      (next-line 1)
      (sit-for 0))))

(defun bench-mark-scrolling-up ()
  "How long does it take to scroll up through a large fontified ile."
  (let ((buffer-read-only t))
    (while (> (point) (point-min))
      (previous-line 1)
      (sit-for 0))))

(defun bench-mark-scrolling-down-fontified ()
  "How long does it take to scroll down through a large fontified file."
  (let ((buffer-read-only t))
    (goto-char (point-min))
    (while (< (point) (point-max))
      (next-line 1)
      (sit-for 0))))

(defun bench-mark-scrolling-up-fontified ()
  "How long does it take to scroll up through a large fontified ile."
  (let ((buffer-read-only t))
    (while (> (point) (point-min))
      (previous-line 1)
      (sit-for 0))))

;-----------------------------------------------------------------------------

(defun bench-handler-make-frames (times)
  (let ((temp-times times)
	(frame))
    (while (> temp-times 0)
      (setq frame (bench-mark-make-frame)) ;Make frame
      (bench-mark-delete-frame frame)	;Delete frame
      (setq temp-times (- temp-times 1))))

  (let ((temp-times times)
	(frames))
    (while (> temp-times 0)
      (setq frames (cons (bench-mark-make-multiple-frames) frames)) ;Make frames
      (setq temp-times (- temp-times 1)))

    (setq temp-times times)

    (while (> temp-times 0)
      (bench-mark-delete-multiple-frames (car frames))	;Delete frames
      (setq frames (cdr frames))
      (setq temp-times (- temp-times 1))))

)

(defun bench-mark-make-frame ()
  "How quickly can emacs create a new frame."
  (make-frame))

(defun bench-mark-delete-frame (frame)
  "How quickly can emacs create a new frame."
  (delete-frame frame))

(defun bench-mark-make-multiple-frames ()
  "How quickly can emacs create a new frame."
  (make-frame))

(defun bench-mark-delete-multiple-frames (frame)
  "How quickly can emacs create a new frame."
  (delete-frame frame))


;-----------------------------------------------------------------------------
(defconst bench-mark-make-words-buffer nil)
(defconst bench-mark-make-words-buffer-name "*bench-mark-make-words*")
(defconst bench-mark-make-words-number-of-words 10000)

(defun bench-handler-make-words (times)
  (setq bench-mark-make-words-buffer (get-buffer-create bench-mark-make-words-buffer-name))
  (set-buffer bench-mark-make-words-buffer)
  (while (> times 0)
    (bench-mark-make-words)
    (erase-buffer)
    (setq times (- times 1)))
  (kill-buffer bench-mark-make-words-buffer)
)

(defun bench-mark-make-words ()
  "How long does it take to generate lots of random words."
  (let ((tmp-words bench-mark-make-words-number-of-words))
    (while (not (= tmp-words 0))
      (let ((word-len (random 10)))
	(while (not (= word-len 0))
	  (insert (+ ?a (random 25)))
	  (setq word-len (- word-len 1))))
      (insert "\n")
      (setq tmp-words (- tmp-words 1)))))

;-----------------------------------------------------------------------------
(defconst bench-mark-sort-words-buffer-name "*bench-mark-sort-words*")
(defconst bench-mark-sort-words-buffer nil)
(defconst bench-mark-sort-words-number-words 10000)

(defun bench-handler-sort-words (times)
  (setq bench-mark-sort-words-buffer (get-buffer-create bench-mark-sort-words-buffer-name))
  (switch-to-buffer bench-mark-sort-words-buffer)
  (while (> times 0)
    (bench-pre-sort-words)			;Generate the random words
    (bench-mark-sort-words)			;Sort those puppies
    (erase-buffer)
    (setq times (- times 1)))
  (kill-buffer bench-mark-sort-words-buffer)
)

(defun bench-pre-sort-words ()
  "How long does it take to generate lots of random words."
  (let ((tmp-words bench-mark-sort-words-number-words))
    (while (not (= tmp-words 0))
      (let ((word-len (random 10)))
	(while (not (= word-len 0))
	  (insert (+ ?a (random 25)))
	  (setq word-len (- word-len 1))))
      (insert "\n")
      (setq tmp-words (- tmp-words 1)))))

(defun bench-mark-sort-words ()
  (sort-lines nil (point-min) (point-max))
)

;-----------------------------------------------------------------------------
; Byte compile a file
(defun bench-handler-byte-compile (times)
  (while (> times 0)
    (bench-mark-byte-compile)
    (setq times (- times 1)))
)

(defun bench-mark-byte-compile ()
  "How long does it take to byte-compile a large lisp file"
  (byte-compile-file bench-lisp-file)
)

;-----------------------------------------------------------------------------
; Run through a loop

(defconst bench-mark-loop-count 250000)

(defun bench-handler-loop (times)
  (while (> times 0)
    (bench-mark-loop)
    (setq times (- times 1)))
)

(defun bench-mark-loop ()
  "How long does it take to run through a loop."
  (let ((count bench-mark-loop-count))
    (let ((i 0) (gcount 0))
      (while (< i count)
	(increment)
	(setq i (1+ i)))
      (message "gcount = %d" gcount))))

(defun increment ()
  "Increment a variable for bench-mark-loop."
  (setq gcount (1+ gcount)))

;-----------------------------------------------------------------------------
(defconst bench-mark-large-list-list-size 500000
  "Size of list to use in small list creation/garbage collection")
(defconst bench-mark-large-list-num-lists 10)

(defun bench-handler-large-list (times)
  (let ((tmp-foo bench-mark-large-list-num-lists))
    (while (> tmp-foo 0)
      (bench-mark-large-list)
      (setq tmp-foo (- tmp-foo 1))))
)

(defun bench-mark-large-list ()
  (make-list bench-mark-large-list-list-size '1)
)

;-----------------------------------------------------------------------------
(defun bench-mark-large-list-garbage-collect (times)
  (garbage-collect)
)

;-----------------------------------------------------------------------------
(defconst bench-mark-small-list-list-size 10
  "Size of list to use in small list creation/garbage collection")

(defconst bench-mark-small-list-num-lists 100000
  "Number of lists to use in small list creation/garbage collections")

(defun bench-handler-small-list (times)
  (let ((tmp-foo bench-mark-small-list-num-lists))
    (while (> tmp-foo 0)
      (bench-mark-small-list)
      (setq tmp-foo (- tmp-foo 1)))
))

(defun bench-mark-small-list ()
  (make-list bench-mark-small-list-list-size '1)
)

;-----------------------------------------------------------------------------
(defun bench-mark-small-list-garbage-collect (times)
  (garbage-collect)
)

;-----------------------------------------------------------------------------
(defconst bench-mark-insert-into-empty-buffer-num-words 100000)

(defun bench-handler-insert-into-empty-buffer ()
  (set-buffer (get-buffer-create "*tmp*"))
  (bench-mark-insert-into-empty-buffer)
  (erase-buffer)
  (kill-buffer "*tmp*")
)

(defun bench-mark-insert-into-empty-buffer ()
  (let ((a bench-mark-insert-into-empty-buffer-num-words))
    (while (> a 0)
      (insert "0123456789\n")
      (setq a (1- a))))
)

;=============================================================================
(defconst bench-version (let ((rcsvers "$Revision: 1.2 $"))
			  (substring rcsvers 11 (- (length rcsvers) 2)))
  "*Version number of bench.el")

(defconst temp-dir (file-name-as-directory
		    (or (getenv "TMPDIR")
			(getenv "TMP")
			(getenv "TEMP")
			"/tmp/")))

(defconst bench-large-lisp-file (concat temp-dir "./bench-large.el")
  "Large lisp file to use in benchmarks should be /temp-dir/bench-text.el")

(defconst bench-small-lisp-file (concat temp-dir "./bench-small.el")
  "Large lisp file to use in benchmarks should be /temp-dir/bench-text.el")

(defconst bench-lisp-file bench-large-lisp-file)

(defconst bench-pre-bench-hook nil
  "Hook for individual bench mark initialization.")

(defconst bench-post-bench-hook nil
  "Hook for individual bench mark statistic collection.")

(defconst bench-mark-function-alist 
  '(
    (bench-handler-hanoi . "Tower of Hanoi")
    (bench-handler-font-lock               . "Font Lock")
    (bench-handler-scrolling               . "Large File scrolling")
    (bench-handler-make-frames             . "Frame Creation")
    (bench-handler-make-words              . "Generate Words")
    (bench-handler-sort-words              . "Sort Buffer")
    (bench-handler-byte-compile            . "Large File bytecompilation")
    (bench-handler-loop                    . "Loop Computation")
    (bench-handler-large-list              . "Make a Few Large Size List")
    (bench-mark-large-list-garbage-collect . "Garbage Collection Large Size List")
    (bench-handler-small-list              . "Make Several Small Size List")
    (bench-mark-small-list-garbage-collect  . "Garbage Collection Small Size List")
))

(defconst bench-enabled-profiling nil
  "If non-nil and the underlying emacs supports it, do function profiling.")

(defconst bench-mark-profile-buffer "*Profile*"
  "Buffer used for collection of profiling data.")

(setq gc-cons-threshold 40000000)

(defconst bench-small-frame-alist '((height . 24) (width . 80)))
(defconst bench-medium-frame-alist '((height . 48) (width . 80)))
(defconst bench-large-frame-alist '((height . 72) (width . 80)))

(defsubst bench-get-time ()
  ;; Stolen from elp
  ;; get current time in seconds and microseconds. I throw away the
  ;; most significant 16 bits of seconds since I doubt we'll ever want
  ;; to profile lisp on the order of 18 hours. See notes at top of file.
  (let ((now (current-time)))
    (+ (float (nth 1 now)) (/ (float (nth 2 now)) 1000000.0))))

(defun bench-init ()
  "Initialize profiling for bench marking package."
  (if (fboundp 'start-profiling)
      (let ((buf (get-buffer-create bench-mark-profile-buffer)))
	(erase-buffer buf)
	(when (profiling-active-p)
	  (stop-profiling)
	  (clear-profiling-info)))
    (message "Profiling not available in this XEmacs.")
    (sit-for 2)))

(defun bench-test-init ()
  "Initialize profiling for bench marking package."
  (if (fboundp 'start-profiling)
      (let ((buf (get-buffer-create bench-mark-profile-buffer)))
	(erase-buffer buf)
	(when (profiling-active-p)
	  (stop-profiling)
	  (clear-profiling-info)))
    (message "Profiling not available in this XEmacs.")
    (sit-for 2))
  (setq bench-lisp-file bench-small-lisp-file)
  (setq bench-mark-make-words-number-of-words 100)
  (setq bench-mark-sort-words-number-of-words 100)
  (setq bench-mark-loop-count 10000)
  (setq bench-mark-large-list-list-size 500)
  (setq bench-mark-small-list-num-lists 100)
  (setq bench-mark-insert-into-empty-buffer-num-words 100)
  
)

(defun bench-profile-start (test-name)
  "Turn on profiling for test `test-name'."
  (when (and bench-enabled-profiling
	     (fboundp 'start-profiling))
    (when (profiling-active-p)
      (stop-profiling))
    (let ((buf (get-buffer-create bench-mark-profile-buffer)))
      (save-excursion
	(set-buffer buf)
	(insert "Test `" test-name "'\n")
	(start-profiling)))))

(defun bench-profile-stop (test-name)
  "Turn off profiling for test `test-name'."
  (when (and bench-enabled-profiling
	     (fboundp 'stop-profiling))
    (stop-profiling)
    (let ((buf (get-buffer-create bench-mark-profile-buffer)))
      (save-excursion
	(set-buffer buf)
	(insert (with-output-to-string
		 (pretty-print-profiling-info)) "\n")))
    (clear-profiling-info)))

(add-hook 'bench-pre-bench-hook 'bench-profile-start)
(add-hook 'bench-post-bench-hook 'bench-profile-stop)

(defun bench-post ()
"Post processing of elp results"
; I can't figure out a good way to sort the lines numerically.
; If someone comes up with a good way, let me know.
  (goto-char (point-min))
  (next-line 2)
  (sort-lines nil (point) (point-max))
  (mail-results (current-buffer))
)

(defun bench (arg)
  "Run a series of benchmarks."
  (interactive "p")
  (elp-instrument-package "bench-mark") ;Only instrument functions
                                        ;beginning with bench-mark
  (bench-init)
  (if (fboundp 'byte-optimize)		;Turn off byte-compile optimization in XEmacs
      (setq byte-optimize nil))
  (if (fboundp 'menu-bar-mode)
      (menu-bar-mode -1))			;Turn off menu-bar
  (let ((benches bench-mark-function-alist))
    (while benches
      (let ((test-name (cdar benches)))
	(run-hook-with-args 'bench-pre-bench-hook test-name)
	(message "Running %s - %s." (symbol-name (caar benches)) test-name)
	(funcall (caar benches) arg)
	(setq benches (cdr benches))
	(run-hook-with-args 'bench-post-bench-hook test-name))
      ))
  (elp-results)
  (bench-post)
)

(defun bench-test (arg)
  "Run all the tests but with smaller values so the tests run quicker.
This way I don't have to sit around to see if the tests complete"
  (interactive "p")
  (elp-instrument-package "bench-mark") ;Only instrument functions
                                        ;beginning with bench-mark
  (bench-test-init)
  (if (fboundp 'byte-optimize)		;Turn off byte-compile optimization in XEmacs
      (setq byte-optimize nil))
  (if (fboundp 'menu-bar-mode)
      (menu-bar-mode -1))			;Turn off menu-bar
  (let ((benches bench-mark-function-alist))
    (while benches
      (let ((test-name (cdar benches)))
	(run-hook-with-args 'bench-pre-bench-hook test-name)
	(message "Running %s - %s." (symbol-name (caar benches)) test-name)
	(funcall (caar benches) arg)
	(setq benches (cdr benches))
	(run-hook-with-args 'bench-post-bench-hook test-name))
      ))
  (elp-results)
  (bench-post)
)


(defconst bench-send-results-to "holder@rsn.hp.com")
(defconst bench-subject "Bench Mark Results")
(defconst bench-system-form (format "

Please fill in as much of the following as you can
and then hit C-cC-c to send.

CPU Manufacturer (Intel,HP,DEC,etc.): 
CPU Type (Pentium,Alpha): 
CPU Speed: 
RAM (in meg): 
Emacs Version: %s
Emacs (version): %s
Compile line:
Bench Version: %s
" emacs-version (emacs-version) bench-version))

(defun mail-results (buffer)
  (mail nil bench-send-results-to bench-subject)
  (sit-for 0)
  (goto-char (point-max))
  (insert bench-system-form)
  (insert-buffer buffer)
)
;;; bench.el ends here
@EOF

chmod 444 bench.el

echo x - bench-small.el
cat >bench-small.el <<'@EOF'
;;; $Id: bench-small.el,v 1.2 1997/01/11 01:41:31 holder Exp $	
;;; $Source: /home/holder/lib/elisp/bench/RCS/bench-small.el,v $
;;; $Revision: 1.2 $
;;; $Author: holder $
;;; $Date: 1997/01/11 01:41:31 $
;;; bench-small.el --- Used as a quick test for bench.el
;;; bench.el --- a crude benchmark for emacsen
;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc.

;; Author: Shane Holder <holder@rsn.hp.com>
;; Adapted-By: Steve Baur <steve@altair.xemacs.org>
;; Further adapted by: Shane Holder <holder@rsn.hp.com>

;; This file is part of XEmacs.

;; XEmacs 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 2, or (at your option)
;; any later version.

;; XEmacs 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.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Commentary:

;; Adapted from Shane Holder's bench.el by steve@altair.xemacs.org.

;; To run
;; Extract the shar file in /tmp, or modify bench-lisp-file to
;; point to the gnus.el file.
;; At the shell prompt emacs -q --no-site-file <= don't load users .emacs or site-file
;; M-x byte-compile-file "/tmp/bench.el"
;; M-x load-file "/tmp/bench.elc"
;; In the scratch buffer (bench 1)

;; All bench marks must be named bench-mark-<something>
;; Results are put in bench-mark-<something-times which is a list of
;;  times for the runs.
;; If the bench mark is not simple then there needs to be a
;;  corresponding bench-handler-<something>

;;; Code:

;; Use elp to profile benchmarks
(require 'cl)				;Emacs doesn't have when and cdar

;-----------------------------------------------------------------------------
(defvar bench-mark-hanoi-times nil)

(defun bench-handler-hanoi (times)
  (let ((start-time))
  (while (> times 0)
;    (setq start-time (bench-get-time))
    (bench-mark-hanoi)
;    (setq bench-mark-hanoi-times (cons (- (bench-get-time) start-time ) bench-mark-hanoi-times ))
    (setq times (- times 1))))
)

(defun bench-mark-hanoi ()
  "How long to complete the tower of hanoi."
  (hanoi 4))

;-----------------------------------------------------------------------------
(defvar bench-mark-font-lock-buffer nil "buffer used for bench-mark-fontlock")

(defun bench-handler-font-lock (times)
  (setq bench-mark-font-lock-buffer (find-file bench-lisp-file))
  (while (> times 0)
    (bench-mark-font-lock)
    (font-lock-mode)			; Turn it off
    (setq times (- times 1)))
  (kill-buffer bench-mark-font-lock-buffer)
)

(defun bench-mark-font-lock ()
  "How long to fonitfy a large file."
  (font-lock-fontify-buffer)
)

;-----------------------------------------------------------------------------
(defvar bench-mark-scrolling-buffer nil "buffer used for bench-mark-scrolling")

(defun bench-handler-scrolling (times)
  (setq bench-mark-scrolling-buffer (find-file bench-lisp-file))
  (set-buffer bench-mark-scrolling-buffer)
;  (setq scroll-step 1)
  (font-lock-mode -1)
  (goto-char (point-min))		;Start at point min
  (let ((temp-times times))
    (while (> temp-times 0)
      (bench-mark-scrolling-down)
      (bench-mark-scrolling-up)
      (setq temp-times (- temp-times 1))))

  (font-lock-fontify-buffer)

  (goto-char (point-min))		;Start at point min
  (let ((temp-times times))
    (while (> temp-times 0)
      (bench-mark-scrolling-down-fontified)
      (bench-mark-scrolling-up-fontified)
      (setq temp-times (- temp-times 1))))
  (kill-buffer bench-mark-scrolling-buffer)
)

(defun bench-mark-scrolling-down ()
  "How long does it take to scroll down through a large file.
Expect point to be at point min"
  (let ((buffer-read-only t))
    (while (< (point) (point-max))
      (next-line 1)
      (sit-for 0))))

(defun bench-mark-scrolling-up ()
  "How long does it take to scroll up through a large fontified ile."
  (let ((buffer-read-only t))
    (while (> (point) (point-min))
      (previous-line 1)
      (sit-for 0))))

(defun bench-mark-scrolling-down-fontified ()
  "How long does it take to scroll down through a large fontified file."
  (let ((buffer-read-only t))
    (goto-char (point-min))
    (while (< (point) (point-max))
      (next-line 1)
      (sit-for 0))))

(defun bench-mark-scrolling-up-fontified ()
  "How long does it take to scroll up through a large fontified ile."
  (let ((buffer-read-only t))
    (while (> (point) (point-min))
      (previous-line 1)
      (sit-for 0))))

;-----------------------------------------------------------------------------

(defun bench-handler-make-frames (times)
  (let ((temp-times times)
	(frame))
    (while (> temp-times 0)
      (setq frame (bench-mark-make-frame)) ;Make frame
      (bench-mark-delete-frame frame)	;Delete frame
      (setq temp-times (- temp-times 1))))

  (let ((temp-times times)
	(frames))
    (while (> temp-times 0)
      (setq frames (cons (bench-mark-make-multiple-frames) frames)) ;Make frames
      (setq temp-times (- temp-times 1)))

    (setq temp-times times)

    (while (> temp-times 0)
      (bench-mark-delete-multiple-frames (car frames))	;Delete frames
      (setq frames (cdr frames))
      (setq temp-times (- temp-times 1))))

)

(defun bench-mark-make-frame ()
  "How quickly can emacs create a new frame."
  (make-frame))

(defun bench-mark-delete-frame (frame)
  "How quickly can emacs create a new frame."
  (delete-frame frame))

(defun bench-mark-make-multiple-frames ()
  "How quickly can emacs create a new frame."
  (make-frame))

(defun bench-mark-delete-multiple-frames (frame)
  "How quickly can emacs create a new frame."
  (delete-frame frame))


;-----------------------------------------------------------------------------
(defconst bench-mark-make-words-buffer nil)
(defconst bench-mark-make-words-buffer-name "*bench-mark-make-words*")
(defconst bench-mark-make-words-number-of-words 10000)

(defun bench-handler-make-words (times)
  (setq bench-mark-make-words-buffer (get-buffer-create bench-mark-make-words-buffer-name))
  (set-buffer bench-mark-make-words-buffer)
  (while (> times 0)
    (bench-mark-make-words)
    (erase-buffer)
    (setq times (- times 1)))
  (kill-buffer bench-mark-make-words-buffer)
)

(defun bench-mark-make-words ()
  "How long does it take to generate lots of random words."
  (let ((tmp-words bench-mark-make-words-number-of-words))
    (while (not (= tmp-words 0))
      (let ((word-len (random 10)))
	(while (not (= word-len 0))
	  (insert (+ ?a (random 25)))
	  (setq word-len (- word-len 1))))
      (insert "\n")
      (setq tmp-words (- tmp-words 1)))))

;-----------------------------------------------------------------------------
(defconst bench-mark-sort-words-buffer-name "*bench-mark-sort-words*")
(defconst bench-mark-sort-words-buffer nil)
(defconst bench-mark-sort-words-number-words 10000)

(defun bench-handler-sort-words (times)
  (setq bench-mark-sort-words-buffer (get-buffer-create bench-mark-sort-words-buffer-name))
  (switch-to-buffer bench-mark-sort-words-buffer)
  (while (> times 0)
    (bench-pre-sort-words)			;Generate the random words
    (bench-mark-sort-words)			;Sort those puppies
    (erase-buffer)
    (setq times (- times 1)))
  (kill-buffer bench-mark-sort-words-buffer)
)

(defun bench-pre-sort-words ()
  "How long does it take to generate lots of random words."
  (let ((tmp-words bench-mark-sort-words-number-words))
    (while (not (= tmp-words 0))
      (let ((word-len (random 10)))
	(while (not (= word-len 0))
	  (insert (+ ?a (random 25)))
	  (setq word-len (- word-len 1))))
      (insert "\n")
      (setq tmp-words (- tmp-words 1)))))

(defun bench-mark-sort-words ()
  (sort-lines nil (point-min) (point-max))
)

;-----------------------------------------------------------------------------
; Byte compile a file
(defun bench-handler-byte-compile (times)
  (while (> times 0)
    (bench-mark-byte-compile)
    (setq times (- times 1)))
)

(defun bench-mark-byte-compile ()
  "How long does it take to byte-compile a large lisp file"
  (byte-compile-file bench-lisp-file)
)

;-----------------------------------------------------------------------------
; Run through a loop

(defconst bench-mark-loop-count 250000)

(defun bench-handler-loop (times)
  (while (> times 0)
    (bench-mark-loop)
    (setq times (- times 1)))
)

(defun bench-mark-loop ()
  "How long does it take to run through a loop."
  (let ((count bench-mark-loop-count))
    (let ((i 0) (gcount 0))
      (while (< i count)
	(increment)
	(setq i (1+ i)))
      (message "gcount = %d" gcount))))

(defun increment ()
  "Increment a variable for bench-mark-loop."
  (setq gcount (1+ gcount)))

;-----------------------------------------------------------------------------
(defconst bench-mark-large-list-list-size 500000
  "Size of list to use in small list creation/garbage collection")
(defconst bench-mark-large-list-num-lists 10)

(defun bench-handler-large-list (times)
  (let ((tmp-foo bench-mark-large-list-num-lists))
    (while (> tmp-foo 0)
      (bench-mark-large-list)
      (setq tmp-foo (- tmp-foo 1))))
)

(defun bench-mark-large-list ()
  (make-list bench-mark-large-list-list-size '1)
)

;-----------------------------------------------------------------------------
(defun bench-mark-large-list-garbage-collect (times)
  (garbage-collect)
)

;-----------------------------------------------------------------------------
(defconst bench-mark-small-list-list-size 10
  "Size of list to use in small list creation/garbage collection")

(defconst bench-mark-small-list-num-lists 100000
  "Number of lists to use in small list creation/garbage collections")

(defun bench-handler-small-list (times)
  (let ((tmp-foo bench-mark-small-list-num-lists))
    (while (> tmp-foo 0)
      (bench-mark-small-list)
      (setq tmp-foo (- tmp-foo 1)))
))

(defun bench-mark-small-list ()
  (make-list bench-mark-small-list-list-size '1)
)

;-----------------------------------------------------------------------------
(defun bench-mark-small-list-garbage-collect (times)
  (garbage-collect)
)

;-----------------------------------------------------------------------------
(defconst bench-mark-insert-into-empty-buffer-num-words 100000)

(defun bench-handler-insert-into-empty-buffer ()
  (set-buffer (get-buffer-create "*tmp*"))
  (bench-mark-insert-into-empty-buffer)
  (erase-buffer)
  (kill-buffer "*tmp*")
)

(defun bench-mark-insert-into-empty-buffer ()
  (let ((a bench-mark-insert-into-empty-buffer-num-words))
    (while (> a 0)
      (insert "0123456789\n")
      (setq a (1- a))))
)

;=============================================================================
(defconst bench-version 1.0)

(defconst temp-dir (file-name-as-directory
		    (or (getenv "TMPDIR")
			(getenv "TMP")
			(getenv "TEMP")
			"/tmp/")))

(defconst bench-large-lisp-file (concat temp-dir "./bench-large.el")
  "Large lisp file to use in benchmarks should be /temp-dir/bench-text.el")

(defconst bench-small-lisp-file (concat temp-dir "./bench-small.el")
  "Large lisp file to use in benchmarks should be /temp-dir/bench-text.el")

(defconst bench-lisp-file bench-large-lisp-file)

(defconst bench-pre-bench-hook nil
  "Hook for individual bench mark initialization.")

(defconst bench-post-bench-hook nil
  "Hook for individual bench mark statistic collection.")

(defconst bench-mark-function-alist 
  '(
    (bench-handler-hanoi . "Tower of Hanoi")
    (bench-handler-font-lock               . "Font Lock")
    (bench-handler-scrolling               . "Large File scrolling")
    (bench-handler-make-frames             . "Frame Creation")
    (bench-handler-make-words              . "Generate Words")
    (bench-handler-sort-words              . "Sort Buffer")
    (bench-handler-byte-compile            . "Large File bytecompilation")
    (bench-handler-loop                    . "Loop Computation")
    (bench-handler-large-list              . "Make a Few Large Size List")
    (bench-mark-large-list-garbage-collect . "Garbage Collection Large Size List")
    (bench-handler-small-list              . "Make Several Small Size List")
    (bench-mark-small-list-garbage-collect  . "Garbage Collection Small Size List")
))

(defconst bench-enabled-profiling nil
  "If non-nil and the underlying emacs supports it, do function profiling.")

(defconst bench-mark-profile-buffer "*Profile*"
  "Buffer used for collection of profiling data.")

(setq gc-cons-threshold 40000000)

(defconst bench-small-frame-alist '((height . 24) (width . 80)))
(defconst bench-medium-frame-alist '((height . 48) (width . 80)))
(defconst bench-large-frame-alist '((height . 72) (width . 80)))

(defsubst bench-get-time ()
  ;; Stolen from elp
  ;; get current time in seconds and microseconds. I throw away the
  ;; most significant 16 bits of seconds since I doubt we'll ever want
  ;; to profile lisp on the order of 18 hours. See notes at top of file.
  (let ((now (current-time)))
    (+ (float (nth 1 now)) (/ (float (nth 2 now)) 1000000.0))))

(defun bench-init ()
  "Initialize profiling for bench marking package."
  (if (fboundp 'start-profiling)
      (let ((buf (get-buffer-create bench-mark-profile-buffer)))
	(erase-buffer buf)
	(when (profiling-active-p)
	  (stop-profiling)
	  (clear-profiling-info)))
    (message "Profiling not available in this XEmacs.")
    (sit-for 2)))

(defun bench-test-init ()
  "Initialize profiling for bench marking package."
  (if (fboundp 'start-profiling)
      (let ((buf (get-buffer-create bench-mark-profile-buffer)))
	(erase-buffer buf)
	(when (profiling-active-p)
	  (stop-profiling)
	  (clear-profiling-info)))
    (message "Profiling not available in this XEmacs.")
    (sit-for 2))
  (setq bench-lisp-file bench-small-lisp-file)
  (setq bench-mark-make-words-number-of-words 100)
  (setq bench-mark-sort-words-number-of-words 100)
  (setq bench-mark-loop-count 10000)
  (setq bench-mark-large-list-list-size 500)
  (setq bench-mark-small-list-num-lists 100)
  (setq bench-mark-insert-into-empty-buffer-num-words 100)
  
)

(defun bench-profile-start (test-name)
  "Turn on profiling for test `test-name'."
  (when (and bench-enabled-profiling
	     (fboundp 'start-profiling))
    (when (profiling-active-p)
      (stop-profiling))
    (let ((buf (get-buffer-create bench-mark-profile-buffer)))
      (save-excursion
	(set-buffer buf)
	(insert "Test `" test-name "'\n")
	(start-profiling)))))

(defun bench-profile-stop (test-name)
  "Turn off profiling for test `test-name'."
  (when (and bench-enabled-profiling
	     (fboundp 'stop-profiling))
    (stop-profiling)
    (let ((buf (get-buffer-create bench-mark-profile-buffer)))
      (save-excursion
	(set-buffer buf)
	(insert (with-output-to-string
		 (pretty-print-profiling-info)) "\n")))
    (clear-profiling-info)))

(add-hook 'bench-pre-bench-hook 'bench-profile-start)
(add-hook 'bench-post-bench-hook 'bench-profile-stop)

(defun bench-post ()
"Post processing of elp results"
; I can't figure out a good way to sort the lines numerically.
; If someone comes up with a good way, let me know.
  (goto-char (point-min))
  (replace-string "-" " ")
  (goto-char (point-min))
  (next-line 2)
  (sort-numeric-fields 3 (point) (point-max))
  (goto-char (point-min))
  (replace-string " mark " "-mark-")
  (goto-char (point-min))
  (let ((benches bench-mark-function-alist))
    (while benches
      (goto-char (point-min))
      (let ((test-name (cdar benches))
	    (test-func (caar benches)))
;; Replace string handler with mark	
	(setq test-func (symbol-name test-func))
	
	(if (string-match "handler" test-func)
	    (setq test-func (replace-match "mark" nil nil test-func)))
	(search-forward test-func)
	(end-of-line)
	(insert "   <= " test-name))
	(setq benches (cdr benches))
      ))
  (mail-results (current-buffer))
)

(defun bench (arg)
  "Run a series of benchmarks."
  (interactive "p")
  (elp-instrument-package "bench-mark") ;Only instrument functions
                                        ;beginning with bench-mark
  (bench-init)
  (if (fboundp 'byte-optimize)		;Turn off byte-compile optimization in XEmacs
      (setq byte-optimize nil))
  (menu-bar-mode -1)			;Turn off menu-bar
  (let ((benches bench-mark-function-alist))
    (while benches
      (let ((test-name (cdar benches)))
	(run-hook-with-args 'bench-pre-bench-hook test-name)
	(message "Running %s - %s." (symbol-name (caar benches)) test-name)
	(funcall (caar benches) arg)
	(setq benches (cdr benches))
	(run-hook-with-args 'bench-post-bench-hook test-name))
      ))
  (elp-results)
  (bench-post)
)

(defun bench-test (arg)
  "Run all the tests but with smaller values so the tests run quicker.
This way I don't have to sit around to see if the tests complete"
  (interactive "p")
  (elp-instrument-package "bench-mark") ;Only instrument functions
                                        ;beginning with bench-mark
  (bench-test-init)
  (if (fboundp 'byte-optimize)		;Turn off byte-compile optimization in XEmacs
      (setq byte-optimize nil))
  (menu-bar-mode -1)			;Turn off menu-bar
  (let ((benches bench-mark-function-alist))
    (while benches
      (let ((test-name (cdar benches)))
	(run-hook-with-args 'bench-pre-bench-hook test-name)
	(message "Running %s - %s." (symbol-name (caar benches)) test-name)
	(funcall (caar benches) arg)
	(setq benches (cdr benches))
	(run-hook-with-args 'bench-post-bench-hook test-name))
      ))
  (elp-results)
  (bench-post)
)


(defconst bench-send-results-to "holder@rsn.hp.com")
(defconst bench-subject "Bench Mark Results")
(defconst bench-system-form "

Please fill in as much of the following as you can
and then hit C-cC-c to send.

CPU Manufacturer (Intel,HP,DEC,etc.): 
CPU Type (Pentium,Alpha): 
CPU Speed: 
RAM (in meg): 

")

(defun mail-results (buffer)
  (mail nil bench-send-results-to bench-subject)
  (sit-for 0)
  (goto-char (point-max))
  (insert bench-system-form)
  (insert-buffer buffer)
)
;;; bench.el ends here
@EOF

chmod 444 bench-small.el

echo x - bench-large.el
cat >bench-large.el <<'@EOF'
;;; $Id: bench-large.el,v 1.1 1997/01/11 01:27:59 holder Exp $	
;;; $Source: /home/holder/lib/elisp/bench/RCS/bench-large.el,v $
;;; $Revision: 1.1 $
;;; $Author: holder $
;;; $Date: 1997/01/11 01:27:59 $
;; bench-text.el -- File used by bench.el 
;; Consists of several lisp files
;; cc-mode.el
;; allout.el
;; emerge.el
;;; cc-mode.el --- major mode for editing C, C++, and Objective-C code

;; Copyright (C) 1985, 87, 92, 93, 94, 95, 96 Free Software Foundation, Inc.

;; Authors: 1992-1996 Barry A. Warsaw
;;          1987 Dave Detlefs and Stewart Clamen
;;          1985 Richard M. Stallman
;; Created: a long, long, time ago. adapted from the original c-mode.el
;; Barry Warsaw Version:    4.282
;; Keywords: c languages oop

;; NOTE: Read the commentary below for the right way to submit bug reports!
;; NOTE: See the accompanying texinfo manual for details on using this mode!

;; This file is part of GNU Emacs.

;; GNU Emacs 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 2, or (at your option)
;; any later version.

;; GNU Emacs 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.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;;;    This file may contain modifications made by the FSF for inclusion
;;;    in the Emacs release.  It may not be identical to the version
;;;    written by Barry Warsaw, so bugs are not necessarily his fault.
;;;    However, these changes are usually small, so we still do recommend
;;;    reporting bugs to him with C-c C-b.  Even when they are not his fault,
;;;    he may fix them for the FSF's sake.

;; This package provides modes in GNU Emacs for editing C, C++, 
;; Objective-C, and Java code. It is intended to be a replacement for
;; c-mode.el (a.k.a. BOCM -- Boring Old C-Mode), and c++-mode.el
;; (a.k.a cplus-md.el and cplus-md1.el), both of which are ancestors
;; of this file.  A number of important improvements have been made,
;; briefly: complete K&R C, ANSI C, `ARM' C++, Objective-C, and Java
;; support with consistent indentation across all modes, more
;; intuitive indentation controlling variables, compatibility across
;; all known Emacsen, nice new features, and tons of bug fixes.  This
;; package is called "cc-mode" to distinguish it from its ancestors,
;; but there really is no top-level cc-mode.  Usage and programming
;; details are contained in an accompanying texinfo manual.

;; To submit bug reports, type "C-c C-b".  These will be sent to
;; bug-gnu-emacs@prep.ai.mit.edu and I'll read about them there (this
;; is mirrored as the Usenet newsgroup gnu.emacs.bug).  Questions can
;; sent to help-gnu-emacs@prep.ai.mit.edu (mirrored as
;; gnu.emacs.help).  Please do not send bugs or questions to my
;; personal account.

;; YOU CAN IGNORE ALL BYTE-COMPILER WARNINGS. They are the result of
;; the multi-Emacsen support.  Emacs 19 (from the FSF), XEmacs 19
;; (formerly Lucid Emacs), and GNU Emacs 18 all do things differently
;; and there's no way to shut the byte-compiler up at the necessary
;; granularity.  Let me say this again: YOU CAN IGNORE ALL
;; BYTE-COMPILER WARNINGS (you'd be surprised at how many people don't
;; follow this advice :-).

;; If your Emacs is dumped with c-mode.el and/or c++-mode.el, you will
;; need to add the following to your .emacs file before any other
;; reference to c-mode or c++-mode:
;;
;; (fmakunbound 'c-mode)
;; (makunbound 'c-mode-map)
;; (fmakunbound 'c++-mode)
;; (makunbound 'c++-mode-map)
;; (makunbound 'c-style-alist)

;; If your Emacs comes with cc-mode already (and as of 18-Jan-1996,
;; XEmacs 19.13 and Emacs 19.30 both do), you only need to add the
;; following to use the latest version of cc-mode:
;;
;; (load "cc-mode")
;;
;; Make sure the new version is earlier on your load-path.

;; There are four major mode entry points provided by this package,
;; one for editing C++ code, one for editing C code (both K&R and
;; ANSI), one for editing Objective-C code, and one for editing Java
;; code.  The commands are M-x c-mode, M-x c++-mode, M-x objc-mode,
;; and M-x java-mode.

;; If you are using an old version of Emacs which does not come
;; with cc-mode.el, you will need to do these things
;; to use it:
;;
;; (autoload 'c++-mode  "cc-mode" "C++ Editing Mode" t)
;; (autoload 'c-mode    "cc-mode" "C Editing Mode" t)
;; (autoload 'objc-mode "cc-mode" "Objective-C Editing Mode" t)
;; (autoload 'java-mode "cc-mode" "Java Editing Mode" t)
;; (setq auto-mode-alist
;;   (append '(("\\.C$"    . c++-mode)
;;             ("\\.cc$"   . c++-mode)
;;             ("\\.c$"    . c-mode)
;;             ("\\.h$"    . c-mode)
;;             ("\\.m$"    . objc-mode)
;;             ("\\.java$" . java-mode)
;;            ) auto-mode-alist))
;;
;; You do not need these changes in Emacs versions that come with cc-mode.

;; Many, many thanks go out to all the folks on the beta test list.
;; Without their patience, testing, insight, code contributions, and
;; encouragement cc-mode.el would be a far inferior package.

;; Anonymous ftp URL:
;;
;;    ftp://ftp.python.org/pub/emacs/cc-mode.tar.gz

;;; Code:


;; user definable variables
;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv

(defvar c-inhibit-startup-warnings-p nil
  "*If non-nil, inhibits start up compatibility warnings.")
(defvar c-strict-syntax-p nil
  "*If non-nil, all syntactic symbols must be found in `c-offsets-alist'.
If the syntactic symbol for a particular line does not match a symbol
in the offsets alist, an error is generated, otherwise no error is
reported and the syntactic symbol is ignored.")
(defvar c-echo-syntactic-information-p nil
  "*If non-nil, syntactic info is echoed when the line is indented.")
(defvar c-basic-offset 4
  "*Amount of basic offset used by + and - symbols in `c-offsets-alist'.")

(defvar c-offsets-alist
  '((string                . -1000)
    (c                     . c-lineup-C-comments)
    (defun-open            . 0)
    (defun-close           . 0)
    (defun-block-intro     . +)
    (class-open            . 0)
    (class-close           . 0)
    (inline-open           . +)
    (inline-close          . 0)
    (ansi-funcdecl-cont    . +)
    (knr-argdecl-intro     . +)
    (knr-argdecl           . 0)
    (topmost-intro         . 0)
    (topmost-intro-cont    . 0)
    (member-init-intro     . +)
    (member-init-cont      . 0)
    (inher-intro           . +)
    (inher-cont            . c-lineup-multi-inher)
    (block-open            . 0)
    (block-close           . 0)
    (brace-list-open       . 0)
    (brace-list-close      . 0)
    (brace-list-intro      . +)
    (brace-list-entry      . 0)
    (statement             . 0)
    ;; some people might prefer
    ;;(statement             . c-lineup-runin-statements)
    (statement-cont        . +)
    ;; some people might prefer
    ;;(statement-cont        . c-lineup-math)
    (statement-block-intro . +)
    (statement-case-intro  . +)
    (statement-case-open   . 0)
    (substatement          . +)
    (substatement-open     . +)
    (case-label            . 0)
    (access-label          . -)
    (label                 . 2)
    (do-while-closure      . 0)
    (else-clause           . 0)
    (comment-intro         . c-lineup-comment)
    (arglist-intro         . +)
    (arglist-cont          . 0)
    (arglist-cont-nonempty . c-lineup-arglist)
    (arglist-close         . +)
    (stream-op             . c-lineup-streamop)
    (inclass               . +)
    (cpp-macro             . -1000)
    (friend                . 0)
    (objc-method-intro     . -1000)
    (objc-method-args-cont . c-lineup-ObjC-method-args)
    (objc-method-call-cont . c-lineup-ObjC-method-call)
    )
  "*Association list of syntactic element symbols and indentation offsets.
As described below, each cons cell in this list has the form:

    (SYNTACTIC-SYMBOL . OFFSET)

When a line is indented, cc-mode first determines the syntactic
context of the line by generating a list of symbols called syntactic
elements.  This list can contain more than one syntactic element and
the global variable `c-syntactic-context' contains the context list
for the line being indented.  Each element in this list is actually a
cons cell of the syntactic symbol and a buffer position.  This buffer
position is called the relative indent point for the line.  Some
syntactic symbols may not have a relative indent point associated with
them.

After the syntactic context list for a line is generated, cc-mode
calculates the absolute indentation for the line by looking at each
syntactic element in the list.  First, it compares the syntactic
element against the SYNTACTIC-SYMBOL's in `c-offsets-alist'.  When it
finds a match, it adds the OFFSET to the column of the relative indent
point.  The sum of this calculation for each element in the syntactic
list is the absolute offset for line being indented.

If the syntactic element does not match any in the `c-offsets-alist',
an error is generated if `c-strict-syntax-p' is non-nil, otherwise
the element is ignored.

Actually, OFFSET can be an integer, a function, a variable, or one of
the following symbols: `+', `-', `++', `--', `*', or `/'.  These
latter designate positive or negative multiples of `c-basic-offset',
respectively: *1, *-1, *2, *-2, *0.5, and *-0.5. If OFFSET is a
function, it is called with a single argument containing the cons of
the syntactic element symbol and the relative indent point.  The
function should return an integer offset.

Here is the current list of valid syntactic element symbols:

 string                 -- inside multi-line string
 c                      -- inside a multi-line C style block comment
 defun-open             -- brace that opens a function definition
 defun-close            -- brace that closes a function definition
 defun-block-intro      -- the first line in a top-level defun
 class-open             -- brace that opens a class definition
 class-close            -- brace that closes a class definition
 inline-open            -- brace that opens an in-class inline method
 inline-close           -- brace that closes an in-class inline method
 ansi-funcdecl-cont     -- the nether region between an ANSI function
                           declaration and the defun opening brace
 knr-argdecl-intro      -- first line of a K&R C argument declaration
 knr-argdecl            -- subsequent lines in a K&R C argument declaration
 topmost-intro          -- the first line in a topmost construct definition
 topmost-intro-cont     -- topmost definition continuation lines
 member-init-intro      -- first line in a member initialization list
 member-init-cont       -- subsequent member initialization list lines
 inher-intro            -- first line of a multiple inheritance list
 inher-cont             -- subsequent multiple inheritance lines
 block-open             -- statement block open brace
 block-close            -- statement block close brace
 brace-list-open        -- open brace of an enum or static array list
 brace-list-close       -- close brace of an enum or static array list
 brace-list-intro       -- first line in an enum or static array list
 brace-list-entry       -- subsequent lines in an enum or static array list
 statement              -- a C/C++/ObjC statement
 statement-cont         -- a continuation of a C/C++/ObjC statement
 statement-block-intro  -- the first line in a new statement block
 statement-case-intro   -- the first line in a case `block'
 statement-case-open    -- the first line in a case block starting with brace
 substatement           -- the first line after an if/while/for/do/else
 substatement-open      -- the brace that opens a substatement block
 case-label             -- a case or default label
 access-label           -- C++ private/protected/public access label
 label                  -- any non-special C/C++/ObjC label
 do-while-closure       -- the `while' that ends a do/while construct
 else-clause            -- the `else' of an if/else construct
 comment-intro          -- a line containing only a comment introduction
 arglist-intro          -- the first line in an argument list
 arglist-cont           -- subsequent argument list lines when no
                           arguments follow on the same line as the
                           the arglist opening paren
 arglist-cont-nonempty  -- subsequent argument list lines when at
                           least one argument follows on the same
                           line as the arglist opening paren
 arglist-close          -- the solo close paren of an argument list
 stream-op              -- lines continuing a stream operator construct
 inclass                -- the construct is nested inside a class definition
 cpp-macro              -- the start of a cpp macro
 friend                 -- a C++ friend declaration
 objc-method-intro      -- the first line of an Objective-C method definition
 objc-method-args-cont  -- lines continuing an Objective-C method definition
 objc-method-call-cont  -- lines continuing an Objective-C method call
")

(defvar c-tab-always-indent t
  "*Controls the operation of the TAB key.
If t, hitting TAB always just indents the current line.  If nil,
hitting TAB indents the current line if point is at the left margin or
in the line's indentation, otherwise it insert a real tab character.
If other than nil or t, then tab is inserted only within literals
-- defined as comments and strings -- and inside preprocessor
directives, but line is always reindented.

Note that indentation of lines containing only comments is also
controlled by the `c-comment-only-line-offset' variable.")

(defvar c-comment-only-line-offset 0
  "*Extra offset for line which contains only the start of a comment.
Can contain an integer or a cons cell of the form:

 (NON-ANCHORED-OFFSET . ANCHORED-OFFSET)

Where NON-ANCHORED-OFFSET is the amount of offset given to
non-column-zero anchored comment-only lines, and ANCHORED-OFFSET is
the amount of offset to give column-zero anchored comment-only lines.
Just an integer as value is equivalent to (<val> . -1000).")

(defvar c-indent-comments-syntactically-p nil
  "*Specifies how comment-only lines should be indented.
When this variable is non-nil, comment-only lines are indented
according to syntactic analysis via `c-offsets-alist', even when
\\[indent-for-comment] is used.")

(defvar c-block-comments-indent-p nil
  "*Specifies how to re-indent C style block comments.

Examples of the supported styles of C block comment indentation are
shown below.  When this variable is nil, block comments are indented
as shown in styles 1 through 4.  If this variable is non-nil, block
comments are indented as shown in style 5.

Note that cc-mode does not automatically insert any stars or block
comment delimiters.  You must type these in manually.  This variable
only controls how the lines within the block comment are indented when
you hit ``\\[c-indent-command]''.

 style 1:    style 2 (GNU):    style 3:     style 4:     style 5:
 /*          /* Blah           /*           /*           /*
    blah        blah.  */       * blah      ** blah      blah
    blah                        * blah      ** blah      blah
    */                          */          */           */")

(defvar c-cleanup-list '(scope-operator)
  "*List of various C/C++/ObjC constructs to \"clean up\".
These clean ups only take place when the auto-newline feature is turned
on, as evidenced by the `/a' or `/ah' appearing next to the mode name.
Valid symbols are:

 brace-else-brace    -- cleans up `} else {' constructs by placing entire
                        construct on a single line.  This clean up only
                        takes place when there is nothing but white
                        space between the braces and the `else'.  Clean
			up occurs when the open-brace after the `else'
			is typed.
 empty-defun-braces  -- cleans up empty defun braces by placing the
                        braces on the same line.  Clean up occurs when
			the defun closing brace is typed.
 defun-close-semi    -- cleans up the terminating semi-colon on defuns
			by placing the semi-colon on the same line as
			the closing brace.  Clean up occurs when the
			semi-colon is typed.
 list-close-comma    -- cleans up commas following braces in array
                        and aggregate initializers.  Clean up occurs
			when the comma is typed.
 scope-operator      -- cleans up double colons which may designate
			a C++ scope operator split across multiple
			lines. Note that certain C++ constructs can
			generate ambiguous situations.  This clean up
			only takes place when there is nothing but
			whitespace between colons. Clean up occurs
			when the second colon is typed.")

(defvar c-hanging-braces-alist '((brace-list-open)
				 (substatement-open after)
				 (block-close . c-snug-do-while))
  "*Controls the insertion of newlines before and after braces.
This variable contains an association list with elements of the
following form: (SYNTACTIC-SYMBOL . ACTION).

When a brace (either opening or closing) is inserted, the syntactic
context it defines is looked up in this list, and if found, the
associated ACTION is used to determine where newlines are inserted.
If the context is not found, the default is to insert a newline both
before and after the brace.

SYNTACTIC-SYMBOL can be any of: defun-open, defun-close, class-open,
class-close, inline-open, inline-close, block-open, block-close,
substatement-open, statement-case-open, brace-list-open,
brace-list-close, brace-list-intro, or brace-list-entry. See
`c-offsets-alist' for details.

ACTION can be either a function symbol or a list containing any
combination of the symbols `before' or `after'.  If the list is empty,
no newlines are inserted either before or after the brace.

When ACTION is a function symbol, the function is called with a two
arguments: the syntactic symbol for the brace and the buffer position
at which the brace was inserted.  The function must return a list as
described in the preceding paragraph.  Note that during the call to
the function, the variable `c-syntactic-context' is set to the entire
syntactic context for the brace line.")

(defvar c-hanging-colons-alist nil
  "*Controls the insertion of newlines before and after certain colons.
This variable contains an association list with elements of the
following form: (SYNTACTIC-SYMBOL . ACTION).

See the variable `c-hanging-braces-alist' for the semantics of this
variable.  Note however that making ACTION a function symbol is
currently not supported for this variable.")

(defvar c-hanging-semi&comma-criteria '(c-semi&comma-inside-parenlist)
  "*List of functions that decide whether to insert a newline or not.
The functions in this list are called, in order, whenever the
auto-newline minor mode is activated (as evidenced by a `/a' or `/ah'
string in the mode line), and a semicolon or comma is typed (see
`c-electric-semi&comma').  Each function in this list is called with
no arguments, and should return one of the following values:

  nil             -- no determination made, continue checking
  'stop           -- do not insert a newline, and stop checking
  (anything else) -- insert a newline, and stop checking

If every function in the list is called with no determination made,
then no newline is inserted.")

(defvar c-hanging-comment-ender-p t
  "*If nil, `c-fill-paragraph' leaves C block comment enders on their own line.
Default value is t, which inhibits leaving block comment ending string
`*/' on a line by itself.  This is BOCM's sole behavior.")

(defvar c-backslash-column 48
  "*Column to insert backslashes when macroizing a region.")
(defvar c-special-indent-hook nil
  "*Hook for user defined special indentation adjustments.
This hook gets called after a line is indented by the mode.")
(defvar c-delete-function 'backward-delete-char-untabify
  "*Function called by `c-electric-delete' when deleting characters.")
(defvar c-electric-pound-behavior nil
  "*List of behaviors for electric pound insertion.
Only currently supported behavior is `alignleft'.")

(defvar c-recognize-knr-p t
  "*If non-nil, `c-mode' and `objc-mode' will recognize K&R constructs.
This variable is needed because of ambiguities in C syntax that make
fast recognition of K&R constructs problematic, and slow.  If you are
coding with ANSI prototypes, set this variable to nil to speed up
recognition of certain constructs.  By setting this variable to nil, I
have seen an increase of 20 times under some circumstance.")

(defvar c-progress-interval 5
  "*Interval used to update progress status during long re-indentation.
If a number, percentage complete gets updated after each interval of
that many seconds.   Set to nil to inhibit updating.  This is only
useful for Emacs 19.")

(defvar c-style-alist
  '(("gnu"
     (c-basic-offset . 2)
     (c-comment-only-line-offset . (0 . 0))
     (c-offsets-alist . ((statement-block-intro . +)
			 (knr-argdecl-intro . 5)
			 (substatement-open . +)
			 (label . 0)
			 (statement-case-open . +)
			 (statement-cont . +)
			 (arglist-intro . c-lineup-arglist-intro-after-paren)
			 (arglist-close . c-lineup-arglist)
			 ))
     )
    ("k&r"
     (c-basic-offset . 5)
     (c-comment-only-line-offset . 0)
     (c-offsets-alist . ((statement-block-intro . +)
			 (knr-argdecl-intro . 0)
			 (substatement-open . 0)
			 (label . 0)
			 (statement-cont . +)
			 ))
     )
    ("bsd"
     (c-basic-offset . 4)
     (c-comment-only-line-offset . 0)
     (c-offsets-alist . ((statement-block-intro . +)
			 (knr-argdecl-intro . +)
			 (substatement-open . 0)
			 (label . 0)
			 (statement-cont . +)
			 ))
     )
    ("stroustrup"
     (c-basic-offset . 4)
     (c-comment-only-line-offset . 0)
     (c-offsets-alist . ((statement-block-intro . +)
			 (substatement-open . 0)
			 (label . 0)
			 (statement-cont . +)
			 ))
     )
    ("whitesmith"
     (c-basic-offset . 4)
     (c-comment-only-line-offset . 0)
     (c-offsets-alist . ((statement-block-intro . +)
			 (knr-argdecl-intro . +)
			 (substatement-open . 0)
			 (label . 0)
			 (statement-cont . +)
			 ))

     )
    ("ellemtel"
     (c-basic-offset . 3)
     (c-comment-only-line-offset . 0)
     (c-hanging-braces-alist     . ((substatement-open before after)))
     (c-offsets-alist . ((topmost-intro        . 0)
                         (topmost-intro-cont   . 0)
                         (substatement         . 3)
			 (substatement-open    . 0)
			 (statement-case-intro . 0)
                         (case-label           . +)
                         (access-label         . -3)
                         (inclass              . 6)
                         (inline-open          . 0)
                         ))
     )
    ("java"
     (c-basic-offset . 2)
     (c-comment-only-line-offset . (0 . 0))
     (c-offsets-alist . ((statement-block-intro . +)
 			 (knr-argdecl-intro     . 5)
 			 (substatement-open     . +)
 			 (label                 . 0)
 			 (statement-case-open   . +)
 			 (statement-cont        . +)
 			 (arglist-intro . c-lineup-arglist-intro-after-paren)
 			 (arglist-close . c-lineup-arglist)
 			 (access-label  . 0)
			 ))

     )
    )
  "Styles of Indentation.
Elements of this alist are of the form:

  (STYLE-STRING (VARIABLE . VALUE) [(VARIABLE . VALUE) ...])

where STYLE-STRING is a short descriptive string used to select a
style, VARIABLE is any cc-mode variable, and VALUE is the intended
value for that variable when using the selected style.

There is one special case when VARIABLE is `c-offsets-alist'.  In this
case, the VALUE is a list containing elements of the form:

  (SYNTACTIC-SYMBOL . VALUE)

as described in `c-offsets-alist'.  These are passed directly to
`c-set-offset' so there is no need to set every syntactic symbol in
your style, only those that are different from the default.

Note that all styles inherit from the `cc-mode' style, which is
computed at the time the mode is loaded.")

(defvar c-file-style nil
  "*Variable interface for setting style via File Local Variables.
In a file's Local Variable section, you can set this variable to a
string suitable for `c-set-style'.  When the file is visited, cc-mode
will set the style of the file to this value automatically.

Note that file style settings are applied before file offset settings
as designated in the variable `c-file-offsets'.")

(defvar c-file-offsets nil
  "*Variable interface for setting offsets via File Local Variables.
In a file's Local Variable section, you can set this variable to an
association list similar to the values allowed in `c-offsets-alist'.
When the file is visited, cc-mode will institute these offset settings
automatically.

Note that file offset settings are applied after file style settings
as designated in the variable `c-file-style'.")

(defvar c-site-default-style "gnu"
  "Default style for your site.
To change the default style at your site, you can set this variable to
any style defined in `c-style-alist'.  However, if cc-mode is usually
loaded into your Emacs at compile time, you will need to set this
variable in the `site-init.el' file before cc-mode is loaded, then
re-dump Emacs.")

(defvar c-mode-hook nil
  "*Hook called by `c-mode'.")
(defvar c++-mode-hook nil
  "*Hook called by `c++-mode'.")
(defvar objc-mode-hook nil
  "*Hook called by `objc-mode'.")
(defvar java-mode-hook nil
  "*Hook called by `java-mode'.")

(defvar c-mode-common-hook nil
  "*Hook called by `c-mode', `c++-mode', and 'objc-mode' during common init.")

(defvar c-mode-menu
  '(["Comment Out Region"     comment-region (mark)]
    ["Macro Expand Region"    c-macro-expand (mark)]
    ["Backslashify"           c-backslash-region (mark)]
    ["Indent Expression"      c-indent-exp
     (memq (following-char) '(?\( ?\[ ?\{))]
    ["Indent Line"            c-indent-command t]
    ["Fill Comment Paragraph" c-fill-paragraph t]
    ["Up Conditional"         c-up-conditional t]
    ["Backward Conditional"   c-backward-conditional t]
    ["Forward Conditional"    c-forward-conditional t]
    ["Backward Statement"     c-beginning-of-statement t]
    ["Forward Statement"      c-end-of-statement t]
    )
  "XEmacs 19 menu for C/C++/ObjC modes.")

;; Sadly we need this for a macro in Emacs 19.
(eval-when-compile
  ;; Imenu isn't used in XEmacs, so just ignore load errors.
  (condition-case ()
      (require 'imenu)
    (error nil)))

(defvar cc-imenu-c++-generic-expression
  (` 
   ((nil
     (, 
      (concat
       "^"				; beginning of line is required
       "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>"
       "\\([a-zA-Z0-9_:]+[ \t]+\\)?"	; type specs; there can be no
       "\\([a-zA-Z0-9_:]+[ \t]+\\)?"	; more than 3 tokens, right?
        
       "\\("				; last type spec including */&
       "[a-zA-Z0-9_:]+"
       "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)" ; either pointer/ref sign or whitespace
       "\\)?"				; if there is a last type spec
       "\\("				; name; take that into the imenu entry
       "[a-zA-Z0-9_:~]+"		; member function, ctor or dtor...
 					; (may not contain * because then 
 					; "a::operator char*" would become "char*"!)
       "\\|"
       "\\([a-zA-Z0-9_:~]*::\\)?operator"
       "[^a-zA-Z1-9_][^(]*"		; ...or operator
       " \\)"
       "[ \t]*([^)]*)[ \t\n]*[^		;]" ; require something other than a ; after
 					; the (...) to avoid prototypes.  Can't
 					; catch cases with () inside the parentheses
 					; surrounding the parameters
 					; (like "int foo(int a=bar()) {...}"
        
       )) 6)    
    ("Class" 
     (, (concat 
 	 "^"				; beginning of line is required
 	 "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>"
 	 "class[ \t]+"
 	 "\\([a-zA-Z0-9_]+\\)"		; this is the string we want to get
 	 "[ \t]*[:{]"
 	 )) 2)))
  "Imenu generic expression for C++ mode.  See `imenu-generic-expression'.")
 
(defvar cc-imenu-c-generic-expression
  cc-imenu-c++-generic-expression
  "Imenu generic expression for C mode.  See `imenu-generic-expression'.")


;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;; NO USER DEFINABLE VARIABLES BEYOND THIS POINT

;; Shut the byte-compiler up. Requires Emacs 19 or JWZ's improved
;; byte-compiler. Otherwise, comment this line out and ignore
;; any warnings.
;;(byte-compiler-options (warnings nil))

;; figure out what features this Emacs has
(defconst c-emacs-features
  (let ((major (and (boundp 'emacs-major-version)
		    emacs-major-version))
	(minor (and (boundp 'emacs-minor-version)
		    emacs-minor-version))
	(re-suite 'old-re)
	flavor comments)
    ;; figure out version numbers if not already discovered
    (and (or (not major) (not minor))
	 (string-match "\\([0-9]+\\).\\([0-9]+\\)" emacs-version)
	 (setq major (string-to-int (substring emacs-version
					       (match-beginning 1)
					       (match-end 1)))
	       minor (string-to-int (substring emacs-version
					       (match-beginning 2)
					       (match-end 2)))))
    (if (not (and major minor))
	(error "Cannot figure out the major and minor version numbers."))
    ;; calculate the major version
    (cond
     ((= major 18) (setq major 'v18))	;Emacs 18
     ((= major 4)  (setq major 'v18))	;Epoch 4
     ((= major 19) (setq major 'v19	;Emacs 19
			 flavor (if (or (string-match "Lucid" emacs-version)
					(string-match "XEmacs" emacs-version))
				    'XEmacs 'FSF)))
     ;; I don't know
     (t (error "Cannot recognize major version number: %s" major)))
    ;; Regular expression suites...
    (if (and (eq major 'v19)
	     (or (and (eq flavor 'XEmacs) (>= minor 14))
		 (and (eq flavor 'FSF) (>= minor 30))))
	(setq re-suite 'new-re))
    ;; XEmacs 19 uses 8-bit modify-syntax-entry flags, as do all
    ;; patched Emacs 19, Emacs 18, Epoch 4's.  Only Emacs 19 uses a
    ;; 1-bit flag.  Let's be as smart as we can about figuring this
    ;; out.
    (if (eq major 'v19)
	(let ((table (copy-syntax-table)))
	  (modify-syntax-entry ?a ". 12345678" table)
	  (cond
	   ;; XEmacs pre 20 and Emacs pre 19.30 use vectors for syntax tables.
	   ((vectorp table)
	    (if (= (logand (lsh (aref table ?a) -16) 255) 255)
		(setq comments '8-bit)
	      (setq comments '1-bit)))
	   ;; XEmacs 20 is known to be 8-bit
	   ((eq flavor 'XEmacs) (setq comments '8-bit))
	   ;; Emacs 19.30 and beyond are known to be 1-bit
	   ((eq flavor 'FSF) (setq comments '1-bit))
	   ;; Don't know what this is
	   (t (error "Couldn't figure out syntax table format."))
	   ))
      ;; Emacs 18 has no support for dual comments
      (setq comments 'no-dual-comments))
    ;; lets do some minimal sanity checking.
    (if (and (or
	      ;; Lucid Emacs before 19.6 had bugs
	      (and (eq major 'v19) (eq flavor 'XEmacs) (< minor 6))
	      ;; Emacs 19 before 19.21 has known bugs
	      (and (eq major 'v19) (eq flavor 'FSF) (< minor 21)))
	     (not c-inhibit-startup-warnings-p))
	(with-output-to-temp-buffer "*cc-mode warnings*"
	  (print (format
"The version of Emacs that you are running, %s,
has known bugs in its syntax.c parsing routines which will affect the
performance of cc-mode. You should strongly consider upgrading to the
latest available version.  cc-mode may continue to work, after a
fashion, but strange indentation errors could be encountered."
		     emacs-version))))
    ;; Emacs 18, with no patch is not too good
    (if (and (eq major 'v18) (eq comments 'no-dual-comments)
	     (not c-inhibit-startup-warnings-p))
	(with-output-to-temp-buffer "*cc-mode warnings*"
	  (print (format
"The version of Emacs 18 you are running, %s,
has known deficiencies in its ability to handle dual C++ comments,
i.e. C++ line style comments and C block style comments.  This will
not be much of a problem for you if you are only editing C code, but
if you are doing much C++ editing, you should strongly consider
upgrading to one of the latest Emacs 19's.  In Emacs 18, you may also
experience performance degradations. Emacs 19 has some new built-in
routines which will speed things up for you.

Because of these inherent problems, cc-mode is no longer being
actively maintained for Emacs 18, however, until you can upgrade to
Emacs 19, you may want to look at cc-mode-18.el in the cc-mode
distribution.  THIS FILE IS COMPLETELY UNSUPPORTED!  If you use it,
you are on your own, although patch contributions will be folded into
the main release."
			    emacs-version))))
    ;; Emacs 18 with the syntax patches are no longer supported
    (if (and (eq major 'v18) (not (eq comments 'no-dual-comments))
	     (not c-inhibit-startup-warnings-p))
	(with-output-to-temp-buffer "*cc-mode warnings*"
	  (print (format
"You are running a syntax patched Emacs 18 variant.  While this should
work for you, you may want to consider upgrading to Emacs 19.  The
syntax patches are no longer supported either for syntax.c or
cc-mode."))))
    (list major comments re-suite))
  "A list of features extant in the Emacs you are using.
There are many flavors of Emacs out there, each with different
features supporting those needed by cc-mode.  Here's the current
supported list, along with the values for this variable:

 Emacs 18/Epoch 4:           (v18 no-dual-comments RS)
 Emacs 18/Epoch 4 (patch2):  (v18 8-bit RS)
 XEmacs 19:                  (v19 8-bit RS)
 Emacs 19:                   (v19 1-bit RS)

RS is the regular expression suite to use.  XEmacs versions after
19.13, and Emacs versions after 19.29 use the `new-re' regex suite.
All other Emacsen use the `old-re' suite.")

(defvar c++-mode-abbrev-table nil
  "Abbrev table in use in c++-mode buffers.")
(define-abbrev-table 'c++-mode-abbrev-table ())

(defvar c-mode-abbrev-table nil
  "Abbrev table in use in c-mode buffers.")
(define-abbrev-table 'c-mode-abbrev-table ())

(defvar objc-mode-abbrev-table nil
  "Abbrev table in use in objc-mode buffers.")
(define-abbrev-table 'objc-mode-abbrev-table ())

(defvar java-mode-abbrev-table nil
  "Abbrev table in use in java-mode buffers.")
(define-abbrev-table 'java-mode-abbrev-table ())

(defun c-mode-fsf-menu (name map)
  ;; Add menu to a keymap.  FSF menus suck.  Don't add them for
  ;; XEmacs. This feature test will fail on other than Emacs 19.
  (condition-case nil
      (progn
	(define-key map [menu-bar] (make-sparse-keymap))
	(define-key map [menu-bar c] (cons name (make-sparse-keymap name)))

	(define-key map [menu-bar c comment-region]
	  '("Comment Out Region" . comment-region))
	(define-key map [menu-bar c c-macro-expand]
	  '("Macro Expand Region" . c-macro-expand))
	(define-key map [menu-bar c c-backslash-region]
	  '("Backslashify" . c-backslash-region))
	(define-key map [menu-bar c indent-exp]
	  '("Indent Expression" . c-indent-exp))
	(define-key map [menu-bar c indent-line]
	  '("Indent Line" . c-indent-command))
	(define-key map [menu-bar c fill]
	  '("Fill Comment Paragraph" . c-fill-paragraph))
	(define-key map [menu-bar c up]
	  '("Up Conditional" . c-up-conditional))
	(define-key map [menu-bar c backward]
	  '("Backward Conditional" . c-backward-conditional))
	(define-key map [menu-bar c forward]
	  '("Forward Conditional" . c-forward-conditional))
	(define-key map [menu-bar c backward-stmt]
	  '("Backward Statement" . c-beginning-of-statement))
	(define-key map [menu-bar c forward-stmt]
	  '("Forward Statement" . c-end-of-statement))

	;; RMS: mouse-3 should not select this menu.  mouse-3's global
	;; definition is useful in C mode and we should not interfere
	;; with that.  The menu is mainly for beginners, and for them,
	;; the menubar requires less memory than a special click.
	t)
    (error nil)))

(defvar c-mode-map ()
  "Keymap used in c-mode buffers.")
(if c-mode-map
    ()
  ;; TBD: should we even worry about naming this keymap. My vote: no,
  ;; because Emacs and XEmacs do it differently.
  (setq c-mode-map (make-sparse-keymap))
  ;; put standard keybindings into MAP
  ;; the following mappings correspond more or less directly to BOCM
  (define-key c-mode-map "{"         'c-electric-brace)
  (define-key c-mode-map "}"         'c-electric-brace)
  (define-key c-mode-map ";"         'c-electric-semi&comma)
  (define-key c-mode-map "#"         'c-electric-pound)
  (define-key c-mode-map ":"         'c-electric-colon)
  ;; Lucid Emacs 19.9 defined these two, the second of which was
  ;; commented out...
  ;; (define-key c-mode-map "\e{" 'c-insert-braces)
  ;; Commented out electric square brackets because nobody likes them.
  ;; (define-key c-mode-map "[" 'c-insert-brackets)
  (define-key c-mode-map "\e\C-h"    'c-mark-function)
  (define-key c-mode-map "\e\C-q"    'c-indent-exp)
  (define-key c-mode-map "\ea"       'c-beginning-of-statement)
  (define-key c-mode-map "\ee"       'c-end-of-statement)
  ;; Emacs 19.30 introduces fill-paragraph-function, but it's not in
  ;; every version of Emacs cc-mode supports.
  (if (not (boundp 'fill-paragraph-function))
      ;; I'd rather use an adaptive fill program instead of this.
      (define-key c-mode-map "\eq"   'c-fill-paragraph))
  (define-key c-mode-map "\C-c\C-n"  'c-forward-conditional)
  (define-key c-mode-map "\C-c\C-p"  'c-backward-conditional)
  (define-key c-mode-map "\C-c\C-u"  'c-up-conditional)
  (define-key c-mode-map "\t"        'c-indent-command)
  (define-key c-mode-map "\177"      'c-electric-delete)
  ;; these are new keybindings, with no counterpart to BOCM
  (define-key c-mode-map ","         'c-electric-semi&comma)
  (define-key c-mode-map "*"         'c-electric-star)
  (define-key c-mode-map "\C-c\C-q"  'c-indent-defun)
  (define-key c-mode-map "\C-c\C-\\" 'c-backslash-region)
  ;; TBD: where if anywhere, to put c-backward|forward-into-nomenclature
  (define-key c-mode-map "\C-c\C-a"  'c-toggle-auto-state)
  (define-key c-mode-map "\C-c\C-b"  'c-submit-bug-report)
  (define-key c-mode-map "\C-c\C-c"  'comment-region)
  (define-key c-mode-map "\C-c\C-d"  'c-toggle-hungry-state)
  (define-key c-mode-map "\C-c\C-e"  'c-macro-expand)
  (define-key c-mode-map "\C-c\C-o"  'c-set-offset)
  (define-key c-mode-map "\C-c\C-s"  'c-show-syntactic-information)
  (define-key c-mode-map "\C-c\C-t"  'c-toggle-auto-hungry-state)
  ;; conflicts with OOBR
  ;;(define-key c-mode-map "\C-c\C-v"  'c-version)
  ;;
  ;; Emacs 19 defines menus in the mode map. This call will return
  ;; t on Emacs 19, otherwise no-op and return nil.
  (if (and (not (c-mode-fsf-menu "C" c-mode-map))
	   ;; in XEmacs 19, we want the menu to popup when the 3rd
	   ;; button is hit.  In Lucid Emacs 19.10 and beyond this is
	   ;; done automatically if we put the menu on mode-popup-menu
	   ;; variable, see c-common-init. Emacs 19 uses C-Mouse-3 for
	   ;; this, and it works with no special effort.
	   (boundp 'current-menubar)
	   (not (boundp 'mode-popup-menu)))
      (define-key c-mode-map 'button3 'c-popup-menu)))

(defvar c++-mode-map ()
  "Keymap used in c++-mode buffers.")
(if c++-mode-map
    ()
  ;; In Emacs 19, it makes more sense to inherit c-mode-map
  (if (memq 'v19 c-emacs-features)
      ;; XEmacs and Emacs 19 do this differently
      (cond
       ;; XEmacs 19.13
       ((fboundp 'set-keymap-parents)
	(setq c++-mode-map (make-sparse-keymap))
	(set-keymap-parents c++-mode-map c-mode-map))
       ((fboundp 'set-keymap-parent)
	(setq c++-mode-map (make-sparse-keymap))
	(set-keymap-parent c++-mode-map c-mode-map))
       (t (setq c++-mode-map (cons 'keymap c-mode-map))))
    ;; Do it the hard way for Emacs 18 -- given by JWZ
    (setq c++-mode-map (nconc (make-sparse-keymap) c-mode-map)))
  ;; add bindings which are only useful for C++
  (define-key c++-mode-map "\C-c:"  'c-scope-operator)
  (define-key c++-mode-map "/"      'c-electric-slash)
  (define-key c++-mode-map "<"      'c-electric-lt-gt)
  (define-key c++-mode-map ">"      'c-electric-lt-gt)
  ;; Emacs 19 defines menus in the mode map. This call will return
  ;; t on Emacs 19, otherwise no-op and return nil.
  (c-mode-fsf-menu "C++" c++-mode-map))

(defvar objc-mode-map ()
  "Keymap used in objc-mode buffers.")
(if objc-mode-map
    ()
  ;; In Emacs 19, it makes more sense to inherit c-mode-map
  (if (memq 'v19 c-emacs-features)
      ;; XEmacs and Emacs 19 do this differently
      (cond
       ;; XEmacs 19.13
       ((fboundp 'set-keymap-parents)
	(setq objc-mode-map (make-sparse-keymap))
	(set-keymap-parents objc-mode-map c-mode-map))
       ((fboundp 'set-keymap-parent)
	(setq objc-mode-map (make-sparse-keymap))
	(set-keymap-parent objc-mode-map c-mode-map))
       (t (setq objc-mode-map (cons 'keymap c-mode-map))))
    ;; Do it the hard way for Emacs 18 -- given by JWZ
    (setq objc-mode-map (nconc (make-sparse-keymap) c-mode-map)))
  ;; add bindings which are only useful for Objective-C
  (define-key objc-mode-map "/"      'c-electric-slash)
  ;; Emacs 19 defines menus in the mode map. This call will return
  ;; t on Emacs 19, otherwise no-op and return nil.
  (c-mode-fsf-menu "ObjC" objc-mode-map))

(defvar java-mode-map ()
  "Keymap used in java-mode buffers.")
(if java-mode-map
    ()
  ;; In Emacs 19, it makes more sense to inherit c-mode-map
  (if (memq 'v19 c-emacs-features)
      ;; XEmacs and Emacs 19 do this differently
      (cond
       ;; XEmacs 19.13
       ((fboundp 'set-keymap-parents)
	(setq java-mode-map (make-sparse-keymap))
	(set-keymap-parents java-mode-map c-mode-map))
       ((fboundp 'set-keymap-parent)
	(setq java-mode-map (make-sparse-keymap))
	(set-keymap-parent java-mode-map c-mode-map))
       (t (setq java-mode-map (cons 'keymap c-mode-map)))
       )
    ;; Do it the hard way for Emacs 18 -- given by JWZ
    (setq java-mode-map (nconc (make-sparse-keymap) c-mode-map)))
  ;; add bindings which are only useful for Java
  (define-key java-mode-map "/"      'c-electric-slash)
  ;; Emacs 19 defines menus in the mode map. This call will return t
  ;; on Emacs 19, otherwise no-op and return nil.
  (c-mode-fsf-menu "Java" java-mode-map))

(defun c-populate-syntax-table (table)
  ;; Populate the syntax TABLE
  ;; DO NOT TRY TO SET _ (UNDERSCORE) TO WORD CLASS!
  (modify-syntax-entry ?_  "_"     table)
  (modify-syntax-entry ?\\ "\\"    table)
  (modify-syntax-entry ?+  "."     table)
  (modify-syntax-entry ?-  "."     table)
  (modify-syntax-entry ?=  "."     table)
  (modify-syntax-entry ?%  "."     table)
  (modify-syntax-entry ?<  "."     table)
  (modify-syntax-entry ?>  "."     table)
  (modify-syntax-entry ?&  "."     table)
  (modify-syntax-entry ?|  "."     table)
  (modify-syntax-entry ?\' "\""    table))

(defun c-setup-dual-comments (table)
  ;; Set up TABLE to handle block and line style comments
  (cond
   ((memq '8-bit c-emacs-features)
    ;; XEmacs 19 has the best implementation
    (modify-syntax-entry ?/  ". 1456" table)
    (modify-syntax-entry ?*  ". 23"   table)
    (modify-syntax-entry ?\n "> b"    table)
    ;; Give CR the same syntax as newline, for selective-display
    (modify-syntax-entry ?\^m "> b"    table))
   ((memq '1-bit c-emacs-features)
    ;; Emacs 19 does things differently, but we can work with it
    (modify-syntax-entry ?/  ". 124b" table)
    (modify-syntax-entry ?*  ". 23"   table)
    (modify-syntax-entry ?\n "> b"    table)
    ;; Give CR the same syntax as newline, for selective-display
    (modify-syntax-entry ?\^m "> b"   table))
   ))

(defvar c-mode-syntax-table nil
  "Syntax table used in c-mode buffers.")
(if c-mode-syntax-table
    ()
  (setq c-mode-syntax-table (make-syntax-table))
  (c-populate-syntax-table c-mode-syntax-table)
  ;; add extra comment syntax
  (modify-syntax-entry ?/  ". 14"  c-mode-syntax-table)
  (modify-syntax-entry ?*  ". 23"  c-mode-syntax-table))

(defvar c++-mode-syntax-table nil
  "Syntax table used in c++-mode buffers.")
(if c++-mode-syntax-table
    ()
  (setq c++-mode-syntax-table (make-syntax-table))
  (c-populate-syntax-table c++-mode-syntax-table)
  ;; add extra comment syntax
  (c-setup-dual-comments c++-mode-syntax-table)
  ;; TBD: does it make sense for colon to be symbol class in C++?
  ;; I'm not so sure, since c-label-key is busted on lines like:
  ;; Foo::bar( i );
  ;; maybe c-label-key should be fixed instead of commenting this out,
  ;; but it also bothers me that this only seems appropriate for C++
  ;; and not C.
  ;;(modify-syntax-entry ?: "_" c++-mode-syntax-table)
  )

(defvar objc-mode-syntax-table nil
  "Syntax table used in objc-mode buffers.")
(if objc-mode-syntax-table
    ()
  (setq objc-mode-syntax-table (make-syntax-table))
  (c-populate-syntax-table objc-mode-syntax-table)
  ;; add extra comment syntax
  (c-setup-dual-comments objc-mode-syntax-table)
  ;; everyone gets these
  (modify-syntax-entry ?@ "_" objc-mode-syntax-table)
  )

(defvar java-mode-syntax-table nil
  "Syntax table used in java-mode buffers.")
(if java-mode-syntax-table
    ()
  (setq java-mode-syntax-table (make-syntax-table))
  (c-populate-syntax-table java-mode-syntax-table)
  ;; add extra comment syntax
  (c-setup-dual-comments java-mode-syntax-table)
  ;; everyone gets these
  (modify-syntax-entry ?@ "_" java-mode-syntax-table)
  )

(defvar c-hungry-delete-key nil
  "Internal state of hungry delete key feature.")
(defvar c-auto-newline nil
  "Internal state of auto newline feature.")
(defvar c-auto-hungry-string nil
  "Internal auto-newline/hungry-delete designation string for mode line.")
(defvar c-syntactic-context nil
  "Variable containing syntactic analysis list during indentation.")
(defvar c-comment-start-regexp nil
  "Buffer local variable describing how comment are introduced.")
(defvar c-conditional-key nil
  "Buffer local language-specific conditional keyword regexp.")
(defvar c-access-key nil
  "Buffer local language-specific access key regexp.")
(defvar c-class-key nil
  "Buffer local language-specific class key regexp.")
(defvar c-method-key nil
  "Buffer local language-specific method regexp.")
(defvar c-double-slash-is-comments-p nil
  "Buffer local language-specific comment style flag.")
(defconst c-protection-key
  "\\<\\(public\\|protected\\|private\\)\\>"
  "Regexp describing protection keywords.")
(defconst c-symbol-key "\\(\\w\\|\\s_\\)+"
  "Regexp describing a C/C++/ObjC symbol.
We cannot use just `word' syntax class since `_' cannot be in word
class.  Putting underscore in word class breaks forward word movement
behavior that users are familiar with.")
(defconst c-baseclass-key
  (concat
   ":?[ \t]*\\(virtual[ \t]+\\)?\\("
   c-protection-key "[ \t]+\\)" c-symbol-key)
  "Regexp describing C++ base classes in a derived class definition.")

;; minor mode variables
(make-variable-buffer-local 'c-auto-newline)
(make-variable-buffer-local 'c-hungry-delete-key)
(make-variable-buffer-local 'c-auto-hungry-string)
;; language differences
(make-variable-buffer-local 'c-comment-start-regexp)
(make-variable-buffer-local 'c-conditional-key)
(make-variable-buffer-local 'c-access-key)
(make-variable-buffer-local 'c-class-key)
(make-variable-buffer-local 'c-method-key)
(make-variable-buffer-local 'c-double-slash-is-comments-p)
(make-variable-buffer-local 'c-baseclass-key)
(make-variable-buffer-local 'c-recognize-knr-p)
;; style variables are made buffer local at tail end of this file.

;; cmacexp is lame because it uses no preprocessor symbols.
;; It isn't very extensible either -- hardcodes /lib/cpp.
;; [I add it here only because c-mode has it -- BAW]
(autoload 'c-macro-expand "cmacexp"
  "Display the result of expanding all C macros occurring in the region.
The expansion is entirely correct because it uses the C preprocessor."
  t)


;; constant regular expressions for looking at various constructs
(defconst c-C++-class-key "\\(class\\|struct\\|union\\)"
  "Regexp describing a C++ class declaration, including templates.")
(defconst c-C-class-key "\\(struct\\|union\\)"
  "Regexp describing a C struct declaration.")
(defconst c-inher-key
  (concat "\\(\\<static\\>\\s +\\)?"
	  c-C++-class-key "[ \t]+" c-symbol-key
	  "\\([ \t]*:[ \t]*\\)?\\s *[^;]")
  "Regexp describing a class inheritance declaration.")
(defconst c-switch-label-key
  "\\(\\(case[( \t]+\\S .*\\)\\|default[ \t]*\\):"
  "Regexp describing a switch's case or default label")
(defconst c-C++-access-key
  (concat c-protection-key ":")
  "Regexp describing C++ access specification keywords.")
(defconst c-label-key
  (concat c-symbol-key ":\\([^:]\\|$\\)")
  "Regexp describing any label.")
(defconst c-C-conditional-key
  "\\b\\(for\\|if\\|do\\|else\\|while\\|switch\\)\\b[^_]"
  "Regexp describing a conditional control.")
(defconst c-C++-conditional-key
  "\\b\\(for\\|if\\|do\\|else\\|while\\|switch\\|try\\|catch\\)\\b[^_]"
  "Regexp describing a conditional control for C++.")
(defconst c-C++-friend-key
  "friend[ \t]+\\|template[ \t]*<.+>[ \t]*friend[ \t]+"
  "Regexp describing friend declarations in C++ classes.")
(defconst c-C++-comment-start-regexp "//\\|/\\*"
  "Dual comment value for `c-comment-start-regexp'.")
(defconst c-C-comment-start-regexp "/\\*"
  "Single comment style value for `c-comment-start-regexp'.")

(defconst c-ObjC-method-key
  (concat
   "^\\s *[+-]\\s *"
   "\\(([^)]*)\\)?"			; return type
   ;; \\s- in objc syntax table does not include \n
   ;; since it is considered the end of //-comments.
   "[ \t\n]*" c-symbol-key)
  "Regexp describing an Objective-C method intro.")
(defconst c-ObjC-access-key
  (concat "@" c-protection-key)
  "Regexp describing access specification keywords for Objective-C.")
(defconst c-ObjC-class-key
  (concat
   "@\\(interface\\|implementation\\)\\s +"
   c-symbol-key				;name of the class
   "\\(\\s *:\\s *" c-symbol-key "\\)?"	;maybe followed by the superclass
   "\\(\\s *<[^>]+>\\)?"		;and maybe the adopted protocols list
   )
  "Regexp describing a class or protocol declaration for Objective-C.")

(defconst c-Java-method-key
  (concat
   "^\\s *[+-]\\s *"
   "\\(([^)]*)\\)?"			; return type
   ;; \\s- in java syntax table does not include \n
   ;; since it is considered the end of //-comments.
   "[ \t\n]*" c-symbol-key)
  "Regexp describing a Java method intro.")
(defconst c-Java-access-key
  (concat c-protection-key)
  "Regexp describing access specification keywords for Java.")
(defconst c-Java-class-key
  (concat
   "\\(interface\\|class\\)\\s +"
   c-symbol-key				;name of the class
   "\\(\\s *extends\\s *" c-symbol-key "\\)?" ;maybe followed by superclass 
   ;;"\\(\\s *implements *[^{]+{\\)?"	;and maybe the adopted protocols list
   )
  "Regexp describing a class or protocol declaration for Java.")

;; KLUDGE ALERT.  We default these variables to their `C' values so
;; that non-cc-mode-ized modes that depend on c-mode will still work
;; out of the box.  The most glaring example is awk-mode.  There ought
;; to be a better way.
(setq-default c-conditional-key c-C-conditional-key
	      c-class-key c-C-class-key
	      c-comment-start-regexp c-C-comment-start-regexp)


;; main entry points for the modes
(defconst c-list-of-mode-names nil)

;;;###autoload
(defun c-mode ()
  "Major mode for editing K&R and ANSI C code.
To submit a problem report, enter `\\[c-submit-bug-report]' from a
c-mode buffer.  This automatically sets up a mail buffer with version
information already added.  You just need to add a description of the
problem, including a reproducible test case and send the message.

To see what version of cc-mode you are running, enter `\\[c-version]'.

The hook variable `c-mode-hook' is run with no args, if that value is
bound and has a non-nil value.  Also the hook `c-mode-common-hook' is
run first.

Key bindings:
\\{c-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (set-syntax-table c-mode-syntax-table)
  (setq major-mode 'c-mode
	mode-name "C"
	local-abbrev-table c-mode-abbrev-table)
  (use-local-map c-mode-map)
  (c-common-init)
  (setq comment-start "/* "
	comment-end   " */"
	comment-multi-line t
	c-conditional-key c-C-conditional-key
	c-class-key c-C-class-key
	c-baseclass-key nil
	c-comment-start-regexp c-C-comment-start-regexp
	imenu-generic-expression cc-imenu-c-generic-expression)
  (run-hooks 'c-mode-common-hook)
  (run-hooks 'c-mode-hook))
(setq c-list-of-mode-names (cons "C" c-list-of-mode-names))

;;;###autoload
(defun c++-mode ()
  "Major mode for editing C++ code.
To submit a problem report, enter `\\[c-submit-bug-report]' from a
c++-mode buffer.  This automatically sets up a mail buffer with
version information already added.  You just need to add a description
of the problem, including a reproducible test case, and send the
message.

To see what version of cc-mode you are running, enter `\\[c-version]'.

The hook variable `c++-mode-hook' is run with no args, if that
variable is bound and has a non-nil value.  Also the hook
`c-mode-common-hook' is run first.

Key bindings:
\\{c++-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (set-syntax-table c++-mode-syntax-table)
  (setq major-mode 'c++-mode
	mode-name "C++"
	local-abbrev-table c++-mode-abbrev-table)
  (use-local-map c++-mode-map)
  (c-common-init)
  (setq comment-start "// "
	comment-end ""
	comment-multi-line nil
	c-conditional-key c-C++-conditional-key
	c-comment-start-regexp c-C++-comment-start-regexp
	c-class-key c-C++-class-key
	c-access-key c-C++-access-key
	c-double-slash-is-comments-p t
	imenu-generic-expression cc-imenu-c++-generic-expression)
  (make-local-variable 'c-recognize-knr-p)
  (setq c-recognize-knr-p nil)
  (run-hooks 'c-mode-common-hook)
  (run-hooks 'c++-mode-hook))
(setq c-list-of-mode-names (cons "C++" c-list-of-mode-names))

;;;###autoload
(defun objc-mode ()
  "Major mode for editing Objective C code.
To submit a problem report, enter `\\[c-submit-bug-report]' from an
objc-mode buffer.  This automatically sets up a mail buffer with
version information already added.  You just need to add a description
of the problem, including a reproducible test case, and send the
message.

To see what version of cc-mode you are running, enter `\\[c-version]'.

The hook variable `objc-mode-hook' is run with no args, if that value
is bound and has a non-nil value.  Also the hook `c-mode-common-hook'
is run first.

Key bindings:
\\{objc-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (set-syntax-table objc-mode-syntax-table)
  (setq major-mode 'objc-mode
	mode-name "ObjC"
	local-abbrev-table objc-mode-abbrev-table)
  (use-local-map objc-mode-map)
  (c-common-init)
  (setq comment-start "// "
	comment-end   ""
	comment-multi-line nil
	c-conditional-key c-C-conditional-key
	c-comment-start-regexp c-C++-comment-start-regexp
 	c-class-key c-ObjC-class-key
	c-baseclass-key nil
	c-access-key c-ObjC-access-key
	c-double-slash-is-comments-p t
	c-method-key c-ObjC-method-key)
  (run-hooks 'c-mode-common-hook)
  (run-hooks 'objc-mode-hook))
(setq c-list-of-mode-names (cons "ObjC" c-list-of-mode-names))

;;;###autoload
(defun java-mode ()
  "Major mode for editing Java code.
To submit a problem report, enter `\\[c-submit-bug-report]' from an
java-mode buffer.  This automatically sets up a mail buffer with
version information already added.  You just need to add a description
of the problem, including a reproducible test case and send the
message.

To see what version of cc-mode you are running, enter `\\[c-version]'.

The hook variable `java-mode-hook' is run with no args, if that value
is bound and has a non-nil value.  Also the common hook
`c-mode-common-hook' is run first.

Key bindings:
\\{java-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (set-syntax-table java-mode-syntax-table)
  (setq major-mode 'java-mode
 	mode-name "Java"
 	local-abbrev-table java-mode-abbrev-table)
  (use-local-map java-mode-map)
  (c-common-init)
  (setq comment-start "// "
 	comment-end   ""
 	comment-multi-line nil
 	c-conditional-key c-C-conditional-key
 	c-comment-start-regexp c-C++-comment-start-regexp
  	c-class-key c-Java-class-key
	c-method-key c-Java-method-key
	c-double-slash-is-comments-p t
 	c-baseclass-key nil
 	c-access-key c-Java-access-key)
  (c-set-style "Java")
  (run-hooks 'c-mode-common-hook)
  (run-hooks 'java-mode-hook))
(setq c-list-of-mode-names (cons "Java" c-list-of-mode-names))

(defun c-common-init ()
  ;; Common initializations for c++-mode and c-mode.
  ;; make local variables
  (make-local-variable 'paragraph-start)
  (make-local-variable 'paragraph-separate)
  (make-local-variable 'paragraph-ignore-fill-prefix)
  (make-local-variable 'require-final-newline)
  (make-local-variable 'parse-sexp-ignore-comments)
  (make-local-variable 'indent-line-function)
  (make-local-variable 'indent-region-function)
  (make-local-variable 'comment-start)
  (make-local-variable 'comment-end)
  (make-local-variable 'comment-column)
  (make-local-variable 'comment-start-skip)
  (make-local-variable 'comment-multi-line)
  (make-local-variable 'outline-regexp)
  (make-local-variable 'outline-level)
  (make-local-variable 'adaptive-fill-regexp)
  (make-local-variable 'imenu-generic-expression) ;set in the mode functions
  ;; Emacs 19.30 and beyond only, AFAIK
  (if (boundp 'fill-paragraph-function)
      (progn
	(make-local-variable 'fill-paragraph-function)
	(setq fill-paragraph-function 'c-fill-paragraph)))
  ;; now set their values
  (setq paragraph-start (if (memq 'new-re c-emacs-features)
			    (concat page-delimiter "\\|$")
			  (concat "^$\\|" page-delimiter))
	paragraph-separate paragraph-start
	paragraph-ignore-fill-prefix t
	require-final-newline t
	parse-sexp-ignore-comments t
	indent-line-function 'c-indent-line
	indent-region-function 'c-indent-region
	outline-regexp "[^#\n\^M]"
	outline-level 'c-outline-level
	comment-column 32
	comment-start-skip "/\\*+ *\\|// *"
	adaptive-fill-regexp nil)
  ;; we have to do something special for c-offsets-alist so that the
  ;; buffer local value has its own alist structure.
  (setq c-offsets-alist (copy-alist c-offsets-alist))
  ;; setup the comment indent variable in a Emacs version portable way
  ;; ignore any byte compiler warnings you might get here
  (if (boundp 'comment-indent-function)
      (progn
	   (make-local-variable 'comment-indent-function)
	   (setq comment-indent-function 'c-comment-indent))
    (make-local-variable 'comment-indent-hook)
    (setq comment-indent-hook 'c-comment-indent))
  ;; Put C menu into menubar and on popup menu for XEmacs 19. I think
  ;; this happens automatically for Emacs 19.
  (if (and (boundp 'current-menubar)
	   current-menubar
	   (not (assoc mode-name current-menubar)))
      ;; its possible that this buffer has changed modes from one of
      ;; the other cc-mode modes.  In that case, only the menubar
      ;; title of the menu changes.
      (let ((modes (copy-sequence c-list-of-mode-names))
	    changed-p)
	(setq modes (delete major-mode modes))
	(while modes
	  (if (not (assoc (car modes) current-menubar))
	      (setq modes (cdr modes))
	    (relabel-menu-item (list (car modes)) mode-name)
	    (setq modes nil
		  changed-p t)))
	(if (not changed-p)
	    (progn
	      (set-buffer-menubar (copy-sequence current-menubar))
	      (add-menu nil mode-name c-mode-menu)))))
  (if (boundp 'mode-popup-menu)
      (setq mode-popup-menu
	    (cons (concat mode-name " Mode Commands") c-mode-menu)))
  ;; put auto-hungry designators onto minor-mode-alist, but only once
  (or (assq 'c-auto-hungry-string minor-mode-alist)
      (setq minor-mode-alist
	    (cons '(c-auto-hungry-string c-auto-hungry-string)
		  minor-mode-alist))))

(defun c-postprocess-file-styles ()
  "Function that post processes relevant file local variables.
Currently, this function simply applies any style and offset settings
found in the file's Local Variable list.  It first applies any style
setting found in `c-file-style', then it applies any offset settings
it finds in `c-file-offsets'."
  ;; apply file styles and offsets
  (and c-file-style
       (c-set-style c-file-style))
  (and c-file-offsets
       (mapcar
	(function
	 (lambda (langentry)
	   (let ((langelem (car langentry))
		 (offset (cdr langentry)))
	     (c-set-offset langelem offset)
	     )))
	c-file-offsets)))

;; Add the postprocessing function to hack-local-variables-hook.  As
;; of 28-Aug-1995, XEmacs 19.12 and Emacs 19.29 support this.
(and (fboundp 'add-hook)
     (add-hook 'hack-local-variables-hook 'c-postprocess-file-styles))

(defun c-enable-//-in-c-mode ()
  "Enables // as a comment delimiter in `c-mode'.
ANSI C currently does *not* allow this, although many C compilers
support optional C++ style comments.  To use, call this function from
your `.emacs' file before you visit any C files.  The changes are
global and affect all future `c-mode' buffers."
  (c-setup-dual-comments c-mode-syntax-table)
  (setq-default c-C-comment-start-regexp c-C++-comment-start-regexp))


;; macros must be defined before first use
(defmacro c-point (position)
  ;; Returns the value of point at certain commonly referenced POSITIONs.
  ;; POSITION can be one of the following symbols:
  ;; 
  ;; bol  -- beginning of line
  ;; eol  -- end of line
  ;; bod  -- beginning of defun
  ;; boi  -- back to indentation
  ;; ionl -- indentation of next line
  ;; iopl -- indentation of previous line
  ;; bonl -- beginning of next line
  ;; bopl -- beginning of previous line
  ;; 
  ;; This function does not modify point or mark.
  (or (and (eq 'quote (car-safe position))
	   (null (cdr (cdr position))))
      (error "bad buffer position requested: %s" position))
  (setq position (nth 1 position))
  (` (let ((here (point)))
       (,@ (cond
	    ((eq position 'bol)  '((beginning-of-line)))
	    ((eq position 'eol)  '((end-of-line)))
	    ((eq position 'bod)
	     '((beginning-of-defun)
	       ;; if defun-prompt-regexp is non-nil, b-o-d won't leave
	       ;; us at the open brace.
	       (and (boundp 'defun-prompt-regexp)
		    defun-prompt-regexp
		    (looking-at defun-prompt-regexp)
		    (goto-char (match-end 0)))
	       ))
	    ((eq position 'boi)  '((back-to-indentation)))
	    ((eq position 'bonl) '((forward-line 1)))
	    ((eq position 'bopl) '((forward-line -1)))
	    ((eq position 'iopl)
	     '((forward-line -1)
	       (back-to-indentation)))
	    ((eq position 'ionl)
	     '((forward-line 1)
	       (back-to-indentation)))
	    (t (error "unknown buffer position requested: %s" position))
	    ))
       (prog1
	   (point)
	 (goto-char here))
       ;; workaround for an Emacs18 bug -- blech! Well, at least it
       ;; doesn't hurt for v19
       (,@ nil)
       )))

(defmacro c-auto-newline ()
  ;; if auto-newline feature is turned on, insert a newline character
  ;; and return t, otherwise return nil.
  (` (and c-auto-newline
	  (not (c-in-literal))
	  (not (newline)))))

(defmacro c-safe (&rest body)
  ;; safely execute BODY, return nil if an error occurred
  (` (condition-case nil
	 (progn (,@ body))
       (error nil))))

(defun c-insert-special-chars (arg)
  ;; simply call self-insert-command in Emacs 19
  (self-insert-command (prefix-numeric-value arg)))

(defun c-intersect-lists (list alist)
  ;; return the element of ALIST that matches the first element found
  ;; in LIST.  Uses assq.
  (let (match)
    (while (and list
		(not (setq match (assq (car list) alist))))
      (setq list (cdr list)))
    match))

(defun c-lookup-lists (list alist1 alist2)
  ;; first, find the first entry from LIST that is present in ALIST1,
  ;; then find the entry in ALIST2 for that entry.
  (assq (car (c-intersect-lists list alist1)) alist2))


;; This is used by indent-for-comment to decide how much to indent a
;; comment in C code based on its context.
(defun c-comment-indent ()
  (if (looking-at (concat "^\\(" c-comment-start-regexp "\\)"))
      0				;Existing comment at bol stays there.
    (let ((opoint (point))
	  placeholder)
      (save-excursion
	(beginning-of-line)
	(cond
	 ;; CASE 1: A comment following a solitary close-brace should
	 ;; have only one space.
	 ((looking-at (concat "[ \t]*}[ \t]*\\($\\|"
			      c-comment-start-regexp
			      "\\)"))
	  (search-forward "}")
	  (1+ (current-column)))
	 ;; CASE 2: 2 spaces after #endif
	 ((or (looking-at "^#[ \t]*endif[ \t]*")
	      (looking-at "^#[ \t]*else[ \t]*"))
	  7)
	 ;; CASE 3: when comment-column is nil, calculate the offset
	 ;; according to c-offsets-alist.  E.g. identical to hitting
	 ;; TAB.
	 ((and c-indent-comments-syntactically-p
	       (save-excursion
		 (skip-chars-forward " \t")
		 (or (looking-at comment-start)
		     (eolp))))
	  (let ((syntax (c-guess-basic-syntax)))
	    ;; BOGOSITY ALERT: if we're looking at the eol, its
	    ;; because indent-for-comment hasn't put the comment-start
	    ;; in the buffer yet.  this will screw up the syntactic
	    ;; analysis so we kludge in the necessary info.  Another
	    ;; kludge is that if we're at the bol, then we really want
	    ;; to ignore any anchoring as specified by
	    ;; c-comment-only-line-offset since it doesn't apply here.
	    (if (save-excursion
		  (beginning-of-line)
		  (skip-chars-forward " \t")
		  (eolp))
		(c-add-syntax 'comment-intro))
	    (let ((c-comment-only-line-offset
		   (if (consp c-comment-only-line-offset)
		       c-comment-only-line-offset
		     (cons c-comment-only-line-offset
			   c-comment-only-line-offset))))
	      (apply '+ (mapcar 'c-get-offset syntax)))))
	 ;; CASE 4: use comment-column if previous line is a
	 ;; comment-only line indented to the left of comment-column
	 ((save-excursion
	    (beginning-of-line)
	    (and (not (bobp))
		 (forward-line -1))
	    (skip-chars-forward " \t")
	    (prog1
		(looking-at c-comment-start-regexp)
	      (setq placeholder (point))))
	  (goto-char placeholder)
	  (if (< (current-column) comment-column)
	      comment-column
	    (current-column)))
	 ;; CASE 5: If comment-column is 0, and nothing but space
	 ;; before the comment, align it at 0 rather than 1.
	 ((progn
	    (goto-char opoint)
	    (skip-chars-backward " \t")
	    (and (= comment-column 0) (bolp)))
	  0)
	 ;; CASE 6: indent at comment column except leave at least one
	 ;; space.
	 (t (max (1+ (current-column))
		 comment-column))
	 )))))

;; used by outline-minor-mode
(defun c-outline-level ()
  (save-excursion
    (skip-chars-forward "\t ")
    (current-column)))

;; active regions, and auto-newline/hungry delete key
(defun c-keep-region-active ()
  ;; Do whatever is necessary to keep the region active in
  ;; XEmacs 19. ignore byte-compiler warnings you might see
  (and (boundp 'zmacs-region-stays)
       (setq zmacs-region-stays t)))

(defun c-update-modeline ()
  ;; set the c-auto-hungry-string for the correct designation on the modeline
  (setq c-auto-hungry-string
	(if c-auto-newline
	    (if c-hungry-delete-key "/ah" "/a")
	  (if c-hungry-delete-key "/h" nil)))
  ;; updates the modeline for all Emacsen
  (if (memq 'v19 c-emacs-features)
      (force-mode-line-update)
    (set-buffer-modified-p (buffer-modified-p))))

(defun c-calculate-state (arg prevstate)
  ;; Calculate the new state of PREVSTATE, t or nil, based on arg. If
  ;; arg is nil or zero, toggle the state. If arg is negative, turn
  ;; the state off, and if arg is positive, turn the state on
  (if (or (not arg)
	  (zerop (setq arg (prefix-numeric-value arg))))
      (not prevstate)
    (> arg 0)))

(defun c-toggle-auto-state (arg)
  "Toggle auto-newline feature.
Optional numeric ARG, if supplied turns on auto-newline when positive,
turns it off when negative, and just toggles it when zero.

When the auto-newline feature is enabled (as evidenced by the `/a' or
`/ah' on the modeline after the mode name) newlines are automatically
inserted after special characters such as brace, comma, semi-colon,
and colon."
  (interactive "P")
  (setq c-auto-newline (c-calculate-state arg c-auto-newline))
  (c-update-modeline)
  (c-keep-region-active))

(defun c-toggle-hungry-state (arg)
  "Toggle hungry-delete-key feature.
Optional numeric ARG, if supplied turns on hungry-delete when positive,
turns it off when negative, and just toggles it when zero.

When the hungry-delete-key feature is enabled (as evidenced by the
`/h' or `/ah' on the modeline after the mode name) the delete key
gobbles all preceding whitespace in one fell swoop."
  (interactive "P")
  (setq c-hungry-delete-key (c-calculate-state arg c-hungry-delete-key))
  (c-update-modeline)
  (c-keep-region-active))

(defun c-toggle-auto-hungry-state (arg)
  "Toggle auto-newline and hungry-delete-key features.
Optional numeric ARG, if supplied turns on auto-newline and
hungry-delete when positive, turns them off when negative, and just
toggles them when zero.

See `c-toggle-auto-state' and `c-toggle-hungry-state' for details."
  (interactive "P")
  (setq c-auto-newline (c-calculate-state arg c-auto-newline))
  (setq c-hungry-delete-key (c-calculate-state arg c-hungry-delete-key))
  (c-update-modeline)
  (c-keep-region-active))


;; COMMANDS
(defun c-electric-delete (arg)
  "Deletes preceding character or whitespace.
If `c-hungry-delete-key' is non-nil, as evidenced by the \"/h\" or
\"/ah\" string on the mode line, then all preceding whitespace is
consumed.  If however an ARG is supplied, or `c-hungry-delete-key' is
nil, or point is inside a literal then the function in the variable
`c-delete-function' is called."
  (interactive "P")
  (if (or (not c-hungry-delete-key)
	  arg
	  (c-in-literal))
      (funcall c-delete-function (prefix-numeric-value arg))
    (let ((here (point)))
      (skip-chars-backward " \t\n")
      (if (/= (point) here)
	  (delete-region (point) here)
	(funcall c-delete-function 1)
	))))

(defun c-electric-pound (arg)
  "Electric pound (`#') insertion.
Inserts a `#' character specially depending on the variable
`c-electric-pound-behavior'.  If a numeric ARG is supplied, or if
point is inside a literal, nothing special happens."
  (interactive "P")
  (if (or (c-in-literal)
	  arg
	  (not (memq 'alignleft c-electric-pound-behavior)))
      ;; do nothing special
      (self-insert-command (prefix-numeric-value arg))
    ;; place the pound character at the left edge
    (let ((pos (- (point-max) (point)))
	  (bolp (bolp)))
      (beginning-of-line)
      (delete-horizontal-space)
      (insert-char last-command-char 1)
      (and (not bolp)
	   (goto-char (- (point-max) pos)))
      )))

(defun c-electric-brace (arg)
  "Insert a brace.

If the auto-newline feature is turned on, as evidenced by the \"/a\"
or \"/ah\" string on the mode line, newlines are inserted before and
after braces based on the value of `c-hanging-braces-alist'.

Also, the line is re-indented unless a numeric ARG is supplied, there
are non-whitespace characters present on the line after the brace, or
the brace is inserted inside a literal."
  (interactive "P")
  (let* ((c-state-cache (c-parse-state))
	 (safepos (c-safe-position (point) c-state-cache))
	 (literal (c-in-literal safepos)))
    ;; if we're in a literal, or we're not at the end of the line, or
    ;; a numeric arg is provided, or auto-newlining is turned off,
    ;; then just insert the character.
    (if (or literal arg
;	    (not c-auto-newline)
	    (not (looking-at "[ \t]*$")))
	(c-insert-special-chars arg)	
      (let* ((syms '(class-open class-close defun-open defun-close 
		     inline-open inline-close brace-list-open brace-list-close
		     brace-list-intro brace-list-entry block-open block-close
		     substatement-open statement-case-open))
	    ;; we want to inhibit blinking the paren since this will
	    ;; be most disruptive. we'll blink it ourselves later on
	    (old-blink-paren (if (boundp 'blink-paren-function)
				 blink-paren-function
			       blink-paren-hook))
	    blink-paren-function	; emacs19
	    blink-paren-hook		; emacs18
	    (insertion-point (point))
	    delete-temp-newline
	    (preserve-p (= 32 (char-syntax (preceding-char))))
	    ;; shut this up too
	    (c-echo-syntactic-information-p nil)
	    (syntax (progn
		      ;; only insert a newline if there is
		      ;; non-whitespace behind us
		      (if (save-excursion
			    (skip-chars-backward " \t")
			    (not (bolp)))
			  (progn (newline)
				 (setq delete-temp-newline t)))
		      (self-insert-command (prefix-numeric-value arg))
		      ;; state cache doesn't change
		      (c-guess-basic-syntax)))
	    (newlines (and
		       c-auto-newline
		       (or (c-lookup-lists syms syntax c-hanging-braces-alist)
			   '(ignore before after)))))
	;; If syntax is a function symbol, then call it using the
	;; defined semantics.
	(if (and (not (consp (cdr newlines)))
		 (fboundp (cdr newlines)))
	    (let ((c-syntactic-context syntax))
	      (setq newlines
		    (funcall (cdr newlines) (car newlines) insertion-point))))
	;; does a newline go before the open brace?
	(if (memq 'before newlines)
	    ;; we leave the newline we've put in there before,
	    ;; but we need to re-indent the line above
	    (let ((pos (- (point-max) (point)))
		  (here (point))
		  (c-state-cache c-state-cache))
	      (forward-line -1)
	      ;; we may need to update the cache. this should still be
	      ;; faster than recalculating the state in many cases
	      (save-excursion
		(save-restriction
		  (narrow-to-region here (point))
		  (if (and (c-safe (progn (backward-up-list -1) t))
			   (memq (preceding-char) '(?\) ?}))
			   (progn (widen)
				  (c-safe (progn (forward-sexp -1) t))))
		      (setq c-state-cache
			    (c-hack-state (point) 'open c-state-cache))
		    (if (and (car c-state-cache)
			     (not (consp (car c-state-cache)))
			     (<= (point) (car c-state-cache)))
			(setq c-state-cache (cdr c-state-cache))
		      ))))
	      (let ((here (point))
		    (shift (c-indent-line)))
		(setq c-state-cache (c-adjust-state (c-point 'bol) here
						    (- shift) c-state-cache)))
	      (goto-char (- (point-max) pos))
	      ;; if the buffer has changed due to the indentation, we
	      ;; need to recalculate syntax for the current line, but
	      ;; we won't need to update the state cache.
	      (if (/= (point) here)
		  (setq syntax (c-guess-basic-syntax))))
	  ;; must remove the newline we just stuck in (if we really did it)
	  (and delete-temp-newline
	       (save-excursion
		 ;; if there is whitespace before point, then preserve
		 ;; at least one space.
		 (delete-indentation)
		 (just-one-space)
		 (if (not preserve-p)
		     (delete-char -1))))
	  ;; since we're hanging the brace, we need to recalculate
	  ;; syntax.  Update the state to accurately reflect the
	  ;; beginning of the line.  We punt if we cross any open or
	  ;; closed parens because its just too hard to modify the
	  ;; known state.  This limitation will be fixed in v5.
	  (save-excursion
	    (let ((bol (c-point 'bol)))
	      (if (zerop (car (parse-partial-sexp bol (1- (point)))))
		  (setq c-state-cache (c-whack-state bol c-state-cache)
			syntax (c-guess-basic-syntax))
		;; gotta punt. this requires some horrible kludgery
		(beginning-of-line)
		(makunbound 'c-state-cache)
		(setq c-state-cache (c-parse-state)
		      syntax nil))))
	  )
	;; now adjust the line's indentation. don't update the state
	;; cache since c-guess-basic-syntax isn't called when the
	;; syntax is passed to c-indent-line
	(let ((here (point))
	      (shift (c-indent-line syntax)))
	  (setq c-state-cache (c-adjust-state (c-point 'bol) here
					      (- shift) c-state-cache)))
	;; Do all appropriate clean ups
	(let ((here (point))
	      (pos (- (point-max) (point)))
	      mbeg mend)
	  ;; clean up empty defun braces
	  (if (and c-auto-newline
		   (memq 'empty-defun-braces c-cleanup-list)
		   (= last-command-char ?\})
		   (c-intersect-lists '(defun-close class-close inline-close)
				      syntax)
		   (progn
		     (forward-char -1)
		     (skip-chars-backward " \t\n")
		     (= (preceding-char) ?\{))
		   ;; make sure matching open brace isn't in a comment
		   (not (c-in-literal)))
	      (delete-region (point) (1- here)))
	  ;; clean up brace-else-brace
	  (if (and c-auto-newline
		   (memq 'brace-else-brace c-cleanup-list)
		   (= last-command-char ?\{)
		   (re-search-backward "}[ \t\n]*else[ \t\n]*{" nil t)
		   (progn
		     (setq mbeg (match-beginning 0)
			   mend (match-end 0))
		     (= mend here))
		   (not (c-in-literal)))
	      (progn
		(delete-region mbeg mend)
		(insert "} else {")))
	  (goto-char (- (point-max) pos))
	  )
	;; does a newline go after the brace?
	(if (memq 'after newlines)
	    (progn
	      (newline)
	      ;; update on c-state-cache
	      (let* ((bufpos (- (point) 2))
		     (which (if (= (char-after bufpos) ?{) 'open 'close))
		     (c-state-cache (c-hack-state bufpos which c-state-cache)))
		(c-indent-line))))
	;; blink the paren
	(and (= last-command-char ?\})
	     old-blink-paren
	     (save-excursion
	       (c-backward-syntactic-ws safepos)
	       (if (boundp 'blink-paren-function)
		   (funcall old-blink-paren)
		 (run-hooks old-blink-paren))))
	))))
      
(defun c-electric-slash (arg)
  "Insert a slash character.
If slash is second of a double-slash C++ style comment introducing
construct, and we are on a comment-only-line, indent line as comment.
If numeric ARG is supplied or point is inside a literal, indentation
is inhibited."
  (interactive "P")
  (let ((indentp (and (not arg)
		      (= (preceding-char) ?/)
		      (= last-command-char ?/)
		      (not (c-in-literal))))
	;; shut this up
	(c-echo-syntactic-information-p nil))
    (self-insert-command (prefix-numeric-value arg))
    (if indentp
	(c-indent-line))))

(defun c-electric-star (arg)
  "Insert a star character.
If the star is the second character of a C style comment introducing
construct, and we are on a comment-only-line, indent line as comment.
If numeric ARG is supplied or point is inside a literal, indentation
is inhibited."
  (interactive "P")
  (self-insert-command (prefix-numeric-value arg))
  ;; if we are in a literal, or if arg is given do not re-indent the
  ;; current line, unless this star introduces a comment-only line.
  (if (and (not arg)
	   (memq (c-in-literal) '(c))
	   (= (preceding-char) ?*)
	   (save-excursion
	     (forward-char -1)
	     (skip-chars-backward "*")
	     (if (= (preceding-char) ?/)
		 (forward-char -1))
	     (skip-chars-backward " \t")
	     (bolp)))
      ;; shut this up
      (let (c-echo-syntactic-information-p)
	(c-indent-line))
    ))

(defun c-electric-semi&comma (arg)
  "Insert a comma or semicolon.
When the auto-newline feature is turned on, as evidenced by the \"/a\"
or \"/ah\" string on the mode line, a newline might be inserted.  See
the variable `c-hanging-semi&comma-criteria' for how newline insertion
is determined.

When semicolon is inserted, the line is re-indented unless a numeric
arg is supplied, point is inside a literal, or there are
non-whitespace characters on the line following the semicolon."
  (interactive "P")
  (let* ((lim (c-most-enclosing-brace (c-parse-state)))
	 (literal (c-in-literal lim))
	 (here (point))
	 ;; shut this up
	 (c-echo-syntactic-information-p nil))
    (if (or literal
	    arg
	    (not (looking-at "[ \t]*$")))
	(c-insert-special-chars arg)
      ;; do some special stuff with the character
      (self-insert-command (prefix-numeric-value arg))
      ;; do all cleanups, reindentations, and newline insertions, but
      ;; only if c-auto-newline is turned on
      (if (not c-auto-newline) nil
	;; clean ups
	(let ((pos (- (point-max) (point))))
	  (if (and (or (and
			(= last-command-char ?,)
			(memq 'list-close-comma c-cleanup-list))
		       (and
			(= last-command-char ?\;)
			(memq 'defun-close-semi c-cleanup-list)))
		   (progn
		     (forward-char -1)
		     (skip-chars-backward " \t\n")
		     (= (preceding-char) ?}))
		   ;; make sure matching open brace isn't in a comment
		   (not (c-in-literal lim)))
	      (delete-region (point) here))
	  (goto-char (- (point-max) pos)))
	;; re-indent line
	(c-indent-line)
	;; check to see if a newline should be added
	(let ((criteria c-hanging-semi&comma-criteria)
	      answer add-newline-p)
	  (while criteria
	    (setq answer (funcall (car criteria)))
	    ;; only nil value means continue checking
	    (if (not answer)
		(setq criteria (cdr criteria))
	      (setq criteria nil)
	      ;; only 'stop specifically says do not add a newline
	      (setq add-newline-p (not (eq answer 'stop)))
	      ))
	  (if add-newline-p
	      (progn (newline)
		     (c-indent-line)))
	  )))))

(defun c-semi&comma-inside-parenlist ()
  "Determine if a newline should be added after a semicolon.
If a comma was inserted, no determination is made.  If a semicolon was
inserted inside a parenthesis list, no newline is added otherwise a
newline is added.  In either case, checking is stopped.  This supports
exactly the old newline insertion behavior."
  ;; newline only after semicolon, but only if that semicolon is not
  ;; inside a parenthesis list (e.g. a for loop statement)
  (if (/= last-command-char ?\;)
      nil				; continue checking
    (if (condition-case nil
	    (save-excursion
	      (up-list -1)
	      (/= (following-char) ?\())
	  (error t))
	t
      'stop)))

(defun c-electric-colon (arg)
  "Insert a colon.

If the auto-newline feature is turned on, as evidenced by the \"/a\"
or \"/ah\" string on the mode line, newlines are inserted before and
after colons based on the value of `c-hanging-colons-alist'.

Also, the line is re-indented unless a numeric ARG is supplied, there
are non-whitespace characters present on the line after the colon, or
the colon is inserted inside a literal.

This function cleans up double colon scope operators based on the
value of `c-cleanup-list'."
  (interactive "P")
  (let* ((bod (c-point 'bod))
	 (literal (c-in-literal bod))
	 syntax newlines
	 ;; shut this up
	 (c-echo-syntactic-information-p nil))
    (if (or literal
	    arg
	    (not (looking-at "[ \t]*$")))
	(c-insert-special-chars arg)
      ;; insert the colon, then do any specified cleanups
      (self-insert-command (prefix-numeric-value arg))
      (let ((pos (- (point-max) (point)))
	    (here (point)))
	(if (and c-auto-newline
		 (memq 'scope-operator c-cleanup-list)
		 (= (preceding-char) ?:)
		 (progn
		   (forward-char -1)
		   (skip-chars-backward " \t\n")
		   (= (preceding-char) ?:))
		 (not (c-in-literal))
		 (not (= (char-after (- (point) 2)) ?:)))
	    (delete-region (point) (1- here)))
	(goto-char (- (point-max) pos)))
      ;; lets do some special stuff with the colon character
      (setq syntax (c-guess-basic-syntax)
	    ;; some language elements can only be determined by
	    ;; checking the following line.  Lets first look for ones
	    ;; that can be found when looking on the line with the
	    ;; colon
	    newlines
	    (and c-auto-newline
		 (or (c-lookup-lists '(case-label label access-label)
				     syntax c-hanging-colons-alist)
		     (c-lookup-lists '(member-init-intro inher-intro)
				     (prog2
					 (insert "\n")
					 (c-guess-basic-syntax)
				       (delete-char -1))
				     c-hanging-colons-alist))))
      ;; indent the current line
      (c-indent-line syntax)
      ;; does a newline go before the colon?  Watch out for already
      ;; non-hung colons.  However, we don't unhang them because that
      ;; would be a cleanup (and anti-social).
      (if (and (memq 'before newlines)
	       (save-excursion
		 (skip-chars-backward ": \t")
		 (not (bolp))))
	  (let ((pos (- (point-max) (point))))
	    (forward-char -1)
	    (newline)
	    (c-indent-line)
	    (goto-char (- (point-max) pos))))
      ;; does a newline go after the colon?
      (if (memq 'after (cdr-safe newlines))
	  (progn
	    (newline)
	    (c-indent-line)))
      )))

(defun c-electric-lt-gt (arg)
  "Insert a less-than, or greater-than character.
When the auto-newline feature is turned on, as evidenced by the \"/a\"
or \"/ah\" string on the mode line, the line will be re-indented if
the character inserted is the second of a C++ style stream operator
and the buffer is in C++ mode.

The line will also not be re-indented if a numeric argument is
supplied, or point is inside a literal."
  (interactive "P")
  (let ((indentp (and (not arg)
		      (= (preceding-char) last-command-char)
		      (not (c-in-literal))))
	;; shut this up
	(c-echo-syntactic-information-p nil))
    (self-insert-command (prefix-numeric-value arg))
    (if indentp
	(c-indent-line))))

;; set up electric character functions to work with pending-del,
;; (a.k.a. delsel) mode.  All symbols get the t value except
;; c-electric-delete which gets 'supersede.
(mapcar
 (function
  (lambda (sym)
    (put sym 'delete-selection t)	; for delsel (Emacs)
    (put sym 'pending-delete t)))	; for pending-del (XEmacs)
 '(c-electric-pound
   c-electric-brace
   c-electric-slash
   c-electric-star
   c-electric-semi&comma
   c-electric-lt-gt
   c-electric-colon))
(put 'c-electric-delete 'delete-selection 'supersede) ; delsel
(put 'c-electric-delete 'pending-delete   'supersede) ; pending-del



(defun c-read-offset (langelem)
  ;; read new offset value for LANGELEM from minibuffer. return a
  ;; legal value only
  (let* ((oldoff (cdr-safe (assq langelem c-offsets-alist)))
	 (defstr (format "(default %s): " oldoff))
	 (errmsg (concat "Offset must be int, func, var, "
			 "or in [+,-,++,--,*,/] "
			 defstr))
	 (prompt (concat "Offset " defstr))
	 offset input interned)
    (while (not offset)
      (setq input (read-string prompt)
	    offset (cond ((string-equal "" input) oldoff)  ; default
			 ((string-equal "+" input) '+)
			 ((string-equal "-" input) '-)
			 ((string-equal "++" input) '++)
			 ((string-equal "--" input) '--)
			 ((string-equal "*" input) '*)
			 ((string-equal "/" input) '/)
			 ((string-match "^-?[0-9]+$" input)
			  (string-to-int input))
			 ((fboundp (setq interned (intern input)))
			  interned)
			 ((boundp interned) interned)
			 ;; error, but don't signal one, keep trying
			 ;; to read an input value
			 (t (ding)
			    (setq prompt errmsg)
			    nil))))
    offset))

(defun c-set-offset (symbol offset &optional add-p)
  "Change the value of a syntactic element symbol in `c-offsets-alist'.
SYMBOL is the syntactic element symbol to change and OFFSET is the new
offset for that syntactic element.  Optional ADD says to add SYMBOL to
`c-offsets-alist' if it doesn't already appear there."
  (interactive
   (let* ((langelem
	   (intern (completing-read
		    (concat "Syntactic symbol to change"
			    (if current-prefix-arg " or add" "")
			    ": ")
		    (mapcar
		     (function
		      (lambda (langelem)
			(cons (format "%s" (car langelem)) nil)))
		     c-offsets-alist)
		    nil (not current-prefix-arg)
		    ;; initial contents tries to be the last element
		    ;; on the syntactic analysis list for the current
		    ;; line
		    (let* ((syntax (c-guess-basic-syntax))
			   (len (length syntax))
			   (ic (format "%s" (car (nth (1- len) syntax)))))
		      (if (memq 'v19 c-emacs-features)
			  (cons ic 0)
			ic))
		    )))
	  (offset (c-read-offset langelem)))
     (list langelem offset current-prefix-arg)))
  ;; sanity check offset
  (or (eq offset '+)
      (eq offset '-)
      (eq offset '++)
      (eq offset '--)
      (eq offset '*)
      (eq offset '/)
      (integerp offset)
      (fboundp offset)
      (boundp offset)
      (error "Offset must be int, func, var, or in [+,-,++,--,*,/]: %s"
	     offset))
  (let ((entry (assq symbol c-offsets-alist)))
    (if entry
	(setcdr entry offset)
      (if add-p
	  (setq c-offsets-alist (cons (cons symbol offset) c-offsets-alist))
	(error "%s is not a valid syntactic symbol." symbol))))
  (c-keep-region-active))

(defun c-set-style-1 (stylevars)
  ;; given a style's variable alist, institute the style
  (mapcar
   (function
    (lambda (conscell)
      (let ((attr (car conscell))
	    (val  (cdr conscell)))
	;; KLUDGE ALERT: special case for c-offsets-alist
	(if (not (eq attr 'c-offsets-alist))
	    (set attr val)
	  (mapcar
	   (function
	    (lambda (langentry)
	      (let ((langelem (car langentry))
		    (offset (cdr langentry)))
		(c-set-offset langelem offset)
		)))
	   val))
	)))
   stylevars))

;;;###autoload
(defun c-set-style (stylename)
  "Set cc-mode variables to use one of several different indentation styles.
STYLENAME is a string representing the desired style from the list of
styles described in the variable `c-style-alist'.  See that variable
for details of setting up styles."
  (interactive (list (let ((completion-ignore-case t)
			   (prompt (format "Which %s indentation style? "
					   mode-name)))
		       (completing-read prompt c-style-alist nil t))))
  (let ((vars (cdr (or (assoc (downcase stylename) c-style-alist)
		       ;; backwards compatibility
		       (assoc (upcase stylename) c-style-alist)
		       )))
	(default (cdr (assoc "cc-mode" c-style-alist))))
    (or vars (error "Invalid indentation style `%s'" stylename))
    (or default (error "No `cc-mode' style found!"))
    ;; first reset the style to `cc-mode' to give every style a common
    ;; base. Then institute the new style.
    (c-set-style-1 default)
    (if (not (string= stylename "cc-mode"))
	(c-set-style-1 vars)))
  (c-keep-region-active))

(defun c-add-style (style descrip &optional set-p)
  "Adds a style to `c-style-alist', or updates an existing one.
STYLE is a string identifying the style to add or update.  DESCRIP is
an association list describing the style and must be of the form:

  ((VARIABLE . VALUE) [(VARIABLE . VALUE) ...])

See the variable `c-style-alist' for the semantics of VARIABLE and
VALUE.  This function also sets the current style to STYLE using
`c-set-style' if the optional SET-P flag is non-nil."
  (interactive
   (let ((stylename (completing-read "Style to add: " c-style-alist))
	 (description (eval-minibuffer "Style description: ")))
     (list stylename description
	   (y-or-n-p "Set the style too? "))))
  (setq style (downcase style))
  (let ((s (assoc style c-style-alist)))
    (if s
	(setcdr s (copy-alist descrip))	; replace
      (setq c-style-alist (cons (cons style descrip) c-style-alist))))
  (and set-p (c-set-style style)))

(defun c-fill-paragraph (&optional arg)
  "Like \\[fill-paragraph] but handles C and C++ style comments.
If any of the current line is a comment or within a comment,
fill the comment or the paragraph of it that point is in,
preserving the comment indentation or line-starting decorations.

Optional prefix ARG means justify paragraph as well."
  (interactive "P")
  (let* (comment-start-place
	 (first-line
	  ;; Check for obvious entry to comment.
	  (save-excursion
	    (beginning-of-line)
	    (skip-chars-forward " \t\n")
	    (and (looking-at comment-start-skip)
		 (setq comment-start-place (point)))))
	 (re1 (if (memq 'new-re c-emacs-features)
		  "\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$"
		"\\|^[ \t]*/\\*[ \t]*$\\|^[ \t]*\\*/[ \t]*$\\|^[ \t/*]*$"))
	 )
    (if (and c-double-slash-is-comments-p
	     (save-excursion
	       (beginning-of-line)
	       (looking-at ".*//")))
	(let (fill-prefix
	       ;; Lines containing just a comment start or just an end
	       ;; should not be filled into paragraphs they are next
	       ;; to.
	      (paragraph-start (concat paragraph-start re1))
	      (paragraph-separate (concat paragraph-separate re1)))
	  (save-excursion
	    (beginning-of-line)
	    ;; Move up to first line of this comment.
	    (while (and (not (bobp))
			(looking-at "[ \t]*//"))
	      (forward-line -1))
	    (if (not (looking-at ".*//"))
		(forward-line 1))
	    ;; Find the comment start in this line.
	    (re-search-forward "[ \t]*//[ \t]*")
	    ;; Set the fill-prefix to be what all lines except the first
	    ;; should start with.
	    (setq fill-prefix (buffer-substring (match-beginning 0)
						(match-end 0)))
	    (save-restriction
	      ;; Narrow down to just the lines of this comment.
	      (narrow-to-region (c-point 'bol)
				(save-excursion
				  (forward-line 1)
				  (while (looking-at fill-prefix)
				    (forward-line 1))
				  (point)))
	      (fill-paragraph arg)
	      t)))
      ;; else C style comments
      (if (or first-line
	      ;; t if we enter a comment between start of function and
	      ;; this line.
	      (eq (c-in-literal) 'c)
	      ;; t if this line contains a comment starter.
	      (setq first-line
		    (save-excursion
		      (beginning-of-line)
		      (prog1
			  (re-search-forward comment-start-skip
					     (save-excursion (end-of-line)
							     (point))
					     t)
			(setq comment-start-place (point))))))
	  ;; Inside a comment: fill one comment paragraph.
	  (let ((fill-prefix
		 ;; The prefix for each line of this paragraph
		 ;; is the appropriate part of the start of this line,
		 ;; up to the column at which text should be indented.
		 (save-excursion
		   (beginning-of-line)
		   (if (looking-at "[ \t]*/\\*.*\\*/")
		       (progn (re-search-forward comment-start-skip)
			      (make-string (current-column) ?\ ))
		     (if first-line (forward-line 1))

		     (let ((line-width (progn (end-of-line) (current-column))))
		       (beginning-of-line)
		       (prog1
			   (buffer-substring
			    (point)

			    ;; How shall we decide where the end of the
			    ;; fill-prefix is?
			    (progn
			      (beginning-of-line)
			      (skip-chars-forward " \t*" (c-point 'eol))
			      (point)))

			 ;; If the comment is only one line followed
			 ;; by a blank line, calling move-to-column
			 ;; above may have added some spaces and tabs
			 ;; to the end of the line; the fill-paragraph
			 ;; function will then delete it and the
			 ;; newline following it, so we'll lose a
			 ;; blank line when we shouldn't.  So delete
			 ;; anything move-to-column added to the end
			 ;; of the line.  We record the line width
			 ;; instead of the position of the old line
			 ;; end because move-to-column might break a
			 ;; tab into spaces, and the new characters
			 ;; introduced there shouldn't be deleted.

			 ;; If you can see a better way to do this,
			 ;; please make the change.  This seems very
			 ;; messy to me.
			 (delete-region (progn (move-to-column line-width)
					       (point))
					(progn (end-of-line) (point))))))))

		;; Lines containing just a comment start or just an end
		;; should not be filled into paragraphs they are next
		;; to.
		(paragraph-start (concat paragraph-start re1))
		(paragraph-separate (concat paragraph-separate re1))
		(chars-to-delete 0))
	    (save-restriction
	      ;; Don't fill the comment together with the code
	      ;; following it.  So temporarily exclude everything
	      ;; before the comment start, and everything after the
	      ;; line where the comment ends.  If comment-start-place
	      ;; is non-nil, the comment starter is there.  Otherwise,
	      ;; point is inside the comment.
	      (narrow-to-region (save-excursion
				  (if comment-start-place
				      (goto-char comment-start-place)
				    (search-backward "/*"))
				  ;; Protect text before the comment
				  ;; start by excluding it.  Add
				  ;; spaces to bring back proper
				  ;; indentation of that point.
				  (let ((column (current-column)))
				    (prog1 (point)
				      (setq chars-to-delete column)
				      (insert-char ?\  column))))
				(save-excursion
				  (if comment-start-place
				      (goto-char (+ comment-start-place 2)))
				  (search-forward "*/" nil 'move)
				  (forward-line 1)
				  (point)))
	      (fill-paragraph arg)
	      (save-excursion
		;; Delete the chars we inserted to avoid clobbering
		;; the stuff before the comment start.
		(goto-char (point-min))
		(if (> chars-to-delete 0)
		    (delete-region (point) (+ (point) chars-to-delete)))
		;; Find the comment ender (should be on last line of
		;; buffer, given the narrowing) and don't leave it on
		;; its own line, unless that's the style that's desired.
		(goto-char (point-max))
		(forward-line -1)
		(search-forward "*/" nil 'move)
		(beginning-of-line)
		(if (and c-hanging-comment-ender-p
			 (looking-at "[ \t]*\\*/"))
		    ;(delete-indentation)))))
		    (let ((fill-column (+ fill-column 9999)))
		      (forward-line -1)
		      (fill-region-as-paragraph (point) (point-max))))))
	    t)))))

;; better movement routines for ThisStyleOfVariablesCommonInCPlusPlus
;; originally contributed by Terry_Glanfield.Southern@rxuk.xerox.com
(defun c-forward-into-nomenclature (&optional arg)
  "Move forward to end of a nomenclature section or word.
With arg, to it arg times."
  (interactive "p")
  (let ((case-fold-search nil))
    (if (> arg 0)
	(re-search-forward "\\W*\\([A-Z]*[a-z0-9]*\\)" (point-max) t arg)
      (while (and (< arg 0)
		  (re-search-backward
		   "\\(\\(\\W\\|[a-z0-9]\\)[A-Z]+\\|\\W\\w+\\)"
		   (point-min) 0))
	(forward-char 1)
	(setq arg (1+ arg)))))
  (c-keep-region-active))

(defun c-backward-into-nomenclature (&optional arg)
  "Move backward to beginning of a nomenclature section or word.
With optional ARG, move that many times.  If ARG is negative, move
forward."
  (interactive "p")
  (c-forward-into-nomenclature (- arg))
  (c-keep-region-active))

(defun c-scope-operator ()
  "Insert a double colon scope operator at point.
No indentation or other \"electric\" behavior is performed."
  (interactive)
  (insert "::"))


(defun c-beginning-of-statement (&optional count lim sentence-flag)
  "Go to the beginning of the innermost C statement.
With prefix arg, go back N - 1 statements.  If already at the
beginning of a statement then go to the beginning of the preceding
one.  If within a string or comment, or next to a comment (only
whitespace between), move by sentences instead of statements.

When called from a program, this function takes 3 optional args: the
repetition count, a buffer position limit which is the farthest back
to search, and a flag saying whether to do sentence motion when in a
comment."
  (interactive (list (prefix-numeric-value current-prefix-arg)
		     nil t))
  (let ((here (point))
	(count (or count 1))
	(lim (or lim (c-point 'bod)))
	state)
    (save-excursion
      (goto-char lim)
      (setq state (parse-partial-sexp (point) here nil nil)))
    (if (and sentence-flag
	     (or (nth 3 state)
		 (nth 4 state)
		 (looking-at (concat "[ \t]*" comment-start-skip))
		 (save-excursion
		   (skip-chars-backward " \t")
		   (goto-char (- (point) 2))
		   (looking-at "\\*/"))))
	(forward-sentence (- count))
      (while (> count 0)
	(c-beginning-of-statement-1 lim)
	(setq count (1- count)))
      (while (< count 0)
	(c-end-of-statement-1)
	(setq count (1+ count))))
    ;; its possible we've been left up-buf of lim
    (goto-char (max (point) lim))
    )
  (c-keep-region-active))

(defun c-end-of-statement (&optional count lim sentence-flag)
  "Go to the end of the innermost C statement.

With prefix arg, go forward N - 1 statements.  Move forward to end of
the next statement if already at end.  If within a string or comment,
move by sentences instead of statements.

When called from a program, this function takes 3 optional args: the
repetition count, a buffer position limit which is the farthest back
to search, and a flag saying whether to do sentence motion when in a
comment."
  (interactive (list (prefix-numeric-value current-prefix-arg)
		     nil t))
  (c-beginning-of-statement (- (or count 1)) lim sentence-flag)
  (c-keep-region-active))

(defun c-beginning-of-statement-1 (&optional lim)
  ;; move to the start of the current statement, or the previous
  ;; statement if already at the beginning of one.
  (let ((firstp t)
	(substmt-p t)
	donep c-in-literal-cache
	;; KLUDGE ALERT: maybe-labelp is used to pass information
	;; between c-crosses-statement-barrier-p and
	;; c-beginning-of-statement-1.  A better way should be
	;; implemented.
	maybe-labelp
	(last-begin (point)))
    (while (not donep)
      ;; stop at beginning of buffer
      (if (bobp) (setq donep t)
	;; go backwards one balanced expression, but be careful of
	;; unbalanced paren being reached
	(if (not (c-safe (progn (backward-sexp 1) t)))
	    (progn
	      (if firstp
		  (backward-up-list 1)
		(goto-char last-begin))
	      ;; skip over any unary operators, or other special
	      ;; characters appearing at front of identifier
	      (save-excursion
		(c-backward-syntactic-ws lim)
		(skip-chars-backward "-+!*&:.~ \t\n")
		(if (= (preceding-char) ?\()
		    (setq last-begin (point))))
	      (goto-char last-begin)
	      (setq last-begin (point)
		    donep t)))

	(setq maybe-labelp nil)
	;; see if we're in a literal. if not, then this bufpos may be
	;; a candidate for stopping
	(cond
	 ;; CASE 0: did we hit the error condition above?
	 (donep)
	 ;; CASE 1: are we in a literal?
	 ((eq (c-in-literal lim) 'pound)
	  (beginning-of-line))
	 ;; CASE 2: some other kind of literal?
	 ((c-in-literal lim))
	 ;; CASE 3: are we looking at a conditional keyword?
	 ((or (looking-at c-conditional-key)
	      (and (= (following-char) ?\()
		   (save-excursion
		     (forward-sexp 1)
		     (c-forward-syntactic-ws)
		     (/= (following-char) ?\;))
		   (let ((here (point))
			 (foundp (progn
				   (c-backward-syntactic-ws lim)
				   (forward-word -1)
				   (and lim
					(<= lim (point))
					(not (c-in-literal lim))
					(looking-at c-conditional-key)
					))))
		     ;; did we find a conditional?
		     (if (not foundp)
			 (goto-char here))
		     foundp)))
	  ;; are we in the middle of an else-if clause?
	  (if (save-excursion
		(and (not substmt-p)
		     (c-safe (progn (forward-sexp -1) t))
		     (looking-at "\\<else\\>[ \t\n]+\\<if\\>")
		     (not (c-in-literal lim))))
	      (progn
		(forward-sexp -1)
		(c-backward-to-start-of-if lim)))
	  ;; are we sitting at an else clause, that we are not a
	  ;; substatement of?
	  (if (and (not substmt-p)
		   (looking-at "\\<else\\>[^_]"))
	      (c-backward-to-start-of-if lim))
	  ;; are we sitting at the while of a do-while?
	  (if (and (looking-at "\\<while\\>[^_]")
		   (c-backward-to-start-of-do lim))
	      (setq substmt-p nil))
	  (setq last-begin (point)
		donep substmt-p))
	 ;; CASE 4: are we looking at a label?
	 ((looking-at c-label-key))
	 ;; CASE 5: is this the first time we're checking?
	 (firstp (setq firstp nil
		       substmt-p (not (c-crosses-statement-barrier-p
				       (point) last-begin))
		       last-begin (point)))
	 ;; CASE 6: have we crossed a statement barrier?
	 ((c-crosses-statement-barrier-p (point) last-begin)
	  (setq donep t))
	 ;; CASE 7: ignore labels
	 ((and maybe-labelp
	       (or (and c-access-key (looking-at c-access-key))
		   ;; with switch labels, we have to go back further
		   ;; to try to pick up the case or default
		   ;; keyword. Potential bogosity alert: we assume
		   ;; `case' or `default' is first thing on line
		   (let ((here (point)))
		     (beginning-of-line)
		     (c-forward-syntactic-ws)
		     (if (looking-at c-switch-label-key)
			 t
		       (goto-char here)
		       nil))
		   (looking-at c-label-key))))
	 ;; CASE 8: ObjC or Java method def
	 ((and c-method-key
	       (setq last-begin (c-in-method-def-p)))
	  (setq donep t))
	 ;; CASE 9: nothing special
	 (t (setq last-begin (point)))
	 )))
    (goto-char last-begin)
    ;; we always do want to skip over non-whitespace modifier
    ;; characters that didn't get skipped above
    (skip-chars-backward "-+!*&:.~" (c-point 'boi))))

(defun c-end-of-statement-1 ()
  (condition-case ()
      (progn
	(while (and (not (eobp))
		    (let ((beg (point)))
		      (forward-sexp 1)
		      (let ((end (point)))
			(save-excursion
			  (goto-char beg)
			  (not (re-search-forward "[;{}]" end t)))))))
	(re-search-backward "[;}]")
	(forward-char 1))
    (error 
     (let ((beg (point)))
       (backward-up-list -1)
       (let ((end (point)))
	 (goto-char beg)
	 (search-forward ";" end 'move))))))

(defun c-crosses-statement-barrier-p (from to)
  ;; Does buffer positions FROM to TO cross a C statement boundary?
  (let ((here (point))
	(lim from)
	crossedp)
    (condition-case ()
	(progn
	  (goto-char from)
	  (while (and (not crossedp)
		      (< (point) to))
	    (skip-chars-forward "^;{}:" to)
	    (if (not (c-in-literal lim))
		(progn
		  (if (memq (following-char) '(?\; ?{ ?}))
		      (setq crossedp t)
		    (if (= (following-char) ?:)
			(setq maybe-labelp t))
		    (forward-char 1))
		  (setq lim (point)))
	      (forward-char 1))))
      (error (setq crossedp nil)))
    (goto-char here)
    crossedp))


(defun c-up-conditional (count)
  "Move back to the containing preprocessor conditional, leaving mark behind.
A prefix argument acts as a repeat count.  With a negative argument,
move forward to the end of the containing preprocessor conditional.
When going backwards, `#elif' is treated like `#else' followed by
`#if'.  When going forwards, `#elif' is ignored."
  (interactive "p")
  (c-forward-conditional (- count) t)
  (c-keep-region-active))

(defun c-backward-conditional (count &optional up-flag)
  "Move back across a preprocessor conditional, leaving mark behind.
A prefix argument acts as a repeat count.  With a negative argument,
move forward across a preprocessor conditional."
  (interactive "p")
  (c-forward-conditional (- count) up-flag)
  (c-keep-region-active))

(defun c-forward-conditional (count &optional up-flag)
  "Move forward across a preprocessor conditional, leaving mark behind.
A prefix argument acts as a repeat count.  With a negative argument,
move backward across a preprocessor conditional."
  (interactive "p")
  (let* ((forward (> count 0))
	 (increment (if forward -1 1))
	 (search-function (if forward 're-search-forward 're-search-backward))
	 (new))
    (save-excursion
      (while (/= count 0)
	(let ((depth (if up-flag 0 -1)) found)
	  (save-excursion
	    ;; Find the "next" significant line in the proper direction.
	    (while (and (not found)
			;; Rather than searching for a # sign that
			;; comes at the beginning of a line aside from
			;; whitespace, search first for a string
			;; starting with # sign.  Then verify what
			;; precedes it.  This is faster on account of
			;; the fastmap feature of the regexp matcher.
			(funcall search-function
				 "#[ \t]*\\(if\\|elif\\|endif\\)"
				 nil t))
	      (beginning-of-line)
	      ;; Now verify it is really a preproc line.
	      (if (looking-at "^[ \t]*#[ \t]*\\(if\\|elif\\|endif\\)")
		  (let ((prev depth))
		    ;; Update depth according to what we found.
		    (beginning-of-line)
		    (cond ((looking-at "[ \t]*#[ \t]*endif")
			   (setq depth (+ depth increment)))
			  ((looking-at "[ \t]*#[ \t]*elif")
			   (if (and forward (= depth 0))
			       (setq found (point))))
			  (t (setq depth (- depth increment))))
		    ;; If we are trying to move across, and we find an
		    ;; end before we find a beginning, get an error.
		    (if (and (< prev 0) (< depth prev))
			(error (if forward
				   "No following conditional at this level"
				 "No previous conditional at this level")))
		    ;; When searching forward, start from next line so
		    ;; that we don't find the same line again.
		    (if forward (forward-line 1))
		    ;; If this line exits a level of conditional, exit
		    ;; inner loop.
		    (if (< depth 0)
			(setq found (point))))
		;; else
		(if forward (forward-line 1))
		)))
	  (or found
	      (error "No containing preprocessor conditional"))
	  (goto-char (setq new found)))
	(setq count (+ count increment))))
    (push-mark)
    (goto-char new))
  (c-keep-region-active))


;; commands to indent lines, regions, defuns, and expressions
(defun c-indent-command (&optional whole-exp)
  "Indent current line as C++ code, or in some cases insert a tab character.

If `c-tab-always-indent' is t, always just indent the current line.
If nil, indent the current line only if point is at the left margin or
in the line's indentation; otherwise insert a tab.  If other than nil
or t, then tab is inserted only within literals (comments and strings)
and inside preprocessor directives, but line is always reindented.

A numeric argument, regardless of its value, means indent rigidly all
the lines of the expression starting after point so that this line
becomes properly indented.  The relative indentation among the lines
of the expression are preserved."
  (interactive "P")
  (let ((bod (c-point 'bod)))
    (if whole-exp
	;; If arg, always indent this line as C
	;; and shift remaining lines of expression the same amount.
	(let ((shift-amt (c-indent-line))
	      beg end)
	  (save-excursion
	    (if (eq c-tab-always-indent t)
		(beginning-of-line))
	    (setq beg (point))
	    (forward-sexp 1)
	    (setq end (point))
	    (goto-char beg)
	    (forward-line 1)
	    (setq beg (point)))
	  (if (> end beg)
	      (indent-code-rigidly beg end (- shift-amt) "#")))
      ;; No arg supplied, use c-tab-always-indent to determine
      ;; behavior
      (cond
       ;; CASE 1: indent when at column zero or in lines indentation,
       ;; otherwise insert a tab
       ((not c-tab-always-indent)
	(if (save-excursion
	      (skip-chars-backward " \t")
	      (not (bolp)))
	    (insert-tab)
	  (c-indent-line)))
       ;; CASE 2: just indent the line
       ((eq c-tab-always-indent t)
	(c-indent-line))
       ;; CASE 3: if in a literal, insert a tab, but always indent the
       ;; line
       (t
	(if (c-in-literal bod)
	    (insert-tab))
	(c-indent-line)
	)))))

(defun c-indent-exp (&optional shutup-p)
  "Indent each line in balanced expression following point.
Optional SHUTUP-P if non-nil, inhibits message printing and error checking."
  (interactive "P")
  (let ((here (point))
	end progress-p)
    (unwind-protect
	(let ((c-echo-syntactic-information-p nil) ;keep quiet for speed
	      (start (progn
		       ;; try to be smarter about finding the range of
		       ;; lines to indent. skip all following
		       ;; whitespace. failing that, try to find any
		       ;; opening brace on the current line
		       (skip-chars-forward " \t\n")
		       (if (memq (following-char) '(?\( ?\[ ?\{))
			   (point)
			 (let ((state (parse-partial-sexp (point)
							  (c-point 'eol))))
			   (and (nth 1 state)
				(goto-char (nth 1 state))
				(memq (following-char) '(?\( ?\[ ?\{))
				(point)))))))
	  ;; find balanced expression end
	  (setq end (and (c-safe (progn (forward-sexp 1) t))
			 (point-marker)))
	  ;; sanity check
	  (and (not start)
	       (not shutup-p)
	       (error "Cannot find start of balanced expression to indent."))
	  (and (not end)
	       (not shutup-p)
	       (error "Cannot find end of balanced expression to indent."))
	  (c-progress-init start end 'c-indent-exp)
	  (setq progress-p t)
	  (goto-char start)
	  (beginning-of-line)
	  (while (< (point) end)
	    (if (not (looking-at "[ \t]*$"))
		(c-indent-line))
	    (c-progress-update)
	    (forward-line 1)))
      ;; make sure marker is deleted
      (and end
	   (set-marker end nil))
      (and progress-p
	   (c-progress-fini 'c-indent-exp))
      (goto-char here))))

(defun c-indent-defun ()
  "Re-indents the current top-level function def, struct or class declaration."
  (interactive)
  (let ((here (point-marker))
	(c-echo-syntactic-information-p nil)
	(brace (c-least-enclosing-brace (c-parse-state))))
    (if brace
	(goto-char brace)
      (beginning-of-defun))
    ;; if we're sitting at b-o-b, it might be because there was no
    ;; least enclosing brace and we were sitting on the defun's open
    ;; brace.
    (if (and (bobp) (not (= (following-char) ?\{)))
	(goto-char here))
    ;; if defun-prompt-regexp is non-nil, b-o-d might not leave us at
    ;; the open brace. I consider this an Emacs bug.
    (and (boundp 'defun-prompt-regexp)
	 defun-prompt-regexp
	 (looking-at defun-prompt-regexp)
	 (goto-char (match-end 0)))
    ;; catch all errors in c-indent-exp so we can 1. give more
    ;; meaningful error message, and 2. restore point
    (unwind-protect
	(c-indent-exp)
      (goto-char here)
      (set-marker here nil))))

(defun c-indent-region (start end)
  ;; Indent every line whose first char is between START and END inclusive.
  (save-excursion
    (goto-char start)
    ;; Advance to first nonblank line.
    (skip-chars-forward " \t\n")
    (beginning-of-line)
    (let (endmark)
      (unwind-protect
	  (let ((c-tab-always-indent t)
		;; shut up any echo msgs on indiv lines
		(c-echo-syntactic-information-p nil))
	    (c-progress-init start end 'c-indent-region)
	    (setq endmark (copy-marker end))
	    (while (and (bolp)
			(not (eobp))
			(< (point) endmark))
	      ;; update progress
	      (c-progress-update)
	      ;; Indent one line as with TAB.
	      (let (nextline sexpend sexpbeg)
		;; skip blank lines
		(skip-chars-forward " \t\n")
		(beginning-of-line)
		;; indent the current line
		(c-indent-line)
		(if (save-excursion
		      (beginning-of-line)
		      (looking-at "[ \t]*#"))
		    (forward-line 1)
		  (save-excursion
		    ;; Find beginning of following line.
		    (setq nextline (c-point 'bonl))
		    ;; Find first beginning-of-sexp for sexp extending past
		    ;; this line.
		    (beginning-of-line)
		    (while (< (point) nextline)
		      (condition-case nil
			  (progn
			    (forward-sexp 1)
			    (setq sexpend (point)))
			(error (setq sexpend nil)
			       (goto-char nextline)))
		      (c-forward-syntactic-ws))
		    (if sexpend
			(progn 
			  ;; make sure the sexp we found really starts on the
			  ;; current line and extends past it
			  (goto-char sexpend)
			  (setq sexpend (point-marker))
			  (c-safe (backward-sexp 1))
			  (setq sexpbeg (point)))))
		  ;; check to see if the next line starts a
		  ;; comment-only line
		  (save-excursion
		    (forward-line 1)
		    (skip-chars-forward " \t")
		    (if (looking-at c-comment-start-regexp)
			(setq sexpbeg (c-point 'bol))))
		  ;; If that sexp ends within the region, indent it all at
		  ;; once, fast.
		  (condition-case nil
		      (if (and sexpend
			       (> sexpend nextline)
			       (<= sexpend endmark))
			  (progn
			    (goto-char sexpbeg)
			    (c-indent-exp 'shutup)
			    (c-progress-update)
			    (goto-char sexpend)))
		    (error
		     (goto-char sexpbeg)
		     (c-indent-line)))
		  ;; Move to following line and try again.
		  (and sexpend
		       (markerp sexpend)
		       (set-marker sexpend nil))
		  (forward-line 1)))))
	(set-marker endmark nil)
	(c-progress-fini 'c-indent-region)
	))))

(defun c-mark-function ()
  "Put mark at end of a C, C++, or Objective-C defun, point at beginning."
  (interactive)
  (let ((here (point))
	;; there should be a c-point position for 'eod
	(eod  (save-excursion (end-of-defun) (point)))
	(state (c-parse-state))
	brace)
    (while state
      (setq brace (car state))
      (if (consp brace)
	  (goto-char (cdr brace))
	(goto-char brace))
      (setq state (cdr state)))
    (if (= (following-char) ?{)
	(progn
	  (forward-line -1)
	  (while (not (or (bobp)
			  (looking-at "[ \t]*$")))
	    (forward-line -1)))
      (forward-line 1)
      (skip-chars-forward " \t\n"))
    (push-mark here)
    (push-mark eod nil t)))


;; for progress reporting
(defvar c-progress-info nil)

(defun c-progress-init (start end context)
  ;; start the progress update messages.  if this emacs doesn't have a
  ;; built-in timer, just be dumb about it
  (if (not (fboundp 'current-time))
      (message "indenting region... (this may take a while)")
    ;; if progress has already been initialized, do nothing. otherwise
    ;; initialize the counter with a vector of:
    ;; [start end lastsec context]
    (if c-progress-info
	()
      (setq c-progress-info (vector start
				    (save-excursion
				      (goto-char end)
				      (point-marker))
				    (nth 1 (current-time))
				    context))
      (message "indenting region..."))))

(defun c-progress-update ()
  ;; update progress
  (if (not (and c-progress-info c-progress-interval))
      nil
    (let ((now (nth 1 (current-time)))
	  (start (aref c-progress-info 0))
	  (end (aref c-progress-info 1))
	  (lastsecs (aref c-progress-info 2)))
      ;; should we update?  currently, update happens every 2 seconds,
      ;; what's the right value?
      (if (< c-progress-interval (- now lastsecs))
	  (progn
	    (message "indenting region... (%d%% complete)"
		     (/ (* 100 (- (point) start)) (- end start)))
	    (aset c-progress-info 2 now)))
      )))

(defun c-progress-fini (context)
  ;; finished
  (if (or (eq context (aref c-progress-info 3))
	  (eq context t))
      (progn
	(set-marker (aref c-progress-info 1) nil)
	(setq c-progress-info nil)
	(message "indenting region...done"))))


;; Skipping of "syntactic whitespace" for Emacs 19.  Syntactic
;; whitespace is defined as lexical whitespace, C and C++ style
;; comments, and preprocessor directives.  Search no farther back or
;; forward than optional LIM.  If LIM is omitted, `beginning-of-defun'
;; is used for backward skipping, point-max is used for forward
;; skipping.  Note that Emacs 18 support has been moved to cc-mode-18.el.

(defun c-forward-syntactic-ws (&optional lim)
  ;; Forward skip of syntactic whitespace for Emacs 19.
  (save-restriction
    (let* ((lim (or lim (point-max)))
	   (here lim)
	   (hugenum (point-max)))
      (narrow-to-region lim (point))
      (while (/= here (point))
	(setq here (point))
	(forward-comment hugenum)
	;; skip preprocessor directives
	(if (and (= (following-char) ?#)
		 (= (c-point 'boi) (point)))
	    (end-of-line)
	  )))))

(defun c-backward-syntactic-ws (&optional lim)
  ;; Backward skip over syntactic whitespace for Emacs 19.
  (save-restriction
    (let* ((lim (or lim (c-point 'bod)))
	   (here lim)
	   (hugenum (- (point-max))))
      (if (< lim (point))
	  (progn
	    (narrow-to-region lim (point))
	    (while (/= here (point))
	      (setq here (point))
	      (forward-comment hugenum)
	      (if (eq (c-in-literal lim) 'pound)
		  (beginning-of-line))
	      )))
      )))


;; Return `c' if in a C-style comment, `c++' if in a C++ style
;; comment, `string' if in a string literal, `pound' if on a
;; preprocessor line, or nil if not in a comment at all.  Optional LIM
;; is used as the backward limit of the search.  If omitted, or nil,
;; `beginning-of-defun' is used."

;; This is for all v19 Emacsen supporting either 1-bit or 8-bit syntax
(defun c-in-literal (&optional lim)
  ;; Determine if point is in a C++ literal. we cache the last point
  ;; calculated if the cache is enabled
  (if (and (boundp 'c-in-literal-cache)
	   c-in-literal-cache
	   (= (point) (aref c-in-literal-cache 0)))
      (aref c-in-literal-cache 1)
    (let ((rtn (save-excursion
		 (let* ((lim (or lim (c-point 'bod)))
			(here (point))
			(state (parse-partial-sexp lim (point))))
		   (cond
		    ((nth 3 state) 'string)
		    ((nth 4 state) (if (nth 7 state) 'c++ 'c))
		    ((progn
		       (goto-char here)
		       (beginning-of-line)
		       (looking-at "[ \t]*#"))
		     'pound)
		    (t nil))))))
      ;; cache this result if the cache is enabled
      (and (boundp 'c-in-literal-cache)
	   (setq c-in-literal-cache (vector (point) rtn)))
      rtn)))


;; utilities for moving and querying around syntactic elements
(defun c-parse-state ()
  ;; Finds and records all open parens between some important point
  ;; earlier in the file and point.
  ;;
  ;; if there's a state cache, return it
  (if (boundp 'c-state-cache) c-state-cache
    (let* (at-bob
	   (pos (save-excursion
		  ;; go back 2 bods, but ignore any bogus positions
		  ;; returned by beginning-of-defun (i.e. open paren
		  ;; in column zero)
		  (let ((cnt 2))
		    (while (not (or at-bob (zerop cnt)))
		      (beginning-of-defun)
		      (if (= (following-char) ?\{)
			  (setq cnt (1- cnt)))
		      (if (bobp)
			  (setq at-bob t))))
		  (point)))
	   (here (save-excursion
		   ;;(skip-chars-forward " \t}")
		   (point)))
	   (last-bod pos) (last-pos pos)
	   placeholder state sexp-end)
      ;; cache last bod position
      (while (catch 'backup-bod
	       (setq state nil)
	       (while (and pos (< pos here))
		 (setq last-pos pos)
		 (if (and (setq pos (c-safe (scan-lists pos 1 -1)))
			  (<= pos here))
		     (progn
		       (setq sexp-end (c-safe (scan-sexps (1- pos) 1)))
		       (if (and sexp-end
				(<= sexp-end here))
			   ;; we want to record both the start and end
			   ;; of this sexp, but we only want to record
			   ;; the last-most of any of them before here
			   (progn
			     (if (= (char-after (1- pos)) ?\{)
				 (setq state (cons (cons (1- pos) sexp-end)
						   (if (consp (car state))
						       (cdr state)
						     state))))
			     (setq pos sexp-end))
			 ;; we're contained in this sexp so put pos on
			 ;; front of list
			 (setq state (cons (1- pos) state))))
		   ;; something bad happened. check to see if we
		   ;; crossed an unbalanced close brace. if so, we
		   ;; didn't really find the right `important bufpos'
		   ;; so lets back up and try again
		   (if (and (not pos) (not at-bob)
			    (setq placeholder
				  (c-safe (scan-lists last-pos 1 1)))
			    ;;(char-after (1- placeholder))
			    (<= placeholder here)
			    (= (char-after (1- placeholder)) ?\}))
		       (while t
			 (setq last-bod (c-safe (scan-lists last-bod -1 1)))
			 (if (not last-bod)
			     (error "unbalanced close brace at position %d"
				    (1- placeholder))
			   (setq at-bob (= last-bod (point-min))
				 pos last-bod)
			   (if (= (char-after last-bod) ?\{)
			       (throw 'backup-bod t)))
			 ))		;end-if
		   ))			;end-while
	       nil))
      state)))

(defun c-whack-state (bufpos state)
  ;; whack off any state information that appears on STATE which lies
  ;; after the bounds of BUFPOS.
  (let (newstate car)
    (while state
      (setq car (car state)
	    state (cdr state))
      (if (consp car)
	  ;; just check the car, because in a balanced brace
	  ;; expression, it must be impossible for the corresponding
	  ;; close brace to be before point, but the open brace to be
	  ;; after.
	  (if (<= bufpos (car car))
	      nil			; whack it off
	    ;; its possible that the open brace is before bufpos, but
	    ;; the close brace is after.  In that case, convert this
	    ;; to a non-cons element.
	    (if (<= bufpos (cdr car))
		(setq newstate (append newstate (list (car car))))
	      ;; we know that both the open and close braces are
	      ;; before bufpos, so we also know that everything else
	      ;; on state is before bufpos, so we can glom up the
	      ;; whole thing and exit.
	      (setq newstate (append newstate (list car) state)
		    state nil)))
	(if (<= bufpos car)
	    nil				; whack it off
	  ;; it's before bufpos, so everything else should too
	  (setq newstate (append newstate (list car) state)
		state nil))))
    newstate))

(defun c-hack-state (bufpos which state)
  ;; Using BUFPOS buffer position, and WHICH (must be 'open or
  ;; 'close), hack the c-parse-state STATE and return the results.
  (if (eq which 'open)
      (let ((car (car state)))
	(if (or (null car)
		(consp car)
		(/= bufpos car))
	    (cons bufpos state)
	  state))
    (if (not (eq which 'close))
	(error "c-hack-state, bad argument: %s" which))
    ;; 'close brace
    (let ((car (car state))
	  (cdr (cdr state)))
      (if (consp car)
	  (setq car (car cdr)
		cdr (cdr cdr)))
      ;; TBD: is this test relevant???
      (if (consp car)
	  state				;on error, don't change
	;; watch out for balanced expr already on cdr of list
	(cons (cons car bufpos)
	      (if (consp (car cdr))
		  (cdr cdr) cdr))
	))))

(defun c-adjust-state (from to shift state)
  ;; Adjust all points in state that lie in the region FROM..TO by
  ;; SHIFT amount (as would be returned by c-indent-line).
  (mapcar
   (function
    (lambda (e)
      (if (consp e)
	  (let ((car (car e))
		(cdr (cdr e)))
	    (if (and (<= from car) (< car to))
		(setcar e (+ shift car)))
	    (if (and (<= from cdr) (< cdr to))
		(setcdr e (+ shift cdr))))
	(if (and (<= from e) (< e to))
	    (setq e (+ shift e))))
      e))
   state))


(defun c-beginning-of-inheritance-list (&optional lim)
  ;; Go to the first non-whitespace after the colon that starts a
  ;; multiple inheritance introduction.  Optional LIM is the farthest
  ;; back we should search.
  (let ((lim (or lim (c-point 'bod)))
	(placeholder (progn
		       (back-to-indentation)
		       (point))))
    (c-backward-syntactic-ws lim)
    (while (and (> (point) lim)
		(memq (preceding-char) '(?, ?:))
		(progn
		  (beginning-of-line)
		  (setq placeholder (point))
		  (skip-chars-forward " \t")
		  (not (looking-at c-class-key))
		  ))
      (c-backward-syntactic-ws lim))
    (goto-char placeholder)
    (skip-chars-forward "^:" (c-point 'eol))))

(defun c-beginning-of-macro (&optional lim)
  ;; Go to the beginning of the macro. Right now we don't support
  ;; multi-line macros too well
  (back-to-indentation))

(defun c-in-method-def-p ()
  ;; Return nil if we aren't in a method definition, otherwise the
  ;; position of the initial [+-].
  (save-excursion
    (beginning-of-line)
    (and c-method-key
	 (looking-at c-method-key)
	 (point))
    ))

(defun c-just-after-func-arglist-p (&optional containing)
  ;; Return t if we are between a function's argument list closing
  ;; paren and its opening brace.  Note that the list close brace
  ;; could be followed by a "const" specifier or a member init hanging
  ;; colon.  Optional CONTAINING is position of containing s-exp open
  ;; brace.  If not supplied, point is used as search start.
  (save-excursion
    (c-backward-syntactic-ws)
    (let ((checkpoint (or containing (point))))
      (goto-char checkpoint)
      ;; could be looking at const specifier
      (if (and (= (preceding-char) ?t)
	       (forward-word -1)
	       (looking-at "\\<const\\>"))
	  (c-backward-syntactic-ws)
	;; otherwise, we could be looking at a hanging member init
	;; colon
	(goto-char checkpoint)
	(if (and (= (preceding-char) ?:)
		 (progn
		   (forward-char -1)
		   (c-backward-syntactic-ws)
		   (looking-at "[ \t\n]*:\\([^:]+\\|$\\)")))
	    nil
	  (goto-char checkpoint))
	)
      (and (= (preceding-char) ?\))
	   ;; check if we are looking at a method def
	   (or (not c-method-key)
	       (progn
		 (forward-sexp -1)
		 (forward-char -1)
		 (c-backward-syntactic-ws)
		 (not (or (= (preceding-char) ?-)
			  (= (preceding-char) ?+)
			  ;; or a class category
			  (progn
			    (forward-sexp -2)
			    (looking-at c-class-key))
			  )))))
      )))

;; defuns to look backwards for things
(defun c-backward-to-start-of-do (&optional lim)
  ;; Move to the start of the last "unbalanced" do expression.
  ;; Optional LIM is the farthest back to search.  If none is found,
  ;; nil is returned and point is left unchanged, otherwise t is returned.
  (let ((do-level 1)
	(case-fold-search nil)
	(lim (or lim (c-point 'bod)))
	(here (point))
	foundp)
    (while (not (zerop do-level))
      ;; we protect this call because trying to execute this when the
      ;; while is not associated with a do will throw an error
      (condition-case nil
	  (progn
	    (backward-sexp 1)
	    (cond
	     ((memq (c-in-literal lim) '(c c++)))
	     ((looking-at "while\\b[^_]")
	      (setq do-level (1+ do-level)))
	     ((looking-at "do\\b[^_]")
	      (if (zerop (setq do-level (1- do-level)))
		  (setq foundp t)))
	     ((<= (point) lim)
	      (setq do-level 0)
	      (goto-char lim))))
	(error
	 (goto-char lim)
	 (setq do-level 0))))
    (if (not foundp)
	(goto-char here))
    foundp))

(defun c-backward-to-start-of-if (&optional lim)
  ;; Move to the start of the last "unbalanced" if and return t.  If
  ;; none is found, and we are looking at an if clause, nil is
  ;; returned.  If none is found and we are looking at an else clause,
  ;; an error is thrown.
  (let ((if-level 1)
	(here (c-point 'bol))
	(case-fold-search nil)
	(lim (or lim (c-point 'bod)))
	(at-if (looking-at "if\\b[^_]")))
    (catch 'orphan-if
      (while (and (not (bobp))
		  (not (zerop if-level)))
	(c-backward-syntactic-ws)
	(condition-case nil
	    (backward-sexp 1)
	  (error
	   (if at-if
	       (throw 'orphan-if nil)
	     (error "No matching `if' found for `else' on line %d."
		    (1+ (count-lines 1 here))))))
	(cond
	 ((looking-at "else\\b[^_]")
	  (setq if-level (1+ if-level)))
	 ((looking-at "if\\b[^_]")
	  ;; check for else if... skip over
	  (let ((here (point)))
	    (c-safe (forward-sexp -1))
	    (if (looking-at "\\<else\\>[ \t]+\\<if\\>")
		nil
	      (setq if-level (1- if-level))
	      (goto-char here))))
	 ((< (point) lim)
	  (setq if-level 0)
	  (goto-char lim))
	 ))
      t)))

(defun c-skip-conditional ()
  ;; skip forward over conditional at point, including any predicate
  ;; statements in parentheses. No error checking is performed.
  (forward-sexp
   ;; else if()
   (if (looking-at "\\<else\\>[ \t]+\\<if\\>")
       3
     ;; do and else aren't followed by parens
     (if (looking-at "\\<\\(do\\|else\\)\\>")
	 1 2))))

(defun c-skip-case-statement-forward (state &optional lim)
  ;; skip forward over case/default bodies, with optional maximal
  ;; limit. if no next case body is found, nil is returned and point
  ;; is not moved
  (let ((lim (or lim (point-max)))
	(here (point))
	donep foundp bufpos
	(safepos (point))
	(balanced (car state)))
    ;; search until we've passed the limit, or we've found our match
    (while (and (< (point) lim)
		(not donep))
      (setq safepos (point))
      ;; see if we can find a case statement, not in a literal
      (if (and (re-search-forward c-switch-label-key lim 'move)
	       (setq bufpos (match-beginning 0))
	       (not (c-in-literal safepos))
	       (/= bufpos here))
	  ;; if we crossed into a balanced sexp, we know the case is
	  ;; not part of our switch statement, so just bound over the
	  ;; sexp and keep looking.
	  (if (and (consp balanced)
		   (> bufpos (car balanced))
		   (< bufpos (cdr balanced)))
	      (goto-char (cdr balanced))
	    (goto-char bufpos)
	    (setq donep t
		  foundp t))))
    (if (not foundp)
	(goto-char here))
    foundp))

(defun c-search-uplist-for-classkey (brace-state)
  ;; search for the containing class, returning a 2 element vector if
  ;; found. aref 0 contains the bufpos of the class key, and aref 1
  ;; contains the bufpos of the open brace.
  (if (null brace-state)
      ;; no brace-state means we cannot be inside a class
      nil
    (let ((carcache (car brace-state))
	  search-start search-end)
      (if (consp carcache)
	  ;; a cons cell in the first element means that there is some
	  ;; balanced sexp before the current bufpos. this we can
	  ;; ignore. the nth 1 and nth 2 elements define for us the
	  ;; search boundaries
	  (setq search-start (nth 2 brace-state)
		search-end (nth 1 brace-state))
	;; if the car was not a cons cell then nth 0 and nth 1 define
	;; for us the search boundaries
	(setq search-start (nth 1 brace-state)
	      search-end (nth 0 brace-state)))
      ;; search-end cannot be a cons cell
      (and (consp search-end)
	   (error "consp search-end: %s" search-end))
      ;; if search-end is nil, or if the search-end character isn't an
      ;; open brace, we are definitely not in a class
      (if (or (not search-end)
	      (< search-end (point-min))
	      (/= (char-after search-end) ?{))
	  nil
	;; now, we need to look more closely at search-start.  if
	;; search-start is nil, then our start boundary is really
	;; point-min.
	(if (not search-start)
	    (setq search-start (point-min))
	  ;; if search-start is a cons cell, then we can start
	  ;; searching from the end of the balanced sexp just ahead of
	  ;; us
	  (if (consp search-start)
	      (setq search-start (cdr search-start))))
	;; now we can do a quick regexp search from search-start to
	;; search-end and see if we can find a class key.  watch for
	;; class like strings in literals
	(save-excursion
	  (save-restriction
	    (goto-char search-start)
	    (let (foundp class match-end)
	      (while (and (not foundp)
			  (progn
			    (c-forward-syntactic-ws)
			    (> search-end (point)))
			  (re-search-forward c-class-key search-end t))
		(setq class (match-beginning 0)
		      match-end (match-end 0))
		(if (c-in-literal search-start)
		    nil			; its in a comment or string, ignore
		  (goto-char class)
		  (skip-chars-forward " \t\n")
		  (setq foundp (vector (c-point 'boi) search-end))
		  (cond
		   ;; check for embedded keywords
		   ((let ((char (char-after (1- class))))
		      (and char
			   (memq (char-syntax char) '(?w ?_))))
		    (goto-char match-end)
		    (setq foundp nil))
		   ;; make sure we're really looking at the start of a
		   ;; class definition, and not a forward decl, return
		   ;; arg, template arg list, or an ObjC or Java method.
		   ((and c-method-key
			 (re-search-forward c-method-key search-end t))
		    (setq foundp nil))
		   ;; Its impossible to define a regexp for this, and
		   ;; nearly so to do it programmatically.
		   ;;
		   ;; ; picks up forward decls
		   ;; = picks up init lists
		   ;; ) picks up return types
		   ;; > picks up templates, but remember that we can
		   ;;   inherit from templates!
		   ((let ((skipchars "^;=)"))
		      ;; try to see if we found the `class' keyword
		      ;; inside a template arg list
		      (save-excursion
			(skip-chars-backward "^<>" search-start)
			(if (= (preceding-char) ?<)
			    (setq skipchars (concat skipchars ">"))))
		      (skip-chars-forward skipchars search-end)
		      (/= (point) search-end))
		    (setq foundp nil))
		   )))
	      foundp))
	  )))))

(defun c-inside-bracelist-p (containing-sexp brace-state)
  ;; return the buffer position of the beginning of the brace list
  ;; statement if we're inside a brace list, otherwise return nil.
  ;; CONTAINING-SEXP is the buffer pos of the innermost containing
  ;; paren. BRACE-STATE is the remainder of the state of enclosing braces
  ;;
  ;; N.B.: This algorithm can potentially get confused by cpp macros
  ;; places in inconvenient locations.  Its a trade-off we make for
  ;; speed.
  (or
   ;; this will pick up enum lists
   (condition-case ()
       (save-excursion
	 (goto-char containing-sexp)
	 (forward-sexp -1)
	 (if (or (looking-at "enum[\t\n ]+")
		 (progn (forward-sexp -1)
			(looking-at "enum[\t\n ]+")))
	     (point)))
     (error nil))
   ;; this will pick up array/aggregate init lists, even if they are nested.
   (save-excursion
     (let (bufpos failedp)
       (while (and (not bufpos)
		   containing-sexp)
	 (if (consp containing-sexp)
	     (setq containing-sexp (car brace-state)
		   brace-state (cdr brace-state))
	   ;; see if significant character just before brace is an equal
	   (goto-char containing-sexp)
	   (setq failedp nil)
	   (condition-case ()
	       (progn
		 (forward-sexp -1)
		 (forward-sexp 1)
		 (c-forward-syntactic-ws containing-sexp))
	     (error (setq failedp t)))
	   (if (or failedp (/= (following-char) ?=))
	       ;; lets see if we're nested. find the most nested
	       ;; containing brace
	       (setq containing-sexp (car brace-state)
		     brace-state (cdr brace-state))
	     ;; we've hit the beginning of the aggregate list
	     (c-beginning-of-statement-1 (c-most-enclosing-brace brace-state))
	     (setq bufpos (point)))
	   ))
       bufpos))
   ))


;; defuns for calculating the syntactic state and indenting a single
;; line of C/C++/ObjC code
(defmacro c-add-syntax (symbol &optional relpos)
  ;; a simple macro to append the syntax in symbol to the syntax list.
  ;; try to increase performance by using this macro
  (` (setq syntax (cons (cons (, symbol) (, relpos)) syntax))))

(defun c-most-enclosing-brace (state)
  ;; return the bufpos of the most enclosing brace that hasn't been
  ;; narrowed out by any enclosing class, or nil if none was found
  (let (enclosingp)
    (while (and state (not enclosingp))
      (setq enclosingp (car state)
	    state (cdr state))
      (if (consp enclosingp)
	  (setq enclosingp nil)
	(if (> (point-min) enclosingp)
	    (setq enclosingp nil))
	(setq state nil)))
    enclosingp))

(defun c-least-enclosing-brace (state)
  ;; return the bufpos of the least (highest) enclosing brace that
  ;; hasn't been narrowed out by any enclosing class, or nil if none
  ;; was found.
  (c-most-enclosing-brace (nreverse state)))

(defun c-safe-position (bufpos state)
  ;; return the closest known safe position higher up than point
  (let ((safepos nil))
    (while state
      (setq safepos
	    (if (consp (car state))
		(cdr (car state))
	      (car state)))
      (if (< safepos bufpos)
	  (setq state nil)
	(setq state (cdr state))))
    safepos))

(defun c-narrow-out-enclosing-class (state lim)
  ;; narrow the buffer so that the enclosing class is hidden
  (let (inclass-p)
    (and state
	 (setq inclass-p (c-search-uplist-for-classkey state))
	 (narrow-to-region
	  (progn
	    (goto-char (1+ (aref inclass-p 1)))
	    (skip-chars-forward " \t\n" lim)
	    ;; if point is now left of the class opening brace, we're
	    ;; hosed, so try a different tact
	    (if (<= (point) (aref inclass-p 1))
		(progn
		  (goto-char (1+ (aref inclass-p 1)))
		  (c-forward-syntactic-ws lim)))
	    (point))
	  ;; end point is the end of the current line
	  (progn
	    (goto-char lim)
	    (c-point 'eol))))
    ;; return the class vector
    inclass-p))

(defun c-guess-basic-syntax ()
  ;; guess the syntactic description of the current line of C++ code.
  (save-excursion
    (save-restriction
      (beginning-of-line)
      (let* ((indent-point (point))
	     (case-fold-search nil)
	     (fullstate (c-parse-state))
	     (state fullstate)
	     (in-method-intro-p (and c-method-key
				     (looking-at c-method-key)))
	     literal containing-sexp char-before-ip char-after-ip lim
	     syntax placeholder c-in-literal-cache inswitch-p
	     ;; narrow out any enclosing class
	     (inclass-p (c-narrow-out-enclosing-class state indent-point))
	     )

	;; get the buffer position of the most nested opening brace,
	;; if there is one, and it hasn't been narrowed out
	(save-excursion
	  (goto-char indent-point)
	  (skip-chars-forward " \t}")
	  (skip-chars-backward " \t")
	  (while (and state
		      (not in-method-intro-p)
		      (not containing-sexp))
	    (setq containing-sexp (car state)
		  state (cdr state))
	    (if (consp containing-sexp)
		;; if cdr == point, then containing sexp is the brace
		;; that opens the sexp we close
		(if (= (cdr containing-sexp) (point))
		    (setq containing-sexp (car containing-sexp))
		  ;; otherwise, ignore this element
		  (setq containing-sexp nil))
	      ;; ignore the bufpos if its been narrowed out by the
	      ;; containing class
	      (if (<= containing-sexp (point-min))
		  (setq containing-sexp nil)))))

	;; set the limit on the farthest back we need to search
	(setq lim (or containing-sexp
		      (if (consp (car fullstate))
			  (cdr (car fullstate))
			nil)
		      (point-min)))

	;; cache char before and after indent point, and move point to
	;; the most likely position to perform the majority of tests
	(goto-char indent-point)
	(skip-chars-forward " \t")
	(setq char-after-ip (following-char))
	(c-backward-syntactic-ws lim)
	(setq char-before-ip (preceding-char))
	(goto-char indent-point)
	(skip-chars-forward " \t")

	;; are we in a literal?
	(setq literal (c-in-literal lim))

	;; now figure out syntactic qualities of the current line
	(cond
	 ;; CASE 1: in a string.
	 ((memq literal '(string))
	  (c-add-syntax 'string (c-point 'bopl)))
	 ;; CASE 2: in a C or C++ style comment.
	 ((memq literal '(c c++))
	  ;; we need to catch multi-paragraph C comments
	  (while (and (zerop (forward-line -1))
		      (looking-at "^[ \t]*$")))
	  (c-add-syntax literal (c-point 'bol)))
	 ;; CASE 3: in a cpp preprocessor
	 ((eq literal 'pound)
	  (c-beginning-of-macro lim)
	  (c-add-syntax 'cpp-macro (c-point 'boi)))
	 ;; CASE 4: in an objective-c method intro
	 (in-method-intro-p
	  (c-add-syntax 'objc-method-intro (c-point 'boi)))
	 ;; CASE 5: Line is at top level.
	 ((null containing-sexp)
	  (cond
	   ;; CASE 5A: we are looking at a defun, class, or
	   ;; inline-inclass method opening brace
	   ((= char-after-ip ?{)
	    (cond
	     ;; CASE 5A.1: we are looking at a class opening brace
	     ((save-excursion
		(goto-char indent-point)
		(skip-chars-forward " \t{")
		;; TBD: watch out! there could be a bogus
		;; c-state-cache in place when we get here.  we have
		;; to go through much chicanery to ignore the cache.
		;; But of course, there may not be!  BLECH!  BOGUS!
		(let ((decl
		       (if (boundp 'c-state-cache)
			   (let ((old-cache c-state-cache))
			     (prog2
				 (makunbound 'c-state-cache)
				 (c-search-uplist-for-classkey (c-parse-state))
			       (setq c-state-cache old-cache)))
			 (c-search-uplist-for-classkey (c-parse-state))
			 )))
		  (and decl
		       (setq placeholder (aref decl 0)))
		  ))
	      (c-add-syntax 'class-open placeholder))
	     ;; CASE 5A.2: brace list open
	     ((save-excursion
		(c-beginning-of-statement-1 lim)
		;; c-b-o-s could have left us at point-min
		(and (bobp)
		     (c-forward-syntactic-ws indent-point))
		(setq placeholder (point))
		(and (or (looking-at "enum[ \t\n]+")
			 (= char-before-ip ?=))
		     (save-excursion
		       (skip-chars-forward "^;(" indent-point)
		       (not (memq (following-char) '(?\; ?\()))
		       )))
	      (c-add-syntax 'brace-list-open placeholder))
	     ;; CASE 5A.3: inline defun open
	     (inclass-p
	      (c-add-syntax 'inline-open (aref inclass-p 0)))
	     ;; CASE 5A.4: ordinary defun open
	     (t
	      (goto-char placeholder)
	      (c-add-syntax 'defun-open (c-point 'bol))
	      )))
	   ;; CASE 5B: first K&R arg decl or member init
	   ((c-just-after-func-arglist-p)
	    (cond
	     ;; CASE 5B.1: a member init
	     ((or (= char-before-ip ?:)
		  (= char-after-ip ?:))
	      ;; this line should be indented relative to the beginning
	      ;; of indentation for the topmost-intro line that contains
	      ;; the prototype's open paren
	      ;; TBD: is the following redundant?
	      (if (= char-before-ip ?:)
		  (forward-char -1))
	      (c-backward-syntactic-ws lim)
	      ;; TBD: is the preceding redundant?
	      (if (= (preceding-char) ?:)
		  (progn (forward-char -1)
			 (c-backward-syntactic-ws lim)))
	      (if (= (preceding-char) ?\))
		  (backward-sexp 1))
	      (c-add-syntax 'member-init-intro (c-point 'boi))
	      ;; we don't need to add any class offset since this
	      ;; should be relative to the ctor's indentation
	      )
	     ;; CASE 5B.2: K&R arg decl intro
	     (c-recognize-knr-p
	      (c-add-syntax 'knr-argdecl-intro (c-point 'boi))
	      (and inclass-p (c-add-syntax 'inclass (aref inclass-p 0))))
	     ;; CASE 5B.3: Nether region after a C++ func decl, which
	     ;; could include a `throw' declaration.
	     (t
	      (c-beginning-of-statement-1 lim)
	      (c-add-syntax 'ansi-funcdecl-cont (c-point 'boi))
	      )))
	   ;; CASE 5C: inheritance line. could be first inheritance
	   ;; line, or continuation of a multiple inheritance
	   ((or (and c-baseclass-key (looking-at c-baseclass-key))
		(and (or (= char-before-ip ?:)
			 (= char-after-ip ?:))
		     (save-excursion
		       (c-backward-syntactic-ws lim)
		       (if (= char-before-ip ?:)
			   (progn
			     (forward-char -1)
			     (c-backward-syntactic-ws lim)))
		       (back-to-indentation)
		       (looking-at c-class-key))))
	    (cond
	     ;; CASE 5C.1: non-hanging colon on an inher intro
	     ((= char-after-ip ?:)
	      (c-backward-syntactic-ws lim)
	      (c-add-syntax 'inher-intro (c-point 'boi))
	      ;; don't add inclass symbol since relative point already
	      ;; contains any class offset
	      )
	     ;; CASE 5C.2: hanging colon on an inher intro
	     ((= char-before-ip ?:)
	      (c-add-syntax 'inher-intro (c-point 'boi))
	      (and inclass-p (c-add-syntax 'inclass (aref inclass-p 0))))
	     ;; CASE 5C.3: a continued inheritance line
	     (t
	      (c-beginning-of-inheritance-list lim)
	      (c-add-syntax 'inher-cont (point))
	      ;; don't add inclass symbol since relative point already
	      ;; contains any class offset
	      )))
	   ;; CASE 5D: this could be a top-level compound statement or a
	   ;; member init list continuation
	   ((= char-before-ip ?,)
	    (goto-char indent-point)
	    (c-backward-syntactic-ws lim)
	    (while (and (< lim (point))
			(= (preceding-char) ?,))
	      ;; this will catch member inits with multiple
	      ;; line arglists
	      (forward-char -1)
	      (c-backward-syntactic-ws (c-point 'bol))
	      (if (= (preceding-char) ?\))
		  (backward-sexp 1))
	      ;; now continue checking
	      (beginning-of-line)
	      (c-backward-syntactic-ws lim))
	    (cond
	     ;; CASE 5D.1: hanging member init colon, but watch out
	     ;; for bogus matches on access specifiers inside classes.
	     ((and (= (preceding-char) ?:)
		   (save-excursion
		     (forward-word -1)
		     (not (looking-at c-access-key))))
	      (goto-char indent-point)
	      (c-backward-syntactic-ws lim)
	      (c-safe (backward-sexp 1))
	      (c-add-syntax 'member-init-cont (c-point 'boi))
	      ;; we do not need to add class offset since relative
	      ;; point is the member init above us
	      )
	     ;; CASE 5D.2: non-hanging member init colon
	     ((progn
		(c-forward-syntactic-ws indent-point)
		(= (following-char) ?:))
	      (skip-chars-forward " \t:")
	      (c-add-syntax 'member-init-cont (point)))
	     ;; CASE 5D.3: perhaps a multiple inheritance line?
	     ((looking-at c-inher-key)
	      (c-add-syntax 'inher-cont (c-point 'boi)))
	     ;; CASE 5D.4: perhaps a template list continuation?
	     ((save-excursion
		(skip-chars-backward "^<" lim)
		;; not sure if this is the right test, but it should
		;; be fast and mostly accurate.
		(and (= (preceding-char) ?<)
		     (not (c-in-literal lim))))
	      ;; we can probably indent it just like and arglist-cont
	      (c-add-syntax 'arglist-cont (point)))
	     ;; CASE 5D.5: perhaps a top-level statement-cont
	     (t
	      (c-beginning-of-statement-1 lim)
	      ;; skip over any access-specifiers
	      (and inclass-p c-access-key
		   (while (looking-at c-access-key)
		     (forward-line 1)))
	      ;; skip over comments, whitespace
	      (c-forward-syntactic-ws indent-point)
	      (c-add-syntax 'statement-cont (c-point 'boi)))
	     ))
	   ;; CASE 5E: we are looking at a access specifier
	   ((and inclass-p
		 c-access-key
		 (looking-at c-access-key))
	    (c-add-syntax 'access-label (c-point 'bonl))
	    (c-add-syntax 'inclass (aref inclass-p 0)))
	   ;; CASE 5F: we are looking at the brace which closes the
	   ;; enclosing nested class decl
	   ((and inclass-p
		 (= char-after-ip ?})
		 (save-excursion
		   (save-restriction
		     (widen)
		     (forward-char 1)
		     (and
		      (condition-case nil
			  (progn (backward-sexp 1) t)
			(error nil))
		      (= (point) (aref inclass-p 1))
		      ))))
	    (save-restriction
	      (widen)
	      (goto-char (aref inclass-p 0))
	      (c-add-syntax 'class-close (c-point 'boi))))
	   ;; CASE 5G: we could be looking at subsequent knr-argdecls
	   ((and c-recognize-knr-p
		 (save-excursion
		   (c-backward-syntactic-ws lim)
		   (while (memq (preceding-char) '(?\; ?,))
		     (beginning-of-line)
		     (setq placeholder (point))
		     (c-backward-syntactic-ws lim))
		   (and (= (preceding-char) ?\))
			(or (not c-method-key)
			    (progn
			      (forward-sexp -1)
			      (forward-char -1)
			      (c-backward-syntactic-ws)
			      (not (or (= (preceding-char) ?-)
				       (= (preceding-char) ?+)
				       ;; or a class category
				       (progn
					 (forward-sexp -2)
					 (looking-at c-class-key))
				       )))))
		   )
		 (save-excursion
		   (c-beginning-of-statement-1)
		   (not (looking-at "typedef[ \t\n]+"))))
	    (goto-char placeholder)
	    (c-add-syntax 'knr-argdecl (c-point 'boi)))
	   ;; CASE 5H: we are at the topmost level, make sure we skip
	   ;; back past any access specifiers
	   ((progn
	      (c-backward-syntactic-ws lim)
	      (while (and inclass-p
			  c-access-key
			  (not (bobp))
			  (save-excursion
			    (c-safe (progn (backward-sexp 1) t))
			    (looking-at c-access-key)))
		(backward-sexp 1)
		(c-backward-syntactic-ws lim))
	      (or (bobp)
		  (memq (preceding-char) '(?\; ?\}))))
	    ;; real beginning-of-line could be narrowed out due to
	    ;; enclosure in a class block
	    (save-restriction
	      (widen)
	      (c-add-syntax 'topmost-intro (c-point 'bol))
	      (if inclass-p
		  (progn
		    (goto-char (aref inclass-p 1))
		    (c-add-syntax 'inclass (c-point 'boi))))))
	   ;; CASE 5I: we are at an ObjC or Java method definition
	   ;; continuation line.
	   ((and c-method-key
		 (progn
		   (c-beginning-of-statement-1 lim)
		   (beginning-of-line)
		   (looking-at c-method-key)))
	    (c-add-syntax 'objc-method-args-cont (point)))
	   ;; CASE 5J: we are at a topmost continuation line
	   (t
	    (c-beginning-of-statement-1 lim)
	    (c-forward-syntactic-ws)
	    (c-add-syntax 'topmost-intro-cont (c-point 'boi)))
	   ))				; end CASE 5
	 ;; CASE 6: line is an expression, not a statement.  Most
	 ;; likely we are either in a function prototype or a function
	 ;; call argument list
	 ((/= (char-after containing-sexp) ?{)
	  (c-backward-syntactic-ws containing-sexp)
	  (cond
	   ;; CASE 6A: we are looking at the arglist closing paren or
	   ;; at an Objective-C or Java method call closing bracket.
	   ((and (/= char-before-ip ?,)
		 (memq char-after-ip '(?\) ?\])))
	    (if (and c-method-key
		     (progn
		       (goto-char (1- containing-sexp))
		       (c-backward-syntactic-ws lim)
		       (not (looking-at c-symbol-key))))
		(c-add-syntax 'statement-cont containing-sexp)
	      (goto-char containing-sexp)
	      (c-add-syntax 'arglist-close (c-point 'boi))))
	   ;; CASE 6B: we are looking at the first argument in an empty
	   ;; argument list. Use arglist-close if we're actually
	   ;; looking at a close paren or bracket.
	   ((memq char-before-ip '(?\( ?\[))
	    (goto-char containing-sexp)
	    (c-add-syntax 'arglist-intro (c-point 'boi)))
	   ;; CASE 6C: we are inside a conditional test clause. treat
	   ;; these things as statements
	   ((save-excursion
	     (goto-char containing-sexp)
	     (and (c-safe (progn (forward-sexp -1) t))
		  (looking-at "\\<for\\>")))
	    (goto-char (1+ containing-sexp))
	    (c-forward-syntactic-ws indent-point)
	    (c-beginning-of-statement-1 containing-sexp)
	    (if (= char-before-ip ?\;)
		(c-add-syntax 'statement (point))
	      (c-add-syntax 'statement-cont (point))
	      ))
	   ;; CASE 6D: maybe a continued method call. This is the case
	   ;; when we are inside a [] bracketed exp, and what precede
	   ;; the opening bracket is not an identifier.
	   ((and c-method-key
		 (= (char-after containing-sexp) ?\[)
		 (save-excursion
		   (goto-char (1- containing-sexp))
		   (c-backward-syntactic-ws (c-point 'bod))
		   (if (not (looking-at c-symbol-key))
		       (c-add-syntax 'objc-method-call-cont containing-sexp))
		   )))
	   ;; CASE 6E: we are looking at an arglist continuation line,
	   ;; but the preceding argument is on the same line as the
	   ;; opening paren.  This case includes multi-line
	   ;; mathematical paren groupings, but we could be on a
	   ;; for-list continuation line
	   ((and (save-excursion
		   (goto-char (1+ containing-sexp))
		   (skip-chars-forward " \t")
		   (not (eolp)))
		 (save-excursion
		   (c-beginning-of-statement-1 lim)
		   (skip-chars-backward " \t([")
		   (<= (point) containing-sexp)))
	    (goto-char containing-sexp)
	    (c-add-syntax 'arglist-cont-nonempty (c-point 'boi)))
	   ;; CASE 6F: we are looking at just a normal arglist
	   ;; continuation line
	   (t (c-beginning-of-statement-1 containing-sexp)
	      (forward-char 1)
	      (c-forward-syntactic-ws indent-point)
	      (c-add-syntax 'arglist-cont (c-point 'boi)))
	   ))
	 ;; CASE 7: func-local multi-inheritance line
	 ((and c-baseclass-key
	       (save-excursion
		 (goto-char indent-point)
		 (skip-chars-forward " \t")
		 (looking-at c-baseclass-key)))
	  (goto-char indent-point)
	  (skip-chars-forward " \t")
	  (cond
	   ;; CASE 7A: non-hanging colon on an inher intro
	   ((= char-after-ip ?:)
	    (c-backward-syntactic-ws lim)
	    (c-add-syntax 'inher-intro (c-point 'boi)))
	   ;; CASE 7B: hanging colon on an inher intro
	   ((= char-before-ip ?:)
	    (c-add-syntax 'inher-intro (c-point 'boi)))
	   ;; CASE 7C: a continued inheritance line
	   (t
	    (c-beginning-of-inheritance-list lim)
	    (c-add-syntax 'inher-cont (point))
	    )))
	 ;; CASE 8: we are inside a brace-list
	 ((setq placeholder (c-inside-bracelist-p containing-sexp state))
	  (cond
	   ;; CASE 8A: brace-list-close brace
	   ((and (= char-after-ip ?})
		 (c-safe (progn (forward-char 1)
				(backward-sexp 1)
				t))
		 (= (point) containing-sexp))
	    (c-add-syntax 'brace-list-close (c-point 'boi)))
	   ;; CASE 8B: we're looking at the first line in a brace-list
	   ((save-excursion
	      (goto-char indent-point)
	      (c-backward-syntactic-ws containing-sexp)
	      (= (point) (1+ containing-sexp)))
	    (goto-char containing-sexp)
	    ;;(if (= char-after-ip ?{)
		;;(c-add-syntax 'brace-list-open (c-point 'boi))
	    (c-add-syntax 'brace-list-intro (c-point 'boi))
	    )
	    ;;))			; end CASE 8B
	   ;; CASE 8C: this is just a later brace-list-entry
	   (t (goto-char (1+ containing-sexp))
	      (c-forward-syntactic-ws indent-point)
	      (if (= char-after-ip ?{)
		  (c-add-syntax 'brace-list-open (point))
		(c-add-syntax 'brace-list-entry (point))
		))			; end CASE 8C
	   ))				; end CASE 8
	 ;; CASE 9: A continued statement
	 ((and (not (memq char-before-ip '(?\; ?} ?:)))
	       (> (point)
		  (save-excursion
		    (c-beginning-of-statement-1 containing-sexp)
		    (setq placeholder (point))))
	       (/= placeholder containing-sexp))
	  (goto-char indent-point)
	  (skip-chars-forward " \t")
	  (let ((after-cond-placeholder
		 (save-excursion
		   (goto-char placeholder)
		   (if (looking-at c-conditional-key)
		       (progn
			 (c-safe (c-skip-conditional))
			 (c-forward-syntactic-ws)
			 (if (memq (following-char) '(?\;))
			     (progn
			       (forward-char 1)
			       (c-forward-syntactic-ws)))
			 (point))
		     nil))))
	    (cond
	     ;; CASE 9A: substatement
	     ((and after-cond-placeholder
		   (>= after-cond-placeholder indent-point))
	      (goto-char placeholder)
	      (if (= char-after-ip ?{)
		  (c-add-syntax 'substatement-open (c-point 'boi))
		(c-add-syntax 'substatement (c-point 'boi))))
	     ;; CASE 9B: open braces for class or brace-lists
	     ((= char-after-ip ?{)
	      (cond
	       ;; CASE 9B.1: class-open
	       ((save-excursion
		  (goto-char indent-point)
		  (skip-chars-forward " \t{")
		  (let ((decl (c-search-uplist-for-classkey (c-parse-state))))
		    (and decl
			 (setq placeholder (aref decl 0)))
		    ))
		(c-add-syntax 'class-open placeholder))
	       ;; CASE 9B.2: brace-list-open
	       ((or (save-excursion
		      (goto-char placeholder)
		      (looking-at "\\<enum\\>"))
		    (= char-before-ip ?=))
		(c-add-syntax 'brace-list-open placeholder))
	       ;; CASE 9B.3: catch-all for unknown construct.
	       (t
		;; Can and should I add an extensibility hook here?
		;; Something like c-recognize-hook so support for
		;; unknown constructs could be added.  It's probably a
		;; losing proposition, so I dunno.
		(goto-char placeholder)
		(c-add-syntax 'statement-cont (c-point 'boi))
		(c-add-syntax 'block-open))
	       ))
	     ;; CASE 9C: iostream insertion or extraction operator
	     ((looking-at "<<\\|>>")
	      (goto-char placeholder)
	      (and after-cond-placeholder
		   (goto-char after-cond-placeholder))
	      (while (and (re-search-forward "<<\\|>>" indent-point 'move)
			  (c-in-literal placeholder)))
	      ;; if we ended up at indent-point, then the first
	      ;; streamop is on a separate line. Indent the line like
	      ;; a statement-cont instead
	      (if (/= (point) indent-point)
		  (c-add-syntax 'stream-op (c-point 'boi))
		(c-backward-syntactic-ws lim)
		(c-add-syntax 'statement-cont (c-point 'boi))))
	     ;; CASE 9D: continued statement. find the accurate
	     ;; beginning of statement or substatement
	     (t
	      (c-beginning-of-statement-1 after-cond-placeholder)
	      ;; KLUDGE ALERT!  c-beginning-of-statement-1 can leave
	      ;; us before the lim we're passing in.  It should be
	      ;; fixed, but I'm worried about side-effects at this
	      ;; late date.  Fix for v5.
	      (goto-char (or (and after-cond-placeholder
				  (max after-cond-placeholder (point)))
			     (point)))
	      (c-add-syntax 'statement-cont (point)))
	     )))
	 ;; CASE 10: an else clause?
	 ((looking-at "\\<else\\>[^_]")
	  (c-backward-to-start-of-if containing-sexp)
	  (c-add-syntax 'else-clause (c-point 'boi)))
	 ;; CASE 11: Statement. But what kind?  Lets see if its a
	 ;; while closure of a do/while construct
	 ((progn
	    (goto-char indent-point)
	    (skip-chars-forward " \t")
	    (and (looking-at "while\\b[^_]")
		 (save-excursion
		   (c-backward-to-start-of-do containing-sexp)
		   (setq placeholder (point))
		   (looking-at "do\\b[^_]"))
		 ))
	  (c-add-syntax 'do-while-closure placeholder))
	 ;; CASE 12: A case or default label
	 ((looking-at c-switch-label-key)
	  (goto-char containing-sexp)
	  ;; check for hanging braces
	  (if (/= (point) (c-point 'boi))
	      (forward-sexp -1))
	  (c-add-syntax 'case-label (c-point 'boi)))
	 ;; CASE 13: any other label
	 ((looking-at c-label-key)
	  (goto-char containing-sexp)
	  (c-add-syntax 'label (c-point 'boi)))
	 ;; CASE 14: block close brace, possibly closing the defun or
	 ;; the class
	 ((= char-after-ip ?})
	  (let* ((lim (c-safe-position containing-sexp fullstate))
		 (relpos (save-excursion
			   (goto-char containing-sexp)
			   (if (/= (point) (c-point 'boi))
			       (c-beginning-of-statement-1 lim))
			   (c-point 'boi))))
	    (cond
	     ;; CASE 14A: does this close an inline?
	     ((progn
		(goto-char containing-sexp)
		(c-search-uplist-for-classkey state))
	      (c-add-syntax 'inline-close relpos))
	     ;; CASE 14B: if there an enclosing brace that hasn't
	     ;; been narrowed out by a class, then this is a
	     ;; block-close
	     ((c-most-enclosing-brace state)
	      (c-add-syntax 'block-close relpos))
	     ;; CASE 14C: find out whether we're closing a top-level
	     ;; class or a defun
	     (t
	      (save-restriction
		(narrow-to-region (point-min) indent-point)
		(let ((decl (c-search-uplist-for-classkey (c-parse-state))))
		  (if decl
		      (c-add-syntax 'class-close (aref decl 0))
		    (c-add-syntax 'defun-close relpos)))))
	     )))
	 ;; CASE 15: statement catchall
	 (t
	  ;; we know its a statement, but we need to find out if it is
	  ;; the first statement in a block
	  (goto-char containing-sexp)
	  (forward-char 1)
	  (c-forward-syntactic-ws indent-point)
	  ;; now skip forward past any case/default clauses we might find.
	  (while (or (c-skip-case-statement-forward fullstate indent-point)
		     (and (looking-at c-switch-label-key)
			  (not inswitch-p)))
	    (setq inswitch-p t))
	  ;; we want to ignore non-case labels when skipping forward
	  (while (and (looking-at c-label-key)
		      (goto-char (match-end 0)))
	    (c-forward-syntactic-ws indent-point))
	  (cond
	   ;; CASE 15A: we are inside a case/default clause inside a
	   ;; switch statement.  find out if we are at the statement
	   ;; just after the case/default label.
	   ((and inswitch-p
		 (progn
		   (goto-char indent-point)
		   (c-backward-syntactic-ws containing-sexp)
		   (back-to-indentation)
		   (setq placeholder (point))
		   (looking-at c-switch-label-key)))
	    (goto-char indent-point)
	    (skip-chars-forward " \t")
	    (if (= (following-char) ?{)
		(c-add-syntax 'statement-case-open placeholder)
	      (c-add-syntax 'statement-case-intro placeholder)))
	   ;; CASE 15B: continued statement
	   ((= char-before-ip ?,)
	    (c-add-syntax 'statement-cont (c-point 'boi)))
	   ;; CASE 15C: a question/colon construct?  But make sure
	   ;; what came before was not a label, and what comes after
	   ;; is not a globally scoped function call!
	   ((or (and (memq char-before-ip '(?: ??))
		     (save-excursion
		       (goto-char indent-point)
		       (c-backward-syntactic-ws lim)
		       (back-to-indentation)
		       (not (looking-at c-label-key))))
		(and (memq char-after-ip '(?: ??))
		     (save-excursion
		       (goto-char indent-point)
		       (skip-chars-forward " \t")
		       ;; watch out for scope operator
		       (not (looking-at "::")))))
	    (c-add-syntax 'statement-cont (c-point 'boi)))
	   ;; CASE 15D: any old statement
	   ((< (point) indent-point)
	    (let ((safepos (c-most-enclosing-brace fullstate)))
	      (goto-char indent-point)
	      (c-beginning-of-statement-1 safepos)
	      ;; It is possible we're on the brace that opens a nested
	      ;; function.
	      (if (and (= (following-char) ?{)
		       (save-excursion
			 (c-backward-syntactic-ws safepos)
			 (/= (preceding-char) ?\;)))
		  (c-beginning-of-statement-1 safepos))
	      (c-add-syntax 'statement (c-point 'boi))
	      (if (= char-after-ip ?{)
		  (c-add-syntax 'block-open))))
	   ;; CASE 15E: first statement in an inline, or first
	   ;; statement in a top-level defun. we can tell this is it
	   ;; if there are no enclosing braces that haven't been
	   ;; narrowed out by a class (i.e. don't use bod here!)
	   ((save-excursion
	      (save-restriction
		(widen)
		(goto-char containing-sexp)
		(c-narrow-out-enclosing-class state containing-sexp)
		(not (c-most-enclosing-brace state))))
	    (goto-char containing-sexp)
	    ;; if not at boi, then defun-opening braces are hung on
	    ;; right side, so we need a different relpos
	    (if (/= (point) (c-point 'boi))
		(progn
		  (c-backward-syntactic-ws)
		  (c-safe (forward-sexp (if (= (preceding-char) ?\))
					    -1 -2)))
		  ))
	    (c-add-syntax 'defun-block-intro (c-point 'boi)))
	   ;; CASE 15F: first statement in a block
	   (t (goto-char containing-sexp)
	      (if (/= (point) (c-point 'boi))
		  (c-beginning-of-statement-1
		   (if (= (point) lim)
		       (c-safe-position (point) state) lim)))
	      (c-add-syntax 'statement-block-intro (c-point 'boi))
	      (if (= char-after-ip ?{)
		  (c-add-syntax 'block-open)))
	   ))
	 )

	;; now we need to look at any modifiers
	(goto-char indent-point)
	(skip-chars-forward " \t")
	;; are we looking at a comment only line?
	(if (looking-at c-comment-start-regexp)
	    (c-add-syntax 'comment-intro))
	;; we might want to give additional offset to friends (in C++).
	(if (and (eq major-mode 'c++-mode)
		 (looking-at c-C++-friend-key))
	    (c-add-syntax 'friend))
	;; return the syntax
	syntax))))


;; indent via syntactic language elements
(defun c-get-offset (langelem)
  ;; Get offset from LANGELEM which is a cons cell of the form:
  ;; (SYMBOL . RELPOS).  The symbol is matched against
  ;; c-offsets-alist and the offset found there is either returned,
  ;; or added to the indentation at RELPOS.  If RELPOS is nil, then
  ;; the offset is simply returned.
  (let* ((symbol (car langelem))
	 (relpos (cdr langelem))
	 (match  (assq symbol c-offsets-alist))
	 (offset (cdr-safe match)))
    ;; offset can be a number, a function, a variable, or one of the
    ;; symbols + or -
    (cond
     ((not match)
      (if c-strict-syntax-p
	  (error "don't know how to indent a %s" symbol)
	(setq offset 0
	      relpos 0)))
     ((eq offset '+)  (setq offset c-basic-offset))
     ((eq offset '-)  (setq offset (- c-basic-offset)))
     ((eq offset '++) (setq offset (* 2 c-basic-offset)))
     ((eq offset '--) (setq offset (* 2 (- c-basic-offset))))
     ((eq offset '*)  (setq offset (/ c-basic-offset 2)))
     ((eq offset '/)  (setq offset (/ (- c-basic-offset) 2)))
     ((and (not (numberp offset))
	   (fboundp offset))
      (setq offset (funcall offset langelem)))
     ((not (numberp offset))
      (setq offset (eval offset)))
     )
    (+ (if (and relpos
		(< relpos (c-point 'bol)))
	   (save-excursion
	     (goto-char relpos)
	     (current-column))
	 0)
       offset)))

(defun c-indent-line (&optional syntax)
  ;; indent the current line as C/C++/ObjC code. Optional SYNTAX is the
  ;; syntactic information for the current line. Returns the amount of
  ;; indentation change
  (let* ((c-syntactic-context (or syntax (c-guess-basic-syntax)))
	 (pos (- (point-max) (point)))
	 (indent (apply '+ (mapcar 'c-get-offset c-syntactic-context)))
	 (shift-amt  (- (current-indentation) indent)))
    (and c-echo-syntactic-information-p
	 (message "syntax: %s, indent= %d" c-syntactic-context indent))
    (if (zerop shift-amt)
	nil
      (delete-region (c-point 'bol) (c-point 'boi))
      (beginning-of-line)
      (indent-to indent))
    (if (< (point) (c-point 'boi))
	(back-to-indentation)
      ;; If initial point was within line's indentation, position after
      ;; the indentation.  Else stay at same point in text.
      (if (> (- (point-max) pos) (point))
	  (goto-char (- (point-max) pos)))
      )
    (run-hooks 'c-special-indent-hook)
    shift-amt))

(defun c-show-syntactic-information ()
  "Show syntactic information for current line."
  (interactive)
  (message "syntactic analysis: %s" (c-guess-basic-syntax))
  (c-keep-region-active))


;; Standard indentation line-ups
(defun c-lineup-arglist (langelem)
  ;; lineup the current arglist line with the arglist appearing just
  ;; after the containing paren which starts the arglist.
  (save-excursion
    (let* ((containing-sexp
	    (save-excursion
	      ;; arglist-cont-nonempty gives relpos ==
	      ;; to boi of containing-sexp paren. This
	      ;; is good when offset is +, but bad
	      ;; when it is c-lineup-arglist, so we
	      ;; have to special case a kludge here.
	      (if (memq (car langelem) '(arglist-intro arglist-cont-nonempty))
		  (progn
		    (beginning-of-line)
		    (backward-up-list 1)
		    (skip-chars-forward " \t" (c-point 'eol)))
		(goto-char (cdr langelem)))
	      (point)))
	   (cs-curcol (save-excursion
			(goto-char (cdr langelem))
			(current-column))))
      (if (save-excursion
	    (beginning-of-line)
	    (looking-at "[ \t]*)"))
	  (progn (goto-char (match-end 0))
		 (forward-sexp -1)
		 (forward-char 1)
		 (c-forward-syntactic-ws)
		 (- (current-column) cs-curcol))
	(goto-char containing-sexp)
	(or (eolp)
	    (not (memq (following-char) '(?{ ?\( )))
	    (let ((eol (c-point 'eol))
		  (here (progn
			  (forward-char 1)
			  (skip-chars-forward " \t")
			  (point))))
	      (c-forward-syntactic-ws)
	      (if (< (point) eol)
		  (goto-char here))))
	(- (current-column) cs-curcol)
	))))

(defun c-lineup-arglist-intro-after-paren (langelem)
  ;; lineup an arglist-intro line to just after the open paren
  (save-excursion
    (let ((cs-curcol (save-excursion
		       (goto-char (cdr langelem))
		       (current-column)))
	  (ce-curcol (save-excursion
		       (beginning-of-line)
		       (backward-up-list 1)
		       (skip-chars-forward " \t" (c-point 'eol))
		       (current-column))))
      (- ce-curcol cs-curcol -1))))

(defun c-lineup-streamop (langelem)
  ;; lineup stream operators
  (save-excursion
    (let* ((relpos (cdr langelem))
	   (curcol (progn (goto-char relpos)
			  (current-column))))
      (re-search-forward "<<\\|>>" (c-point 'eol) 'move)
      (goto-char (match-beginning 0))
      (- (current-column) curcol))))

(defun c-lineup-multi-inher (langelem)
  ;; line up multiple inheritance lines
  (save-excursion
    (let (cs-curcol
	  (eol (c-point 'eol))
	  (here (point)))
      (goto-char (cdr langelem))
      (setq cs-curcol (current-column))
      (skip-chars-forward "^:" eol)
      (skip-chars-forward " \t:" eol)
      (if (or (eolp)
	      (looking-at c-comment-start-regexp))
	  (c-forward-syntactic-ws here))
      (- (current-column) cs-curcol)
      )))

(defun c-lineup-C-comments (langelem)
  ;; line up C block comment continuation lines
  (save-excursion
    (let ((stars (progn
		   (beginning-of-line)
		   (skip-chars-forward " \t")
		   (if (looking-at "\\*\\*?")
		       (- (match-end 0) (match-beginning 0))
		     0)))
	  (cs-curcol (progn (goto-char (cdr langelem))
			    (current-column))))
      (back-to-indentation)
      (if (re-search-forward "/\\*[ \t]*" (c-point 'eol) t)
	  (goto-char (+ (match-beginning 0)
			(cond
			 (c-block-comments-indent-p 0)
			 ((= stars 1) 1)
			 ((= stars 2) 0)
			 (t (- (match-end 0) (match-beginning 0)))))))
      (- (current-column) cs-curcol))))

(defun c-lineup-comment (langelem)
  ;; support old behavior for comment indentation. we look at
  ;; c-comment-only-line-offset to decide how to indent comment
  ;; only-lines
  (save-excursion
    (back-to-indentation)
    ;; indent as specified by c-comment-only-line-offset
    (if (not (bolp))
	(or (car-safe c-comment-only-line-offset)
	    c-comment-only-line-offset)
      (or (cdr-safe c-comment-only-line-offset)
	  (car-safe c-comment-only-line-offset)
	  -1000				;jam it against the left side
	  ))))

(defun c-lineup-runin-statements (langelem)
  ;; line up statements in coding standards which place the first
  ;; statement on the same line as the block opening brace.
  (if (= (char-after (cdr langelem)) ?{)
      (save-excursion
	(let ((curcol (progn
			(goto-char (cdr langelem))
			(current-column))))
	  (forward-char 1)
	  (skip-chars-forward " \t")
	  (- (current-column) curcol)))
    0))

(defun c-lineup-math (langelem)
  ;; line up math statement-cont after the equals
  (save-excursion
    (let* ((relpos (cdr langelem))
	   (equalp (save-excursion
		     (goto-char (c-point 'boi))
		     (skip-chars-forward "^=" (c-point 'eol))
		     (and (= (following-char) ?=)
			  (- (point) (c-point 'boi)))))
	   (curcol (progn
		     (goto-char relpos)
		     (current-column)))
	   donep)
      (while (and (not donep)
		  (< (point) (c-point 'eol)))
	(skip-chars-forward "^=" (c-point 'eol))
	(if (c-in-literal (cdr langelem))
	    (forward-char 1)
	  (setq donep t)))
      (if (/= (following-char) ?=)
	  ;; there's no equal sign on the line
	  c-basic-offset
	;; calculate indentation column after equals and ws, unless
	;; our line contains an equals sign
	(if (not equalp)
	    (progn
	      (forward-char 1)
	      (skip-chars-forward " \t")
	      (setq equalp 0)))
	(- (current-column) equalp curcol))
      )))

(defun c-lineup-ObjC-method-call (langelem)
  ;; Line up methods args as elisp-mode does with function args: go to
  ;; the position right after the message receiver, and if you are at
  ;; (eolp) indent the current line by a constant offset from the
  ;; opening bracket; otherwise we are looking at the first character
  ;; of the first method call argument, so lineup the current line
  ;; with it.
  (save-excursion
    (let* ((extra (save-excursion
		    (back-to-indentation)
		    (c-backward-syntactic-ws (cdr langelem))
		    (if (= (preceding-char) ?:)
			(- c-basic-offset)
		      0)))
	   (open-bracket-pos (cdr langelem))
           (open-bracket-col (progn
			       (goto-char open-bracket-pos)
			       (current-column)))
           (target-col (progn
			 (forward-char)
			 (forward-sexp)
			 (skip-chars-forward " \t")
			 (if (eolp)
			     (+ open-bracket-col c-basic-offset)
			   (current-column))))
	   )
      (- target-col open-bracket-col extra))))

(defun c-lineup-ObjC-method-args (langelem)
  ;; Line up the colons that separate args. This is done trying to
  ;; align colons vertically.
  (save-excursion
    (let* ((here (c-point 'boi))
	   (curcol (progn (goto-char here) (current-column)))
	   (eol (c-point 'eol))
	   (relpos (cdr langelem))
	   (first-col-column (progn
			       (goto-char relpos)
			       (skip-chars-forward "^:" eol)
			       (and (= (following-char) ?:)
				    (current-column)))))
      (if (not first-col-column)
	  c-basic-offset
	(goto-char here)
	(skip-chars-forward "^:" eol)
	(if (= (following-char) ?:)
	    (+ curcol (- first-col-column (current-column)))
	  c-basic-offset)))))

(defun c-lineup-ObjC-method-args-2 (langelem)
  ;; Line up the colons that separate args. This is done trying to
  ;; align the colon on the current line with the previous one.
  (save-excursion
    (let* ((here (c-point 'boi))
	   (curcol (progn (goto-char here) (current-column)))
	   (eol (c-point 'eol))
	   (relpos (cdr langelem))
	   (prev-col-column (progn
			      (skip-chars-backward "^:" relpos)
			      (and (= (preceding-char) ?:)
				   (- (current-column) 1)))))
      (if (not prev-col-column)
	  c-basic-offset
	(goto-char here)
	(skip-chars-forward "^:" eol)
	(if (= (following-char) ?:)
	    (+ curcol (- prev-col-column (current-column)))
	  c-basic-offset)))))

(defun c-snug-do-while (syntax pos)
  "Dynamically calculate brace hanginess for do-while statements.
Using this function, `while' clauses that end a `do-while' block will
remain on the same line as the brace that closes that block.

See `c-hanging-braces-alist' for how to utilize this function as an
ACTION associated with `block-close' syntax."
  (save-excursion
    (let (langelem)
      (if (and (eq syntax 'block-close)
	       (setq langelem (assq 'block-close c-syntactic-context))
	       (progn (goto-char (cdr langelem))
		      (if (= (following-char) ?{)
			  (c-safe (forward-sexp -1)))
		      (looking-at "\\<do\\>[^_]")))
	  '(before)
	'(before after)))))


;;; This page handles insertion and removal of backslashes for C macros.

(defun c-backslash-region (from to delete-flag)
  "Insert, align, or delete end-of-line backslashes on the lines in the region.
With no argument, inserts backslashes and aligns existing backslashes.
With an argument, deletes the backslashes.

This function does not modify the last line of the region if the region ends 
right at the start of the following line; it does not modify blank lines
at the start of the region.  So you can put the region around an entire macro
definition and conveniently use this command."
  (interactive "r\nP")
  (save-excursion
    (goto-char from)
    (let ((column c-backslash-column)
          (endmark (make-marker)))
      (move-marker endmark to)
      ;; Compute the smallest column number past the ends of all the lines.
      (if (not delete-flag)
          (while (< (point) to)
            (end-of-line)
            (if (= (preceding-char) ?\\)
                (progn (forward-char -1)
                       (skip-chars-backward " \t")))
            (setq column (max column (1+ (current-column))))
            (forward-line 1)))
      ;; Adjust upward to a tab column, if that doesn't push past the margin.
      (if (> (% column tab-width) 0)
          (let ((adjusted (* (/ (+ column tab-width -1) tab-width) tab-width)))
            (if (< adjusted (window-width))
                (setq column adjusted))))
      ;; Don't modify blank lines at start of region.
      (goto-char from)
      (while (and (< (point) endmark) (eolp))
        (forward-line 1))
      ;; Add or remove backslashes on all the lines.
      (while (and (< (point) endmark)
                  ;; Don't backslashify the last line
                  ;; if the region ends right at the start of the next line.
                  (save-excursion
                    (forward-line 1)
                    (< (point) endmark)))
        (if (not delete-flag)
            (c-append-backslash column)
          (c-delete-backslash))
        (forward-line 1))
      (move-marker endmark nil))))

(defun c-append-backslash (column)
  (end-of-line)
  ;; Note that "\\\\" is needed to get one backslash.
  (if (= (preceding-char) ?\\)
      (progn (forward-char -1)
             (delete-horizontal-space)
             (indent-to column))
    (indent-to column)
    (insert "\\")))

(defun c-delete-backslash ()
  (end-of-line)
  (or (bolp)
      (progn
 	(forward-char -1)
 	(if (looking-at "\\\\")
 	    (delete-region (1+ (point))
 			   (progn (skip-chars-backward " \t") (point)))))))


;; defuns for submitting bug reports

(defconst c-version (concat "4.282"
			    " as included in "
			    emacs-version)
  "cc-mode version number.")
(defconst c-mode-help-address "bug-gnu-emacs@prep.ai.mit.edu"
  "Address for cc-mode bug reports.")

(defun c-version ()
  "Echo the current version of cc-mode in the minibuffer."
  (interactive)
  (message "Using cc-mode version %s" c-version)
  (c-keep-region-active))

;; get reporter-submit-bug-report when byte-compiling
(eval-when-compile
  (require 'reporter))

(defun c-submit-bug-report ()
  "Submit via mail a bug report on cc-mode."
  (interactive)
  ;; load in reporter
  (let ((reporter-prompt-for-summary-p t)
	(reporter-dont-compact-list '(c-offsets-alist)))
    (and
     (if (y-or-n-p "Do you want to submit a report on cc-mode? ")
	 t (message "") nil)
     (require 'reporter)
     (reporter-submit-bug-report
      c-mode-help-address
      (concat "cc-mode " c-version " ("
	      (cond ((eq major-mode 'c++-mode)  "C++")
		    ((eq major-mode 'c-mode)    "C")
		    ((eq major-mode 'objc-mode) "ObjC")
		    ((eq major-mode 'java-mode) "Java")
		    )
	      ")")
      (let ((vars (list
		   ;; report only the vars that affect indentation
		   'c-basic-offset
		   'c-offsets-alist
		   'c-block-comments-indent-p
		   'c-cleanup-list
		   'c-comment-only-line-offset
		   'c-backslash-column
		   'c-delete-function
		   'c-electric-pound-behavior
		   'c-hanging-braces-alist
		   'c-hanging-colons-alist
		   'c-hanging-comment-ender-p
		   'c-tab-always-indent
		   'c-recognize-knr-p
		   'defun-prompt-regexp
		   'tab-width
		   )))
	(if (not (boundp 'defun-prompt-regexp))
	    (delq 'defun-prompt-regexp vars)
	  vars))
      (function
       (lambda ()
	 (insert
	  (if c-special-indent-hook
	      (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n"
		      "c-special-indent-hook is set to '"
		      (format "%s" c-special-indent-hook)
		      ".\nPerhaps this is your problem?\n"
		      "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n")
	    "\n")
	  (format "c-emacs-features: %s\n" c-emacs-features)
	  )))
      nil
      "Dear Barry,"
      ))))


;; menus for XEmacs 19
(defun c-popup-menu (e)
  "Pops up the C/C++/ObjC menu."
  (interactive "@e")
  (popup-menu (cons (concat mode-name " Mode Commands") c-mode-menu))
  (c-keep-region-active))
    

(defun c-copy-tree (tree)
  ;; Lift XEmacs 19.12's copy-tree
  (if (consp tree)
      (cons (c-copy-tree (car tree))
	    (c-copy-tree (cdr tree)))
    (if (vectorp tree)
	(let* ((new (copy-sequence tree))
	       (i (1- (length new))))
	  (while (>= i 0)
	    (aset new i (c-copy-tree (aref new i)))
	    (setq i (1- i)))
	  new)
      tree)))

(defun c-mapcar-defun (var)
  (let ((val (symbol-value var)))
    (cons var (if (atom val) val
		;; XEmacs 19.12 and Emacs 19 + lucid.el have this
		(if (fboundp 'copy-tree)
		    (copy-tree val)
		  ;; Emacs 19 and Emacs 18
		  (c-copy-tree val)
		  )))
    ))

;; Dynamically append the default value of most variables. This is
;; crucial because future c-set-style calls will always reset the
;; variables first to the `cc-mode' style before instituting the new
;; style.  Only do this once!
(or (assoc "cc-mode" c-style-alist)
    (progn
      (c-add-style "cc-mode"
		   (mapcar 'c-mapcar-defun
			   '(c-backslash-column
			     c-basic-offset
			     c-block-comments-indent-p
			     c-cleanup-list
			     c-comment-only-line-offset
			     c-echo-syntactic-information-p
			     c-electric-pound-behavior
			     c-hanging-braces-alist
			     c-hanging-colons-alist
			     c-hanging-comment-ender-p
			     c-offsets-alist
			     c-recognize-knr-p
			     c-strict-syntax-p
			     c-tab-always-indent
			     c-inhibit-startup-warnings-p
			     )))
      ;; the default style is now GNU.  This can be overridden in
      ;; c-mode-common-hook or {c,c++,objc}-mode-hook.
      (c-set-style c-site-default-style)))

;; style variables
(make-variable-buffer-local 'c-offsets-alist)
(make-variable-buffer-local 'c-basic-offset)
(make-variable-buffer-local 'c-file-style)
(make-variable-buffer-local 'c-file-offsets)
(make-variable-buffer-local 'c-comment-only-line-offset)
(make-variable-buffer-local 'c-block-comments-indent-p)
(make-variable-buffer-local 'c-cleanup-list)
(make-variable-buffer-local 'c-hanging-braces-alist)
(make-variable-buffer-local 'c-hanging-colons-alist)
(make-variable-buffer-local 'c-hanging-comment-ender-p)
(make-variable-buffer-local 'c-backslash-column)



;; fsets for compatibility with BOCM
(fset 'electric-c-brace      'c-electric-brace)
(fset 'electric-c-semi       'c-electric-semi&comma)
(fset 'electric-c-sharp-sign 'c-electric-pound)
;; there is no cc-mode equivalent for electric-c-terminator
(fset 'mark-c-function       'c-mark-function)
(fset 'indent-c-exp          'c-indent-exp)
;;;###autoload (fset 'set-c-style           'c-set-style)
;; Lucid Emacs 19.9 + font-lock + cc-mode - c++-mode lossage
(fset 'c++-beginning-of-defun 'beginning-of-defun)
(fset 'c++-end-of-defun 'end-of-defun)

;; set up bc warnings for obsolete variables, but for now lets not
;; worry about obsolete functions.  maybe later some will be important
;; to flag
(and (memq 'v19 c-emacs-features)
     (let* ((na "Nothing appropriate.")
	    (vars
	     (list
	      (cons 'c++-c-mode-syntax-table 'c-mode-syntax-table)
	      (cons 'c++-tab-always-indent 'c-tab-always-indent)
	      (cons 'c++-always-arglist-indent-p na)
	      (cons 'c++-block-close-brace-offset 'c-offsets-alist)
	      (cons 'c++-paren-as-block-close-p na)
	      (cons 'c++-continued-member-init-offset 'c-offsets-alist)
	      (cons 'c++-member-init-indent 'c-offsets-alist)
	      (cons 'c++-friend-offset na)
	      (cons 'c++-access-specifier-offset 'c-offsets-alist)
	      (cons 'c++-empty-arglist-indent 'c-offsets-alist)
	      (cons 'c++-comment-only-line-offset 'c-comment-only-line-offset)
	      (cons 'c++-C-block-comments-indent-p 'c-block-comments-indent-p)
	      (cons 'c++-cleanup-list 'c-cleanup-list)
	      (cons 'c++-hanging-braces 'c-hanging-braces-alist)
	      (cons 'c++-hanging-member-init-colon 'c-hanging-colons-alist)
	      (cons 'c++-auto-hungry-initial-state
		    "Use `c-auto-newline' and `c-hungry-delete-key' instead.")
	      (cons 'c++-auto-hungry-toggle na)
	      (cons 'c++-relative-offset-p na)
	      (cons 'c++-special-indent-hook 'c-special-indent-hook)
	      (cons 'c++-delete-function 'c-delete-function)
	      (cons 'c++-electric-pound-behavior 'c-electric-pound-behavior)
	      (cons 'c++-hungry-delete-key 'c-hungry-delete-key)
	      (cons 'c++-auto-newline 'c-auto-newline)
	      (cons 'c++-match-header-strongly na)
	      (cons 'c++-defun-header-strong-struct-equivs na)
	      (cons 'c++-version 'c-version)
	      (cons 'c++-mode-help-address 'c-mode-help-address)
	      (cons 'c-indent-level 'c-basic-offset)
	      (cons 'c-brace-imaginary-offset na)
	      (cons 'c-brace-offset 'c-offsets-alist)
	      (cons 'c-argdecl-indent 'c-offsets-alist)
	      (cons 'c-label-offset 'c-offsets-alist)
	      (cons 'c-continued-statement-offset 'c-offsets-alist)
	      (cons 'c-continued-brace-offset 'c-offsets-alist)
	      (cons 'c-default-macroize-column 'c-backslash-column)
	      (cons 'c++-default-macroize-column 'c-backslash-column)
	      )))
       (mapcar
	(function
	 (lambda (elt)
	   (make-obsolete-variable (car elt) (cdr elt))))
	vars)))

(provide 'cc-mode)
;;; cc-mode.el ends here

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

;; Copyright (C) 1992, 1993, 1994 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 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
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs 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.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;;_* Commentary:

;; Allout outline mode provides extensive outline formatting and
;; manipulation capabilities, subsuming and well beyond that of
;; standard emacs outline mode.  It is specifically aimed at
;; supporting outline structuring and manipulation of syntax-
;; sensitive text, eg programming languages.  (For an example, see the
;; allout code itself, which is organized in outline structure.)
;; 
;; It also includes such things as topic-oriented repositioning, cut, and
;; paste; integral outline exposure-layout; incremental search with
;; dynamic exposure/concealment of concealed text; automatic topic-number
;; maintenance; and many other features.
;; 
;; See the docstring of the variables `outline-layout' and
;; `outline-auto-activation' for details on automatic activation of
;; allout outline-mode as a minor mode.  (It has changed since allout
;; 3.x, for those of you that depend on the old method.)
;;
;; Note - the lines beginning with ';;;_' are outline topic headers.
;;        Just 'ESC-x eval-current-buffer' to give it a whirl.

;;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

;;;_* Provide
(provide 'outline)
(provide 'allout)

;;;_* USER CUSTOMIZATION VARIABLES:

;;;_ + Layout, Mode, and Topic Header Configuration

;;;_  = outline-auto-activation
(defvar outline-auto-activation nil
  "*Regulates auto-activation modality of allout outlines - see `outline-init'.

Setq-default by `outline-init' to regulate whether or not allout
outline mode is automatically activated when the buffer-specific
variable `outline-layout' is non-nil, and whether or not the layout
dictated by `outline-layout' should be imposed on mode activation.

With value `t', auto-mode-activation and auto-layout are enabled.
\(This also depends on `outline-find-file-hooks' being installed in
`find-file-hooks', which is also done by `outline-init'.)

With value `ask', auto-mode-activation is enabled, and endorsement for
performing auto-layout is asked of the user each time.

With value `activate', only auto-mode-activation is enabled, auto-
layout is not.

With value `nil', neither auto-mode-activation nor auto-layout are
enabled.

See the docstring for `outline-init' for the proper interface to
this variable.")
;;;_  = outline-layout
(defvar outline-layout nil
  "*Layout specification and provisional mode trigger for allout outlines.

Buffer-specific.

A list value specifies a default layout for the current buffer, to be
applied upon activation of allout outline-mode.  Any non-nil value
will automatically trigger allout outline-mode, provided `outline-
init' has been called to enable it.

See the docstring for `outline-init' for details on setting up for
auto-mode-activation, and for `outline-expose-topic' for the format of
the layout specification.

You can associate a particular outline layout with a file by setting
this var via the file's local variables.  For example, the following
lines at the bottom of an Emacs Lisp file:

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

will, modulo the above-mentioned conditions, cause the mode to be
activated when the file is visited, followed by the equivalent of
`\(outline-expose-topic 0 : -1 -1 0\)'.  \(This is the layout used for
the allout.el, itself.)

Also, allout's mode-specific provisions will make topic prefixes
default to the comment-start string, if any, of the language of the
file.  This is modulo the setting of `outline-use-mode-specific-
leader', which see.") 
(make-variable-buffer-local 'outline-layout)

;;;_  = outline-header-prefix
(defvar outline-header-prefix "."
  "*Leading string which helps distinguish 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.  Many
outlines start at level 2 to avoid this discrepancy.")
(make-variable-buffer-local 'outline-header-prefix)
;;;_  = outline-primary-bullet
(defvar outline-primary-bullet "*"
  "Bullet used for top-level outline topics.

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 compatibility
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 (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, ']', as a 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 "=>([{}&!?#%\"X@$~\\"
  "*Persistent outline header bullets used to distinguish special topics.

These bullets are not offered among the regular, level-specific
rotation, and are not altered by automatic rebulleting, as when
shifting the level of a topic.  See `outline-plain-bullets-string' for
the selection of alternating bullets.

You must run 'set-outline-regexp' in order for changes
to the value of this var to effect outline-mode operation.

DO NOT include the close-square-bracket, ']', on either of the bullet
strings.")
(make-variable-buffer-local 'outline-distinctive-bullets-string)

;;;_  = outline-use-mode-specific-leader
(defvar outline-use-mode-specific-leader t
  "*When non-nil, use mode-specific topic-header prefixes.

Allout outline mode will use the mode-specific `outline-mode-leaders'
and/or comment-start string, if any, to lead the topic prefix string,
so topic headers look like comments in the programming language. 

String values are used as they stand.

Value `t' means to first check for assoc value in `outline-mode-leaders'
alist, then use comment-start string, if any, then use default \(`.').
\(See note about use of comment-start strings, below.\)

Set to the symbol for either of `outline-mode-leaders' or
`comment-start' to use only one of them, respectively.

Value `nil' means to always use the default \(`.'\).

comment-start strings that do not end in spaces are tripled, and an
'_' underscore is tacked on the end, to distinguish them from regular
comment strings.  comment-start strings that do end in spaces are not
tripled, but an underscore is substituted for the space.  \[This
presumes that the space is for appearance, not comment syntax.  You
can use `outline-mode-leaders' to override this behavior, when
incorrect.\]")
;;;_  = outline-mode-leaders
(defvar outline-mode-leaders '()
  "Specific outline-prefix leading strings per major modes.

Entries will be used in the stead (or lieu) of mode-specific
comment-start strings.  See also `outline-use-mode-specific-leader'.

If you're constructing a string that will comment-out outline
structuring so it can be included in program code, append an extra
character, like an \"_\" underscore, to distinguish the lead string
from regular comments that start at bol.")

;;;_  = outline-old-style-prefixes
(defvar outline-old-style-prefixes nil
  "*When non-nil, use only old-and-crusty outline-mode '*' topic 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.

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-stylish-prefixes - alternating bullets
(defvar outline-stylish-prefixes t
  "*Do fancy stuff with topic prefix bullets according to level, etc.

Non-nil enables topic creation, modification, and repositioning
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 (but sans indentation) with stylish
prefixes:

    * Top level
    .* A topic
    . + One level 3 subtopic
    .  . One level 4 subtopic
    .  . A second 4 subtopic
    . + Another level 3 subtopic
    .  #1 A numbered level 4 subtopic
    .  #2 Another
    .  ! Another level 4 subtopic with a different distinctive bullet
    .  #4 And another numbered level 4 subtopic

This would be an outline with stylish prefixes inhibited (but the
numbered and other distinctive bullets retained):

    * Top level
    .* A topic
    . * One level 3 subtopic
    .  * One level 4 subtopic
    .  * A second 4 subtopic
    . * Another level 3 subtopic
    .  #1 A numbered level 4 subtopic
    .  #2 Another
    .  ! Another level 4 subtopic with a different distinctive bullet
    .  #4 And another numbered level 4 subtopic

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)

;;;_  = outline-numbered-bullet
(defvar outline-numbered-bullet "#"
  "*String designating bullet of topics that have auto-numbering; nil for none.

Topics having this bullet have automatic maintenance 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 maintenance.")
(make-variable-buffer-local 'outline-numbered-bullet)
;;;_  = outline-file-xref-bullet
(defvar outline-file-xref-bullet "@"
  "*Bullet signifying file cross-references, for `outline-resolve-xref'.

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.

These bindings 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:
        ("?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-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:
        (" " outline-open-sibtopic)
        ("." outline-open-subtopic)
        ("," outline-open-supertopic)
        ("'" outline-shift-in)
        (">" outline-shift-in)
        ("<" outline-shift-out)
        ("\C-m" outline-rebullet-topic)
        ("*" 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-@" 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.")

;;;_  = outline-enwrap-isearch-mode
(defvar outline-enwrap-isearch-mode t
  "*Set non-nil to enable automatic exposure of concealed isearch targets.

If non-nil, isearch will expose hidden text encountered in the course
of a search, and to reconceal it if the search is continued past it.")

;;;_  = outline-use-hanging-indents
(defvar outline-use-hanging-indents t
  "*If non-nil, topic body text auto-indent defaults to indent 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)

;;;_  = 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.

Outline mode uses emacs change-triggered functions to detect unruly
changes to concealed regions.  Set this var non-nil to disable the
protection, potentially increasing text-entry responsiveness a bit.

This var takes effect at outline-mode activation, so you may have to
deactivate and then reactivate the mode if you want to toggle the
behavior.")

;;;_* CODE - no user customizations below.

;;;_ #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)))
    (if here (insert-string msg))
    (message "%s" msg)
    msg))
;;;_  - 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.")
(make-variable-buffer-local 'outline-regexp)
;;;_   = 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 produced from the elements of 'outline-plain-bullets-string'
and 'outline-distinctive-bullets-string'.")
(make-variable-buffer-local 'outline-bullets-string)
;;;_   = 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.")
(make-variable-buffer-local 'outline-line-boundary-regexp)
;;;_   = outline-bob-regexp
(defvar outline-bob-regexp ()
  "Like outline-line-boundary-regexp, for headers at beginning of buffer.
\(match-beginning 2) and (match-end 2) delimit the prefix.")
(make-variable-buffer-local 'outline-bob-regexp)
;;;_   = outline-header-subtraction
(defvar outline-header-subtraction (1- (length outline-header-prefix))
  "Outline-header prefix length to subtract when computing topic depth.")
(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)


;;;_   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."

  (interactive "P")
  (if (not (stringp header-lead))
      (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
					  t)))
			      outline-use-mode-specific-leader
			    ;; Oops - garbled value, equate with effect of 't:
			    t)))
	 (leader
	  (cond
	   ((not use-leader) nil)
	   ;; Use the explicitly designated leader:
	   ((stringp use-leader) use-leader)
	   (t (or (and (memq use-leader '(t outline-mode-leaders))
		       ;; Get it from outline mode leaders?
		       (cdr (assq major-mode outline-mode-leaders)))
		  ;; ... didn't get from outline-mode-leaders...
		  (and (memq use-leader '(t comment-start))
		       comment-start
		       ;; Use comment-start, maybe tripled, and with
		       ;; underscore: 
		       (concat
			(if (string= " "
				     (substring comment-start
						(1- (length comment-start))))
			    ;; Use comment-start, sans trailing space:
			    (substring comment-start 0 -1)
			  (concat comment-start comment-start comment-start))
			;; ... and append underscore, whichever:
			"_")))))))
    (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-distinctive-bullets-string'."

  (interactive)
  ;; Derive outline-bullets-string from user configured components:
  (setq outline-bullets-string "")
  (let ((strings (list 'outline-plain-bullets-string
                       'outline-distinctive-bullets-string))
        cur-string
        cur-len
        cur-char
        cur-char-string
        index
        new-string)
    (while strings
      (setq new-string "") (setq index 0)
      (setq cur-len (length (setq cur-string (symbol-value (car strings)))))
      (while (< index cur-len)
        (setq cur-char (aref cur-string index))
        (setq outline-bullets-string
              (concat outline-bullets-string
                      (cond
                                        ; Single dash would denote a
                                        ; sequence, repeated denotes
                                        ; a dash:
                       ((eq cur-char ?-) "--")
                                        ; literal close-square-bracket
                                        ; doesn't work right in the
                                        ; expr, exclude it:
                       ((eq cur-char ?\]) "")
                       (t (regexp-quote  (char-to-string cur-char))))))
        (setq index (1+ index)))
      (setq strings (cdr strings)))
    )
  ;; Derive next for repeated use in outline-pending-bullet:
  (setq outline-plain-bullets-string-len (length outline-plain-bullets-string))
  (setq outline-header-subtraction (1- (length outline-header-prefix)))
  ;; Produce the new outline-regexp:
  (setq outline-regexp (concat "\\(\\"
                               outline-header-prefix
                               "[ \t]*["
                               outline-bullets-string
                               "]\\)\\|\\"
                               outline-primary-bullet
                               "+\\|\^l"))
  (setq outline-line-boundary-regexp
        (concat "\\([\n\r]\\)\\(" outline-regexp "\\)"))
  (setq outline-bob-regexp
        (concat "\\(\\`\\)\\(" outline-regexp "\\)"))
  )
;;;_  - Key bindings
;;;_   = outline-mode-map
(defvar outline-mode-map nil "Keybindings for (allout) outline minor mode.")
;;;_   > 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-prior-bindings - being deprecated.
(defvar outline-prior-bindings nil 
  "Variable for use in V18, with outline-added-bindings, for
resurrecting, on mode deactivation, bindings that existed before
activation.  Being deprecated.")
;;;_   = outline-added-bindings - being deprecated
(defvar outline-added-bindings nil 
  "Variable for use in V18, with outline-prior-bindings, for
resurrecting, on mode deactivation, bindings that existed before
activation.  Being deprecated.")
;;;_  - Mode-Specific Variable Maintenance Utilities
;;;_   = outline-mode-prior-settings
(defvar outline-mode-prior-settings nil
  "Internal outline mode use; settings to be resumed on mode deactivation.")
(make-variable-buffer-local 'outline-mode-prior-settings)
;;;_   > outline-resumptions (name &optional value)
(defun outline-resumptions (name &optional value)

  "Registers or resumes settings over outline-mode activation/deactivation.

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
                                        ; containing a value, so we can
                                        ; distinguish nil from no value.
        )

    (if value

        ;; Registering:
        (progn
          (if on-list
              nil 	; Already preserved prior value - don't mess with it.
            ;; Register the old value, or nil if previously unbound:
            (setq outline-mode-prior-settings
                  (cons (list name
                              (if (boundp name) (list (symbol-value name))))
                        outline-mode-prior-settings)))
                                        ; And impose the new value, locally:
	  (progn (make-local-variable name)
		 (set name (car value))))

      ;; Relinquishing:
      (if (not on-list)

          ;; Oops, not registered - leave it be:
          nil

        ;; Some registration:
                                        ; reestablish it:
        (setq prior-capsule (car (cdr on-list)))
        (if prior-capsule
            (set name (car prior-capsule)) ; Some prior value - reestablish it.
          (makunbound name))		; Previously unbound - demolish var.
                                        ; Remove registration:
        (let (rebuild)
          (while outline-mode-prior-settings
            (if (not (eq (car outline-mode-prior-settings)
                         on-list))
                (setq rebuild
                      (cons (car outline-mode-prior-settings)
                            rebuild)))
            (setq outline-mode-prior-settings
                  (cdr outline-mode-prior-settings)))
          (setq outline-mode-prior-settings rebuild)))))
  )
;;;_  - Mode-specific incidentals
;;;_   = outline-during-write-cue nil
(defvar outline-during-write-cue nil
  "Used to inhibit outline change-protection during file write.

See also `outline-post-command-business', `outline-write-file-hook',
`outline-before-change-protect', and `outline-post-command-business'
functions.")
;;;_   = outline-override-protect nil
(defvar outline-override-protect nil
  "Used in outline-mode for regulate of concealed-text protection mechanism.

Allout outline mode regulates alteration of concealed text to protect
against inadvertent, unnoticed changes.  This is for use by specific,
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)
;;;_   = file-var-bug hack
(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.")
;;;_   > 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)

;;;_ #2 Mode activation
;;;_  = outline-mode
(defvar outline-mode () "Allout outline mode minor-mode flag.")
(make-variable-buffer-local 'outline-mode)
;;;_  > outline-mode-p ()
(defmacro outline-mode-p ()
  "Return t if outline-mode is active in current buffer."
  'outline-mode)
;;;_  = outline-explicitly-deactivated
(defvar outline-explicitly-deactivated nil
  "Outline-mode was last deliberately deactivated.
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 solicited 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).

`outline-init' works by setting up (or removing) the outline-mode
find-file-hook, and giving `outline-auto-activation' a suitable
setting.

To prime your emacs session for full auto-outline operation, include
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.

Optional arg forces mode reactivation iff arg is positive num or symbol.

Allout outline mode provides extensive outline formatting and
manipulation capabilities.  It is specifically aimed at supporting
outline structuring and manipulation of syntax-sensitive text, eg
programming languages.  \(For an example, see the allout code itself,
which is organized in outline structure.\)

It also includes such things as topic-oriented repositioning, cut, and
paste; integral outline exposure-layout; incremental search with
dynamic exposure/concealment of concealed text; automatic topic-number
maintenance; and many other features.

See the docstring of the variable `outline-init' for instructions on
priming your emacs session for automatic activation of outline-mode,
according to file-var settings of the `outline-layout' variable.

Below is a description of the bindings, and then explanation of
special outline-mode features and terminology.

The bindings themselves are established according to the values of
variables `outline-keybindings-list' and `outline-command-prefix',
each time the mode is invoked.  Prior bindings are resurrected when
the mode is revoked.

	Navigation:				   Exposure Control:
	----------                                 ----------------
C-c C-n outline-next-visible-heading     | C-c C-h outline-hide-current-subtree
C-c C-p outline-previous-visible-heading | C-c C-i outline-show-children
C-c C-u outline-up-current-level         | C-c C-s outline-show-current-subtree
C-c C-f outline-forward-current-level    | C-c C-o outline-show-current-entry
C-c C-b outline-backward-current-level   | ^U C-c C-s outline-show-all
C-c C-e outline-end-of-current-entry     |	   outline-hide-current-leaves
C-c C-a outline-beginning-of-current-entry, alternately, goes to hot-spot

	Topic Header Production:
	-----------------------
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 topic's parent.

	Topic Level and Prefix Adjustment:
	---------------------------------
C-c >	outline-shift-in	Shift current topic and all offspring deeper.
C-c <	outline-shift-out	... less deep.
C-c<CR>	outline-rebullet-topic	Reconcile bullets of topic and its' offspring
				- distinctive bullets are not changed, others
				  alternated according to nesting depth.
C-c *	outline-rebullet-current-heading Prompt for alternate bullet for
					 current topic.
C-c #	outline-number-siblings	Number bullets of topic and siblings - the
				offspring are not affected.  With repeat
				count, revoke numbering.

	Topic-oriented Killing and Yanking:
	----------------------------------
C-c C-k	outline-kill-topic	Kill current topic, including offspring.
C-k	outline-kill-line	Like kill-line, but reconciles numbering, etc.
C-y	outline-yank		Yank, adjusting depth of yanked topic to
				depth of heading if yanking into bare topic
				heading (ie, prefix sans text).
M-y	outline-yank-pop	Is to outline-yank as yank-pop is to yank

	Misc commands:
	-------------
C-c @   outline-resolve-xref    pop-to-buffer named by xref (cf
				outline-file-xref-bullet)
C-c c	outline-copy-exposed	Copy current topic outline sans concealed
				text, to buffer with name derived from
				current buffer - \"XXX exposed\"
M-x outlineify-sticky		Activate outline mode for current buffer,
				and establish a default file-var setting
				for `outline-layout'.
ESC ESC (outline-init t)	Setup emacs session for outline mode
				auto-activation.

		 HOT-SPOT Operation

Hot-spot operation provides a means for easy, single-keystroke outline
navigation and exposure control.

\\<outline-mode-map>
When the text cursor is positioned directly on the bullet character of
a topic, regular characters (a to z) invoke the commands of the
corresponding outline-mode keymap control chars.  For example, \"f\"
would invoke the command typically bound to \"C-c C-f\"
\(\\[outline-forward-current-level] `outline-forward-current-level').

Thus, by positioning the cursor on a topic bullet, you can execute
the outline navigation and manipulation commands with a single
keystroke.  Non-literal chars never get this special translation, so
you can use them to get away from the hot-spot, and back to normal
operation.

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;
SUBTOPIC:
	An immediate offspring of a topic;
CHILDREN:
	The immediate offspring of a topic.
SIBLINGS:
	Topics having the same parent and depth.
	       
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.  See `outline-use-mode-specific-leader'
	docstring for more detail.
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, though its' offspring or body may be."
;;;_    . Code
  (interactive "P")

  (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 specifically 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)))
	 do-layout
	 )

				       ; See comments below re v19.18,.19 bug.
    (setq outline-v18/9-file-var-hack (car command-history))

    (cond

     ;; Provision for 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)
	  
     ;; Deactivation:
     ((and (not explicit-activation)
	  (or active toggle))
				       ; Activation not explicitly
				       ; requested, and either in
				       ; active state or *de*activation
				       ; specifically requested:
      (setq outline-explicitly-deactivated t)
      (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)
      (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 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))

     ;; Activation:
     ((not active)
      (setq outline-explicitly-deactivated nil)
      (if outline-old-style-prefixes
	  (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:
      (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)))
				       ; 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 "\\)")))
      (make-local-variable 'paragraph-separate)
      (outline-resumptions 'paragraph-separate
			  (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-layout
	  (setq do-layout t))

      (if outline-enwrap-isearch-mode
	  (outline-enwrap-isearch))

      (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)
	     (and (not (eq outline-auto-activation 'activate))
		  (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
;;; All the basic outline functions that directly do string matches to
;;; evaluate heading prefix location set the variables
;;; `outline-recent-prefix-beginning'  and `outline-recent-prefix-end'
;;; when successful.  Functions starting with `outline-recent-' all
;;; use 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
(defvar outline-recent-prefix-beginning 0
  "Buffer point of the start of the last topic prefix encountered.")
(make-variable-buffer-local 'outline-recent-prefix-beginning)
;;;_  = outline-recent-prefix-end
(defvar outline-recent-prefix-end 0
  "Buffer point of the end of the last topic prefix encountered.")
(make-variable-buffer-local 'outline-recent-prefix-end)
;;;_  = outline-recent-end-of-subtree
(defvar outline-recent-end-of-subtree 0
  "Buffer point last returned by outline-end-of-current-subtree.")
(make-variable-buffer-local 'outline-recent-end-of-subtree)
;;;_  > 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))

;;;_ #4 Navigation

;;;_  - Position Assessment
;;;_   : Location Predicates
;;;_    > outline-on-current-heading-p ()
(defun outline-on-current-heading-p ()
  "Return non-nil if point is on current visible topics' header line.

Actually, returns prefix beginning point."
  (save-excursion
    (beginning-of-line)
    (and (looking-at outline-regexp)
	 (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)
  '(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 nesting depth of visible topic most immediately containing point."
  '(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."
  (save-excursion
    (if (outline-goto-prefix)
	(outline-recent-prefix))))
;;;_    > outline-get-bullet ()
(defun outline-get-bullet ()
  "Return bullet of containing topic (visible or not)."
  (save-excursion
    (and (outline-goto-prefix)
	 (outline-recent-bullet))))
;;;_    > outline-current-bullet ()
(defun outline-current-bullet ()
  "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))
    ;; Quick and dirty provision, ostensibly for missing bullet:
    (args-out-of-range nil))
  )
;;;_    > outline-get-prefix-bullet (prefix)
(defun outline-get-prefix-bullet (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))))

;;;_  - 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-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."

  '(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 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 levels orig-depth prev-depth)
(defun outline-chart-subtree (&optional levels orig-depth prev-depth)
  "Produce a location \"chart\" of subtopics of the containing topic.

Optional argument LEVELS specifies the depth \(relative to start
depth\) for the chart.  Subsequent optional args are not for public
use.

Charts are used to capture outline structure, so that outline-altering
routines need assess the structure only once, and then use the chart
for their elaborate manipulations.

Topics are entered in the chart so the last one is at the car.
The entry for each topic consists of an integer indicating the point
at the beginning of the topic.  Charts for offspring consists of a
list containing, recursively, the charts for the respective subtopics.
The chart for a topics' offspring precedes the entry for the topic
itself.

The other function parameters are for internal recursion, and should
not be specified by external callers.  ORIG-DEPTH is depth of topic at
starting point, and PREV-DEPTH is depth of prior topic."

  (let ((original (not orig-depth))	; 'orig-depth' set only in recursion.
	chart curr-depth)

    (if original			; Just starting?
					; Register initial settings and
					; position to first offspring:
	(progn (setq orig-depth (outline-depth))
	       (or prev-depth (setq prev-depth (1+ orig-depth)))
	       (outline-next-heading)))

    ;; Loop over the current levels' siblings.  Besides being more
    ;; efficient than tail-recursing over a level, it avoids exceeding
    ;; the typically quite constrained emacs max-lisp-eval-depth.
    ;; Probably would speed things up to implement loop-based stack
    ;; operation rather than recursing for lower levels.  Bah.
    (while (and (not (eobp))
					; Still within original topic?
		(< orig-depth (setq curr-depth (outline-recent-depth)))
		(cond ((= prev-depth curr-depth)
		       ;; Register this one and move on:
		       (setq chart (cons (point) chart))
		       (if (and levels (<= levels 1))
			   ;; At depth limit - skip sublevels:
			   (or (outline-next-sibling curr-depth)
			       ;; or no more siblings - proceed to
			       ;; next heading at lesser depth:
			       (while (and (<= curr-depth
					       (outline-recent-depth))
					   (outline-next-heading))))
			 (outline-next-heading)))

		      ((and (< prev-depth curr-depth)
			    (or (not levels)
				(> levels 0)))
		       ;; Recurse on deeper level of curr topic:
		       (setq chart
			     (cons (outline-chart-subtree (and levels
							       (1- levels))
							  orig-depth
							  curr-depth)
				   chart))
		       ;; ... then continue with this one.
		       )

		      ;; ... else nil if we've ascended back to prev-depth.

		      )))

    (if original			; We're at the last sibling on
					; the original level.  Position
					; to the end of it:
	(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))
	       (setq outline-recent-end-of-subtree (point))))
    
    chart				; (nreverse chart) not necessary,
					; and maybe not preferable.
    ))
;;;_   > 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 hidden points in subtree CHART, up to DEPTH.

Note that point can be left 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))
;;;_   X outline-chart-spec (chart spec &optional exposing)
(defun outline-chart-spec (chart spec &optional exposing)
  "Not yet \(if ever\) implemented.

Produce exposure directives given topic/subtree CHART and an exposure SPEC.

Exposure spec indicates 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
   opened.
 - 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 immediately containing topic.

Goes to first subsequent topic if none immediately containing.

Not sensitive to topic visibility.

Returns a the point at the beginning of the prefix, or nil if none."

  (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 (bobp)
	(cond ((looking-at outline-regexp)
	       (outline-prefix-data (match-beginning 0)(match-end 0)))
	      ((outline-next-heading)
	       (outline-prefix-data (match-beginning 0)(match-end 0)))
	      (done))
      done)))
;;;_   > outline-end-of-prefix ()
(defun outline-end-of-prefix (&optional ignore-decorations)
  "Position cursor at beginning of header text.

If optional IGNORE-DECORATIONS is non-nil, put just after bullet,
otherwise skip white space between bullet and ensuing text."

  (if (not (outline-goto-prefix))
      nil
    (let ((match-data (match-data)))
      (goto-char (match-end 0))
      (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-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 topic, or beginning if already on the line."

  (beginning-of-line)
  (prog1 (or (outline-on-current-heading-p)
             (and (re-search-backward (concat "^\\(" outline-regexp "\\)")
                                      nil
                                      'move)
                  (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."

  (if (re-search-forward outline-line-boundary-regexp nil 'move)
      (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."
  (interactive)
  (outline-back-to-current-heading)
  (let ((level (outline-recent-depth)))
    (outline-next-heading)
    (while (and (not (eobp))
                (> (outline-recent-depth) level))
      (outline-next-heading))
    (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))
    (setq outline-recent-end-of-subtree (point))))
;;;_   > outline-beginning-of-current-entry ()
(defun outline-beginning-of-current-entry ()
  "When not already there, position point at beginning of current topic's body.

If already there, move cursor to bullet for hot-spot operation.
\(See outline-mode doc string for details on hot-spot operation.)"
  (interactive)
  (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 topics' entry."
  (interactive)
  (outline-show-entry)
  (prog1 (outline-pre-next-preface)
    (if (and (not (bobp))(looking-at "^$"))
        (forward-char -1))))

;;;_  - Depth-wise
;;;_   > outline-ascend-to-depth (depth)
(defun outline-ascend-to-depth (depth)
  "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))
                    (setq last-good (point))
                    (outline-beginning-of-level)
                    (outline-previous-heading)))
        (if (= (outline-recent-depth) depth)
            (progn (goto-char outline-recent-prefix-beginning)
                   depth)
          (goto-char last-good)
          nil))
    (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."
  (let ((start-point (point))
        (start-depth (outline-depth)))
    (while
        (and (> (outline-depth) 0)
             (not (= depth (outline-recent-depth))) ; ... not there yet
             (outline-next-heading)     ; ... go further
             (< start-depth (outline-recent-depth)))) ; ... still in topic
    (if (and (> (outline-depth) 0)
             (= (outline-recent-depth) depth))
        depth
      (goto-char start-point)
      nil))
  )
;;;_   > outline-up-current-level (arg &optional dont-complain)
(defun outline-up-current-level (arg &optional dont-complain)
  "Move out ARG levels from current visible topic.

Positions on heading line of containing topic.  Error if unable to
ascend that far, or nil if unable to ascend but optional arg
DONT-COMPLAIN is non-nil."
  (interactive "p")
  (outline-back-to-current-heading)
  (let ((present-level (outline-recent-depth))
	(last-good (point))
	failed
	return)
    ;; Loop for iterating arg:
    (while (and (> (outline-recent-depth) 1)
                (> arg 0)
                (not (bobp))
		(not failed))
      (setq last-good (point))
      ;; Loop for going back over current or greater depth:
      (while (and (not (< (outline-recent-depth) present-level))
		  (or (outline-previous-visible-heading 1)
		      (not (setq failed present-level)))))
      (setq present-level (outline-current-depth))
      (setq arg (- arg 1)))
    (if (or failed
	    (> arg 0))
	(progn (goto-char last-good)
	       (if (interactive-p) (outline-end-of-prefix))
	       (if (not dont-complain)
		   (error "Can't ascend past outermost level.")
		 (if (interactive-p) (outline-end-of-prefix))
		 nil))
      (if (interactive-p) (outline-end-of-prefix))
      outline-recent-prefix-beginning)))

;;;_  - Linear
;;;_   > outline-next-sibling (&optional depth backward)
(defun outline-next-sibling (&optional depth backward)
  "Like outline-forward-current-level, but respects invisible topics.

Traverse at optional DEPTH, or current depth if none specified.

Go backward if optional arg BACKWARD is non-nil.

Return depth if successful, nil otherwise."

  (if (and backward (bobp))
      nil
    (let ((start-depth (or depth (outline-depth)))
          (start-point (point))
	  last-depth)
      (while (and (not (if backward (bobp) (eobp)))
                  (if backward (outline-previous-heading)
                    (outline-next-heading))
                  (> (setq last-depth (outline-recent-depth)) start-depth)))
      (if (and (not (eobp))
               (and (> (or last-depth (outline-depth)) 0)
                    (= (outline-recent-depth) start-depth)))
          outline-recent-prefix-beginning
        (goto-char start-point)
	(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 backwards & respect invisible topics.

Optional DEPTH specifies depth to traverse, default current depth.

Optional BACKWARD reverses direction.

Return depth if successful, nil otherwise."
  (outline-next-sibling depth (not backward))
  )
;;;_   > outline-snug-back ()
(defun outline-snug-back ()
  "Position cursor at end of previous topic

Presumes point is 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."
  (outline-end-of-level '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."

  (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 ARG'th visible heading line, backward if arg is negative.

Move as far as possible in indicated direction \(beginning or end of
buffer\) if headings are exhausted."

  (interactive "p")
  (let* ((backward (if (< arg 0) (setq arg (* -1 arg))))
	 (step (if backward -1 1))
	 (start-point (point))
	 prev got)

    (while (> arg 0)			; limit condition
      (while (and (not (if backward (bobp)(eobp))) ; boundary condition
		  ;; Move, skipping over all those concealed lines:
		  (< -1 (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.

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 point at the next heading of the same level.

Takes optional repeat-count, goes backward if count is negative.

Returns resulting position, else nil if none found."
  (interactive "p")
  (let ((start-depth (outline-current-depth))
	(start-point (point))
	(start-arg arg)
	(backward (> 0 arg))
	last-depth
	(last-good (point))
	at-boundary)
    (if (= 0 start-depth)
	(error "No siblings, not in a topic..."))
    (if backward (setq arg (* -1 arg)))
    (while (not (or (zerop arg)
		    at-boundary))
      (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)
	       (not (if backward (bobp) (eobp))))
	  (setq last-good (point)
		arg (1- arg))
	(setq at-boundary t)))
    (if (and (not (eobp))
	     (= arg 0)
	     (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 "Hit %s level %d topic, traversed %d of %d requested."
	       (if backward "first" "last")
	       (outline-recent-depth)
	       (- (abs start-arg) arg)
	       (abs start-arg))))))
;;;_   > outline-backward-current-level (arg)
(defun outline-backward-current-level (arg)
  "Inverse of `outline-forward-current-level'."
  (interactive "p")
  (if (interactive-p)
      (let ((current-prefix-arg (* -1 arg)))
	(call-interactively 'outline-forward-current-level))
    (outline-forward-current-level (* -1 arg))))

;;;_ #5 Alteration

;;;_  - Fundamental
;;;_   > outline-before-change-protect (beg end)
(defun outline-before-change-protect (beg end)
  "Outline before-change hook, regulates changes to concealed text.

Reveal concealed text that would be changed by current command, 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...")
		   (if (outline-hidden-p)
		       (outline-show-children))
		   (message "Undo!"))
	  (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, for `outline-pre-command-business' hot-spot operation.

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 ()
  "Outline post-command-hook function.

- Null outline-override-protect, so it's not left open.

- Implement (and clear) 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 (not (outline-mode-p))		; In outline-mode.
      nil
    (setq outline-override-protect nil)
    (if outline-during-write-cue
	;; Was used by outline-before-change-protect, done with it now:
	(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 ()
  "Outline 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 (boundp 'outline-mode)
	   outline-mode
	   (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)))))
;;;_   > outline-find-file-hook ()
(defun outline-find-file-hook ()
  "Activate outline-mode when `outline-auto-activation' & `outline-layout' are non-nil.

See `outline-init' for setup instructions."
  (if (and outline-auto-activation
	   (not (outline-mode-p))
	   outline-layout)
      (outline-mode t)))
;;;_   : Establish the hooks
(add-hook 'post-command-hook 'outline-post-command-business)
(add-hook 'pre-command-hook 'outline-pre-command-business)

;;;_  - 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.

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): "
			  sans-escapes
                          default-bullet)
		  sans-escapes
                  t)))
    (if (string= choice "") default-bullet choice))
  )
;;;_   > outline-sibling-index (&optional depth)
(defun outline-sibling-index (&optional depth)
  "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 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 (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)
(defun outline-distinctive-bullet (bullet)
  "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)
(defun outline-numbered-type-prefix (&optional prefix)
  "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)
(defun outline-bullet-for-depth (&optional depth)
  "Return outline topic bullet suited to optional DEPTH, or current depth."
  ;; Find bullet in plain-bullets-string modulo DEPTH.
  (if outline-stylish-prefixes
      (char-to-string (aref outline-plain-bullets-string
                            (% (max 0 (- depth 2))
                               outline-plain-bullets-string-len)))
    outline-primary-bullet)
  )

;;;_  - Topic Production
;;;_   > outline-make-topic-prefix (&optional prior-bullet
(defun outline-make-topic-prefix (&optional prior-bullet
                                            new
                                            depth
                                            solicit
                                            number-control
                                            index)
  ;; Depth null means use current depth, non-null means we're either
  ;; opening a new topic after current topic, lower or higher, or we're
  ;; changing level of current topic.
  ;; Solicit dominates specified bullet-char.
;;;_    . Doc string:
  "Generate a topic prefix suitable for optional arg DEPTH, or current depth.

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)."
;;;_    . 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.
  ;; Current prefix is least dominant, but most likely to be commonly
  ;; specified...

  (let* (body
         numbering
         denumbering
         (depth (or depth (outline-depth)))
         (header-lead outline-header-prefix)
         (bullet-char

          ;; Getting value for bullet char is practically the whole job:

          (cond
                                        ; Simplest situation - level 1:
           ((<= depth 1) (setq header-lead "") outline-primary-bullet)
                                        ; Simple, too: all asterisks:
           (outline-old-style-prefixes
            ;; Cheat - make body the whole thing, null out header-lead and
            ;; bullet-char:
            (setq body (make-string depth
                                    (string-to-char outline-primary-bullet)))
            (setq header-lead "")
            "")

           ;; (Neither level 1 nor old-style, so we're space padding.
           ;; Sneak it in the condition of the next case, whatever it is.)

           ;; Solicitation overrides numbering and other cases:
           ((progn (setq body (make-string (- depth 2) ?\ ))
                   ;; The actual condition:
                   solicit)
            (let* ((got (outline-solicit-alternate-bullet depth)))
              ;; Gotta check whether we're numbering and got a numbered bullet:
              (setq numbering (and outline-numbered-bullet
                                   (not (and number-control (not index)))
                                   (string= got outline-numbered-bullet)))
              ;; Now return what we got, regardless:
              got))

           ;; Numbering invoked through args:
           ((and outline-numbered-bullet number-control)
            (if (setq numbering (not (setq denumbering (not index))))
                outline-numbered-bullet
              (if (and prior-bullet
                       (not (string= outline-numbered-bullet
                                     prior-bullet)))
                  prior-bullet
                (outline-bullet-for-depth depth))))

          ;;; Neither soliciting nor controlled numbering ;;;
             ;;; (may be controlled denumbering, tho) ;;;

           ;; Check wrt previous sibling:
           ((and new				  ; only check for new prefixes
                 (<= depth (outline-depth))
                 outline-numbered-bullet	      ; ... & numbering enabled
                 (not denumbering)
                 (let ((sibling-bullet
                        (save-excursion
                          ;; Locate correct sibling:
                          (or (>= depth (outline-depth))
                              (outline-ascend-to-depth depth))
                          (outline-get-bullet))))
                   (if (and sibling-bullet
                            (string= outline-numbered-bullet sibling-bullet))
                       (setq numbering sibling-bullet)))))

           ;; Distinctive prior bullet?
           ((and prior-bullet
                 (outline-distinctive-bullet prior-bullet)
                 ;; Either non-numbered:
                 (or (not (and outline-numbered-bullet
                               (string= prior-bullet outline-numbered-bullet)))
                     ;; or numbered, and not denumbering:
                     (setq numbering (not denumbering)))
                 ;; Here 'tis:
                 prior-bullet))

           ;; Else, standard bullet per depth:
           ((outline-bullet-for-depth depth)))))

    (concat header-lead
            body
            bullet-char
            (if numbering
                (format "%d" (cond ((and index (numberp index)) index)
                                   (new (1+ (outline-sibling-index depth)))
                                   ((outline-sibling-index))))))
    )
  )
;;;_   > 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 preceding sibling, and then open forward
  from there."

  (let* ((depth (+ (outline-current-depth) relative-depth))
         (opening-on-blank (if (looking-at "^\$")
                               (not (setq before nil))))
         opening-numbered	; Will get while computing ref-topic, below
         ref-depth		; Will get while computing ref-topic, next
         (ref-topic (save-excursion
                      (cond ((< relative-depth 0)
                             (outline-ascend-to-depth depth))
                            ((>= relative-depth 1) nil)
                            (t (outline-back-to-current-heading)))
                      (setq ref-depth (outline-recent-depth))
                      (setq opening-numbered
                            (save-excursion
                              (and outline-numbered-bullet
                                   (or (<= relative-depth 0)
                                       (outline-descend-to-depth depth))
                                   (if (outline-numbered-type-prefix)
                                       outline-numbered-bullet))))
                      (point)))
         dbl-space
         doing-beginning)

    (if (not opening-on-blank)
                                        ; Positioning and vertical
                                        ; padding - only if not
                                        ; opening-on-blank:
        (progn 
          (goto-char ref-topic)
          (setq dbl-space               ; Determine double space action:
                (or (and (<= relative-depth 0)	; not descending;
                         (save-excursion
                           ;; at b-o-b or preceded 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)
                             (save-excursion
                               ;; Don't already have following
                               ;; vertical padding:
                               (not (outline-pre-next-preface)))))))

                                        ; Position to prior 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 (not (bobp))
                                (outline-previous-heading)))
	    (if (and before (bobp))
		(outline-unprotected (open-line 1))))

          (if (<= relative-depth 0)
              ;; Not going inwards, don't snug up:
              (if doing-beginning
		  (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.
            (outline-pre-next-preface)
            (if (bolp)
                ;; Blank lines between current header body and next
                ;; header - get to last substantive (non-white-space)
                ;; line in body:
                (re-search-backward "[^ \t\n]" nil t))
            (if (save-excursion
                  (outline-next-heading)
                  (if (> (outline-recent-depth) ref-depth)
                      ;; This is an offspring.
                      (progn (forward-line -1)
                             (looking-at "^\\s-*$"))))
                (progn (forward-line 1)
                       (outline-unprotected (open-line 1))))
            (end-of-line))
          ;;(if doing-beginning (goto-char doing-beginning))
          (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
                                                      depth)
                           " "))

    ;;(if doing-beginning (save-excursion (newline (if dbl-space 2 1))))


    (outline-rebullet-heading nil		;;; solicit
                              depth 		;;; depth
                              nil 		;;; number-control
                              nil		;;; index
                              t)     (end-of-line)
    )
  )
;;;_    . open-topic contingencies
;;;_     ; base topic - one from which open was issued
;;;_      , beginning char
;;;_      , amount of space before will be used, unless opening 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")
  (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")
  (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")
  (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 ()
  "Outline-mode autofill function.

Maintains 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 accommodated.

Note that refill of indented paragraphs is not done."

  (save-excursion
    (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 \(only\) affects visible heading containing point.

With repeat count, solicit for bullet."
  (interactive "P")
  (save-excursion (outline-back-to-current-heading)
                  (outline-end-of-prefix)
                  (outline-rebullet-heading (not arg)	;;; solicit
                                            nil		;;; depth
                                            nil		;;; number-control
                                            nil		;;; index
                                            t)		;;; do-successors
                  )
  )
;;;_    > outline-rebullet-heading (&optional solicit ...)
(defun outline-rebullet-heading (&optional solicit
                                           new-depth
                                           number-control
                                           index
                                           do-successors)

  "Adjust bullet of current topic prefix.

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.

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.

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.

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))
         (mb outline-recent-prefix-beginning)
         (me outline-recent-prefix-end)
         (current-bullet (buffer-substring (- me 1) me))
         (new-prefix (outline-make-topic-prefix current-bullet
                                                nil
                                                new-depth
                                                solicit
                                                number-control
                                                index)))

    ;; 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:
      (outline-unprotected (delete-region mb me))
      (goto-char mb)
					; Dispense with number if
					; numbered-bullet prefix:
      (if (and outline-numbered-bullet
               (string= outline-numbered-bullet current-bullet)
               (looking-at "[0-9]+"))
	  (outline-unprotected
	   (delete-region (match-beginning 0)(match-end 0))))

					; Put in new prefix:
      (outline-unprotected (insert-string new-prefix))

      ;; 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 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.

With repeat count, shift topic depth by that amount."
  (interactive "P")
  (let ((start-col (current-column))
        (was-eol (eolp)))
    (save-excursion
      ;; Normalize arg:
      (cond ((null arg) (setq arg 0))
            ((listp arg) (setq arg (car arg))))
      ;; Fill the user in, in case we're shifting a big topic:
      (if (not (zerop arg)) (message "Shifting..."))
      (outline-back-to-current-heading)
      (if (<= (+ (outline-recent-depth) arg) 0)
          (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 ...)
(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.

All arguments are optional.

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

  (let* ((relative-depth (or relative-depth 0))
         (new-depth (outline-depth))
         (starting-depth (or starting-depth new-depth))
         (on-starting-call  (null starting-point))
         (index (or index
                    ;; Leave index null on starting call, so rebullet-heading
                    ;; calculates it at what might be new depth:
                    (and (or (zerop relative-depth)
                             (not on-starting-call))
                         (outline-sibling-index))))
         (moving-outwards (< 0 relative-depth))
         (starting-point (or starting-point (point))))

    ;; Sanity check for excessive promotion done only on starting call:
    (and on-starting-call
         moving-outwards
         (> 0 (+ starting-depth relative-depth))
         (error "Attempt to shift topic out beyond level 1."))	;;; ====>

    (cond ((= starting-depth new-depth)
           ;; We're at depth to work on this one:
           (outline-rebullet-heading nil		;;; solicit
                                     (+ starting-depth	;;; starting-depth
                                        relative-depth)
                                     nil		;;; number
                                     index		;;; index
                                     ;; Every contained topic will get hit,
                                     ;; and we have to get to outside ones
                                     ;; deliberately:
                                     nil)		;;; do-successors
           ;; ... and work on subsequent ones which are at greater depth:
           (setq index 0)
           (outline-next-heading)
           (while (and (not (eobp))
                       (< starting-depth (outline-recent-depth)))
             (setq index (1+ index))
             (outline-rebullet-topic-grunt relative-depth   ;;; relative-depth
                                           (1+ starting-depth);;;starting-depth
                                           starting-point   ;;; starting-point
                                           index)))	    ;;; index

          ((< starting-depth new-depth)
           ;; Rare case - subtopic more than one level deeper than parent.
           ;; Treat this one at an even deeper level:
           (outline-rebullet-topic-grunt relative-depth   ;;; relative-depth
                                         new-depth	  ;;; starting-depth
                                         starting-point	  ;;; starting-point
                                         index)))	  ;;; index

    (if on-starting-call
        (progn
          ;; Rectify numbering of former siblings of the adjusted topic,
          ;; if topic has changed depth
          (if (or do-successors
                  (and (not (zerop relative-depth))
                       (or (= (outline-recent-depth) starting-depth)
                           (= (outline-recent-depth) (+ starting-depth
                                                        relative-depth)))))
              (outline-rebullet-heading nil nil nil nil t))
          ;; Now rectify numbering of new siblings of the adjusted topic,
          ;; if depth has been changed:
          (progn (goto-char starting-point)
                 (if (not (zerop relative-depth))
                     (outline-rebullet-heading nil nil nil nil t)))))
    )
  )
;;;_    > outline-renumber-to-depth (&optional depth)
(defun outline-renumber-to-depth (&optional depth)
  "Renumber siblings at current depth.

Affects superior topics 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.

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

  (interactive "P")

  (save-excursion
    (outline-back-to-current-heading)
    (outline-beginning-of-level)
    (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
                                  depth			;;; depth
                                  t			;;; number-control
                                  index			;;; index
                                  nil)			;;; do-successors
        (if index (setq index (1+ index)))
        (setq more (outline-next-sibling depth nil))))))
;;;_    > outline-shift-in (arg)
(defun outline-shift-in (arg)
  "Increase depth of current heading and any topics collapsed within it."
  (interactive "p")
  (outline-rebullet-topic arg))
;;;_    > outline-shift-out (arg)
(defun outline-shift-out (arg)
  "Decrease 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)
(defun outline-kill-line (&optional arg)
  "Kill line, adjusting subsequent lines suitably for outline mode."

  (interactive "*P")
  (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)))
                                        ; 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))
        (outline-renumber-to-depth depth)))))
;;;_    > outline-kill-topic ()
(defun outline-kill-topic ()
  "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
  ;; after the region is disposed of, though the renumbering process
  ;; has yet to be performed.  This means that there may appear to be
  ;; a lag *after* the kill has been performed.

  (interactive)
  (let* ((beg (prog1 (outline-back-to-current-heading)(beginning-of-line)))
         (depth (outline-recent-depth)))
    (outline-end-of-current-subtree)
    (if (not (eobp))
	(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
      (outline-renumber-to-depth depth))))
;;;_    > outline-yank-processing ()
(defun outline-yank-processing (&optional arg)

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

Also, adjusts numbering of subsequent siblings when appropriate.

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.

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)
  "Outline-mode yank, with depth and numbering adjustment of yanked topics.

Non-topic yanks work no differently 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 successive 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)
  (yank arg)
  (if (outline-mode-p)
      (outline-yank-processing)))
;;;_    > outline-yank-pop (&optional arg)
(defun outline-yank-pop (&optional arg)
  "Yank-pop like outline-yank when popping to bare outline prefixes.

Adapts level of popped topics to level of fresh prefix.

Note - prefix changes to distinctive bullets will stick, if followed
by pops to non-distinctive yanks.  Bug..."

  (interactive "*p")
  (setq this-command 'yank)
  (yank-pop arg)
  (if (outline-mode-p)
      (outline-yank-processing)))

;;;_  - 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.

\(Works according to setting of `outline-file-xref-bullet')."
  (interactive)
  (if (not outline-file-xref-bullet)
      (error
       "outline cross references disabled - no 'outline-file-xref-bullet'")
    (if (not (string= (outline-current-bullet) outline-file-xref-bullet))
        (error "current heading lacks cross-reference bullet '%s'"
               outline-file-xref-bullet)
      (let (file-name)
        (save-excursion
          (let* ((text-start outline-recent-prefix-end)
                 (heading-end (progn (outline-pre-next-preface)
                                     (point))))
            (goto-char text-start)
            (setq file-name
                  (if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t)
                      (buffer-substring (match-beginning 1) (match-end 1))))))
        (setq file-name
              (if (not (= (aref file-name 0) ?:))
                  (expand-file-name file-name)
                                        ; A registry-files ref, strip the ':'
                                        ; and try to follow it:
                (let ((reg-ref (reference-registered-file
                                (substring file-name 1) nil t)))
                  (if reg-ref (car (cdr reg-ref))))))
        (if (or (file-exists-p file-name)
                (if (file-writable-p file-name)
                    (y-or-n-p (format "%s not there, create one? "
                                      file-name))
                  (error "%s not found and can't be created" file-name)))
            (condition-case failure
                (find-file-other-window file-name)
              (error failure))
          (error "%s not found" file-name))
        )
      )
    )
  )

;;;_ #6 Exposure Control and Processing

;;;_  - Fundamental
;;;_   > outline-flag-region (from to flag)
(defmacro outline-flag-region (from to flag)
  "Hide or show lines from FROM to TO, via emacs selective-display FLAG char.
Ie, text following flag C-m \(carriage-return) is hidden until the
next C-j (newline) char.

Returns the endpoint of the region."
  (` (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)
  "Hide or show subtree of currently-visible topic.

See `outline-flag-region' for more details."

  (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)
  "Map function on exposed parts of current topic; results to another buffer.

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 "outline-process-exposed: source buffer %s not found."
		       frombuf)
	      (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', reveals entries nested in 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.

Returns point at end of subtree that was opened, if any.  (May get a
point of non-opened subtree?)"

  (interactive "p")
  (let (max-pos)
    (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:
	       (setq max-pos (outline-show-children level t)))

      (save-excursion
	(save-restriction
	  (let* ((start-pt (point))
		 (chart (outline-chart-subtree (or level 1)))
		 (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, use `outline-show-children' 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'; hides completely if 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.

As with 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)))
  (if (outline-hidden-p)
      (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 (&optional arg)
(defun outline-show-current-subtree (&optional arg)
  "Show everything within the current topic.  With a repeat-count,
expose this topic and its' siblings."
  (interactive "P")
  (save-excursion
    (if (<= (outline-current-depth) 0)
	;; Outside any topics - try to get to the first:
	(if (not (outline-next-heading))
	    (error "No topics.")
	  ;; got to first, outermost topic - set to expose it and siblings:
	  (message "Above outermost topic - exposing all.")
	  (outline-flag-region (point-min)(point-max) ?\n))
      (if (not arg)
	  (outline-flag-current-subtree ?\n)
	(outline-beginning-of-level)
	(outline-expose-topic '(* :))))))
;;;_   > outline-hide-current-subtree (&optional just-close)
(defun outline-hide-current-subtree (&optional just-close)
  "Close the current topic, or containing topic if this one is already closed.

If this topic is closed and it's a top level topic, close this topic
and its' siblings.

If optional arg JUST-CLOSE is non-nil, do not treat the parent or
siblings, even if the target topic is already closed."

  (interactive)
  (let ((from (point))
	(orig-eol (progn (end-of-line)
			 (if (not (outline-goto-prefix))
			     (error "No topics found.")
			   (end-of-line)(point)))))
    (outline-flag-current-subtree ?\^M)
    (goto-char from)
    (if (and (= orig-eol (progn (goto-char orig-eol)
				(end-of-line)
				(point)))
	     (not just-close)
             ;; Structure didn't change - try hiding current level:
	     (goto-char from)
	     (if (outline-up-current-level 1 t)
		 t
	       (goto-char 0)
	       (let ((msg
		      "Top-level topic already closed - closing siblings..."))
		 (message msg)
		 (outline-expose-topic '(0 :))
		 (message (concat msg "  Done.")))
	       nil)
	     (/= (outline-recent-depth) 0))
	(outline-hide-current-subtree))
      (goto-char from)))
;;;_   > 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)
  (message "Exposing entire buffer...")
  (outline-flag-region (point-min) (point-max) ?\n)
  (message "Exposing entire buffer...  Done."))
;;;_   > 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)
(defun outline-expose-topic (spec)
  "Apply exposure specs to successive outline topic items.

Use the more convenient frontend, `outline-new-exposure', if you don't
need evaluation of the arguments, or even better, the `outline-layout'
variable-keyed mode-activation/auto-exposure feature of allout outline
mode.  See the respective documentation strings for more details.

Cursor is left at start position.

SPEC is either a number or a list.

Successive specs on a list are applied to successive sibling topics.

A simple spec \(either a number, one of a few symbols, or the null
list) dictates the exposure for the corresponding topic.

Non-null lists recursively designate exposure specs for respective
subtopics of the current topic.

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 of the corresponding 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: ")
  (if (not (listp spec))
      nil
    (let ((depth (outline-depth))
	  (max-pos 0)
	  prev-elem curr-elem
	  stay done
	  snug-back
	  )
      (while spec
	(setq prev-elem curr-elem
	      curr-elem (car spec)
	      spec (cdr spec))
	(cond				; Do current element:
	 ((null curr-elem) nil)
	 ((symbolp curr-elem)
	  (cond ((eq curr-elem '*) (outline-show-current-subtree)
		 (if (> outline-recent-end-of-subtree max-pos)
		     (setq max-pos outline-recent-end-of-subtree)))
		((eq curr-elem '+) (outline-show-current-branches)
		 (if (> outline-recent-end-of-subtree max-pos)
		     (setq max-pos outline-recent-end-of-subtree)))
		((eq curr-elem '-) (outline-show-current-entry))
		((eq curr-elem ':)
		 (setq stay t)
		 ;; Expand the 'repeat' spec to an explicit version,
		 ;; w.r.t. remaining siblings:
		 (let ((residue	   ; = # of sibs not covered by remaining spec
			;; Dang - could be nice to make use of the chart, sigh:
			(- (length (outline-chart-siblings))
			   (length spec))))
		   (if (< 0 residue)
		       ;; Some residue - cover it with prev-elem:
		       (setq spec (append (make-list residue prev-elem)
					  spec)))))))
	 ((numberp curr-elem)
	  (if (and (>= 0 curr-elem) (outline-visible-p))
	      (save-excursion (outline-hide-current-subtree t)
			      (if (> 0 curr-elem)
				  nil
				(if (> outline-recent-end-of-subtree max-pos)
				    (setq max-pos
					  outline-recent-end-of-subtree)))))
	  (if (> (abs curr-elem) 0)
	      (progn (outline-show-children (abs curr-elem))
		     (if (> outline-recent-end-of-subtree max-pos)
			 (setq max-pos outline-recent-end-of-subtree)))))
	  ((listp curr-elem)
	   (if (outline-descend-to-depth (1+ depth))
	       (let ((got (outline-expose-topic curr-elem)))
		 (if (and got (> got max-pos)) (setq max-pos got))))))
	(cond (stay (setq stay nil))
	      ((listp (car spec)) nil)
	      ((> max-pos (point))
	       ;; 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))))
      max-pos)))
;;;_   > outline-old-expose-topic (spec &rest followers)
(defun outline-old-expose-topic (spec &rest followers)

  "Deprecated.  Use outline-expose-topic \(with different schema
format\) instead.

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.

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.
Some arguments that would need to be quoted in outline-expose-topic
need not be quoted in outline-new-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-new-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))))

;;;_ #7 ISearch with Dynamic Exposure
;;;_  = outline-search-reconceal
(defvar outline-search-reconceal nil
  "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
  "Distinguishes isearch conclusion and cancellation.

Used by isearch-terminate/outline-provisions and
isearch-done/outline-provisions")

           
;;;_  > outline-enwrap-isearch ()
(defun outline-enwrap-isearch ()
  "Impose outline-mode isearch-mode wrappers for dynamic exposure in isearch.

Isearch progressively exposes and reconceals hidden topics when
working in outline mode, but works normally 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 isearch 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.

Registers 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.

Works 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 (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 dynamically adjusts isearch target exposure.

Appropriately exposes and reconceals hidden outline portions, as
necessary, 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)))))

;;;_ #8 Copying and printing

;;;_  - Copy exposed
;;;_   > outline-insert-listified (depth prefix bullet text)
(defun outline-insert-listified (depth prefix bullet text)
  "Insert contents of listified outline portion in current buffer."
  (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 another buffer.

Other buffer has 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 for literal reproduction across latex processing.
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 ()
  "Express line for exact \(literal\) representation across latex processing.

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 outline item.

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)
  "Format current topic's exposed portions to TOBUF 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)
    (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))
    (pop-to-buffer buf)
    (goto-char start-pt)))

;;;_ #9 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 ()
;; outlinify-sticky is correct spelling; provide this alias for sticklers:
(defalias 'outlinify-sticky 'outlineify-sticky)
(defun outlineify-sticky (&optional arg)
  "Activate outline mode and establish file var so it is started subsequently.

See doc-string for `outline-layout' and `outline-init' for details on
setup for auto-startup."

  (interactive "P")

  (outline-mode t)

  (save-excursion
    (goto-char (point-min))
    (if (looking-at outline-regexp)
	t
      (outline-open-topic 2)
      (insert-string (concat "Dummy outline topic header - see"
			     "`outline-mode' docstring for info."))
      (next-line 1)
      (goto-char (point-max))
      (next-line 1)
      (outline-open-topic 0)
      (insert-string "Local emacs vars.\n")
      (outline-open-topic 1)
      (insert-string "(`outline-layout' is for allout.el outline-mode)\n")
      (outline-open-topic 0)
      (insert-string "Local variables:\n")
      (outline-open-topic 0)
      (insert-string (format "outline-layout: %s\n"
			     (or outline-layout
				 '(1 : 0))))
      (outline-open-topic 0)
      (insert-string "End:\n"))))
;;;_  > 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.

Optional arg DO-DEFAULTING indicates to accept empty input (CR)."

  (let ((new-prompt prompt)
        got)

    (while (not got)
      (message "%s" new-prompt)

      ;; We do our own reading here, so we can circumvent, eg, special
      ;; treatment for '?' character.  (Might oughta change minibuffer
      ;; keymap instead, oh well.)
      (setq got
            (char-to-string (let ((cursor-in-echo-area nil)) (read-char))))

      (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 "")
            ;; Failed match and not defaulting,
            ;; set the prompt to give feedback,
            (setq new-prompt (concat prompt
                                     got
                                     " ...pick from: "
                                     string
                                     ""))
            ;; and set loop to try again:
            (setq got nil))
        ;; Got a match - give feedback:
        (message "")))
    ;; got something out of loop - return it:
    got)
  )
;;;_  > 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 divergent emacsen
;;;_   > 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)))))))

;;;_ #10 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.
;;; The following `outline-layout' local variable setting:
;;;  - closes all topics from the first topic to just before the third-to-last,
;;;  - shows the children of the third to last (config vars)
;;;  - and the second to last (code section),
;;;  - and closes the last topic (this local-variables section).
;;;Local variables:
;;;outline-layout: (0 : -1 -1 0)
;;;End:

;; allout.el ends here
;;; emerge.el --- merge diffs under Emacs control

;;; The author has placed this file in the public domain.

;; Author: Dale R. Worley <worley@world.std.com>
;; Version: 5fsf
;; Keywords: unix, tools

;; This software was created by Dale R. Worley and is
;; distributed free of charge.  It is placed in the public domain and
;; permission is granted to anyone to use, duplicate, modify and redistribute
;; it provided that this notice is attached.

;; Dale R. Worley provides absolutely NO WARRANTY OF ANY KIND
;; with respect to this software.  The entire risk as to the quality and
;; performance of this software is with the user.  IN NO EVENT WILL DALE
;; R. WORLEY BE LIABLE TO ANYONE FOR ANY DAMAGES ARISING OUT THE
;; USE OF THIS SOFTWARE, INCLUDING, WITHOUT LIMITATION, DAMAGES RESULTING FROM
;; LOST DATA OR LOST PROFITS, OR FOR ANY SPECIAL, INCIDENTAL OR CONSEQUENTIAL
;; DAMAGES.

;;; Code:

;;;###autoload
(defvar menu-bar-emerge-menu (make-sparse-keymap "Emerge"))
;;;###autoload
(fset 'menu-bar-emerge-menu (symbol-value 'menu-bar-emerge-menu))

;;;###autoload
(define-key menu-bar-emerge-menu [emerge-merge-directories]
  '("Merge Directories..." . emerge-merge-directories))
;;;###autoload
(define-key menu-bar-emerge-menu [emerge-revisions-with-ancestor]
  '("Revisions with Ancestor..." . emerge-revisions-with-ancestor))
;;;###autoload
(define-key menu-bar-emerge-menu [emerge-revisions]
  '("Revisions..." . emerge-revisions))
;;;###autoload
(define-key menu-bar-emerge-menu [emerge-files-with-ancestor]
  '("Files with Ancestor..." . emerge-files-with-ancestor))
;;;###autoload
(define-key menu-bar-emerge-menu [emerge-files]
  '("Files..." . emerge-files))
;;;###autoload
(define-key menu-bar-emerge-menu [emerge-buffers-with-ancestor]
  '("Buffers with Ancestor..." . emerge-buffers-with-ancestor))
;;;###autoload
(define-key menu-bar-emerge-menu [emerge-buffers]
  '("Buffers..." . emerge-buffers))

;;; Macros

(defmacro emerge-eval-in-buffer (buffer &rest forms)
  "Macro to switch to BUFFER, evaluate FORMS, returns to original buffer.
Differs from `save-excursion' in that it doesn't save the point and mark."
  (` (let ((StartBuffer (current-buffer)))
    (unwind-protect
	(progn
	  (set-buffer (, buffer))
	  (,@ forms))
      (set-buffer StartBuffer)))))

(defmacro emerge-defvar-local (var value doc) 
  "Defines SYMBOL as an advertised variable.  
Performs a defvar, then executes `make-variable-buffer-local' on
the variable.  Also sets the `preserved' property, so that
`kill-all-local-variables' (called by major-mode setting commands) 
won't destroy Emerge control variables."
  (` (progn
       (defvar (, var) (, value) (, doc))
       (make-variable-buffer-local '(, var))
       (put '(, var) 'preserved t))))

;; Add entries to minor-mode-alist so that emerge modes show correctly
(defvar emerge-minor-modes-list
  '((emerge-mode " Emerge")
    (emerge-fast-mode " F")
    (emerge-edit-mode " E")
    (emerge-auto-advance " A")
    (emerge-skip-prefers " S")))
(if (not (assq 'emerge-mode minor-mode-alist))
    (setq minor-mode-alist (append emerge-minor-modes-list
				   minor-mode-alist)))

;; We need to define this function so describe-mode can describe Emerge mode.
(defun emerge-mode ()
  "Emerge mode is used by the Emerge file-merging package.
It is entered only through one of the functions:
	`emerge-files'
	`emerge-files-with-ancestor'
	`emerge-buffers'
	`emerge-buffers-with-ancestor'
	`emerge-files-command'
	`emerge-files-with-ancestor-command'
	`emerge-files-remote'
	`emerge-files-with-ancestor-remote'

Commands:
\\{emerge-basic-keymap}
Commands must be prefixed by \\<emerge-fast-keymap>\\[emerge-basic-keymap] in `edit' mode,
but can be invoked directly in `fast' mode.")

(defvar emerge-version "5fsf"
  "The version of Emerge.")

(defun emerge-version ()
  "Return string describing the version of Emerge.
When called interactively, displays the version."
  (interactive)
  (if (interactive-p)
      (message "Emerge version %s" (emerge-version))
    emerge-version))

;;; Emerge configuration variables

;; Commands that produce difference files
;; All that can be configured is the name of the programs to execute
;; (emerge-diff-program and emerge-diff3-program) and the options
;; to be provided (emerge-diff-options).  The order in which the file names
;; are given is fixed.
;; The file names are always expanded (see expand-file-name) before being
;; passed to diff, thus they need not be invoked under a shell that 
;; understands `~'.
;; The code which processes the diff/diff3 output depends on all the
;; finicky details of their output, including the somewhat strange
;; way they number lines of a file.
(defvar emerge-diff-program "diff"
  "*Name of the program which compares two files.")
(defvar emerge-diff3-program "diff3"
  "*Name of the program which compares three files.
Its arguments are the ancestor file and the two variant files.")
(defvar emerge-diff-options ""
  "*Options to pass to `emerge-diff-program' and `emerge-diff3-program'.")
(defvar emerge-match-diff-line (let ((x "\\([0-9]+\\)\\(\\|,\\([0-9]+\\)\\)"))
				 (concat "^" x "\\([acd]\\)" x "$"))
  "*Pattern to match lines produced by diff that describe differences.
This is as opposed to lines from the source files.")
(defvar emerge-diff-ok-lines-regexp
  "^\\([0-9,]+[acd][0-9,]+$\\|[<>] \\|---\\)"
  "*Regexp that matches normal output lines from `emerge-diff-program'.
Lines that do not match are assumed to be error messages.")
(defvar emerge-diff3-ok-lines-regexp
  "^\\([1-3]:\\|====\\|  \\)"
  "*Regexp that matches normal output lines from `emerge-diff3-program'.
Lines that do not match are assumed to be error messages.")

(defvar emerge-rcs-ci-program "ci"
  "*Name of the program that checks in RCS revisions.")
(defvar emerge-rcs-co-program "co"
  "*Name of the program that checks out RCS revisions.")

(defvar emerge-process-local-variables nil
  "*Non-nil if Emerge should process local-variables lists in merge buffers.
\(You can explicitly request processing the local-variables
by executing `(hack-local-variables)'.)")
(defvar emerge-execute-line-deletions nil
  "*If non-nil: `emerge-execute-line' makes no output if an input was deleted.
It concludes that an input version has been deleted when an ancestor entry
is present, only one A or B entry is present, and an output entry is present.
If nil: In such circumstances, the A or B file that is present will be
copied to the designated output file.")

(defvar emerge-before-flag "vvvvvvvvvvvvvvvvvvvv\n"
  "*Flag placed above the highlighted block of code.  Must end with newline.
Must be set before Emerge is loaded, or  emerge-new-flags  must be run
after setting.")
(defvar emerge-after-flag "^^^^^^^^^^^^^^^^^^^^\n"
  "*Flag placed below the highlighted block of code.  Must end with newline.
Must be set before Emerge is loaded, or  emerge-new-flags  must be run
after setting.")

;; Hook variables

(defvar emerge-startup-hook nil
  "*Hook to run in the merge buffer after the merge has been set up.")
(defvar emerge-select-hook nil
  "*Hook to run after a difference has been selected.
The variable `n' holds the (internal) number of the difference.")
(defvar emerge-unselect-hook nil
  "*Hook to run after a difference has been unselected.
The variable `n' holds the (internal) number of the difference.")

;; Variables to control the default directories of the arguments to
;; Emerge commands.

(defvar emerge-default-last-directories nil
  "*If nil, default dir for filenames in emerge is `default-directory'.
If non-nil, filenames complete in the directory of the last argument of the
same type to an `emerge-files...' command.")

(defvar emerge-last-dir-A nil
  "Last directory for the first file of an `emerge-files...' command.")
(defvar emerge-last-dir-B nil
  "Last directory for the second file of an `emerge-files...' command.")
(defvar emerge-last-dir-ancestor nil
  "Last directory for the ancestor file of an `emerge-files...' command.")
(defvar emerge-last-dir-output nil
  "Last directory for the output file of an `emerge-files...' command.")
(defvar emerge-last-revision-A nil
  "Last RCS revision used for first file of an `emerge-revisions...' command.")
(defvar emerge-last-revision-B nil
  "Last RCS revision used for second file of an `emerge-revisions...' command.")
(defvar emerge-last-revision-ancestor nil
  "Last RCS revision used for ancestor file of an `emerge-revisions...' command.")

(defvar emerge-before-flag-length)
(defvar emerge-before-flag-lines)
(defvar emerge-before-flag-match)
(defvar emerge-after-flag-length)
(defvar emerge-after-flag-lines)
(defvar emerge-after-flag-match)
(defvar emerge-diff-buffer)
(defvar emerge-diff-error-buffer)
(defvar emerge-prefix-argument)
(defvar emerge-file-out)
(defvar emerge-exit-func)
(defvar emerge-globalized-difference-list)
(defvar emerge-globalized-number-of-differences)

;; The flags used to mark differences in the buffers.

;; These function definitions need to be up here, because they are used
;; during loading.
(defun emerge-new-flags ()
  "Function to be called after `emerge-{before,after}-flag'.
This is called after these functions are changed to compute values that
depend on the flags."
  (setq emerge-before-flag-length (length emerge-before-flag))
  (setq emerge-before-flag-lines
	(emerge-count-matches-string emerge-before-flag "\n"))
  (setq emerge-before-flag-match (regexp-quote emerge-before-flag))
  (setq emerge-after-flag-length (length emerge-after-flag))
  (setq emerge-after-flag-lines
	(emerge-count-matches-string emerge-after-flag "\n"))
  (setq emerge-after-flag-match (regexp-quote emerge-after-flag)))

(defun emerge-count-matches-string (string regexp)
  "Return the number of matches in STRING for REGEXP."
  (let ((i 0)
	(count 0))
    (while (string-match regexp string i)
      (setq count (1+ count))
      (setq i (match-end 0)))
    count))

;; Calculate dependent variables
(emerge-new-flags)

(defvar emerge-min-visible-lines 3
  "*Number of lines that we want to show above and below the flags when we are
displaying a difference.")

(defvar emerge-temp-file-prefix
  (let ((env (or (getenv "TMPDIR")
		 (getenv "TMP")
		 (getenv "TEMP")))
	d)
    (setq d (if (and env (> (length env) 0))
		env
	      "/tmp"))
    (if (= (aref d (1- (length d))) ?/)
	(setq d (substring d 0 -1)))
    (concat d "/emerge"))
  "*Prefix to put on Emerge temporary file names.
Do not start with `~/' or `~user-name/'.")

(defvar emerge-temp-file-mode 384	; u=rw only
  "*Mode for Emerge temporary files.")

(defvar emerge-combine-versions-template
  "#ifdef NEW\n%b#else /* not NEW */\n%a#endif /* not NEW */\n"
  "*Template for `emerge-combine-versions' to combine the two versions.
The template is inserted as a string, with the following interpolations:
	%a	the A version of the difference
	%b	the B version of the difference
	%%	the character `%'
Don't forget to end the template with a newline.
Note that this variable can be made local to a particular merge buffer by
giving a prefix argument to `emerge-set-combine-versions-template'.")

;; Build keymaps

(defvar emerge-basic-keymap nil
  "Keymap of Emerge commands.
Directly available in `fast' mode;
must be prefixed by \\<emerge-fast-keymap>\\[emerge-basic-keymap] in `edit' mode.")

(defvar emerge-fast-keymap nil
  "Local keymap used in Emerge `fast' mode.
Makes Emerge commands directly available.")

(defvar emerge-options-menu
  (make-sparse-keymap "Options"))

(defvar emerge-merge-menu
  (make-sparse-keymap "Merge"))

(defvar emerge-move-menu
  (make-sparse-keymap "Move"))

(defvar emerge-command-prefix "\C-c\C-c"
  "*Command prefix for Emerge commands in `edit' mode.
Must be set before Emerge is loaded.")

;; This function sets up the fixed keymaps.  It is executed when the first
;; Emerge is done to allow the user maximum time to set up the global keymap.
(defun emerge-setup-fixed-keymaps ()
  ;; Set up the basic keymap
  (setq emerge-basic-keymap (make-keymap))
  (suppress-keymap emerge-basic-keymap)	; this sets 0..9 to digit-argument and
					; - to negative-argument
  (define-key emerge-basic-keymap "p" 'emerge-previous-difference)
  (define-key emerge-basic-keymap "n" 'emerge-next-difference)
  (define-key emerge-basic-keymap "a" 'emerge-select-A)
  (define-key emerge-basic-keymap "b" 'emerge-select-B)
  (define-key emerge-basic-keymap "j" 'emerge-jump-to-difference)
  (define-key emerge-basic-keymap "." 'emerge-find-difference)
  (define-key emerge-basic-keymap "q" 'emerge-quit)
  (define-key emerge-basic-keymap "\C-]" 'emerge-abort)
  (define-key emerge-basic-keymap "f" 'emerge-fast-mode)
  (define-key emerge-basic-keymap "e" 'emerge-edit-mode)
  (define-key emerge-basic-keymap "s" nil)
  (define-key emerge-basic-keymap "sa" 'emerge-auto-advance)
  (define-key emerge-basic-keymap "ss" 'emerge-skip-prefers)
  (define-key emerge-basic-keymap "l" 'emerge-recenter)
  (define-key emerge-basic-keymap "d" nil)
  (define-key emerge-basic-keymap "da" 'emerge-default-A)
  (define-key emerge-basic-keymap "db" 'emerge-default-B)
  (define-key emerge-basic-keymap "c" nil)
  (define-key emerge-basic-keymap "ca" 'emerge-copy-as-kill-A)
  (define-key emerge-basic-keymap "cb" 'emerge-copy-as-kill-B)
  (define-key emerge-basic-keymap "i" nil)
  (define-key emerge-basic-keymap "ia" 'emerge-insert-A)
  (define-key emerge-basic-keymap "ib" 'emerge-insert-B)
  (define-key emerge-basic-keymap "m" 'emerge-mark-difference)
  (define-key emerge-basic-keymap "v" 'emerge-scroll-up)
  (define-key emerge-basic-keymap "^" 'emerge-scroll-down)
  (define-key emerge-basic-keymap "<" 'emerge-scroll-left)
  (define-key emerge-basic-keymap ">" 'emerge-scroll-right)
  (define-key emerge-basic-keymap "|" 'emerge-scroll-reset)
  (define-key emerge-basic-keymap "x" nil)
  (define-key emerge-basic-keymap "x1" 'emerge-one-line-window)
  (define-key emerge-basic-keymap "xc" 'emerge-combine-versions)
  (define-key emerge-basic-keymap "xC" 'emerge-combine-versions-register)
  (define-key emerge-basic-keymap "xf" 'emerge-file-names)
  (define-key emerge-basic-keymap "xj" 'emerge-join-differences)
  (define-key emerge-basic-keymap "xl" 'emerge-line-numbers)
  (define-key emerge-basic-keymap "xm" 'emerge-set-merge-mode)
  (define-key emerge-basic-keymap "xs" 'emerge-split-difference)
  (define-key emerge-basic-keymap "xt" 'emerge-trim-difference)
  (define-key emerge-basic-keymap "xx" 'emerge-set-combine-versions-template)
  ;; Allow emerge-basic-keymap to be referenced indirectly
  (fset 'emerge-basic-keymap emerge-basic-keymap)
  ;; Set up the fast mode keymap
  (setq emerge-fast-keymap (copy-keymap emerge-basic-keymap))
  ;; Allow prefixed commands to work in fast mode
  (define-key emerge-fast-keymap emerge-command-prefix 'emerge-basic-keymap)
  ;; Allow emerge-fast-keymap to be referenced indirectly
  (fset 'emerge-fast-keymap emerge-fast-keymap)
  ;; Suppress write-file and save-buffer
  (substitute-key-definition 'write-file 'emerge-query-write-file
			     emerge-fast-keymap (current-global-map))
  (substitute-key-definition 'save-buffer 'emerge-query-save-buffer
			     emerge-fast-keymap (current-global-map))

  (define-key emerge-basic-keymap [menu-bar] (make-sparse-keymap))

  (define-key emerge-fast-keymap [menu-bar options]
    (cons "Options" emerge-options-menu))
  (define-key emerge-fast-keymap [menu-bar merge]
    (cons "Merge" emerge-merge-menu))
  (define-key emerge-fast-keymap [menu-bar move]
    (cons "Move" emerge-move-menu))

  (define-key emerge-move-menu [emerge-scroll-reset]
    '("Scroll Reset" . emerge-scroll-reset))
  (define-key emerge-move-menu [emerge-scroll-right]
    '("Scroll Right" . emerge-scroll-right))
  (define-key emerge-move-menu [emerge-scroll-left]
    '("Scroll Left" . emerge-scroll-left))
  (define-key emerge-move-menu [emerge-scroll-down]
    '("Scroll Down" . emerge-scroll-down))
  (define-key emerge-move-menu [emerge-scroll-up]
    '("Scroll Up" . emerge-scroll-up))
  (define-key emerge-move-menu [emerge-recenter]
    '("Recenter" . emerge-recenter))
  (define-key emerge-move-menu [emerge-mark-difference]
    '("Mark Difference" . emerge-mark-difference))
  (define-key emerge-move-menu [emerge-jump-to-difference]
    '("Jump To Difference" . emerge-jump-to-difference))
  (define-key emerge-move-menu [emerge-find-difference]
    '("Find Difference" . emerge-find-difference))
  (define-key emerge-move-menu [emerge-previous-difference]
    '("Previous Difference" . emerge-previous-difference))
  (define-key emerge-move-menu [emerge-next-difference]
    '("Next Difference" . emerge-next-difference))


  (define-key emerge-options-menu [emerge-one-line-window]
    '("One Line Window" . emerge-one-line-window))
  (define-key emerge-options-menu [emerge-set-merge-mode]
    '("Set Merge Mode" . emerge-set-merge-mode))
  (define-key emerge-options-menu [emerge-set-combine-template]
    '("Set Combine Template..." . emerge-set-combine-template))
  (define-key emerge-options-menu [emerge-default-B]
    '("Default B" . emerge-default-B))
  (define-key emerge-options-menu [emerge-default-A]
    '("Default A" . emerge-default-A))
  (define-key emerge-options-menu [emerge-skip-prefers]
    '("Skip Prefers" . emerge-skip-prefers))
  (define-key emerge-options-menu [emerge-auto-advance]
    '("Auto Advance" . emerge-auto-advance))
  (define-key emerge-options-menu [emerge-edit-mode]
    '("Edit Mode" . emerge-edit-mode))
  (define-key emerge-options-menu [emerge-fast-mode]
    '("Fast Mode" . emerge-fast-mode))

  (define-key emerge-merge-menu [emerge-abort] '("Abort" . emerge-abort))
  (define-key emerge-merge-menu [emerge-quit] '("Quit" . emerge-quit))
  (define-key emerge-merge-menu [emerge-split-difference]
    '("Split Difference" . emerge-split-difference))
  (define-key emerge-merge-menu [emerge-join-differences]
    '("Join Differences" . emerge-join-differences))
  (define-key emerge-merge-menu [emerge-trim-difference]
    '("Trim Difference" . emerge-trim-difference))
  (define-key emerge-merge-menu [emerge-combine-versions]
    '("Combine Versions" . emerge-combine-versions))
  (define-key emerge-merge-menu [emerge-copy-as-kill-B]
    '("Copy B as Kill" . emerge-copy-as-kill-B))
  (define-key emerge-merge-menu [emerge-copy-as-kill-A]
    '("Copy A as Kill" . emerge-copy-as-kill-A))
  (define-key emerge-merge-menu [emerge-insert-B]
    '("Insert B" . emerge-insert-B))
  (define-key emerge-merge-menu [emerge-insert-A]
    '("Insert A" . emerge-insert-A))
  (define-key emerge-merge-menu [emerge-select-B]
    '("Select B" . emerge-select-B))
  (define-key emerge-merge-menu [emerge-select-A]
    '("Select A" . emerge-select-A)))


;; Variables which control each merge.  They are local to the merge buffer.

;; Mode variables
(emerge-defvar-local emerge-mode nil
  "Indicator for emerge-mode.")
(emerge-defvar-local emerge-fast-mode nil
  "Indicator for emerge-mode fast submode.")
(emerge-defvar-local emerge-edit-mode nil
  "Indicator for emerge-mode edit submode.")
(emerge-defvar-local emerge-A-buffer nil
  "The buffer in which the A variant is stored.")
(emerge-defvar-local emerge-B-buffer nil
  "The buffer in which the B variant is stored.")
(emerge-defvar-local emerge-merge-buffer nil
  "The buffer in which the merged file is manipulated.")
(emerge-defvar-local emerge-ancestor-buffer nil
  "The buffer in which the ancestor variant is stored,
or nil if there is none.")

(defconst emerge-saved-variables
  '((buffer-modified-p set-buffer-modified-p)
    buffer-read-only
    buffer-auto-save-file-name)
  "Variables and properties of a buffer which are saved, modified and restored
during a merge.")
(defconst emerge-merging-values '(nil t nil)
  "Values to be assigned to emerge-saved-variables during a merge.")

(emerge-defvar-local emerge-A-buffer-values nil
  "Remembers emerge-saved-variables for emerge-A-buffer.")
(emerge-defvar-local emerge-B-buffer-values nil
  "Remembers emerge-saved-variables for emerge-B-buffer.")

(emerge-defvar-local emerge-difference-list nil
  "Vector of differences between the variants, and markers in the buffers to
show where they are.  Each difference is represented by a vector of seven
elements.  The first two are markers to the beginning and end of the difference
section in the A buffer, the second two are markers for the B buffer, the third
two are markers for the merge buffer, and the last element is the \"state\" of
that difference in the merge buffer.
  A section of a buffer is described by two markers, one to the beginning of
the first line of the section, and one to the beginning of the first line
after the section.  (If the section is empty, both markers point to the same
point.)  If the section is part of the selected difference, then the markers
are moved into the flags, so the user can edit the section without disturbing
the markers.
  The \"states\" are:
	A		the merge buffer currently contains the A variant
	B		the merge buffer currently contains the B variant
	default-A	the merge buffer contains the A variant by default,
			but this difference hasn't been selected yet, so
			change-default commands can alter it
	default-B	the merge buffer contains the B variant by default,
			but this difference hasn't been selected yet, so
			change-default commands can alter it
	prefer-A	in a three-file merge, the A variant is the preferred
			choice
	prefer-B	in a three-file merge, the B variant is the preferred
			choice")
(emerge-defvar-local emerge-current-difference -1
  "The difference that is currently selected.")
(emerge-defvar-local emerge-number-of-differences nil
  "Number of differences found.")
(emerge-defvar-local emerge-edit-keymap nil
  "The local keymap for the merge buffer, with the emerge commands defined in
it.  Used to save the local keymap during fast mode, when the local keymap is
replaced by emerge-fast-keymap.")
(emerge-defvar-local emerge-old-keymap nil
  "The original local keymap for the merge buffer.")
(emerge-defvar-local emerge-auto-advance nil
  "*If non-nil, emerge-select-A and emerge-select-B automatically advance to
the next difference.")
(emerge-defvar-local emerge-skip-prefers nil
  "*If non-nil, differences for which there is a preference are automatically
skipped.")
(emerge-defvar-local emerge-quit-hook nil
  "Hooks to run in the merge buffer after the merge has been finished.
`emerge-prefix-argument' will hold the prefix argument of the `emerge-quit'
command.
This is *not* a user option, since Emerge uses it for its own processing.")
(emerge-defvar-local emerge-output-description nil
  "Describes output destination of emerge, for `emerge-file-names'.")

;;; Setup functions for two-file mode.

(defun emerge-files-internal (file-A file-B &optional startup-hooks quit-hooks
				     output-file)
  (if (not (file-readable-p file-A))
      (error "File `%s' does not exist or is not readable" file-A))
  (if (not (file-readable-p file-B))
      (error "File `%s' does not exist or is not readable" file-B))
  (let ((buffer-A (find-file-noselect file-A))
	(buffer-B (find-file-noselect file-B)))
    ;; Record the directories of the files
    (setq emerge-last-dir-A (file-name-directory file-A))
    (setq emerge-last-dir-B (file-name-directory file-B))
    (if output-file
	(setq emerge-last-dir-output (file-name-directory output-file)))
    ;; Make sure the entire files are seen, and they reflect what is on disk
    (emerge-eval-in-buffer 
     buffer-A
     (widen)
     (let ((temp (file-local-copy file-A)))
       (if temp
	   (setq file-A temp
		 startup-hooks
		 (cons (` (lambda () (delete-file (, file-A))))
		       startup-hooks))
	 ;; Verify that the file matches the buffer
	 (emerge-verify-file-buffer))))
    (emerge-eval-in-buffer
     buffer-B
     (widen)
     (let ((temp (file-local-copy file-B)))
       (if temp
	   (setq file-B temp
		 startup-hooks
		 (cons (` (lambda () (delete-file (, file-B))))
		       startup-hooks))
	 ;; Verify that the file matches the buffer
	 (emerge-verify-file-buffer))))
    (emerge-setup buffer-A file-A buffer-B file-B startup-hooks quit-hooks
		  output-file)))

;; Start up Emerge on two files
(defun emerge-setup (buffer-A file-A buffer-B file-B startup-hooks quit-hooks
			      output-file)
  (setq file-A (expand-file-name file-A))
  (setq file-B (expand-file-name file-B))
  (setq output-file (and output-file (expand-file-name output-file)))
  (let* ((merge-buffer-name (emerge-unique-buffer-name "*merge" "*"))
	 ;; create the merge buffer from buffer A, so it inherits buffer A's
	 ;; default directory, etc.
	 (merge-buffer (emerge-eval-in-buffer
			buffer-A
			(get-buffer-create merge-buffer-name))))
    (emerge-eval-in-buffer
     merge-buffer
     (emerge-copy-modes buffer-A)
     (setq buffer-read-only nil)
     (auto-save-mode 1)
     (setq emerge-mode t)
     (setq emerge-A-buffer buffer-A)
     (setq emerge-B-buffer buffer-B)
     (setq emerge-ancestor-buffer nil)
     (setq emerge-merge-buffer merge-buffer)
     (setq emerge-output-description
	   (if output-file
	       (concat "Output to file: " output-file)
	     (concat "Output to buffer: " (buffer-name merge-buffer))))
     (insert-buffer emerge-A-buffer)
     (emerge-set-keys)
     (setq emerge-difference-list (emerge-make-diff-list file-A file-B))
     (setq emerge-number-of-differences (length emerge-difference-list))
     (setq emerge-current-difference -1)
     (setq emerge-quit-hook quit-hooks)
     (emerge-remember-buffer-characteristics)
     (emerge-handle-local-variables))
    (emerge-setup-windows buffer-A buffer-B merge-buffer t)
    (emerge-eval-in-buffer merge-buffer
			   (run-hooks 'startup-hooks 'emerge-startup-hook)
			   (setq buffer-read-only t))))

;; Generate the Emerge difference list between two files
(defun emerge-make-diff-list (file-A file-B)
  (setq emerge-diff-buffer (get-buffer-create "*emerge-diff*"))
  (emerge-eval-in-buffer
   emerge-diff-buffer
   (erase-buffer)
   (shell-command
    (format "%s %s %s %s"
	    emerge-diff-program emerge-diff-options
	    (emerge-protect-metachars file-A)
	    (emerge-protect-metachars file-B))
    t))
  (emerge-prepare-error-list emerge-diff-ok-lines-regexp)
  (emerge-convert-diffs-to-markers
   emerge-A-buffer emerge-B-buffer emerge-merge-buffer
   (emerge-extract-diffs emerge-diff-buffer)))

(defun emerge-extract-diffs (diff-buffer)
  (let (list)
    (emerge-eval-in-buffer
     diff-buffer
     (goto-char (point-min))
     (while (re-search-forward emerge-match-diff-line nil t)
       (let* ((a-begin (string-to-int (buffer-substring (match-beginning 1)
							(match-end 1))))
	      (a-end  (let ((b (match-beginning 3))
			    (e (match-end 3)))
			(if b
			    (string-to-int (buffer-substring b e))
			  a-begin)))
	      (diff-type (buffer-substring (match-beginning 4) (match-end 4)))
	      (b-begin (string-to-int (buffer-substring (match-beginning 5)
							(match-end 5))))
	      (b-end (let ((b (match-beginning 7))
			   (e (match-end 7)))
		       (if b
			   (string-to-int (buffer-substring b e))
			 b-begin))))
	 ;; fix the beginning and end numbers, because diff is somewhat
	 ;; strange about how it numbers lines
	 (if (string-equal diff-type "a")
	     (progn
	       (setq b-end (1+ b-end))
	       (setq a-begin (1+ a-begin))
	       (setq a-end a-begin))
	   (if (string-equal diff-type "d")
	       (progn
		 (setq a-end (1+ a-end))
		 (setq b-begin (1+ b-begin))
		 (setq b-end b-begin))
	     ;; (string-equal diff-type "c")
	     (progn
	       (setq a-end (1+ a-end))
	       (setq b-end (1+ b-end)))))
	 (setq list (cons (vector a-begin a-end
				  b-begin b-end
				  'default-A)
			  list)))))
    (nreverse list)))

;; Set up buffer of diff/diff3 error messages.
(defun emerge-prepare-error-list (ok-regexp)
  (setq emerge-diff-error-buffer (get-buffer-create "*emerge-diff-errors*"))
  (emerge-eval-in-buffer
   emerge-diff-error-buffer
   (erase-buffer)
   (insert-buffer emerge-diff-buffer)
   (delete-matching-lines ok-regexp)))

;;; Top-level and setup functions for three-file mode.

(defun emerge-files-with-ancestor-internal (file-A file-B file-ancestor
					    &optional startup-hooks quit-hooks
					    output-file)
  (if (not (file-readable-p file-A))
      (error "File `%s' does not exist or is not readable" file-A))
  (if (not (file-readable-p file-B))
      (error "File `%s' does not exist or is not readable" file-B))
  (if (not (file-readable-p file-ancestor))
      (error "File `%s' does not exist or is not readable" file-ancestor))
  (let ((buffer-A (find-file-noselect file-A))
	(buffer-B (find-file-noselect file-B))
	(buffer-ancestor (find-file-noselect file-ancestor)))
    ;; Record the directories of the files
    (setq emerge-last-dir-A (file-name-directory file-A))
    (setq emerge-last-dir-B (file-name-directory file-B))
    (setq emerge-last-dir-ancestor (file-name-directory file-ancestor))
    (if output-file
	(setq emerge-last-dir-output (file-name-directory output-file)))
    ;; Make sure the entire files are seen, and they reflect what is on disk
    (emerge-eval-in-buffer
     buffer-A
     (widen)
     (let ((temp (file-local-copy file-A)))
       (if temp
	   (setq file-A temp
		 startup-hooks
		 (cons (` (lambda () (delete-file (, file-A))))
		       startup-hooks))
	 ;; Verify that the file matches the buffer
	 (emerge-verify-file-buffer))))
    (emerge-eval-in-buffer
     buffer-B
     (widen)
     (let ((temp (file-local-copy file-B)))
       (if temp
	   (setq file-B temp
		 startup-hooks
		 (cons (` (lambda () (delete-file (, file-B))))
		       startup-hooks))
	 ;; Verify that the file matches the buffer
	 (emerge-verify-file-buffer))))
    (emerge-eval-in-buffer
     buffer-ancestor
     (widen)
     (let ((temp (file-local-copy file-ancestor)))
       (if temp
	   (setq file-ancestor temp
		 startup-hooks
		 (cons (` (lambda () (delete-file (, file-ancestor))))
		       startup-hooks))
	 ;; Verify that the file matches the buffer
	 (emerge-verify-file-buffer))))
    (emerge-setup-with-ancestor buffer-A file-A buffer-B file-B
				buffer-ancestor file-ancestor
				startup-hooks quit-hooks output-file)))

;; Start up Emerge on two files with an ancestor
(defun emerge-setup-with-ancestor (buffer-A file-A buffer-B file-B
					    buffer-ancestor file-ancestor
					    &optional startup-hooks quit-hooks
					    output-file)
  (setq file-A (expand-file-name file-A))
  (setq file-B (expand-file-name file-B))
  (setq file-ancestor (expand-file-name file-ancestor))
  (setq output-file (and output-file (expand-file-name output-file)))
  (let* ((merge-buffer-name (emerge-unique-buffer-name "*merge" "*"))
	 ;; create the merge buffer from buffer A, so it inherits buffer A's
	 ;; default directory, etc.
	 (merge-buffer (emerge-eval-in-buffer
			buffer-A
			(get-buffer-create merge-buffer-name))))
    (emerge-eval-in-buffer
     merge-buffer
     (emerge-copy-modes buffer-A)
     (setq buffer-read-only nil)
     (auto-save-mode 1)
     (setq emerge-mode t)
     (setq emerge-A-buffer buffer-A)
     (setq emerge-B-buffer buffer-B)
     (setq emerge-ancestor-buffer buffer-ancestor)
     (setq emerge-merge-buffer merge-buffer)
     (setq emerge-output-description
	   (if output-file
	       (concat "Output to file: " output-file)
	     (concat "Output to buffer: " (buffer-name merge-buffer))))
     (insert-buffer emerge-A-buffer)
     (emerge-set-keys)
     (setq emerge-difference-list
	   (emerge-make-diff3-list file-A file-B file-ancestor))
     (setq emerge-number-of-differences (length emerge-difference-list))
     (setq emerge-current-difference -1)
     (setq emerge-quit-hook quit-hooks)
     (emerge-remember-buffer-characteristics)
     (emerge-select-prefer-Bs)
     (emerge-handle-local-variables))
    (emerge-setup-windows buffer-A buffer-B merge-buffer t)
    (emerge-eval-in-buffer merge-buffer
			   (run-hooks 'startup-hooks 'emerge-startup-hook)
			   (setq buffer-read-only t))))

;; Generate the Emerge difference list between two files with an ancestor
(defun emerge-make-diff3-list (file-A file-B file-ancestor)
  (setq emerge-diff-buffer (get-buffer-create "*emerge-diff*"))
  (emerge-eval-in-buffer
   emerge-diff-buffer
   (erase-buffer)
   (shell-command
    (format "%s %s %s %s %s"
	    emerge-diff3-program emerge-diff-options
	    (emerge-protect-metachars file-A)
	    (emerge-protect-metachars file-ancestor)
	    (emerge-protect-metachars file-B))
    t))
  (emerge-prepare-error-list emerge-diff3-ok-lines-regexp)
  (emerge-convert-diffs-to-markers
   emerge-A-buffer emerge-B-buffer emerge-merge-buffer
   (emerge-extract-diffs3 emerge-diff-buffer)))

(defun emerge-extract-diffs3 (diff-buffer)
  (let (list)
    (emerge-eval-in-buffer
     diff-buffer
     (while (re-search-forward "^====\\(.?\\)$" nil t)
       ;; leave point after matched line
       (beginning-of-line 2)
       (let ((agreement (buffer-substring (match-beginning 1) (match-end 1))))
	 ;; if the A and B files are the same, ignore the difference
	 (if (not (string-equal agreement "2"))
	     (setq list
		   (cons 
		    (let (group-1 group-3 pos)
		      (setq pos (point))
		      (setq group-1 (emerge-get-diff3-group "1"))
		      (goto-char pos)
		      (setq group-3 (emerge-get-diff3-group "3"))
		      (vector (car group-1) (car (cdr group-1))
			      (car group-3) (car (cdr group-3))
			      (cond ((string-equal agreement "1") 'prefer-A)
				    ((string-equal agreement "3") 'prefer-B)
				    (t 'default-A))))
		    list))))))
    (nreverse list)))

(defun emerge-get-diff3-group (file)
  ;; This save-excursion allows emerge-get-diff3-group to be called for the
  ;; various groups of lines (1, 2, 3) in any order, and for the lines to
  ;; appear in any order.  The reason this is necessary is that Gnu diff3
  ;; can produce the groups in the order 1, 2, 3 or 1, 3, 2.
  (save-excursion
    (re-search-forward
     (concat "^" file ":\\([0-9]+\\)\\(,\\([0-9]+\\)\\)?\\([ac]\\)$"))
    (beginning-of-line 2)
    ;; treatment depends on whether it is an "a" group or a "c" group
    (if (string-equal (buffer-substring (match-beginning 4) (match-end 4)) "c")
	;; it is a "c" group
	(if (match-beginning 2)
	    ;; it has two numbers
	    (list (string-to-int
		   (buffer-substring (match-beginning 1) (match-end 1)))
		  (1+ (string-to-int
		       (buffer-substring (match-beginning 3) (match-end 3)))))
	  ;; it has one number
	  (let ((x (string-to-int
		    (buffer-substring (match-beginning 1) (match-end 1)))))
	    (list x (1+ x))))
      ;; it is an "a" group
      (let ((x (1+ (string-to-int
		    (buffer-substring (match-beginning 1) (match-end 1))))))
	(list x x)))))

;;; Functions to start Emerge on files

;;;###autoload
(defun emerge-files (arg file-A file-B file-out &optional startup-hooks
		     quit-hooks)
  "Run Emerge on two files."
  (interactive
   (let (f)
     (list current-prefix-arg
	   (setq f (emerge-read-file-name "File A to merge" emerge-last-dir-A
					  nil nil t))
	   (emerge-read-file-name "File B to merge" emerge-last-dir-B nil f t)
	   (and current-prefix-arg
		(emerge-read-file-name "Output file" emerge-last-dir-output
				       f f nil)))))
  (emerge-files-internal
   file-A file-B startup-hooks
   (if file-out
       (cons (` (lambda () (emerge-files-exit (, file-out))))
	     quit-hooks)
     quit-hooks)
   file-out))

;;;###autoload
(defun emerge-files-with-ancestor (arg file-A file-B file-ancestor file-out
				   &optional startup-hooks quit-hooks)
  "Run Emerge on two files, giving another file as the ancestor."
  (interactive
   (let (f)
     (list current-prefix-arg
	   (setq f (emerge-read-file-name "File A to merge" emerge-last-dir-A
					  nil nil t))
	   (emerge-read-file-name "File B to merge" emerge-last-dir-B nil f t)
	   (emerge-read-file-name "Ancestor file" emerge-last-dir-ancestor
				  nil f t)
	   (and current-prefix-arg
		(emerge-read-file-name "Output file" emerge-last-dir-output
				       f f nil)))))
  (emerge-files-with-ancestor-internal
   file-A file-B file-ancestor startup-hooks
   (if file-out
       (cons (` (lambda () (emerge-files-exit (, file-out))))
	     quit-hooks)
     quit-hooks)
   file-out))

;; Write the merge buffer out in place of the file the A buffer is visiting.
(defun emerge-files-exit (file-out)
  ;; if merge was successful was given, save to disk
  (if (not emerge-prefix-argument)
      (emerge-write-and-delete file-out)))

;;; Functions to start Emerge on buffers

;;;###autoload
(defun emerge-buffers (buffer-A buffer-B &optional startup-hooks quit-hooks)
  "Run Emerge on two buffers."
  (interactive "bBuffer A to merge: \nbBuffer B to merge: ")
  (let ((emerge-file-A (emerge-make-temp-file "A"))
	(emerge-file-B (emerge-make-temp-file "B")))
    (emerge-eval-in-buffer
     buffer-A
     (write-region (point-min) (point-max) emerge-file-A nil 'no-message))
    (emerge-eval-in-buffer
     buffer-B
     (write-region (point-min) (point-max) emerge-file-B nil 'no-message))
    (emerge-setup (get-buffer buffer-A) emerge-file-A
		  (get-buffer buffer-B) emerge-file-B
		  (cons (` (lambda ()
			     (delete-file (, emerge-file-A))
			     (delete-file (, emerge-file-B))))
			startup-hooks)
		  quit-hooks
		  nil)))

;;;###autoload
(defun emerge-buffers-with-ancestor (buffer-A buffer-B buffer-ancestor
					      &optional startup-hooks
					      quit-hooks)
  "Run Emerge on two buffers, giving another buffer as the ancestor."
  (interactive
   "bBuffer A to merge: \nbBuffer B to merge: \nbAncestor buffer: ")
  (let ((emerge-file-A (emerge-make-temp-file "A"))
	(emerge-file-B (emerge-make-temp-file "B"))
	(emerge-file-ancestor (emerge-make-temp-file "anc")))
    (emerge-eval-in-buffer
     buffer-A
     (write-region (point-min) (point-max) emerge-file-A nil 'no-message))
    (emerge-eval-in-buffer
     buffer-B
     (write-region (point-min) (point-max) emerge-file-B nil 'no-message))
    (emerge-eval-in-buffer
     buffer-ancestor
     (write-region (point-min) (point-max) emerge-file-ancestor nil
		   'no-message))
    (emerge-setup-with-ancestor (get-buffer buffer-A) emerge-file-A
				(get-buffer buffer-B) emerge-file-B
				(get-buffer buffer-ancestor)
				emerge-file-ancestor
				(cons (` (lambda ()
					   (delete-file (, emerge-file-A))
					   (delete-file (, emerge-file-B))
					   (delete-file
					    (, emerge-file-ancestor))))
				      startup-hooks)
				quit-hooks
				nil)))

;;; Functions to start Emerge from the command line

;;;###autoload
(defun emerge-files-command ()
  (let ((file-a (nth 0 command-line-args-left))
	(file-b (nth 1 command-line-args-left))
	(file-out (nth 2 command-line-args-left)))
    (setq command-line-args-left (nthcdr 3 command-line-args-left))
    (emerge-files-internal
     file-a file-b nil
     (list (` (lambda () (emerge-command-exit (, file-out))))))))

;;;###autoload
(defun emerge-files-with-ancestor-command ()
  (let (file-a file-b file-anc file-out)
    ;; check for a -a flag, for filemerge compatibility
    (if (string= (car command-line-args-left) "-a")
	;; arguments are "-a ancestor file-a file-b file-out"
	(progn
	  (setq file-a (nth 2 command-line-args-left))
	  (setq file-b (nth 3 command-line-args-left))
	  (setq file-anc (nth 1 command-line-args-left))
	  (setq file-out (nth 4 command-line-args-left))
	  (setq command-line-args-left (nthcdr 5 command-line-args-left)))
      ;; arguments are "file-a file-b ancestor file-out"
      (setq file-a (nth 0 command-line-args-left))
      (setq file-b (nth 1 command-line-args-left))
      (setq file-anc (nth 2 command-line-args-left))
      (setq file-out (nth 3 command-line-args-left))
      (setq command-line-args-left (nthcdr 4 command-line-args-left)))
    (emerge-files-with-ancestor-internal
     file-a file-b file-anc nil
     (list (` (lambda () (emerge-command-exit (, file-out))))))))
      
(defun emerge-command-exit (file-out)
  (emerge-write-and-delete file-out)
  (kill-emacs (if emerge-prefix-argument 1 0)))

;;; Functions to start Emerge via remote request

;;;###autoload
(defun emerge-files-remote (file-a file-b file-out)
  (setq emerge-file-out file-out)
  (emerge-files-internal
   file-a file-b nil
   (list (` (lambda () (emerge-remote-exit (, file-out) '(, emerge-exit-func)))))
   file-out)
  (throw 'client-wait nil))

;;;###autoload
(defun emerge-files-with-ancestor-remote (file-a file-b file-anc file-out)
  (setq emerge-file-out file-out)
  (emerge-files-with-ancestor-internal
   file-a file-b file-anc nil
   (list (` (lambda () (emerge-remote-exit (, file-out) '(, emerge-exit-func)))))
   file-out)
  (throw 'client-wait nil))

(defun emerge-remote-exit (file-out emerge-exit-func)
  (emerge-write-and-delete file-out)
  (kill-buffer emerge-merge-buffer)
  (funcall emerge-exit-func (if emerge-prefix-argument 1 0)))

;;; Functions to start Emerge on RCS versions

;;;###autoload
(defun emerge-revisions (arg file revision-A revision-B
			 &optional startup-hooks quit-hooks)
  "Emerge two RCS revisions of a file."
  (interactive
   (list current-prefix-arg
	 (read-file-name "File to merge: " nil nil 'confirm)
	 (read-string "Revision A to merge: " emerge-last-revision-A)
	 (read-string "Revision B to merge: " emerge-last-revision-B)))
  (setq emerge-last-revision-A revision-A
	emerge-last-revision-B revision-B)
  (emerge-revisions-internal
   file revision-A revision-B startup-hooks
   (if arg
       (cons (` (lambda ()
		  (shell-command
		   (, (format "%s %s" emerge-rcs-ci-program file)))))
	     quit-hooks)
     quit-hooks)))

;;;###autoload
(defun emerge-revisions-with-ancestor (arg file revision-A
					   revision-B ancestor
					   &optional
					   startup-hooks quit-hooks)
  "Emerge two RCS revisions of a file, with another revision as ancestor."
  (interactive
   (list current-prefix-arg
	 (read-file-name "File to merge: " nil nil 'confirm)
	 (read-string "Revision A to merge: " emerge-last-revision-A)
	 (read-string "Revision B to merge: " emerge-last-revision-B)
	 (read-string "Ancestor: " emerge-last-revision-ancestor)))
  (setq emerge-last-revision-A revision-A
	emerge-last-revision-B revision-B
	emerge-last-revision-ancestor ancestor)
  (emerge-revision-with-ancestor-internal
   file revision-A revision-B ancestor startup-hooks
   (if arg
       (let ((cmd ))
	 (cons (` (lambda ()
		    (shell-command
		     (, (format "%s %s" emerge-rcs-ci-program file)))))
	       quit-hooks))
     quit-hooks)))

(defun emerge-revisions-internal (file revision-A revision-B &optional
				      startup-hooks quit-hooks output-file)
  (let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A)))
	(buffer-B (get-buffer-create (format "%s,%s" file revision-B)))
	(emerge-file-A (emerge-make-temp-file "A"))
	(emerge-file-B (emerge-make-temp-file "B")))
    ;; Get the revisions into buffers
    (emerge-eval-in-buffer
     buffer-A
     (erase-buffer)
     (shell-command
      (format "%s -q -p%s %s" emerge-rcs-co-program revision-A file)
      t)
     (write-region (point-min) (point-max) emerge-file-A nil 'no-message)
     (set-buffer-modified-p nil))
    (emerge-eval-in-buffer
     buffer-B
     (erase-buffer)
     (shell-command
      (format "%s -q -p%s %s" emerge-rcs-co-program revision-B file)
      t)
     (write-region (point-min) (point-max) emerge-file-B nil 'no-message)
     (set-buffer-modified-p nil))
    ;; Do the merge
    (emerge-setup buffer-A emerge-file-A
		  buffer-B emerge-file-B
		  (cons (` (lambda ()
			     (delete-file (, emerge-file-A))
			     (delete-file (, emerge-file-B))))
			startup-hooks)
		  (cons (` (lambda () (emerge-files-exit (, file))))
			quit-hooks)
		  nil)))

(defun emerge-revision-with-ancestor-internal (file revision-A revision-B
						    ancestor
						    &optional startup-hooks
						    quit-hooks output-file)
  (let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A)))
	(buffer-B (get-buffer-create (format "%s,%s" file revision-B)))
	(buffer-ancestor (get-buffer-create (format "%s,%s" file ancestor)))
	(emerge-file-A (emerge-make-temp-file "A"))
	(emerge-file-B (emerge-make-temp-file "B"))
	(emerge-ancestor (emerge-make-temp-file "ancestor")))
    ;; Get the revisions into buffers
    (emerge-eval-in-buffer
     buffer-A
     (erase-buffer)
     (shell-command
      (format "%s -q -p%s %s" emerge-rcs-co-program
	      revision-A file)
      t)
     (write-region (point-min) (point-max) emerge-file-A nil 'no-message)
     (set-buffer-modified-p nil))
    (emerge-eval-in-buffer
     buffer-B
     (erase-buffer)
     (shell-command
      (format "%s -q -p%s %s" emerge-rcs-co-program revision-B file)
      t)
     (write-region (point-min) (point-max) emerge-file-B nil 'no-message)
     (set-buffer-modified-p nil))
    (emerge-eval-in-buffer
     buffer-ancestor
     (erase-buffer)
     (shell-command
      (format "%s -q -p%s %s" emerge-rcs-co-program ancestor file)
      t)
     (write-region (point-min) (point-max) emerge-ancestor nil 'no-message)
     (set-buffer-modified-p nil))
    ;; Do the merge
    (emerge-setup-with-ancestor
     buffer-A emerge-file-A buffer-B emerge-file-B
     buffer-ancestor emerge-ancestor
     (cons (` (lambda ()
		(delete-file (, emerge-file-A))
		(delete-file (, emerge-file-B))
		(delete-file (, emerge-ancestor))))
	   startup-hooks)
     (cons (` (lambda () (emerge-files-exit (, file))))
	   quit-hooks)
     output-file)))

;;; Function to start Emerge based on a line in a file

(defun emerge-execute-line ()
  "Run Emerge using files named in current text line.
Looks in that line for whitespace-separated entries of these forms:
	a=file1
	b=file2
	ancestor=file3
	output=file4
to specify the files to use in Emerge.

In addition, if only one of `a=file' or `b=file' is present, and `output=file'
is present:
If `emerge-execute-line-deletions' is non-nil and `ancestor=file' is present,
it is assumed that the file in question has been deleted, and it is
not copied to the output file.
Otherwise, the A or B file present is copied to the output file."
  (interactive)
  (let (file-A file-B file-ancestor file-out
	       (case-fold-search t))
    ;; Stop if at end of buffer (even though we might be in a line, if
    ;; the line does not end with newline)
    (if (eobp)
	(error "At end of buffer"))
    ;; Go to the beginning of the line
    (beginning-of-line)
    ;; Skip any initial whitespace
    (if (looking-at "[ \t]*")
	(goto-char (match-end 0)))
    ;; Process the entire line
    (while (not (eolp))
      ;; Get the next entry
      (if (looking-at "\\([a-z]+\\)=\\([^ \t\n]+\\)[ \t]*")
	  ;; Break apart the tab (before =) and the filename (after =)
	  (let ((tag (downcase
		      (buffer-substring (match-beginning 1) (match-end 1))))
		(file (buffer-substring (match-beginning 2) (match-end 2))))
	    ;; Move point after the entry
	    (goto-char (match-end 0))
	    ;; Store the filename in the right variable
	    (cond
	     ((string-equal tag "a")
	      (if file-A
		  (error "This line has two `A' entries"))
	      (setq file-A file))
	     ((string-equal tag "b")
	      (if file-B
		  (error "This line has two `B' entries"))
	      (setq file-B file))
	     ((or (string-equal tag "anc") (string-equal tag "ancestor"))
	      (if file-ancestor
		  (error "This line has two `ancestor' entries"))
	      (setq file-ancestor file))
	     ((or (string-equal tag "out") (string-equal tag "output"))
	      (if file-out
		  (error "This line has two `output' entries"))
	      (setq file-out file))
	     (t
	      (error "Unrecognized entry"))))
	;; If the match on the entry pattern failed
	(error "Unparsable entry")))
    ;; Make sure that file-A and file-B are present
    (if (not (or (and file-A file-B) file-out))
	(error "Must have both `A' and `B' entries"))
    (if (not (or file-A file-B))
	(error "Must have `A' or `B' entry"))
    ;; Go to the beginning of the next line, so next execution will use
    ;; next line in buffer.
    (beginning-of-line 2)
    ;; Execute the correct command
    (cond
     ;; Merge of two files with ancestor
     ((and file-A file-B file-ancestor)
      (message "Merging %s and %s..." file-A file-B)
      (emerge-files-with-ancestor (not (not file-out)) file-A file-B
				  file-ancestor file-out
				  nil
				  ;; When done, return to this buffer.
				  (list
				   (` (lambda ()
					(switch-to-buffer (, (current-buffer)))
					(message "Merge done."))))))
     ;; Merge of two files without ancestor
     ((and file-A file-B)
      (message "Merging %s and %s..." file-A file-B)
      (emerge-files (not (not file-out)) file-A file-B file-out
		    nil
		    ;; When done, return to this buffer.
		    (list 
		     (` (lambda ()
			  (switch-to-buffer (, (current-buffer)))
			  (message "Merge done."))))))
     ;; There is an output file (or there would have been an error above),
     ;; but only one input file.
     ;; The file appears to have been deleted in one version; do nothing.
     ((and file-ancestor emerge-execute-line-deletions)
      (message "No action."))
     ;; The file should be copied from the version that contains it
     (t (let ((input-file (or file-A file-B)))
	  (message "Copying...")
	  (copy-file input-file file-out)
	  (message "%s copied to %s." input-file file-out))))))

;;; Sample function for creating information for emerge-execute-line

(defvar emerge-merge-directories-filename-regexp "[^.]"
  "Regexp describing files to be processed by `emerge-merge-directories'.")

;;;###autoload
(defun emerge-merge-directories (a-dir b-dir ancestor-dir output-dir)
  (interactive 
   (list
    (read-file-name "A directory: " nil nil 'confirm)
    (read-file-name "B directory: " nil nil 'confirm)
    (read-file-name "Ancestor directory (null for none): " nil nil 'confirm)
    (read-file-name "Output directory (null for none): " nil nil 'confirm)))
  ;; Check that we're not on a line
  (if (not (and (bolp) (eolp)))
      (error "There is text on this line"))
  ;; Turn null strings into nil to indicate directories not used.
  (if (and ancestor-dir (string-equal ancestor-dir ""))
      (setq ancestor-dir nil))
  (if (and output-dir (string-equal output-dir ""))
      (setq output-dir nil))
  ;; Canonicalize the directory names
  (setq a-dir (expand-file-name a-dir))
  (if (not (string-equal (substring a-dir -1) "/"))
      (setq a-dir (concat a-dir "/")))
  (setq b-dir (expand-file-name b-dir))
  (if (not (string-equal (substring b-dir -1) "/"))
      (setq b-dir (concat b-dir "/")))
  (if ancestor-dir
      (progn
	(setq ancestor-dir (expand-file-name ancestor-dir))
	(if (not (string-equal (substring ancestor-dir -1) "/"))
	    (setq ancestor-dir (concat ancestor-dir "/")))))
  (if output-dir
      (progn
	(setq output-dir (expand-file-name output-dir))
	(if (not (string-equal (substring output-dir -1) "/"))
	    (setq output-dir (concat output-dir "/")))))
  ;; Set the mark to where we start
  (push-mark)
  ;; Find out what files are in the directories.
  (let* ((a-dir-files
	  (directory-files a-dir nil emerge-merge-directories-filename-regexp))
	 (b-dir-files
	  (directory-files b-dir nil emerge-merge-directories-filename-regexp))
	 (ancestor-dir-files
	  (and ancestor-dir
	       (directory-files ancestor-dir nil
				emerge-merge-directories-filename-regexp)))
	 (all-files (sort (nconc (copy-sequence a-dir-files)
				 (copy-sequence b-dir-files)
				 (copy-sequence ancestor-dir-files))
			  (function string-lessp))))
    ;; Remove duplicates from all-files.
    (let ((p all-files))
      (while p
	(if (and (cdr p) (string-equal (car p) (car (cdr p))))
	    (setcdr p (cdr (cdr p)))
	  (setq p (cdr p)))))
    ;; Generate the control lines for the various files.
    (while all-files
      (let ((f (car all-files)))
	(setq all-files (cdr all-files))
	(if (and a-dir-files (string-equal (car a-dir-files) f))
	    (progn
	      (insert "A=" a-dir f "\t")
	      (setq a-dir-files (cdr a-dir-files))))
	(if (and b-dir-files (string-equal (car b-dir-files) f))
	    (progn
	      (insert "B=" b-dir f "\t")
	      (setq b-dir-files (cdr b-dir-files))))
	(if (and ancestor-dir-files (string-equal (car ancestor-dir-files) f))
	    (progn
	      (insert "ancestor=" ancestor-dir f "\t")
	      (setq ancestor-dir-files (cdr ancestor-dir-files))))
	(if output-dir
	    (insert "output=" output-dir f "\t"))
	(backward-delete-char 1)
	(insert "\n")))))

;;; Common setup routines

;; Set up the window configuration.  If POS is given, set the points to
;; the beginnings of the buffers.
(defun emerge-setup-windows (buffer-A buffer-B merge-buffer &optional pos)
  ;; Make sure we are not in the minibuffer window when we try to delete
  ;; all other windows.
  (if (eq (selected-window) (minibuffer-window))
      (other-window 1))
  (delete-other-windows)
  (switch-to-buffer merge-buffer)
  (emerge-refresh-mode-line)
  (split-window-vertically)
  (split-window-horizontally)
  (switch-to-buffer buffer-A)
  (if pos
      (goto-char (point-min)))
  (other-window 1)
  (switch-to-buffer buffer-B)
  (if pos
      (goto-char (point-min)))
  (other-window 1)
  (if pos
      (goto-char (point-min)))
  ;; If diff/diff3 reports errors, display them rather than the merge buffer.
  (if (/= 0 (emerge-eval-in-buffer emerge-diff-error-buffer (buffer-size)))
      (progn
	(ding)
	(message "Errors found in diff/diff3 output.  Merge buffer is %s."
		 (buffer-name emerge-merge-buffer))
	(switch-to-buffer emerge-diff-error-buffer))))

;; Set up the keymap in the merge buffer
(defun emerge-set-keys ()
  ;; Set up fixed keymaps if necessary
  (if (not emerge-basic-keymap)
      (emerge-setup-fixed-keymaps))
  ;; Save the old local map
  (setq emerge-old-keymap (current-local-map))
  ;; Construct the edit keymap
  (setq emerge-edit-keymap (if emerge-old-keymap
			       (copy-keymap emerge-old-keymap)
			     (make-sparse-keymap)))
  ;; Install the Emerge commands
  (emerge-force-define-key emerge-edit-keymap emerge-command-prefix
			   'emerge-basic-keymap)
  (define-key emerge-edit-keymap [menu-bar] (make-sparse-keymap))

  ;; Create the additional menu bar items.
  (define-key emerge-edit-keymap [menu-bar options]
    (cons "Options" emerge-options-menu))
  (define-key emerge-edit-keymap [menu-bar merge]
    (cons "Merge" emerge-merge-menu))
  (define-key emerge-edit-keymap [menu-bar move]
    (cons "Move" emerge-move-menu))

  ;; Suppress write-file and save-buffer
  (substitute-key-definition 'write-file
			     'emerge-query-write-file
			     emerge-edit-keymap)
  (substitute-key-definition 'save-buffer
			     'emerge-query-save-buffer
			     emerge-edit-keymap)
  (substitute-key-definition 'write-file 'emerge-query-write-file
			     emerge-edit-keymap (current-global-map))
  (substitute-key-definition 'save-buffer 'emerge-query-save-buffer
			     emerge-edit-keymap (current-global-map))
  (use-local-map emerge-fast-keymap)
  (setq emerge-edit-mode nil)
  (setq emerge-fast-mode t))

(defun emerge-remember-buffer-characteristics ()
  "Record certain properties of the buffers being merged.
Must be called in the merge buffer.  Remembers read-only, modified,
auto-save, and saves them in buffer local variables.  Sets the buffers
read-only and turns off `auto-save-mode'.
These characteristics are restored by `emerge-restore-buffer-characteristics'."
  ;; force auto-save, because we will turn off auto-saving in buffers for the
  ;; duration
  (do-auto-save)
  ;; remember and alter buffer characteristics
  (setq emerge-A-buffer-values
	(emerge-eval-in-buffer
	 emerge-A-buffer
	 (prog1
	     (emerge-save-variables emerge-saved-variables)
	   (emerge-restore-variables emerge-saved-variables
				     emerge-merging-values))))
  (setq emerge-B-buffer-values
	(emerge-eval-in-buffer
	 emerge-B-buffer
	 (prog1
	     (emerge-save-variables emerge-saved-variables)
	   (emerge-restore-variables emerge-saved-variables
				     emerge-merging-values)))))

(defun emerge-restore-buffer-characteristics ()
  "Restores characteristics saved by `emerge-remember-buffer-characteristics'."
  (let ((A-values emerge-A-buffer-values)
	(B-values emerge-B-buffer-values))
    (emerge-eval-in-buffer emerge-A-buffer
			   (emerge-restore-variables emerge-saved-variables
						     A-values))
    (emerge-eval-in-buffer emerge-B-buffer
			   (emerge-restore-variables emerge-saved-variables
						     B-values))))

;; Move to line DESIRED-LINE assuming we are at line CURRENT-LINE.
;; Return DESIRED-LINE.
(defun emerge-goto-line (desired-line current-line)
  (forward-line (- desired-line current-line))
  desired-line)

(defun emerge-convert-diffs-to-markers (A-buffer
					B-buffer
					merge-buffer
					lineno-list)
  (let* (marker-list
	 (A-point-min (emerge-eval-in-buffer A-buffer (point-min)))
	 (offset (1- A-point-min))
	 (B-point-min (emerge-eval-in-buffer B-buffer (point-min)))
	 ;; Record current line number in each buffer
	 ;; so we don't have to count from the beginning.
	 (a-line 1)
	 (b-line 1))
    (emerge-eval-in-buffer A-buffer (goto-char (point-min)))
    (emerge-eval-in-buffer B-buffer (goto-char (point-min)))
    (while lineno-list
      (let* ((list-element (car lineno-list))
	     a-begin-marker
	     a-end-marker
	     b-begin-marker
	     b-end-marker
	     merge-begin-marker
	     merge-end-marker
	     (a-begin (aref list-element 0))
	     (a-end (aref list-element 1))
	     (b-begin (aref list-element 2))
	     (b-end (aref list-element 3))
	     (state (aref list-element 4)))
	;; place markers at the appropriate places in the buffers
	(emerge-eval-in-buffer
	 A-buffer
	 (setq a-line (emerge-goto-line a-begin a-line))
	 (setq a-begin-marker (point-marker))
	 (setq a-line (emerge-goto-line a-end a-line))
	 (setq a-end-marker (point-marker)))
	(emerge-eval-in-buffer
	 B-buffer
	 (setq b-line (emerge-goto-line b-begin b-line))
	 (setq b-begin-marker (point-marker))
	 (setq b-line (emerge-goto-line b-end b-line))
	 (setq b-end-marker (point-marker)))
	(setq merge-begin-marker (set-marker
				  (make-marker)
				  (- (marker-position a-begin-marker)
				     offset)
				  merge-buffer))
	(setq merge-end-marker (set-marker
				(make-marker)
				(- (marker-position a-end-marker)
				   offset)
				merge-buffer))
	;; record all the markers for this difference
	(setq marker-list (cons (vector a-begin-marker a-end-marker
					b-begin-marker b-end-marker
					merge-begin-marker merge-end-marker
					state)
				marker-list)))
      (setq lineno-list (cdr lineno-list)))
    ;; convert the list of difference information into a vector for
    ;; fast access
    (setq emerge-difference-list (apply 'vector (nreverse marker-list)))))

;; If we have an ancestor, select all B variants that we prefer 
(defun emerge-select-prefer-Bs ()
  (let ((n 0))
    (while (< n emerge-number-of-differences)
      (if (eq (aref (aref emerge-difference-list n) 6) 'prefer-B)
	  (progn
	    (emerge-unselect-and-select-difference n t)
	    (emerge-select-B)
	    (aset (aref emerge-difference-list n) 6 'prefer-B)))
      (setq n (1+ n))))
  (emerge-unselect-and-select-difference -1))

;; Process the local-variables list at the end of the merged file, if
;; requested.
(defun emerge-handle-local-variables ()
  (if emerge-process-local-variables
      (condition-case err
	  (hack-local-variables)
	(error (message "Local-variables error in merge buffer: %s"
			(prin1-to-string err))))))

;;; Common exit routines

(defun emerge-write-and-delete (file-out)
  ;; clear screen format
  (delete-other-windows)
  ;; delete A, B, and ancestor buffers, if they haven't been changed
  (if (not (buffer-modified-p emerge-A-buffer))
      (kill-buffer emerge-A-buffer))
  (if (not (buffer-modified-p emerge-B-buffer))
      (kill-buffer emerge-B-buffer))
  (if (and emerge-ancestor-buffer
	   (not (buffer-modified-p emerge-ancestor-buffer)))
      (kill-buffer emerge-ancestor-buffer))
  ;; Write merge buffer to file
  (and file-out
       (write-file file-out)))

;;; Commands

(defun emerge-recenter (&optional arg)
  "Bring the highlighted region of all three merge buffers into view.
This brings the buffers into view if they are in windows.
With an argument, reestablish the default three-window display."
  (interactive "P")
  ;; If there is an argument, rebuild the window structure
  (if arg
      (emerge-setup-windows emerge-A-buffer emerge-B-buffer
			    emerge-merge-buffer))
  ;; Redisplay whatever buffers are showing, if there is a selected difference
  (if (and (>= emerge-current-difference 0)
	   (< emerge-current-difference emerge-number-of-differences))
      (let* ((merge-buffer emerge-merge-buffer)
	     (buffer-A emerge-A-buffer)
	     (buffer-B emerge-B-buffer)
	     (window-A (get-buffer-window buffer-A 'visible))
	     (window-B (get-buffer-window buffer-B 'visible))
	     (merge-window (get-buffer-window merge-buffer))
	     (diff-vector
	      (aref emerge-difference-list emerge-current-difference)))
	(if window-A (progn
		       (select-window window-A)
		       (emerge-position-region
			(- (aref diff-vector 0)
			   (1- emerge-before-flag-length))
			(+ (aref diff-vector 1)
			   (1- emerge-after-flag-length))
			(1+ (aref diff-vector 0)))))
	(if window-B (progn
		       (select-window window-B)
		       (emerge-position-region
			(- (aref diff-vector 2)
			   (1- emerge-before-flag-length))
			(+ (aref diff-vector 3)
			   (1- emerge-after-flag-length))
			(1+ (aref diff-vector 2)))))
	(if merge-window (progn
			   (select-window merge-window)
			   (emerge-position-region
			    (- (aref diff-vector 4)
			       (1- emerge-before-flag-length))
			    (+ (aref diff-vector 5)
			       (1- emerge-after-flag-length))
			    (1+ (aref diff-vector 4))))))))

;;; Window scrolling operations
;; These operations are designed to scroll all three windows the same amount,
;; so as to keep the text in them aligned.

;; Perform some operation on all three windows (if they are showing).
;; Catches all errors on the operation in the A and B windows, but not
;; in the merge window.  Usually, errors come from scrolling off the
;; beginning or end of the buffer, and this gives a nice error message:
;; End of buffer is reported in the merge buffer, but if the scroll was
;; possible in the A or B windows, it is performed there before the error
;; is reported.
(defun emerge-operate-on-windows (operation arg)
  (let* ((merge-buffer emerge-merge-buffer)
	 (buffer-A emerge-A-buffer)
	 (buffer-B emerge-B-buffer)
	 (window-A (get-buffer-window buffer-A 'visible))
	 (window-B (get-buffer-window buffer-B 'visible))
	 (merge-window (get-buffer-window merge-buffer)))
    (if window-A (progn
		   (select-window window-A)
		   (condition-case nil
		       (funcall operation arg)
		     (error))))
    (if window-B (progn
		   (select-window window-B)
		   (condition-case nil
		       (funcall operation arg)
		     (error))))
    (if merge-window (progn
		       (select-window merge-window)
		       (funcall operation arg)))))

(defun emerge-scroll-up (&optional arg)
  "Scroll up all three merge buffers, if they are in windows.
With argument N, scroll N lines; otherwise scroll by nearly
the height of the merge window.
`C-u -' alone as argument scrolls half the height of the merge window."
  (interactive "P")
  (emerge-operate-on-windows
   'scroll-up 
   ;; calculate argument to scroll-up
   ;; if there is an explicit argument
   (if (and arg (not (equal arg '-)))
       ;; use it
       (prefix-numeric-value arg)
     ;; if not, see if we can determine a default amount (the window height)
     (let ((merge-window (get-buffer-window emerge-merge-buffer)))
       (if (null merge-window)
	   ;; no window, use nil
	   nil
	 (let ((default-amount
		 (- (window-height merge-window) 1 next-screen-context-lines)))
	   ;; the window was found
	   (if arg
	       ;; C-u as argument means half of default amount
	       (/ default-amount 2)
	     ;; no argument means default amount
	     default-amount)))))))

(defun emerge-scroll-down (&optional arg)
  "Scroll down all three merge buffers, if they are in windows.
With argument N, scroll N lines; otherwise scroll by nearly
the height of the merge window.
`C-u -' alone as argument scrolls half the height of the merge window."
  (interactive "P")
  (emerge-operate-on-windows
   'scroll-down
   ;; calculate argument to scroll-down
   ;; if there is an explicit argument
   (if (and arg (not (equal arg '-)))
       ;; use it
       (prefix-numeric-value arg)
     ;; if not, see if we can determine a default amount (the window height)
     (let ((merge-window (get-buffer-window emerge-merge-buffer)))
       (if (null merge-window)
	   ;; no window, use nil
	   nil
	 (let ((default-amount
		 (- (window-height merge-window) 1 next-screen-context-lines)))
	   ;; the window was found
	   (if arg
	       ;; C-u as argument means half of default amount
	       (/ default-amount 2)
	     ;; no argument means default amount
	     default-amount)))))))

(defun emerge-scroll-left (&optional arg)
  "Scroll left all three merge buffers, if they are in windows.
If an argument is given, that is how many columns are scrolled, else nearly
the width of the A and B windows.  `C-u -' alone as argument scrolls half the
width of the A and B windows."
  (interactive "P")
  (emerge-operate-on-windows
   'scroll-left
   ;; calculate argument to scroll-left
   ;; if there is an explicit argument
   (if (and arg (not (equal arg '-)))
       ;; use it
       (prefix-numeric-value arg)
     ;; if not, see if we can determine a default amount
     ;; (half the window width)
     (let ((merge-window (get-buffer-window emerge-merge-buffer)))
       (if (null merge-window)
	   ;; no window, use nil
	   nil
	 (let ((default-amount
		 (- (/ (window-width merge-window) 2) 3)))
	   ;; the window was found
	   (if arg
	       ;; C-u as argument means half of default amount
	       (/ default-amount 2)
	     ;; no argument means default amount
	     default-amount)))))))

(defun emerge-scroll-right (&optional arg)
  "Scroll right all three merge buffers, if they are in windows.
If an argument is given, that is how many columns are scrolled, else nearly
the width of the A and B windows.  `C-u -' alone as argument scrolls half the
width of the A and B windows."
  (interactive "P")
  (emerge-operate-on-windows
   'scroll-right
   ;; calculate argument to scroll-right
   ;; if there is an explicit argument
   (if (and arg (not (equal arg '-)))
       ;; use it
       (prefix-numeric-value arg)
     ;; if not, see if we can determine a default amount
     ;; (half the window width)
     (let ((merge-window (get-buffer-window emerge-merge-buffer)))
       (if (null merge-window)
	   ;; no window, use nil
	   nil
	 (let ((default-amount
		 (- (/ (window-width merge-window) 2) 3)))
	   ;; the window was found
	   (if arg
	       ;; C-u as argument means half of default amount
	       (/ default-amount 2)
	     ;; no argument means default amount
	     default-amount)))))))

(defun emerge-scroll-reset ()
  "Reset horizontal scrolling in Emerge.
This resets the horizontal scrolling of all three merge buffers
to the left margin, if they are in windows."
  (interactive)
  (emerge-operate-on-windows
   (function (lambda (x) (set-window-hscroll (selected-window) 0)))
   nil))

;; Attempt to show the region nicely.
;; If there are min-lines lines above and below the region, then don't do
;; anything.
;; If not, recenter the region to make it so.
;; If that isn't possible, remove context lines balancedly from top and bottom
;; so the entire region shows.
;; If that isn't possible, show the top of the region.
;; BEG must be at the beginning of a line.
(defun emerge-position-region (beg end pos)
  ;; First test whether the entire region is visible with
  ;; emerge-min-visible-lines above and below it
  (if (not (and (<= (progn
		      (move-to-window-line emerge-min-visible-lines)
		      (point))
		    beg)
		(<= end (progn
			  (move-to-window-line
			   (- (1+ emerge-min-visible-lines)))
			  (point)))))
      ;; We failed that test, see if it fits at all
      ;; Meanwhile positioning it correctly in case it doesn't fit
      (progn
	(set-window-start (selected-window) beg)
	(if (pos-visible-in-window-p end)
	    ;; Determine the number of lines that the region occupies
	    (let ((lines 0))
	      (while (> end (progn
			      (move-to-window-line lines)
			      (point)))
		(setq lines (1+ lines)))
	      ;; And position the beginning on the right line
	      (goto-char beg)
	      (recenter (/ (1+ (- (1- (window-height (selected-window)))
				  lines))
			   2))))))
  (goto-char pos))

(defun emerge-next-difference ()
  "Advance to the next difference."
  (interactive)
  (if (< emerge-current-difference emerge-number-of-differences)
      (let ((n (1+ emerge-current-difference)))
	(while (and emerge-skip-prefers
		    (< n emerge-number-of-differences)
		    (memq (aref (aref emerge-difference-list n) 6)
			  '(prefer-A prefer-B)))
	  (setq n (1+ n)))
	(let ((buffer-read-only nil))
	  (emerge-unselect-and-select-difference n)))
    (error "At end")))

(defun emerge-previous-difference ()
  "Go to the previous difference."
  (interactive)
  (if (> emerge-current-difference -1)
      (let ((n (1- emerge-current-difference)))
	(while (and emerge-skip-prefers
		    (> n -1)
		    (memq (aref (aref emerge-difference-list n) 6)
			  '(prefer-A prefer-B)))
	  (setq n (1- n)))
	(let ((buffer-read-only nil))
	  (emerge-unselect-and-select-difference n)))
    (error "At beginning")))

(defun emerge-jump-to-difference (difference-number)
  "Go to the N-th difference."
  (interactive "p")
  (let ((buffer-read-only nil))
    (setq difference-number (1- difference-number))
    (if (and (>= difference-number -1)
	     (< difference-number (1+ emerge-number-of-differences)))
	(emerge-unselect-and-select-difference difference-number)
      (error "Bad difference number"))))

(defun emerge-abort ()
  "Abort the Emerge session."
  (interactive)
  (emerge-quit t))

(defun emerge-quit (arg)
  "Finish the Emerge session and exit Emerge.
Prefix argument means to abort rather than successfully finish.
The difference depends on how the merge was started,
but usually means to not write over one of the original files, or to signal
to some process which invoked Emerge a failure code.

Unselects the selected difference, if any, restores the read-only and modified
flags of the merged file buffers, restores the local keymap of the merge
buffer, and sets off various emerge flags.  Using Emerge commands in this
buffer after this will cause serious problems."
  (interactive "P")
  (if (prog1
	  (y-or-n-p
	   (if (not arg)
	       "Do you really want to successfully finish this merge? "
	     "Do you really want to abort this merge? "))
	(message ""))
      (emerge-really-quit arg)))

;; Perform the quit operations.
(defun emerge-really-quit (arg)
  (setq buffer-read-only nil)
  (emerge-unselect-and-select-difference -1)
  (emerge-restore-buffer-characteristics)
  ;; null out the difference markers so they don't slow down future editing
  ;; operations
  (mapcar (function (lambda (d)
		      (set-marker (aref d 0) nil)
		      (set-marker (aref d 1) nil)
		      (set-marker (aref d 2) nil)
		      (set-marker (aref d 3) nil)
		      (set-marker (aref d 4) nil)
		      (set-marker (aref d 5) nil)))
	  emerge-difference-list)
  ;; allow them to be garbage collected
  (setq emerge-difference-list nil)
  ;; restore the local map
  (use-local-map emerge-old-keymap)
  ;; turn off all the emerge modes
  (setq emerge-mode nil)
  (setq emerge-fast-mode nil)
  (setq emerge-edit-mode nil)
  (setq emerge-auto-advance nil)
  (setq emerge-skip-prefers nil)
  ;; restore mode line
  (kill-local-variable 'mode-line-buffer-identification)
  (let ((emerge-prefix-argument arg))
    (run-hooks 'emerge-quit-hook)))

(defun emerge-select-A (&optional force)
  "Select the A variant of this difference.  
Refuses to function if this difference has been edited, i.e., if it
is neither the A nor the B variant.
A prefix argument forces the variant to be selected
even if the difference has been edited."
  (interactive "P")
  (let ((operate
	 (function (lambda ()
		     (emerge-select-A-edit merge-begin merge-end A-begin A-end)
		     (if emerge-auto-advance
			 (emerge-next-difference)))))
	(operate-no-change
	 (function (lambda ()
		     (if emerge-auto-advance
			 (emerge-next-difference))))))
    (emerge-select-version force operate-no-change operate operate)))

;; Actually select the A variant
(defun emerge-select-A-edit (merge-begin merge-end A-begin A-end)
  (emerge-eval-in-buffer
   emerge-merge-buffer
   (delete-region merge-begin merge-end)
   (goto-char merge-begin)
   (insert-buffer-substring emerge-A-buffer A-begin A-end)
   (goto-char merge-begin)
   (aset diff-vector 6 'A)
   (emerge-refresh-mode-line)))

(defun emerge-select-B (&optional force)
  "Select the B variant of this difference.
Refuses to function if this difference has been edited, i.e., if it
is neither the A nor the B variant.
A prefix argument forces the variant to be selected
even if the difference has been edited."
  (interactive "P")
  (let ((operate
	 (function (lambda ()
		     (emerge-select-B-edit merge-begin merge-end B-begin B-end)
		     (if emerge-auto-advance
			 (emerge-next-difference)))))
	(operate-no-change
	 (function (lambda ()
		     (if emerge-auto-advance
			 (emerge-next-difference))))))
    (emerge-select-version force operate operate-no-change operate)))

;; Actually select the B variant
(defun emerge-select-B-edit (merge-begin merge-end B-begin B-end)
  (emerge-eval-in-buffer
   emerge-merge-buffer
   (delete-region merge-begin merge-end)
   (goto-char merge-begin)
   (insert-buffer-substring emerge-B-buffer B-begin B-end)
   (goto-char merge-begin)
   (aset diff-vector 6 'B)
   (emerge-refresh-mode-line)))

(defun emerge-default-A ()
  "Make the A variant the default from here down.
This selects the A variant for all differences from here down in the buffer
which are still defaulted, i.e., which the user has not selected and for
which there is no preference."
  (interactive)
  (let ((buffer-read-only nil))
    (let ((selected-difference emerge-current-difference)
	  (n (max emerge-current-difference 0)))
      (while (< n emerge-number-of-differences)
	(let ((diff-vector (aref emerge-difference-list n)))
	  (if (eq (aref diff-vector 6) 'default-B)
	      (progn
		(emerge-unselect-and-select-difference n t)
		(emerge-select-A)
		(aset diff-vector 6 'default-A))))
	(setq n (1+ n))
	(if (zerop (% n 10))
	    (message "Setting default to A...%d" n)))
      (emerge-unselect-and-select-difference selected-difference)))
  (message "Default choice is now A"))

(defun emerge-default-B ()
  "Make the B variant the default from here down.
This selects the B variant for all differences from here down in the buffer
which are still defaulted, i.e., which the user has not selected and for
which there is no preference."
  (interactive)
  (let ((buffer-read-only nil))
    (let ((selected-difference emerge-current-difference)
	  (n (max emerge-current-difference 0)))
      (while (< n emerge-number-of-differences)
	(let ((diff-vector (aref emerge-difference-list n)))
	  (if (eq (aref diff-vector 6) 'default-A)
	      (progn
		(emerge-unselect-and-select-difference n t)
		(emerge-select-B)
		(aset diff-vector 6 'default-B))))
	(setq n (1+ n))
	(if (zerop (% n 10))
	    (message "Setting default to B...%d" n)))
      (emerge-unselect-and-select-difference selected-difference)))
  (message "Default choice is now B"))

(defun emerge-fast-mode ()
  "Set fast mode, for Emerge.
In this mode ordinary Emacs commands are disabled, and Emerge commands
need not be prefixed with \\<emerge-fast-keymap>\\[emerge-basic-keymap]."
  (interactive)
  (setq buffer-read-only t)
  (use-local-map emerge-fast-keymap)
  (setq emerge-mode t)
  (setq emerge-fast-mode t)
  (setq emerge-edit-mode nil)
  (message "Fast mode set")
  (force-mode-line-update))

(defun emerge-edit-mode ()
  "Set edit mode, for Emerge.
In this mode ordinary Emacs commands are available, and Emerge commands
must be prefixed with \\<emerge-fast-keymap>\\[emerge-basic-keymap]."
  (interactive)
  (setq buffer-read-only nil)
  (use-local-map emerge-edit-keymap)
  (setq emerge-mode t)
  (setq emerge-fast-mode nil)
  (setq emerge-edit-mode t)
  (message "Edit mode set")
  (force-mode-line-update))

(defun emerge-auto-advance (arg)
  "Toggle Auto-Advance mode, for Emerge.
This mode causes `emerge-select-A' and `emerge-select-B' to automatically
advance to the next difference.
With a positive argument, turn on Auto-Advance mode.
With a negative argument, turn off Auto-Advance mode."
  (interactive "P")
  (setq emerge-auto-advance (if (null arg)
				(not emerge-auto-advance)
			      (> (prefix-numeric-value arg) 0)))
  (message (if emerge-auto-advance
	       "Auto-advance set"
	     "Auto-advance cleared"))
  (force-mode-line-update))

(defun emerge-skip-prefers (arg)
  "Toggle Skip-Prefers mode, for Emerge.
This mode causes `emerge-next-difference' and `emerge-previous-difference'
to automatically skip over differences for which there is a preference.
With a positive argument, turn on Skip-Prefers mode.
With a negative argument, turn off Skip-Prefers mode."
  (interactive "P")
  (setq emerge-skip-prefers (if (null arg)
				(not emerge-skip-prefers)
			      (> (prefix-numeric-value arg) 0)))
  (message (if emerge-skip-prefers
	       "Skip-prefers set"
	     "Skip-prefers cleared"))
  (force-mode-line-update))

(defun emerge-copy-as-kill-A ()
  "Put the A variant of this difference in the kill ring."
  (interactive)
  (emerge-validate-difference)
  (let* ((diff-vector
	  (aref emerge-difference-list emerge-current-difference))
	 (A-begin (1+ (aref diff-vector 0)))
	 (A-end (1- (aref diff-vector 1)))
	 ;; so further kills don't append
	 this-command)
    (save-excursion
      (set-buffer emerge-A-buffer)
      (copy-region-as-kill A-begin A-end))))

(defun emerge-copy-as-kill-B ()
  "Put the B variant of this difference in the kill ring."
  (interactive)
  (emerge-validate-difference)
  (let* ((diff-vector
	  (aref emerge-difference-list emerge-current-difference))
	 (B-begin (1+ (aref diff-vector 2)))
	 (B-end (1- (aref diff-vector 3)))
	 ;; so further kills don't append
	 this-command)
    (save-excursion
      (set-buffer emerge-B-buffer)
      (copy-region-as-kill B-begin B-end))))

(defun emerge-insert-A (arg)
  "Insert the A variant of this difference at the point.
Leaves point after text, mark before.
With prefix argument, puts point before, mark after."
  (interactive "P")
  (emerge-validate-difference)
  (let* ((diff-vector
	  (aref emerge-difference-list emerge-current-difference))
	 (A-begin (1+ (aref diff-vector 0)))
	 (A-end (1- (aref diff-vector 1)))
	 (opoint (point))
	 (buffer-read-only nil))
    (insert-buffer-substring emerge-A-buffer A-begin A-end)
    (if (not arg)
	(set-mark opoint)
      (set-mark (point))
      (goto-char opoint))))

(defun emerge-insert-B (arg)
  "Insert the B variant of this difference at the point.
Leaves point after text, mark before.
With prefix argument, puts point before, mark after."
  (interactive "P")
  (emerge-validate-difference)
  (let* ((diff-vector
	  (aref emerge-difference-list emerge-current-difference))
	 (B-begin (1+ (aref diff-vector 2)))
	 (B-end (1- (aref diff-vector 3)))
	 (opoint (point))
	 (buffer-read-only nil))
    (insert-buffer-substring emerge-B-buffer B-begin B-end)
    (if (not arg)
	(set-mark opoint)
      (set-mark (point))
      (goto-char opoint))))

(defun emerge-mark-difference (arg)
  "Leaves the point before this difference and the mark after it.
With prefix argument, puts mark before, point after."
  (interactive "P")
  (emerge-validate-difference)
  (let* ((diff-vector
	  (aref emerge-difference-list emerge-current-difference))
	 (merge-begin (1+ (aref diff-vector 4)))
	 (merge-end (1- (aref diff-vector 5))))
    (if (not arg)
	(progn
	  (goto-char merge-begin)
	  (set-mark merge-end))
      (goto-char merge-end)
      (set-mark merge-begin))))

(defun emerge-file-names ()
  "Show the names of the buffers or files being operated on by Emerge.
Use C-u l to reset the windows afterward."
  (interactive)
  (delete-other-windows)
  (let ((temp-buffer-show-function
	 (function (lambda (buf)
		     (split-window-vertically)
		     (switch-to-buffer buf)
		     (other-window 1)))))
    (with-output-to-temp-buffer "*Help*"
      (emerge-eval-in-buffer emerge-A-buffer
			     (if buffer-file-name
				 (progn
				   (princ "File A is: ")
				   (princ buffer-file-name))
			       (progn
				 (princ "Buffer A is: ")
				 (princ (buffer-name))))
			     (princ "\n"))
      (emerge-eval-in-buffer emerge-B-buffer
			     (if buffer-file-name
				 (progn
				   (princ "File B is: ")
				   (princ buffer-file-name))
			       (progn
				 (princ "Buffer B is: ")
				 (princ (buffer-name))))
			     (princ "\n"))
      (if emerge-ancestor-buffer
	    (emerge-eval-in-buffer emerge-ancestor-buffer
				   (if buffer-file-name
				       (progn
					 (princ "Ancestor file is: ")
					 (princ buffer-file-name))
				     (progn
				       (princ "Ancestor buffer is: ")
				       (princ (buffer-name))))
				   (princ "\n")))
      (princ emerge-output-description)
      (save-excursion
	(set-buffer standard-output)
	(help-mode)))))

(defun emerge-join-differences (arg)
  "Join the selected difference with the following one.
With a prefix argument, join with the preceding one."
  (interactive "P")
  (let ((n emerge-current-difference))
    ;; adjust n to be first difference to join
    (if arg
	(setq n (1- n)))
    ;; n and n+1 are the differences to join
    ;; check that they are both differences
    (if (or (< n 0) (>= n (1- emerge-number-of-differences)))
	(error "Incorrect differences to join"))
    ;; remove the flags
    (emerge-unselect-difference emerge-current-difference)
    ;; decrement total number of differences
    (setq emerge-number-of-differences (1- emerge-number-of-differences))
    ;; build new differences vector
    (let ((i 0)
	  (new-differences (make-vector emerge-number-of-differences nil)))
      (while (< i emerge-number-of-differences)
	(aset new-differences i
	      (cond
	       ((< i n) (aref emerge-difference-list i))
	       ((> i n) (aref emerge-difference-list (1+ i)))
	       (t (let ((prev (aref emerge-difference-list i))
			(next (aref emerge-difference-list (1+ i))))
		    (vector (aref prev 0)
			    (aref next 1)
			    (aref prev 2)
			    (aref next 3)
			    (aref prev 4)
			    (aref next 5)
			    (let ((ps (aref prev 6))
				  (ns (aref next 6)))
			      (cond
			       ((eq ps ns)
				ps)
			       ((and (or (eq ps 'B) (eq ps 'prefer-B))
				     (or (eq ns 'B) (eq ns 'prefer-B)))
				'B)
			       (t 'A))))))))
	(setq i (1+ i)))
      (setq emerge-difference-list new-differences))
    ;; set the current difference correctly
    (setq emerge-current-difference n)
    ;; fix the mode line
    (emerge-refresh-mode-line)
    ;; reinsert the flags
    (emerge-select-difference emerge-current-difference)
    (emerge-recenter)))

(defun emerge-split-difference ()
  "Split the current difference where the points are in the three windows."
  (interactive)
  (let ((n emerge-current-difference))
    ;; check that this is a valid difference
    (emerge-validate-difference)
    ;; get the point values and old difference
    (let ((A-point (emerge-eval-in-buffer emerge-A-buffer
					  (point-marker)))
	  (B-point (emerge-eval-in-buffer emerge-B-buffer
					  (point-marker)))
	  (merge-point (point-marker))
	  (old-diff (aref emerge-difference-list n)))
      ;; check location of the points, give error if they aren't in the
      ;; differences
      (if (or (< A-point (aref old-diff 0))
	      (> A-point (aref old-diff 1)))
	  (error "Point outside of difference in A buffer"))
      (if (or (< B-point (aref old-diff 2))
	      (> B-point (aref old-diff 3)))
	  (error "Point outside of difference in B buffer"))
      (if (or (< merge-point (aref old-diff 4))
	      (> merge-point (aref old-diff 5)))
	  (error "Point outside of difference in merge buffer"))
      ;; remove the flags
      (emerge-unselect-difference emerge-current-difference)
      ;; increment total number of differences
      (setq emerge-number-of-differences (1+ emerge-number-of-differences))
      ;; build new differences vector
      (let ((i 0)
	    (new-differences (make-vector emerge-number-of-differences nil)))
	(while (< i emerge-number-of-differences)
	  (aset new-differences i
		(cond
		 ((< i n)
		  (aref emerge-difference-list i))
		 ((> i (1+ n))
		  (aref emerge-difference-list (1- i)))
		 ((= i n)
		  (vector (aref old-diff 0)
			  A-point
			  (aref old-diff 2)
			  B-point
			  (aref old-diff 4)
			  merge-point
			  (aref old-diff 6)))
		 (t
		  (vector (copy-marker A-point)
			  (aref old-diff 1)
			  (copy-marker B-point)
			  (aref old-diff 3)
			  (copy-marker merge-point)
			  (aref old-diff 5)
			  (aref old-diff 6)))))
	  (setq i (1+ i)))
	(setq emerge-difference-list new-differences))
      ;; set the current difference correctly
      (setq emerge-current-difference n)
      ;; fix the mode line
      (emerge-refresh-mode-line)
      ;; reinsert the flags
      (emerge-select-difference emerge-current-difference)
      (emerge-recenter))))

(defun emerge-trim-difference ()
  "Trim lines off top and bottom of difference that are the same.
If lines are the same in both the A and the B versions, strip them off.
\(This can happen when the A and B versions have common lines that the
ancestor version does not share.)"
  (interactive)
  ;; make sure we are in a real difference
  (emerge-validate-difference)
  ;; remove the flags
  (emerge-unselect-difference emerge-current-difference)
  (let* ((diff (aref emerge-difference-list emerge-current-difference))
	 (top-a (marker-position (aref diff 0)))
	 (bottom-a (marker-position (aref diff 1)))
	 (top-b (marker-position (aref diff 2)))
	 (bottom-b (marker-position (aref diff 3)))
	 (top-m (marker-position (aref diff 4)))
	 (bottom-m (marker-position (aref diff 5)))
	 size success sa sb sm)
    ;; move down the tops of the difference regions as much as possible
    ;; Try advancing comparing 1000 chars at a time.
    ;; When that fails, go 500 chars at a time, and so on.
    (setq size 1000)
    (while (> size 0)
      (setq success t)
      (while success
	(setq size (min size (- bottom-a top-a) (- bottom-b top-b)
			(- bottom-m top-m)))
	(setq sa (emerge-eval-in-buffer emerge-A-buffer
					(buffer-substring top-a
							  (+ size top-a))))
	(setq sb (emerge-eval-in-buffer emerge-B-buffer
					(buffer-substring top-b
							  (+ size top-b))))
	(setq sm (buffer-substring top-m (+ size top-m)))
	(setq success (and (> size 0) (equal sa sb) (equal sb sm)))
	(if success
	    (setq top-a (+ top-a size)
		  top-b (+ top-b size)
		  top-m (+ top-m size))))
      (setq size (/ size 2)))
    ;; move up the bottoms of the difference regions as much as possible
    ;; Try advancing comparing 1000 chars at a time.
    ;; When that fails, go 500 chars at a time, and so on.
    (setq size 1000)
    (while (> size 0)
      (setq success t)
      (while success
	(setq size (min size (- bottom-a top-a) (- bottom-b top-b)
			(- bottom-m top-m)))
	(setq sa (emerge-eval-in-buffer emerge-A-buffer
					(buffer-substring (- bottom-a size)
							  bottom-a)))
	(setq sb (emerge-eval-in-buffer emerge-B-buffer
					(buffer-substring (- bottom-b size)
							  bottom-b)))
	(setq sm (buffer-substring (- bottom-m size) bottom-m))
	(setq success (and (> size 0) (equal sa sb) (equal sb sm)))
	(if success
	    (setq bottom-a (- bottom-a size)
		  bottom-b (- bottom-b size)
		  bottom-m (- bottom-m size))))
      (setq size (/ size 2)))
    ;; {top,bottom}-{a,b,m} are now set at the new beginnings and ends
    ;; of the difference regions.  Move them to the beginning of lines, as
    ;; appropriate.
    (emerge-eval-in-buffer emerge-A-buffer
			   (goto-char top-a)
			   (beginning-of-line)
			   (aset diff 0 (point-marker))
			   (goto-char bottom-a)
			   (beginning-of-line 2)
			   (aset diff 1 (point-marker)))
    (emerge-eval-in-buffer emerge-B-buffer
			   (goto-char top-b)
			   (beginning-of-line)
			   (aset diff 2 (point-marker))
			   (goto-char bottom-b)
			   (beginning-of-line 2)
			   (aset diff 3 (point-marker)))
    (goto-char top-m)
    (beginning-of-line)
    (aset diff 4 (point-marker))
    (goto-char bottom-m)
    (beginning-of-line 2)
    (aset diff 5 (point-marker))
    ;; put the flags back in, recenter the display
    (emerge-select-difference emerge-current-difference)
    (emerge-recenter)))

(defun emerge-find-difference (arg)
  "Find the difference containing the current position of the point.
If there is no containing difference and the prefix argument is positive,
it finds the nearest following difference.  A negative prefix argument finds
the nearest previous difference."
  (interactive "P")
  (cond ((eq (current-buffer) emerge-A-buffer)
	 (emerge-find-difference-A arg))
	((eq (current-buffer) emerge-B-buffer)
	 (emerge-find-difference-B arg))
	(t (emerge-find-difference-merge arg))))

(defun emerge-find-difference-merge (arg)
  "Find the difference containing point, in the merge buffer.
If there is no containing difference and the prefix argument is positive,
it finds the nearest following difference.  A negative prefix argument finds
the nearest previous difference."
  (interactive "P")
  ;; search for the point in the merge buffer, using the markers
  ;; for the beginning and end of the differences in the merge buffer
  (emerge-find-difference1 arg (point) 4 5))

(defun emerge-find-difference-A (arg)
  "Find the difference containing point, in the A buffer.
This command must be executed in the merge buffer.
If there is no containing difference and the prefix argument is positive,
it finds the nearest following difference.  A negative prefix argument finds
the nearest previous difference."
  (interactive "P")
  ;; search for the point in the A buffer, using the markers
  ;; for the beginning and end of the differences in the A buffer
  (emerge-find-difference1 arg
			   (emerge-eval-in-buffer emerge-A-buffer (point))
			   0 1))

(defun emerge-find-difference-B (arg)
  "Find the difference containing point, in the B buffer.
This command must be executed in the merge buffer.
If there is no containing difference and the prefix argument is positive,
it finds the nearest following difference.  A negative prefix argument finds
the nearest previous difference."
  (interactive "P")
  ;; search for the point in the B buffer, using the markers
  ;; for the beginning and end of the differences in the B buffer
  (emerge-find-difference1 arg
			   (emerge-eval-in-buffer emerge-B-buffer (point))
			   2 3))

(defun emerge-find-difference1 (arg location begin end)
  (let* ((index
	  ;; find first difference containing or after the current position
	  (catch 'search
	    (let ((n 0))
	      (while (< n emerge-number-of-differences)
		(let ((diff-vector (aref emerge-difference-list n)))
		  (if (<= location (marker-position (aref diff-vector end)))
		      (throw 'search n)))
		(setq n (1+ n))))
	    emerge-number-of-differences))
	 (contains
	  ;; whether the found difference contains the current position
	  (and (< index emerge-number-of-differences)
	       (<= (marker-position (aref (aref emerge-difference-list index)
					  begin))
		   location)))
	 (arg-value
	  ;; numeric value of prefix argument
	  (prefix-numeric-value arg)))
    (emerge-unselect-and-select-difference
     (cond
      ;; if the point is in a difference, select it
      (contains index)
      ;; if the arg is nil and the point is not in a difference, error
      ((null arg) (error "No difference contains point"))
      ;; if the arg is positive, select the following difference
      ((> arg-value 0)
       (if (< index emerge-number-of-differences)
	   index
	 (error "No difference contains or follows point")))
      ;; if the arg is negative, select the preceding difference
      (t
       (if (> index 0)
	   (1- index)
	 (error "No difference contains or precedes point")))))))

(defun emerge-line-numbers ()
  "Display the current line numbers.
This function displays the line numbers of the points in the A, B, and
merge buffers."
  (interactive)
  (let* ((valid-diff
	 (and (>= emerge-current-difference 0)
	      (< emerge-current-difference emerge-number-of-differences)))
	(diff (and valid-diff
		   (aref emerge-difference-list emerge-current-difference)))
	(merge-line (emerge-line-number-in-buf 4 5))
	(A-line (emerge-eval-in-buffer emerge-A-buffer
				       (emerge-line-number-in-buf 0 1)))
	(B-line (emerge-eval-in-buffer emerge-B-buffer
				       (emerge-line-number-in-buf 2 3))))
    (message "At lines: merge = %d, A = %d, B = %d"
	     merge-line A-line B-line)))

(defun emerge-line-number-in-buf (begin-marker end-marker)
  (let (temp)
    (setq temp (save-excursion
		 (beginning-of-line)
		 (1+ (count-lines 1 (point)))))
    (if valid-diff
	(progn
	  (if (> (point) (aref diff begin-marker))
	      (setq temp (- temp emerge-before-flag-lines)))
	  (if (> (point) (aref diff end-marker))
	      (setq temp (- temp emerge-after-flag-lines)))))
    temp))

(defun emerge-set-combine-template (string &optional localize)
  "Set `emerge-combine-versions-template' to STRING.
This value controls how `emerge-combine-versions' combines the two versions.
With prefix argument, `emerge-combine-versions-template' is made local to this
merge buffer.  Localization is permanent for any particular merge buffer."
  (interactive "s\nP")
  (if localize
      (make-local-variable 'emerge-combine-versions-template))
  (setq emerge-combine-versions-template string)
  (message
   (if (assq 'emerge-combine-versions-template (buffer-local-variables))
       "emerge-set-combine-versions-template set locally"
     "emerge-set-combine-versions-template set")))

(defun emerge-set-combine-versions-template (start end &optional localize)
  "Copy region into `emerge-combine-versions-template'.
This controls how `emerge-combine-versions' will combine the two versions.
With prefix argument, `emerge-combine-versions-template' is made local to this
merge buffer.  Localization is permanent for any particular merge buffer."
  (interactive "r\nP")
  (if localize
      (make-local-variable 'emerge-combine-versions-template))
  (setq emerge-combine-versions-template (buffer-substring start end))
  (message
   (if (assq 'emerge-combine-versions-template (buffer-local-variables))
       "emerge-set-combine-versions-template set locally."
     "emerge-set-combine-versions-template set.")))

(defun emerge-combine-versions (&optional force)
  "Combine versions using the template in `emerge-combine-versions-template'.
Refuses to function if this difference has been edited, i.e., if it is
neither the A nor the B variant.
An argument forces the variant to be selected even if the difference has
been edited."
  (interactive "P")
  (emerge-combine-versions-internal emerge-combine-versions-template force))

(defun emerge-combine-versions-register (char &optional force)
  "Combine the two versions using the template in register REG.
See documentation of the variable `emerge-combine-versions-template'
for how the template is interpreted.
Refuses to function if this difference has been edited, i.e., if it is
neither the A nor the B variant.
An argument forces the variant to be selected even if the difference has
been edited."
  (interactive "cRegister containing template: \nP")
  (let ((template (get-register char)))
    (if (not (stringp template))
	(error "Register does not contain text"))
    (emerge-combine-versions-internal template force)))

(defun emerge-combine-versions-internal (template force)
  (let ((operate
	 (function (lambda ()
		     (emerge-combine-versions-edit merge-begin merge-end
						   A-begin A-end B-begin B-end)
		     (if emerge-auto-advance
			 (emerge-next-difference))))))
    (emerge-select-version force operate operate operate)))

(defun emerge-combine-versions-edit (merge-begin merge-end
				     A-begin A-end B-begin B-end)
  (emerge-eval-in-buffer
   emerge-merge-buffer
   (delete-region merge-begin merge-end)
   (goto-char merge-begin)
   (let ((i 0))
     (while (< i (length template))
       (let ((c (aref template i)))
	 (if (= c ?%)
	     (progn
	       (setq i (1+ i))
	       (setq c 
		     (condition-case nil
			 (aref template i)
		       (error ?%)))
	       (cond ((= c ?a)
		      (insert-buffer-substring emerge-A-buffer A-begin A-end))
		     ((= c ?b) 
		      (insert-buffer-substring emerge-B-buffer B-begin B-end))
		     ((= c ?%) 
		      (insert ?%))
		     (t
		      (insert c))))
	   (insert c)))
       (setq i (1+ i))))
   (goto-char merge-begin)
   (aset diff-vector 6 'combined)
   (emerge-refresh-mode-line)))

(defun emerge-set-merge-mode (mode)
  "Set the major mode in a merge buffer.
Overrides any change that the mode might make to the mode line or local
keymap.  Leaves merge in fast mode."
  (interactive
   (list (intern (completing-read "New major mode for merge buffer: "
				  obarray 'commandp t nil))))
  (funcall mode)
  (emerge-refresh-mode-line)
  (if emerge-fast-mode
      (emerge-fast-mode)
    (emerge-edit-mode)))

(defun emerge-one-line-window ()
  (interactive)
  (let ((window-min-height 1))
    (shrink-window (- (window-height) 2))))

;;; Support routines

;; Select a difference by placing the visual flags around the appropriate
;; group of lines in the A, B, and merge buffers
(defun emerge-select-difference (n)
  (let ((emerge-globalized-difference-list emerge-difference-list)
	(emerge-globalized-number-of-differences emerge-number-of-differences))
    (emerge-place-flags-in-buffer emerge-A-buffer n 0 1)
    (emerge-place-flags-in-buffer emerge-B-buffer n 2 3)
    (emerge-place-flags-in-buffer nil n 4 5))
  (run-hooks 'emerge-select-hook))

(defun emerge-place-flags-in-buffer (buffer difference before-index
					    after-index)
  (if buffer
      (emerge-eval-in-buffer
       buffer
       (emerge-place-flags-in-buffer1 difference before-index after-index))
    (emerge-place-flags-in-buffer1 difference before-index after-index)))

(defun emerge-place-flags-in-buffer1 (difference before-index after-index)
  (let ((buffer-read-only nil))
    ;; insert the flag before the difference
    (let ((before (aref (aref emerge-globalized-difference-list difference)
			before-index))
	  here)
      (goto-char before)
      ;; insert the flag itself
      (insert-before-markers emerge-before-flag)
      (setq here (point))
      ;; Put the marker(s) referring to this position 1 character before the
      ;; end of the flag, so it won't be damaged by the user.
      ;; This gets a bit tricky, as there could be a number of markers
      ;; that have to be moved.
      (set-marker before (1- before))
      (let ((n (1- difference)) after-marker before-marker diff-list)
	(while (and
		(>= n 0)
		(progn
		  (setq diff-list (aref emerge-globalized-difference-list n)
			after-marker (aref diff-list after-index))
		  (= after-marker here)))
	  (set-marker after-marker (1- after-marker))
	  (setq before-marker (aref diff-list before-index))
	  (if (= before-marker here)
	      (setq before-marker (1- before-marker)))
	  (setq n (1- n)))))
    ;; insert the flag after the difference
    (let* ((after (aref (aref emerge-globalized-difference-list difference)
			after-index))
	   (here (marker-position after)))
      (goto-char here)
      ;; insert the flag itself
      (insert emerge-after-flag)
      ;; Put the marker(s) referring to this position 1 character after the
      ;; beginning of the flag, so it won't be damaged by the user.
      ;; This gets a bit tricky, as there could be a number of markers
      ;; that have to be moved.
      (set-marker after (1+ after))
      (let ((n (1+ difference)) before-marker after-marker diff-list)
	(while (and
		(< n emerge-globalized-number-of-differences)
		(progn
		  (setq diff-list (aref emerge-globalized-difference-list n)
			before-marker (aref diff-list before-index))
		  (= before-marker here)))
	  (set-marker before-marker (1+ before-marker))
	  (setq after-marker (aref diff-list after-index))
	  (if (= after-marker here)
	      (setq after-marker (1+ after-marker)))
	  (setq n (1+ n)))))))

;; Unselect a difference by removing the visual flags in the buffers.
(defun emerge-unselect-difference (n)
  (let ((diff-vector (aref emerge-difference-list n)))
    (emerge-remove-flags-in-buffer emerge-A-buffer
				   (aref diff-vector 0) (aref diff-vector 1))
    (emerge-remove-flags-in-buffer emerge-B-buffer
				   (aref diff-vector 2) (aref diff-vector 3))
    (emerge-remove-flags-in-buffer emerge-merge-buffer
				   (aref diff-vector 4) (aref diff-vector 5)))
  (run-hooks 'emerge-unselect-hook))

(defun emerge-remove-flags-in-buffer (buffer before after)
  (emerge-eval-in-buffer
   buffer
   (let ((buffer-read-only nil))
     ;; remove the flags, if they're there
     (goto-char (- before (1- emerge-before-flag-length)))
     (if (looking-at emerge-before-flag-match)
	 (delete-char emerge-before-flag-length)
       ;; the flag isn't there
       (ding)
       (message "Trouble removing flag"))
     (goto-char (1- after))
     (if (looking-at emerge-after-flag-match)
	 (delete-char emerge-after-flag-length)
       ;; the flag isn't there
       (ding)
       (message "Trouble removing flag")))))

;; Select a difference, removing any flags that exist now.
(defun emerge-unselect-and-select-difference (n &optional suppress-display)
  (if (and (>= emerge-current-difference 0)
	   (< emerge-current-difference emerge-number-of-differences))
      (emerge-unselect-difference emerge-current-difference))
  (if (and (>= n 0) (< n emerge-number-of-differences))
      (progn
	(emerge-select-difference n)
	(let* ((diff-vector (aref emerge-difference-list n))
	       (selection-type (aref diff-vector 6)))
	  (if (eq selection-type 'default-A)
	      (aset diff-vector 6 'A)
	    (if (eq selection-type 'default-B)
		(aset diff-vector 6 'B))))))
  (setq emerge-current-difference n)
  (if (not suppress-display)
      (progn
	(emerge-recenter)
	(emerge-refresh-mode-line))))

;; Perform tests to see whether user should be allowed to select a version
;; of this difference:
;;   a valid difference has been selected; and
;;   the difference text in the merge buffer is:
;;     the A version (execute a-version), or
;;     the B version (execute b-version), or
;;     empty (execute neither-version), or
;;     argument FORCE is true (execute neither-version)
;; Otherwise, signal an error.
(defun emerge-select-version (force a-version b-version neither-version)
  (emerge-validate-difference)
  (let ((buffer-read-only nil))
    (let* ((diff-vector
	    (aref emerge-difference-list emerge-current-difference))
	   (A-begin (1+ (aref diff-vector 0)))
	   (A-end (1- (aref diff-vector 1)))
	   (B-begin (1+ (aref diff-vector 2)))
	   (B-end (1- (aref diff-vector 3)))
	   (merge-begin (1+ (aref diff-vector 4)))
	   (merge-end (1- (aref diff-vector 5))))
      (if (emerge-compare-buffers emerge-A-buffer A-begin A-end
				  emerge-merge-buffer merge-begin
				  merge-end)
	  (funcall a-version)
	(if (emerge-compare-buffers emerge-B-buffer B-begin B-end
				    emerge-merge-buffer merge-begin
				    merge-end)
	    (funcall b-version)
	  (if (or force (= merge-begin merge-end))
	      (funcall neither-version)
	    (error "This difference region has been edited")))))))

;; Read a file name, handling all of the various defaulting rules.

(defun emerge-read-file-name (prompt alternative-default-dir default-file
			      A-file must-match)
  ;; `prompt' should not have trailing ": ", so that it can be modified
  ;; according to context.
  ;; If alternative-default-dir is non-nil, it should be used as the default
  ;; directory instead if default-directory, if emerge-default-last-directories
  ;; is set.
  ;; If default-file is set, it should be used as the default value.
  ;; If A-file is set, and its directory is different from
  ;; alternative-default-dir, and if emerge-default-last-directories is set,
  ;; the default file should be the last part of A-file in the default
  ;; directory.  (Overriding default-file.)
  (cond
   ;; If this is not the A-file argument (shown by non-nil A-file), and
   ;; if emerge-default-last-directories is set, and
   ;; the default directory exists but is not the same as the directory of the
   ;; A-file,
   ;; then make the default file have the same name as the A-file, but in
   ;; the default directory.
   ((and emerge-default-last-directories
	 A-file
	 alternative-default-dir
	 (not (string-equal alternative-default-dir
			    (file-name-directory A-file))))
    (read-file-name (format "%s (default %s): "
			    prompt (file-name-nondirectory A-file))
		    alternative-default-dir
		    (concat alternative-default-dir
			    (file-name-nondirectory A-file))
		    (and must-match 'confirm)))
   ;; If there is a default file, use it.
   (default-file
     (read-file-name (format "%s (default %s): " prompt default-file)
		     ;; If emerge-default-last-directories is set, use the
		     ;; directory from the same argument of the last call of
		     ;; Emerge as the default for this argument.
		     (and emerge-default-last-directories
			  alternative-default-dir)
		     default-file (and must-match 'confirm)))
   (t
    (read-file-name (concat prompt ": ")
		    ;; If emerge-default-last-directories is set, use the
		    ;; directory from the same argument of the last call of
		    ;; Emerge as the default for this argument.
		    (and emerge-default-last-directories
			 alternative-default-dir)
		    nil (and must-match 'confirm)))))

;; Revise the mode line to display which difference we have selected

(defun emerge-refresh-mode-line ()
  (setq mode-line-buffer-identification
	(list (format "Emerge: %%b   diff %d of %d%s"
		      (1+ emerge-current-difference)
		      emerge-number-of-differences
		      (if (and (>= emerge-current-difference 0)
			       (< emerge-current-difference
				  emerge-number-of-differences))
			  (cdr (assq (aref (aref emerge-difference-list
						 emerge-current-difference)
					   6)
				     '((A . " - A")
				       (B . " - B")
				       (prefer-A . " - A*")
				       (prefer-B . " - B*")
				       (combined . " - comb"))))
			""))))
  (force-mode-line-update))

;; compare two regions in two buffers for containing the same text
(defun emerge-compare-buffers (buffer-x x-begin x-end buffer-y y-begin y-end)
  ;; first check that the two regions are the same length
  (if (not (and (= (- x-end x-begin) (- y-end y-begin))))
      nil
    (catch 'exit
      (while (< x-begin x-end)
	;; bite off and compare no more than 1000 characters at a time
	(let* ((compare-length (min (- x-end x-begin) 1000))
	       (x-string (emerge-eval-in-buffer 
			  buffer-x
			  (buffer-substring x-begin
					    (+ x-begin compare-length))))
	       (y-string (emerge-eval-in-buffer
			  buffer-y
			  (buffer-substring y-begin
					    (+ y-begin compare-length)))))
	  (if (not (string-equal x-string y-string))
	      (throw 'exit nil)
	    (setq x-begin (+ x-begin compare-length))
	    (setq y-begin (+ y-begin compare-length)))))
      t)))

;; Construct a unique buffer name.
;; The first one tried is prefixsuffix, then prefix<2>suffix, 
;; prefix<3>suffix, etc.
(defun emerge-unique-buffer-name (prefix suffix)
  (if (null (get-buffer (concat prefix suffix)))
      (concat prefix suffix)
    (let ((n 2))
      (while (get-buffer (format "%s<%d>%s" prefix n suffix))
	(setq n (1+ n)))
      (format "%s<%d>%s" prefix n suffix))))

;; Verify that we have a difference selected.
(defun emerge-validate-difference ()
  (if (not (and (>= emerge-current-difference 0)
		(< emerge-current-difference emerge-number-of-differences)))
      (error "No difference selected")))

;;; Functions for saving and restoring a batch of variables

;; These functions save (get the values of) and restore (set the values of)
;; a list of variables.  The argument is a list of symbols (the names of
;; the variables).  A list element can also be a list of two functions,
;; the first of which (when called with no arguments) gets the value, and
;; the second (when called with a value as an argument) sets the value.
;; A "function" is anything that funcall can handle as an argument.

(defun emerge-save-variables (vars)
  (mapcar (function (lambda (v) (if (symbolp v)
				    (symbol-value v)
				  (funcall (car v)))))
	  vars))

(defun emerge-restore-variables (vars values)
  (while vars
    (let ((var (car vars))
	  (value (car values)))
      (if (symbolp var)
	  (set var value)
	(funcall (car (cdr var)) value)))
    (setq vars (cdr vars))
    (setq values (cdr values))))

;; Make a temporary file that only we have access to.
;; PREFIX is appended to emerge-temp-file-prefix to make the filename prefix.
(defun emerge-make-temp-file (prefix)
  (let ((f (make-temp-name (concat emerge-temp-file-prefix prefix))))
    ;; create the file
    (write-region (point-min) (point-min) f nil 'no-message)
    (set-file-modes f emerge-temp-file-mode)
    f))

;;; Functions that query the user before he can write out the current buffer.

(defun emerge-query-write-file ()
  "Ask the user whether to write out an incomplete merge.
If answer is yes, call `write-file' to do so.  See `emerge-query-and-call'
for details of the querying process."
  (interactive)
  (emerge-query-and-call 'write-file))

(defun emerge-query-save-buffer ()
  "Ask the user whether to save an incomplete merge.
If answer is yes, call `save-buffer' to do so.  See `emerge-query-and-call'
for details of the querying process."
  (interactive)
  (emerge-query-and-call 'save-buffer))

(defun emerge-query-and-call (command)
  "Ask the user whether to save or write out the incomplete merge.
If answer is yes, call COMMAND interactively.  During the call, the flags
around the current difference are removed."
  (if (yes-or-no-p "Do you really write to write out this unfinished merge? ")
      ;; He really wants to do it -- unselect the difference for the duration
      (progn
	(if (and (>= emerge-current-difference 0)
		 (< emerge-current-difference emerge-number-of-differences))
	    (emerge-unselect-difference emerge-current-difference))
	;; call-interactively takes the value of current-prefix-arg as the
	;; prefix argument value to be passed to the command.  Thus, we have
	;; to do nothing special to make sure the prefix argument is
	;; transmitted to the command.
	(call-interactively command)
	(if (and (>= emerge-current-difference 0)
		 (< emerge-current-difference emerge-number-of-differences))
	    (progn
	      (emerge-select-difference emerge-current-difference)
	      (emerge-recenter))))
    ;; He's being smart and not doing it
    (message "Not written")))

;; Make sure the current buffer (for a file) has the same contents as the
;; file on disk, and attempt to remedy the situation if not.
;; Signal an error if we can't make them the same, or the user doesn't want
;; to do what is necessary to make them the same.
(defun emerge-verify-file-buffer ()
  ;; First check if the file has been modified since the buffer visited it.
  (if (verify-visited-file-modtime (current-buffer))
      (if (buffer-modified-p)
	  ;; If buffer is not obsolete and is modified, offer to save
	  (if (yes-or-no-p (format "Save file %s? " buffer-file-name))
	      (save-buffer)
	    (error "Buffer out of sync for file %s" buffer-file-name))
	;; If buffer is not obsolete and is not modified, do nothing
	nil)
    (if (buffer-modified-p)
	;; If buffer is obsolete and is modified, give error
	(error "Buffer out of sync for file %s" buffer-file-name)
      ;; If buffer is obsolete and is not modified, offer to revert
      (if (yes-or-no-p (format "Revert file %s? " buffer-file-name))
	      (revert-buffer t t)
	(error "Buffer out of sync for file %s" buffer-file-name)))))

;; Utilities that might have value outside of Emerge.

;; Set up the mode in the current buffer to duplicate the mode in another
;; buffer.
(defun emerge-copy-modes (buffer)
  ;; Set the major mode
  (funcall (emerge-eval-in-buffer buffer major-mode)))

;; Define a key, even if a prefix of it is defined
(defun emerge-force-define-key (keymap key definition)
  "Like `define-key', but forcibly creates prefix characters as needed.
If some prefix of KEY has a non-prefix definition, it is redefined."
  ;; Find out if a prefix of key is defined
  (let ((v (lookup-key keymap key)))
    ;; If so, undefine it
    (if (integerp v)
	(define-key keymap (substring key 0 v) nil)))
  ;; Now define the key
  (define-key keymap key definition))

;;;;; Improvements to describe-mode, so that it describes minor modes as well
;;;;; as the major mode
;;(defun describe-mode (&optional minor)
;;  "Display documentation of current major mode.
;;If optional arg MINOR is non-nil (or prefix argument is given if interactive),
;;display documentation of active minor modes as well.
;;For this to work correctly for a minor mode, the mode's indicator variable
;;\(listed in `minor-mode-alist') must also be a function whose documentation
;;describes the minor mode."
;;  (interactive)
;;  (with-output-to-temp-buffer "*Help*"
;;    (princ mode-name)
;;    (princ " Mode:\n")
;;    (princ (documentation major-mode))
;;    (let ((minor-modes minor-mode-alist)
;;	  (locals (buffer-local-variables)))
;;      (while minor-modes
;;	(let* ((minor-mode (car (car minor-modes)))
;;	       (indicator (car (cdr (car minor-modes))))
;;	       (local-binding (assq minor-mode locals)))
;;	  ;; Document a minor mode if it is listed in minor-mode-alist,
;;	  ;; bound locally in this buffer, non-nil, and has a function
;;	  ;; definition.
;;	  (if (and local-binding
;;		   (cdr local-binding)
;;		   (fboundp minor-mode))
;;	      (progn
;;		(princ (format "\n\n\n%s minor mode (indicator%s):\n"
;;			       minor-mode indicator))
;;		(princ (documentation minor-mode)))))
;;	(setq minor-modes (cdr minor-modes))))
;;    (save-excursion
;;      (set-buffer standard-output)
;;      (help-mode))
;;    (print-help-return-message)))

;; This goes with the redefinition of describe-mode.
;;;; Adjust things so that keyboard macro definitions are documented correctly.
;;(fset 'defining-kbd-macro (symbol-function 'start-kbd-macro))

;; substitute-key-definition should work now.
;;;; Function to shadow a definition in a keymap with definitions in another.
;;(defun emerge-shadow-key-definition (olddef newdef keymap shadowmap)
;;  "Shadow OLDDEF with NEWDEF for any keys in KEYMAP with entries in SHADOWMAP.
;;In other words, SHADOWMAP will now shadow all definitions of OLDDEF in KEYMAP
;;with NEWDEF.  Does not affect keys that are already defined in SHADOWMAP,
;;including those whose definition is OLDDEF."
;;  ;; loop through all keymaps accessible from keymap
;;  (let ((maps (accessible-keymaps keymap)))
;;    (while maps
;;      (let ((prefix (car (car maps)))
;;	    (map (cdr (car maps))))
;;	;; examine a keymap
;;	(if (arrayp map)
;;	    ;; array keymap
;;	    (let ((len (length map))
;;		  (i 0))
;;	      (while (< i len)
;;		(if (eq (aref map i) olddef)
;;		    ;; set the shadowing definition
;;		    (let ((key (concat prefix (char-to-string i))))
;;		      (emerge-define-key-if-possible shadowmap key newdef)))
;;		(setq i (1+ i))))
;;	  ;; sparse keymap
;;	  (while map
;;	    (if (eq (cdr-safe (car-safe map)) olddef)
;;		;; set the shadowing definition
;;		(let ((key
;;		       (concat prefix (char-to-string (car (car map))))))
;;		      (emerge-define-key-if-possible shadowmap key newdef)))
;;	    (setq map (cdr map)))))
;;      (setq maps (cdr maps)))))

;; Define a key if it (or a prefix) is not already defined in the map.
(defun emerge-define-key-if-possible (keymap key definition)
  ;; look up the present definition of the key
  (let ((present (lookup-key keymap key)))
    (if (integerp present)
	;; if it is "too long", look up the valid prefix
	(if (not (lookup-key keymap (substring key 0 present)))
	    ;; if the prefix isn't defined, define it
	    (define-key keymap key definition))
      ;; if there is no present definition, define it
      (if (not present)
	  (define-key keymap key definition)))))

;; Ordinary substitute-key-definition should do this now.
;;(defun emerge-recursively-substitute-key-definition (olddef newdef keymap)
;;  "Like `substitute-key-definition', but act recursively on subkeymaps.
;;Make sure that subordinate keymaps aren't shared with other keymaps!
;;\(`copy-keymap' will suffice.)"
;;  ;; Loop through all keymaps accessible from keymap
;;  (let ((maps (accessible-keymaps keymap)))
;;    (while maps
;;      ;; Substitute in this keymap
;;      (substitute-key-definition olddef newdef (cdr (car maps)))
;;      (setq maps (cdr maps)))))

;; Show the name of the file in the buffer.
(defun emerge-show-file-name ()
  "Displays the name of the file loaded into the current buffer.
If the name won't fit on one line, the minibuffer is expanded to hold it,
and the command waits for a keystroke from the user.  If the keystroke is
SPC, it is ignored; if it is anything else, it is processed as a command."
  (interactive)
  (let ((name (buffer-file-name)))
    (or name
	(setq name "Buffer has no file name."))
    (save-window-excursion
      (select-window (minibuffer-window))
      (erase-buffer)
      (insert name)
      (if (not (pos-visible-in-window-p))
	  (let ((echo-keystrokes 0))
	    (while (and (not (pos-visible-in-window-p))
			(> (1- (screen-height)) (window-height)))
	      (enlarge-window 1))
	    (let ((c (read-event)))
	      (if (not (eq c 32))
		  (setq unread-command-events (list c)))))))))

;; Improved auto-save file names.
;; This function fixes many problems with the standard auto-save file names:
;; Auto-save files for non-file buffers get put in the default directory
;; for the buffer, whether that makes sense or not.
;; Auto-save files for file buffers get put in the directory of the file,
;; regardless of whether we can write into it or not.
;; Auto-save files for non-file buffers don't use the process id, so if a
;; user runs more than on Emacs, they can make auto-save files that overwrite
;; each other.
;; To use this function, do:
;;	(fset 'make-auto-save-file-name
;;	      (symbol-function 'emerge-make-auto-save-file-name))
(defun emerge-make-auto-save-file-name ()
  "Return file name to use for auto-saves of current buffer.
Does not consider `auto-save-visited-file-name';
that is checked before calling this function.
You can redefine this for customization.
See also `auto-save-file-name-p'."
  (if buffer-file-name
      ;; if buffer has a file, try the format <file directory>/#<file name>#
      (let ((f (concat (file-name-directory buffer-file-name)
		       "#"
		       (file-name-nondirectory buffer-file-name)
		       "#")))
	(if (file-writable-p f)
	    ;; the file is writable, so use it
	    f
	  ;; the file isn't writable, so use the format
	  ;; ~/#&<file name>&<hash of directory>#
	  (concat (getenv "HOME")
		  "/#&"
		  (file-name-nondirectory buffer-file-name)
		  "&"
		  (emerge-hash-string-into-string
		   (file-name-directory buffer-file-name))
		  "#")))
    ;; if buffer has no file, use the format ~/#%<buffer name>%<process id>#
    (expand-file-name (concat (getenv "HOME")
			      "/#%"
			      ;; quote / into \! and \ into \\
			      (emerge-unslashify-name (buffer-name))
			      "%"
			      (make-temp-name "")
			      "#"))))

;; Hash a string into five characters more-or-less suitable for use in a file
;; name.  (Allowed characters are ! through ~, except /.)
(defun emerge-hash-string-into-string (s)
  (let ((bins (vector 0 0 0 0 0))
	(i 0))
    (while (< i (length s))
      (aset bins (% i 5) (% (+ (* (aref bins (% i 5)) 35)
			       (aref s i))
			    65536))
      (setq i (1+ i)))
    (mapconcat (function (lambda (b)
			   (setq b (+ (% b 93) ?!))
			   (if (>= b ?/)
			       (setq b (1+ b)))
			   (char-to-string b)))
	       bins "")))

;; Quote any /s in a string by replacing them with \!.
;; Also, replace any \s by \\, to make it one-to-one.
(defun emerge-unslashify-name (s)
  (let ((limit 0))
    (while (string-match "[/\\]" s limit)
      (setq s (concat (substring s 0 (match-beginning 0))
		      (if (string= (substring s (match-beginning 0)
					      (match-end 0))
				   "/")
			  "\\!"
			"\\\\")
		      (substring s (match-end 0))))
      (setq limit (1+ (match-end 0)))))
  s)

;; Metacharacters that have to be protected from the shell when executing
;; a diff/diff3 command.
(defvar emerge-metachars "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]"
  "Characters that must be quoted with \\ when used in a shell command line.
More precisely, a [...] regexp to match any one such character.")

;; Quote metacharacters (using \) when executing a diff/diff3 command.
(defun emerge-protect-metachars (s)
  (let ((limit 0))
    (while (string-match emerge-metachars s limit)
      (setq s (concat (substring s 0 (match-beginning 0))
		      "\\"
		      (substring s (match-beginning 0))))
      (setq limit (1+ (match-end 0)))))
  s)

(provide 'emerge)

;;; emerge.el ends here
@EOF

chmod 440 bench-large.el

exit 0


-- 
Shane Holder                                 e-mail: holder@rsn.hp.com
Hewlett Packard                               phone:     (214)497-4182
3000 Waterview                       Never underestimate the bandwidth
Richardson, TX 75083                 of a truck moving at 70 MPH.

