# HG changeset patch # User Andr Spiegel # Date 809033152 0 # Node ID 22f47b2375c185ad4a56a207d3b80510c4585f94 # Parent 92c12902ae8d3ab3cf63f75816cac94ebb0b1ed2 (vc-fetch-master-properties): RCS case: get locking mode. CVS case: new state `locally-added'. (vc-locking-user): Under RCS with non-strict locking, don't trust the file permissions. CVS case: change which states count as "locked". (vc-consult-rcs-headers): Streamlined. Don't set vc-locking-user if this is called under CVS. Under RCS, use a heuristic to find the value of vc-checkout-model without examining the master file. (vc-parse-locks): Set vc-checkout-model. (vc-status): Comment change. (vc-after-save-hook, vc-after-save): The former renamed to the latter. Now unconditionally called by `basic-save-buffer', determines whether the buffer should be "locked" or not. (vc-mode-line): No longer use dynamic after-save-hook. Changed references to `automatic' into `implicit'. (vc-checkout-model): Values are now `manual' and `implicit'. Derive the property on a per-file basis, supporting all possible modes. diff -r 92c12902ae8d -r 22f47b2375c1 lisp/vc-hooks.el --- a/lisp/vc-hooks.el Mon Aug 21 18:48:21 1995 +0000 +++ b/lisp/vc-hooks.el Mon Aug 21 19:25:52 1995 +0000 @@ -67,14 +67,21 @@ (defvar vc-consult-headers t "*Identify work files by searching for version headers.") -(defvar vc-mistrust-permissions nil - "*Don't assume that permissions and ownership track version-control status.") - (defvar vc-keep-workfiles t "*If non-nil, don't delete working files after registering changes. If the back-end is CVS, workfiles are always kept, regardless of the value of this flag.") +(defvar vc-mistrust-permissions nil + "*Don't assume that permissions and ownership track version-control status.") + +(defun vc-mistrust-permissions (file) + ;; Access function to the above. + (or (eq vc-mistrust-permissions 't) + (and vc-mistrust-permissions + (funcall vc-mistrust-permissions + (vc-backend-subdirectory-name file))))) + ;; Tell Emacs about this new kind of minor mode (if (not (assoc 'vc-mode minor-mode-alist)) (setq minor-mode-alist (cons '(vc-mode vc-mode) @@ -218,7 +225,10 @@ (match-beginning 1) (match-end 1))) (setq master-locks (append master-locks (list (cons version user)))) - (setq index (match-end 0))))) + (setq index (match-end 0))) + (if (string-match ";[ \t\n]+strict;" locks index) + (vc-file-setprop file 'vc-checkout-model 'manual) + (vc-file-setprop file 'vc-checkout-model 'implicit)))) (vc-file-setprop file 'vc-master-locks (or master-locks 'none))))) (defun vc-fetch-master-properties (file) @@ -244,11 +254,11 @@ ((eq (vc-backend file) 'RCS) (set-buffer (get-buffer-create "*vc-info*")) - (vc-insert-file (vc-name file) "^locks") + (vc-insert-file (vc-name file) "^[0-9]") (vc-parse-buffer (list '("^head[ \t\n]+\\([^;]+\\);" 1) '("^branch[ \t\n]+\\([^;]+\\);" 1) - '("^locks\\([^;]+\\);" 1)) + '("^locks[ \t\n]*\\([^;]*;\\([ \t\n]*strict;\\)?\\)" 1)) file '(vc-head-version vc-default-branch @@ -309,19 +319,19 @@ ;; Translate those status values that are needed into symbols. ;; Any other value is converted to nil. (let ((status (vc-file-getprop file 'vc-cvs-status))) - (cond ((string-match "Up-to-date" status) - (vc-file-setprop file 'vc-cvs-status 'up-to-date) - (vc-file-setprop file 'vc-checkout-time - (nth 5 (file-attributes file)))) - ((string-match "Locally Modified" status) - (vc-file-setprop file 'vc-cvs-status 'locally-modified)) - ((string-match "Needs Merge" status) - (vc-file-setprop file 'vc-cvs-status 'needs-merge)) - ((string-match "Needs Checkout" status) - (vc-file-setprop file 'vc-cvs-status 'needs-checkout)) - ((string-match "Unresolved Conflict" status) - (vc-file-setprop file 'vc-cvs-status 'unresolved-conflict)) - (t (vc-file-setprop file 'vc-cvs-status nil)))))) + (cond + ((string-match "Up-to-date" status) + (vc-file-setprop file 'vc-cvs-status 'up-to-date) + (vc-file-setprop file 'vc-checkout-time + (nth 5 (file-attributes file)))) + ((vc-file-setprop file 'vc-cvs-status + (cond + ((string-match "Locally Modified" status) 'locally-modified) + ((string-match "Needs Merge" status) 'needs-merge) + ((string-match "Needs Checkout" status) 'needs-checkout) + ((string-match "Unresolved Conflict" status) 'unresolved-conflict) + ((string-match "Locally Added" status) 'locally-added) + ))))))) (if (get-buffer "*vc-info*") (kill-buffer (get-buffer "*vc-info*"))))) @@ -338,10 +348,11 @@ ;; visiting FILE) ;; 'rev if a workfile revision was found ;; 'rev-and-lock if revision and lock info was found - (cond + (cond ((or (not vc-consult-headers) (not (get-file-buffer file))) nil) - ((save-excursion + ((let (status version locking-user) + (save-excursion (set-buffer (get-file-buffer file)) (goto-char (point-min)) (cond @@ -354,63 +365,69 @@ (looking-at "[^ ]+ \\([0-9.]+\\) "))) (goto-char (match-end 0)) ;; if found, store the revision number ... - (let ((rev (buffer-substring (match-beginning 1) - (match-end 1)))) - ;; ... and check for the locking state + (setq version (buffer-substring (match-beginning 1) (match-end 1))) + ;; ... and check for the locking state + (cond + ((looking-at + (concat "[0-9]+[/-][01][0-9][/-][0-3][0-9] " ; date + "[0-2][0-9]:[0-5][0-9]+:[0-6][0-9]+\\([+-][0-9:]+\\)? " ; time + "[^ ]+ [^ ]+ ")) ; author & state + (goto-char (match-end 0)) ; [0-6] in regexp handles leap seconds (cond - ((looking-at - (concat "[0-9]+[/-][01][0-9][/-][0-3][0-9] " ; date - "[0-2][0-9]:[0-5][0-9]+:[0-6][0-9]+\\([+-][0-9:]+\\)? " ; time - "[^ ]+ [^ ]+ ")) ; author & state - (goto-char (match-end 0)) ; [0-6] in regexp handles leap seconds - (cond - ;; unlocked revision - ((looking-at "\\$") - (vc-file-setprop file 'vc-workfile-version rev) - (vc-file-setprop file 'vc-locking-user 'none) - 'rev-and-lock) - ;; revision is locked by some user - ((looking-at "\\([^ ]+\\) \\$") - (vc-file-setprop file 'vc-workfile-version rev) - (vc-file-setprop file 'vc-locking-user - (buffer-substring (match-beginning 1) - (match-end 1))) - 'rev-and-lock) - ;; everything else: false - (nil))) - ;; unexpected information in - ;; keyword string --> quit - (nil)))) + ;; unlocked revision + ((looking-at "\\$") + (setq locking-user 'none) + (setq status 'rev-and-lock)) + ;; revision is locked by some user + ((looking-at "\\([^ ]+\\) \\$") + (setq locking-user + (buffer-substring (match-beginning 1) (match-end 1))) + (setq status 'rev-and-lock)) + ;; everything else: false + (nil))) + ;; unexpected information in + ;; keyword string --> quit + (nil))) ;; search for $Revision ;; -------------------- ((re-search-forward (concat "\\$" "Revision: \\([0-9.]+\\) \\$") nil t) ;; if found, store the revision number ... - (let ((rev (buffer-substring (match-beginning 1) - (match-end 1)))) - ;; and see if there's any lock information - (goto-char (point-min)) - (if (re-search-forward (concat "\\$" "Locker:") nil t) - (cond ((looking-at " \\([^ ]+\\) \\$") - (vc-file-setprop file 'vc-workfile-version rev) - (vc-file-setprop file 'vc-locking-user - (buffer-substring (match-beginning 1) + (setq version (buffer-substring (match-beginning 1) (match-end 1))) + ;; and see if there's any lock information + (goto-char (point-min)) + (if (re-search-forward (concat "\\$" "Locker:") nil t) + (cond ((looking-at " \\([^ ]+\\) \\$") + (setq locking-user (buffer-substring (match-beginning 1) (match-end 1))) - 'rev-and-lock) - ((looking-at " *\\$") - (vc-file-setprop file 'vc-workfile-version rev) - (vc-file-setprop file 'vc-locking-user 'none) - 'rev-and-lock) - (t - (vc-file-setprop file 'vc-workfile-version rev) - (vc-file-setprop file 'vc-locking-user 'none) - 'rev-and-lock)) - (vc-file-setprop file 'vc-workfile-version rev) - 'rev))) + (setq status 'rev-and-lock)) + ((looking-at " *\\$") + (setq locking-user 'none) + (setq status 'rev-and-lock)) + (t + (setq locking-user 'none) + (setq status 'rev-and-lock))) + (setq status 'rev))) ;; else: nothing found ;; ------------------- - (t nil)))))) + (t nil))) + (if status (vc-file-setprop file 'vc-workfile-version version)) + (and (eq status 'rev-and-lock) + (eq (vc-backend file) 'RCS) + (vc-file-setprop file 'vc-locking-user locking-user) + ;; If the file has headers, we don't want to query the master file, + ;; because that would eliminate all the performance gain the headers + ;; brought us. We therefore use a heuristic for the checkout model + ;; now: If we trust the file permissions, and the file is not + ;; locked, then if the file is read-only the checkout model is + ;; `manual', otherwise `implicit'. + (not (vc-mistrust-permissions file)) + (not (vc-locking-user file)) + (if (string-match ".r-..-..-." (nth 8 (file-attributes file))) + (vc-file-setprop file 'vc-checkout-model 'manual) + (vc-file-setprop file 'vc-checkout-model 'implicit)) + status))))) ;;; Access functions to file properties ;;; (Properties should be _set_ using vc-file-setprop, but @@ -451,13 +468,20 @@ (defun vc-checkout-model (file) ;; Return `manual' if the user has to type C-x C-q to check out FILE. - ;; Return `automatic' if the file can be modified without locking it first. - ;; Simplistic version, only returns the default for each backend. - (cond ((vc-file-getprop file 'vc-checkout-model)) - ((vc-file-setprop file 'vc-checkout-model - (cond ((eq (vc-backend file) 'SCCS) 'manual) - ((eq (vc-backend file) 'RCS) 'manual) - ((eq (vc-backend file) 'CVS) 'automatic)))))) + ;; Return `implicit' if the file can be modified without locking it first. + (or + (vc-file-getprop file 'vc-checkout-model) + (cond + ((eq (vc-backend file) 'SCCS) + (vc-file-setprop file 'vc-checkout-model 'manual)) + ((eq (vc-backend file) 'RCS) + (vc-consult-rcs-headers file) + (or (vc-file-getprop file 'vc-checkout-model) + (progn (vc-fetch-master-properties file) + (vc-file-getprop file 'vc-checkout-model)))) + ((eq (vc-backend file) 'CVS) + (vc-file-setprop file 'vc-checkout-model + (if (getenv "CVSREAD") 'manual 'implicit)))))) ;;; properties indicating the locking state @@ -506,9 +530,8 @@ (cond ;; in the CVS case, check the status ((eq (vc-backend file) 'CVS) - (if (and (not (eq (vc-cvs-status file) 'locally-modified)) - (not (eq (vc-cvs-status file) 'needs-merge)) - (not (eq (vc-cvs-status file) 'unresolved-conflict))) + (if (or (eq (vc-cvs-status file) 'up-to-date) + (eq (vc-cvs-status file) 'needs-checkout)) (vc-file-setprop file 'vc-locking-user 'none) ;; The expression below should return the username of the owner ;; of the file. It doesn't. It returns the username if it is @@ -535,12 +558,11 @@ (eq (vc-consult-rcs-headers file) 'rev-and-lock))) ;; if the file permissions are not trusted, + ;; or if locking is not strict, ;; use the information from the master file ((or (not vc-keep-workfiles) - (eq vc-mistrust-permissions 't) - (and vc-mistrust-permissions - (funcall vc-mistrust-permissions - (vc-backend-subdirectory-name file)))) + (vc-mistrust-permissions file) + (eq (vc-checkout-model file) 'implicit)) (vc-file-setprop file 'vc-locking-user (vc-master-locking-user file))) ;; Otherwise: Use the file permissions. (But if it turns out that the @@ -735,11 +757,23 @@ (toggle-read-only))) (define-key global-map "\C-x\C-q" 'vc-toggle-read-only) -(defun vc-after-save-hook () - ;; Mark the file in the current buffer as "locked" by the user. - (remove-hook 'after-save-hook 'vc-after-save-hook t) - (vc-file-setprop (buffer-file-name) 'vc-locking-user (user-login-name)) - (vc-mode-line (buffer-file-name))) +(defun vc-after-save () + ;; Function to be called by basic-save-buffer (in files.el). + ;; If the file in the current buffer is under version control, + ;; not locked, and the checkout model for it is `implicit', + ;; mark it "locked" and redisplay the mode line. + (let ((file (buffer-file-name))) + (and (vc-file-getprop file 'vc-backend) + ;; ...check the property directly, not through the function of the + ;; same name. Otherwise Emacs would check for a master file + ;; each time a non-version-controlled buffer is saved. + ;; The property is computed when the file is visited, so if it + ;; is `nil' now, it is certain that the file is NOT + ;; version-controlled. + (not (vc-locking-user file)) + (eq (vc-checkout-model file) 'implicit) + (vc-file-setprop file 'vc-locking-user (user-login-name)) + (vc-mode-line file)))) (defun vc-mode-line (file &optional label) "Set `vc-mode' to display type of version control for FILE. @@ -754,19 +788,12 @@ (and vc-display-status (vc-status file))))) (and vc-type (equal file (buffer-file-name)) - (if (vc-locking-user file) - ;; If the file is locked by some other user, make - ;; the buffer read-only. Like this, even root - ;; cannot modify a file without locking it first. - (if (not (string= (user-login-name) (vc-locking-user file))) - (setq buffer-read-only t)) - ;; If the file is not locked, and vc-checkout-model is - ;; `automatic', install a hook that will make the file - ;; "locked" when the buffer is saved. - (cond ((eq (vc-checkout-model file) 'automatic) - (make-local-variable 'after-save-hook) - (make-local-hook 'after-save-hook) - (add-hook 'after-save-hook 'vc-after-save-hook t))))) + (vc-locking-user file) + ;; If the file is locked by some other user, make + ;; the buffer read-only. Like this, even root + ;; cannot modify a file without locking it first. + (not (string= (user-login-name) (vc-locking-user file))) + (setq buffer-read-only t)) (force-mode-line-update) ;;(set-buffer-modified-p (buffer-modified-p)) ;;use this if Emacs 18 vc-type)) @@ -782,8 +809,8 @@ ;; ;; In the CVS case, a "locked" working file is a ;; working file that is modified with respect to the master. - ;; The file is "locked" from the moment when the user makes - ;; the buffer writable. + ;; The file is "locked" from the moment when the user saves + ;; the modified buffer. ;; ;; This function assumes that the file is registered.