;;; ==================================================================== ;;; @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-filefilehdr.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" " <<>> ") ;;; )) ;;; ;;; (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 ;; 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 ;; 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 } ;; 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 ;; 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 ;; 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 " "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 "\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 "\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 ;; 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