diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /support/filehdr/filehdr.el |
Initial commit
Diffstat (limited to 'support/filehdr/filehdr.el')
-rw-r--r-- | support/filehdr/filehdr.el | 1733 |
1 files changed, 1733 insertions, 0 deletions
diff --git a/support/filehdr/filehdr.el b/support/filehdr/filehdr.el new file mode 100644 index 0000000000..75e4854fb8 --- /dev/null +++ b/support/filehdr/filehdr.el @@ -0,0 +1,1733 @@ +;;; ==================================================================== +;;; @Emacs-Lisp-file{ +;;; author = "Nelson H. F. Beebe", +;;; version = "1.28", +;;; date = "05 March 1996", +;;; time = "19:04:36 MST", +;;; filename = "filehdr.el", +;;; address = "Center for Scientific Computing +;;; Department of Mathematics +;;; University of Utah +;;; Salt Lake City, UT 84112 +;;; USA +;;; telephone = "+1 801 581 5254", +;;; FAX = "+1 801 581 4148", +;;; URL = "http://www.math.utah.edu/~beebe", +;;; checksum = "16197 1733 7127 68969", +;;; email = "beebe@solitude.math.utah.edu (Internet)", +;;; codetable = "ISO/ASCII", +;;; keywords = "checksum, file header", +;;; 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-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.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.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]") + +;;; 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 nil + "List of lists of pairs of month abbreviations and full names") + +(setq 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") + )) + +;;; ==================================================================== +;;; 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) + ("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. + +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]+\\)" 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)) + (search-forward "\"") + (forward-char -1) + (delete-region start (point)) + (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-checksum) + (save-buffer)) + +(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 "version[ \t]*=[ \t]*\"\\([0-9.]*\\)\"" 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 1)) + (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\", + +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 "version[ \t]*=[ \t]*\"\\([0-9.]*\\)\"" 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 1)) + (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 ".")) + (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\" +where there are zero or more dot-separated unsigned integers in the +value string, 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\")." + (if (re-search-forward + "version[ \t]*=[ \t]*\"\\([0-9.]*\\)\"" + 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-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-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 |