(vc-menu-map): Set up menu items.

(vc-status): Use vc-path when calling prs.

(vc-status): New arg vc-type.

(vc-file-not-found-hook): Use save-excursion.

(vc-status): Renamed from vc-rcs-status.  Handle SCCS.
(vc-display-status): Renamed from vc-rcs-status.
(vc-mode-line): Call vc-status for SCCS files too.

1 files changed, 128 insertions, 63 deletions

diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el
index dd19ac4a0d9..87ac15556be 100644
--- a/lisp/vc-hooks.el
+++ b/lisp/vc-hooks.el
@@ -38,8 +38,8 @@ when creating new masters.")
   "*If non-nil, backups of registered files are made as with other files.
 If nil (the default), files covered by version control don't get backups.")
 
-(defvar vc-rcs-status t
-  "*If non-nil, revision and locks on RCS working file displayed in modeline.
+(defvar vc-display-status t
+  "*If non-nil, display revision number and lock status in modeline.
 Otherwise, not displayed.")
 
 ;; Tell Emacs about this new kind of minor mode
@@ -132,16 +132,18 @@ of the buffer."
 (defun vc-mode-line (file &optional label)
   "Set `vc-mode' to display type of version control for FILE.
 The value is set in the current buffer, which should be the buffer
-visiting FILE."
+visiting FILE.  Second optional arg LABEL is put in place of version
+control system name."
   (interactive (list buffer-file-name nil))
   (if file
       (let ((vc-type (vc-backend-deduce file)))
 	(setq vc-mode
-	      (and vc-type
-		   (concat " " (or label (symbol-name vc-type))
-			   (if (and vc-rcs-status (eq vc-type 'RCS))
-			       (vc-rcs-status file)))))
-	;; Even root shouldn't modify a registered file without locking it first.
+	      (if vc-type
+		  (concat " " (or label (symbol-name vc-type))
+			  (if vc-display-status
+			      (vc-status file vc-type)))))
+	;; Even root shouldn't modify a registered file without
+	;; locking it first.
 	(and vc-type
 	     (not buffer-read-only)
 	     (zerop (user-uid))
@@ -158,9 +160,9 @@ visiting FILE."
 	;;(set-buffer-modified-p (buffer-modified-p))  ;;use this if Emacs 18
 	vc-type)))
 
-(defun vc-rcs-status (file)
+(defun vc-status (file vc-type)
   ;; Return string for placement in modeline by `vc-mode-line'.
-  ;; If FILE is not registered under RCS, return nil.
+  ;; If FILE is not registered, return nil.
   ;; If FILE is registered but not locked, return " REV" if there is a head
   ;; revision and " @@" otherwise.
   ;; If FILE is locked then return all locks in a string of the
@@ -169,18 +171,19 @@ visiting FILE."
 
   ;; Algorithm: 
 
-  ;; 1. Check for master file corresponding to FILE being visited.
+  ;; Check for master file corresponding to FILE being visited.
   ;; 
-  ;; 2. Insert the first few characters of the master file into a work
-  ;; buffer.
-  ;;  
-  ;; 3. Search work buffer for "locks...;" phrase; if not found, then
-  ;; keep inserting more characters until the phrase is found.
-  ;; 
-  ;; 4. Extract the locks, and remove control characters
+  ;; RCS: Insert the first few characters of the master file into a
+  ;; work buffer.  Search work buffer for "locks...;" phrase; if not
+  ;; found, then keep inserting more characters until the phrase is
+  ;; found.  Extract the locks, and remove control characters
   ;; separating them, like newlines; the string " user1:revision1
   ;; user2:revision2 ..." is returned.
-
+  ;;
+  ;; SCCS: Check if the p-file exists.  If it does, read it and
+  ;; extract the locks, giving them the right format.  Else use prs to
+  ;; find the revision number.
+  
   ;; Limitations:
 
   ;; The output doesn't show which version you are actually looking at.
@@ -188,55 +191,85 @@ visiting FILE."
   ;; The head revision is probably not what you want if you've used `rcs -b'.
 
   (let ((master (vc-name file))
-	found)
+	found
+	status)
 
-    ;; If master file exists, then parse its contents, otherwise we return the 
-    ;; nil value of this if form.
-    (if master
+    ;; If master file exists, then parse its contents, otherwise we
+    ;; return the nil value of this if form.
+    (if (and master vc-type)
         (save-excursion
 
           ;; Create work buffer.
-          (set-buffer (get-buffer-create " *vc-rcs-status*"))
+          (set-buffer (get-buffer-create " *vc-status*"))
           (setq buffer-read-only nil
                 default-directory (file-name-directory master))
           (erase-buffer)
 
-          ;; Check if we have enough of the header.
-	  ;; If not, then keep including more.
-          (while
-	      (not (or found
-		       (let ((s (buffer-size)))
-			 (goto-char (1+ s))
-			 (zerop (car (cdr (insert-file-contents
-					   master nil s (+ s 8192))))))))
-	    (beginning-of-line)
-	    (setq found (re-search-forward "^locks\\([^;]*\\);" nil t)))
-
-          (if found
-	      ;; Clean control characters and self-locks from text.
-	      (let* ((lock-pattern
-		      (concat "[ \b\t\n\v\f\r]+\\("
-			      (regexp-quote (user-login-name))
-			      ":\\)?"))
-		     (locks
-		      (save-restriction
-			(narrow-to-region (match-beginning 1) (match-end 1))
-			(goto-char (point-min))
-			(while (re-search-forward lock-pattern nil t)
-			  (replace-match (if (eobp) "" ":") t t))
-			(buffer-string)))
-		     (status
-		      (if (not (string-equal locks ""))
-			  locks
-			(goto-char (point-min))
-			(if (looking-at "head[ \b\t\n\v\f\r]+\\([.0-9]+\\)")
-			    (concat "-" (buffer-substring (match-beginning 1)
-							  (match-end 1)))
-			  " @@"))))
-		;; Clean work buffer.
-		(erase-buffer)
-		(set-buffer-modified-p nil)
-		status))))))
+	  ;; Set the `status' var to the return value.
+	  (cond
+
+	   ;; RCS code.
+	   ((eq vc-type 'RCS)
+	    ;; Check if we have enough of the header.
+	    ;; If not, then keep including more.
+	    (while
+		(not (or found
+			 (let ((s (buffer-size)))
+			   (goto-char (1+ s))
+			   (zerop (car (cdr (insert-file-contents
+					     master nil s (+ s 8192))))))))
+	      (beginning-of-line)
+	      (setq found (re-search-forward "^locks\\([^;]*\\);" nil t)))
+
+	    (if found
+		;; Clean control characters and self-locks from text.
+		(let* ((lock-pattern
+			(concat "[ \b\t\n\v\f\r]+\\("
+				(regexp-quote (user-login-name))
+				":\\)?"))
+		       (locks
+			(save-restriction
+			  (narrow-to-region (match-beginning 1) (match-end 1))
+			  (goto-char (point-min))
+			  (while (re-search-forward lock-pattern nil t)
+			    (replace-match (if (eobp) "" ":") t t))
+			  (buffer-string))))
+		  (setq status
+			(if (not (string-equal locks ""))
+			    locks
+			  (goto-char (point-min))
+			  (if (looking-at "head[ \b\t\n\v\f\r]+\\([.0-9]+\\)")
+			      (concat "-"
+				      (buffer-substring (match-beginning 1)
+							(match-end 1)))
+			    " @@"))))))
+
+	   ;; SCCS code.
+	   ((eq vc-type 'SCCS)
+	    ;; Build the name of the p-file and put it in the work buffer.
+	    (insert master)
+	    (search-backward "/s.")
+	    (delete-char 2)
+	    (insert "/p")
+	    (if (not (file-exists-p (buffer-string)))
+		;; No lock.
+		(let ((exec-path (if vc-path (append exec-path vc-path)
+				   exec-path)))
+		  (erase-buffer)
+		  (insert "-")
+		  (if (zerop (call-process "prs" nil t nil "-d:I:" master))
+		      (setq status (buffer-substring 1 (1- (point-max))))))
+	      ;; Locks exist.
+	      (insert-file-contents (buffer-string) nil nil nil t)
+	      (while (looking-at "[^ ]+ \\([^ ]+\\) \\([^ ]+\\).*\n")
+		(replace-match " \\2:\\1"))
+	      (setq status (buffer-string))
+	      (aset status 0 ?:))))
+
+	  ;; Clean work buffer.
+	  (erase-buffer)
+	  (set-buffer-modified-p nil)
+	  status))))
 
 ;;; install a call to the above as a find-file hook
 (defun vc-find-file-hook ()
@@ -258,7 +291,7 @@ visiting FILE."
   "When file is not found, try to check it out from RCS or SCCS.
 Returns t if checkout was successful, nil otherwise."
   (if (vc-backend-deduce buffer-file-name)
-      (progn
+      (save-excursion
 	(require 'vc)
 	(not (vc-error-occurred (vc-checkout buffer-file-name))))))
 
@@ -284,8 +317,40 @@ Returns t if checkout was successful, nil otherwise."
       (define-key vc-prefix-map "u" 'vc-revert-buffer)
       (define-key vc-prefix-map "v" 'vc-next-action)
       (define-key vc-prefix-map "=" 'vc-diff)
-      (define-key vc-prefix-map "~" 'vc-version-other-window)
-      ))
+      (define-key vc-prefix-map "~" 'vc-version-other-window)))
+
+;;;(define-key vc-menu-map [show-files]
+;;;  '("Show Files under VC" . (vc-directory t)))
+(define-key vc-menu-map [vc-directory] '("Show Locked Files" . vc-directory))
+(define-key vc-menu-map [separator1] '("----"))
+(define-key vc-menu-map [vc-rename-file] '("Rename File" . vc-rename-file))
+(define-key vc-menu-map [vc-version-other-window]
+  '("Show Other Version" . vc-version-other-window))
+(define-key vc-menu-map [vc-diff] '("Compare with Last Version" . vc-diff))
+(define-key vc-menu-map [vc-update-change-log]
+  '("Update ChangeLog" . vc-update-change-log))
+(define-key vc-menu-map [vc-print-log] '("Show History" . vc-print-log))
+(define-key vc-menu-map [separator2] '("----"))
+(define-key vc-menu-map [undo] '("Undo Last Check-In" . vc-cancel-version))
+(define-key vc-menu-map [vc-revert-buffer]
+  '("Revert to Last Version" . vc-revert-buffer))
+(define-key vc-menu-map [vc-insert-header]
+  '("Insert Header" . vc-insert-headers))
+(define-key vc-menu-map [vc-menu-check-in] '("Check In" . vc-next-action))
+(define-key vc-menu-map [vc-check-out] '("Check Out" . vc-toggle-read-only))
+(define-key vc-menu-map [vc-register] '("Register" . vc-register))
+
+(put 'vc-rename-file 'menu-enable 'vc-mode)
+(put 'vc-version-other-window 'menu-enable 'vc-mode)
+(put 'vc-diff 'menu-enable 'vc-mode)
+(put 'vc-update-change-log 'menu-enable '(eq (vc-backend-deduce (buffer-file-name)) 'RCS))
+(put 'vc-print-log 'menu-enable 'vc-mode)
+(put 'vc-cancel-version 'menu-enable 'vc-mode)
+(put 'vc-revert-buffer 'menu-enable 'vc-mode)
+(put 'vc-insert-headers 'menu-enable 'vc-mode)
+(put 'vc-next-action 'menu-enable '(and vc-mode (not buffer-read-only)))
+(put 'vc-toggle-read-only 'menu-enable '(and vc-mode buffer-read-only))
+(put 'vc-register 'menu-enable '(not vc-mode))
 
 (provide 'vc-hooks)