--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/packages/generic-sc.el	Mon Aug 13 09:39:39 2007 +0200
@@ -0,0 +1,1758 @@
+;;; generic-sc.el --- generic interface to source control systems
+
+;; Copyright (C) 1992, 1993, 1994, 1997 Free Software Foundation, Inc.
+
+;; Author: devin@lucid.com
+;; Maintainer: Unmaintained
+;; Keywords: tools, unix
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the 
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Synched up with: Not in FSF.
+
+;;; Commentary:
+
+;; The generic interface provide a common set of functions that can be
+;; used to interface with a source control system like SCCS, RCS or
+;; CVS.  
+;; 
+;; You chose which source control system to use by calling sc-mode
+;; 
+;; The module is based on the sccs.el mode of Eric S. Raymond
+;; (eric@snark.thyrsus.com) which was distantly derived from an rcs
+;; mode written by Ed Simpson ({decvax, seismo}!mcnc!duke!dukecdu!evs)
+;; in years gone by and revised at MIT's Project Athena.
+
+;;; Code:
+
+;; This can be customized by the user
+
+(defgroup generic-sc nil
+  "Generic interface to source control systems"
+  :prefix "sc-"
+  :group 'tools)
+
+
+(defcustom sc-diff-command '("diff")
+  "*The command/flags list to be used in constructing diff commands."
+  :type '(repeat string)
+  :group 'generic-sc)
+
+;; Duplicated from pcl-cvs.
+(defvar cvs-program "cvs"
+  "*The command name of the cvs program.")
+
+(defcustom sc-mode-expert ()
+  "*Treat user as expert; suppress yes-no prompts on some things."
+  :type 'boolean
+  :group 'generic-sc)
+
+(defcustom sc-max-log-size 510
+  "*Maximum allowable size of a source control log message."
+  :type 'integer
+  :group 'generic-sc)
+
+(defcustom sc-ccase-comment-on '(checkout checkout-dir checkin-dir rename
+				       new-brtype new-branch checkin-merge
+				       create-label label-sources)
+  "*Operations on which comments would be appreciated.
+We check the values checkout, checkout-dir, checkin-dir,
+rename, new-brtype, new-branch, create-label,
+and label-sources as symbols."
+  :type '(repeat symbol)
+  :group 'generic-sc)
+
+(defvar sc-ccase-reserve nil
+  "Whether to reserve checkouts or not. By default, this is nil - don't.
+Other values are t - do, and anything else, eg. 'ask - ask.")
+
+;; default keybindings
+(defvar sc-prefix-map (lookup-key global-map "\C-xv"))
+(if (not (keymapp sc-prefix-map))
+    (progn
+      (setq sc-prefix-map (make-sparse-keymap))
+      (define-key global-map "\C-xv" sc-prefix-map)
+      (define-key sc-prefix-map "v" 'sc-next-operation)
+      (define-key sc-prefix-map "=" 'sc-show-changes)
+      (define-key sc-prefix-map "l" 'sc-show-history)
+      (define-key sc-prefix-map "p" 'sc-visit-previous-revision)
+      (define-key sc-prefix-map "u" 'sc-revert-file)
+      (define-key sc-prefix-map "d" 'sc-list-registered-files)
+      (define-key sc-prefix-map "\C-d" 'sc-update-directory)
+      (define-key sc-prefix-map "\C-r" 'sc-rename-file)
+      ))
+
+
+;;; The user does not change these
+(defvar sc-generic-name ""
+  "Name of the source control system used.  Is displayed in the modeline.")
+
+(defvar sc-mode-line-string ()
+  "Revision number to show in the mode line")
+
+(defvar sc-generic-log-buf ()
+  "Buffer for entering log message")
+
+(defvar sc-log-entry-keymap ()
+  "Additional keybindings used when entering the log message")
+
+(defvar sc-can-hack-dir ()
+  "Does the SC system allow users to play directly with directories")
+
+(defvar sc-ccase-mfs-prefixes ()
+  "Prefixes known to the system to be MFS ... ignore all others")
+
+(defmacro sc-chmod (perms file)
+  (list 'call-process "chmod" nil nil nil perms file))
+
+(defmacro error-occurred (&rest body)
+  (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
+
+
+;;; User level functions
+(defun sc-next-operation (verbose)
+  "Do the next logical source-control operation on the file in the current buffer.
+The current subdirectory must be under source control.
+   If the file is not already registered with the source control, this registers it 
+and checks it out.
+   If the file is registered and not locked by anyone, this checks it out.
+   If the file is registered and locked by the calling user, this pops up a
+buffer for creation of a log message, then checks the file in.
+A read-only copy of the changed file is left in place afterwards.
+   If the file is registered and locked by someone else, an error message is
+returned indicating who has locked it."
+  (interactive "P")
+  (if (not buffer-file-name)
+      (error "There is no file associated with buffer %s" (buffer-name)))
+  (let* (revision
+	 (file buffer-file-name)
+	 (lock-info (sc-lock-info file))
+	 (sc-generic-log-buf
+	  (get-buffer-create (format "*%s-Log*" sc-generic-name))))
+    (if (eq lock-info 'na)
+	(error "The file associated with buffer %s is not registered" (buffer-name)))
+	
+    ;; if file is not registered register it and set lock-info to show it's not locked
+    (if (not lock-info)
+	(progn
+	  (sc-register-file verbose)
+	  (setq lock-info (list () ()))))
+	
+    (cond ((not (car lock-info))
+	   ;; if there is no lock on the file, assert one and get it
+	   (sc-check-out file t)
+	   (revert-buffer nil t)
+	   (sc-mode-line))
+	      
+	  ((and (not (equal sc-generic-name "CCase"))
+	       (not (equal (car lock-info) (user-login-name))))
+	   ;; file is locked by someone else
+	   (error "Sorry, %s has that file locked." (car lock-info)))
+
+	  (t 
+	   ;; OK, user owns the lock on the file 
+	   ;; if so, give user a chance to save before delta-ing.
+	   (if (and (buffer-modified-p)
+		    (or
+		     sc-mode-expert
+		     (y-or-n-p (format "%s has been modified. Write it out? "
+				       (buffer-name)))))
+	       (save-buffer))
+	       
+	   (setq revision (car (cdr lock-info)))
+	       
+	   ;; user may want to set nonstandard parameters
+	   (if verbose
+	       (if (or sc-mode-expert
+		       (y-or-n-p 
+			(format "revision: %s  Change revision level? "
+				revision)))
+		   (setq revision (read-string "New revision level: "))))
+	       
+	   ;; OK, let's do the delta
+	   (let ((buffer (sc-temp-buffer)))
+	     (if (save-window-excursion
+		   ;; this excursion returns t if the new version was saved OK
+		   (pop-to-buffer buffer)
+		   (erase-buffer)
+		   (set-buffer-modified-p nil)
+		   (sc-log-entry-mode)
+		   (message 
+		    "Enter log message. Type C-c C-c when done, C-c ? for help.")
+		   (prog1
+		       (and (not (error-occurred (recursive-edit)))
+			    (not (error-occurred
+				  (sc-check-in file revision
+					       (buffer-string)))))
+		     (setq buffer-file-name nil)
+		     (bury-buffer buffer)))
+		   
+		 ;; if the save went OK do some post-checking
+		 (if (buffer-modified-p)
+		     (error
+		      "Checked-in version of file does not match buffer!")
+		   (revert-buffer nil t)
+		   (sc-mode-line)
+		   (run-hooks 'sc-check-in-ok))))))))
+
+(defun sc-insert-last-log ()
+  "Insert the log message of the last check in at point."
+  (interactive)
+  (insert-buffer sc-generic-log-buf))
+
+(defun sc-abort-check-in ()
+  "Abort a source control check-in command."
+  (interactive)
+  (if (or sc-mode-expert (y-or-n-p "Really Abort Check-in? "))
+      (progn
+	(delete-window)
+	(abort-recursive-edit))))
+
+(defun sc-log-exit ()
+  "Proceed with checkin with the contents of the current buffer as message."
+  (interactive)
+  (if (< (buffer-size) sc-max-log-size)
+      (progn
+	(copy-to-buffer sc-generic-log-buf (point-min) (point-max))
+	(exit-recursive-edit)
+	(delete-window))
+    (goto-char sc-max-log-size)
+    (error
+     "Log must be less than %d characters. Point is now at char %d."
+     sc-max-log-size (point))))
+
+
+;;; Functions to look at the edit history
+(defun sc-show-changes (arg)
+  "Compare the version being edited with the last checked-in revision.
+With a prefix argument prompt for revision to compare with."
+  (interactive "P")
+  ;; check that the file is not modified
+  (if (and (buffer-modified-p)
+	   (or
+	    sc-mode-expert
+	    (y-or-n-p (format "%s has been modified. Write it out? "
+			      (buffer-name)))))
+      (save-buffer))
+  (let* ((revision (and arg (read-string "Revision to compare against: ")))
+	 (file buffer-file-name)
+	 (name (file-name-nondirectory file))
+	 (old (sc-get-version-in-temp-file file revision))
+	 (buffer (sc-temp-buffer))
+	 status)
+    (save-excursion
+      (set-buffer buffer)
+      (erase-buffer)
+      (setq default-directory (file-name-directory file))
+      (setq status
+	    (apply 'call-process (car sc-diff-command) () t ()
+		   (append (cdr sc-diff-command) (list old) (list file)))))
+    (if (not (or (eq 0 status) (eq 1 status))) ; see man diff.1
+	(progn
+	  (display-buffer buffer)
+	  (error "diff FAILED")))
+    (delete-file old)
+    (save-excursion
+      (set-buffer buffer)
+      (goto-char (point-min))
+      (if (equal (point-min) (point-max))
+	  (insert
+	   (format "No changes to %s since last update."
+		   (file-name-nondirectory file)))
+	(insert "==== Diffs for " file "\n")
+	(insert "==== ")
+	(mapcar '(lambda (i) (insert i " ")) sc-diff-command)
+	(insert name "<" (or revision "current") ">" " " name "\n\n")))
+    (display-buffer buffer)))
+
+(defun sc-show-revision-changes ()
+  "Prompt for a revision to diff against."
+  (interactive)
+  (sc-show-changes 4))
+
+(defun sc-version-diff-file (file rel1 rel2)
+  "For FILE, report diffs between two revisions REL1 and REL2 of it."
+  (interactive "fFile: \nsOlder version: \nsNewer version: ")
+  (if (string-equal rel1 "") (setq rel1 nil))
+  (if (string-equal rel2 "") (setq rel2 nil))
+  (let ((buffer (sc-temp-buffer)))
+    (set-buffer buffer)
+    (erase-buffer)
+    (let ((v1 (sc-get-version-in-temp-file file rel1))
+	  (v2 (if rel2 (sc-get-version-in-temp-file file rel2) file)))
+      (and v1
+	   v2
+	   (unwind-protect
+	       (apply 'call-process (car sc-diff-command) nil t t
+		      (append (cdr sc-diff-command) (list v1) (list v2)))))
+      (condition-case () (delete-file v1) (error nil))
+      (if rel2
+	  (condition-case () (delete-file v2) (error nil)))
+      (set-buffer-modified-p nil)
+      (goto-char (point-min))
+      (if (equal (point-min) (point-max))
+	  (message
+	   (format "No changes to %s between %s and %s." file rel1 rel2))
+	(display-buffer buffer)))))
+
+(defun sc-show-history ()
+  "List the edit history of the current buffer."
+  (interactive)
+  (let ((file buffer-file-name))
+    (if (not file)
+	(error "There is no file associated with buffer %s" (buffer-name)))
+    (if (not (sc-lock-info file))
+	(error "The file is not registered in the source control system"))
+    (let ((buffer (sc-temp-buffer)))
+      (save-excursion
+	(set-buffer buffer)
+	(erase-buffer)
+	(sc-history file)
+	(goto-char (point-min)))
+      (display-buffer buffer))))
+
+(defun sc-visit-previous-revision (revision)
+  "Show a previous revision of the current file"
+  (interactive "sShow previous revision number: ")
+  (let ((file buffer-file-name))
+    (if (not file)
+	(error "There is no file associated with buffer %s" (buffer-name)))
+    (let ((other-file (sc-get-version-in-temp-file file revision))
+	  (buffer-name (concat (file-name-nondirectory file)
+			       "<" sc-generic-name " " revision ">")))
+      (pop-to-buffer (get-buffer-create buffer-name))
+      (erase-buffer)
+      (insert-file other-file)
+      ;; get the same major mode as the original file
+      (setq buffer-file-name file)
+      (normal-mode)
+      (setq buffer-file-name ())
+      (set-buffer-modified-p ())
+      (toggle-read-only)
+      (delete-file other-file))))
+
+(defun sc-revert-file ()
+  "Revert the current buffer's file back to the last saved version."
+  (interactive)
+  (let ((file buffer-file-name))
+    (if (y-or-n-p (format "Revert file %s to last checked-in revision?" file))
+	(progn
+	  (sc-revert file)
+	  (revert-buffer nil t)
+	  (sc-mode-line)))))
+
+;; Functions to get directory level information
+
+(defun sc-list-all-locked-files (arg)
+  "List all files currently locked under the revision control system.
+With prefix arg list only the files locked by the user."
+  (interactive "P")
+  (let* ((locker (and arg (user-login-name)))
+	 (buffer (sc-tree-walk 'sc-list-file-if-locked locker)))
+    (save-excursion
+      (set-buffer buffer)
+      (goto-char (point-min))
+      (if (= (point-min) (point-max))
+	  (insert "No files locked ")
+	(insert "Files locked "))
+      (if locker
+	  (insert "by " locker " "))
+      (insert "in " default-directory "\n\n"))
+    (display-buffer buffer)))
+      
+(defun sc-list-locked-files ()
+  "List all files currently locked by me"
+  (interactive)
+  (sc-list-all-locked-files 4))
+
+(defun sc-list-registered-files ()
+  "List all files currently registered under the revision control system."
+  (interactive)
+  (let ((buffer (sc-tree-walk 'sc-list-file)))
+    (save-excursion
+      (set-buffer buffer)
+      (if (= (point-min) (point-max))
+	  (insert "No files registered in " sc-generic-name
+		  " in " default-directory)
+	(goto-char (point-min))
+	(insert "Files registered in " sc-generic-name " in " default-directory
+		"\n\n")))
+    (display-buffer buffer)))
+       
+(defun sc-update-directory ()
+  "Updates the current directory by getting the latest copies of the files"
+  (interactive)
+  (save-some-buffers)
+  (let ((buffer (sc-tree-walk 'sc-update-file)))
+    (save-excursion
+      (set-buffer buffer)
+      (goto-char (point-min))
+      (if (= (point-min) (point-max))
+	  (insert "No files needed to be updated in " default-directory "\n\n")
+	(insert "Files updated in " default-directory "\n\n")))
+    (display-buffer buffer)))
+
+;; Miscellaneous other entry points
+
+(defun sc-register-file (verbose)
+  "Register the file visited by the current buffer into source control.
+Prefix argument register it under an explicit revision number."
+  (interactive "P")
+  (let ((file buffer-file-name))
+    (if (not file)
+	(error "There is no file associated with buffer %s" (buffer-name)))
+    (let ((lock-info (sc-lock-info file))
+	  (revision ()))
+      (if lock-info
+	  (error "This file is already registered into %s" sc-generic-name))
+      ;; propose to save the file if it's modified
+      (if (and (buffer-modified-p)
+	       (or
+		sc-mode-expert
+		(y-or-n-p (format "%s has been modified. Write it out? "
+				  (buffer-name)))))
+	  (save-buffer))
+      ;; get the revision number
+      (if verbose
+	  (setq revision (read-string "Initial Revision Number: ")))
+      (sc-register file revision)
+      (revert-buffer nil t)
+      (sc-mode-line))))
+
+(defun sc-rename-file (old new)
+  "Rename a file, taking its source control archive with it."
+  (interactive "fOld name: \nFNew name: ")
+  (let ((owner (sc-locking-user old)))
+    (if (and owner (not (string-equal owner (user-login-name))))
+	(error "Sorry, %s has that file checked out" owner)))
+  (if sc-can-hack-dir
+      (rename-file old new t))
+  (sc-rename old new))
+
+(defun sc-rename-this-file (new)
+  "Rename the file of the current buffer, taking its source control archive with it"
+  (interactive "FNew name: ")
+  (if (and (buffer-modified-p)
+	   (y-or-n-p (format "%s has been modified. Write it out? "
+			     (buffer-name))))
+      (save-buffer))
+  (sc-rename-file buffer-file-name new)
+  (let ((old-buffer (current-buffer))
+	(new-buffer (find-file-noselect new)))
+    (set-window-buffer (selected-window) new-buffer)
+    (pop-to-buffer (current-buffer))
+    (bury-buffer old-buffer)))
+
+
+;;; Mode independent functions 
+;;; All those sc-... functions FUNCALL the corresponding sc-generic-... function.  
+;;; The variables are set to functions that do the SCCS, RCS or CVS commands 
+;;; depending on the mode chosen.
+
+(defvar sc-generic-lock-info ()
+  "Function to implement sc-lock-info")
+
+(defun sc-lock-info (file)
+  "Return a list of the current locker and current locked revision for FILE.
+Returns NIL if FILE is not registered in the source control system.
+Return (NIL NIL) if FILE is registered but not locked.
+Return (locker revision) if file is locked."
+  (funcall sc-generic-lock-info file))
+
+
+(defvar sc-generic-register ()
+  "Function to implement sc-register")
+
+(defun sc-register (file revision)
+  "Register FILE under source control with initial revision REVISION."
+  (funcall sc-generic-register file revision))
+
+
+(defvar sc-generic-check-out ()
+  "Function to implement sc-check-out")
+
+(defun sc-check-out (file lockp)
+  "Checks out the latest version of FILE.  
+If LOCKP is not NIL, FILE is also locked."
+  (funcall sc-generic-check-out file lockp))
+
+
+(defvar sc-generic-get-version ()
+  "Function to implement sc-get-version")
+
+(defun sc-get-version (file buffer revision)
+  "Insert a previous revison of FILE in BUFFER.  
+REVISION is the revision number requested."
+  (funcall sc-generic-get-version file buffer revision))
+
+
+(defvar sc-generic-check-in ()
+  "Function to implement sc-check-in")
+
+(defun sc-check-in (file revision message)
+  "Check in FILE with revision REVISION.
+MESSAGE is a string describing the changes."
+  (funcall sc-generic-check-in file revision message))
+
+
+(defvar sc-generic-history ()
+  "Function to implement sc-history")
+
+(defun sc-history (file)
+  "Insert the edit history of FILE in the current buffer."
+  (funcall sc-generic-history file))
+
+
+(defvar sc-generic-tree-list ()
+  "Function to implement sc-tree-list")
+
+(defun sc-tree-list ()
+  "List in the current buffer the files registered in the source control system"
+  (funcall sc-generic-tree-list))
+  
+
+(defvar sc-generic-new-revision-p ()
+  "Function to implement sc-new-revision-p")
+
+(defun sc-new-revision-p (file)
+  "True if a new revision of FILE was checked in since we last got a copy of it"
+  (funcall sc-generic-new-revision-p file))
+
+
+(defvar sc-generic-revert ()
+  "Function to implement sc-revert")
+
+(defun sc-revert (file)
+  "Cancel a check out of FILE and get back the latest checked in version"
+  (funcall sc-generic-revert file))
+
+
+(defvar sc-generic-rename ()
+  "Function to implement sc-rename")
+
+(defun sc-rename (old new)
+  "Rename the source control archives for OLD to NEW"
+  (funcall sc-generic-rename old new))
+
+
+(defvar sc-menu ()
+  "Menu to use")
+  
+
+;;; Utilities functions
+(defun sc-do-command (buffer message command file sc-file &rest flags)
+  "Execute a command, notifying the user and checking for errors."
+  (setq file (expand-file-name file))
+  (message "Running %s on %s..." message file)
+  (let ((status
+	 (save-excursion
+	   (set-buffer (get-buffer-create buffer))
+	   (erase-buffer)
+	   (setq flags (append flags (and file (list sc-file))))
+	   (setq flags (delq () flags))
+	   (let ((default-directory (file-name-directory (or file "./"))))
+	     (eq (apply 'call-process command nil t nil flags) 0)))))
+    (if status
+	(message "Running %s...OK" message)
+      (save-excursion
+	(set-buffer buffer)
+	(goto-char (point-min))
+	(insert command)
+	(mapcar '(lambda (i) (insert " " i)) flags)
+	(insert "\n\n")
+	(goto-char (point-min)))
+      (display-buffer buffer)
+      (error "Running %s...FAILED" message))))
+
+(defun sc-enter-comment ()
+  "Enter a comment. Return it as a string."
+  (let ((buffer (sc-temp-buffer)))
+    (setq sc-generic-log-buf
+	  (get-buffer-create (format "*%s-Log*" sc-generic-name)))
+    (save-window-excursion
+      ;; this excursion returns t if the new version was saved OK
+      (pop-to-buffer buffer)
+      (erase-buffer)
+      (set-buffer-modified-p nil)
+      (sc-log-entry-mode)
+      (message 
+	   "Enter log message. Type C-c C-c when done, C-c ? for help.")
+      (prog1
+	  (and (not (error-occurred (recursive-edit)))
+	       (let ((bs (buffer-string)))
+		 (if (> (length bs) 0) bs)))
+	(setq buffer-file-name nil)
+	(bury-buffer buffer)))))
+
+(defun sc-locking-user (file)
+  "Return the login name of the locker of FILE.  Return nil if FILE is not locked"
+  (car (sc-lock-info file)))
+
+(defun sc-locked-revision (file)
+  "Return the revision number currently locked for FILE, nil if FILE is not locked."
+  (car (cdr (sc-lock-info file))))
+
+(defun sc-mode-line ()
+  "Set the mode line for the current buffer.
+FILE is the file being visited."
+  (let* ((file buffer-file-name)
+	 (lock-info (sc-lock-info file)))
+    ;; ensure that the global mode string is not NIL
+    (or global-mode-string (setq global-mode-string '("")))
+    ;; ensure that our variable is in the global-mode-string
+    (or (memq 'sc-mode-line-string global-mode-string)
+	(setq global-mode-string
+	      (append global-mode-string '(sc-mode-line-string))))
+    (make-local-variable 'sc-mode-line-string)
+    (setq sc-mode-line-string
+	  (cond ((or
+		  (eq lock-info 'na)
+		  (null lock-info))     ())
+		((null (car lock-info))
+		 (format " <%s:>" sc-generic-name))
+		((equal (car lock-info) (user-login-name))
+		 (format " <%s: %s>" sc-generic-name (car (cdr lock-info))))
+		(t
+		 (format " <%s: %s>" sc-generic-name (car lock-info)))))))
+
+(defun sc-temp-buffer ()
+  "Return a temporary buffer to use for output"
+  (get-buffer-create (format "*%s*" sc-generic-name)))
+
+(defun sc-tree-walk (func &rest args)
+  "Apply FUNC to the files registered in the source control system.
+FUNC is passed the file path and ARGS."
+  (let* ((buffer-name (format "*%s directory*" sc-generic-name))
+	 (buffer (get-buffer-create buffer-name))
+	 (dir default-directory)
+	 files)
+    ;; recreate the directory buffer in the right directory
+    (save-excursion
+      (set-buffer buffer)
+      (erase-buffer)
+      (setq default-directory dir)
+      ;; get a list of all the registered files
+      (sc-tree-list)
+      ;; remove the "not found" messages
+      (goto-char (point-min))
+      (while (search-forward "not found" () t)
+	(beginning-of-line 1)
+	(kill-line 1))
+      ;; check if any file is listed
+      (if (= (point-min) (point-max))
+	  (error "No registered files under %s" default-directory))
+      ;; build the list of files
+      (goto-char (point-min))
+      (setq files ())
+      (while (not (eobp))
+	(let ((file
+	       (buffer-substring (point) (progn (end-of-line) (point)))))
+	  (setq files (cons file files)))
+	(forward-line 1))
+      (setq files (nreverse files))
+      ;; let the function output information in the buffer
+      (erase-buffer))
+    (display-buffer buffer)
+    ;; apply the function
+    (save-excursion
+      (set-buffer buffer)
+      (while files
+	(apply func (car files) args)
+	(setq files (cdr files)))
+      buffer)))
+  
+(defun sc-get-version-in-temp-file (file revision)
+  "For the given FILE, retrieve a copy of the version with given REVISION.
+The text is retrieved into a tempfile.  Return the tempfile name."
+  (let* ((oldversion
+	  (make-temp-name
+	   (concat (or (ccase-protect-expanded-name revision) "current")
+		   "-"
+		   (file-name-nondirectory file)
+		   "-")))
+	 (vbuf (get-buffer-create oldversion)))
+    (sc-get-version file vbuf revision)
+    (save-excursion
+      (set-buffer vbuf)
+      (write-region (point-min) (point-max) oldversion t 0))
+    (kill-buffer vbuf)
+    (sc-chmod "-w" oldversion)
+    oldversion))
+
+;; Functions used to get directory level information
+
+(defun sc-insert-file-lock-info (file lock-info)
+  (insert (car lock-info) ":" (car (cdr lock-info)))
+  (indent-to-column 16 1)
+  (insert (file-name-nondirectory file) "\n"))
+  
+(defun sc-list-file-if-locked (file &optional arg)
+   "List all files underneath the current directory matching a prefix type."
+   (let ((lock-info (sc-lock-info file)))
+     (if (and lock-info
+	      (car lock-info)
+	      (or (null arg) (equal arg (car lock-info))))
+	 (progn
+	   (sc-insert-file-lock-info file lock-info)
+	   (sit-for 0)))))
+
+(defun sc-list-file (file)
+  (let ((lock-info (sc-lock-info file)))
+    (cond ((eq lock-info 'na)
+	   (indent-to-column 16 1)
+	   (insert (file-name-nondirectory file) "\n"))
+	  ((car lock-info)
+	   (sc-insert-file-lock-info file lock-info))
+	  ((sc-new-revision-p file)
+	   (insert "needs update")
+	   (indent-to-column 16 1)
+	   (insert (file-name-nondirectory file) "\n"))
+	  (t
+	   (indent-to-column 16 1)
+	   (insert (file-name-nondirectory file) "\n")))
+    (sit-for 0)))
+
+;;; Function to update one file from the archive
+(defun sc-update-file (file)
+  "get the latest version of the file if a new one was checked-in"
+  (if (sc-new-revision-p file)
+      (let ((file-name (file-name-nondirectory file)))
+	;; get the latest copy
+	(rename-file (sc-get-version-in-temp-file file nil) file t)
+	(let ((b (get-file-buffer file)))
+	  (if b
+	      (save-excursion
+		(set-buffer b)
+		(revert-buffer nil t)
+		(sc-mode-line))))
+	;; show the file was updated
+	(insert "updated")
+	(indent-to-column 16 1)
+	(insert file-name "\n")
+	(sit-for 0))))
+
+;; Set up key bindings for use while editing log messages
+
+(if sc-log-entry-keymap
+    nil
+  (setq sc-log-entry-keymap (make-sparse-keymap))
+  (define-key sc-log-entry-keymap "\C-ci" 'sc-insert-last-log)
+  (define-key sc-log-entry-keymap "\C-c\C-i" 'sc-insert-last-log)
+  (define-key sc-log-entry-keymap "\C-ca" 'sc-abort-check-in)
+  (define-key sc-log-entry-keymap "\C-c\C-a" 'sc-abort-check-in)
+  (define-key sc-log-entry-keymap "\C-c\C-c" 'sc-log-exit)
+  (define-key sc-log-entry-keymap "\C-x\C-s" 'sc-log-exit))
+
+(defvar sc-mode-hook nil
+  "*Function or functions to run on entry to sc-mode.")
+
+(defvar sc-mode ()
+  "The currently active source control mode.  Use M-x sc-mode to set it")
+
+;;;###autoload
+(defun sc-mode (system)
+  "Toggle sc-mode.
+SYSTEM can be sccs, rcs or cvs.
+Cvs requires the pcl-cvs package.
+
+The following commands are available
+\\[sc-next-operation]	perform next logical source control operation on current file
+\\[sc-show-changes]	compare the version being edited with an older one
+\\[sc-version-diff-file]	compare two older versions of a file
+\\[sc-show-history]		display change history of current file
+\\[sc-visit-previous-revision]	display an older revision of current file
+\\[sc-revert-file]		revert buffer to last checked-in version
+\\[sc-list-all-locked-files]		show all files locked in current directory
+\\[sc-list-locked-files]		show all files locked by you in current directory
+\\[sc-list-registered-files]		show all files under source control in current directory
+\\[sc-update-directory]		get fresh copies of files checked-in by others in current directory
+\\[sc-rename-file]		rename the current file and its source control file
+
+
+While you are entering a change log message for a check in, sc-log-entry-mode
+will be in effect.
+
+Global user options:
+    sc-diff-command	A list consisting of the command and flags
+			to be used for generating context diffs.
+    sc-mode-expert	suppresses some conformation prompts,
+			notably for delta aborts and file saves.
+    sc-max-log-size	specifies the maximum allowable size
+			of a log message plus one.
+
+
+When using SCCS you have additional commands and options
+
+\\[sccs-insert-headers]		insert source control headers in current file
+
+When you generate headers into a buffer using \\[sccs-insert-headers],
+the value of sc-insert-headers-hook is called before insertion. If the
+file is recognized a C or Lisp source, sc-insert-c-header-hook or
+sc-insert-lisp-header-hook is called after insertion respectively.
+
+    sccs-headers-wanted	which %-keywords to insert when adding
+			headers with C-c h
+    sccs-insert-static	if non-nil, keywords inserted in C files
+			get stuffed in a static string area so that
+			what(1) can see them in the compiled object code.
+
+When using CVS you have additional commands
+
+\\[sc-cvs-update-directory]	update the current directory using pcl-cvs
+\\[sc-cvs-file-status]		show the CVS status of current file
+"
+  (interactive
+   (if sc-mode
+       '(())
+     (list
+      (intern
+	(read-string "Turn on source control mode on for: " "SCCS")))))
+  (cond ((eq system ())
+	 (remove-hook 'find-file-hooks 'sc-mode-line)
+	 (delete-menu-item (list sc-generic-name))
+	 (remove-hook 'activate-menubar-hook 'sc-sensitize-menu)
+	 (setq sc-mode ()))
+	(sc-mode
+	 (sc-mode ())
+	 (sc-mode system))
+	(t
+	 (setq system (intern (upcase (symbol-name system))))
+	 (let ((f (intern (format "sc-set-%s-mode" system))))
+	   (if (not (fboundp f))
+	       (error
+		"No source control interface for \"%s\".  \
+Please use SCCS, RCS, CVS, or Atria."
+		system)
+	     (funcall f)
+	     (add-hook 'find-file-hooks 'sc-mode-line)
+	     (add-submenu '() (cons sc-generic-name sc-menu))
+	     (add-hook 'activate-menubar-hook 'sc-sensitize-menu)
+	     (run-hooks 'sc-mode-hook)
+	     (setq sc-mode system))))))
+
+(defun sc-log-entry-mode ()
+  "Major mode for editing log message.
+
+These bindings are available when entering the log message
+\\[sc-log-exit]		proceed with check in, ending log message entry
+\\[sc-insert-last-log]		insert log message from last check-in
+\\[sc-abort-check-in]		abort this check-in
+
+Entry to the change-log submode calls the value of text-mode-hook, then
+the value sc-log-entry-mode-hook.
+"
+  (interactive)
+  (set-syntax-table text-mode-syntax-table)
+  (use-local-map sc-log-entry-keymap)
+  (setq local-abbrev-table text-mode-abbrev-table)
+  (setq major-mode 'sc-log-entry-mode)
+  (setq mode-name "Source Control Change Log Entry")
+  (run-hooks 'text-mode-hook 'sc-log-entry-mode-hook))
+
+
+
+;;; SCCS specific part
+
+;; Find a reasonable default for the SCCS bin directory
+(defvar sccs-bin-directory
+  (cond ((file-executable-p "/usr/sccs/unget") "/usr/sccs")
+	((file-executable-p "/usr/bin/unget") "/usr/bin")
+	((file-directory-p "/usr/sccs") "/usr/sccs")
+	((file-directory-p "/usr/bin/sccs") "/usr/bin/sccs")
+	(t "/usr/bin"))
+  "*Directory where to find the sccs executables")
+
+(defvar sccs-headers-wanted '("\%\W\%")
+  "*SCCS header keywords to be inserted when sccs-insert-header is executed.")
+
+(defvar sccs-insert-static t
+  "*Insert a static character string when inserting source control headers in C mode.
+Only relevant for the SCCS mode.")
+
+;; Vars the user doesn't need to know about.
+
+(defvar sccs-log-entry-mode nil)
+(defvar sccs-current-major-version nil)
+
+;; Some helper functions
+
+(defun sccs-name (file &optional letter)
+  "Return the sccs-file name corresponding to a given file."
+  (if (null file)
+      ()
+    (let ((expanded-file (expand-file-name file)))
+      (format "%sSCCS/%s.%s"
+	      (concat (file-name-directory expanded-file))
+	      (or letter "s")
+	      (concat (file-name-nondirectory expanded-file))))))
+
+(defun sccs-lock-info (file)
+  "Lock-info method for SCCS.  See sc-generic-lock-info"
+  (let ((sccs-file (sccs-name file "s"))
+	(lock-file (sccs-name file "p")))
+    (cond ((or (null file) (not (file-exists-p sccs-file)))
+	   ())
+	  ((not (file-exists-p lock-file))
+	   (list () ()))
+	  (t
+	   (save-excursion
+	     (set-buffer (get-buffer-create "*SCCS tmp*"))
+	     (insert-file lock-file)
+	     (while (search-forward " " () t)
+	       (replace-match "\n" () t))
+	     (goto-char (point-min))
+	     (forward-line 1)
+	     (let ((revision
+		    (buffer-substring (point) (progn (end-of-line) (point))))
+		   (name
+		    (progn (forward-line 1)
+			   (buffer-substring (point)
+					     (progn (end-of-line) (point))))))
+	       (kill-buffer (current-buffer))
+	       (list name revision)))))))
+
+
+(defun sccs-do-command (buffer command file &rest flags)
+  "Execute an SCCS command, notifying the user and checking for errors."
+  (let ((exec-path (cons sccs-bin-directory exec-path)))
+    (apply 'sc-do-command buffer command command file (sccs-name file) flags)))
+
+(defun sccs-admin (file sid)
+  "Checks a file into sccs.
+FILE is the unmodified name of the file.  SID should be the base-level sid to
+check it in under."
+  ;; give a change to save the file if it's modified
+  (if (and (buffer-modified-p)
+	   (y-or-n-p (format "%s has been modified. Write it out? "
+			     (buffer-name))))
+      (save-buffer))
+  (sccs-do-command "*SCCS*" "admin" file
+		   (concat "-i" file) (concat "-r" sid))
+  (sc-chmod "-w" file)
+  ;; expand SCCS headers
+  (sccs-check-out file nil))
+
+(defun sccs-register (file revision)
+  (sccs-load-vars)
+  (if (and (not (file-exists-p "SCCS"))
+	   (y-or-n-p "Directory SCCS does not exist, create it?"))
+      (make-directory "SCCS"))
+  (sccs-admin file
+	      (cond 
+	       (revision revision)
+	       ((error-occurred (load-file "SCCS/emacs-vars.el")) "1")
+	       (t sccs-current-major-version))))
+
+(defun sccs-check-out (file lockp)
+  "Retrieve a copy of the latest version of the given file."
+  (sccs-do-command "*SCCS*" "get" file (if lockp "-e")))
+
+(defun sccs-get-version (file buffer revision)
+  (sccs-do-command buffer "get" file
+		   (and revision (concat "-r" revision))
+		   "-p" "-s"))
+
+(defun sccs-check-in (file revision comment)
+  "Check-in a given version of the given file with the given comment."
+  (sccs-do-command "*SCCS*" "delta" file "-n"
+		   (format "-r%s" revision)
+		   (format "-y%s" comment))
+  (sc-chmod "-w" file)
+  ;; sccs-delta already turned off write-privileges on the
+  ;; file, let's not re-fetch it unless there's something
+  ;; in it that get would expand
+  (save-excursion
+    (let ((buffer (get-file-buffer file)))
+      (if buffer
+	  (progn
+	    (set-buffer buffer)
+	    (sccs-check-out file nil))))))
+
+(defun sccs-history (file)
+  (sccs-do-command (current-buffer) "prs" file))
+
+;; There has *got* to be a better way to do this...
+
+(defun sccs-save-vars (sid)
+  (save-excursion
+    (find-file "SCCS/emacs-vars.el")
+    (erase-buffer)
+    (insert "(setq sccs-current-major-version \"" sid "\")")
+    (basic-save-buffer)))
+
+(defun sccs-load-vars ()
+  (if (error-occurred (load-file "SCCS/emacs-vars.el"))
+      (setq sccs-current-major-version "1")))
+
+;; SCCS header insertion code
+
+(defun sccs-insert-headers ()
+  "*Insert headers for use with the Source Code Control System.
+Headers desired are inserted at the start of the buffer, and are pulled from 
+the variable sccs-headers-wanted"
+  (interactive)
+  (save-excursion
+    (save-restriction
+      (widen)
+      (if (or (not (sccs-check-headers))
+	      (y-or-n-p "SCCS headers already exist.  Insert another set?"))
+	  (progn
+	     (goto-char (point-min))
+	     (run-hooks 'sccs-insert-headers-hook)
+	     (cond ((eq major-mode 'c-mode) (sccs-insert-c-header))
+		   ((eq major-mode 'lisp-mode) (sccs-insert-lisp-header))
+		   ((eq major-mode 'emacs-lisp-mode) (sccs-insert-lisp-header))
+		   ((eq major-mode 'scheme-mode) (sccs-insert-lisp-header))
+		   ((eq major-mode 'nroff-mode) (sccs-insert-nroff-header))
+		   ((eq major-mode 'plain-tex-mode) (sccs-insert-tex-header))
+		   ((eq major-mode 'texinfo-mode) (sccs-insert-texinfo-header))
+		   (t (sccs-insert-generic-header))))))))
+
+
+
+(defun sccs-insert-c-header ()
+  (insert "/*\n")
+  (mapcar '(lambda (s)
+	     (insert " *\t" s "\n"))
+	  sccs-headers-wanted)
+  (insert " */\n\n")
+  (if (and sccs-insert-static 
+	   (not (string-match "\\.h$" buffer-file-name)))
+      (progn
+	(insert "#ifndef lint\n"
+		"static char *sccsid")
+;;	(setq st (point))
+;;	(insert (file-name-nondirectory buffer-file-name))
+;;	(setq en (point))
+;;	(subst-char-in-region st en ?. ?_)
+	(insert " = \"\%\W\%\";\n"
+		"#endif /* lint */\n\n")))
+  (run-hooks 'sccs-insert-c-header-hook))
+
+(defun sccs-insert-lisp-header ()
+  (mapcar '(lambda (s) 
+		  (insert ";;;\t" s "\n"))
+	  sccs-headers-wanted)
+  (insert "\n")
+  (run-hooks 'sccs-insert-lisp-header-hook))
+
+(defun sccs-insert-nroff-header ()
+  (mapcar '(lambda (s) 
+		  (insert ".\\\"\t" s "\n"))
+	  sccs-headers-wanted)
+  (insert "\n")
+  (run-hooks 'sccs-insert-nroff-header-hook))
+
+(defun sccs-insert-tex-header ()
+  (mapcar '(lambda (s) 
+		  (insert "%%\t" s "\n"))
+	  sccs-headers-wanted)
+  (insert "\n")
+  (run-hooks 'sccs-insert-tex-header-hook))
+
+(defun sccs-insert-texinfo-header ()
+  (mapcar '(lambda (s) 
+		  (insert "@comment\t" s "\n"))
+	  sccs-headers-wanted)
+  (insert "\n")
+  (run-hooks 'sccs-insert-texinfo-header-hook))
+
+(defun sccs-insert-generic-header ()
+  (let* ((comment-start-sccs (or comment-start "#"))
+	 (comment-end-sccs (or comment-end ""))
+	 (dont-insert-nl-p (string-match "\n" comment-end-sccs)))
+    (mapcar '(lambda (s)
+	       (insert comment-start-sccs "\t" s ""
+		       comment-end-sccs (if dont-insert-nl-p "" "\n")))
+	  sccs-headers-wanted)
+  (insert comment-start-sccs comment-end-sccs (if dont-insert-nl-p "" "\n"))))
+
+(defun sccs-check-headers ()
+  "Check if the current file has any SCCS headers in it."
+  (save-excursion
+    (goto-char (point-min))
+    (let ((case-fold-search ()))
+      (re-search-forward  "%[MIRLBSDHTEGUYFPQCZWA]%" (point-max) t))))
+
+(defun sccs-tree-list ()
+  "List all the registered files in the current directory"
+  (call-process "/bin/sh" () t () "-c"
+		(concat "/bin/ls -1 " default-directory "SCCS/s.*"))
+  (goto-char (point-min))
+  (while (search-forward "SCCS/s." () t)
+    (replace-match "" () t)))
+
+(defun sccs-new-revision-p (file)
+  "True if the SCCS archive is more recent than the file itself"
+  (file-newer-than-file-p (sccs-name file) file))
+
+(defun sccs-revert (file)
+  "Cancel a check-out and get a fresh copy of the file"
+  (delete-file (sccs-name file "p"))
+  (delete-file file)
+  (sccs-do-command "*SCCS*" "get" file "-s"))
+
+(defun sccs-rename (old new)
+  "Rename the SCCS archives for OLD to NEW"
+  (if (file-exists-p (sccs-name old "p"))
+      (rename-file (sccs-name old "p") (sccs-name new "p") t))
+  (if (file-exists-p (sccs-name old "s"))
+      (rename-file (sccs-name old "s") (sccs-name new "s") t)))
+
+
+;;; RCS specific part
+
+;; Some helper functions
+
+(defun rcs-name (file)
+  "Return the rcs-file corresponding to a given file."
+  (if (null file)
+      ()
+    (let* ((name (expand-file-name file))
+	   (rcs-file (concat name ",v")))
+      (if (and (not (file-exists-p rcs-file))
+	       (file-exists-p (concat (file-name-directory name) "RCS")))
+	  (setq rcs-file 
+		(format "%sRCS/%s,v" (file-name-directory name)
+			(file-name-nondirectory name))))
+      rcs-file)))
+
+(defun rcs-lock-info (file)
+  "Lock-info method for RCS.  See sc-generic-lock-info"
+  (let ((rcs-file (rcs-name file))
+	locks-regexp)
+    (if (or (null rcs-file) (not (file-exists-p rcs-file)))
+	()
+      (save-excursion
+	(set-buffer (get-buffer-create "*RCS tmp*"))
+	(erase-buffer)
+	(call-process "rlog" () t () "-L" "-h" rcs-file)
+	(goto-char (point-min))
+	(if (looking-at "\n.*Working file")
+	    ;; RCS 4.x
+	    (setq locks-regexp "^locks:")
+	  ;; RCS 5.x
+	  (setq locks-regexp "^locks:.*$\n"))
+	(if (not (re-search-forward locks-regexp () t))
+	    (list () ())
+	  (if (not (looking-at (concat "[\t ]*\\([^:]*\\): \\([0-9\\.]*\\)")))
+	      (list () ())
+	    (list (buffer-substring (match-beginning 1) (match-end 1))
+		  (buffer-substring (match-beginning 2) (match-end 2)))))))))
+
+
+(defun rcs-register (file revision)
+  (if (and (not (file-exists-p "RCS"))
+	   (y-or-n-p "Directory RCS does not exist, create it?"))
+      (make-directory "RCS"))
+  (sc-do-command "*RCS*" "ci" "ci" file (rcs-name file) "-u"))
+
+(defun rcs-check-out (file lockp)
+  (sc-do-command "*RCS*" "co" "co" file (rcs-name file) (if lockp "-l")))
+
+(defun rcs-get-version (file buffer revision)
+  (sc-do-command buffer "co" "co" file (rcs-name file)
+		 (if revision (concat "-p" revision) "-p")
+		 "-q"))
+
+(defun rcs-check-in (file revision comment)
+  "Check-in a given version of the given file with the given comment."
+  (sc-do-command "*RCS*" "ci" "ci" file (rcs-name file) "-f"
+		 (format "-m%s" comment)
+		 (if (equal revision (sc-locked-revision file))
+		     "-u"
+		   (format "-u%s" revision))))
+
+(defun rcs-history (file)
+  (sc-do-command (current-buffer) "rlog" "rlog" file (rcs-name file)))
+
+(defun rcs-tree-list ()
+  "List all the registered files in the current directory"
+  (call-process "/bin/sh" () t () "-c"
+		(concat "/bin/ls -1 " default-directory "RCS/*,v"))
+  (call-process "/bin/sh" () t () "-c"
+		(concat "/bin/ls -1 " default-directory "*,v"))
+  (goto-char (point-min))
+  (while (search-forward "RCS/" () t)
+    (replace-match "" () t))
+  (goto-char (point-min))
+  (while (search-forward ",v" () t)
+    (replace-match "" () t)))
+
+(defun rcs-new-revision-p (file)
+  "True if the archive is more recent than the file itself"
+  (file-newer-than-file-p (rcs-name file) file))
+
+(defun rcs-revert (file)
+  "Cancel a check-out and get a fresh copy of the file"
+  (sc-do-command "*RCS*" "rcs" "rcs" file (rcs-name file) "-u")
+  (delete-file file)
+  (sc-do-command "*RCS*" "co" "co" file (rcs-name file)))
+
+(defun rcs-rename (old new)
+  "Rename the archives for OLD to NEW"
+  (if (file-exists-p (rcs-name old))
+      (rename-file (rcs-name old) (rcs-name new) t)))
+
+
+;;; CVS specific part
+
+;;; As we rely on pcl-cvs for the directory level functions the menu is
+;;; much shorter in CVS mode
+
+
+(defun cvs-lock-info (file)
+  "Lock-info method for CVS, different from RCS and SCCS modes.
+File are never locked in CVS."
+  (list () ()))
+
+(defun cvs-register (file revision)
+  (sc-do-command "*CVS*" "cvs add" cvs-program file
+		 (file-name-nondirectory file)
+		 "add" "-mInitial revision"))
+
+(defun cvs-check-out (file lockp)
+  )
+
+(defun cvs-get-version (file buffer revision)
+  (sc-do-command buffer "cvs update" cvs-program file file "update" 
+		 (if revision (concat "-r" revision))
+		 "-p" "-q"))
+
+(defun cvs-check-in (file revision comment)
+  "Check-in a given version of the given file with the given comment."
+  (sc-do-command "*CVS*" "cvs commit" cvs-program file file "commit"
+		 (and revision (format "-r%s" revision))
+		 (format "-m%s" comment)))
+
+(defun cvs-history (file)
+  (sc-do-command (current-buffer) "cvs log" cvs-program file file "log"))
+
+(defun cvs-revert (file)
+  "Cancel a check-out and get a fresh copy of the file"
+  (delete-file file)
+  (sc-do-command "*CVS*" "cvs update" cvs-program file file "update"))
+
+(defun sc-cvs-update-directory ()
+  "Update the current directory by calling cvs-update from pcl-cvs"
+  (interactive)
+  (cvs-update default-directory))
+
+(defun sc-cvs-file-status ()
+  "Show the CVS status of the current file"
+  (interactive)
+  (if (not buffer-file-name)
+      (error "There is no file associated with buffer %s" (buffer-name)))
+  (let ((file buffer-file-name))
+    (sc-do-command "*CVS*" "cvs status" cvs-program file file "status" "-v"))
+  (save-excursion
+    (set-buffer "*CVS*")
+    (goto-char (point-min)))
+  (display-buffer "*CVS*"))
+
+
+;;; ClearCase specific part
+
+(defun ccase-is-registered-3 (fod)
+  (if (or (not fod)
+	  (not (file-readable-p fod)))
+      'na
+    (let ((dirs sc-ccase-mfs-prefixes)
+	  (f nil)
+	  (file (expand-file-name fod)))
+      (while (and (null f) dirs)
+	(if (string-match (car dirs) file)
+	    (setq f t)
+	  (setq dirs (cdr dirs))))
+      (if (null f)
+	  'na
+	(sc-do-command "*CCase*" "describe" "cleartool" fod fod "describe")
+	(save-excursion
+	  (set-buffer "*CCase*")
+	  (let ((s (buffer-string)))
+	    (cond
+	     ((string-match "@@" s) t)
+	     ((string-match "^Unix" s) 'na)
+	     (t nil)
+	     )))))))
+
+(defun ccase-is-registered (fod)
+  (eq (ccase-is-registered-3 fod) t))
+
+(defun ccase-lock-info (file)
+  (let ((cc (ccase-is-registered-3 file))
+	s)
+    (if (eq cc 't)
+	(progn
+	  (save-excursion
+	    (set-buffer "*CCase*")
+	    (setq s (buffer-string)))
+	  (if (string-match "@@[^\n]*CHECKEDOUT\" from \\([^ ]*\\)[^\n]*\n[^\n]* by \\([^(\n]*\\) (" s)
+	      (list
+	       (substring s (match-beginning 1) (match-end 1))
+	       (substring s (match-beginning 2) (match-end 2)))
+	    (list nil nil)))
+      cc)))
+
+(defun ccase-maybe-comment (tag)
+  (if (memq tag sc-ccase-comment-on)
+      (sc-enter-comment)))
+
+(defun ccase-register (file revision)
+  "Registers the file. We don't support the revision argument.
+Also, we have to checkout the directory first."
+  ;; probably need proper error handling to catch the 
+  ;; cases where we co the directory, but don't get to
+  ;; ci it back (want to uco in this case)
+  (let ((dpath (file-name-directory file)))
+    (if (not (ccase-is-registered dpath))
+	(error "Cannot register file outside of VOB")
+      (sc-do-command "*CCase*" "co - dir" "cleartool" dpath dpath "co")
+      (sc-do-command "*CCase*" "register" "cleartool" file file "mkelem")
+      (sc-do-command "*CCase*" "ci - dir" "cleartool" dpath dpath "ci"))))
+
+(defun ccase-check-out (file lockp)
+  "Checks out the latest version of FILE.  
+If LOCKP is not NIL, FILE is also locked."
+  (let ((comment (ccase-maybe-comment 'checkout)))
+    (sc-do-command "*CCase*" "co" "cleartool" file file "co"
+		   (if comment "-c" "-nc")
+		   (if comment comment)
+  ;; this locking does not correspond to what we actually want. It's a
+  ;; hack from the days when this was SCCS-only
+		   (if (ccase-reserve-p) "-res" "-unr"))
+))
+
+(defun ccase-reserve-p ()
+  "Determine whether the user wants a reserved or unreserved checkout"
+  (cond
+   ((eq sc-ccase-reserve t)   t)
+   ((eq sc-ccase-reserve nil) nil)
+   (t (y-or-n-p "Reserve Checkout? "))))
+   
+(defun ccase-get-version (file buffer revision)
+  "Insert a previous revison of FILE in BUFFER.  
+REVISION is the revision number requested."
+  (save-excursion
+    (set-buffer buffer)
+    (delete-region (point-min) (point-max))
+    (insert-file-contents (concat file "@@/" revision)))
+)
+
+(defun ccase-check-in (file revision message)
+  "Check in FILE with revision REVISION.
+MESSAGE is a string describing the changes."
+  ;; we ignore revision since we can't use it
+  (sc-do-command "*CCase*" "ci" "cleartool" file file "ci" "-c" message (if sc-mode-expert "-ide"))
+)
+
+(defun ccase-history (file)
+  "Insert the edit history of FILE in the current buffer."
+  (sc-do-command (buffer-name) "history" "cleartool" file file "lsh")
+)
+
+(defun ccase-tree-list ()
+  "List in the current buffer the files registered in the source control system"
+  ;;; This isn't going to fly as a practicality. We abstract everything out.
+  ;;  (sc-do-command (buffer-name) "listing" "cleartool" (default-directory) (default-directory) "ls" "-r" "-short" "-vis" "-nxname")
+)
+  
+(defun ccase-new-revision-p (file)
+  "True if a new revision of FILE was checked in since we last got a copy of it"
+  (save-excursion
+  (let (newfile res br1 br2)
+    (sc-do-command "*CCase*" "Describe" "cleartool" file file "des")
+    (set-buffer "*CCase*")
+    (goto-char (point-min))
+    (if (setq pos (search-forward-regexp "@@\\([^ \"]*\\)CHECKEDOUT\" from \\([^ ]*\\) (\\([a-z]*\\))" nil t))
+;;    (if (setq pos (search-forward-regexp "@@\\([^ \"]*\\)CHECKEDOUT\"" nil t))
+	(progn
+	  (setq res (buffer-substring (match-beginning 3) (match-end 3)))
+	  (if (equal res "unreserved")
+	      (progn
+		(setq newfile (concat file "@@"
+				      (buffer-substring (match-beginning 1)
+							(match-end 1))
+				      "LATEST"))
+		(setq br1 (buffer-substring (match-beginning 2) (match-end 2)))
+		(sc-do-command "*CCase*" "Describe" "cleartool" file newfile
+			       "des")
+		(search-forward-regexp "@@\\([^ \"]*\\)" nil t)
+		(setq br2 (buffer-substring (match-beginning 1) (match-end 1)))
+		(not (equal br1 br2)))
+	    nil))
+      (error "%s not currently checked out" file)))))
+
+(defun ccase-revert (file)
+  "Cancel a check out of FILE and get back the latest checked in version"
+  (sc-do-command "*CCase*" "uco" "cleartool" file file "unco")
+)
+
+(defun ccase-rename (old new)
+  "Rename the source control archives for OLD to NEW"
+  (let ((dpath (file-name-directory old))
+	(comment (ccase-maybe-comment 'rename)))
+    (if (not (ccase-is-registered dpath))
+	(error "Cannot rename file outside of VOB")
+      (sc-do-command "*CCase*" "co - dir" "cleartool" dpath dpath "co"
+		   (if comment "-c" "-nc")
+		   (if comment comment))
+      (sc-do-command "*CCase*" "mv" "cleartool" new new "mv" 
+		   (if comment "-c" "-nc")
+		   (if comment comment)
+		   old)
+      (sc-do-command "*CCase*" "ci - dir" "cleartool" dpath dpath "ci" 
+		     (if comment "-c" "-nc")
+		     (if comment comment)))))
+
+(defun sc-ccase-checkout-dir ()
+  "Checkout the directory this file is in"
+  (interactive)
+  (let ((dpath default-directory)
+	(comment (ccase-maybe-comment 'checkout-dir)))
+    (if (not (ccase-is-registered dpath))
+	(error "Cannot checkout directory outside of VOB")
+      (sc-do-command "*CCase*" "co - dir" "cleartool" dpath dpath "co"
+		   (if comment "-c" "-nc")
+		   (if comment comment)))))
+
+(defun sc-ccase-checkin-dir ()
+  "Checkin the directory this file is in"
+  (interactive)
+  (let ((dpath default-directory)
+	(comment (ccase-maybe-comment 'checkin-dir)))
+    (if (not (ccase-is-registered dpath))
+	(error "Cannot checkout directory outside of VOB")
+      (sc-do-command "*CCase*" "ci - dir" "cleartool" dpath dpath "ci"
+		   (if comment "-c" "-nc")
+		   (if comment comment)))))
+
+(defun sc-ccase-editcs ()
+  "Edit Config Spec for this view"
+  (interactive)
+  (sc-do-command "*CCase-cs*" "catcs" "cleartool" "" nil "catcs")
+  (switch-to-buffer-other-window "*CCase-cs*")
+  (local-set-key "\C-c\C-c" 'exit-recursive-edit)
+  (recursive-edit)
+  (set-buffer "*CCase-cs*")
+  (let ((name (make-temp-name "/tmp/configspec")))
+    (write-region (point-min) (point-max) name)
+    (kill-buffer "*CCase-cs*")
+    (sc-do-command "*CCase*" "setcs" "cleartool" name name "setcs"))
+)
+
+(defun sc-ccase-new-brtype (brt)
+  "Create a new branch type"
+  (interactive "sBranch Name: ")
+  (let ((comment (ccase-maybe-comment 'new-brtype)))
+    (sc-do-command "*CCase*" "mkbrt" "cleartool" brt brt "mkbrtype"
+		   (if comment "-c" "-nc")
+		   (if comment comment))))
+
+(defun sc-ccase-new-branch (brch)
+  "Create a new branch for element"
+  (interactive "sBranch: ")
+  (let ((file (buffer-file-name))
+	(comment (ccase-maybe-comment 'new-branch)))
+    (sc-do-command "*CCase*" "mkbrch" "cleartool" file file "mkbranch" 
+		   (if comment "-c" "-nc")
+		   (if comment comment)
+		   brch)))
+
+(defun sc-ccase-checkin-merge ()
+  "Merge in changes to enable checkin"
+  (interactive)
+  (save-excursion
+  (let ((file (buffer-file-name))
+	(buf (current-buffer))
+	(comment (ccase-maybe-comment 'checkin-merge)))
+    (sc-do-command "*CCase*" "Describe" "cleartool" file file "des")
+    (set-buffer "*CCase*")
+    (goto-char (point-min))
+    (if (search-forward-regexp "@@\\([^ \"]*\\)CHECKEDOUT\" from \\([^ ]*\\) (\\([a-z]*\\))" nil t)
+	(progn
+	  (sc-do-command "*CCase*" "Merging" "cleartool" file
+			 (concat (buffer-substring (match-beginning 1)
+						   (match-end 1)) "LATEST")
+			 "merge"
+			 (if comment "-c" "-nc")
+			 (if comment comment)
+			 "-abort" "-to" file "-ver")
+	  (set-buffer buf)
+	  (revert-buffer t t)
+	  (display-buffer "*CCase*"))
+      (error "File %s not checked out" file)))))
+	  
+(defun sc-ccase-version-tree ()
+  "List version tree for file"
+  (interactive)
+  (let ((p (buffer-file-name)))
+    (sc-do-command "*CCase*" "lsvtree" "cleartool" p p "lsvtree")
+    (display-buffer "*CCase*")))
+
+(defun ccase-protect-expanded-name (revision)
+  "Protect ccase extended names from being used as temp names. Munge /s into :s"
+  (if (equal sc-generic-name "CCase")
+      (progn
+	(if (string-match "/" revision)
+	    (let ((str (substring revision 0)) ;; copy string
+		  i)
+	      (while (setq i (string-match "/" str))
+		(aset str i 58)) ; 58 is for :
+	      str)))))
+
+(defun sc-ccase-list-locked-files ()
+  (interactive)
+  (sc-do-command "*CCase directory*" "listing" "cleartool" (default-directory) nil "lsco" "-cview"))
+
+(defun sc-ccase-list-all-locked-files ()
+  (interactive)
+  (sc-do-command "*CCase directory*" "listing" "cleartool" (default-directory) nil "lsco"))
+
+(defun sc-ccase-list-registered-files ()
+  "List files registered in clearcase"
+  (interactive)
+  (sc-do-command "*CCase directory*" "listing" "cleartool" (default-directory) nil "ls" "-r" "-vis" "-nxname"))
+
+;;; Instantiation and installation of the menus
+
+;;; Set the menubar for Lucid Emacs
+(defvar sc-default-menu
+  '(["NEXT-OPERATION"	sc-next-operation	t	nil]
+    ["Update Current Directory"		sc-update-directory	t]
+    "----"
+    ["Revert File"		sc-revert-file	t	nil]
+    ["Rename File"		sc-rename-this-file		t	nil]
+    "----"
+    ["Show Changes"		sc-show-changes		t]
+    ["Show Changes Since Revision..."	sc-show-revision-changes	t]
+    ["Visit Previous Revision..."	sc-visit-previous-revision	t]
+    ["Show Edit History"		sc-show-history		t]
+    "----"
+    ["List Locked Files"	sc-list-locked-files	t]
+    ["List Locked Files Any User"	sc-list-all-locked-files	t]
+    ["List Registered Files"	sc-list-registered-files	t])
+  "Menubar entry for using the revision control system.")
+
+(defvar sc-cvs-menu
+  '(["Update Current Directory"		sc-cvs-update-directory	t]
+    ["Revert File"		sc-revert-file	t	nil]
+    "----"
+    ["Show Changes"		sc-show-changes		t]
+    ["Show Changes Since Revision..."	sc-show-revision-changes	t]
+    ["Visit Previous Revision..."	sc-visit-previous-revision	t]
+    ["Show File Status"		sc-cvs-file-status		t]
+    ["Show Edit History"		sc-show-history		t])
+  "Menubar entry for using the revision control system with CVS.")
+
+(defvar sc-ccase-menu
+  '(["NEXT-OPERATION"			sc-next-operation		t nil]
+    ["Revert File"			sc-revert-file			t nil]
+    ["Checkin Merge"			sc-ccase-checkin-merge  	t]
+    "----"
+    ["Show Changes"			sc-show-changes			t]
+    ["Show Changes Since Revision..."	sc-show-revision-changes	t]
+    ["Visit Previous Revision..."	sc-visit-previous-revision	t]
+    ["Show Edit History"		sc-show-history			t]
+    "----"
+    ("Directories" 
+     ["Checkout Directory"		sc-ccase-checkout-dir		t]
+     ["Checkin Directory"		sc-ccase-checkin-dir		t]
+     ["Rename File..."			sc-rename-this-file		t nil])
+    ("Configs"
+     ["Edit Config Spec..."		sc-ccase-editcs			t]
+     ["Create New Branch..."		sc-ccase-new-brtype		t]
+     ["Make New Branch..."		sc-ccase-new-branch		t])
+    ("Listings"
+     ["List Version Tree"		sc-ccase-version-tree		t]
+     ["List Locked Files"		sc-ccase-list-locked-files	t]
+     ["List Locked Files Any User"	sc-ccase-list-all-locked-files	t]
+     ["List Registered Files"		sc-ccase-list-registered-files	t]
+     ))
+  "Menubar entry for using the revision control system.")
+
+(defun sc-sensitize-menu ()
+  (let* ((rest (cdr (car
+		     (find-menu-item current-menubar (list sc-generic-name)))))
+	 (case-fold-search t)
+	 (file (if buffer-file-name
+		   (file-name-nondirectory buffer-file-name)
+		 (buffer-name)))
+	 (lock-info (sc-lock-info buffer-file-name))
+	 command
+	 nested-rest
+	 item)
+    (while rest
+      (setq item (car rest))
+      (if (listp item)
+	  (progn
+	    (setq nested-rest (cons (cdr rest) nested-rest))
+	    (setq rest (cdr item)))
+	(if (vectorp item)
+	    (progn
+	      (setq command (aref item 1))
+	      (cond ((eq 'sc-next-operation command)
+		     (aset item 0
+			   (cond ((eq lock-info 'na) "Not Available")
+				 ((not lock-info) "Register File")
+				 ((not (car lock-info)) "Check out File")
+				 (t "Check in File")))
+		     ;; if locked by somebody else disable the next-operation
+		     (if (or (not buffer-file-name)
+			     (eq lock-info 'na)
+			     (and (car lock-info)
+				  (not (equal sc-generic-name "CCase"))
+				  (not (equal (car lock-info) (user-login-name)))))
+			 (aset item 2 ())
+		       (aset item 2 t)))
+		    ((eq lock-info 'na) (aset item 2 ()))
+		    ((> (length item) 3)
+		     (aset item 3 file))
+		    (t nil))
+	      (if (not (eq lock-info 'na))
+		  (let ((enable-file-items
+			 (if (member sc-generic-name '("CVS" "CCase"))
+			     buffer-file-name
+			   (if lock-info t ()))))
+		    (if (memq command
+			      '(sc-force-check-in-file
+				sc-register-file
+				sc-revert-file
+				sc-rename-this-file
+				sc-show-history
+				sc-show-changes
+				sc-show-revision-changes
+				sc-visit-previous-revision
+				sc-cvs-file-status
+				sc-ccase-checkout-dir
+				sc-ccase-checkin-dir
+				sc-ccase-editcs
+				sc-ccase-new-brtype
+				sc-ccase-new-branch
+				sc-ccase-checkin-merge
+				sc-ccase-needs-merge
+				sc-ccase-merge-changes
+				sc-ccase-create-label
+				sc-ccase-label-sources
+				sc-ccase-version-tree
+				sc-list-locked-files
+				sc-list-all-locked-files
+				sc-ccase-list-registered-files
+				))
+			(aset item 2 enable-file-items))))))
+	(if (not (setq rest (cdr rest)))
+	    (if nested-rest
+		(progn
+		  (setq rest (car nested-rest))
+		  (setq nested-rest (cdr nested-rest)))))))
+    nil))
+
+
+;;; Function to decide which Source control to use
+(defun sc-set-SCCS-mode ()
+  (setq sc-generic-name "SCCS")
+  (setq sc-can-hack-dir t)
+  (setq sc-generic-lock-info 'sccs-lock-info)
+  (setq sc-generic-register 'sccs-register)
+  (setq sc-generic-check-out 'sccs-check-out)
+  (setq sc-generic-get-version 'sccs-get-version)
+  (setq sc-generic-check-in 'sccs-check-in)
+  (setq sc-generic-history 'sccs-history)
+  (setq sc-generic-tree-list 'sccs-tree-list)
+  (setq sc-generic-new-revision-p 'sccs-new-revision-p)
+  (setq sc-generic-revert 'sccs-revert)
+  (setq sc-generic-rename 'sccs-rename)
+  (setq sc-menu
+	(cons (car sc-default-menu)
+	      (cons ["Insert Headers"	sccs-insert-headers	t]
+		    (cdr sc-default-menu))))
+  (define-key sc-prefix-map "h" 'sccs-insert-headers)
+  (define-key sc-prefix-map "\C-d" 'sc-update-directory))
+
+(defun sc-set-RCS-mode ()
+  (setq sc-generic-name "RCS")
+  (setq sc-can-hack-dir t)
+  (setq sc-generic-lock-info 'rcs-lock-info)
+  (setq sc-generic-register 'rcs-register)
+  (setq sc-generic-check-out 'rcs-check-out)
+  (setq sc-generic-get-version 'rcs-get-version)
+  (setq sc-generic-check-in 'rcs-check-in)
+  (setq sc-generic-history 'rcs-history)
+  (setq sc-generic-tree-list 'rcs-tree-list)
+  (setq sc-generic-new-revision-p 'rcs-new-revision-p)
+  (setq sc-generic-revert 'rcs-revert)
+  (setq sc-generic-rename 'rcs-rename)
+  (setq sc-menu sc-default-menu)
+  (define-key sc-prefix-map "\C-d" 'sc-update-directory))
+
+(defun sc-set-CVS-mode ()
+  (require 'pcl-cvs)
+  (setq sc-generic-name "CVS")
+  (setq sc-can-hack-dir t)
+  (setq sc-generic-lock-info 'cvs-lock-info)
+  (setq sc-generic-register 'cvs-register)
+  (setq sc-generic-check-out 'cvs-check-out)
+  (setq sc-generic-get-version 'cvs-get-version)
+  (setq sc-generic-check-in 'cvs-check-in)
+  (setq sc-generic-history 'cvs-history)
+  (setq sc-generic-tree-list 'cvs-tree-list)
+  (setq sc-generic-new-revision-p 'cvs-new-revision-p)
+  (setq sc-generic-revert 'cvs-revert)
+  (setq sc-generic-rename 'cvs-rename)
+  (setq sc-menu sc-cvs-menu)
+  (define-key sc-prefix-map "\C-d" 'sc-cvs-update-directory)
+  (define-key sc-prefix-map "s" 'sc-cvs-file-status))
+
+(defun sc-set-CLEARCASE-mode ()
+  (setq sc-generic-name "CCase")
+  (setq sc-can-hack-dir nil)
+  (setq sc-generic-lock-info 'ccase-lock-info)
+  (setq sc-generic-register 'ccase-register)
+  (setq sc-generic-check-out 'ccase-check-out)
+  (setq sc-generic-get-version 'ccase-get-version)
+  (setq sc-generic-check-in 'ccase-check-in)
+  (setq sc-generic-history 'ccase-history)
+  (setq sc-generic-tree-list 'ccase-tree-list)
+  (setq sc-generic-new-revision-p 'ccase-new-revision-p)
+  (setq sc-generic-revert 'ccase-revert)
+  (setq sc-generic-rename 'ccase-rename)
+  (setq sc-menu sc-ccase-menu)
+
+  ;; caching for file directory types
+  (save-excursion
+    (set-buffer (get-buffer-create "*CCase*"))
+    (shell-command-on-region (point-min) (point-max) "df -t mfs | sed -n 's%.*[       ]\\(/[^ ]*\\)$%\\1%p'" t)
+    (goto-char (point-min))
+    (let (x l)
+      (while (condition-case nil (setq x (read (current-buffer)))
+	       (error nil))
+	(setq l (cons (prin1-to-string x) l)))
+      (setq sc-ccase-mfs-prefixes (nreverse l))))
+)
+
+(defun sc-set-ATRIA-mode ()
+  (sc-set-CLEARCASE-mode))
+
+(defun sc-set-CCASE-mode ()
+  (sc-set-CLEARCASE-mode))
+
+
+;; the module is sucessfully loaded!
+(provide 'generic-sc)
+
+;;; generic-sc.el ends here