spa@fctunl.rccn.pt (Salvador Pinto Abreu) (02/24/90)
Here's copy of a message I sent to `info-gnu-emacs@prep.ai.mit.edu' some
3 years ago.
Note: I haven't been using SCCS much lately, so this may break: it used
to run under Emacs 17.64.
--------------------------------
This is a little piece of code I hacked up some time ago, thought it
might be useful. Just load this from your ~/.emacs file.
Example scenario: suppose you have a directory foo, with SCCS stuff in
foo/SCCS, you already extracted all the files (via sccs get), ready,
say, for a "make". You ^X-^F some file. Comes as read-only. You want
to make changes: hit ^C-^F. To save the changes and make a new delta
use ^C-^S.
To quickly edit all active SCCS files in some directory, do ^C-^D and
type the directory name.
------- file sccs.el ----------
(make-variable-buffer-local 'sccs-edit-file)
(set-default 'sccs-edit-file nil)
(defun sccs-find-file (name)
"Same as \\[find-file] but does an sccs edit first."
(interactive
(list
(let ((the-name (file-name-nondirectory (buffer-file-name nil))))
(read-file-name (concat "Find SCCS file (default " the-name "): ")
nil the-name nil))))
(if sccs-edit-file (error "%s is already an SCCS edit buffer" (buffer-name)))
(let ((this-buffer (current-buffer))
(output-buffer (get-buffer-create "*sccs output*"))
version-1 version-2)
(find-file-read-only name)
(display-buffer output-buffer)
(save-excursion
(set-buffer output-buffer) (erase-buffer)
(insert "% sccs edit " name "\n")
(set-buffer this-buffer))
(message "fetching editable version...")
(call-process "/usr/ucb/sccs" nil output-buffer t "edit" name)
(find-alternate-file name) (setq this-buffer (current-buffer))
(save-excursion (let (beg)
(set-buffer output-buffer)
(beginning-of-buffer) (beginning-of-line 2)
(setq beg (point)) (end-of-line)
(setq version-1 (buffer-substring beg (point)))
(forward-word 2) (forward-char 1)
(setq beg (point)) (end-of-line)
(setq version-2 (buffer-substring beg (point)))
(end-of-buffer) (set-buffer this-buffer)))
(message "fetching editable version... done")
(setq sccs-edit-file t)
(set-minor-mode 'sccs-edit-mode
(format "SCCS edit %s-%s" version-1 version-2) t)))
(defun sccs-save-buffer ()
"Same as \\[save-buffer] but does an sccs delget as well."
(interactive)
(if (not sccs-edit-file) (error "%s is not an SCCS edit buffer"
(buffer-name)))
(save-buffer)
(let ((output-buffer (get-buffer-create "*sccs output*"))
(comments-buffer (get-buffer-create "*sccs comments*"))
(this-buffer (current-buffer))
(name (file-name-nondirectory (buffer-file-name (current-buffer)))))
(save-window-excursion
(switch-to-buffer-other-window comments-buffer)
(erase-buffer)
(message "Describe changes, hit %s to confirm, %s to abort."
(key-description (car (where-is-internal 'exit-recursive-edit)))
(key-description (car (where-is-internal 'abort-recursive-edit))))
(recursive-edit))
(display-buffer output-buffer)
(save-excursion
(set-buffer output-buffer) (erase-buffer)
(insert "% sccs delget " name "\n")
(insert-buffer comments-buffer) (end-of-buffer)
(set-buffer this-buffer))
(message "saving new version...")
(save-excursion
(set-buffer comments-buffer)
(call-process-region 1 (1+ (buffer-size))
"/usr/ucb/sccs" nil output-buffer t "delget" name)
(set-buffer this-buffer) (kill-buffer comments-buffer))
(find-alternate-file name)
(message "saving new version... done")
(setq sccs-edit-file nil)
(set-minor-mode 'sccs-edit-mode "" nil)))
(defun sccs-find-active-files (dir)
"Set things up so that all files in DIR that are being edited (from
SCCS's point of view) will be visited."
(interactive "DFind active SCCS files in directory: ")
(let ((output-buffer (get-buffer-create "*sccs output*"))
(this-buffer (current-buffer))
(current-dir default-directory))
(save-excursion (set-buffer output-buffer) (erase-buffer)
(set-buffer this-buffer))
(cd dir)
(call-process "/usr/ucb/sccs" nil output-buffer t "info")
(message (prog1 (parse-sccs-info-buffer output-buffer dir)
(cd current-dir)))))
(defun get-match (n)
"Returns the string matched by the Nth parenthesis set."
(buffer-substring (match-begin