Commit 624c0e9d authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

(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.
parent 0a56ee6b
...@@ -38,8 +38,8 @@ when creating new masters.") ...@@ -38,8 +38,8 @@ when creating new masters.")
"*If non-nil, backups of registered files are made as with other files. "*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.") If nil (the default), files covered by version control don't get backups.")
(defvar vc-rcs-status t (defvar vc-display-status t
"*If non-nil, revision and locks on RCS working file displayed in modeline. "*If non-nil, display revision number and lock status in modeline.
Otherwise, not displayed.") Otherwise, not displayed.")
;; Tell Emacs about this new kind of minor mode ;; Tell Emacs about this new kind of minor mode
...@@ -132,16 +132,18 @@ of the buffer." ...@@ -132,16 +132,18 @@ of the buffer."
(defun vc-mode-line (file &optional label) (defun vc-mode-line (file &optional label)
"Set `vc-mode' to display type of version control for FILE. "Set `vc-mode' to display type of version control for FILE.
The value is set in the current buffer, which should be the buffer 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)) (interactive (list buffer-file-name nil))
(if file (if file
(let ((vc-type (vc-backend-deduce file))) (let ((vc-type (vc-backend-deduce file)))
(setq vc-mode (setq vc-mode
(and vc-type (if vc-type
(concat " " (or label (symbol-name vc-type)) (concat " " (or label (symbol-name vc-type))
(if (and vc-rcs-status (eq vc-type 'RCS)) (if vc-display-status
(vc-rcs-status file))))) (vc-status file vc-type)))))
;; Even root shouldn't modify a registered file without locking it first. ;; Even root shouldn't modify a registered file without
;; locking it first.
(and vc-type (and vc-type
(not buffer-read-only) (not buffer-read-only)
(zerop (user-uid)) (zerop (user-uid))
...@@ -158,9 +160,9 @@ visiting FILE." ...@@ -158,9 +160,9 @@ visiting FILE."
;;(set-buffer-modified-p (buffer-modified-p)) ;;use this if Emacs 18 ;;(set-buffer-modified-p (buffer-modified-p)) ;;use this if Emacs 18
vc-type))) vc-type)))
(defun vc-rcs-status (file) (defun vc-status (file vc-type)
;; Return string for placement in modeline by `vc-mode-line'. ;; 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 ;; If FILE is registered but not locked, return " REV" if there is a head
;; revision and " @@" otherwise. ;; revision and " @@" otherwise.
;; If FILE is locked then return all locks in a string of the ;; If FILE is locked then return all locks in a string of the
...@@ -169,18 +171,19 @@ visiting FILE." ...@@ -169,18 +171,19 @@ visiting FILE."
;; Algorithm: ;; 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 ;; RCS: Insert the first few characters of the master file into a
;; buffer. ;; work buffer. Search work buffer for "locks...;" phrase; if not
;; ;; found, then keep inserting more characters until the phrase is
;; 3. Search work buffer for "locks...;" phrase; if not found, then ;; found. Extract the locks, and remove control characters
;; keep inserting more characters until the phrase is found.
;;
;; 4. Extract the locks, and remove control characters
;; separating them, like newlines; the string " user1:revision1 ;; separating them, like newlines; the string " user1:revision1
;; user2:revision2 ..." is returned. ;; 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: ;; Limitations:
;; The output doesn't show which version you are actually looking at. ;; The output doesn't show which version you are actually looking at.
...@@ -188,55 +191,85 @@ visiting FILE." ...@@ -188,55 +191,85 @@ visiting FILE."
;; The head revision is probably not what you want if you've used `rcs -b'. ;; The head revision is probably not what you want if you've used `rcs -b'.
(let ((master (vc-name file)) (let ((master (vc-name file))
found) found
status)
;; If master file exists, then parse its contents, otherwise we return the ;; If master file exists, then parse its contents, otherwise we
;; nil value of this if form. ;; return the nil value of this if form.
(if master (if (and master vc-type)
(save-excursion (save-excursion
;; Create work buffer. ;; Create work buffer.
(set-buffer (get-buffer-create " *vc-rcs-status*")) (set-buffer (get-buffer-create " *vc-status*"))
(setq buffer-read-only nil (setq buffer-read-only nil
default-directory (file-name-directory master)) default-directory (file-name-directory master))
(erase-buffer) (erase-buffer)
;; Check if we have enough of the header. ;; Set the `status' var to the return value.
;; If not, then keep including more. (cond
(while
(not (or found ;; RCS code.
(let ((s (buffer-size))) ((eq vc-type 'RCS)
(goto-char (1+ s)) ;; Check if we have enough of the header.
(zerop (car (cdr (insert-file-contents ;; If not, then keep including more.
master nil s (+ s 8192)))))))) (while
(beginning-of-line) (not (or found
(setq found (re-search-forward "^locks\\([^;]*\\);" nil t))) (let ((s (buffer-size)))
(goto-char (1+ s))
(if found (zerop (car (cdr (insert-file-contents
;; Clean control characters and self-locks from text. master nil s (+ s 8192))))))))
(let* ((lock-pattern (beginning-of-line)
(concat "[ \b\t\n\v\f\r]+\\(" (setq found (re-search-forward "^locks\\([^;]*\\);" nil t)))
(regexp-quote (user-login-name))
":\\)?")) (if found
(locks ;; Clean control characters and self-locks from text.
(save-restriction (let* ((lock-pattern
(narrow-to-region (match-beginning 1) (match-end 1)) (concat "[ \b\t\n\v\f\r]+\\("
(goto-char (point-min)) (regexp-quote (user-login-name))
(while (re-search-forward lock-pattern nil t) ":\\)?"))
(replace-match (if (eobp) "" ":") t t)) (locks
(buffer-string))) (save-restriction
(status (narrow-to-region (match-beginning 1) (match-end 1))
(if (not (string-equal locks "")) (goto-char (point-min))
locks (while (re-search-forward lock-pattern nil t)
(goto-char (point-min)) (replace-match (if (eobp) "" ":") t t))
(if (looking-at "head[ \b\t\n\v\f\r]+\\([.0-9]+\\)") (buffer-string))))
(concat "-" (buffer-substring (match-beginning 1) (setq status
(match-end 1))) (if (not (string-equal locks ""))
" @@")))) locks
;; Clean work buffer. (goto-char (point-min))
(erase-buffer) (if (looking-at "head[ \b\t\n\v\f\r]+\\([.0-9]+\\)")
(set-buffer-modified-p nil) (concat "-"
status)))))) (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 ;;; install a call to the above as a find-file hook
(defun vc-find-file-hook () (defun vc-find-file-hook ()
...@@ -258,7 +291,7 @@ visiting FILE." ...@@ -258,7 +291,7 @@ visiting FILE."
"When file is not found, try to check it out from RCS or SCCS. "When file is not found, try to check it out from RCS or SCCS.
Returns t if checkout was successful, nil otherwise." Returns t if checkout was successful, nil otherwise."
(if (vc-backend-deduce buffer-file-name) (if (vc-backend-deduce buffer-file-name)
(progn (save-excursion
(require 'vc) (require 'vc)
(not (vc-error-occurred (vc-checkout buffer-file-name)))))) (not (vc-error-occurred (vc-checkout buffer-file-name))))))
...@@ -284,8 +317,40 @@ Returns t if checkout was successful, nil otherwise." ...@@ -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 "u" 'vc-revert-buffer)
(define-key vc-prefix-map "v" 'vc-next-action) (define-key vc-prefix-map "v" 'vc-next-action)
(define-key vc-prefix-map "=" 'vc-diff) (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) (provide 'vc-hooks)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment