Functions reordered.

1 files changed, 202 insertions, 170 deletions

diff --git a/lisp/vc-sccs.el b/lisp/vc-sccs.el
index db618915e90..bc02d199124 100644
--- a/lisp/vc-sccs.el
+++ b/lisp/vc-sccs.el
@@ -5,7 +5,7 @@
 ;; Author:     FSF (see vc.el for full credits)
 ;; Maintainer: Andre Spiegel <spiegel@gnu.org>
 
-;; $Id: vc-sccs.el,v 1.3 2000/09/07 20:06:55 fx Exp $
+;; $Id: vc-sccs.el,v 1.4 2000/09/09 00:48:40 monnier Exp $
 
 ;; This file is part of GNU Emacs.
 
@@ -28,6 +28,10 @@
 
 ;;; Code:
 
+;;; 
+;;; Customization options
+;;;
+
 (defcustom vc-sccs-register-switches nil
   "*Extra switches for registering a file in SCCS.
 A string or list of strings passed to the checkin program by
@@ -58,8 +62,18 @@ For a description of possible values, see `vc-check-master-templates'."
   :version "21.1"
   :group 'vc)
 
+
+;;;
+;;; Internal variables
+;;;
+
 (defconst vc-sccs-name-assoc-file "VC-names")
 
+
+;;;
+;;; State-querying functions
+;;;
+
 ;;;###autoload
 (progn (defun vc-sccs-registered (f) (vc-default-registered 'SCCS f)))
 
@@ -108,6 +122,12 @@ For a description of possible values, see `vc-check-master-templates'."
     (vc-insert-file (vc-name file) "^\001e")
     (vc-parse-buffer "^\001d D \\([^ ]+\\)" 1)))
 
