148 |
;; contents with those of the master version. If the backend does not |
;; contents with those of the master version. If the backend does not |
149 |
;; have such a brief-comparison feature, the default implementation of |
;; have such a brief-comparison feature, the default implementation of |
150 |
;; this function can be used, which delegates to a full |
;; this function can be used, which delegates to a full |
151 |
;; vc-BACKEND-diff. |
;; vc-BACKEND-diff. (Note that vc-BACKEND-diff must not run |
152 |
|
;; asynchronously in this case.) |
153 |
;; |
;; |
154 |
;; - mode-line-string (file) |
;; - mode-line-string (file) |
155 |
;; |
;; |
211 |
;; check-in comment. The implementation should pass the value of |
;; check-in comment. The implementation should pass the value of |
212 |
;; vc-checkin-switches to the backend command. |
;; vc-checkin-switches to the backend command. |
213 |
;; |
;; |
214 |
;; * checkout (file &optional editable rev destfile) |
;; * find-version (file rev buffer) |
215 |
|
;; |
216 |
|
;; Fetch revision REV of file FILE and put it into BUFFER. |
217 |
|
;; If REV is the empty string, fetch the head of the trunk. |
218 |
|
;; The implementation should pass the value of vc-checkout-switches |
219 |
|
;; to the backend command. |
220 |
|
;; |
221 |
|
;; * checkout (file &optional editable rev) |
222 |
;; |
;; |
223 |
;; Check out revision REV of FILE into the working area. If EDITABLE |
;; Check out revision REV of FILE into the working area. If EDITABLE |
224 |
;; is non-nil, FILE should be writable by the user and if locking is |
;; is non-nil, FILE should be writable by the user and if locking is |
225 |
;; used for FILE, a lock should also be set. If REV is non-nil, that |
;; used for FILE, a lock should also be set. If REV is non-nil, that |
226 |
;; is the revision to check out (default is current workfile version); |
;; is the revision to check out (default is current workfile version). |
227 |
;; if REV is the empty string, that means to check out the head of the |
;; If REV is t, that means to check out the head of the current branch; |
228 |
;; trunk. If optional arg DESTFILE is given, it is an alternate |
;; if it is the empty string, check out the head of the trunk. |
229 |
;; filename to write the contents to. The implementation should |
;; The implementation should pass the value of vc-checkout-switches |
230 |
;; pass the value of vc-checkout-switches to the backend command. |
;; to the backend command. |
231 |
;; |
;; |
232 |
;; * revert (file &optional contents-done) |
;; * revert (file &optional contents-done) |
233 |
;; |
;; |
645 |
:group 'vc) |
:group 'vc) |
646 |
|
|
647 |
(defcustom vc-checkout-carefully (= (user-uid) 0) |
(defcustom vc-checkout-carefully (= (user-uid) 0) |
648 |
"*This variable is obsolete |
"*Non-nil means be extra-careful in checkout. |
|
The corresponding checks are always done now. |
|
|
From the old doc string: |
|
|
|
|
|
Non-nil means be extra-careful in checkout. |
|
649 |
Verify that the file really is not locked |
Verify that the file really is not locked |
650 |
and that its contents match what the master file says." |
and that its contents match what the master file says." |
651 |
:type 'boolean |
:type 'boolean |
652 |
:group 'vc) |
:group 'vc) |
653 |
|
(make-obsolete-variable 'vc-checkout-carefully |
654 |
|
"the corresponding checks are always done now." |
655 |
|
"21.1") |
656 |
|
|
657 |
|
|
658 |
;; The main keymap |
;; The main keymap |
660 |
;; Initialization code, to be done just once at load-time |
;; Initialization code, to be done just once at load-time |
661 |
(defvar vc-log-mode-map |
(defvar vc-log-mode-map |
662 |
(let ((map (make-sparse-keymap))) |
(let ((map (make-sparse-keymap))) |
663 |
|
(set-keymap-parent map text-mode-map) |
664 |
(define-key map "\M-n" 'vc-next-comment) |
(define-key map "\M-n" 'vc-next-comment) |
665 |
(define-key map "\M-p" 'vc-previous-comment) |
(define-key map "\M-p" 'vc-previous-comment) |
666 |
(define-key map "\M-r" 'vc-comment-search-reverse) |
(define-key map "\M-r" 'vc-comment-search-reverse) |
721 |
(defun vc-default-previous-version (backend file rev) |
(defun vc-default-previous-version (backend file rev) |
722 |
"Guess the version number immediately preceding REV for FILE. |
"Guess the version number immediately preceding REV for FILE. |
723 |
This default implementation works for <major>.<minor>-style version numbers |
This default implementation works for <major>.<minor>-style version numbers |
724 |
as used by RCS and CVS." |
as used by RCS and CVS." |
725 |
(let ((branch (vc-branch-part rev)) |
(let ((branch (vc-branch-part rev)) |
726 |
(minor-num (string-to-number (vc-minor-part rev)))) |
(minor-num (string-to-number (vc-minor-part rev)))) |
727 |
(when branch |
(when branch |
781 |
(error (format "File not under version control: `%s'" file))) |
(error (format "File not under version control: `%s'" file))) |
782 |
(unless (vc-editable-p ,filevar) |
(unless (vc-editable-p ,filevar) |
783 |
(let ((state (vc-state ,filevar))) |
(let ((state (vc-state ,filevar))) |
784 |
(if (stringp state) |
(if (stringp state) |
785 |
(error (format "`%s' is locking `%s'" state ,filevar)) |
(error (format "`%s' is locking `%s'" state ,filevar)) |
786 |
(vc-checkout ,filevar t)))) |
(vc-checkout ,filevar t)))) |
787 |
(save-excursion |
(save-excursion |
817 |
(if (not (vc-backend (buffer-file-name))) |
(if (not (vc-backend (buffer-file-name))) |
818 |
(error "File %s is not under version control" (buffer-file-name)))))) |
(error "File %s is not under version control" (buffer-file-name)))))) |
819 |
|
|
|
(defvar vc-binary-assoc nil) |
|
|
(defvar vc-binary-suffixes |
|
|
(if (memq system-type '(ms-dos windows-nt)) |
|
|
'(".exe" ".com" ".bat" ".cmd" ".btm" "") |
|
|
'(""))) |
|
|
|
|
820 |
(defun vc-process-filter (p s) |
(defun vc-process-filter (p s) |
821 |
"An alternative output filter for async process P. |
"An alternative output filter for async process P. |
822 |
The only difference with the default filter is to insert S after markers." |
The only difference with the default filter is to insert S after markers." |
1072 |
(unless not-urgent |
(unless not-urgent |
1073 |
(error "Aborted"))))) |
(error "Aborted"))))) |
1074 |
|
|
|
(defun vc-workfile-unchanged-p (file) |
|
|
"Return non-nil if FILE has not changed since the last checkout." |
|
|
(let ((checkout-time (vc-file-getprop file 'vc-checkout-time)) |
|
|
(lastmod (nth 5 (file-attributes file)))) |
|
|
(if checkout-time |
|
|
(equal checkout-time lastmod) |
|
|
(let ((unchanged (vc-call workfile-unchanged-p file))) |
|
|
(vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0)) |
|
|
unchanged)))) |
|
|
|
|
|
(defun vc-default-workfile-unchanged-p (backend file) |
|
|
"Check if FILE is unchanged by diffing against the master version. |
|
|
Return non-nil if FILE is unchanged." |
|
|
(zerop (vc-call diff file (vc-workfile-version file)))) |
|
|
|
|
1075 |
(defun vc-default-latest-on-branch-p (backend file) |
(defun vc-default-latest-on-branch-p (backend file) |
1076 |
"Return non-nil if FILE is the latest on its branch. |
"Return non-nil if FILE is the latest on its branch. |
1077 |
This default implementation always returns non-nil, which means that |
This default implementation always returns non-nil, which means that |
1091 |
(let ((visited (get-file-buffer file)) |
(let ((visited (get-file-buffer file)) |
1092 |
state version) |
state version) |
1093 |
(when visited |
(when visited |
1094 |
|
(if vc-dired-mode |
1095 |
|
(switch-to-buffer-other-window visited) |
1096 |
|
(set-buffer visited)) |
1097 |
;; Check relation of buffer and file, and make sure |
;; Check relation of buffer and file, and make sure |
1098 |
;; user knows what he's doing. First, finding the file |
;; user knows what he's doing. First, finding the file |
1099 |
;; will check whether the file on disk is newer. |
;; will check whether the file on disk is newer. |
1100 |
(if vc-dired-mode |
;; Ignore buffer-read-only during this test, and |
1101 |
(find-file-other-window file) |
;; preserve find-file-literally. |
1102 |
(set-buffer (find-file-noselect file))) |
(let ((buffer-read-only (not (file-writable-p file)))) |
1103 |
|
(find-file-noselect file nil find-file-literally)) |
1104 |
(if (not (verify-visited-file-modtime (current-buffer))) |
(if (not (verify-visited-file-modtime (current-buffer))) |
1105 |
(if (yes-or-no-p "Replace file on disk with buffer contents? ") |
(if (yes-or-no-p "Replace file on disk with buffer contents? ") |
1106 |
(write-file (buffer-file-name)) |
(write-file (buffer-file-name)) |
1188 |
(if (yes-or-no-p (format |
(if (yes-or-no-p (format |
1189 |
"%s is not up-to-date. Get latest version? " |
"%s is not up-to-date. Get latest version? " |
1190 |
(file-name-nondirectory file))) |
(file-name-nondirectory file))) |
1191 |
(vc-checkout file (eq (vc-checkout-model file) 'implicit) "") |
(vc-checkout file (eq (vc-checkout-model file) 'implicit) t) |
1192 |
(if (and (not (eq (vc-checkout-model file) 'implicit)) |
(if (and (not (eq (vc-checkout-model file) 'implicit)) |
1193 |
(yes-or-no-p "Lock this version? ")) |
(yes-or-no-p "Lock this version? ")) |
1194 |
(vc-checkout file t) |
(vc-checkout file t) |
1215 |
(yes-or-no-p (concat "File has unlocked changes. " |
(yes-or-no-p (concat "File has unlocked changes. " |
1216 |
"Claim lock retaining changes? "))) |
"Claim lock retaining changes? "))) |
1217 |
(progn (vc-call steal-lock file) |
(progn (vc-call steal-lock file) |
1218 |
|
(clear-visited-file-modtime) |
1219 |
;; Must clear any headers here because they wouldn't |
;; Must clear any headers here because they wouldn't |
1220 |
;; show that the file is locked now. |
;; show that the file is locked now. |
1221 |
(vc-clear-headers file) |
(vc-clear-headers file) |
1222 |
|
(write-file (buffer-file-name)) |
1223 |
(vc-mode-line file)) |
(vc-mode-line file)) |
1224 |
(if (not (yes-or-no-p |
(if (not (yes-or-no-p |
1225 |
"Revert to checked-in version, instead? ")) |
"Revert to checked-in version, instead? ")) |
1780 |
(setq rel1-default (vc-workfile-version file))) |
(setq rel1-default (vc-workfile-version file))) |
1781 |
;; if the file is not locked, use last and previous version as default |
;; if the file is not locked, use last and previous version as default |
1782 |
(t |
(t |
1783 |
(setq rel1-default (vc-call previous-version file |
(setq rel1-default (vc-call previous-version file |
1784 |
(vc-workfile-version file))) |
(vc-workfile-version file))) |
1785 |
(if (string= rel1-default "") (setq rel1-default nil)) |
(if (string= rel1-default "") (setq rel1-default nil)) |
1786 |
(setq rel2-default (vc-workfile-version file)))) |
(setq rel2-default (vc-workfile-version file)))) |
1907 |
(if buf (with-current-buffer buf |
(if buf (with-current-buffer buf |
1908 |
buffer-file-coding-system))) |
buffer-file-coding-system))) |
1909 |
;; otherwise, try to find one based on the file name |
;; otherwise, try to find one based on the file name |
1910 |
(car (find-operation-coding-system 'insert-file-contents |
(car (find-operation-coding-system 'insert-file-contents file)) |
|
file)) |
|
1911 |
;; and a final fallback |
;; and a final fallback |
1912 |
'undecided)) |
'undecided)) |
1913 |
|
|
1927 |
(defun vc-find-version (file version) |
(defun vc-find-version (file version) |
1928 |
"Read VERSION of FILE into a buffer and return the buffer." |
"Read VERSION of FILE into a buffer and return the buffer." |
1929 |
(let ((automatic-backup (vc-version-backup-file-name file version)) |
(let ((automatic-backup (vc-version-backup-file-name file version)) |
1930 |
(manual-backup (vc-version-backup-file-name file version 'manual))) |
(filebuf (or (get-file-buffer file) (current-buffer))) |
1931 |
(unless (file-exists-p manual-backup) |
(filename (vc-version-backup-file-name file version 'manual))) |
1932 |
|
(unless (file-exists-p filename) |
1933 |
(if (file-exists-p automatic-backup) |
(if (file-exists-p automatic-backup) |
1934 |
(rename-file automatic-backup manual-backup nil) |
(rename-file automatic-backup filename nil) |
1935 |
(vc-call checkout file nil version manual-backup))) |
(message "Checking out %s..." filename) |
1936 |
(find-file-noselect manual-backup))) |
(with-current-buffer filebuf |
1937 |
|
(let ((failed t)) |
1938 |
|
(unwind-protect |
1939 |
|
(let ((coding-system-for-read 'no-conversion) |
1940 |
|
(coding-system-for-write 'no-conversion)) |
1941 |
|
(with-temp-file filename |
1942 |
|
(let ((outbuf (current-buffer))) |
1943 |
|
;; Change buffer to get local value of |
1944 |
|
;; vc-checkout-switches. |
1945 |
|
(with-current-buffer filebuf |
1946 |
|
(vc-call find-version file version outbuf)))) |
1947 |
|
(setq failed nil)) |
1948 |
|
(if (and failed (file-exists-p filename)) |
1949 |
|
(delete-file filename)))) |
1950 |
|
(vc-mode-line file)) |
1951 |
|
(message "Checking out %s...done" filename))) |
1952 |
|
(find-file-noselect filename))) |
1953 |
|
|
1954 |
|
(defun vc-default-find-version (backend file rev buffer) |
1955 |
|
"Provide the new `find-version' op based on the old `checkout' op. |
1956 |
|
This is only for compatibility with old backends. They should be updated |
1957 |
|
to provide the `find-version' operation instead." |
1958 |
|
(let ((tmpfile (make-temp-file (expand-file-name file)))) |
1959 |
|
(unwind-protect |
1960 |
|
(progn |
1961 |
|
(vc-call-backend backend 'checkout file nil rev tmpfile) |
1962 |
|
(with-current-buffer buffer |
1963 |
|
(insert-file-contents-literally tmpfile))) |
1964 |
|
(delete-file tmpfile)))) |
1965 |
|
|
1966 |
;; Header-insertion code |
;; Header-insertion code |
1967 |
|
|
2063 |
(defun vc-maybe-resolve-conflicts (file status &optional name-A name-B) |
(defun vc-maybe-resolve-conflicts (file status &optional name-A name-B) |
2064 |
(vc-resynch-buffer file t (not (buffer-modified-p))) |
(vc-resynch-buffer file t (not (buffer-modified-p))) |
2065 |
(if (zerop status) (message "Merge successful") |
(if (zerop status) (message "Merge successful") |
2066 |
(if (fboundp 'smerge-mode) (smerge-mode 1)) |
(smerge-mode 1) |
2067 |
(if (y-or-n-p "Conflicts detected. Resolve them now? ") |
(if (y-or-n-p "Conflicts detected. Resolve them now? ") |
2068 |
(if (fboundp 'smerge-ediff) |
(vc-resolve-conflicts name-A name-B) |
|
(smerge-ediff) |
|
|
(vc-resolve-conflicts name-A name-B)) |
|
2069 |
(message "File contains conflict markers")))) |
(message "File contains conflict markers")))) |
2070 |
|
|
2071 |
(defvar vc-ediff-windows) |
;;;###autoload |
2072 |
(defvar vc-ediff-result) |
(defalias 'vc-resolve-conflicts 'smerge-ediff) |
|
(eval-when-compile |
|
|
(defvar ediff-buffer-A) |
|
|
(defvar ediff-buffer-B) |
|
|
(defvar ediff-buffer-C) |
|
|
(require 'ediff-util)) |
|
|
;;;###autoload |
|
|
(defun vc-resolve-conflicts (&optional name-A name-B) |
|
|
"Invoke ediff to resolve conflicts in the current buffer. |
|
|
The conflicts must be marked with rcsmerge conflict markers." |
|
|
(interactive) |
|
|
(vc-ensure-vc-buffer) |
|
|
(let* ((found nil) |
|
|
(file-name (file-name-nondirectory buffer-file-name)) |
|
|
(your-buffer (generate-new-buffer |
|
|
(concat "*" file-name |
|
|
" " (or name-A "WORKFILE") "*"))) |
|
|
(other-buffer (generate-new-buffer |
|
|
(concat "*" file-name |
|
|
" " (or name-B "CHECKED-IN") "*"))) |
|
|
(result-buffer (current-buffer))) |
|
|
(save-excursion |
|
|
(set-buffer your-buffer) |
|
|
(erase-buffer) |
|
|
(insert-buffer result-buffer) |
|
|
(goto-char (point-min)) |
|
|
(while (re-search-forward (concat "^<<<<<<< " |
|
|
(regexp-quote file-name) "\n") nil t) |
|
|
(setq found t) |
|
|
(replace-match "") |
|
|
(if (not (re-search-forward "^=======\n" nil t)) |
|
|
(error "Malformed conflict marker")) |
|
|
(replace-match "") |
|
|
(let ((start (point))) |
|
|
(if (not (re-search-forward "^>>>>>>> [0-9.]+\n" nil t)) |
|
|
(error "Malformed conflict marker")) |
|
|
(delete-region start (point)))) |
|
|
(if (not found) |
|
|
(progn |
|
|
(kill-buffer your-buffer) |
|
|
(kill-buffer other-buffer) |
|
|
(error "No conflict markers found"))) |
|
|
(set-buffer other-buffer) |
|
|
(erase-buffer) |
|
|
(insert-buffer result-buffer) |
|
|
(goto-char (point-min)) |
|
|
(while (re-search-forward (concat "^<<<<<<< " |
|
|
(regexp-quote file-name) "\n") nil t) |
|
|
(let ((start (match-beginning 0))) |
|
|
(if (not (re-search-forward "^=======\n" nil t)) |
|
|
(error "Malformed conflict marker")) |
|
|
(delete-region start (point)) |
|
|
(if (not (re-search-forward "^>>>>>>> [0-9.]+\n" nil t)) |
|
|
(error "Malformed conflict marker")) |
|
|
(replace-match ""))) |
|
|
(let ((config (current-window-configuration)) |
|
|
(ediff-default-variant 'default-B)) |
|
|
|
|
|
;; Fire up ediff. |
|
|
|
|
|
(set-buffer (ediff-merge-buffers your-buffer other-buffer)) |
|
|
|
|
|
;; Ediff is now set up, and we are in the control buffer. |
|
|
;; Do a few further adjustments and take precautions for exit. |
|
|
|
|
|
(make-local-variable 'vc-ediff-windows) |
|
|
(setq vc-ediff-windows config) |
|
|
(make-local-variable 'vc-ediff-result) |
|
|
(setq vc-ediff-result result-buffer) |
|
|
(make-local-variable 'ediff-quit-hook) |
|
|
(setq ediff-quit-hook |
|
|
(lambda () |
|
|
(let ((buffer-A ediff-buffer-A) |
|
|
(buffer-B ediff-buffer-B) |
|
|
(buffer-C ediff-buffer-C) |
|
|
(result vc-ediff-result) |
|
|
(windows vc-ediff-windows)) |
|
|
(ediff-cleanup-mess) |
|
|
(set-buffer result) |
|
|
(erase-buffer) |
|
|
(insert-buffer buffer-C) |
|
|
(kill-buffer buffer-A) |
|
|
(kill-buffer buffer-B) |
|
|
(kill-buffer buffer-C) |
|
|
(set-window-configuration windows) |
|
|
(message "Conflict resolution finished; you may save the buffer")))) |
|
|
(message "Please resolve conflicts now; exit ediff when done") |
|
|
nil)))) |
|
2073 |
|
|
2074 |
;; The VC directory major mode. Coopt Dired for this. |
;; The VC directory major mode. Coopt Dired for this. |
2075 |
;; All VC commands get mapped into logical equivalents. |
;; All VC commands get mapped into logical equivalents. |
2107 |
(set-keymap-parent vc-dired-mode-map dired-mode-map) |
(set-keymap-parent vc-dired-mode-map dired-mode-map) |
2108 |
(add-hook 'dired-after-readin-hook 'vc-dired-hook nil t) |
(add-hook 'dired-after-readin-hook 'vc-dired-hook nil t) |
2109 |
;; The following is slightly modified from dired.el, |
;; The following is slightly modified from dired.el, |
2110 |
;; because file lines look a bit different in vc-dired-mode. |
;; because file lines look a bit different in vc-dired-mode |
2111 |
|
;; (the column before the date does not end in a digit). |
2112 |
(set (make-local-variable 'dired-move-to-filename-regexp) |
(set (make-local-variable 'dired-move-to-filename-regexp) |
2113 |
(let* |
(let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)") |
2114 |
((l "\\([A-Za-z]\\|[^\0-\177]\\)") |
;; In some locales, month abbreviations are as short as 2 letters, |
2115 |
;; In some locales, month abbreviations are as short as 2 letters, |
;; and they can be followed by ".". |
2116 |
;; and they can be padded on the right with spaces. |
(month (concat l l "+\\.?")) |
2117 |
(month (concat l l "+ *")) |
(s " ") |
2118 |
;; Recognize any non-ASCII character. |
(yyyy "[0-9][0-9][0-9][0-9]") |
2119 |
;; The purpose is to match a Kanji character. |
(dd "[ 0-3][0-9]") |
2120 |
(k "[^\0-\177]") |
(HH:MM "[ 0-2][0-9]:[0-5][0-9]") |
2121 |
;; (k "[^\x00-\x7f\x80-\xff]") |
(seconds "[0-6][0-9]\\([.,][0-9]+\\)?") |
2122 |
(s " ") |
(zone "[-+][0-2][0-9][0-5][0-9]") |
2123 |
(yyyy "[0-9][0-9][0-9][0-9]") |
(iso-mm-dd "[01][0-9]-[0-3][0-9]") |
2124 |
(mm "[ 0-1][0-9]") |
(iso-time (concat HH:MM "\\(:" seconds "\\( ?" zone "\\)?\\)?")) |
2125 |
(dd "[ 0-3][0-9]") |
(iso (concat "\\(\\(" yyyy "-\\)?" iso-mm-dd "[ T]" iso-time |
2126 |
(HH:MM "[ 0-2][0-9]:[0-5][0-9]") |
"\\|" yyyy "-" iso-mm-dd "\\)")) |
2127 |
(western (concat "\\(" month s dd "\\|" dd s month "\\)" |
(western (concat "\\(" month s "+" dd "\\|" dd "\\.?" s month "\\)" |
2128 |
s "\\(" HH:MM "\\|" s yyyy"\\|" yyyy s "\\)")) |
s "+" |
2129 |
(japanese (concat mm k s dd k s "\\(" s HH:MM "\\|" yyyy k "\\)"))) |
"\\(" HH:MM "\\|" yyyy "\\)")) |
2130 |
;; the .* below ensures that we find the last match on a line |
(western-comma (concat month s "+" dd "," s "+" yyyy)) |
2131 |
(concat ".*" s "\\(" western "\\|" japanese "\\)" s))) |
;; Japanese MS-Windows ls-lisp has one-digit months, and |
2132 |
|
;; omits the Kanji characters after month and day-of-month. |
2133 |
|
(mm "[ 0-1]?[0-9]") |
2134 |
|
(japanese |
2135 |
|
(concat mm l "?" s dd l "?" s "+" |
2136 |
|
"\\(" HH:MM "\\|" yyyy l "?" "\\)"))) |
2137 |
|
;; the .* below ensures that we find the last match on a line |
2138 |
|
(concat ".*" s |
2139 |
|
"\\(" western "\\|" western-comma "\\|" japanese "\\|" iso "\\)" |
2140 |
|
s "+"))) |
2141 |
(and (boundp 'vc-dired-switches) |
(and (boundp 'vc-dired-switches) |
2142 |
vc-dired-switches |
vc-dired-switches |
2143 |
(set (make-local-variable 'dired-actual-switches) |
(set (make-local-variable 'dired-actual-switches) |
2175 |
((eq state 'needs-patch) "(patch)") |
((eq state 'needs-patch) "(patch)") |
2176 |
((eq state 'unlocked-changes) "(stale)")))) |
((eq state 'unlocked-changes) "(stale)")))) |
2177 |
|
|
2178 |
(defun vc-dired-reformat-line (x) |
(defun vc-dired-reformat-line (vc-info) |
2179 |
"Reformat a directory-listing line. |
"Reformat a directory-listing line. |
2180 |
Replace various columns with version control information. |
Replace various columns with version control information, VC-INFO. |
2181 |
This code, like dired, assumes UNIX -l format." |
This code, like dired, assumes UNIX -l format." |
2182 |
(beginning-of-line) |
(beginning-of-line) |
2183 |
(let ((pos (point)) limit perm date-and-file) |
(when (re-search-forward |
2184 |
(end-of-line) |
;; Match link count, owner, group, size. Group may be missing, |
2185 |
(setq limit (point)) |
;; and only the size is present in OS/2 -l format. |
2186 |
(goto-char pos) |
"^..[drwxlts-]+ \\( *[0-9]+\\( [^ ]+ +\\([^ ]+ +\\)?[0-9]+\\)?\\) " |
2187 |
(when |
(line-end-position) t) |
2188 |
(or |
(replace-match (substring (concat vc-info " ") 0 10) |
2189 |
(re-search-forward ;; owner and group |
t t nil 1))) |
|
"^\\(..[drwxlts-]+ \\) *[0-9]+ [^ ]+ +[^ ]+ +[0-9]+\\( .*\\)" |
|
|
limit t) |
|
|
(re-search-forward ;; only owner displayed |
|
|
"^\\(..[drwxlts-]+ \\) *[0-9]+ [^ ]+ +[0-9]+\\( .*\\)" |
|
|
limit t) |
|
|
(re-search-forward ;; OS/2 -l format, no links, owner, group |
|
|
"^\\(..[drwxlts-]+ \\) *[0-9]+\\( .*\\)" |
|
|
limit t)) |
|
|
(setq perm (match-string 1) |
|
|
date-and-file (match-string 2)) |
|
|
(setq x (substring (concat x " ") 0 10)) |
|
|
(replace-match (concat perm x date-and-file))))) |
|
2190 |
|
|
2191 |
(defun vc-dired-hook () |
(defun vc-dired-hook () |
2192 |
"Reformat the listing according to version control. |
"Reformat the listing according to version control. |
2413 |
(vc-call print-log file) |
(vc-call print-log file) |
2414 |
(set-buffer "*vc*") |
(set-buffer "*vc*") |
2415 |
(pop-to-buffer (current-buffer)) |
(pop-to-buffer (current-buffer)) |
2416 |
(if (fboundp 'log-view-mode) (log-view-mode)) |
(log-view-mode) |
2417 |
(vc-exec-after |
(vc-exec-after |
2418 |
`(let ((inhibit-read-only t)) |
`(let ((inhibit-read-only t)) |
2419 |
(goto-char (point-max)) (forward-line -1) |
(goto-char (point-max)) (forward-line -1) |
2425 |
(delete-char (- (match-end 0) (match-beginning 0)))) |
(delete-char (- (match-end 0) (match-beginning 0)))) |
2426 |
(shrink-window-if-larger-than-buffer) |
(shrink-window-if-larger-than-buffer) |
2427 |
;; move point to the log entry for the current version |
;; move point to the log entry for the current version |
2428 |
(if (fboundp 'log-view-goto-rev) |
(vc-call-backend ',(vc-backend file) |
2429 |
(log-view-goto-rev ',(vc-workfile-version file)) |
'show-log-entry |
2430 |
(if (vc-find-backend-function ',(vc-backend file) 'show-log-entry) |
',(vc-workfile-version file)) |
|
(vc-call-backend ',(vc-backend file) |
|
|
'show-log-entry |
|
|
',(vc-workfile-version file)))) |
|
2431 |
(set-buffer-modified-p nil))))) |
(set-buffer-modified-p nil))))) |
2432 |
|
|
2433 |
|
(defun vc-default-show-log-entry (backend rev) |
2434 |
|
(log-view-goto-rev rev)) |
2435 |
|
|
2436 |
(defun vc-default-comment-history (backend file) |
(defun vc-default-comment-history (backend file) |
2437 |
"Return a string with all log entries stored in BACKEND for FILE." |
"Return a string with all log entries stored in BACKEND for FILE." |
2438 |
(if (vc-find-backend-function backend 'print-log) |
(if (vc-find-backend-function backend 'print-log) |
2439 |
(with-temp-buffer |
(with-current-buffer "*vc*" |
2440 |
(vc-call print-log file) |
(vc-call print-log file) |
2441 |
(vc-call wash-log file) |
(vc-call wash-log file) |
2442 |
(buffer-string)))) |
(buffer-string)))) |
2507 |
"Update the current buffer's file to the latest version on its branch. |
"Update the current buffer's file to the latest version on its branch. |
2508 |
If the file contains no changes, and is not locked, then this simply replaces |
If the file contains no changes, and is not locked, then this simply replaces |
2509 |
the working file with the latest version on its branch. If the file contains |
the working file with the latest version on its branch. If the file contains |
2510 |
changes, and the backend supports merging news, then any recent changes from |
changes, and the backend supports merging news, then any recent changes from |
2511 |
the current branch are merged into the working file." |
the current branch are merged into the working file." |
2512 |
(interactive) |
(interactive) |
2513 |
(vc-ensure-vc-buffer) |
(vc-ensure-vc-buffer) |
2517 |
(vc-checkout file nil "") |
(vc-checkout file nil "") |
2518 |
(if (eq (vc-checkout-model file) 'locking) |
(if (eq (vc-checkout-model file) 'locking) |
2519 |
(if (eq (vc-state file) 'edited) |
(if (eq (vc-state file) 'edited) |
2520 |
(error |
(error |
2521 |
(substitute-command-keys |
(substitute-command-keys |
2522 |
"File is locked--type \\[vc-revert-buffer] to discard changes")) |
"File is locked--type \\[vc-revert-buffer] to discard changes")) |
2523 |
(error |
(error |
2524 |
(substitute-command-keys |
(substitute-command-keys |
2525 |
"Unexpected file state (%s)--type \\[vc-next-action] to correct") |
"Unexpected file state (%s)--type \\[vc-next-action] to correct") |
2526 |
(vc-state file))) |
(vc-state file))) |
2527 |
(if (not (vc-find-backend-function (vc-backend file) 'merge-news)) |
(if (not (vc-find-backend-function (vc-backend file) 'merge-news)) |
2528 |
(error "Sorry, merging news is not implemented for %s" |
(error "Sorry, merging news is not implemented for %s" |
2529 |
(vc-backend file)) |
(vc-backend file)) |
2530 |
(vc-call merge-news file) |
(vc-call merge-news file) |
2531 |
(vc-resynch-window file t t)))))) |
(vc-resynch-window file t t)))))) |
2872 |
(defvar vc-annotate-ratio nil "Global variable.") |
(defvar vc-annotate-ratio nil "Global variable.") |
2873 |
(defvar vc-annotate-backend nil "Global variable.") |
(defvar vc-annotate-backend nil "Global variable.") |
2874 |
|
|
2875 |
|
(defconst vc-annotate-font-lock-keywords |
2876 |
|
;; The fontification is done by vc-annotate-lines instead of font-lock. |
2877 |
|
'((vc-annotate-lines))) |
2878 |
|
|
2879 |
(defun vc-annotate-get-backend (buffer) |
(defun vc-annotate-get-backend (buffer) |
2880 |
"Return the backend matching \"Annotate\" buffer BUFFER. |
"Return the backend matching \"Annotate\" buffer BUFFER. |
2881 |
Return nil if no match made. Associations are made based on |
Return nil if no match made. Associations are made based on |
2888 |
You can use the mode-specific menu to alter the time-span of the used |
You can use the mode-specific menu to alter the time-span of the used |
2889 |
colors. See variable `vc-annotate-menu-elements' for customizing the |
colors. See variable `vc-annotate-menu-elements' for customizing the |
2890 |
menu items." |
menu items." |
2891 |
|
(set (make-local-variable 'truncate-lines) t) |
2892 |
|
(set (make-local-variable 'font-lock-defaults) |
2893 |
|
'(vc-annotate-font-lock-keywords t)) |
2894 |
(vc-annotate-add-menu)) |
(vc-annotate-add-menu)) |
2895 |
|
|
2896 |
(defun vc-annotate-display-default (&optional ratio) |
(defun vc-annotate-display-default (&optional ratio) |
2997 |
(display-buffer buffer)) |
(display-buffer buffer)) |
2998 |
(if (not vc-annotate-mode) ; Turn on vc-annotate-mode if not done |
(if (not vc-annotate-mode) ; Turn on vc-annotate-mode if not done |
2999 |
(vc-annotate-mode)) |
(vc-annotate-mode)) |
3000 |
(cond ((null vc-annotate-display-mode) (vc-annotate-display-default |
(cond ((null vc-annotate-display-mode) |
3001 |
vc-annotate-ratio)) |
(vc-annotate-display-default vc-annotate-ratio)) |
3002 |
((symbolp vc-annotate-display-mode) ; One of the auto-scaling modes |
;; One of the auto-scaling modes |
3003 |
(cond ((eq vc-annotate-display-mode 'scale) |
((eq vc-annotate-display-mode 'scale) |
3004 |
(vc-annotate-display-autoscale)) |
(vc-annotate-display-autoscale)) |
3005 |
((eq vc-annotate-display-mode 'fullscale) |
((eq vc-annotate-display-mode 'fullscale) |
3006 |
(vc-annotate-display-autoscale t)) |
(vc-annotate-display-autoscale t)) |
|
(t (error "No such display mode: %s" |
|
|
vc-annotate-display-mode)))) |
|
3007 |
((numberp vc-annotate-display-mode) ; A fixed number of days lookback |
((numberp vc-annotate-display-mode) ; A fixed number of days lookback |
3008 |
(vc-annotate-display-default |
(vc-annotate-display-default |
3009 |
(/ vc-annotate-display-mode (vc-annotate-car-last-cons |
(/ vc-annotate-display-mode (vc-annotate-car-last-cons |
3010 |
vc-annotate-color-map)))) |
vc-annotate-color-map)))) |
3011 |
(t (error "Error in display mode select")))) |
(t (error "No such display mode: %s" |
3012 |
|
vc-annotate-display-mode)))) |
3013 |
|
|
3014 |
;;;; (defun vc-BACKEND-annotate-command (file buffer) ...) |
;;;; (defun vc-BACKEND-annotate-command (file buffer) ...) |
3015 |
;;;; Execute "annotate" on FILE by using `call-process' and insert |
;;;; Execute "annotate" on FILE by using `call-process' and insert |
3125 |
|
|
3126 |
(defun vc-annotate-display (&optional color-map offset) |
(defun vc-annotate-display (&optional color-map offset) |
3127 |
"Highlight `vc-annotate' output in the current buffer. |
"Highlight `vc-annotate' output in the current buffer. |
3128 |
COLOR-MAP, if present, overrides `vc-annotate-color-map'. The |
COLOR-MAP, if present, overrides `vc-annotate-color-map'. |
3129 |
annotations are relative to the current time, unless overridden by |
The annotations are relative to the current time, unless overridden by OFFSET." |
3130 |
OFFSET. |
(if (and color-map (not (eq color-map vc-annotate-color-map))) |
3131 |
|
(set (make-local-variable 'vc-annotate-color-map) color-map)) |
3132 |
This function is obsolete, and has been replaced by |
(set (make-local-variable 'vc-annotate-offset) offset) |
3133 |
`vc-annotate-select'." |
(font-lock-mode 1)) |
3134 |
(save-excursion |
(make-obsolete 'vc-annotate-display 'vc-annotate-display-select "21.4") |
3135 |
(goto-char (point-min)) ; Position at the top of the buffer. |
|
3136 |
;; Delete old overlays |
(defvar vc-annotate-offset nil) |
3137 |
(mapcar |
|
3138 |
(lambda (overlay) |
(defun vc-annotate-lines (limit) |
3139 |
(if (overlay-get overlay 'vc-annotation) |
(let (difference) |
3140 |
(delete-overlay overlay))) |
(while (and (< (point) limit) |
3141 |
(overlays-in (point-min) (point-max))) |
(setq difference (vc-annotate-difference vc-annotate-offset))) |
3142 |
(goto-char (point-min)) ; Position at the top of the buffer. |
(let* ((color (or (vc-annotate-compcar difference vc-annotate-color-map) |
3143 |
(let (difference) |
(cons nil vc-annotate-very-old-color))) |
3144 |
(while (setq difference (vc-annotate-difference offset)) |
;; substring from index 1 to remove any leading `#' in the name |
3145 |
(let* |
(face-name (concat "vc-annotate-face-" (substring (cdr color) 1))) |
3146 |
((color (or (vc-annotate-compcar |
;; Make the face if not done. |
3147 |
difference (or color-map vc-annotate-color-map)) |
(face (or (intern-soft face-name) |
3148 |
(cons nil vc-annotate-very-old-color))) |
(let ((tmp-face (make-face (intern face-name)))) |
3149 |
;; substring from index 1 to remove any leading `#' in the name |
(set-face-foreground tmp-face (cdr color)) |
3150 |
(face-name (concat "vc-annotate-face-" (substring (cdr color) 1))) |
(if vc-annotate-background |
|
;; Make the face if not done. |
|
|
(face (or (intern-soft face-name) |
|
|
(let ((tmp-face (make-face (intern face-name)))) |
|
|
(set-face-foreground tmp-face (cdr color)) |
|
|
(if vc-annotate-background |
|
3151 |
(set-face-background tmp-face |
(set-face-background tmp-face |
3152 |
vc-annotate-background)) |
vc-annotate-background)) |
3153 |
tmp-face))) ; Return the face |
tmp-face))) ; Return the face |
3154 |
(point (point)) |
(point (point)) |
3155 |
overlay) |
overlay) |
3156 |
(forward-line 1) |
(forward-line 1) |
3157 |
(setq overlay (make-overlay point (point))) |
(put-text-property point (point) 'face face))) |
3158 |
(overlay-put overlay 'face face) |
;; Pretend to font-lock there were no matches. |
3159 |
(overlay-put overlay 'vc-annotation t)))))) |
nil)) |
3160 |
|
|
3161 |
;; Collect back-end-dependent stuff here |
;; Collect back-end-dependent stuff here |
3162 |
|
|
3175 |
|
|
3176 |
;; Set up key bindings for use while editing log messages |
;; Set up key bindings for use while editing log messages |
3177 |
|
|
|
(define-derived-mode vc-log-mode text-mode "VC-Log" |
|
|
"Major mode for editing VC log entries. |
|
|
These bindings are added to the global keymap when you enter this mode: |
|
|
\\[vc-next-action] perform next logical version-control operation on current file |
|
|
\\[vc-register] register current file |
|
|
\\[vc-toggle-read-only] like next-action, but won't register files |
|
|
\\[vc-insert-headers] insert version-control headers in current file |
|
|
\\[vc-print-log] display change history of current file |
|
|
\\[vc-revert-buffer] revert buffer to latest version |
|
|
\\[vc-cancel-version] undo latest checkin |
|
|
\\[vc-diff] show diffs between file versions |
|
|
\\[vc-version-other-window] visit old version in another window |
|
|
\\[vc-directory] show all files locked by any user in or below . |
|
|
\\[vc-annotate] colorful display of the cvs annotate command |
|
|
\\[vc-update-change-log] add change log entry from recent checkins |
|
|
|
|
|
While you are entering a change log message for a version, the following |
|
|
additional bindings will be in effect. |
|
|
|
|
|
\\[vc-finish-logentry] proceed with check in, ending log message entry |
|
|
|
|
|
Whenever you do a checkin, your log comment is added to a ring of |
|
|
saved comments. These can be recalled as follows: |
|
|
|
|
|
\\[vc-next-comment] replace region with next message in comment ring |
|
|
\\[vc-previous-comment] replace region with previous message in comment ring |
|
|
\\[vc-comment-search-reverse] search backward for regexp in the comment ring |
|
|
\\[vc-comment-search-forward] search backward for regexp in the comment ring |
|
|
|
|
|
Entry to the change-log submode calls the value of `text-mode-hook', then |
|
|
the value of `vc-log-mode-hook'. |
|
|
|
|
|
Global user options: |
|
|
`vc-initial-comment' If non-nil, require user to enter a change |
|
|
comment upon first checkin of the file. |
|
|
|
|
|
`vc-keep-workfiles' Non-nil value prevents workfiles from being |
|
|
deleted when changes are checked in |
|
|
|
|
|
`vc-suppress-confirm' Suppresses some confirmation prompts. |
|
|
|
|
|
vc-BACKEND-header Which keywords to insert when adding headers |
|
|
with \\[vc-insert-headers]. Defaults to |
|
|
'(\"\%\W\%\") under SCCS, '(\"\$Id\$\") under |
|
|
RCS and CVS. |
|
|
|
|
|
`vc-static-header-alist' By default, version headers inserted in C files |
|
|
get stuffed in a static string area so that |
|
|
ident(RCS/CVS) or what(SCCS) can see them in |
|
|
the compiled object code. You can override |
|
|
this by setting this variable to nil, or change |
|
|
the header template by changing it. |
|
|
|
|
|
`vc-command-messages' if non-nil, display run messages from the |
|
|
actual version-control utilities (this is |
|
|
intended primarily for people hacking vc |
|
|
itself)." |
|
|
(make-local-variable 'vc-comment-ring-index)) |
|
|
|
|
3178 |
(defun vc-log-edit (file) |
(defun vc-log-edit (file) |
3179 |
"Set up `log-edit' for use with VC on FILE. |
"Set up `log-edit' for use with VC on FILE." |
|
If `log-edit' is not available, resort to `vc-log-mode'." |
|
3180 |
(setq default-directory |
(setq default-directory |
3181 |
(if file (file-name-directory file) |
(if file (file-name-directory file) |
3182 |
(with-current-buffer vc-parent-buffer default-directory))) |
(with-current-buffer vc-parent-buffer default-directory))) |
3183 |
(if (fboundp 'log-edit) |
(log-edit 'vc-finish-logentry nil |
3184 |
(log-edit 'vc-finish-logentry nil |
(if file `(lambda () ',(list (file-name-nondirectory file))) |
3185 |
(if file `(lambda () ',(list (file-name-nondirectory file))) |
;; If FILE is nil, we were called from vc-dired. |
3186 |
;; If FILE is nil, we were called from vc-dired. |
(lambda () |
3187 |
(lambda () |
(with-current-buffer vc-parent-buffer |
3188 |
(with-current-buffer vc-parent-buffer |
(dired-get-marked-files t))))) |
|
(dired-get-marked-files t))))) |
|
|
(vc-log-mode)) |
|
3189 |
(set (make-local-variable 'vc-log-file) file) |
(set (make-local-variable 'vc-log-file) file) |
3190 |
(make-local-variable 'vc-log-version) |
(make-local-variable 'vc-log-version) |
3191 |
(set-buffer-modified-p nil) |
(set-buffer-modified-p nil) |