SCCS vs RCS under emacs
Bill Leonard
bill at ssd.harris.com
Sat Jul 8 01:17:24 AEST 1989
I got such a large response, I will just post my SCCS package. I cannot
guarantee (unfortunately) that I haven't used functions that aren't
generally available, but I will try to fix any such problems you find.
--------------------------------- cut here -------------------------------
;; 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.
;; Written by Bill Leonard, Harris Computer Systems Division.
;; This file provides replacement functions for several Emacs commands
;; to provide a true, integrated historical editing capability.
;; Two functions in particular form the primary interface:
;; hist-find-file-noselect and hist-kill-buffer. This code has been
;; designed to be as transparent AND as safe as possible. In particular,
;; it is very hard to forget to update the SCCS file while editing,
;; since the functions that kill buffers and the "normal" exit from
;; Emacs (i.e., save-buffers-kill-emacs) have been redefined to perform the
;; necessary history-file processing. Furthermore, hooks have
;; been provided so that, should you accidentally exit Emacs (e.g.,
;; via kill-emacs, which hasn't been redefined) or kill a file buffer,
;; historical editing can be resumed for that file and everything should
;; be fine.
;; You must have the "converse" facility to use this.
;; The following is the documentation for the user-visible functions
;; here, most of which replace the corresponding default functions.
;; If you don't want the replacement to occur, remove the fset calls
;; at the end of this file.
;; hist-find-file-noselect operates by finding the file, then it checks to see
;; if historical editing should be done. During all of these checks,
;; the current buffer is the buffer for the file being edited, and
;; all buffer-local variables are set. The sequence of checks are:
;; 1) Call the function historical-edit-enabled. If it returns nil,
;; no historical editing; skip remaining checks. If it returns
;; non-nil, continue with remaining checks.
;; 2) Is there a .history directory in the directory where the
;; file resides? If not, no historical editing; skip remaining
;; checks.
;; 3) Is there an s-file in the .history directory for the file?
;; If so, then do historical editing; skip remaining checks.
;; 4) Call the function historical-edit-initiate. If it returns nil,
;; no historical editing. Otherwise, do historical editing for
;; this file. Note that, if this function returns non-nil, it
;; must create the s-file. It may assume that the s-file does
;; not already exist.
;; NOTE: Before doing anything else, hist-find-file-noselect calls the
;; functions specified by the variable find-file-before-hook, which can
;; be a list of functions to call. Each one is passed the filename as
;; the only argument. If any of these functions returns a non-nil
;; value, the remaining hook functions are not called. If that value
;; is a string, it replaces the filename to be used in the remainder
;; of the find-file-noselect operation. Note that a hook function may
;; call the error function if it wishes to terminate the find-file-noselect
;; operation altogether.
;; NOTE: The find-file-hooks list of functions is called BEFORE any of
;; the historical editing checks are made.
;; If historical editing is enabled for a file in a buffer, this has
;; the following effects:
;; 1) A buffer-local variable, historical-editing-on, is set to t.
;; Otherwise, this variable is set to nil.
;; 2) A buffer-local variable, historical-editing-directory is set
;; to the pathname of the .history directory. Although this is
;; normally the directory where the original file resides, any of
;; the functions called during the check for historical editing
;; (e.g., historical-edit-initiate) may change it.
;; 3) A buffer-local variable, historical-editing-sfile is set to
;; the pathname to the SCCS s-file for the edited file. This is
;; normally the concatenation of: the pathname of the .history
;; directory, the string "s.", and the original filename. However,
;; any of the historical editing check functions may modify it.
;; 4) If there is not already a p-file for this file in the .history
;; directory, a 'get' is performed. If there is a p-file already,
;; call the user-supplied function historical-edit-pfile-exists.
;; 5) If the contents of the file do not match the most recent SCCS
;; version, call the user-supplied function
;; historical-edit-version-mismatch. Editing continues.
;; 6) The mode line is modified so that the string "Hist" appears
;; if historical-editing-on is non-nil.
;; Function hist-kill-buffer first calls the hook functions in the
;; variable kill-buffer-before-hook (using run-hooks). Next, it
;; checks to see if historical-editing-on is true for the specified
;; buffer. If so, it calls the user-specified function
;; historical-edit-get-reason, which must return a string to be
;; used as the change description for the 'delta' command. The quit
;; function can be used at this time to abort the kill-buffer function,
;; leaving the file and buffer unchanged.
;; When a change description has been successfully obtained, the
;; function save-buffer is called (in case no save has been done since
;; most recent change), then a 'delta' command is executed. If that
;; executes successfully, then the file's buffer is killed in the normal
;; fashion. If the delta terminates abnormally, the buffer is not
;; killed, so you can attempt the delta again later.
;; Function hist-save-buffers-kill-emacs functions just like
;; save-buffers-kill-emacs, except that it checks each active
;; buffer to see if it has historical-editing-on. If so, it
;; calls hist-kill-buffer on it so that the SCCS file can be
;; updated.
;; Function hist-checkpoint updates the SCCS file, but allows you
;; to continue editing. It simply does a hist-delta followed by
;; a hist-get.
;; Function hist-turn-off turns off historical editing for the selected
;; buffer. The SCCS file is un-gotten, thus eliminating the p-file.
;; Everything about the buffer and its associated file reverts to
;; "normal" editing, as though historical editing had never been done.
;; If historical-editing-on is nil for this buffer, this function has
;; no effect.
;; Default function bindings:
;; historical-edit-enabled historical-edit-enabled-default
;; historical-edit-initiate historical-edit-initiate-default
;; historical-edit-pfile-exists historical-edit-pfile-exists-warning
;; historical-edit-version-mismatch historical-edit-version-mismatch-warning
;; historical-edit-get-reason historical-edit-read-reason
(require 'converse)
(defvar hist-debug-flag nil
"Non-nil means debug the historical editing functions. For one thing,
this causes all the historical editing temp buffers to stay around and
be displayed after each command.")
(defvar historical-editing-on nil
"A buffer-local variable whose value, if non-nil, indicates
that historical editing is in effect in the buffer.")
(defvar historical-editing-directory ".history"
"A buffer-local variable whose value is the pathname to the
.history directory in which the SCCS files corresponding to the
buffer's visited file reside. Only valid if historical-editing-on
is non-nil.")
(defvar historical-editing-sfile nil
"A buffer-local variable whose value is the pathname to the
the SCCS file s-file corresponding to the buffer's visited file reside.
Only valid if historical-editing-on is non-nil.")
(make-variable-buffer-local 'historical-editing-on)
(make-variable-buffer-local 'historical-editing-directory)
(make-variable-buffer-local 'historical-editing-sfile)
;; Set up the mode-line display so that "Hist" is displayed if
;; historical editing is in effect.
(or (assq 'historical-editing-on minor-mode-alist)
(setq minor-mode-alist (cons '(historical-editing-on " Hist")
minor-mode-alist)))
(defvar find-file-before-hook nil
"This variable, if non-nil, should be a list of functions
to be called (with one argument, the filename) before attempting
to find the specified file. Each function is passed the filename as
the only argument. If any function returns a non-nil value, the
remaining hook functions are not called; if that return value is
a string, it replaces the filename on which the find-file operation
is to be performed.")
(defvar kill-buffer-before-hook nil
"If non-nil, this variable is a list of functions to be called
(with no arguments) before killing a buffer. The buffer to be
killed is always the current buffer by the time these functions
are called.")
(defun hist-find-file-noselect (filename &optional nowarn)
"Attempt to do historical editing on the specified file.
First, this calls the find-file-before-hook list of functions
(if any; see documentation of this variable for details).
Next, it executes a series of checks to see if historical editing
should really be done (see documentation in load file). If historical
editing succeeds, this function sets the buffer-local variable
historical-editing-on to t."
(interactive "FFile:")
(save-excursion
(let
(
filebuf
(hook-result nil)
)
(setq filename (expand-file-name filename))
;; Call the list of hooks, if any
(setq hook-result (run-hooks1 find-file-before-hook filename))
(if (stringp hook-result)
(setq filename hook-result)
)
;; Now find the file.
(setq filebuf (set-buffer (old-find-file-noselect filename nowarn)))
;; We may have already had a buffer with this file in it, with
;; historical-editing already turned on. If so, there is nothing
;; more to do, so only continue from here if historical-editing-on
;; is nil.
(if (not historical-editing-on)
(progn
(setq historical-editing-directory
(concat (file-name-directory filename) ".history/")
)
(setq historical-editing-sfile
(concat historical-editing-directory
"s."
(file-name-nondirectory filename)
)
)
;; Series of checks to see if we should do historical editing.
(or
(not (historical-edit-enabled filename))
(not (file-directory-p historical-editing-directory))
(if (file-readable-p historical-editing-sfile)
(setq historical-editing-on t)
)
(setq historical-editing-on (historical-edit-initiate filename))
)
;; If we are doing historical editing, we need to do a get unless
;; there is already a p-file.
(if historical-editing-on
(if (file-readable-p (hist-sccs-name "p."))
(historical-edit-pfile-exists filename)
(if (equal (hist-get historical-editing-sfile filename nil)
'create)
;; The get created the g-file, so we want the buffer
;; to reflect its contents.
(progn
(erase-buffer)
(insert-file-contents filename t)
)
)
)
)
)
)
filebuf
)
)
)
(defun hist-kill-buffer (buf)
"Kill the specified BUFFER. If historical-editing-on (a buffer-local
variable) is non-nil for this buffer, and if the visited file is newer
than the historical-editing-sfile, then first update the corresponding
SCCS file before killing."
(interactive "bKill buffer:")
(save-excursion
(setq buf (get-buffer buf))
(set-buffer buf)
(run-hooks 'kill-buffer-before-hook)
(if historical-editing-on
(let*
(
(filename (buffer-file-name))
)
(save-buffer)
;; If the g-file has been updated (perhaps by the save we
;; just did) since the s-file was, then we need to do a
;; delta. If the delta is successful, kill the buffer and
;; we're done. If the s-file is already up to date with the
;; g-file, then just unget the file for SCCS' sake and kill
;; the buffer.
(if (file-newer-than-file-p filename historical-editing-sfile)
(if (hist-delta historical-editing-sfile
filename
(historical-edit-get-reason filename))
(old-kill-buffer buf)
)
(progn ;; g-file not newer than s-file
(hist-unget historical-editing-sfile)
(old-kill-buffer buf)
)
)
)
;; else no historical editing, so just kill the buffer.
(old-kill-buffer buf)
)
)
)
(defun hist-checkpoint (buf)
"Checkpoint the specified BUFFER (default is current buffer) in its
SCCS file, but continue editing."
(interactive "bCheckpoint buffer.")
(save-excursion
(setq buf (get-buffer buf))
(set-buffer buf)
(let*
(
(filename (buffer-file-name))
)
(if (buffer-modified-p buf)
(save-buffer)
)
(if (file-newer-than-file-p filename historical-editing-sfile)
(progn
(hist-delta historical-editing-sfile filename
(historical-edit-get-reason filename))
(hist-get historical-editing-sfile filename nil)
)
)
)
)
)
(defun hist-turn-off (buf)
"Turn off historical editing for the specified BUFFER (default is
the current buffer). The file is 'ungotten' from SCCS, and if that
succeeds, historical-editing-on is set to nil. The return value is
t if historical editing is off at the end of this function, and nil
otherwise."
(interactive "bTurn off historical editing for buffer.")
(save-excursion
(set-buffer buf)
(if historical-editing-on
(if (hist-unget historical-editing-sfile)
(setq historical-editing-on nil)
(if (yes-or-no-p "unget failed -- turn historical editing off anyway? ")
(setq historical-editing-on nil)
)
)
)
)
(not historical-editing-on)
)
(defun hist-save-buffers-kill-emacs (&optional arg)
"Offer to save each buffer, then kill this Emacs fork.
With prefix arg, silently save all file-visiting buffers, then kill.
If any buffer has historical editing in effect, then ask the user if
we should call hist-kill-buffer on it before killing emacs."
(interactive "P")
(save-some-buffers arg t)
(let
(
(buflist (buffer-list))
buf-file-name
basename
)
(while buflist
(save-excursion
(set-buffer (car buflist))
(setq buf-file-name (buffer-file-name (car buflist)))
(if buf-file-name
(setq basename (file-name-nondirectory buf-file-name))
)
(if (and historical-editing-on
(y-or-n-p (format "Update historical file for %s? "
basename)))
(hist-kill-buffer (car buflist))
)
)
(setq buflist (cdr buflist))
)
)
(kill-emacs)
)
;; The replacement for find-file-read-only, hist-find-file-read-only,
;; makes sure that the buffer is marked read-only BEFORE historical
;; editing checks are done. Since historical-edit-enabled returns
;; false for a read-only file or buffer, this avoids unnecessary
;; gets and ungets.
(defun hist-find-file-read-only (filename)
"Edit file FILENAME but don't save without confirmation.
Like find-file but marks buffer as read-only.
The buffer is marked read-only BEFORE the checks for historical
editing are made, so that historical editing can be disabled,
if desired, for read-only buffers."
(interactive "fFind file read-only: ")
;; Establish a hook function for find-file, so that
;; the buffer gets marked read-only early in the game.
(let
(
(find-file-hooks (cons (function (lambda ()
(setq buffer-read-only t)))
find-file-hooks))
)
(find-file filename)
)
)
(defun hist-combine (s-file vers1 vers2 output-file)
"Generate a 'combine -h' listing of the differences in two
versions of S-FILE, given by VERS1 and VERS2. The result
is written to the file OUTPUT-FILE. If OUTPUT-FILE already
exists, you will be asked to confirm an overwrite.
If the current buffer is in historical editing mode, then
S-FILE's default value is the value of historical-editing-sfile.
If VERS2 is not given, it defaults to the latest version of the
file."
(interactive
(list
(if historical-editing-on
(expand-file-name
(read-file-name (format "SCCS File (default %s): "
(file-name-nondirectory historical-editing-sfile))
default-directory
historical-editing-sfile
t)
)
;; else no default
(read-file-name "SCCS File: " default-directory nil t)
) ;; end of s-file arg
(read-from-minibuffer "Old version: " nil nil nil) ;; vers1
(read-from-minibuffer "New version (default latest): " nil nil nil) ;; vers2
(read-file-name "Output file: " default-directory nil nil)
)
)
(message "Processing...")
(let
(
(vers1-string (concat "-r" vers1))
(vers2-string (if (string-equal vers2 "") "" (concat "-r" vers2)))
(vers2-display (if (string-equal vers2 "") "latest" vers2))
tfile1
tfile2
(outbuf (get-buffer-create "*H-edit Command Output*"))
(prompt "^\\(#\\|\\$\\|%\\) *")
process
)
(if (file-exists-p output-file)
(if (y-or-n-p (format "File %s exists; overwrite? " output-file))
nil
(error "Quit!")
)
)
(save-excursion
(set-buffer outbuf)
(erase-buffer)
(setq process
(start-process "*shell:hist-combine*"
outbuf
"/bin/sh"
"-s"
)
)
(process-kill-without-query process)
(converse process)
(setq tfile1 (format "%s-%s-%d"
output-file vers1 (process-id process)))
(setq tfile2 (format "%s-%s-%d"
output-file vers2-display (process-id process)))
;; Do a null command to wait for a prompt, to make sure that
;; the process is ready.
(conversation-doit process nil nil prompt nil)
(conversation-doit process
(format "get %s -s -p %s > %s\n"
vers1-string s-file tfile1)
nil
prompt
nil
)
(conversation-doit process
(format "get %s -s -p %s > %s || %s\n"
vers2-string s-file tfile2
"echo get failed")
nil
prompt
nil
)
(conversation-doit process
(format "combine -h %s %s > %s\n"
tfile1 tfile2 output-file)
nil
prompt
nil
)
(conversation-doit process "exit\n" nil nil nil)
(goto-char (point-min))
(if (search-forward "ERROR" nil t)
(progn
(message "SCCS command(s) failed.")
(display-buffer outbuf)
)
(progn
(converse-off process)
(if hist-debug-flag
(display-buffer outbuf)
(old-kill-buffer outbuf)
)
)
)
)
(delete-file tfile1)
(delete-file tfile2)
(message "Processing...done")
)
)
;; Auxiliary functions used by hist-find-file-noselect and hist-kill-buffer.
;; Most of these can also be called interactively, but you shouldn't
;; normally need to.
(defun run-hooks1 (hook-list arg)
"(run-hooks1 HOOKS ARG): HOOKS is a list of functions,
each of which is called with ARG as its only argument.
If a hook function returns a non-nil value, run-hooks1 terminates
and returns that value. Otherwise, run-hooks1 returns nil."
(let
(
(my-result nil)
)
(while (and hook-list (null my-result))
(setq my-result (funcall (car hook-list) str))
(setq hook-list (cdr hook-list))
)
my-result
)
)
(defun hist-sccs-name (str &optional sfile-name)
"Generate an SCCS filename from the given string STR and the optional
second arg SFILE-NAME. SFILE-NAME defaults to the current value of
historical-editing-sfile if not supplied. The name is created by removing
the 's.' from the s-file name and substituting STR. For instance,
(hist-sccs-name \"p.\") gives the p-file name."
(if (not sfile-name)
(setq sfile-name historical-editing-sfile)
)
(let
(
(dir (file-name-directory sfile-name))
(base (file-name-nondirectory sfile-name))
name
)
(setq name (substring base 2))
(setq name (concat dir str name))
name
)
)
(defun hist-create-sfile (sfile-name init-file)
"(hist-create-sfile SFILE-NAME INIT-FILE): Create an SCCS file named
SFILE-NAME with initial contents obtained from INIT-FILE. If this operation
fails, the buffer containing the admin process' output is displayed
in another window. Note that the 'No id keywords' message is not
considered an error, so it is discarded. This function returns t
if the s-file was created successfully, and nil otherwise."
(let
(
(outbuf (get-buffer-create "*H-edit Command Output*"))
(prompt "^\\(#\\|\\$\\|%\\) *")
(result nil)
(init-parm
(if (and (stringp init-file)
(file-readable-p init-file))
(format "-i%s" init-file)
""
)
)
end-output
process
)
(save-excursion
(set-buffer outbuf)
(erase-buffer)
(setq process
(start-process "*shell:admin*"
outbuf
"/bin/sh"
"-s"
)
)
(process-kill-without-query process)
(converse process)
;; Do a null command to wait for a prompt, to make sure that
;; the process is ready.
(conversation-doit process nil nil prompt nil)
(conversation-doit process
(format "admin -n %s %s || echo admin failed\n"
init-parm sfile-name)
nil
prompt
nil
)
(goto-char conversation-start-output)
(setq end-output conversation-end-output)
(save-excursion
(conversation-doit process "exit\n" nil nil nil)
)
(if (search-forward "admin failed" end-output t)
(progn
(message "SCCS admin command failed.")
(display-buffer outbuf)
)
(progn
(message "(SCCS file created)")
(converse-off process)
(if hist-debug-flag
(display-buffer outbuf)
(old-kill-buffer outbuf)
)
(setq result t)
)
)
)
(if hist-debug-flag
(if (not (y-or-n-p "Okay to continue? "))
(error "User requested termination.")
)
)
result
)
)
(defun hist-get (sfile-name gfile-name version)
"(hist-get SFILE-NAME GFILE-NAME VERSION): Run 'get' on SFILE-NAME to
retrieve the given VERSION of the SCCS file. If GFILE-NAME is non-nil
and this file exists, it is compared to the version retrieved and if
they do not match, the function historical-edit-version-mismatch is
called with GFILE-NAME as the argument. If GFILE-NAME is nil or does
not exist, then a g-file is created either in the current directory
(if GFILE-NAME is nil) or with the specified name (GFILE-NAME not nil
but not readable). In this latter case, the get is performed without
the -e option, thus suppressing the 'checkout' of the file. If
VERSION is nil, the latest version is retrieved. The return value is
t if the command and the version comparison were successful, the
symbol create if the g-file was created, and nil otherwise."
(interactive "fSCCS file name:
Fg-file name:
sVersion (default is latest):")
(message "Processing...")
(save-excursion
(let
(
(outbuf (get-buffer-create "*H-edit Command Output*"))
(prompt "^\\(#\\|\\$\\|%\\) *")
(get-cmd nil)
(cmp-cmd nil)
(version-string (if (or (null version) (string-equal version ""))
"" (concat "-r" version)))
(result nil)
(created-gfile nil)
end-output
process
)
(setq sfile-name (expand-file-name sfile-name))
(setq gfile-name (expand-file-name gfile-name))
(set-buffer outbuf)
(erase-buffer) ;; Clear the output buffer, just in case
;; it already existed.
(setq process (start-process "*shell:get*"
outbuf
"/bin/sh"
"-s") )
(process-kill-without-query process)
;; Set up the get command.
(if (and gfile-name
(file-readable-p gfile-name))
(setq get-cmd
(format "get %s -s -e -p %s | cmp -s - %s || %s\n"
version-string sfile-name gfile-name
"echo version mismatch"))
(progn
(setq created-gfile t)
(if gfile-name ;; filename given, but file not readable
(setq get-cmd
(format "get %s -e -s -p %s > %s || %s\n"
version-string sfile-name gfile-name
"echo get failed"))
;; else no filename given at all, so create
(setq get-cmd
(format "get %s -e %s || echo get failed\n"
version-string sfile-name))
)
)
)
(converse process) ;; Start conversation
;; Do a null command to wait for a prompt, to make sure that
;; the process is ready.
(conversation-doit process nil nil prompt nil)
(conversation-doit process get-cmd nil prompt nil)
(if (not (file-readable-p (hist-sccs-name "p." sfile-name)))
(progn
(display-buffer outbuf)
(setq hist-debug-flag t)
(message "Glitch in get -- no p-file.")
)
)
;; Check to see if we got 'get failed'.
(goto-char conversation-start-output)
(setq end-output conversation-end-output)
(save-excursion
(if hist-debug-flag
(conversation-doit process (format "ls -l %s\n"
(hist-sccs-name "p." sfile-name)) nil prompt nil)
)
(conversation-doit process "exit\n" nil nil nil)
)
(if (or (search-forward "get failed" end-output t)
(re-search-forward "ERROR.*nonexistent (ut4)"
end-output t))
(progn
(message "Get command failed.")
(display-buffer outbuf)
)
(if (search-forward "version mismatch" end-output t)
(progn
(display-buffer outbuf)
(historical-edit-version-mismatch gfile-name)
)
(progn
(message "(Get command succeeded)")
(converse-off process)
(if hist-debug-flag
(display-buffer outbuf)
(old-kill-buffer outbuf)
)
(if created-gfile
(setq result 'create)
(setq result t)
)
)
)
)
(if hist-debug-flag
(if (not (y-or-n-p "Okay to continue? "))
(error "User requested termination.")
)
)
result
)
)
)
(defun hist-unget (sfile-name)
"(hist-unget SFILE-NAME): Run 'unget' on SFILE-NAME so it no longer
appears to be edited to SCCS. The return value is t if the command is
successful, and nil otherwise."
(interactive "fSCCS file name:")
(message "Processing...")
(let
(
(outbuf (get-buffer-create "*H-edit Command Output*"))
(prompt "^\\(#\\|\\$\\|%\\) *")
(unget-cmd nil)
(result nil)
end-output
process
)
(save-excursion ;; So set-buffer doesn't affect caller's buffer
(setq sfile-name (expand-file-name sfile-name))
(set-buffer outbuf)
(erase-buffer) ;; Clear the output buffer, just in case
;; it already existed.
(setq process (start-process "*shell:unget*"
outbuf
"/bin/sh"
"-s") )
(process-kill-without-query process)
;; Set up the unget command.
(setq unget-cmd
(format "unget -n %s || echo unget failed\n" sfile-name))
(converse process) ;; Start conversation
;; Do a null command to wait for a prompt, to make sure that
;; the process is ready.
(conversation-doit process nil nil prompt nil)
(conversation-doit process unget-cmd nil prompt nil)
;; Check to see if we got 'unget failed'.
(goto-char conversation-start-output)
(setq end-output conversation-end-output)
(save-excursion
(conversation-doit process "exit\n" nil nil nil)
)
(if (search-forward "unget failed" end-output t)
(progn
(message "Unget command failed.")
(display-buffer outbuf)
)
(progn
(message "(Unget command succeeded)")
(converse-off process)
(if hist-debug-flag
(display-buffer outbuf)
(old-kill-buffer outbuf)
)
(setq result t)
)
)
)
result
)
)
(defun hist-delta (sfile-name gfile-name reason)
"(hist-delta SFILE-NAME GFILE-NAME REASON): Run the 'delta' command
on SFILE-NAME, which is the s-file for an SCCS file, using GFILE-NAME
as the g-file and REASON as the comment. The return value is t if
the command is successful, and nil otherwise."
(interactive "fSCCS file name:
fg-file name:
sComment:")
(message "Processing...")
(save-excursion
(let
(
(outbuf (get-buffer-create "*H-edit Command Output*"))
(dir (file-name-directory gfile-name))
(prompt "^\\(#\\|\\$\\|%\\) *")
(result nil)
end-output
process
)
(setq sfile-name (expand-file-name sfile-name))
(setq gfile-name (expand-file-name gfile-name))
(set-buffer outbuf)
(erase-buffer) ;; Clear the output buffer, just in case
;; it already existed.
(setq process (start-process "*shell:delta*"
outbuf
"/bin/sh"
"-s") )
(process-kill-without-query process)
(converse process) ;; Start conversation
;; Do a null command to wait for a prompt, to make sure that
;; the process is ready.
(conversation-doit process nil nil prompt nil)
;; cd to the directory containing the g-file
(conversation-doit process (format "cd %s\n" dir) nil
prompt nil)
;; Set PS2 to the null string, so that a newline embedded
;; in the comment string won't cause another prompt to be
;; issued by the shell, which in turn will confuse converse
;; into thinking it never got a prompt (and consequently hangs).
(conversation-doit process "PS2='' export PS2\n" nil prompt nil)
(conversation-doit process
(format "delta -s -n -y\"%s\" %s %s\n"
reason
sfile-name
"|| echo delta failed")
nil
prompt
nil)
;; Check to see if we got 'delta failed'.
(goto-char conversation-start-output)
(setq end-output conversation-end-output)
(save-excursion
(conversation-doit process "exit\n" nil nil nil)
)
(if (search-forward "delta failed" end-output t)
(progn
(message "Delta command failed.")
(display-buffer outbuf)
)
(progn
(message "(Delta command succeeded)")
(converse-off process)
(if hist-debug-flag
(display-buffer outbuf)
(old-kill-buffer outbuf)
)
(setq result t)
)
)
result
)
)
)
;; Default functions for historical editing hooks.
(defun historical-edit-enabled-default (filename)
"Default function for determining whether historical editing
should be allowed for the given FILENAME.
Returns t if the buffer is not read-only."
(not buffer-read-only)
)
(defun historical-edit-initiate-default (filename)
"Default function for determining whether historical editing
should be initiated for the given FILENAME.
It assumes that the s-file does not exist. If the environment
variable HED_INIT_HISTORY contains the string \"y\", it creates the s-file
and returns t. If it contains anything else, or if the
environment variable is not defined, then the user is queried via
the Minibuffer to determine whether to initiate historical editing.
If the answer is no, the s-file is not created and this function
returns nil. It also returns nil if an error occurs when trying
to create the s-file."
(let
(
(init (getenv "HED_INIT_HISTORY"))
(create nil)
)
(if (or (null init) (not (stringp init)))
(setq create
(yes-or-no-p "Do you want to initiate historical editing? "))
(setq create (string-equal init "y"))
)
(if create
(if (not (hist-create-sfile historical-editing-sfile filename))
(progn
(setq historical-editing-on nil)
(setq create nil)
)
)
)
create
)
)
(defun historical-edit-pfile-exists-warning (filename)
"Default function for dealing with the condition where historical
editing is being attempted, but the p-file already exists.
This function issues an error message, and asks for confirmation
to continue. If the answer is no, historical-editing-on is set
to nil and then editing continues."
(if (y-or-n-p (format "%s is already being edited. Continue?"
(file-name-nondirectory filename)))
(message "(Continued)")
(save-excursion
(set-buffer (get-file-buffer filename))
(setq historical-editing-on nil)
)
)
)
(defun historical-edit-version-mismatch-warning (filename)
"Default function for dealing with the condition where historical
editing is being attempted, but the g-file contents do not match
the latest version of the s-file.
This function issues an error message, and asks for confirmation
to continue. If the answer is no, hist-turn-off is called for
the buffer and then editing continues."
(if (y-or-n-p (format "%s is not the latest version. Continue? "
(file-name-nondirectory filename)))
(message "(Continued)")
(hist-turn-off (get-file-buffer filename))
)
)
(defun historical-edit-read-reason (filename)
"Default function for reading the comment to be given to 'delta'
when the historical file for FILENAME is updated.
This function uses read-input to read the comment in the minibuffer."
(read-input (format "Comment (%s): " (file-name-nondirectory filename)))
)
;; Establish the default bindings for functions called "automatically"
;; by historical editing functions.
(if (not (fboundp 'historical-edit-enabled))
(fset 'historical-edit-enabled
(symbol-function 'historical-edit-enabled-default))
)
(if (not (fboundp 'historical-edit-initiate))
(fset 'historical-edit-initiate
(symbol-function 'historical-edit-initiate-default))
)
(if (not (fboundp 'historical-edit-pfile-exists))
(fset 'historical-edit-pfile-exists
(symbol-function 'historical-edit-pfile-exists-warning))
)
(if (not (fboundp 'historical-edit-version-mismatch))
(fset 'historical-edit-version-mismatch
(symbol-function 'historical-edit-version-mismatch-warning))
)
(if (not (fboundp 'historical-edit-get-reason))
(fset 'historical-edit-get-reason (symbol-function 'historical-edit-read-reason))
)
;; Replace the normal find-file-noselect, find-file-read-only, and
;; kill-buffer functions with hist-find-file-noselect and hist-kill-buffer.
;; Remove this code if you don't want the replacements to occur.
(if (not (fboundp 'old-find-file-noselect))
(fset 'old-find-file-noselect (symbol-function 'find-file-noselect))
)
(fset 'find-file-noselect (symbol-function 'hist-find-file-noselect))
(if (not (fboundp 'old-find-file-read-only))
(fset 'old-find-file-read-only (symbol-function 'find-file-read-only))
)
(fset 'find-file-read-only (symbol-function 'hist-find-file-read-only))
(if (not (fboundp 'old-kill-buffer))
(fset 'old-kill-buffer (symbol-function 'kill-buffer))
)
(fset 'kill-buffer (symbol-function 'hist-kill-buffer))
(if (not (fboundp 'old-save-buffers-kill-emacs))
(fset 'old-save-buffers-kill-emacs (symbol-function 'save-buffers-kill-emacs))
)
(fset 'save-buffers-kill-emacs (symbol-function 'hist-save-buffers-kill-emacs))
--
Bill Leonard
Harris Computer Systems Division
2101 W. Cypress Creek Road
Fort Lauderdale, FL 33309
bill at ssd.harris.com or hcx1!bill at uunet.uu.net
More information about the Comp.unix.questions
mailing list