gh@bdblues.inria.fr (gilbert harrus) (12/16/88)
Below is a small elisp package for editing history messages. More infos can
be found after the copyleft.
Enjoy whist!
Gilbert Harrus
Gip-Altair/INRIA gh@bdblues.altair.fr
Domaine de Voluceau ...!mcvax!inria!bdblues!gh
BP105 Rocquencourt
78153 Le Chesnay Cedex phone: (33)-(1)-39-63-54-63
France
<----------------------------cut here------------------------------>
;; edition of modification history : whist
;; Copyright (C) 1988 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY. No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing. Refer to the GNU Emacs General Public
;; License for full details.
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License. A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities. It should be in a
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; This file provides a 'whist' function for editing history
;;; messages. It is derived from an Gossling-emacs implementation
;;; of the same function. I just translated it to elisp, and
;;; rewrote some parts.
;;; If you find an improvement, please send it to me.
;;; If you find a bug, please report it to me (along with the fix...).
;;;
;;; December 1988, Gilbert Harrus (gh@bdblues.altair.fr).
;;;
;;; Installation
;;;
;;; 1- Change the default value of whist-site to the appropriate value.
;;;
;;; 2- Put the file whist.el in the standard emacs-lisp directory
;;;
;;; 3- Add this line to your .emacs
;;; (autoload 'whist "whist.el" "" t)
;;;
;;; Man
;;;
;;; Just type: M-x whist<CR>
;;; Error messages should be self-explanatory.
;;; To add new types, you have to modify the whist-types-alist and
;;; whist-prefix-alist constants, and the whist-help-message function.
;;; The modifications should be straightforward.
;;;
;;; Examples
;;;
;;; 11-Dec-88 gilbert harrus (gh@bdblues.altair.fr)
;;; This is another example of history message.
;;;
;;; 10-Dec-88 gilbert harrus (gh@bdblues.altair.fr)
;;; This is an example of history message. Note that is the first I
;;; entered, but this is also the last you read.
;;; Site: change this at will!
(defvar whist-site "bdblues.altair.fr")
;;; Constants
;; As default type is text (no comment prefix), we do not list corresponding
;; extensions (like .txt etc).
(defconst whist-types-alist (mapcar 'purecopy
'(("\\.[chy]$" . "c")
("\\.tex$" . "tex")
("\\.el$" . "lisp")
("\\.l$" . "lisp")
("\\.lisp$" . "lisp")
("akefile" . "makefile")
("\\.p$" . "pascal")
("\\.f$" . "fortran")
("\\.[nt]$" . "ntroff")
("\\.TeX$" . "tex")
("\\.sty$" . "tex")
("\\.bbl$" . "tex")
("\\.bib$" . "tex")
("\\.lsp$" . "lisp")
("\\.ml$" . "lisp")
("\\.ll$" . "lisp")
("\\.lh$" . "lisp")
("\\.bc$" . "bc")
("\\.cc$" . "c++")
("\\..*sh$" . "shell")
("\\.ada$" . "ada")
("\\.tbl$" . "ntroff")
("\\.eqn$" . "ntroff")
; site dependent types
("\\.a$" . "tex")
))
"Alist of filename patterns with corresponding (whist) types, and is used by
whist to make guess about your file types.
Each element looks like (REGEXP . TYPE), for example (""\\.c$"" . ""c"").
See also the whist-prefix variable.")
;; prefix by types
;;
(defconst whist-prefix-alist (mapcar 'purecopy
'(
("ada" . "--")
("bc" . " *")
("c" . " *")
("c++" . " *")
("fortran" . "C")
("lisp" . ";;;")
("makefile" . "#")
("pascal" . " *")
("ntroff" . ".""")
("shell" . "#")
("tex" . "%%")
("text" . "")
("yacc" . " *")
))
"Alist of whist types with corresponding prefix for comment continuation.
Each element looks like (TYPE . PREFIX), for example (""c"" . "" *"").
Type must be an existing type in whist-types-alist")
(defun whist()
"Add some comments line on the history part of the file.
Somewhere in the buffer, insert a comment with HISTORY,
History or history inside."
(interactive)
(catch 'this-way (whist-internal))
)
(defun whist-abort ()
"To abort whist ..."
(throw 'this-way t)
)
(defun whist-internal()
(save-excursion
(if (not buffer-file-name)
(error-message "There is no file associated to this buffer"))
(let
((whist-file-name (file-name-nondirectory buffer-file-name))
(alist whist-types-alist)
(whist-file-type nil)
(prefix nil))
(beginning-of-buffer)
(if (or (< (buffer-size) 10)
; I am not so good with regexp ...
(not (re-search-forward "HISTORY\\|History\\|history"
(buffer-size) t)))
(error-message "Please add a comment containing HISTORY.")
(set-mark (point))
)
(end-of-line)
(if (eobp) (insert-string "\n") (forward-char))
(exchange-point-and-mark)
; We left the mark at the beginning of the line
; that follows the one containing HISTORY.
; What is the type of the file ? We use our own list
(while (and (not whist-file-type) alist)
(if (string-match (car (car alist)) whist-file-name)
(setq whist-file-type (cdr (car alist))))
(setq alist (cdr alist)))
(if (not whist-file-type) (setq whist-file-type "text"))
;
; It is time to check our guess and define the format
; of the comment.
;
(save-window-excursion
(while (not prefix)
(setq whist-file-type ; check our guess.
(get-arg "Type of file ?"
whist-file-type))
(cond
((string-equal whist-file-type ".")
(error-message "Bye."))
((string-equal whist-file-type "special")
(setq prefix
(get-arg "Enter prefix string: " "")))
(t ; let's go for the real search
(setq alist whist-prefix-alist)
(while (and (not prefix) alist)
;; take care to compare with string-equal, not string-match
(if (string-equal (car (car alist)) whist-file-type)
(setq prefix (cdr (car alist))))
(setq alist (cdr alist)))
;
(if (and (not prefix)
(or (string-equal whist-file-type "?")
(string-equal (ml-substring
(get-arg (concat whist-file-type
" is unknown, do you want a list?")
"yes") 0 1) "y")))
(whist-help-message))))))
;
; Now is time to enter the message ...
;
(save-window-excursion
(pop-to-buffer "*whist*" 1)
(erase-buffer)
(setq mode-line-format
(concat "History message for " whist-file-name " ("
whist-file-type ") %M" ))
(setq fill-column 65)
(setq left-margin 0)
(auto-fill-mode 1)
(setq keep-going t)
(while keep-going
(message "%s" (substitute-command-keys
"Enter text. \\[exit-recursive-edit] when done.")
(recursive-edit) ; enter the message in the whist buffer
(setq action (ml-substring (get-arg
(concat "Action? (a[bort], e[dit], u[pdate]):")
"update") 0 1))
(cond
((string-equal action "e")
); continue edition
((string-equal action "a")
(kill-buffer "*whist*")
(error-message "Aborted")) ; abort
((string-equal action "u")
(setq keep-going nil)) ; update
(t
(message "%s" "Don't you read ? ")
(sit-for 2 t)) ; Yes, don't you read ?
)))
; updating
(beginning-of-buffer)
(if (zerop (buffer-size))
(error-message "Must be non-empty!")
(beginning-of-buffer))
(set-mark (point))
(setq time-string (current-time-string))
(insert (concat prefix " "
(if (string-equal whist-file-type "shell") """ " "")
(ml-substring time-string 8 10)
"-"
(ml-substring time-string 4 7)
"-"
(ml-substring time-string -2 2)
" "
(user-full-name)
" ("
(user-login-name) "@" whist-site ")"
"\n"
))
(replace-regexp "^" (concat prefix "\t"))
(end-of-buffer)
(if (not (equal (preceding-char) 10)) (insert-string "\n"))
)
(exchange-dot-and-mark) ; back to the line following HISTORY.
(insert-buffer-substring "*whist*" nil nil)
(kill-buffer "*whist*")
(message "%s" "Done")
)
)
)
;; Misc. functions
(defun whist-help-message()
(with-output-to-temp-buffer "*Help*"
(princ "The following file-types are recognized:\n")
(princ "ada bc c c++\n")
(princ "fortran lisp makefile ntroff\n")
(princ "pascal shell tex text\n")
(princ "yacc\n\n")
(princ "You may also specify ""special"" ")
(princ "to enter a prefix string, or . to abort.\n\n")
(princ "Contact your local emacs guru for adding types.\n")
)
(message "%s" "Hit return to continue")
(read-char)
)
(defun get-arg(arg1 arg2)
"Reads in the minibuffer an answer [string] to the question ARG1 with a
default answer ARG2 (just type <RETURN>)"
(setq return-argum (read-string (concat arg1 " [" arg2 "] ")))
(if (string-equal return-argum "") (setq return-argum arg2))
return-argum
)
(defun error-message(str)
(message "%s" str)
(sit-for 1 t)
(whist-abort))
(defun ml-substring(str pos n)
" Returns the substring of string str starting at position
pos (numbering from 1) and running for n characters.
If pos is less than 0, then length of the string is added to it;
the same is done for n. "
(if (>= pos 0)
(substring str pos n)
(substring str pos (+ (+ (length str) pos) n))))
Gilbert Harrus
Gip-Altair/INRIA gh@bdblues.altair.fr
Domaine de Voluceau ...!mcvax!inria!bdblues!gh
BP105 Rocquencourt
78153 Le Chesnay Cedex phone: (33)-(1)-39-63-54-63
France