spa@hara.DEC.COM (Salvador Pinto Abreu) (05/12/87)
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-beginning n) (match-end n)))
(defun parse-sccs-info-buffer (buffer dir)
"Visit all the files indicated by the sccs info command, whose output
is in BUFFER. The files are located in directory DIR."
(let ((message-data ""))
(save-excursion
(set-buffer buffer)
(beginning-of-buffer)
(while (looking-at
"^ *\\(.*\\): being edited: \\([0-9.]+\\) \\([0-9.]+\\).*$")
(let ((file-name (get-match 1))
(version-1 (get-match 2))
(version-2 (get-match 3)))
(setq message-data (concat message-data " " file-name))
(save-excursion
(find-file-other-window (concat dir file-name))
(setq sccs-edit-file t)
(set-minor-mode 'sccs-edit-mode
(format "SCCS edit %s-%s" version-1 version-2) t)))
(beginning-of-line 2)))
(concat "Editing" message-data)))
(global-set-key "\C-c\C-f" 'sccs-find-file)
(global-set-key "\C-c\C-s" 'sccs-save-buffer)
(global-set-key "\C-c\C-d" 'sccs-find-active-files)
---
ARPA: lisvax.dec!unlai!spa@decwrl.dec.com PSI/VMS: PSI%05010310::SPA
UUCP: mcvax!lisvax.dec!unlai!spa Phone: + 351 1 295 31 56
Snail: Salvador Pinto Abreu
Dept. of Computer Science, Universidade Nova de Lisboa
2825 Monte Caparica, Portugal