[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
header2.el - creation and update of file headers
|
From: |
Drew Adams |
|
Subject: |
header2.el - creation and update of file headers |
|
Date: |
Tue, 16 Jan 2001 21:35:20 -0500 |
;;; header2.el --- Support for creation and update of file headers.
;;
;; Emacs Lisp Archive Entry
;; Filename: header2.el
;; Description: Support for creation and update of file headers.
;; Author: Lynn Slater
;; Drew Adams
;; Maintainer: D. ADAMS
;; Copyright (C) 1996-2001, Drew Adams, all rights reserved.
;; Copyright (C) 1989 Free Software Foundation, Inc.
;; Copyright (C) 1988 Lynn Randolph Slater, Jr.
;; Created: Tue Aug 4 17:06:46 1987
;; Version: $Id$
;; Last-Updated: Mon Jan 8 15:03:47 2001
;; By: dadams
;; Update #: 1001
;; Keywords: tools, docs, maint, abbrev, local
;; Compatibility: GNU Emacs 20.x
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Support for creation and update of file headers.
;;
;; This code and commentary was originally written by Lynn Slater,
;; 42075 Lawrence Place, Fremont Ca 94538 Office (415) 438-2048;
;; Home (415) 796-4149; Fax 438-2034. It has been modified by D. Adams.
;;
;; User Commands:
;; M-x make-header
;; M-x make-revision
;; M-x make-divider
;; M-x make-box-comment
;; Customizer commands
;; register-file-header-action
;; Customizer variables
;; header-copyright-notice
;; make-header-hooks
;;
;; This file is particularly useful with the file-declarations package
;; also by Lynn Slater. Read the first 20% of this file to learn how
;; to customize.
;;
;; From: eddie.mit.edu!think!ames!indetech.com!lrs (Lynn Slater)
;; To: address@hidden
;; Subject: Automatic header creation and maintenance
;; Date: Wed, 1 Nov 89 09:33 PST
;;
;; Enclosed is code to automatically create and maintain file headers.
;; This code is cleaner and mush more easily customized than any of my
;; previous header postings.
;;
;; New in this release are customizations that allow headers to be
;; created and maintained from the command line. This is good for
;; projects with some vi die-hards or when headers are being added in
;; mass for the first time.
;; Example:
;; cd $EMACS/lisp
;; headers -make *.el
;;
;; I have found file headers to be very valuable in project
;; development. I always know who has been where and how many times
;; they were there. Most often, I also know what they did. The update
;; count and last modified date are very useful in determining the
;; proper version of a file to use. I have often thought that it
;; would be easier to integrate patches from individuals to gnu tools
;; such as gcc and g++ if I knew for certain what version of a
;; particular file they were working from. If all had headers, I
;; would see the update count and date in the "diff -c" output and
;; would be able to find or recreate the file to patch accordingly.
;;
;; In this message are three files:
;; header2.el -- Emacs header functions and customization instructions
;; headers.1 -- Man page for command line headers useage
;; headers -- Shell script to hide the emacsness of command line headers.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;; Revision 1.11 1996/04/04 13:46:23 dadams
;;
;; Mods for modes like C, etc.
;; 1. make-header-hooks: Removed header-blank before: header-commentary,
;; header-history and header-code. Added 2 header-blank's after
;; header-commentary.
;; 2. Added section-comment-start.
;; 3. header-file-name: Only use header-prefix-string if 1-char comment-start.
;; 4. header-commentary,header-history,header-code: Use section-comment-start.
;; 5. header-code: Only add ":\n\n\n\n\n" if 1-char comment-start.
;; 6. header-eof: Removed extra " ".
;;
;; Revision 1.10 1996/03/18 14:55:47 dadams
;; 1. header-blank, header-author, header-creation-date, header-maintainer,
;; header-keywords, header-file-name, header-commentary, header-code,
;; header-eof, header-modification-author, header-modification-date,
;; header-update-count, header-status, header-toc, header-rcs-id,
;; header-rcs-log, header-sccs, header-AFS, header-shell, header-end-line,
;; delete-and-forget-line, update-last-modifier, update-last-modified-date,
;; uniquify-list: defun -> defsubst.
;; 2. Added defvars for return-to, explicit-shell-file-name, c-style (to quiet
;; byte compiler).
;; 3. Removed current-d-m-y-string to strings.el.
;;
;; Revision 1.9 1996/03/08 10:06:43 dadams
;; 1. Cleanup, doc strings. Require cl.el.
;; 2. uniqueify-list -> uniquify-list (rename).
;;
;; Revision 1.8 1996/02/12 09:54:33 dadams
;; 1. Updated header keywords (for finder).
;; 2. Added auto-make-header.
;;
;; Revision 1.7 1995/09/04 12:56:56 dadams
;; Adapted to std GNU maintenance form (see file lisp-mnt.el).
;; 1) Distinguished sections from subsections. Changed order.
;; 2) No longer use header-mode-line (conflicts with GNU maintenance std).
;; 3) Added header-eof, header-history-label.
;; 4) Removed header-purpose (use just header-commentary).
;; 5) Redefined: make-revision, header-file-name, header-history (HISTORY
;; -> Change log, header-rcs-id, header-sccs, header-copyright.
;;
;; Revision 1.6 1995/08/08 13:02:52 dadams
;; 1) Added header-maintainer, header-keywords, header-commentary, header-code.
;; 2) divisor -> divider.
;;
;; Revision 1.5 1995/08/02 09:09:23 dadams
;; 1) header-rcs -> header-rcs-id, header-rcs-log, and changed order.
;; 2) Removed RCS & SCCS stuff from header of this file.
;;
;; Revision 1.4 1995/07/31 10:20:17 dadams
;; Added: ;;;###autoload
;;
;; Revision 1.3 1995/07/31 09:41:48 dadams
;; 1. Added header-rcs to header. Removed header-history from header.
;; 2. Corrected SCCS & RCS strings (need to be uninstantiated here).\
;; 3. Added defvar for header-prefix-string (not really needed).
;; 4. Commented out stuff that needs Lynn Slater's command-line-hooks.
;;
;; Revision 1.2 1995/07/31 07:59:07 dadams
;; For emacs 19: removed postpend-unique-hook & drew-real-kill-buffer.
;;
;; Revision 1.1 1995/07/31 07:49:47 dadams
;; Initial revision
;;
;; 31-Jul-1995 D. ADAMS
;; Last modified: Fri Apr 28 15:36:59 1995 #296 (D. ADAMS)
;; For emacs 19: removed postpend-unique-hook & drew-real-kill-buffer.
;; 28-Apr-1995 D. ADAMS
;; Last modified: Fri Apr 28 08:38:18 1995 #294 (D. ADAMS)
;; 1) require drew-util: drew-real-kill-buffer
;; 2) touch-headers & make-headers:
;; find-file -> (set-buffer (find-file-noselect, and
;; kill-buffer -> drew-real-kill-buffer
;; 28-Apr-1995 D. ADAMS
;; Last modified: Fri Apr 28 08:36:18 1995 #293 (D. ADAMS)
;; Needed default for comment-start in make-revision.
;; Renamed to "header2" for compatibility within HP.
;; 11/11/89 -- Darryl Okahata, HP NMD (address@hidden)
;; 25-Sep-1989 Lynn Slater
;; Last Modified: Mon Sep 25 15:12:16 1989 #119 (Lynn Slater)
;; added -default-mode ahd headerable-file-p
;; 10-Sep-1989 Lynn Slater
;; Last Modified: Wed Sep 6 17:36:00 1989 #110 (Lynn Slater)
;; Seperated out header-mode-line and header-end. Headers are now really
;; easy to modify.
;; Added instructions for mode-specific headers.
;; 8-Aug-1989 Lynn Slater
;; Last Modified: Thu Aug 3 08:04:06 1989 #88 (Lynn Slater)
;; Changed structure to allow site/user customized headers
;; 24-Jun-1989 Lynn Slater
;; Last Modified: Thu Jun 22 12:52:24 1989 #84 (Lynn Slater)
;; restructured file, made the order of header actions not be significant.
;; 22-Jun-1989 Lynn Slater
;; Last Modified: Thu Jun 22 11:40:53 1989 #82 (Lynn Slater)
;; Made file header actions easier to declare
;; Made sccs and rcs support be user settable.
;; Added c-style support
;; 25-Jan-1989 Lynn Slater
;; Last Modified: Wed Jan 25 12:03:23 1989 #78 (Lynn Slater)
;; Added make-doc command
;; 25-Jan-1989 Lynn Slater
;; Last Modified: Tue Sep 6 07:57:22 1988 #77 (Lynn Slater)
;; made the make-revision command include the last-modified data
;; 31-Aug-1988 Lynn Slater
;; Made the make-revision work in most modes
;; Added the update-file-name command
;; 1-Mar-1988 Lynn Slater
;; made the headers be as sensitive as possible to the proper
;; comment chars.
;; 1-Mar-1988 Lynn Slater
;; Made the mode be declared in each header
;; 26-Feb-1988 Lynn Slater
;; added the make-revision call
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
(require 'cl) ;; when, unless
(eval-and-compile '(require 'strings nil t)) ;; (no error if not found):
;; current-d-m-y-string,
non-empty-name-p
(provide 'header2)
(require 'header2) ; Ensure loaded before compile.
;;;;;;;;;;;;;;;;;;;;;;
;; This file has two major divisions: header creation and header maintenance.
;; User/Site Customizable Variables
;; --------------------------------
(defvar header-max 2000
"*Number of chars to search at start of buffers for header to update.")
(put 'header-max 'variable-interactive "nMax number of chars in headers: ")
(defvar header-copyright-notice nil
"*Copyright notice to be inserted into file headers.")
(defvar make-header-hooks '(
;;;;;header-mode-line
header-title
header-blank
header-file-name
header-description
;;header-status
header-author
header-maintainer
header-copyright
header-creation-date
header-rcs-id
;;header-sccs
header-modification-date
header-modification-author
header-update-count
header-keywords
header-compatibility
header-blank
header-end-line
header-commentary
header-blank
header-blank
header-blank
header-end-line
header-history
header-blank
header-rcs-log
header-blank
header-end-line
header-code
header-end-line
header-eof
)
"A list of functions which will insert the various header elements.
Each function is started on a new line and is expected to end in a new line.
Each function may insert any number of lines, but each line, including the
first, must be started with the value of `header-prefix-string'.
\(This variable holds the same value as would be returned by calling
`header-prefix-string' but is faster to access.) Each function may set the
following global variables:
`header-prefix-string' -- mode specific comment sequence
`return-to' -- character position to which point will be moved after header
functions are processed. Any header function may set this,
but only the last setting will take effect.
It is reasonable to locally set these hooks according to certain modes.
For example, a table of contents might only apply to code development modes
and `header-shell' might only apply to shell scripts. See instructions in
file `header2.el' to do this.")
;; Mode-specific headers:
;; ---------------------
;; Not all headers need look alike. Suppose that you have a unix script mode
;; and want it to have a shell specifier line that all other headers do not
;; have. To do this, Place the following lines in a hook called when the
;; mode is invoked or in the code that establishes the mode:
;; (make-local-variable 'make-header-hooks)
;; (setq make-header-hooks (cons 'header-shell
;; (default-value 'make-header-hooks)))
;;
;; The header building blocks are sensitive to the different comment
;; characters in different modes.
;;
;; Mode specific update actions:
;; ----------------------------
;; Suppose something needs to be automatically maintained only in certain
;; modes. An example is the .TH macro in man pages. You can create mode-
;; specific update actions by placing lines such as the following in the mode
;; creation function of the mode hook.
;; (make-local-variable 'file-header-update-alist)
;; (register-file-header-action
;; "^\.TH[ \t]+[^\" \t]+[ \t]+[^\" \t]+[ \t]+\"\\([^\"]*\\)\""
; "
;; 'update-last-modified-date-macro)
;; Define individual header elements. These are the building blocks
;; used to construct a site specific header. You may add your own
;; functions either in this file or in your `.emacs' file. The
;; variable `make-header-hooks' specifies the functions that will
;; actually be called.
;; ------------------------------------------------------------------
(defsubst header-blank ()
"Insert an empty comment to file header (after `header-prefix-string')."
(insert header-prefix-string "\n"))
;; Major section headings
(defvar return-to nil
"Position to move point to after header fns are processed.
Any header function may set this. The last setting will take effect.")
;; Comment start of major section headings
(defsubst section-comment-start ()
(if (= (length comment-start) 1) ; e.g. Lisp: ";; \n;;;"
(concat header-prefix-string "\n" comment-start header-prefix-string)
(concat "\n" comment-start))) ; e.g. C: "\n/*"
(defsubst header-title ()
"Insert buffer's file name and leave room for a description.
In `emacs-lisp-mode', this should produce the title line for library
packages."
(insert (concat comment-start (and (= 1 (length comment-start))
header-prefix-string)
(buffer-name) " --- " "\n"))
(setq return-to (1- (point))))
(defsubst header-file-name ()
"Insert \"Filename: \" line, using buffer's file name."
(insert header-prefix-string "Filename: " (buffer-name) "\n"))
(defsubst header-description ()
"Insert \"Description: \" line."
(insert header-prefix-string "Description: \n"))
(defsubst header-author ()
"Insert current user's name (`user-full-name') as this file's author."
(insert header-prefix-string "Author: " (user-full-name) "\n"))
(defsubst header-maintainer ()
"Insert \"Maintainer: \" line."
(insert header-prefix-string "Maintainer: \n"))
(defun header-copyright ()
"Insert `header-copyright-notice', unless nil."
(when header-copyright-notice
(let ((start (point)))
(insert header-copyright-notice)
(save-restriction
(narrow-to-region start (point))
(goto-char (point-min))
;; Must now insert header prefix. Cannot just replace string,
;; because that would cause too many undo boundries.
(insert header-prefix-string)
(while (progn (skip-chars-forward "^\n") (looking-at "\n"))
(forward-char 1) (unless (eolp) (insert header-prefix-string)))
(goto-char (point-max))))))
(defsubst header-creation-date ()
"Insert today's date (`current-time-string') as file creation date."
(insert header-prefix-string "Created: " (current-time-string) "\n"))
(defsubst header-rcs-id ()
"Insert lines to record RCS id information (\"$Id$\n\")."
(insert header-prefix-string "Version: $Id$\n"))
(defsubst header-sccs ()
"Insert a line to record SCCS version information."
(insert header-prefix-string "Version: %W% %E% %U%\n"))
(defsubst header-commentary ()
"Insert \"Commentary: \" line."
(insert (concat (section-comment-start) "Commentary: \n")))
(defsubst header-history ()
"Insert `header-history-label' into header for use by `make-revision'.
Without this, `make-revision' inserts `header-history-label' after the header."
(insert (concat (section-comment-start) header-history-label "\n")))
(defvar header-history-label "Change log:") ; Was "HISTORY:" before.
(defsubst header-code ()
"Insert \"Code: \" line."
(insert (concat (section-comment-start) "Code"
(and (= 1 (length comment-start)) ":\n\n\n\n\n"))))
(defsubst header-eof ()
"Insert comment indicating end of file."
(when (eq major-mode 'emacs-lisp-mode)
(insert (concat comment-start header-prefix-string "`"
(buffer-name) "' ends here\n"))))
(defsubst header-modification-date ()
"Insert todays date as the time of last modification.
This is normally overwritten with each file save."
(insert header-prefix-string "Last-Updated: \n"))
(defsubst header-modification-author ()
"Insert current user's name as the last person who modified the file.
This is normally overwritten with each file save."
(insert header-prefix-string " By: \n"))
(defsubst header-update-count ()
"Insert a count of the number of times the file has been saved."
(insert header-prefix-string " Update #: 0\n"))
(defsubst header-keywords ()
"Insert \"Keywords: \" line."
(insert header-prefix-string "Keywords: \n"))
(defsubst header-compatibility ()
"Insert a \"Compatibility: \" line."
(insert header-prefix-string "Compatibility: \n"))
(defsubst header-status ()
"Insert a \"Status: \" line."
(insert header-prefix-string "Status: \n"))
(defsubst header-toc ()
"Insert a \"Table of Contents: \" line."
(insert header-prefix-string "Table of Contents: \n" header-prefix-string
"\n"))
(defsubst header-rcs-log ()
"Insert lines to record RCS log information (\"$Log$\n\")."
(insert header-prefix-string "RCS $Log$\n"))
(defsubst header-AFS ()
"Insert a line to record SHAPE information."
(insert header-prefix-string "AFSID: $__Header$\n"))
;; Just to quiet the byte compiler. Defined in `shell.el' or `terminal.el'.
(defvar explicit-shell-file-name)
(defsubst header-shell ()
"Insert a kernal shell specifier line.
Uses the same shell named in `explicit-shell-file-name', the ESHELL
environment variable, the SHELL environment variable, or
'/bin/sh'. (This is the same shell that the shell command uses.)"
(insert "#!" (or (and (boundp 'explicit-shell-file-name)
explicit-shell-file-name)
(getenv "ESHELL")
(getenv "SHELL")
"/bin/sh")
"\n"))
;; To quiet the byte compiler. Undefined here.
(defvar c-style)
;; Variable `comment-start-p' is free here. It's bound in `make-header'.
(defun header-mode-line ()
"Insert a \" -*- Mode: \" line."
(let* ((mode-declaration
(concat " -*- Mode: " (true-mode-name)
(if (assoc 'c-style (buffer-local-variables))
(concat "; C-Style: " (symbol-name c-style))
"")
" -*- "))
(md-length (length mode-declaration)))
(insert (cond ((and comment-start (= 1 (length comment-start)))
;; Assume comment start char is also fill char.
(concat comment-start comment-start
(make-string (/ (- 77 md-length) 2)
(aref comment-start 0))
mode-declaration
(make-string (/ (- 78 md-length) 2)
(aref comment-start 0))))
(comment-start-p ; Assume spaces fill the gaps.
(concat comment-start
(make-string (/ (- 79 md-length
(length comment-start)) 2)
?\ )
mode-declaration))
(t ; No comment-start. Assume Lisp.
(concat ";;" (make-string (/ (- 77 md-length) 2) ?\;)
mode-declaration
(make-string (/ (- 78 md-length) 2) ?\;))))
"\n")))
;; Variables `comment-start-p' and `comment-end-p' are free here.
;; They are both bound in `make-header'.
;; `comment-end-p' is also bound in `header-prefix-string'.
(defsubst header-end-line ()
"Insert a divider line."
(insert (cond (comment-end-p comment-end)
((and comment-start (= 1 (length comment-start)))
(make-string 70 (aref comment-start 0)))
(comment-start-p comment-start)
(t (make-string 70 ?\;)))
"\n"))
;; System Variables -- Do not modify. Instead, call the functions that modify.
;; --------------------------------------------------------------------------
(defvar file-header-update-alist ()
"Used by `update-file-header' to know what to do in a file.
Is a list of sets of cons cells where the car is a regexp string and the cdr is
the function to call if the string is found near the start of the file.")
;; User function to declare header actions on a save file.
;; See examples at the end of this file.
;; Invoke from `site-init.el' or in `.emacs'.
;; -------------------------------------------------------
(defun register-file-header-action (regexp function-to-call)
"Record FUNCTION-TO-CALL as the appropiate action to take if REGEXP is
found in the file header when a file is written. The function will be called
with the cursor located just after the matched REGEXP. Calling this twice
with the same args overwrites the previous FUNCTION-TO-CALL."
(let ((ml (assoc regexp file-header-update-alist)))
(if ml
(setcdr ml function-to-call);; overwrite old defn
;; This entry is new to us. Add to the master alist
(setq file-header-update-alist (cons (cons regexp function-to-call)
file-header-update-alist)))))
;; Register the automatic actions to take for file headers during a save
;; See the second part of the file for explinations.
;; ---------------------------------------------------------------------
;;(register-file-header-action "^.* *\\(.*\\) *\\-\\-" 'update-file-name)
(register-file-header-action "Last-Updated[ \t]*: "
'update-last-modified-date)
(register-file-header-action " By[ \t]*: "
'update-last-modifier)
(register-file-header-action " Update #[ \t]*: " 'update-write-count)
;; Header and file division header creation code
;; ---------------------------------------------
(defun true-mode-name ()
"Return name of mode in a form such that mode may be re-established
by calling the function named by appending \"-name\" to this string.
This differs from variable `mode-name' in that this is guaranteed to
work even when the value has embedded spaces or other junk."
(let ((major-mode-name (symbol-name major-mode)))
(capitalize (substring major-mode-name 0
(or (string-match "-mode" major-mode-name)
(length major-mode-name))))))
(defvar header-prefix-string ""
"Mode-specific comment prefix string for use in headers.")
(defun header-prefix-string ()
"Returns a mode-specific prefix string for use in headers.
Is sensitive to language-dependent comment conventions."
(let ((comment-end-p (and comment-end
(not (string-equal comment-end "")))))
(cond
((and comment-start (= 1 (length comment-start)))
(concat comment-start comment-start " "))
;; Special case, three letter comment starts where the first and
;; second letters are the same. (i.e. c++ and ada)
((and comment-start (= 3 (length comment-start))
(equal (aref comment-start 1) (aref comment-start 0)))
comment-start)
;; Other three-letter comment starts -> grab the middle character
((and comment-start (= 3 (length comment-start)))
(concat " " (list (aref comment-start 1)) " "))
((and comment-start (not comment-end-p))
;; Note: no comment end implies that the full comment start must be
;; used on each line.
comment-start)
(t ";; ")))) ; Use Lisp as default.
;; Usable as a programming language mode hook.
;;;###autoload
(defun auto-make-header ()
"Calls `make-header' if current buffer is empty."
(and (zerop (buffer-size)) (make-header)))
;;;###autoload
(defun make-header ()
"Insert (mode-dependent) header comment at beginning of file.
A header is composed of a mode line, a body, and an end line. The body is
constructed by calling the functions in `make-header-hooks'. The mode line
and end lines start and terminate block comments. The body lines continue
the comment. "
(interactive)
(beginning-of-buffer) ; Leave mark at old location.
(let ((return-to nil) ; To be set by `make-header-hooks'.
(header-prefix-string (header-prefix-string)) ; Cache result.
(comment-start-p (and comment-start (not (string= "" comment-start))))
(comment-end-p (and comment-end (not (string= "" comment-end)))))
(mapcar (function funcall) make-header-hooks)
(when return-to (goto-char return-to))))
;;;###autoload
(defun make-revision ()
"Prepare for a new history revision. Insert history line if inexistant."
(interactive)
(setq comment-start (or comment-start ";")) ; Use Lisp comment as default.
(let ((header-prefix-string (header-prefix-string))
(logical-comment-start
(if (= 1 (length comment-start))
(concat comment-start comment-start " ")
comment-start)))
;; Look for the history line
(beginning-of-buffer) ; Leave a mark behind.
(if (re-search-forward (concat "^\\(" (and comment-start
(regexp-quote comment-start))
(regexp-quote (header-prefix-string)) "\\|"
(if (and comment-start
(not (string= "" comment-start)))
(concat "\\|"
(regexp-quote comment-start))
"")
"\\)" " *\\(" header-history-label
"\\|HISTORY\\)") ; Backward compatibility.
header-max t)
(end-of-line)
;; We did not find a history line, add one
(goto-char (point-min))
;; find the first line that is not part of the header
(while (and (< (point) header-max)
(looking-at
(concat "[ \t]*\\("
(regexp-quote (header-prefix-string))
(if (and comment-start
(not (string= "" comment-start)))
(concat "\\|" (regexp-quote comment-start))
"")
(if (and comment-end (not (string= "" comment-end)))
(concat "\\|" (regexp-quote comment-end))
"")
"\\)")))
(forward-line 1))
(insert "\n" logical-comment-start header-history-label)
(save-excursion (insert "\n" comment-end)))
;; We are now on the line with the header-history-label label
(insert "\n" header-prefix-string (if (fboundp 'current-d-m-y-string)
(current-d-m-y-string)
"")
" " (user-full-name)
;;" |>Ident<|\n"
" \n" header-prefix-string " ")
;; Add details about the history of the file before its modification
(when (save-excursion
(re-search-backward "Last-Updated[ \t]*: \\(.+\\)$" nil t))
(insert "Last-Updated: " (buffer-substring (match-beginning 1)
(match-end 1)))
(if (save-excursion
(re-search-backward " Update #[ \t]*: \\([0-9]+\\)$" nil t))
(insert " #" (buffer-substring (match-beginning 1) (match-end 1))))
(if (save-excursion
(re-search-backward " By[ \t]*: \\(.+\\)$" nil t))
(insert " (" (buffer-substring (match-beginning 1) (match-end 1))
")"))
(insert "\n" header-prefix-string " "))))
;;;###autoload
(defun make-divider (&optional end-col)
"Insert a comment divider line: the comment start, filler, and end."
(interactive)
(insert comment-start)
(when (= 1 (length comment-start)) (insert comment-start))
(insert (make-string (max 2 (- (or end-col (- fill-column 2))
(length comment-end) 2 (current-column)))
(aref comment-start
(if (= 1 (length comment-start)) 0 1))))
(insert (concat comment-end "\n")))
;;;###autoload
(defun make-box-comment (&optional end-col)
"Insert an empty (mode dependent) box comment."
(interactive)
(unless (= 0 (current-column)) (forward-line 1))
(insert comment-start)
(when (= 1 (length comment-start)) (insert comment-start))
(unless (char-equal (preceding-char) ? ) (insert ? ))
(insert (make-string (max 2 (- (or end-col fill-column ) (length comment-end)
2 (current-column)))
(aref comment-start
(if (= 1 (length comment-start)) 0 1))))
(insert "\n" (header-prefix-string) )
(save-excursion
(insert "\n" (header-prefix-string)
(make-string (max 2 (- (or end-col fill-column)
(length comment-end) 2 (current-column)))
(aref comment-start
(if (= 1 (length comment-start)) 0 1)))
comment-end "\n")))
;; Automatic Header update code
;; ----------------------------
;;;###autoload
(defun update-file-header ()
"Update file header.
If file has been modified, search the first `header-max' chars in buffer
using regexps in `file-header-update-alist'. When a match is found, apply
the corresponding function with point located just after the match.
The functions can use `match-beginning' and `match-end' to find the
strings that cause them to be invoked."
(interactive)
(and (> (buffer-size) 100)
(buffer-modified-p)
(not buffer-read-only)
(save-excursion
(save-restriction ; Only search `header-max' chars.
(narrow-to-region 1 (min header-max (1- (buffer-size))))
(let ((patterns file-header-update-alist))
;; Do not record this call as a command in command history.
(setq last-command nil)
(while patterns
(goto-char (point-min))
(when (re-search-forward (car (car patterns)) nil t)
;; Position cursor at end of match.
(goto-char (match-end 0))
;;(message "do %s" (car patterns)) (sit-for 1)
(funcall (cdr (car patterns))))
(setq patterns (cdr patterns))))))
nil))
;; Place the header update function as a write file action
(add-hook 'write-file-hooks 'update-file-header)
;; Define individual file header actions. These are the building
;; blocks of automatic header maintenance.
;; -----------------------------------------------------------------------
(defsubst delete-and-forget-line ()
;; does not place the line in the kill-ring
(let* ((start (point))
(stop (progn (end-of-line) (point)))
(str (buffer-substring start stop)))
(delete-region start stop)
str))
(defun update-write-count ()
(let ((num)
(str (delete-and-forget-line)))
(setq num (car (read-from-string str)))
(if (numberp num)
(insert (format "%s" (1+ num)))
(insert str)
(error "Invalid number for update count `%s'." str))))
(defsubst update-last-modifier ()
(delete-and-forget-line)
(insert (format "%s"
(let ((ufn (user-full-name)))
(if (non-empty-name-p ufn)
ufn
(user-login-name))))))
(defsubst update-last-modified-date ()
(delete-and-forget-line)
(insert (format "%s" (current-time-string))))
(defun update-file-name ()
(beginning-of-line)
;; Verify looking at a file name for this mode.
(when (looking-at
(concat (regexp-quote (header-prefix-string)) " *\\(.*\\) *\\-\\-"))
(goto-char (match-beginning 1))
(delete-region (match-beginning 1) (match-end 1))
(insert (file-name-nondirectory (buffer-file-name)) " -")))
;;(setq file-header-update-alist nil)
;;(setq file-header-update-alist (cdr file-header-update-alist))
;; Stand-alone Headers
;; These functions give the ability to invoke headers from the command line.
;; E.g Can use with `vi' instead of emacs.
;; -------------------------------------------------------------------------
(defun headerable-file-p (file)
(not (if (not (file-exists-p file))
(message "File \"%s\" does not exist." file)
(if (file-symlink-p file)
(message "\"%s\" is a symbolic link." file)
(if (file-directory-p file)
(message "\"%s\" is a directory." file))))))
(defsubst uniquify-list (list)
(let ((rest list))
(while rest
(setcdr rest (delq (car rest) (cdr rest)))
(setq rest (cdr rest)))
list))
;;(headerable-file-p "AFS")
;;(headerable-file-p "dbiogen.el")
;;(headerable-file-p "dbiogen.elc")
(defvar header-required-mode nil
"The mode we force files to be in, regardless of file suffix.")
;;; Rest commented out -- Needs Lynn Slater's
;;; customizations to startup.el to allow command-line-hooks.
;;
;;
;; Define a touch-headers command. This depends upon Lynn Slater's
;; customizations to startup.el to allow command-line-hooks.
;; ---------------------------------------------------------------
;;;(setq command-line-hooks (cons 'touch-headers command-line-hooks))
;(defun touch-headers ()
; (if (or (string= argi "-touch") (string= argi "-touch-headers"))
; (let ((trim-versions-without-asking t)
; (executing-macro "true"));; suppress "Mark Set" messages
; ;; Consume all following arguments until one starts with a "-"
; (while (and command-line-args-left
; (not (char-equal ?- (aref (car command-line-args-left)
0))))
; (if (headerable-file-p (car command-line-args-left))
; (progn
; (set-buffer (find-file-noselect (car command-line-args-left)))
; (make-revision)
; (write-file nil)
; (kill-buffer (current-buffer))))
; (setq command-line-args-left (cdr command-line-args-left))))))
;; Define a make-headers command line option.
;; ------------------------------------------
;;;(setq command-line-hooks (cons 'make-headers command-line-hooks))
;(defun make-headers ()
; (if (or (string= argi "-make-headers") (string= argi "-make"))
; (let ((trim-versions-without-asking t)
; (executing-macro "true"));; suppress "Mark Set" messages
; ;; Consume all following arguments until one starts with a "-"
; (while (and command-line-args-left
; (not (char-equal ?- (aref (car command-line-args-left)
0))))
; (if (headerable-file-p (car command-line-args-left))
; (progn
; (set-buffer (find-file-noselect (car command-line-args-left)))
; (if header-required-mode
; (funcall header-required-mode))
; (make-header)
; (write-file nil)
; (message " Mode was %s" major-mode)
; (kill-buffer (current-buffer))))
; (setq command-line-args-left (cdr command-line-args-left))))))
;; Define a -default-mode command line option.
;; -------------------------------------------
;;;(setq command-line-hooks (cons 'set-header-mode command-line-hooks))
;(defun set-header-mode ()
; (if (or (string= argi "-default-mode")
; (string= argi "-default"))
; (let ((trim-versions-without-asking t)
; (executing-macro "true");; suppress "Mark Set" messages
; (mode (intern (car command-line-args-left))))
; (if (memq mode (mapcar 'cdr auto-mode-alist))
; (progn
; (setq default-major-mode mode)
; (message "Default mode is %s" default-major-mode)
; (setq command-line-args-left (cdr command-line-args-left)))
; (message "Mode \"%s\" is invalid. Try one of %s" mode
; (uniquify-list (mapcar 'cdr auto-mode-alist)))
; (kill-emacs 1)))))
;; Define a -required-mode command line option.
;; --------------------------------------------
;;;(setq command-line-hooks (cons 'set-header-required-mode command-line-hooks))
;(defun set-header-required-mode ()
; (if (or (string= argi "-required-mode")
; (string= argi "-mode"))
; (let ((trim-versions-without-asking t)
; (executing-macro "true");; suppress "Mark Set" messages
; (mode (intern (car command-line-args-left))))
; (if (memq mode (mapcar 'cdr auto-mode-alist))
; (progn
; (setq header-required-mode mode)
; (message "Required mode is %s" header-required-mode)
; (setq command-line-args-left (cdr command-line-args-left)))
; (message "Mode \"%s\" is invalid. Try one of %s" mode
; (uniquify-list (mapcar 'cdr auto-mode-alist)))
; (kill-emacs 1)))))
;; Things in the works or still to do.
;;------------------------------------
;; effort.el -- allows an "effort" to be resgistered in the mode line much
;; like the mode is. The effort then determines some header characteristics
;; such as copyright. Typical efforts would be 'gdb 'gcc, 'g++, 'emacs, etc.
;; This would let the copyright (and c-style) be adjusted even within
;; common modes.
;;
;; need ez access to values in the header
;; need a headerp fcn
;;
;; auto make-revision if current user is not same as last modifier
;; this would give a history of who touched what.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; `header2.el' ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- header2.el - creation and update of file headers,
Drew Adams <=