Mercurial > emacs
comparison lisp/vc-hooks.el @ 12561:348341c2d7d1
(vc-mode-line): Don't write-protect a
VC-Log buffer. Better mode line text for initial comments.
Streamlined the function.
(vc-locking-user): Consider a cvs file "locked"
if its status is either 'locally-modified or 'needs-merge.
(vc-workfile-version): Catch 'found when calling vc-find-cvs-master.
(vc-fetch-master-properties): Handle cvs status "Needs Checkout".
This is intended for future use.
(vc-fetch-master-properties): Shrink the window
that displays the error message.
| author | Karl Heuer <kwzh@gnu.org> |
|---|---|
| date | Mon, 17 Jul 1995 22:56:28 +0000 |
| parents | cca1dbc550dd |
| children | a771c59393e7 |
comparison
equal
deleted
inserted
replaced
| 12560:fc8171b983be | 12561:348341c2d7d1 |
|---|---|
| 290 (setq exec-status | 290 (setq exec-status |
| 291 (apply 'call-process "cvs" nil "*vc-info*" nil | 291 (apply 'call-process "cvs" nil "*vc-info*" nil |
| 292 (list "status" file))) | 292 (list "status" file))) |
| 293 (cond ((> exec-status 0) | 293 (cond ((> exec-status 0) |
| 294 (switch-to-buffer (get-file-buffer file)) | 294 (switch-to-buffer (get-file-buffer file)) |
| 295 (display-buffer "*vc-info*") | 295 (shrink-window-if-larger-than-buffer |
| 296 (display-buffer "*vc-info*")) | |
| 296 (error "Couldn't find version control information")))) | 297 (error "Couldn't find version control information")))) |
| 297 (set-buffer (get-buffer "*vc-info*")) | 298 (set-buffer (get-buffer "*vc-info*")) |
| 298 (set-buffer-modified-p nil) | 299 (set-buffer-modified-p nil) |
| 299 (auto-save-mode nil) | 300 (auto-save-mode nil) |
| 300 (vc-parse-buffer | 301 (vc-parse-buffer |
| 313 (nth 5 (file-attributes file)))) | 314 (nth 5 (file-attributes file)))) |
| 314 ((string-match "Locally Modified" status) | 315 ((string-match "Locally Modified" status) |
| 315 (vc-file-setprop file 'vc-cvs-status 'locally-modified)) | 316 (vc-file-setprop file 'vc-cvs-status 'locally-modified)) |
| 316 ((string-match "Needs Merge" status) | 317 ((string-match "Needs Merge" status) |
| 317 (vc-file-setprop file 'vc-cvs-status 'needs-merge)) | 318 (vc-file-setprop file 'vc-cvs-status 'needs-merge)) |
| 319 ((string-match "Needs Checkout" status) | |
| 320 (vc-file-setprop file 'vc-cvs-status 'needs-checkout)) | |
| 318 (t (vc-file-setprop file 'vc-cvs-status nil)))))) | 321 (t (vc-file-setprop file 'vc-cvs-status nil)))))) |
| 319 (if (get-buffer "*vc-info*") | 322 (if (get-buffer "*vc-info*") |
| 320 (kill-buffer (get-buffer "*vc-info*"))))) | 323 (kill-buffer (get-buffer "*vc-info*"))))) |
| 321 | 324 |
| 322 ;;; Functions that determine property values, by examining the | 325 ;;; Functions that determine property values, by examining the |
| 488 | 491 |
| 489 ;; otherwise, infer the property... | 492 ;; otherwise, infer the property... |
| 490 (cond | 493 (cond |
| 491 ;; in the CVS case, check the status | 494 ;; in the CVS case, check the status |
| 492 ((eq (vc-backend file) 'CVS) | 495 ((eq (vc-backend file) 'CVS) |
| 493 (if (eq (vc-cvs-status file) 'up-to-date) | 496 (if (and (not (eq (vc-cvs-status file) 'locally-modified)) |
| 497 (not (eq (vc-cvs-status file) 'needs-merge))) | |
| 494 (vc-file-setprop file 'vc-locking-user 'none) | 498 (vc-file-setprop file 'vc-locking-user 'none) |
| 495 ;; The expression below should return the username of the owner | 499 ;; The expression below should return the username of the owner |
| 496 ;; of the file. It doesn't. It returns the username if it is | 500 ;; of the file. It doesn't. It returns the username if it is |
| 497 ;; you, or otherwise the UID of the owner of the file. The | 501 ;; you, or otherwise the UID of the owner of the file. The |
| 498 ;; return value from this function is only used by | 502 ;; return value from this function is only used by |
| 615 (vc-file-setprop file 'vc-workfile-version rev) | 619 (vc-file-setprop file 'vc-workfile-version rev) |
| 616 rev))) | 620 rev))) |
| 617 ((eq (vc-backend file) 'CVS) | 621 ((eq (vc-backend file) 'CVS) |
| 618 (if (vc-consult-rcs-headers file) ;; CVS | 622 (if (vc-consult-rcs-headers file) ;; CVS |
| 619 (vc-file-getprop file 'vc-workfile-version) | 623 (vc-file-getprop file 'vc-workfile-version) |
| 620 (vc-find-cvs-master (file-name-directory file) | 624 (catch 'found |
| 621 (file-name-nondirectory file)) | 625 (vc-find-cvs-master (file-name-directory file) |
| 626 (file-name-nondirectory file))) | |
| 622 (vc-file-getprop file 'vc-workfile-version))))) | 627 (vc-file-getprop file 'vc-workfile-version))))) |
| 623 | 628 |
| 624 ;;; actual version-control code starts here | 629 ;;; actual version-control code starts here |
| 625 | 630 |
| 626 (defun vc-registered (file) | 631 (defun vc-registered (file) |
| 722 "Set `vc-mode' to display type of version control for FILE. | 727 "Set `vc-mode' to display type of version control for FILE. |
| 723 The value is set in the current buffer, which should be the buffer | 728 The value is set in the current buffer, which should be the buffer |
| 724 visiting FILE. Second optional arg LABEL is put in place of version | 729 visiting FILE. Second optional arg LABEL is put in place of version |
| 725 control system name." | 730 control system name." |
| 726 (interactive (list buffer-file-name nil)) | 731 (interactive (list buffer-file-name nil)) |
| 727 (let ((vc-type (vc-backend file)) | 732 (let ((vc-type (vc-backend file))) |
| 728 (vc-status-string (and vc-display-status (vc-status file)))) | |
| 729 (setq vc-mode | 733 (setq vc-mode |
| 730 (concat " " (or label (symbol-name vc-type)) vc-status-string)) | 734 (and vc-type |
| 731 ;; Make the buffer read-only if the file is not locked | 735 (concat " " (or label (symbol-name vc-type)) |
| 732 ;; (or unchanged, in the CVS case). | 736 (and vc-display-status (vc-status file))))) |
| 733 ;; Determine this by looking at the mode string, | 737 (and vc-type |
| 734 ;; so that no further external status query is necessary | 738 (equal file (buffer-file-name)) |
| 735 (if vc-status-string | 739 ;; Make the buffer read-only if the file is not locked |
| 736 (if (eq (elt vc-status-string 0) ?-) | 740 ;; (or unchanged, in the CVS case). |
| 737 (setq buffer-read-only t)) | 741 (if (not (vc-locking-user file)) |
| 738 (if (not (vc-locking-user file)) | 742 (setq buffer-read-only t)) |
| 739 (setq buffer-read-only t))) | 743 ;; Even root shouldn't modify a registered file without |
| 740 ;; Even root shouldn't modify a registered file without | 744 ;; locking it first. |
| 741 ;; locking it first. | |
| 742 (and vc-type | |
| 743 (not buffer-read-only) | 745 (not buffer-read-only) |
| 744 (zerop (user-uid)) | 746 (zerop (user-uid)) |
| 745 (require 'vc) | |
| 746 (not (equal (user-login-name) (vc-locking-user file))) | 747 (not (equal (user-login-name) (vc-locking-user file))) |
| 747 (setq buffer-read-only t)) | 748 (setq buffer-read-only t)) |
| 748 (and (null vc-type) | 749 (and (null vc-type) |
| 749 (file-symlink-p file) | 750 (file-symlink-p file) |
| 750 (let ((link-type (vc-backend (file-symlink-p file)))) | 751 (let ((link-type (vc-backend (file-symlink-p file)))) |