+(defun vc-sccs-latest-on-branch-p (file)
+  "Return t iff the current workfile version of FILE is latest on its branch."
+  ;; Always return t; we do not support previous versions in the workfile
+  ;; under SCCS.
+  t)
+
 (defun vc-sccs-checkout-model (file)
   "SCCS-specific version of `vc-checkout-model'."
   'locking)
@@ -118,174 +138,10 @@ For a description of possible values, see `vc-check-master-templates'."
          (list "--brief" "-q"
                (concat "-r" (vc-workfile-version file)))))
 
-;; internal code
-
-;; This function is wrapped with `progn' so that the autoload cookie
-;; copies the whole function itself into loaddefs.el rather than just placing
-;; a (autoload 'vc-sccs-search-project-dir "vc-sccs") which would not
-;; help us avoid loading vc-sccs.
-;;;###autoload
-(progn (defun vc-sccs-search-project-dir (dirname basename)
-  "Return the name of a master file in the SCCS project directory.
-Does not check whether the file exists but returns nil if it does not
-find any project directory."
-  (let ((project-dir (getenv "PROJECTDIR")) dirs dir)
-    (when project-dir
-      (if (file-name-absolute-p project-dir)
-	  (setq dirs '("SCCS" ""))
-	(setq dirs '("src/SCCS" "src" "source/SCCS" "source"))
-	(setq project-dir (expand-file-name (concat "~" project-dir))))
-      (while (and (not dir) dirs)
-	(setq dir (expand-file-name (car dirs) project-dir))
-	(unless (file-directory-p dir)
-	  (setq dir nil)
-	  (setq dirs (cdr dirs))))
-      (and dir (expand-file-name (concat "s." basename) dir))))))
-
-(defun vc-sccs-lock-file (file)
-  "Generate lock file name corresponding to FILE."
-  (let ((master (vc-name file)))
-    (and
-     master
-     (string-match "\\(.*/\\)\\(s\\.\\)\\(.*\\)" master)
-     (replace-match "p." t t master 2))))
-
-(defun vc-sccs-parse-locks ()
-  "Parse SCCS locks in current buffer.
-The result is a list of the form ((VERSION . USER) (VERSION . USER) ...)."
-  (let (master-locks)
-    (goto-char (point-min))
-    (while (re-search-forward "^\\([0-9.]+\\) [0-9.]+ \\([^ ]+\\) .*\n?"
-			      nil t)
-      (setq master-locks
-	    (cons (cons (match-string 1) (match-string 2)) master-locks)))
-    ;; FIXME: is it really necessary to reverse ?
-    (nreverse master-locks)))
 
-(defun vc-sccs-print-log (file)
-  "Get change log associated with FILE."
-  (vc-do-command t 0 "prs" (vc-name file)))
-
-(defun vc-sccs-assign-name (file name)
-  "Assign to FILE's latest version a given NAME."
-  (vc-sccs-add-triple name file (vc-workfile-version file)))
-
-;; Named-configuration support
-
-(defun vc-sccs-add-triple (name file rev)
-  (with-current-buffer
-      (find-file-noselect
-       (expand-file-name vc-sccs-name-assoc-file
-			 (file-name-directory (vc-name file))))
-    (goto-char (point-max))
-    (insert name "\t:\t" file "\t" rev "\n")
-    (basic-save-buffer)
-    (kill-buffer (current-buffer))))
-
-(defun vc-sccs-rename-file (old new)
-  ;; Move the master file (using vc-rcs-master-templates).
-  (vc-rename-master (vc-name old) new vc-sccs-master-templates)
-  ;; Update the snapshot file.
-  (with-current-buffer
-      (find-file-noselect
-       (expand-file-name vc-sccs-name-assoc-file
-			 (file-name-directory (vc-name old))))
-    (goto-char (point-min))
-    ;; (replace-regexp (concat ":" (regexp-quote old) "$") (concat ":" new))
-    (while (re-search-forward (concat ":" (regexp-quote old) "$") nil t)
-      (replace-match (concat ":" new) nil nil))
-    (basic-save-buffer)
-    (kill-buffer (current-buffer))))
-
-(defun vc-sccs-lookup-triple (file name)
-  "Return the numeric version corresponding to a named snapshot of FILE.
-If NAME is nil or a version number string it's just passed through."
-  (if (or (null name)
-	  (let ((firstchar (aref name 0)))
-	    (and (>= firstchar ?0) (<= firstchar ?9))))
-      name
-    (with-temp-buffer
-      (vc-insert-file
-       (expand-file-name vc-sccs-name-assoc-file
-			 (file-name-directory (vc-name file))))
-      (vc-parse-buffer (concat name "\t:\t" file "\t\\(.+\\)") 1))))
-
-(defun vc-sccs-merge (file first-version &optional second-version)
-  (error "Merging not implemented for SCCS"))
-
-(defun vc-sccs-check-headers ()
-  "Check if the current file has any headers in it."
-  (save-excursion
-    (goto-char (point-min))
-    (re-search-forward  "%[A-Z]%" nil t)))
-
-(defun vc-sccs-steal-lock (file &optional rev)
-  "Steal the lock on the current workfile for FILE and revision REV."
-  (vc-do-command nil 0 "unget" (vc-name file) "-n" (if rev (concat "-r" rev)))
-  (vc-do-command nil 0 "get" (vc-name file) "-g" (if rev (concat "-r" rev))))
-
-(defun vc-sccs-cancel-version (file writable)
-  "Undo the most recent checkin of FILE.
-WRITABLE non-nil means previous version should be locked."
-  (vc-do-command nil 0 "rmdel"
-		 (vc-name file)
-		 (concat "-r" (vc-workfile-version file)))
-  (vc-do-command nil 0 "get"
-		 (vc-name file)
-		 (if writable "-e")))
-
-(defun vc-sccs-revert (file)
-  "Revert FILE to the version it was based on."
-  (vc-do-command nil 0 "unget" (vc-name file))
-  (vc-do-command nil 0 "get" (vc-name file))
-  ;; Checking out explicit versions is not supported under SCCS, yet.
-  ;; We always "revert" to the latest version; therefore
-  ;; vc-workfile-version is cleared here so that it gets recomputed.
-  (vc-file-setprop file 'vc-workfile-version nil))
-
-(defun vc-sccs-checkin (file rev comment)
-  "SCCS-specific version of `vc-backend-checkin'."
-  (let ((switches (if (stringp vc-checkin-switches)
-		      (list vc-checkin-switches)
-		    vc-checkin-switches)))
-    (apply 'vc-do-command nil 0 "delta" (vc-name file)
-	   (if rev (concat "-r" rev))
-	   (concat "-y" comment)
-	   switches)
-    (if vc-keep-workfiles
-	(vc-do-command nil 0 "get" (vc-name file)))))
-
-(defun vc-sccs-latest-on-branch-p (file)
-  "Return t iff the current workfile version of FILE is latest on its branch."
-  ;; Always return t; we do not support previous versions in the workfile
-  ;; under SCCS.
-  t)
-
-(defun vc-sccs-logentry-check ()
-  "Check that the log entry in the current buffer is acceptable for SCCS."
-  (when (>= (buffer-size) 512)
-    (goto-char 512)
-    (error "Log must be less than 512 characters; point is now at pos 512")))
-
-(defun vc-sccs-diff (file &optional oldvers newvers)
-  "Get a difference report using SCCS between two versions of FILE."
-  (setq oldvers (vc-sccs-lookup-triple file oldvers))
-  (setq newvers (vc-sccs-lookup-triple file newvers))
-  (let* ((diff-switches-list (if (listp diff-switches)
-                                diff-switches
-                              (list diff-switches)))
-	 (options (append (list "-q"
-				(and oldvers (concat "-r" oldvers))
-				(and newvers (concat "-r" newvers)))
-			  diff-switches-list)))
-    (apply 'vc-do-command t 1 "vcdiff" (vc-name file) options)))
-
-(defun vc-sccs-responsible-p (file)
-  "Return non-nil if SCCS thinks it would be responsible for registering FILE."
-  ;; TODO: check for all the patterns in vc-sccs-master-templates
-  (or (file-directory-p (expand-file-name "SCCS" (file-name-directory file)))
-      (stringp (vc-sccs-search-project-dir (or (file-name-directory file) "")
-					   (file-name-nondirectory file)))))
+;;;
+;;; State-changing functions
+;;;
 
 (defun vc-sccs-register (file &optional rev comment)
   "Register FILE into the SCCS version-control system.
@@ -321,6 +177,25 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
       (if vc-keep-workfiles
 	  (vc-do-command nil 0 "get" (vc-name file)))))
 
+(defun vc-sccs-responsible-p (file)
+  "Return non-nil if SCCS thinks it would be responsible for registering FILE."
+  ;; TODO: check for all the patterns in vc-sccs-master-templates
+  (or (file-directory-p (expand-file-name "SCCS" (file-name-directory file)))
+      (stringp (vc-sccs-search-project-dir (or (file-name-directory file) "")
+					   (file-name-nondirectory file)))))
+
+(defun vc-sccs-checkin (file rev comment)
+  "SCCS-specific version of `vc-backend-checkin'."
+  (let ((switches (if (stringp vc-checkin-switches)
+		      (list vc-checkin-switches)
+		    vc-checkin-switches)))
+    (apply 'vc-do-command nil 0 "delta" (vc-name file)
+	   (if rev (concat "-r" rev))
+	   (concat "-y" comment)
+	   switches)
+    (if vc-keep-workfiles
+	(vc-do-command nil 0 "get" (vc-name file)))))
+
 (defun vc-sccs-checkout (file &optional writable rev workfile)
   "Retrieve a copy of a saved version of SCCS controlled FILE into a WORKFILE.
 WRITABLE non-nil means that the file should be writable.  REV is the
@@ -379,9 +254,166 @@ revision to check out into WORKFILE."
 		   switches)))))
     (message "Checking out %s...done" filename)))
 
-(defun vc-sccs-update-changelog (files)
-  (error "Sorry, generating ChangeLog entries is not implemented for SCCS"))
+(defun vc-sccs-revert (file)
+  "Revert FILE to the version it was based on."
+  (vc-do-command nil 0 "unget" (vc-name file))
+  (vc-do-command nil 0 "get" (vc-name file))
+  ;; Checking out explicit versions is not supported under SCCS, yet.
+  ;; We always "revert" to the latest version; therefore
+  ;; vc-workfile-version is cleared here so that it gets recomputed.
+  (vc-file-setprop file 'vc-workfile-version nil))
+
+(defun vc-sccs-cancel-version (file writable)
+  "Undo the most recent checkin of FILE.
+WRITABLE non-nil means previous version should be locked."
+  (vc-do-command nil 0 "rmdel"
+		 (vc-name file)
+		 (concat "-r" (vc-workfile-version file)))
+  (vc-do-command nil 0 "get"
+		 (vc-name file)
+		 (if writable "-e")))
+
+(defun vc-sccs-steal-lock (file &optional rev)
+  "Steal the lock on the current workfile for FILE and revision REV."
+  (vc-do-command nil 0 "unget" (vc-name file) "-n" (if rev (concat "-r" rev)))
+  (vc-do-command nil 0 "get" (vc-name file) "-g" (if rev (concat "-r" rev))))
+
+
+;;;
+;;; History functions
+;;;
+
+(defun vc-sccs-print-log (file)
+  "Get change log associated with FILE."
+  (vc-do-command t 0 "prs" (vc-name file)))
+
+(defun vc-sccs-logentry-check ()
+  "Check that the log entry in the current buffer is acceptable for SCCS."
+  (when (>= (buffer-size) 512)
+    (goto-char 512)
+    (error "Log must be less than 512 characters; point is now at pos 512")))
+
+(defun vc-sccs-diff (file &optional oldvers newvers)
+  "Get a difference report using SCCS between two versions of FILE."
+  (setq oldvers (vc-sccs-lookup-triple file oldvers))
+  (setq newvers (vc-sccs-lookup-triple file newvers))
+  (let* ((diff-switches-list (if (listp diff-switches)
+                                diff-switches
+                              (list diff-switches)))
+	 (options (append (list "-q"
+				(and oldvers (concat "-r" oldvers))
+				(and newvers (concat "-r" newvers)))
+			  diff-switches-list)))
+    (apply 'vc-do-command t 1 "vcdiff" (vc-name file) options)))
+
+
+;;;
+;;; Snapshot system
+;;;
+
+(defun vc-sccs-assign-name (file name)
+  "Assign to FILE's latest version a given NAME."
+  (vc-sccs-add-triple name file (vc-workfile-version file)))
+
+
+;;;
+;;; Miscellaneous
+;;;
+
+(defun vc-sccs-check-headers ()
+  "Check if the current file has any headers in it."
+  (save-excursion
+    (goto-char (point-min))
+    (re-search-forward  "%[A-Z]%" nil t)))
+
+(defun vc-sccs-rename-file (old new)
+  ;; Move the master file (using vc-rcs-master-templates).
+  (vc-rename-master (vc-name old) new vc-sccs-master-templates)
+  ;; Update the snapshot file.
+  (with-current-buffer
+      (find-file-noselect
+       (expand-file-name vc-sccs-name-assoc-file
+			 (file-name-directory (vc-name old))))
+    (goto-char (point-min))
+    ;; (replace-regexp (concat ":" (regexp-quote old) "$") (concat ":" new))
+    (while (re-search-forward (concat ":" (regexp-quote old) "$") nil t)
+      (replace-match (concat ":" new) nil nil))
+    (basic-save-buffer)
+    (kill-buffer (current-buffer))))
+
+
+;;;
+;;; Internal functions
+;;;
+
+;; This function is wrapped with `progn' so that the autoload cookie
+;; copies the whole function itself into loaddefs.el rather than just placing
+;; a (autoload 'vc-sccs-search-project-dir "vc-sccs") which would not
+;; help us avoid loading vc-sccs.
+;;;###autoload
+(progn (defun vc-sccs-search-project-dir (dirname basename)
+  "Return the name of a master file in the SCCS project directory.
+Does not check whether the file exists but returns nil if it does not
+find any project directory."
+  (let ((project-dir (getenv "PROJECTDIR")) dirs dir)
+    (when project-dir
+      (if (file-name-absolute-p project-dir)
+	  (setq dirs '("SCCS" ""))
+	(setq dirs '("src/SCCS" "src" "source/SCCS" "source"))
+	(setq project-dir (expand-file-name (concat "~" project-dir))))
+      (while (and (not dir) dirs)
+	(setq dir (expand-file-name (car dirs) project-dir))
+	(unless (file-directory-p dir)
+	  (setq dir nil)
+	  (setq dirs (cdr dirs))))
+      (and dir (expand-file-name (concat "s." basename) dir))))))
+
+(defun vc-sccs-lock-file (file)
+  "Generate lock file name corresponding to FILE."
+  (let ((master (vc-name file)))
+    (and
+     master
+     (string-match "\\(.*/\\)\\(s\\.\\)\\(.*\\)" master)
+     (replace-match "p." t t master 2))))
+
+(defun vc-sccs-parse-locks ()
+  "Parse SCCS locks in current buffer.
+The result is a list of the form ((VERSION . USER) (VERSION . USER) ...)."
+  (let (master-locks)
+    (goto-char (point-min))
+    (while (re-search-forward "^\\([0-9.]+\\) [0-9.]+ \\([^ ]+\\) .*\n?"
+			      nil t)
+      (setq master-locks
+	    (cons (cons (match-string 1) (match-string 2)) master-locks)))
+    ;; FIXME: is it really necessary to reverse ?
+    (nreverse master-locks)))
+
+(defun vc-sccs-add-triple (name file rev)
+  (with-current-buffer
+      (find-file-noselect
+       (expand-file-name vc-sccs-name-assoc-file
+			 (file-name-directory (vc-name file))))
+    (goto-char (point-max))
+    (insert name "\t:\t" file "\t" rev "\n")
+    (basic-save-buffer)
+    (kill-buffer (current-buffer))))
+
+(defun vc-sccs-lookup-triple (file name)
+  "Return the numeric version corresponding to a named snapshot of FILE.
+If NAME is nil or a version number string it's just passed through."
+  (if (or (null name)
+	  (let ((firstchar (aref name 0)))
+	    (and (>= firstchar ?0) (<= firstchar ?9))))
+      name
+    (with-temp-buffer
+      (vc-insert-file
+       (expand-file-name vc-sccs-name-assoc-file
+			 (file-name-directory (vc-name file))))
+      (vc-parse-buffer (concat name "\t:\t" file "\t\\(.+\\)") 1))))
 
 (provide 'vc-sccs)
 
 ;;; vc-sccs.el ends here
+
+
+