X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=xemacs-packages%2FSun%2Fsccs.el;fp=xemacs-packages%2FSun%2Fsccs.el;h=0000000000000000000000000000000000000000;hb=b40387f66f440ceae9237a9d3e89771105e06a9d;hp=c13308dce807faa0ad4b5efd9a2c50cf05465941;hpb=ddc5c7797a5af35f6aa7d64128db476923e814f3;p=packages

diff --git a/xemacs-packages/Sun/sccs.el b/xemacs-packages/Sun/sccs.el
deleted file mode 100644
index c13308dc..00000000
--- a/xemacs-packages/Sun/sccs.el
+++ /dev/null
@@ -1,913 +0,0 @@
-;; sccs.el -- easy-to-use SCCS control from within Emacs
-;;	@(#)sccs.el	3.5
-
-;; 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.
-;;;
-;;; Synched up with: Not in FSF.
-;;; #### Chuck -- I say remove this piece of crap!  Use VC instead.
-
-;;; Author: Eric S. Raymond (eric@snark.thyrsus.com).
-;;;
-;;; It is 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.
-;;; 
-;;; Modified: Made to work for Lucid Emacs by persons who don't know SCCS.
-;;; Modified: Ben Wing (Ben.Wing@eng.sun.com) -- fixed up and redid menus
-;;;
-
-;; User options
-
-(defvar sccs-bin-directory nil
-  "*Directory that holds the SCCS executables.
-Initialized automatically the first time you execute an SCCS command,
-if not already set.")
-
-(defvar sccs-max-log-size 510
-  "*Maximum allowable size of an SCCS log message.")
-(defvar sccs-diff-command '("diff" "-c")
-  "*The command/flags list to be used in constructing SCCS diff commands.")
-(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 SCCS headers in C mode.")
-(defvar sccs-mode-expert nil
-  "*Treat user as expert; suppress yes-no prompts on some things.")
-
-;; 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."
-  (format "%sSCCS/%s.%s"
-	  (concat (file-name-directory (expand-file-name file)))
-	  (or letter "s")
-	  (concat (file-name-nondirectory (expand-file-name file)))))
-
-(defun sccs-lock-info (file index)
-   "Return the nth token in a file's SCCS-lock information."
-   (let
-       ((pfile (sccs-name file "p")))
-     (and (file-exists-p pfile)
-	  (save-excursion
-	    (find-file pfile)
-	    (auto-save-mode nil)
-	    (goto-char (point-min))
-	    (replace-string " " "\n")
-	    (goto-char (point-min))
-	    (forward-line index)
-	    (prog1
-		(buffer-substring (point) (progn (end-of-line) (point)))
-	      (set-buffer-modified-p nil)
-	      (kill-buffer (current-buffer)))
-	    )
-	  )
-     )
-   )
-
-(defun sccs-locking-user (file)
-  "Return the name of the person currently holding a lock on FILE.
-Return nil if there is no such person."
-  (sccs-lock-info file 2)
-  )
-
-(defun sccs-locked-revision (file)
-  "Return the revision number currently locked for FILE, nil if none such."
-  (sccs-lock-info file 1)
-  )
-
-(defmacro error-occurred (&rest body)
-  (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
-
-;; There has *got* to be a better way to do this...
-(defmacro chmod (perms file)
-  (list 'call-process "chmod" nil nil nil perms file))
-
-(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"))
-)
-
-(defun sccs-init-bin-directory ()
-  (setq 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"))))
-
-;; The following functions do most of the real work
-
-(defun sccs-get-version (file sid)
-   "For the given FILE, retrieve a copy of the version with given SID.
-The text is retrieved into a tempfile.  Return the tempfile name, or nil
-if no such version exists."
-  (let (oldversion vbuf)
-    (setq oldversion (sccs-name file (or sid "new")))
-    (setq vbuf (create-file-buffer oldversion))
-    (prog1
-	(if (not (error-occurred
-	     (sccs-do-command vbuf "get" file
-			      (and sid (concat "-r" sid))
-			      "-p" "-s")))
-	    (save-excursion
-	      (set-buffer vbuf)
-	      (write-region (point-min) (point-max) oldversion t 0)
-	      oldversion)
-	  )
-      (kill-buffer vbuf)
-      )
-    )
-  )
-
-(defun sccs-mode-line (file)
-  "Set the mode line for an SCCS buffer.
-FILE is the file being visited to put in the modeline."
-  (setq mode-line-process
-	(if (file-exists-p (sccs-name file "p"))
-	    (format " <SCCS: %s>" (sccs-locked-revision file))
-	  ""))
-
-    ; force update of frame
-    (save-excursion (set-buffer (other-buffer)))
-    (sit-for 0)
-    )
-
-(defun sccs-do-command (buffer command file &rest flags)
-  "  Execute an SCCS command, notifying the user and checking for errors."
-  (setq file (expand-file-name file))
-  (message "Running %s on %s..." command file)
-  (or sccs-bin-directory (sccs-init-bin-directory))
-  (let ((status
-	 (save-window-excursion
-	   (set-buffer (get-buffer-create buffer))
-	   (erase-buffer)
-	   (while (and flags (not (car flags)))
-	     (setq flags (cdr flags)))
-	   (setq flags (append flags (and file (list (sccs-name file)))))
-	   (let ((default-directory (file-name-directory (or file "./")))
-		 (exec-path (cons sccs-bin-directory exec-path)))
-	     (apply 'call-process command nil t nil flags)
-	     )
-	   (goto-char (point-max))
-	   (previous-line 1)
-	   (if (looking-at "ERROR")
-	       (progn
-		 (previous-line 1)
-		 (print (cons command flags))
-		 (next-line 1)
-		 nil)
-	     t))))
-    (if status
-	(message "Running %s...OK" command)
-      (pop-to-buffer buffer)
-      (error "Running %s...FAILED" command)))
-  (if file (sccs-mode-line file)))
-
-(defun sccs-shell-command (command)
-  "Like shell-command except that the *Shell Command Output*buffer
-is created even if the command does not output anything"
-  (shell-command command)
-  (get-buffer-create "*Shell Command Output*"))
-
-(defun sccs-tree-walk (func &rest optargs)
-  "Apply FUNC to each SCCS file under the default directory.
-If present, OPTARGS are also passed."
-  (sccs-shell-command (concat "/bin/ls -1 " default-directory "SCCS/s.*"))
-  (set-buffer "*Shell Command Output*")
-  (goto-char (point-min))
-  (replace-string "SCCS/s." "")
-  (goto-char (point-min))
-  (if (eobp)
-      (error "No SCCS files under %s" default-directory))
-  (while (not (eobp))
-    (let ((file (buffer-substring (point) (progn (end-of-line) (point)))))
-      (apply func file optargs)
-      )
-    (forward-line 1)
-    )
-  )
-
-(defun sccs-init ()
-  (or (current-local-map) (use-local-map (make-sparse-keymap)))
-  (condition-case nil
-      ;; If C-c s is already defined by another mode, then we
-      ;; will get an error.  In that case, just don't do anything.
-      (progn
-	(define-key (current-local-map) "\C-cs?" 'describe-mode)
-	(define-key (current-local-map) "\C-csn" 'sccs)
-	(define-key (current-local-map) "\C-csm" 'sccs-register-file)
-	(define-key (current-local-map) "\C-csh" 'sccs-insert-headers)
-	(define-key (current-local-map) "\C-csd" 'sccs-revert-diff)
-	(define-key (current-local-map) "\C-csp" 'sccs-prs)
-	(define-key (current-local-map) "\C-csr" 'sccs-revert-buffer)
-	(define-key (current-local-map) "\C-cs\C-d" 'sccs-version-diff)
-	(define-key (current-local-map) "\C-cs\C-p" 'sccs-pending)
-	(define-key (current-local-map) "\C-cs\C-r" 'sccs-registered)
-	)
-    (error nil)))
-
-;; Here's the major entry point
-
-(defun sccs (verbose)
-  "*Do the next logical SCCS operation on the file in the current buffer.
-You must have an SCCS subdirectory in the same directory as the file being
-operated on.
-   If the file is not already registered with SCCS, this does an admin -i
-followed by a get -e.
-   If the file is registered and not locked by anyone, this does a get -e.
-   If the file is registered and locked by the calling user, this pops up a
-buffer for creation of a log message, then does a delta -n on the file.
-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")
-  (sccs-init)
-  (if (buffer-file-name)
-      (let
-	  (do-update revision owner
-		     (file (buffer-file-name))
-		     (sccs-file (sccs-name (buffer-file-name)))
-		     (sccs-log-buf (get-buffer-create "*SCCS-Log*"))
-		     (err-msg nil))
-
-	;; if there is no SCCS file corresponding, create one
-	(if (not (file-exists-p sccs-file))
-	    (progn
-	      (sccs-load-vars)
-	      (sccs-admin 
-	       file
-	       (cond 
-		(verbose (read-string "Initial SID: "))
-		((error-occurred (load-file "SCCS/emacs-vars.el")) "1")
-		(t sccs-current-major-version))
-	       )
-	      )
-	  )
-
-	(cond
-
-	 ;; if there is no lock on the file, assert one and get it
-	 ((not (file-exists-p (sccs-name file "p")))
-	  (progn
-	    (sccs-get file t)
-	    (revert-buffer nil t)
-	    (sccs-mode-line file)
-	    ))
-
-	 ;; a checked-out version exists, but the user may not own the lock
-	 ((not (string-equal
-		(setq owner (sccs-locking-user file)) (user-login-name)))
-	  (error "Sorry, %s has that file checked out" owner))
-
-	 ;; OK, user owns the lock on the file 
-	 (t (progn
-
-	      ;; if so, give luser a chance to save before delta-ing.
-	      (if (and (buffer-modified-p)
-		       (or
-			sccs-mode-expert
-			(y-or-n-p (format "%s has been modified. Write it out? "
-					  (buffer-name)))))
-		       (save-buffer))
-
-	      (setq revision (sccs-locked-revision file))
-
-	      ;; user may want to set nonstandard parameters
-	      (if verbose
-		  (if (or sccs-mode-expert (y-or-n-p 
-		       (format "SID: %s  Change revision level? " revision)))
-		      (setq revision (read-string "New revision level: "))))
-
-	      ;; OK, let's do the delta
-	      (if
-		  ;; this excursion returns t if the new version was saved OK
-		  (save-window-excursion
-		    (pop-to-buffer (get-buffer-create "*SCCS*"))
-		    (erase-buffer)
-		    (set-buffer-modified-p nil)
-		    (sccs-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 (sccs-delta file revision))))
-		      (setq buffer-file-name nil)
-		      (bury-buffer "*SCCS*")))
-
-		  ;; if the save went OK do some post-checking
-		  (if (buffer-modified-p)
-		      (error
-		       "Delta-ed version of file does not match buffer!")
-		    (progn
-		      ;; 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
-		      ;;
-		      ;; fooey on this.  You always need to refetch the
-		      ;; file; otherwise weirdness will ensue when you're
-		      ;; trying to do a make. --bpw
-		      ; (if (sccs-check-headers)
-		      (sccs-get file nil)
-		      (revert-buffer nil t)
-		      (sccs-mode-line file)
-		      (run-hooks 'sccs-delta-ok)
-		      )
-		    ))))))
-    (error "There is no file associated with buffer %s" (buffer-name))))
-
-(defun sccs-insert-last-log ()
-  "*Insert the log message of the last SCCS check in at point."
-  (interactive)
-  (insert-buffer sccs-log-buf))
-
-;;; These functions help the sccs entry point
-
-(defun sccs-get (file writeable)
-  "Retrieve a copy of the latest delta of the given file."
-    (sccs-do-command "*SCCS*" "get" file (if writeable "-e")))
-
-(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))
-  (chmod "-w" file)
-  (if (sccs-check-headers)
-      (sccs-get file nil))	;; expand SCCS headers
-  (revert-buffer nil t)
-  (sccs-mode-line file)
-)
-
-(defun sccs-delta (file &optional rev comment)
-   "Delta the file specified by FILE.
-The optional argument REV may be a string specifying the new revision level
-\(if nil increment the current level). The file is retained with write
-permissions zeroed. COMMENT is a comment string; if omitted, the contents of
-the current buffer up to point becomes the comment for this delta."
-  (if (not comment)
-      (progn
-	(goto-char (point-max))
-	(if (not (bolp)) (newline))
-	(newline)
-	(setq comment (buffer-substring (point-min) (1- (point)))))
-    )
-  (sccs-do-command "*SCCS*" "delta" file "-n"
-	   (if rev (format "-r%s" rev))
-	   (format "-y%s" comment))
-  (chmod "-w" file))
-
-(defun sccs-delta-abort ()
-  "Abort an SCCS delta command."
-  (interactive)
-  (if (or sccs-mode-expert (y-or-n-p "Abort the delta? "))
-      (progn
-	(delete-window)
-	(error "Delta aborted")))
-  )
-
-(defun sccs-log-exit ()
-  "Leave the recursive edit of an SCCS log message."
-  (interactive)
-  (if (< (buffer-size) sccs-max-log-size)
-	 (progn
-	   (copy-to-buffer sccs-log-buf (point-min) (point-max))
-	   (exit-recursive-edit)
-	   (delete-window))
-	 (progn
-	   (goto-char sccs-max-log-size)
-	   (error
-	    "Log must be less than %d characters. Point is now at char %d."
-	    sccs-max-log-size sccs-max-log-size)))
-)
-
-;; Additional entry points for examining version histories
-
-(defun sccs-revert-diff (&rest flags)
-  "*Compare the version being edited with the last checked-in revision.
-Or, if given a prefix argument, with another specified revision."
-  (interactive)
-  (let (old file)
-    (if
-	(setq old (sccs-get-version (buffer-file-name) 
-				    (and
-				     current-prefix-arg
-				     (read-string "Revision to compare against: "))
-				    ))
-	(progn
-	  (if (and (buffer-modified-p)
-		   (or
-		    sccs-mode-expert
-		    (y-or-n-p (format "%s has been modified. Write it out? "
-				      (buffer-name)))))
-	      (save-buffer))
-
-	  (setq file (buffer-file-name))
-	  (set-buffer (get-buffer-create "*SCCS*"))
-	  (erase-buffer)
-	  (apply 'call-process (car sccs-diff-command) nil t nil
-		 (append (cdr sccs-diff-command) flags (list old) (list file)))
-	  (set-buffer-modified-p nil)
-	  (goto-char (point-min))
-	  (delete-file old)
-	  (if (equal (point-min) (point-max))
-	      (message "No changes to %s since last get." file)
-	      (pop-to-buffer "*SCCS*")
-	      )
-	  )
-      )
-    )
-  )
-
-(defun sccs-prs ()
-  "*List the SCCS log of the current buffer in an emacs window."
-  (interactive)
-  (if (and buffer-file-name (file-exists-p (sccs-name buffer-file-name "s")))
-      (progn
-	(sccs-do-command "*SCCS*" "prs" buffer-file-name)
-	(pop-to-buffer (get-buffer-create "*SCCS*"))
-	)
-    (error "There is no SCCS file associated with this buffer")
-    )
-  )
-
-(defun sccs-version-diff (file rel1 rel2)
-  "*For FILE, report diffs between two stored deltas 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))
-  (set-buffer (get-buffer-create "*SCCS*"))
-  (erase-buffer)
-  (sccs-vdiff file rel1 rel2)
-  (set-buffer-modified-p nil)
-  (goto-char (point-min))
-  (if (equal (point-min) (point-max))
-      (message "No changes to %s between %s and %s." file rel1 rel2)
-    (pop-to-buffer "*SCCS*")
-    )
-  )
-
-(defun sccs-vdiff (file rel1 rel2 &optional flags)
-  "Compare two deltas into the current buffer."
-  (let (vers1 vers2)
-    (and
-     (setq vers1 (sccs-get-version file rel1))
-     (setq vers2 (if rel2 (sccs-get-version file rel2) file))
-;     (prog1
-;	 (save-excursion
-;	   (not (error-occurred
-;		 (call-process "prs" nil t t
-;			       (sccs-name file))))
-;	 )
-;       )
-     (unwind-protect
-	 (apply 'call-process (car sccs-diff-command) nil t t
-		(append (cdr sccs-diff-command) flags (list vers1) (list vers2)))
-       (condition-case () (delete-file vers1) (error nil))
-       (if rel2
-	   (condition-case () (delete-file vers2) (error nil)))
-       )
-     )
-    )
-  )
-
-;; 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 ()
-  (let (st en)
-    (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."
-  (interactive)
-  (save-excursion
-    (goto-char (point-min))
-    (re-search-forward  "%[MIRLBSDHTEGUYFPQCZWA]%" (point-max) t)))
-
-;; Status-checking functions
-
-(defun sccs-status (prefix legend)
-   "List all files underneath the current directory matching a prefix type."
-   (sccs-shell-command
-    (concat "/bin/ls -1 SCCS/" prefix ".*"))
-   (if
-       (save-excursion
-	 (set-buffer "*Shell Command Output*")
-	 (if (= (point-max) (point-min))
-	     (not (message
-		   "No files are currently %s under %s"
-		   legend default-directory))
-	   (progn
-	     (goto-char (point-min))
-	     (insert
-	      "The following files are currently " legend
-	      " under " default-directory ":\n")
-	     (replace-string (format "SCCS/%s." prefix) "")
-	     )
-	   )
-	 )
-       (pop-to-buffer "*Shell Command Output*")
-       )
-     )
-
-(defun sccs-pending ()
-  "*List all files currently SCCS locked."
-  (interactive)
-  (sccs-status "p" "locked"))
-
-(defun sccs-registered ()
-  "*List all files currently SCCS registered."
-  (interactive)
-  (sccs-status "s" "registered"))
-       
-(defun sccs-register-file (override)
-  "*Register the file visited by the current buffer into SCCS."
-  (interactive "P")
-  (if (file-exists-p (sccs-name (buffer-file-name)))
-      (error "This file is already registered into SCCS.")
-    (progn
-      (if (and (buffer-modified-p)
-	       (or
-		sccs-mode-expert
-		(y-or-n-p (format "%s has been modified. Write it out? "
-				  (buffer-name)))))
-	  (save-buffer))
-      (sccs-load-vars)
-      (sccs-admin 
-       (buffer-file-name)
-       (cond 
-	(override (read-string "Initial SID: "))
-	((error-occurred (load-file "SCCS/emacs-vars.el")) "1")
-	(t sccs-current-major-version))
-       )
-      )
-    )
-  )
-
-;; Major functions for release-tracking and generation.
-
-(defun sccs-release-diff (rel1 rel2)
-  "*Diff all files below default-directory between versions REL1 and REL2.
-The report goes to a shell output buffer which is popped to.  If REL2 is
-omitted or nil, the comparison is done against the most recent version."
-  (interactive "sOlder version: \nsNewer version: ")
-  (if (string-equal rel1 "") (setq rel1 nil))
-  (if (string-equal rel2 "") (setq rel2 nil))
-  (sccs-shell-command (concat
-		       "/bin/ls -1 " default-directory "SCCS/s.*"
-		       ))
-  (set-buffer "*Shell Command Output*")
-  (goto-char (point-min))
-  (replace-string "SCCS/s." "")
-  (goto-char (point-min))
-  (if (eobp)
-      (error "No SCCS files under %s" default-directory))
-  (let
-      ((sccsbuf (get-buffer-create "*SCCS*")))
-    (save-excursion
-      (set-buffer sccsbuf)
-      (erase-buffer)
-      (insert (format "Diffs from %s to %s.\n\n"
-		      (or rel1 "current") (or rel2 "current"))))
-    (while (not (eobp))
-	 (let ((file (buffer-substring (point) (progn (end-of-line) (point)))))
-	   (save-excursion
-	     (set-buffer sccsbuf)
-	     (set-buffer-modified-p nil)
-
-	     (sccs-vdiff file rel1 rel2)
-	     (if (buffer-modified-p)
-		 (insert "\n"))
-	     )
-	   (forward-line 1)
-	   )
-	 )
-    (kill-buffer "*Shell Command Output*")
-    (pop-to-buffer sccsbuf)
-    (insert "\nEnd of diffs.\n")
-    (goto-char (point-min))
-    (replace-string (format "/SCCS/%s." rel1) "/")
-    (goto-char (point-min))
-    (replace-string (format "/SCCS/%s." rel2) "/new/")
-    (goto-char (point-min))
-    (replace-string "/SCCS/new." "/new/")
-    (goto-char (point-min))
-    (replace-regexp (concat "^*** " default-directory) "*** ")
-    (goto-char (point-min))
-    (replace-regexp (concat "^--- " default-directory) "--- ")
-    (goto-char (point-min))
-    (set-buffer-modified-p nil)
-    )
-  )
-
-(defun sccs-dummy-delta (file sid)
-  "Make a dummy delta to the given FILE with the given SID."
-  (interactive "sFile: \nsRelease ID: ")
-  (if (not (sccs-locked-revision file))
-      (sccs-get file t))
-  ;; Grottiness alert -- to get around SCCS's obsessive second-guessing we
-  ;; have to mung the p-file
-  (save-excursion
-    (let ((pfile (sccs-name file "p")))
-      (chmod "u+w" pfile)
-      (find-file pfile)
-      (auto-save-mode nil)
-      (replace-regexp "^\\([0-9.]+\\) \\([0-9.]+\\)" (concat "\\1 " sid) t)
-      (write-region (point-min) (point-max) pfile t 0)
-      (chmod "u-w" pfile)
-      (set-buffer-modified-p nil)
-      (kill-buffer (current-buffer))
-      )
-    )
-  (sccs-delta file sid (concat "Release " sid))
-  (sccs-get file nil)
-  (sccs-save-vars sid)
-  )
-
-(defun sccs-delta-release (sid)
-  "*Delta everything underneath the current directory to mark it as a release."
-  (interactive "sRelease: ")
-  (sccs-tree-walk 'sccs-dummy-delta sid)
-  (kill-buffer "*SCCS*")
-  )
-
-;; Miscellaneous other entry points
-
-(defun sccs-revert-buffer ()
-  "*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 SCCS revision?" file))
-	(progn
-	  (delete-file file)
-	  (delete-file (sccs-name file "p"))
-	  (rename-file (sccs-get-version file nil) file)
-	  (chmod "-w" file)
-	  (revert-buffer nil t)
-	  (sccs-mode-line file)))))
-
-(defun sccs-rename-file (old new)
-  "*Rename a file, taking its SCCS files with it."
-  (interactive "fOld name: \nFNew name: ")
-  (let ((owner (sccs-locking-user old)))
-    (if (and owner (not (string-equal owner (user-login-name))))
-	(error "Sorry, %s has that file checked out" owner))
-    )
-  (rename-file old new)
-  (if (file-exists-p (sccs-name old "p"))
-      (rename-file (sccs-name old "p") (sccs-name new "p")))
-  (if (file-exists-p (sccs-name old "s"))
-      (rename-file (sccs-name old "s") (sccs-name new "s")))
-  )
-
-;; Set up key bindings for SCCS use, e.g. while editing log messages
-
-(defun sccs-mode ()
-  "Minor mode for driving the SCCS tools.
-
-These bindings are added to the global keymap when you enter this mode:
-\\[sccs]	perform next logical SCCS operation (`sccs') on current file
-\\[sccs-register-file]		register current file into SCCS
-\\[sccs-insert-headers]		insert SCCS headers in current file
-\\[sccs-prs]		display change history of current file
-\\[sccs-revert-buffer]		revert buffer to last saved version
-\\[sccs-revert-diff]		show difference between buffer and last saved delta
-\\[sccs-pending]		show all files currently locked by any user in or below .
-\\[sccs-registered]		show all files registered into SCCS in or below .
-\\[sccs-version-diff]		show diffs between saved versions for all files in or below .
-
-When you generate headers into a buffer using C-c h, the value of
-sccs-insert-headers-hook is called before insertion. If the file is
-recognized a C or Lisp source, sccs-insert-c-header-hook or
-sccs-insert-lisp-header-hook is called after insertion respectively.
-
-While you are entering a change log message for a delta, the following
-additional bindings will be in effect.
-
-\\[sccs-log-exit]		proceed with check in, ending log message entry
-\\[sccs-insert-last-log]		insert log message from last check-in
-\\[sccs-delta-abort]		abort this delta check-in
-
-Entry to the change-log submode calls the value of text-mode-hook, then
-the value sccs-mode-hook.
-
-Global user options:
-        sccs-mode-expert        suppresses some conformation prompts,
-				notably for delta aborts and file saves.
-	sccs-max-log-size	specifies the maximum allowable size
-				of a log message plus one.
-	sccs-diff-command	A list consisting of the command and flags
-				to be used for generating context diffs.
-	sccs-headers-wanted	which %-keywords to insert when adding
-				SCCS headers with C-c h
-	sccs-insert-static	if non-nil, SCCS keywords inserted in C files
-				get stuffed in a static string area so that
-				what(1) can see them in the compiled object
-				code.
-"
-  (interactive)
-  (set-syntax-table text-mode-syntax-table)
-  (use-local-map sccs-log-entry-mode)
-  (setq local-abbrev-table text-mode-abbrev-table)
-  (setq major-mode 'sccs-mode)
-  (setq mode-name "SCCS Change Log Entry")
-  (run-hooks 'text-mode-hook 'sccs-mode-hook)
-)
-
-;; Initialization code, to be done just once at load-time
-(if sccs-log-entry-mode
-    nil
-  (setq sccs-log-entry-mode (make-sparse-keymap))
-  (define-key sccs-log-entry-mode "\C-ci" 'sccs-insert-last-log)
-  (define-key sccs-log-entry-mode "\C-c\C-i" 'sccs-insert-last-log)
-  (define-key sccs-log-entry-mode "\C-ca" 'sccs-delta-abort)
-  (define-key sccs-log-entry-mode "\C-c\C-a" 'sccs-delta-abort)
-  (define-key sccs-log-entry-mode "\C-c\C-c" 'sccs-log-exit)
-  (define-key sccs-log-entry-mode "\C-x\C-s" 'sccs-log-exit)
-  )
-
-
-;;; Lucid Emacs support
-
-(defconst sccs-menu
-  '("SCCS Commands"
-
-    ["SCCS"			sccs			t	nil] ; C-c s n
-    ["Insert Headers"		sccs-insert-headers	t]	     ; C-c s h
-    ["Archive History:"		sccs-prs		t	nil] ; C-c s p
-    ["Diffs from Archive:"	sccs-revert-diff	t	nil] ; C-c s d
-    ["Revert to Archive:"	sccs-revert-buffer	t	nil] ; C-c s r
-    "----"
-    ["Check In..."		sccs-dummy-delta	t]
-    ["Create Archive..."	sccs-register-file	t] ; C-c s h
-    ["Rename Archive..."	sccs-rename-file	t]
-    "----"
-    ["List Checked-Out Files"	sccs-pending		t]	   ; C-c s C-p
-    ["List Registered Files"	sccs-registered		t]	   ; C-c s C-r
-    ["Diff Directory"		sccs-release-diff	t]
-    ["Delta Directory"		sccs-delta-release	t]
-    ))
-
-(progn
-  (delete-menu-item '("SCCS"))
-  (add-menu '() "SCCS" (cdr sccs-menu)))
-
-(defun sccs-sensitize-menu ()
-  (let* ((rest (cdr (car (find-menu-item current-menubar '("SCCS")))))
-	 (case-fold-search t)
-	 (file (if buffer-file-name
-		   (file-name-nondirectory buffer-file-name)
-		 (buffer-name)))
-	 (dir (file-name-directory
-	       (if buffer-file-name buffer-file-name default-directory)))
-	 (sccs-file (and buffer-file-name (sccs-name buffer-file-name)))
-	 (known-p (and sccs-file (file-exists-p sccs-file)))
-	 (checked-out-p (and known-p
-			     (file-exists-p (sccs-name buffer-file-name "p"))))
-	 command
-	 item)
-    (while rest
-      (setq item (car rest))
-      (if (not (vectorp item))
-	  nil
-	(setq command (aref item 1))
-	(if (eq 'sccs command)
-	    (aset item 0
-		  (cond ((or (null sccs-file) (not known-p))
-			 "Create Archive:")
-			((not checked-out-p)
-			 "Check Out")
-			(t
-			 "Check In"))))
-	(cond
-	 ((and (> (length item) 3)
-	       (string-match "directory" (aref item 0)))
-	  (aset item 3 dir))
-	 ((> (length item) 3)
-	  (aset item 3 file))
-	 (t nil))
-	(aset item 2
-	      (cond
-	       ((memq command '(sccs-prs))
-		known-p)
-	       ((memq command '(sccs-revert-diff sccs-revert-buffer))
-		checked-out-p)
-	       (t))))
-	(setq rest (cdr rest))))
-  nil)
-
-(add-hook 'activate-menubar-hook 'sccs-sensitize-menu)
-
-(provide 'sccs)
-
-;; sccs.el ends here