aks%nowhere@HUB.UCSB.EDU (Alan Stebbens) (10/19/88)
Here is a copy of rcs.el which someone posted a long time ago:
I've never used it, but kept it (being kind of a software
pack-rat).
;;
;; This file, rcs.el, is a facility to check in and check out files
;; to and from RCS.
;;
;; Copyright (C) 1987 Pehong Chen (phc@renoir.berkeley.edu)
;; -- Plesase send bug reports and comments to the above address.
;;
;; USAGE:
;; (1) Bind rcs-ci and rcs-co to some keys.
;; (2) rcs-keywords contains the list of RCS keywords to be included
;; in the header. Default is the list ("Log" "Header").
;; Other keywords can be consed to it in rcs-hook.
;; (3) rcs-log-terminator is the string which terminates the prompting
;; of log message lines. Default is ".". This can be redefined
;; in rcs-hook.
;; (4) rcs-head and rcs-tail are the two banners in the header, both of
;; which can be redefined in rcs-hook.
;;
;; ===============================================
;; Global Variables (can be redefined in rcs-hook)
;; ===============================================
(defvar rcs-head nil "RCS head banner.")
(defvar rcs-tail nil "RCS tail banner.")
(defvar rcs-use-directory nil
"If non-nil, create RCS directory when required.")
(defvar rcs-log-terminator "." "String which terminates a log message.")
(defvar rcs-keywords '("Log" "Header")
"List of RCS keywords to be included in the header (in reverse order of
desired occurance). Default is $Header$ and $Log$.")
;; ==================================================
;; Other Variables (shouldn't be touched by the user)
;; ==================================================
(defconst rcs-name "RCS")
(defvar rcs-startup-directory nil)
(defvar rcs-log-buffer "#log#")
(defvar rcs-msg-buffer "#rcs#")
(defvar rcs-comment-begin "")
(defvar rcs-comment-body "")
(defvar rcs-comment-end "")
(defun rcs-check-comment-string ()
"Determine the right comment symbols for the current mode.
If the mode is not known, prompt the user for the three parts of
comment symbols."
(cond
((string-match "TeX\\|PS\\|PostScript\\|postscript\\|ps" mode-name)
(setq rcs-comment-begin "% ")
(setq rcs-comment-body "% ")
(setq rcs-comment-end "% "))
((string-match "[Ll]isp\\|[Ss]cheme" mode-name)
(setq rcs-comment-begin ";; ")
(setq rcs-comment-body ";; ")
(setq rcs-comment-end ";; "))
((string-match "\\.h$\\|\\.c$" (buffer-file-name))
(setq rcs-comment-begin "/* ")
(setq rcs-comment-body " * ")
(setq rcs-comment-end " */"))
((or (string-match "[Mm]akefile\\|\\.sh\\|\\.csh" (buffer-file-name))
(string-equal "#" (buffer-substring 1 1)))
(setq rcs-comment-begin "# ")
(setq rcs-comment-body "# ")
(setq rcs-comment-end "# "))
((string-match "\\.\\(pic\\|tbl\\|x\\|me\\|ms\\|tmac\\|nr\\|tr\\|[0-9]+[vxl]?\\|[nl]\\)$"
(buffer-file-name))
(setq rcs-comment-begin "... ")
(setq rcs-comment-body "... ")
(setq rcs-comment-end "... "))
(t
(setq rcs-comment-begin (read-string "Opening comment string: "))
(setq rcs-comment-body (read-string "Intermediate comment string: "))
(setq rcs-comment-end (read-string "Closing comment string: ")))))
(defun rcs-ci (&optional flags fn)
"Check in file FN to RCS.
With prefix argument, prompt for additional switches to ci.
Enter log message at prompt except for the initial revision.
RCS-LOG-TERMINATOR terminates the message."
(interactive "P\nfRCS check-in file: ")
(let* ((fnnd (file-name-nondirectory fn))
(dir default-directory)
(RCS (concat dir rcs-name))
(fnv (concat RCS "/" fnnd ",v"))
(log (get-buffer-create rcs-log-buffer))
(msg (get-buffer-create rcs-msg-buffer))
(cmd (concat "ci -l "
(if flags
(concat (read-string "Additional ci switches: " "-")
" "))
fnnd)))
;; Check if the directory is right
(if rcs-startup-directory
(if (string-equal rcs-startup-directory default-directory)
nil
(setq cmd (concat "cd " default-directory "; " cmd)))
(setq rcs-startup-directory default-directory))
;; Check if RCS directory exists
(if rcs-use-directory
(if (file-directory-p RCS)
nil
(message "Creating RCS directory %s..." RCS)
(call-process shell-file-name nil nil nil
"-c" (concat "mkdir " RCS))))
(rcs-check-comment-string);; Determine the current mode
(find-file fnnd)
(rcs-init)
(if (buffer-modified-p)
(write-file fn))
(message "Checking in %s to RCS..." fnnd)
(rcs-display msg cmd)
(save-excursion
(set-buffer log)
(call-process-region 1 (point-max) shell-file-name nil msg nil "-c" cmd)
(rcs-co nil fn)
(message "Checking in %s to RCS...done" fnnd))))
(defun rcs-init ()
(if (file-exists-p fnv)
(let (line (n 0))
(save-excursion
(set-buffer log)
(erase-buffer)
(while
(not (string-equal rcs-log-terminator
(setq line (read-string (concat "Log line " (setq n (1+ n))
" [exit with \""
rcs-log-terminator "\"]: ")))))
(insert line ?\n))))
(if (save-excursion
(search-forward (concat rcs-comment-body "$Header") nil t))
nil ;; Header already exists
(rcs-insert-header))
(message "Creating RCS file %s..." fnv)
(call-process shell-file-name nil nil nil "-c"
(concat "rcs -i -c""" rcs-comment-body """ " fnnd))))
(defun rcs-display (buf cmd)
(pop-to-buffer buf)
(goto-char (point-max))
(recenter 0)
(insert cmd ?\n)
(sit-for 0)
(other-window 1))
(defun rcs-insert-header ()
(goto-char 1)
(insert rcs-comment-begin ?\n)
(if rcs-head
(insert rcs-comment-body rcs-head
rcs-comment-body ?\n))
(rcs-insert-keywords)
(if rcs-tail
(insert rcs-comment-body rcs-tail
rcs-comment-body ?\n))
(insert rcs-comment-end "\n\n")
(goto-char 1))
(defun rcs-insert-keywords ()
(let ((keywords (reverse rcs-keywords)))
(while keywords
(insert rcs-comment-body ?$ (car keywords) "$\n")
(setq keywords (cdr keywords)))))
(defun rcs-co (&optional flags fn)
"Check out a locked file FN from RCS and visit the file.
With prefix argument, prompt for additional switches to co.
If called noninteractively, don't do the check out, visit the file only."
(interactive "P\nFRCS check-out file: ")
(let ((verbose (interactive-p)))
(if (and verbose
(file-exists-p fn)
(not (y-or-n-p (concat "Overwrite " fn "? "))))
(error "RCS checkout abort"))
(let* ((fnnd (file-name-nondirectory fn))
(buf (get-file-buffer fn))
(rcs (get-buffer-create "#rcs#"))
(cmd (concat "rm -f " fn "; co -l "
(if flags
(concat (read-string "Additional co switches: " "-") " "))
fn)))
(if verbose
(progn
(message "Checking out locked %s from RCS..." fnnd)
(rcs-display rcs cmd)
(call-process shell-file-name nil rcs nil "-c" cmd)))
(if buf
(progn
(switch-to-buffer buf)
(if (buffer-modified-p)
(write-file fn)
(kill-buffer buf)
(find-file fn)))
(find-file fn))
(if verbose (message "Checking out locked %s from RCS...done" fnnd)))))
(run-hooks 'rcs-hook)