;;; ====================================================================
;;;  @Emacs-Lisp-file{
;;;     author          = "Nelson H. F. Beebe",
;;;     version         = "1.31",
;;;     date            = "04 February 2006",
;;;     time            = "10:27:52 MST",
;;;     filename        = "filehdr.el",
;;;     address         = "University of Utah
;;;                        Department of Mathematics, 110 LCB
;;;                        155 S 1400 E RM 233
;;;                        Salt Lake City, UT 84112-0090
;;;                        USA
;;;     telephone       = "+1 801 581 5254",
;;;     FAX             = "+1 801 581 4148",
;;;     URL             = "http://www.math.utah.edu/~beebe",
;;;     checksum        = "07603 1893 7852 74843",
;;;     email           = "beebe@math.utah.edu (Internet)",
;;;     codetable       = "ISO/ASCII",
;;;     keywords        = "checksum; file header",
;;;     license         = "public domain",
;;;     supported       = "yes",
;;;     docstring       = {This file provides functions written in GNU
;;;                        Emacs Lisp for the generation of standard
;;;                        file headers, like this one.  The headers
;;;                        resembles a BibTeX bibliography entry, with
;;;                        key = "value" fields that document the file
;;;                        contents.
;;;
;;;                        The only user-callable functions in this file
;;;                        are these:
;;;
;;;                        make-file-header
;;;                        show-file-header-variables
;;;                        test-file-header
;;;                        update-checksum
;;;                        update-date
;;;                        update-date-and-minor-version
;;;                        update-file-header-and-save
;;;                        update-license
;;;                        update-major-version
;;;                        update-minor-version
;;;                        update-simple-checksum
;;;
;;;                        Here is a quick guide to using these
;;;                        functions:
;;;
;;;                        (1) See the note below about defining the
;;;                            file-header-user-address variable.  If
;;;                            you forget to set
;;;                            file-header-user-address, you'll just
;;;                            get an empty string in that position.
;;;                            The same applies to
;;;                            file-header-user-telephone and
;;;                            file-header-user-FAX.
;;;                        (2) Load this file by
;;;                              M-x load-file<RET>filehdr.el
;;;                            or put the line
;;;                              (load "/some-dir-name/filehdr.el" t t t)
;;;                            in your .emacs file so you always have it
;;;                            preloaded.
;;;                        (3) Position the cursor to the line at which
;;;                            you want the header, and type
;;;                            M-x make-file-header.
;;;                        (4) Fill in the empty fields, starting with
;;;                            the one where the cursor is positioned.
;;;                        (5) Make your edits.
;;;                        (6) Type M-x update-file-header-and-save to
;;;                            set the new date, version, and checksum,
;;;                            and save the file.
;;;
;;;                        Here is an example of how to initialize the
;;;                        file-header-user-address and related
;;;                        variables in the ~/.emacs startup file;
;;;                        note that line breaks are PRESERVED:
;;;
;;;                        (setq file-header-user-address
;;;                          "Center for Scientific Computing
;;;                        Department of Mathematics
;;;                        University of Utah
;;;                        Salt Lake City, UT 84112
;;;                        USA")
;;;
;;;                        (setq file-header-user-telephone "+1 801 581 5254")
;;;
;;;                        (setq file-header-user-FAX "+1 801 581 4148")
;;;
;;;                        The user personal name and electronic mail
;;;                        address will be obtained automatically from
;;;                        system authorization files.  If the e-mail
;;;                        address constructed from these is inadequate,
;;;                        then you can instead set it in the variable
;;;                        file-header-user-email.
;;;
;;;                        The function make-file-header generates a
;;;                        header customized to the type of the file,
;;;                        and to the user generating it.
;;;                        make-file-header knows about most standard
;;;                        file types (over 110 of them), including
;;;                        vagaries like the effect of at-signs in
;;;                        BibTeX files.  When it is in doubt, it will
;;;                        generate a UNKNOWN-file type entry.
;;;
;;;                        show-file-header-variables will show in a
;;;                        temporary buffer neatly-formatted tables with
;;;                        the settings of all variables named
;;;                        file-header-standard-xxx and
;;;                        file-header-extra-xxx.
;;;
;;;                        test-file-header will run make-file-header
;;;                        for every file type in
;;;                        file-header-standard-suffix-and-type and
;;;                        file-header-extra-suffix-and-type to test
;;;                        their correct execution.
;;;
;;;                        The function update-checksum recomputes and
;;;                        set the checksum field;
;;;                        update-simple-checksum is a simpler version
;;;                        that does not provide the CRC-16 checksum.
;;;                        It will be invoked automatically by
;;;                        update-checksum on VAX VMS until code is
;;;                        added to support calling the checksum
;;;                        program on that operating system.
;;;
;;;                        Similarly, update-date-and-minor-version
;;;                        resets the date to today, and increments
;;;                        the minor version number.
;;;
;;;                        update-major-version increments the major
;;;                        version, and resets the minor version to
;;;                        zero.
;;;
;;;                        update-minor-version increments the minor
;;;                        version.
;;;
;;;                        Finally, update-file-header-and-save
;;;                        combines these to reset the date, version
;;;                        and checksum, and save the file.
;;;
;;;                        The user-customizable variables are:
;;;
;;;                        file-header-extra-at-sign-special-cases
;;;                        file-header-extra-comment-prefixes
;;;                        file-header-extra-paired-comment-delimiter-languages
;;;                        file-header-extra-suffix-and-type
;;;
;;;                        They provide additions to the built-in lists
;;;                        stored in corresponding variables named
;;;                        file-header-standard-xxx.  Here is an example
;;;                        of how you might customize them:
;;;
;;;                        (setq file-header-extra-at-sign-special-cases
;;;                              '(
;;;                                ("Foo-Bar"      " <<<AT>>> ")
;;;                                ))
;;;
;;;                        (setq file-header-extra-comment-prefixes
;;;                              '(
;;;                                ("Foo-Bar"      "!FB!")
;;;                                ))
;;;
;;;                        (setq file-header-extra-suffix-and-type
;;;                              '(
;;;                                ("foobar"       "Foo-Bar")
;;;                               ))
;;;
;;;                   (setq file-header-extra-paired-comment-delimiter-languages
;;;                              '(
;;;                                ("Foo-Bar"
;;;                                 (concat "/#"  (make-string 70 ?\#) "\n")
;;;                                 (concat (make-string 70 ?\#) "#/\n"))
;;;                                ))
;;;
;;;                        These would define a new file type Foo-Bar
;;;                        attached to files with extension .foobar,
;;;                        for which comments are delimited by
;;;                        /# ...  #/, and by ! to end-of-line.  The
;;;                        file header body lines would all begin with
;;;                        !FB!.
;;;
;;;                        The checksum field above contains a CRC-16
;;;                        checksum as the first value, followed by the
;;;                        equivalent of the standard UNIX wc (word
;;;                        count) utility output of lines, words, and
;;;                        characters.  This is produced by Robert
;;;                        Solovay's checksum utility.}
;;;  }
;;; ====================================================================
;;;
;;; filehdr.el --- support for standard file headers
;;
;; Author: Nelson H. F. Beebe <beebe@math.utah.edu>
;; Created: 05-Sep-1991
;; Version: 1.31
;; Keywords: file header, checksum

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

;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Change log:
;;
;; NB: Don't forget to update file-header-code-version below!
;;
;; Version 1.31 [04-Feb-2006]
;;	Add file-header-license, and update update-file-header-and-save
;;	to install a license comment.
;;
;; Version 1.30 [17-Apr-1996]
;;	Extend the functions
;;		file-header-get-version-numbers,
;;		update-date,
;;		update-major-version,
;;	and
;;		update-minor-version
;;	to handle single alphabetic minor versions.  Add new user
;;	customization variables
;;		file-header-ISO-date-separator,
;;		file-header-ISO-date-style,
;;		file-header-minor-version-is-alphabetic,
;;	and
;;		file-header-month-numbers,
;;	and the new function
;;		file-header-ISO-date
;;	to support date fields of the form "1996/04/17", as well as the
;;	default "17 April 1996".  update-date will preserve whichever
;;	style is used in an existing date field, and for an empty field,
;;	will select the style according to the setting of
;;	file-header-ISO-date-style.
;;
;;	These features were requested by the American Mathematical
;;	Society to support the date and version styles used in the
;;	AmSTeX and (AmS)LaTeX files, which are in worldwide use.
;;
;;	Add the constant file-header-version-pattern to avoid
;;	replications of a complicated regular-expression in the code.
;;
;; Version 1.29 [05-Mar-1996] {Thanks to Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
;;	Add some more TeX- and METAFONT-related file types and
;;	extensions (suggested by Ulrik Vieth), plus several dozen new
;;	types and extensions for Expect, Fortran-90, HTML, Java, Python,
;;	SGML, Scheme, STk, and Tcl.
;;
;; Version 1.28 [26-Jan-1996]
;;	Add new variable file-header-user-URL and new function
;;	file-header-URL, and update file-header-standard-entries to
;;	include file-header-URL, so that a user WorldWide Web URL line
;;	is generated by make-file-header.
;;
;; Version 1.27 [31-Oct-1993] {Thanks to Niel Kempson <kempson@snowyowl.co.uk>}
;;	Add file-header-temp-file-prefix and use it in update-checksum
;;	for creating temporary file names.
;;
;; Version 1.26 [22-Oct-1993]
;;	Update update-checksum to handle a nil return (meaning success)
;;	from call-process (encountered on MIPS RC6280 RISCos 2.1.1)
;;
;; Version 1.25 [14-Jun-1993]
;;	Update for Emacs 19.  Change file-header-timezone to use
;;	current-time-zone when available.  Revise comment structure to
;;	match the standards described in info node elisp -> tips ->
;;	library headers.  Reformat functions according to guidelines
;;	in info node elisp -> tips -> style tips.  Use message instead
;;	of princ in one place, and replace message+ding by error
;;	function.
;;
;; Version 1.24 [17-Nov-1992]
;;	Modify update-file-header-and-save to suppress updating
;;	minor version number if invoked with an argument.
;;
;; Version 1.23 [14-Nov-1992]
;;	Add code in update-date to handle Karl Berry's timestamp
;;	variant.
;;
;; Version 1.22 [07-Nov-1992]
;;	Install workaround in update-checksum for nasty Emacs bug
;;	that resulted in loss of the buffer for large files.
;;
;; Version 1.21 [04-Oct-1992]
;;	Modify update-checksum to supply a final newline if one is
;;	lacking, and to remove trailing blank lines.
;;
;; Version 1.20 [01-Aug-1992]
;;	Change update-date to use delete-region instead of zap-to-char
;;	so as to leave the kill ring untouched.  Internationalize
;;	telephone and FAX numbers.
;;
;; Version 1.19 [29-May-1992] {Thanks to Alan Jeffrey
;;	<alanje@cogs.sussex.ac.uk> for suggestions.}
;;	Add abstract keyword, and additional comments in accompanying
;;	documentation about handling of multiple fields of one type.
;;
;; Version 1.18 [25-May-1992] {Thanks to David M. Jones
;; 	<dmjones@theory.lcs.mit.edu> for some of these improvements.}
;; 	Change user-xxx variables to file-header-user-xxx, and
;;	count-matches to file-header-count-matches, to avoid conflicts
;;	with other packages.
;;	Add file-header-user-email variable for more customization.
;;	Add load-time initializations of some variables that are
;;	normally set at run-time to remove undeclared-variable
;;	warnings issued by new byte-compile-file.
;;
;; Version 1.17 [25-Mar-1992]
;;	Use call-process instead of shell-command for getting time
;;	zone; the speedup is noticeable.
;;
;; Version 1.16 [07-Jan-1992]
;;	Correct minor error in setting of the variable
;;	file-header-standard-suffix-and-type for Xdefaults.
;;
;; Version 1.15 [30-Dec-1991]
;;	Add workaround in file-header-timezone for possible extra
;;	garbage generated by shell-command; this can happen if the
;;	shell startup file produces any output.
;;
;; Version 1.14 [19-Dec-1991]
;;	Add 4Dwmrc entry to file-header-standard-suffix-and-type and
;;	file-header-standard-comment-prefixes.
;;
;; Version 1.13 [17-Dec-1991]
;;	Replace file-header-comment-start-string by calls to
;;	file-header-comment-start; this was an unwise economization.
;;
;; Version 1.12 [16-Dec-1991]
;;	Add definition of file-header-comment-start-string if found to
;;	be nil in functions that use it.
;;
;; Version 1.11 [12-Dec-1991]
;;	Add new functions file-header-get-version-numbers and
;;	file-header-number-list, and new variables
;;	internal-file-header-prefix-version,
;;	internal-file-header-major-version, and
;;	internal-file-header-minor-version.  Extend
;;	update-major-version and update-minor-version to handle zero
;;	or more dot-separated unsigned integers.
;;
;; Version 1.10 [11-Dec-1991]
;;	Add show-file-header-variables, internal-show-file-header-alist,
;;	and internal-show-file-header-entry.
;;	Update test-file-header to use file-header-extra-suffix-and-type
;;	values as well.
;;	Revise make-file-header to use file-header-standard-entries and
;;	file-header-extra-entries to allow better customization.
;;	Add file-header-telephone and FAX entries to
;;	file-header-standard-entries.
;;	Add functions file-header-time and file-header-timezone, and
;;	variable file-header-timezone-string, and add time to
;;	file-header-standard-entries.
;;	Make update-date handle the time as well, and insert a time
;;	entry if one is not already present.
;;
;; Version 1.09 [09-Dec-1991]
;;	Add a space before \\ in \date{...} so that it is preserved if
;;	the date is later used in a LaTeX page header.
;;
;; Version 1.08 [12-Nov-1991]
;;	Add more support for X Window System files
;;
;; Version 1.07 [09-Nov-1991]
;;	Add support for X Window System files
;;
;; Version 1.06 [02-Nov-1991]
;;	Repair stupid typo in declaration of
;;	file-header-extra-suffix-and-type.
;;
;; Version 1.05 [25-Oct-1991]
;;	Add support for Reduce.
;;
;;	For all variables file-header-standard-xxx, add user
;;	customization variables file-header-extra-xxx.  The extra ones
;;	are APPENDED to the standard ones, so they can augment, but not
;;	replace, them.
;;
;; Version 1.04 [19-Oct-1991]
;;	Add support for Basic, C Locale, and Digital Standard Runoff.
;;
;;	Fix Scribe support.
;;
;; Version 1.03 [11-Sep-1991]
;;	Make file-header-date return full month names instead of
;;	3-letter abbreviations.
;;
;; Version 1.02 [10-Sep-1991]
;;	Change file-header-comment-delimiter-line to only output text
;;	when the language has inline comments.
;;
;;	Rename update-file-header-checksum to update-simple-checksum.
;;
;;	Add update-checksum, update-date,
;;	update-date-and-minor-version, update-major-version,
;;	update-minor-version, and update-header-and-save.
;;	update-checksum will call update-simple-checksum to do the job
;;	on VAX VMS, since I have not yet added support for the calling
;;	the checksum program under VAX VMS.
;;
;;	Introduce association list variables
;;	file-header-standard-at-sign-special-cases,
;;	file-header-standard-comment-prefixes,
;;	file-header-standard-paired-comment-delimiter-languages, and
;;	file-header-standard-suffix-and-type to simplify code and ease
;;	future additions.
;;
;;	Modify file-header-at-sign and file-header-entry to handle at
;;	signs differently in Web files, using
;;	file-header-standard-at-sign-special-cases for the exceptional
;;	cases.
;;
;;	Add test-file-header function for testing the code.
;;
;; Version 1.01 [06-Sep-1991]
;;	Change long filename from make-file-header.el to shorter
;;	filehdr.el.
;;
;;	Add several new extensions for web, cweb, and troff.
;;
;;	Add file-header-comment-delimiter-line and call in
;;	file-header-entry and file-header-exit to make the inserted
;;	header more visible.
;;
;;	Add file-header-code-author and file-header-code-version
;;	variables.
;;
;; Version 1.00 [05-Sep-1991]
;;	First release
;; ====================================================================

(defconst file-header-code-author
  "Nelson H. F. Beebe <beebe@math.utah.edu>"
  "Author of code in filehdr.el")

(defconst file-header-code-version nil
  "Version number of the filehdr.el library, a collection of functions
for the generation and maintenance of standard file headers.")

(setq file-header-code-version "1.31 [04-Feb-2006]")
;;; (setq file-header-code-version "1.30 [17-Apr-1996]")
;;; (setq file-header-code-version "1.29 [05-Mar-1996]")
;;; (setq file-header-code-version "1.28 [26-Jan-1996]")
;;; (setq file-header-code-version "1.27 [31-Oct-1993]")
;;; (setq file-header-code-version "1.26 [22-Oct-1993]")
;;; (setq file-header-code-version "1.25 [14-Jun-1993]")
;;; (setq file-header-code-version "1.24 [17-Nov-1992]")
;;; (setq file-header-code-version "1.23 [14-Nov-1992]")
;;; (setq file-header-code-version "1.22 [07-Nov-1992]")
;;; (setq file-header-code-version "1.21 [04-Oct-1992]")
;;; (setq file-header-code-version "1.20 [01-Aug-1992]")
;;; (setq file-header-code-version "1.19 [29-May-1992]")
;;; (setq file-header-code-version "1.18 [25-May-1992]")
;;; (setq file-header-code-version "1.17 [25-Mar-1992]")
;;; (setq file-header-code-version "1.16 [07-Jan-1992]")
;;; (setq file-header-code-version "1.15 [30-Dec-1991]")
;;; (setq file-header-code-version "1.14 [19-Dec-1991]")
;;; (setq file-header-code-version "1.13 [17-Dec-1991]")
;;; (setq file-header-code-version "1.12 [16-Dec-1991]")
;;; (setq file-header-code-version "1.11 [12-Dec-1991]")
;;; (setq file-header-code-version "1.10 [11-Dec-1991]")
;;; (setq file-header-code-version "1.09 [09-Dec-1991]")
;;; (setq file-header-code-version "1.08 [12-Nov-1991]")
;;; (setq file-header-code-version "1.07 [09-Nov-1991]")
;;; (setq file-header-code-version "1.06 [02-Nov-1991]")
;;; (setq file-header-code-version "1.05 [25-Oct-1991]")
;;; (setq file-header-code-version "1.04 [19-Oct-1991]")
;;; (setq file-header-code-version "1.03 [11-Sep-1991]")
;;; (setq file-header-code-version "1.02 [10-Sep-1991]")
;;; (setq file-header-code-version "1.01 [06-Sep-1991]")
;;; (setq file-header-code-version "1.00 [05-Sep-1991]")

(defvar file-header-minor-version-is-alphabetic nil
  "*Option to control minor versioning.  Normally, version numbers
consist of dot-separated major and minor numbers, with the minor
number updated on each small change, and the major number updated much
less frequently.  When this option is set, update-minor-version will
leave the minor version number unchanged, and instead append a letter
a, b, c, ... to the current number.  Any previous suffix letter is
incremented by one.  This irregular versioning style is NOT encouraged.")

(defvar file-header-ISO-date-separator "/"
  "*Separator character used between the year and month, and between the
month and day, in ISO-style numeric dates, such as 1996/04/31.  Only
the first character of this string is used, in the event that more are
specified.")

(defvar file-header-ISO-date-style nil
  "*Option to control initial file header date style.  The default of nil
selects dates of the form \"31 April 1996\".  Non-nil selects the
ISO-style numeric form \"1996/04/31\", where the separator character is
determined by the variable file-header-ISO-date-separator.  This option
has no effect on existing dates; their style is preserved during updates.")

;;; Decide where temporary files should be placed.  If the environment
;;; variable TMP has been defined, we use its value.  If TMP has not
;;; been defined, we put the files in an O/S-dependent scratch
;;; directory.
(defvar file-header-temp-file-prefix
  (let* ( (env (getenv "TMP"))
          (prefix (cond
                   ((and env (> (length env) 0)) env)
                   ((eq system-type 'alpha-vms) "SYS$SCRATCH:")
                   ((eq system-type 'vax-vms) "SYS$SCRATCH:")
                   (t "/tmp/"))))
    (cond
     ((= (aref prefix (1- (length prefix))) ?:) nil) ;leave final colon
     ((= (aref prefix (1- (length prefix))) ?/) nil) ;leave final slash
     (t (concat prefix "/")))
    prefix)                             ;else supply final slash
  "*Prefix to put on temporary file names.  Do not start with `~/' or
`~user-name/'.")

(defvar file-header-user-address nil
  "*Customized personal address for make-file-header use.  This should
not include either your personal name or e-mail address, just a postal
address.")

(defvar file-header-user-email nil
  "*Customized personal e-mail address for file-header-email use when
the default of username@systemname is inadequate.")

(defvar file-header-user-telephone nil
  "*Customized personal telephone number(s) for make-file-header use.")

(defvar file-header-user-URL nil
  "*Customized personal WWW address for file-header-URL use when
the default of http://systemname/~username is inadequate.")

(defvar file-header-user-FAX nil
  "*Customized personal FAX number(s) for make-file-header use.")

(defconst file-header-month-abbrevs
  '(
    ("Jan"          "January")
    ("Feb"          "February")
    ("Mar"          "March")
    ("Apr"          "April")
    ("May"          "May")
    ("Jun"          "June")
    ("Jul"          "July")
    ("Aug"          "August")
    ("Sep"          "September")
    ("Oct"          "October")
    ("Nov"          "November")
    ("Dec"          "December"))
  "List of lists of pairs of month abbreviations and full names")

(defconst file-header-month-numbers
  '(("Jan"	"01")
    ("Feb"	"02")
    ("Mar"	"03")
    ("Apr"	"04")
    ("May"	"05")
    ("Jun"	"06")
    ("Jul"	"07")
    ("Aug"	"08")
    ("Sep"	"09")
    ("Oct"	"10")
    ("Nov"	"11")
    ("Dec"	"12"))
  "List of lists of pairs of month names and month numbers.")

(defconst file-header-keywords-pattern
  "keywords[ \t]*=[ \t]*\""
  "Pattern that matches a keywords number line.")


(defconst file-header-version-pattern
  "version[ \t]*=[ \t]*\"\\([0-9.]*\\)\\([A-Za-z]?\\)\""
  "Pattern that matches a version number line.")

;;; ====================================================================
;;; These variables may be customized according to user requirements,
;;; although in the interests of standardizing the file headers, it is
;;; STRONGLY recommended that you do so ONLY through the
;;; file-header-extra-xxx variables which augment, but do not replace,
;;; the values stored in the file-header-standard-xxx variables.
;;;
;;; The values are stored as association lists so that new entries can
;;; be easily added, or existing ones modified, by addition of short
;;; Emacs Lisp sequences to your .emacs startup file.
;;;
;;; Here is how to manipulate these lists:
;;;
;;; Prepend an element:
;;;     (setq file-header-standard-comment-prefixes
;;;             (cons (list "foo" "@@@ ")
;;;                   file-header-standard-comment-prefixes))
;;;
;;; Append an element:
;;;     (setq file-header-standard-comment-prefixes
;;;             (append file-header-standard-comment-prefixes
;;;             (list (list "foo" "@@@ "))))
;;;
;;; Delete an existing element:
;;;     (delq (assoc "Awk" file-header-standard-comment-prefixes)
;;;             file-header-standard-comment-prefixes)
;;;
;;; Since association lists are accessed in order first to last, if you
;;; want to override an existing element, PREPEND it to the list.

(defvar file-header-extra-at-sign-special-cases nil
  "*List of additions to file-header-standard-at-sign-special-cases")

(defvar file-header-standard-at-sign-special-cases nil
  "*List of list of alternate representations of at sign (@) for
certain file header name types.")

(setq file-header-standard-at-sign-special-cases
      '(
        ("BibTeX"               " at ")
        ("C-Web"                "@@")
        ("Web"                  "@@")
        ("Web-change"           "@@")
        ))

(defvar file-header-extra-comment-prefixes nil
  "*List of additions to file-header-standard-comment-prefixes.")

(defvar file-header-standard-comment-prefixes nil
  "*List of lists of file header names and comment prefixes.")

(setq file-header-standard-comment-prefixes
      '(
        ("SGI-4D-Window-Manager-Initialization-file" "### ")
        ("Adobe-Font-Metric"    "Comment ")
        ("AmSTeX"               "%%% ")
        ("Awk"                  "### ")
        ("Basic"                "REM ")
        ("BibTeX"               "%%% ")
        ("BibTeX-style"         "%%% ")
        ("C"                    "")
        ("C++"                  "/// ")
        ("C-Locale"             "NOTE ")
        ("C-Web"                "%%% ")
        ("Digital-Standard-Runoff" ".!!! ")
        ("Emacs-Lisp"           ";;; ")
        ("Encapsulated-PostScript" "%%% ")
        ("Expect"               "### ")
        ("Font-Property-List"   "")
        ("Fortran"              "C====>")
        ("Fortran-90"           "!!! ")
        ("Ghostscript-font"     "%%% ")
        ("Gnuplot"              "### ")
        ("HTML"                 "--- ")
        ("Java"                 "/// ")
        ("LaTeX"                "%%% ")
        ("LaTeX-bibliography"   "%%% ")
        ("LaTeX-class"          "%%% ")
        ("LaTeX-class-option"   "%%% ")
        ("LaTeX-doc-source"     "%%% ")
        ("LaTeX-font-def"       "%%% ")
        ("LaTeX-style"          "%%% ")
        ("LaTeXinfo"            "\\comment ")
        ("Letter"               ";;; ")
        ("Lex"                  "")
        ("Lisp"                 ";;; ")
        ("M4"                   "### ")

        ;; using 4 `%' helps to avoid problems when
        ;; pretty-printing MF or MP sources with MFT
        ("METAFONT"             "%%%% ")
        ("MetaPost"             "%%%% ")

        ;; it's important to have 4 `%' for MFT files
        ;; since 3 `%' has a different meaning in MFT
        ("MFT"                  "%%%% ")

        ("MS-DOS-batch"         ":### ")
        ("MakeIndex-style"      "%%% ")
        ("Maple"                "### ")
        ("Matlab"               "%%% ")
        ("Mock-Lisp"            ";;; ")
        ("Modula-2"             "")
        ("Motif-Window-Manager-Initialization"          "### ")
        ("OpenLook-Window-Manager-Initialization"       "### ")
        ("Pascal"               "")
        ("Perl"                 "### ")
        ("PicTeX"               "%%% ")
        ("PostScript"           "%%% ")
        ("Prolog"               "/* ")
        ("Python"               "### ")
        ("Ratfor"               "### ")
        ("Reduce"               "%%% ")
        ("SFTRAN3"              "C$===>")
        ("SGML"                 "--- ")
        ("SLiTeX"               "%%% ")
        ("Scheme"               ";;; ")
        ("Scribe"               "@@@ ")
        ("STk"                  ";;; ")
        ("Tab-Window-Manager-Initialization"            "### ")
        ("Tcl"                  "### ")
        ("TeX"                  "%%% ")
        ("TeXinfo"              "@comment ")
        ("Teco"                 "")
        ("Text"                 "")
        ("Tib"                  "### ")
        ("Troff"                ".\\\" ")
        ("Troff-eqn"            ".\\\" ")
        ("Troff-grap"           ".\\\" ")
        ("Troff-man"            ".\\\" ")
        ("Troff-me"             ".\\\" ")
        ("Troff-mm"             ".\\\" ")
        ("Troff-ms"             ".\\\" ")
        ("Troff-pic"            ".\\\" ")
        ("Troff-refer"          ".\\\" ")
        ("Troff-tbl"            ".\\\" ")
        ("UNIX-sed"             "### ")
        ("UNIX-shell"           "### ")
        ("UNKNOWN"              "")
        ("VAX-VMS-shell"        "$ !!! ")
        ("Web"                  "%%% ")
        ("Web-change"           "%%% ")
        ("X-Bitmap"             "")
        ("X-Window-System-Defaults"            "!!! ")
        ("X-Window-System-Initialization"       "### ")
        ("Yacc"                 "")
        ))

(defvar file-header-extra-entries nil
  "*List of extra pairs of entry strings and functions to run to
insert them in the file header produced by make-file-header.  They
are always inserted AFTER the standard strings.")

(defvar file-header-standard-entries nil
  "*List of standard pairs of entry strings and functions to run to
insert them in the file header produced by make-file-header.")

(setq file-header-standard-entries
      '(
        ("author"       file-header-author)
        ("version"      file-header-version)
        ("date"         file-header-date)
        ("time"         file-header-time)
        ("filename"     file-header-filename)
        ("address"      file-header-address)
        ("telephone"    file-header-telephone)
        ("FAX"          file-header-FAX)
        ("URL"          file-header-URL)
        ("checksum"     file-header-checksum)
        ("email"        file-header-email)
        ("codetable"    file-header-codetable)
        ("keywords"     file-header-keywords)
        ("license"      file-header-license)
        ("supported"    file-header-supported)
        ("abstract"     file-header-abstract)
        ("docstring"    file-header-docstring)
        ))


(defvar file-header-extra-paired-comment-delimiter-languages nil
  "*List of additions to
file-header-standard-paired-comment-delimiter-languages.")

(defvar file-header-standard-paired-comment-delimiter-languages nil
  "*List of lists of language types that have paired comment
delimiters.  Each sublist consists of a string giving the language
name, a string for file-header-comment-block-begin to insert, and a
string for file-header-comment-block-end to insert.")

(setq file-header-standard-paired-comment-delimiter-languages
      '(
        ("C"
         (concat "/*"  (make-string 70 ?\*) "\n")
         (concat (make-string 70 ?\*) "*/\n"))

        ("Font-Property-List"
         (concat "(COMMENT "(make-string 63 ?\*) "\n")
         (concat (make-string 71 ?\*) ")\n"))

        ("HTML"
         (concat "<!-- " (make-string 67 ?\-) "\n")
         (concat (make-string 68 ?\-) " -->\n"))

        ("Lex"
         (concat " /*" (make-string 69 ?\*) "\n")
         (concat " " (make-string 69 ?\*) "*/\n"))

        ("Modula-2"
         (concat "(*"  (make-string 70 ?\*) "\n")
         (concat (make-string 70 ?\*) "*)\n"))

        ("Pascal"
         (concat "(*"  (make-string 70 ?\*) "\n")
         (concat (make-string 70 ?\*) "*)\n"))

        ("Scribe"
         "@Begin{Comment}\n"
         "@End{Comment}\n")

        ("SGML"
         (concat "<!-- " (make-string 67 ?\-) "\n")
         (concat (make-string 68 ?\-) " -->\n"))

        ("Teco"
         (concat "!*" (make-string 70 ?\*) "\n")
         (concat (make-string 71 ?\*) "!\n"))

        ("Yacc"
         (concat " /*" (make-string 69 ?\*) "\n")
         (concat " " (make-string 69 ?\*) "*/\n"))

        ))

(defvar file-header-extra-suffix-and-type nil
  "*List of additions to file-header-standard-suffix-and-type")

(defvar file-header-standard-suffix-and-type nil
  "*List of lists of file header extension suffixes (excluding the
leading dot), and the type names used in the file headers and
keys of other association lists.")

;;; I've included everything defined in GNU Emacs loaddefs.el for the
;;; auto-mode-alist variable, which associates file extensions with
;;; editing modes, plus several others.
;;;
;;; The list was further extended by extracting the unique file
;;; extensions from 209K files in a large Sun file system, and 25K files
;;; in a small IBM AIX file system.  This gave about 3500 unique
;;; extensions, which were then examined manually for other candidates.
;;;
;;; Please keep these entries in alphabetical order for editing
;;; convenience

(setq file-header-standard-suffix-and-type
      '(
        ("1"            "Troff-man")
        ("1l"           "Troff-man")
        ("2"            "Troff-man")
        ("2l"           "Troff-man")
        ("3"            "Troff-man")
        ("3l"           "Troff-man")
        ("4"            "Troff-man")
        ("4Dwmrc"       "SGI-4D-Window-Manager-Initialization-file")
        ("4l"           "Troff-man")
        ("5"            "Troff-man")
        ("5l"           "Troff-man")
        ("6"            "Troff-man")
        ("6l"           "Troff-man")
        ("7"            "Troff-man")
        ("7l"           "Troff-man")
        ("8"            "Troff-man")
        ("8l"           "Troff-man")
        ("afm"          "Adobe-Font-Metric")
        ("article"      "Text")
        ("atx"          "AmSTeX")
        ("awk"          "Awk")
        ("b"            "C")
        ("bas"          "Basic")
        ("bat"          "MS-DOS-batch")
        ("bbl"          "LaTeX-bibliography")
        ("bib"          "BibTeX")
        ("bit"          "C")
        ("bix"          "Digital-Standard-Runoff")
        ("brn"          "Digital-Standard-Runoff")
        ("bst"          "BibTeX-style")
        ("btc"          "Digital-Standard-Runoff")
        ("C"            "C++")
        ("c"            "C")
        ("c++"          "C++")
        ("CC"           "C++")
        ("cc"           "C++")
        ("cgi"          "Perl")
        ("ch"           "Web-change")
        ("clo"          "LaTeX-class-option")
        ("cls"          "LaTeX-class")
        ("com"          "VAX-VMS-shell")
        ("CPP"          "C++")
        ("cpp"          "C++")
        ("csh"          "UNIX-shell")
        ("cur"          "C")
        ("CXX"          "C++")
        ("cxx"          "C++")
        ("doc"          "Text")
        ("dtx"          "LaTeX-doc-source")
        ("el"           "Emacs-Lisp")
        ("emacs"        "Teco")
        ("eqn"          "Troff-eqn")
        ("eps"          "Encapsulated-PostScript")
        ("epsf"         "Encapsulated-PostScript")
        ("exp"          "Expect")
        ("f"            "Fortran")
        ("f77"          "Fortran")
        ("f90"          "Fortran-90")
        ("fd"           "LaTeX-font-def")
        ("flex"         "Lex")
        ("for"          "Fortran")
        ("ftn"          "Fortran")
        ("gnuplot"      "Gnuplot")
        ("grap"         "Troff-grap")
        ("gsf"          "Ghostscript-font")
        ("h"            "C")
        ("HTM"          "HTML")
        ("HTML"         "HTML")
        ("htm"          "HTML")
        ("html"         "HTML")
        ("hxx"          "C++")
        ("icn"          "C")
        ("icon"         "C")
        ("inc"          "Fortran")
        ("java"         "Java")
        ("l"            "Lex")
        ("latexinfo"    "LaTeXinfo")
        ("letter"       "Letter")
        ("lex"          "Lex")
        ("lisp"         "Lisp")
        ("lni"          "Digital-Standard-Runoff")
        ("loc"          "C-Locale")
        ("lsp"          "Lisp")
        ("ltr"          "LaTeX")
        ("ltx"          "LaTeX")
        ("m"            "Matlab")
        ("m2"           "Modula-2")
        ("m4"           "M4")
        ("man"          "Troff-man")
        ("maple"        "Maple")
        ("mat"          "Matlab")
        ("me"           "Troff-me")
        ("mec"          "Digital-Standard-Runoff")
        ("mem"          "Text")
        ("mex"          "Digital-Standard-Runoff")
        ("mf"           "METAFONT")
        ("mft"          "MFT")
        ("ml"           "Mock-Lisp")
        ("mm"           "Troff-mm")
        ("mp"           "MetaPost")
        ("ms"           "Troff-ms")
        ("mss"          "Scribe")
        ("mst"          "MakeIndex-style")
        ("mwmrc"        "Motif-Window-Manager-Initialization")
        ("n"            "Troff-man")
        ("olwmmenu"     "OpenLook-Window-Manager-Initialization")
        ("openwin-menu" "OpenLook-Window-Manager-Initialization")
        ("p"            "Pascal")
        ("pas"          "Pascal")
        ("perl"         "Perl")
        ("pic"          "Troff-pic")
        ("pictex"       "PicTeX")
        ("pl"           "Font-Property-List")
;;      ("pl"           "Prolog")       ;duplicate -- ignore
        ("prolog"       "Prolog")
        ("ps"           "PostScript")
        ("px"           "C")
        ("py"           "Python")
        ("r"            "Ratfor")
        ("red"          "Reduce")
        ("refer"        "Troff-refer")
        ("rno"          "Digital-Standard-Runoff")
        ("rnt"          "Digital-Standard-Runoff")
        ("rnx"          "Digital-Standard-Runoff")
        ("scm"          "Scheme")
        ("sed"          "UNIX-sed")
        ("sf3"          "SFTRAN3")
        ("sgm"          "SGML")
        ("SGM"          "SGML")
        ("SGML"         "SGML")
        ("sgml"         "SGML")
        ("sh"           "UNIX-shell")
        ("stk"          "STk")
        ("stx"          "SLiTeX")
        ("sty"          "LaTeX-style")
        ("tbl"          "Troff-tbl")
        ("tcl"          "Tcl")
        ("teco"         "Teco")
        ("tex"          "TeX")
        ("texi"         "TeXinfo")
        ("texinfo"      "TeXinfo")
        ("text"         "Text")
        ("tib"          "Tib")
        ("twmrc"        "Tab-Window-Manager-Initialization")
        ("txi"          "TeXinfo")
        ("vpl"          "Font-Property-List")
        ("w"            "C-Web")
        ("web"          "Web")
        ("Xdefaults"    "X-Window-System-Defaults")
        ("xinitrc"      "X-Window-System-Initialization")
        ("y"            "Yacc")
        ("yacc"         "Yacc")
        ))

(defvar file-header-timezone-string nil
 "Saved time zone string.  This is stored globally because getting the
time zone is a slow process under Emacs version 18 or earlier.  It
only needs to be computed once, because most computers don't change
time zones while they run.")

(setq internal-file-header-major-version nil)
(setq internal-file-header-minor-version nil)
(setq internal-file-header-prefix-version nil)

;=======================================================================

(defun make-file-header ()
  "Insert a standard file header comment at the start of the current
line.  The header fields are filled in with the author, date,
filename, and email address.  If the variable file-header-user-address
is defined, each line of its contents are inserted in the address
field as well.  The value returned by file-header-comment-start is
prefixed to each line.  The cursor is left positioned in the first
empty value string.

The key = value entries that are inserted are determined by the
contents of the lists file-header-standard-entries and
file-header-extra-entries, which contain pairs of \"KEY\" strings and
file-header-KEY functions to supply a value.

You can customize this function by defining suitable entries for
file-header-extra-entries."

  (interactive)

  (if (null (buffer-file-name))
      (error "You must have a buffer file name set to use make-file-header!"))

  (beginning-of-line)
  (save-excursion
    (file-header-comment-block-begin)
    (file-header-entry)
    (mapcar '(lambda (entry)
               (file-header-key (car entry) (nth 1 entry)))
            (append file-header-standard-entries file-header-extra-entries))
    (file-header-exit)
    (file-header-comment-block-end))
  (search-forward "\"\"")
  (backward-char 1))

(defun show-file-header-variables ()
  "Show the current settings of file-header-standard-xxx and
file-header-extra-xxx variables in a temporary buffer."
  (interactive)
  (let ((start))
    (with-output-to-temp-buffer "*File Header*"
      (set-buffer "*File Header*")

      (internal-show-file-header-alist
       "Standard File Header Suffix-Type Bindings"
       file-header-standard-suffix-and-type)

      (internal-show-file-header-alist "Extra File Header Suffix-Type Bindings"
                                       file-header-extra-suffix-and-type)

      (internal-show-file-header-alist "Standard Comment Prefixes"
                                       file-header-standard-comment-prefixes)

      (internal-show-file-header-alist "Extra Comment Prefixes"
                                       file-header-extra-comment-prefixes)

      (internal-show-file-header-alist
       "At Sign (@) Special Cases"
       file-header-standard-at-sign-special-cases))))

(defun test-file-header ()
  "Select a temporary buffer, and then run make-file-header on every
file extension defined in file-header-standard-suffix-and-type and
file-header-extra-suffix-and-type to test its correct execution.
Because this takes several seconds to run, each file name is displayed
in the echo area."
  (interactive)
  (create-file-buffer "*Test*")
  (set-buffer "*Test*")
  (let ((k)
        (suffix)
        (suffix-and-type (append file-header-standard-suffix-and-type
                                 file-header-extra-suffix-and-type)))
    (setq k 0)
    (while (nth k suffix-and-type)
      (set-visited-file-name
       (concat "foo."
               (nth 0 (nth k suffix-and-type))))
      (message "%s" (buffer-file-name))
      (goto-char (point-max))
      (insert "\f\n")
      (make-file-header)
      (setq k (1+ k))))
  (switch-to-buffer (buffer-name))
  (goto-char (point-min))
  (message "[Done]"))

(defun update-checksum ()
  "Trim trailing whitespace from all lines in the buffer, ensure that
the final line is terminated by a newline, remove all trailing blank
lines, then update the checksum line in the standard file header
generated by make-file-header, using the checksum program to compute
it.  The whitespace removal is important because some mail and file
systems may modify it, and no reasonable text file should ever depend
upon it."
  (interactive)
  (if (eq system-type 'vax-vms)         ;then VAX VMS
      (progn
        (message "Using simple wc-style checksum on VAX VMS")
        (update-simple-checksum))
    (save-restriction                   ;else on UNIX, use checksum program
      (widen)
      (goto-char (point-min))
      (replace-regexp "[ \t]+$" "")     ;blank trim lines before checksumming
      (goto-char (1- (point-max)))      ;make sure last character in the
      (if (not (looking-at "\n"))       ;buffer is a newline, and
          (progn                        ;supply one if necessary
            (forward-char 1)
            (insert "\n")))
      (goto-char (point-max))
      (delete-blank-lines)              ;remove trailing blank lines
      (goto-char (point-min))

      ;; We used to just do
      ;; (call-process-region (point-min) (point-max) "checksum" t t nil)
      ;; but that fails if the region is large, leaving us with an
      ;; empty buffer and lost text.  This bug (which is really a
      ;; deficiency in GNU Emacs, not an error in the filehdr.el code)
      ;; first showed up 11 months after filehdr.el was written.  It
      ;; was reported by David Carlisle
      ;; <carlisle@computer-science.manchester.ac.uk> on Thu, 29 Oct
      ;; 1992 11:21:31.  The author (NHFB) reproduced it on
      ;; 07-Nov-1992, and prepared this fix for it.
      ;;
      ;; Instead, we run checksum directly using temporary files, and
      ;; only if it is successful do we even replace the buffer.  In
      ;; order to create unique temporary file names, we include the
      ;; mm:ss part of the current hh:mm:ss time stamp in the file
      ;; name, keeping the filenames within the 14-character limit of
      ;; some older UNIX systems, in the form "/tmp/FLHDRmm:ss.xyz"
      ;;
      ;; A process id would be better than mm:ss, but Emacs' O/S
      ;; interface is deficient, and does not provide it.
      ;;
      ;; A random number would work here too; (concat (lsh (random t)
      ;; -8)) could be used in place of (substring
      ;; (current-time-string) 14 19).  However, that would change the
      ;; random number seed, which might interfere with other
      ;; functions that use it.
      ;;
      ;; NOTE: some systems (e.g. MS-DOS, OS/2, VMS) don't like a colon
      ;; half-way through the file specification.  Change the temporary
      ;; file spec to be in the form "$TMP/FHDRhhmmss.xyz", where $TMP
      ;; is determined from the environment variable TMP by the variable
      ;; file-header-temp-file-prefix.
      ;;
      (let* ((tmpname (concat file-header-temp-file-prefix
                "FHDR"
                (substring (current-time-string) 11 13)
                (substring (current-time-string) 14 16)
                (substring (current-time-string) 17 19)))
	     (oldname (concat tmpname ".old"))
	     (newname (concat tmpname ".new"))
             (result))
	(write-region (point-min) (point-max) oldname nil 0)
        (kill-buffer
         (get-buffer-create "*checksum*")) ;delete any current contents
        (setq result
              (call-process "checksum" nil (get-buffer-create "*checksum*")
                               nil oldname newname))
        (if (null result)
            (setq result 0))
	(if (= 0 result)
	    (progn
	      (delete-region (point-min) (point-max))
	      (insert-file newname)
	      (goto-char (point-min))
	      (re-search-forward "checksum[ \t]*=[ \t]*\"")
              (kill-buffer "*checksum*"))
	  (goto-char (point-min))
          (display-buffer "*checksum*"))
        (delete-file oldname)
        (delete-file newname)))))


(defun update-date ()
  "Update a file header to set the date to today, and the time to now.
The header is expected to contain lines like

%%      date            = \"29 May 1991\",
%%      time            = \"23:11:10 MST\",
%%      version         = \"1.06\",

and the body may optionally contain

\\date{29 May 1991 \\
Version 1.01}

If no time entry is found, it is inserted after the date line.  This
is to update old file headers that lacked a time entry.

Any leading comment prefix on the date line in the file header is
ignored.  The version number from the file header is used in the
optional \\date{} entry in the body.

An existing ISO-style numeric date like

%%%     date            = \"1995/02/01\",

is recognized, and the style is preserved during the update.  This
style will be chosen for initially empty dates if the user variable
file-header-ISO-date-style is non-nil.  The separator character may be
changed from a slash to something else by setting the user variable
file-header-ISO-date-separator.

A less common form

%%%     timestamp       = \"Sat Nov 14 12:42:07 1992\",

is also recognized and updated.  This form is never generated by
make-file-header."
  (interactive)
  (let ((major) (minor) (start))
    (goto-char (point-min))
    (if (re-search-forward
         "version[ \t]*=[ \t]*\"[0-9.]*\\([0-9]+\\)\\.\\([0-9]+\\)" nil t)
        (progn
          (setq major (string-to-int
                       (buffer-substring (match-beginning 1) (match-end 1))))
          (setq minor (string-to-int
                       (buffer-substring (match-beginning 2) (match-end 2))))))

    (goto-char (point-min))
    (if (re-search-forward "date[ \t]*=[ \t]*\"" nil t)
        (progn
	  (setq start (point))
	  (let ((ISO-date (or (and (looking-at "\",") file-header-ISO-date-style)
                              (looking-at "[12][0-9][0-9][0-9].[0-9][0-9].[0-9][0-9]"))))
	    (search-forward "\"")
	    (forward-char -1)
	    (delete-region start (point))
	    (if ISO-date
		(insert (file-header-ISO-date))
	    (insert (file-header-date))))))

    (goto-char (point-min))
    (if (re-search-forward "^[ \t]*\\\\date{" nil t)
        (progn
	  (setq start (point))
	  (search-forward "}")
	  (forward-char -1)
	  (delete-region start (point))
          (insert (file-header-date))
          (insert (format " \\\\\nVersion %d.%02d" major minor))))

    (goto-char (point-min))
    (if (re-search-forward "time[ \t]*=[ \t]*\"" nil t)
        (progn
	  (setq start (point))
	  (search-forward "\"")
	  (forward-char -1)
	  (delete-region start (point))
          (insert (file-header-time)))
      (progn                            ;else no time field found
        (goto-char (point-min))         ;so insert it after the date line
        (if (re-search-forward "date[ \t]*=[ \t]*\"" nil t)
            (progn
              (forward-line 1)
              (file-header-key "time" 'file-header-time)))))

    (goto-char (point-min))
    (if (re-search-forward "timestamp[ \t]*=[ \t]*\"" nil t)
        (progn
	  (setq start (point))
	  (search-forward "\"")
	  (forward-char -1)
	  (delete-region start (point))
          (insert (current-time-string))))))

(defun update-date-and-minor-version ()
  "Update a file header to set the date to today, the time to now, and
increment the version number.  The header is expected to contain lines like

%%      version         = \"1.06\",
%%      date            = \"29 May 1991\",
%%      time            = \"23:11:10 MST\",

and the body may optionally contain

\\date{29 May 1991 \\
Version 1.01}

Any leading comment prefix on the version and date lines in the file
header is ignored."
  (interactive)
  (update-minor-version)                ;first bump the minor version number
  (update-date))                        ;next set the date and time

(defun update-file-header-and-save ()
  "Update the date, increment the minor version, update the checksum,
and save the file.  Use this function after completing an edit on the
file.  With an argument, the minor version is left unchanged."
  (interactive)
  (if (null current-prefix-arg)
      (update-date-and-minor-version)
    (update-date))
  (update-license)
  (update-checksum)
  (save-buffer))

(defun update-license ()
  "Update a file header to include a license keyword and value,
inserted following the keywords list, but do nothing if a license is
already present."
  (interactive)
  (goto-char (point-min))
  (if (re-search-forward file-header-keywords-pattern nil t)
      (progn
        (search-forward "\",\n")
        (if (not (looking-at "^.*license *= *\""))
            (file-header-key "license" 'file-header-license)))))

(defun update-major-version ()
  "Update a file header to increment the major version number, and
reset the minor version to 0.  The header is expected to contain lines
like

%%      version         = \"\",
%%      version         = \"1\",
%%      version         = \"1.06\",
%%      version         = \"1.3.17\",
%%      version         = \"4.7.2.13\",

The major version number is the SECOND LAST number in the dotted list
of integers.  Any leading comment prefix on the version line in the
file header is ignored."
  (interactive)
  (goto-char (point-min))
  (if (re-search-forward file-header-version-pattern nil t)
      (let ( (data (match-data)) ;file-header-get-version-numbers destroys this
             (minor) )
        (goto-char (match-beginning 0))
        (file-header-get-version-numbers)
        (store-match-data data)
        (delete-region (match-beginning 1) (match-end 2))
        (backward-char 1)               ;position between ""
        (insert internal-file-header-prefix-version)
        (if (not (string-equal internal-file-header-prefix-version ""))
            (insert "."))
        (setq internal-file-header-minor-version "0")
        (insert (format "%d.%02d"
                        (1+ (string-to-int internal-file-header-major-version))
                        (string-to-int internal-file-header-minor-version))))))

(defun update-minor-version ()
  "Update a file header to increment the minor version number.  The
header is expected to contain lines like

%%      version         = \"\",
%%      version         = \"1\",
%%      version         = \"1.06\",
%%      version         = \"1.3.17\",
%%      version         = \"4.7.2.13\",

or

%%      version         = \"1a\",
%%      version         = \"1.06b\",
%%      version         = \"1.3.17d\",
%%      version         = \"4.7.2.13e\",

or

%%      version         = \"1.a\",
%%      version         = \"1.06.b\",
%%      version         = \"1.3.17.d\",
%%      version         = \"4.7.2.13.e\",

The minor version number is the LAST number in the dotted list of
integers.  Any leading comment prefix on the version line in the file
header is ignored."
  (interactive)
  (goto-char (point-min))
  (if (re-search-forward file-header-version-pattern nil t)
      (let ( (data (match-data))	;file-header-get-version-numbers destroys this
	     (letter) )
	;; (debug)
	(setq letter (buffer-substring (match-beginning 2) (match-end 2)))
        (goto-char (match-beginning 0))
        (file-header-get-version-numbers)
        (store-match-data data)
        (delete-region (match-beginning 1) (match-end 2))
        (backward-char 1)               ;position between ""
        (insert internal-file-header-prefix-version)
        (if (not (string-equal internal-file-header-prefix-version ""))
            (insert "."))
        (insert internal-file-header-major-version)
        (if (not (string-equal internal-file-header-major-version ""))
            (insert "."))
	(if (or (not (string-equal letter "")) file-header-minor-version-is-alphabetic)
	    (progn
	      ;; then have "1.2.3c" style
	      (if internal-file-header-minor-version
		  (insert
		   (format "%d" (string-to-int internal-file-header-minor-version))))
	      (cond
	       ((string-equal letter "")
		(insert "a"))
	       ((and (not (string-lessp letter "A"))
		     (string-lessp letter "Z"))
		(insert (1+ (string-to-char letter))))
	       ((and (not (string-lessp letter "a"))
		     (string-lessp letter "z"))
		(insert (1+ (string-to-char letter))))
	       (t
		(error "New version letter out of range A..Z or a..z"))))
	  ;; else have "1.2.3" style
	  (insert
	   (format (if (string-equal internal-file-header-major-version "")
		       "%d" "%02d")
		   (1+ (string-to-int internal-file-header-minor-version))))))))

(defun update-simple-checksum ()
  "Trim trailing whitespace from all lines in the buffer, then update
the checksum line in the standard file header generated by
make-file-header, using a simple UNIX wc-style checksum of counts of
lines, words, and characters.

The old checksum field is left as the first entry on the kill ring, so
you can get the text back if necessary.

Tab characters are NOT expanded to blanks, but if you want the
checksums to hold across e-mail transfers, it is wise to expand tabs
by M-x untabify, or the UNIX expand utility, if they do not otherwise
need to be present."
  (interactive)
  (save-restriction
    (widen)
    (goto-char (point-min))
    (replace-regexp "[ \t]+$" "")       ;blank trim lines before checksumming
    (goto-char (point-min))
    (if (re-search-forward " *checksum *= *\"\\([0-9 ]*\\)\"," nil t)
        (let ((start) (end) (words) (lines) (chars))
          (setq start (match-beginning 1))
          (setq end (match-end 1))
          (kill-region start end)
          (goto-char (point-min))
          (setq words (file-header-count-matches "[^ \t\n]+"))
          (goto-char (point-min))
          (setq lines (file-header-count-matches "\n"))
          (goto-char (point-min))
          (setq chars (+ (buffer-size) (length (format "%d" lines)) 8 8))
          (goto-char start)
          (insert (format "%d%8d%8d" lines (+ words 2) chars))))))

;;; ====================================================================
;;; The following functions are all private support functions for
;;; make-file-header and update-checksum.  The only ones that might
;;; require modification are file-header-comment-start and
;;; file-header-entry-name, which associate file extensions with header
;;; name strings.

(defun file-header-abstract ()
  "Return as a string the default abstract value."
  "")

(defun file-header-address ()
  "Return as a string the default address value."
  (if (boundp 'file-header-user-address)
      file-header-user-address          ;this variable holds the default, and
    ""))                                ;otherwise, we return an empty string

(defun file-header-at-sign ()
  "Return \"@\" or \" at \", according to the file extension.  BibTeX 0.99
croaks if there are @ signs anywhere except in valid BibTeX entries."
  (let ((e (file-header-entry-name)) (s))
    (setq s
          (eval (nth 1
                     (assoc e
                            (append
                             file-header-standard-at-sign-special-cases
                             file-header-extra-at-sign-special-cases)))))
    (if (null s) "@" s)))

(defun file-header-author ()
  "Return as a string the default author value."
  (user-full-name))

(defun file-header-checksum ()
  "Return as a string the default checksum value."
  "")

(defun file-header-codetable ()
  "Return as a string the default codetable value."
  "ISO/ASCII")

(defun file-header-comment-block-begin ()
  "Insert a comment block begin string for languages that lack a single
comment-from-here-to-end-of-line capability."
  (let ((e (file-header-entry-name)) (s))
    (setq s
          (eval
           (nth 1
                (assoc (file-header-entry-name)
                       (append
                        file-header-standard-paired-comment-delimiter-languages
                        file-header-extra-paired-comment-delimiter-languages)))))
    (if (not (null s))
        (insert s))))

(defun file-header-comment-block-end ()
  "Insert a comment block end string for languages that lack a single
comment-from-here-to-end-of-line capability."
  (let ((e (file-header-entry-name)) (s))
    (setq s
          (eval
           (nth 2
                (assoc (file-header-entry-name)
                       (append
                        file-header-standard-paired-comment-delimiter-languages
                        file-header-extra-paired-comment-delimiter-languages)))))
    (if (not (null s))
        (insert s))))


(defun file-header-comment-delimiter-line ()
  "Insert a comment delimiter line to sharpen the visibility of
the comments."
  (let ((e (file-header-entry-name)) (s))
    (setq s
          (eval
           (nth 1
                (assoc (file-header-entry-name)
                       (append
                        file-header-standard-paired-comment-delimiter-languages
                        file-header-extra-paired-comment-delimiter-languages)))))
    (if (null s)
        (progn
          (insert (file-header-comment-start))
          (insert-char ?\= (- 72 (current-column)))
          (insert "\n")))))

(defun file-header-comment-start ()
  "Return as a string a suitable comment start, chosen according
to the file extension, or if that is not determinable, from the
value of comment-start."

  ;; The returned string should normally have space following it,
  ;; and be a little more distinctive than a normal comment.
  ;; Usually replication of the comment starter is a reasonable
  ;; idea.  We follow Lisp conventions in using tripled comment
  ;; starters where possible.
  ;;
  ;; For languages like C and Pascal that require comment
  ;; terminators, or for languages where there is no real comment
  ;; start, return an empty string, since separate start and end
  ;; lines will be supplied elsewhere.

  (let ((entry-name (file-header-entry-name)) (s))
    (setq s (assoc entry-name
                   (append
                    file-header-standard-comment-prefixes
                    file-header-extra-comment-prefixes)))
    (if (null s)
        comment-start
      (nth 1 s))))

(defun file-header-count-matches (regexp)
  "Return number of matches for REGEXP following point."
  ;; Code borrowed from how-many in lisp/replace.el
  (interactive "sHow many matches for (regexp): ")
  (let ((count 0) opoint)
    (save-excursion
     (while (and (not (eobp))
                 (progn (setq opoint (point))
                        (re-search-forward regexp nil t)))
       (if (= opoint (point))
           (forward-char 1)
         (setq count (1+ count))))
     count)))

(defun file-header-date ()
  "Return as a string the default date value in the form \"23 January 1991\"."
  (let ((cts (current-time-string)))
    (concat
     (if (equal (substring cts 8 9) " ")
         "0"
       (substring cts 8 9))
     (substring cts 9 10)               ;get "dd"
     " "
     (nth 1 (assoc (substring cts 4 7)
                   file-header-month-abbrevs)) ;expand "mon" to full name
     " "
     (substring cts 20 24))))              ;get "yyyy"

(defun file-header-docstring ()
  "Return as a string the default docstring value."
  (if (eq system-type 'vax-vms)         ;on VAX VMS, get only simple checksum
                                        ;from update-checksum
      "The checksum field above contains the
standard UNIX wc (word count) utility
output of lines, words, and characters;
eventually, a better checksum scheme should
be developed."
                                        ;else on UNIX, get CRC-16 + wc style
                                        ;from update-checksum
    "The checksum field above contains a CRC-16
checksum as the first value, followed by the
equivalent of the standard UNIX wc (word
count) utility output of lines, words, and
characters.  This is produced by Robert
Solovay's checksum utility."))

(defun file-header-email ()
  "Return as a string the default email value."
  (or file-header-user-email
      (concat (user-login-name) (file-header-at-sign) (system-name)
              " (Internet)")))

(defun file-header-entry ()
  "Insert a file header entry line, choosing the entry name according to
the filename extension."
  (file-header-comment-delimiter-line)
  (insert (file-header-comment-start)
          " "
          (if (string-equal (file-header-at-sign) " at ")
              "" (file-header-at-sign))
          (file-header-entry-name)
          "-file{\n"))

(defun file-header-entry-name ()
  "Return a file header entry name, chosen according to the
file extension."
  (let ((ext (file-name-extension
              (file-name-sans-versions (buffer-file-name))))
        (s))
    (setq s (assoc ext
                   (append file-header-standard-suffix-and-type
                           file-header-extra-suffix-and-type)))
    (if (null s)
        "UNKNOWN"
      (nth 1 s))))

(defun file-header-exit ()
  "Insert a file header exit line."
  (insert (file-header-comment-start)
          " }\n")
  (file-header-comment-delimiter-line))

(defun file-header-FAX ()
  "Return as a string the default user FAX number."
  (if (boundp 'file-header-user-FAX)
      file-header-user-FAX              ;this variable holds the default, and
    ""))                                ;otherwise, we return an empty string

(defun file-header-filename ()
  "Return as a string the default filename value.  The directory
name is excluded since it is often dependent on the local installation."
  (file-name-nondirectory (buffer-file-name)))

(defun file-header-get-version-numbers ()
  "Search for a line of the form
          version = \"1.20.3.17\"
or
          version = \"1.20.3.17c\"
where there are zero or more dot-separated unsigned integers in the
value string, and possibly, a single final letter, and set global
variables internal-file-header-major-version and
internal-file-header-minor-version to the string values of the last
two numbers, and internal-file-header-prefix-version to the complete
prefix string.  Some of these may be empty strings.  The list of
numbers is returned as the function value, e.g. (\"1\" \"20\" \"3\"
\"17\") or (\"1\" \"20\" \"3\" \"17\" \"c\")."
  (if (re-search-forward file-header-version-pattern nil t)
      (let* ((the-list (file-header-number-list
			(buffer-substring (match-beginning 1) (match-end 1))))
	     (n (length the-list))
	     (k 0))
	(cond				;switch on the count of numbers found
	 ((= n 0)			;"" (empty string)
	  (setq internal-file-header-major-version "")
	  (setq internal-file-header-minor-version ""))
	 ((= n 1)			;"1"
	  (setq internal-file-header-major-version "")
	  (setq internal-file-header-minor-version (nth 0 the-list)))
	 ((= n 2)			;"1.2"
	  (setq internal-file-header-major-version (nth 0 the-list))
	  (setq internal-file-header-minor-version (nth 1 the-list)))
	 (t				;"1.2.3" or more
	  (setq internal-file-header-major-version (nth (- n 2) the-list))
	  (setq internal-file-header-minor-version (nth (- n 1) the-list))))

	(setq internal-file-header-prefix-version "") ;everything but last
                                        ;two numbers

	(while (< k (- n 2))
	  (setq internal-file-header-prefix-version
		(concat internal-file-header-prefix-version
			(if (string-equal
                             internal-file-header-prefix-version "")
			    "" ".")
			(nth k the-list)))
	  (setq k (1+ k)))
	the-list)))

(defun file-header-insert-multiline-string (value indent-column)
  "Insert a possibly multiline string, VALUE, providing a leading comment
string and blank padding to column INDENT-COLUMN."
  (let ( (k 0) )
    (while (< k (length value))
      (insert-char (aref value k) 1)
      (if (= (aref value k) ?\n)
          (progn
            (insert (file-header-comment-start))
            (insert (make-string (- indent-column (current-column)) ?\ ))))
      (setq k (1+ k)))))

(defun file-header-ISO-date ()
  "Return as a string the default date value in the form \"1991/01/23\"."
  (let ((cts (current-time-string)))
    (concat
     (substring cts 20 24)		;get "yyyy"
     (substring file-header-ISO-date-separator 0 1)
     (nth 1 (assoc (substring cts 4 7) file-header-month-numbers)) ;expand "mon" to "mm"
     (substring file-header-ISO-date-separator 0 1)
     (if (equal (substring cts 8 9) " ")
         "0"
       (substring cts 8 9))
     (substring cts 9 10))))		;get "dd"

(defun file-header-key (key value)
  "Insert a file header key = \"value\" line, using the constant
string KEY for the key name, and the function VALUE to get the value
string.  If the string contains newlines, additional comment starters
and indentation are supplied."
  (insert (file-header-comment-start)
          "    "
          key)          ;complete key insertion so current-column is up-to-date
  (insert (make-string
           (if (> (- 24 (current-column)) 0)
               (- 24 (current-column))
             1)
           ?\ )
          "= \"")
  (file-header-insert-multiline-string (funcall value) 27)
  (insert "\",\n"))

(defun file-header-keywords ()
  "Return as a string the default keywords value."
  "")

(defun file-header-license ()
  "Return as a string the default license value."
  "public domain")

(defun file-header-number-list (s)
  "Given a string S matching a series of unsigned integers separated
by dots, return a list of those integers."
  (let ((k 0) (n (length s)) (element nil) (number-list nil) (sk))
    (while (< k n)
      (setq sk (char-to-string (aref s k)))
      (cond
       ((string-match "[0-9]" sk)
	(setq element (concat element sk)))
       ((string-match "\\." sk)
	(setq number-list (append number-list (list element)))
	(setq element nil))
       (t
	(error "Bad version string [%s]" s)))
      (setq k (1+ k)))
    (setq number-list (append number-list (list element)))
    (if (equal number-list (list nil))
	(setq number-list nil))
    number-list))

(defun file-header-supported ()
  "Return as a string the default supported value."
  "yes"
  )

(defun file-header-telephone ()
  "Return as a string the default user telephone number."
  (if (boundp 'file-header-user-telephone)
      file-header-user-telephone        ;this variable holds the default, and
    ""))                                ;otherwise, we return an empty string

(defun file-header-time ()
  "Return as a string the current time."
  ;; current-time-string returns
  ;;    "Tue Feb  9 17:06:20 1988"
  ;;     0123456789.123456789.123
  (let ((timezone (file-header-timezone)))
    (concat (substring (current-time-string) 11 19)
            (if (string-equal timezone "")
                ""
              (concat " " timezone)))))

(defun file-header-timezone ()
  "Return as the string the local time zone abbreviation.  Until Emacs
version 19, this is not available from Emacs, so we have to invoke a
shell to get it, which is, alas, slow.  We save the result in a global
variable so we can return it rapidly on later calls."
  (cond
   ((not (null file-header-timezone-string))) ;do nothing if already set
   ((eq system-type 'vax-vms)           ;cannot get it on VAX VMS
    (setq file-header-timezone-string "")) ;no timezone available
   ((null file-header-timezone-string)  ;no saved timezone
    (if (fboundp 'current-time-zone)    ;then Emacs 19
        (setq file-header-timezone-string (nth 1 (current-time-zone)))
      (get-buffer-create "*timezone*")  ;else Emacs 18 or earlier
      (save-excursion
        (set-buffer "*timezone*")
        (delete-region (point-min) (point-max))
        (message "Getting time zone...this will take a few seconds")
        (sit-for 2)                     ;shell-command produces a Mark Set
                                        ;message that wipes out this one,
                                        ;so wait for it to be seen
        ;; (shell-command "date" t)	;this is too slow
        (call-process "date" nil t)     ;this is pretty fast
        ;; DECstation ULTRIX returns extra lines of garbage "Where are you?"
        ;; so delete all but last line (which has the date command output)
        (goto-char (point-max))
        (forward-line -1)
        (delete-region (point-min) (point))

        ;; UNIX date returns:
        ;; Wed Dec 11 14:32:18 MST 1991
        ;; 123456789.123456789.123456789
        (setq file-header-timezone-string (buffer-substring 21 24)))
      (kill-buffer "*timezone*")
      (message "Time zone saved"))))
  file-header-timezone-string)

(defun file-header-URL ()
  "Return as a string the default URL value.  If the variable
file-header-user-URL is not set, on UNIX, we assume that the
World-Wide Web host name for local host a.b.c.d is www.b.c.d, provided
that that name can be found in the file /etc/hosts."
  (let ((k) (www-name))
    (save-excursion
      (setq www-name (system-name))
      (if (file-exists-p "/etc/hosts")
	  (progn
	    ;; Reduce a.b.c.d to .b.c.d, and prefix www.
	    (setq k 0)
	    (while (< k (length www-name))
	      (progn
		(if (string-equal (substring www-name k (1+ k)) ".")
		    (progn
		      (setq www-name (concat "www" (substring www-name k)))
		      (setq k (length www-name)))) ;to force loop exit
		(setq k (1+ k))))
	    ;; Now see whether this name exists
	    (find-file "/etc/hosts")
	    (goto-char (point-min))
	    (if (not (search-forward www-name nil t))
		(setq www-name "???"))
	    (kill-buffer nil)))
      (or file-header-user-URL
	  (concat "http://" www-name "/~" (user-login-name))))))

(defun file-header-version ()
  "Return as a string the default version value."
  "")

(defun file-name-extension (filename)
  "Return the extension of FILENAME, minus the leading period (e.g.
the call (file-name-extension \"foo.bar\") returns \"bar\").  If there
is no extension, nil is returned."
  (let (n)
    (setq n (1- (length filename)))
    (>= n 0)
    (while (and (>= n 0) (not (= (aref filename n) ?.)))
        (setq n (1- n)))
    (if (< n 0)
        nil
      (substring filename (1+ n)))))

(defun internal-show-file-header-alist (the-title the-list)
  "Insert into the current buffer THE-TITLE followed by the entries of
THE-LIST, one per line, in sorted order."
  (insert-char ?\= (length the-title))
  (newline)
  (insert the-title "\n")
  (insert-char ?\= (length the-title))
  (newline)
  (let ((start (point)))
    (mapcar 'internal-show-file-header-entry the-list)
    (newline)
    (sort-lines nil start (point))
    (goto-char (point-max))
    (newline 2)))

(defun internal-show-file-header-entry (entry)
  "Insert an entry pair in the current buffer, where entry looks
like (\"extension\" \"class\")."
  (insert (format "%-39s\"%s\"\n" (car entry) (car (cdr entry)))))

;;; This is for GNU Emacs file-specific customization:
;;; Local Variables:
;;; indent-tabs-mode: nil
;;; End:
;;; filehdr.el ends here