50 |
|
|
51 |
;;; Bugs: |
;;; Bugs: |
52 |
|
|
53 |
;; - VC-dired doesn't work. |
;; - Retrieving snapshots doesn't filter `cvs update' output and thus |
54 |
|
;; parses bogus filenames. Don't know if it harms. |
55 |
|
|
56 |
;;; Code: |
;;; Code: |
57 |
|
|
186 |
(vc-mcvs-state-heuristic file) |
(vc-mcvs-state-heuristic file) |
187 |
state)) |
state)) |
188 |
(with-temp-buffer |
(with-temp-buffer |
189 |
(cd (file-name-directory file)) |
(setq default-directory (vc-mcvs-root file)) |
190 |
(vc-mcvs-command t 0 file "status") |
(vc-mcvs-command t 0 file "status") |
191 |
(vc-cvs-parse-status t)))) |
(vc-cvs-parse-status t)))) |
192 |
|
|
203 |
;; Don't specify DIR in this command, the default-directory is |
;; Don't specify DIR in this command, the default-directory is |
204 |
;; enough. Otherwise it might fail with remote repositories. |
;; enough. Otherwise it might fail with remote repositories. |
205 |
(with-temp-buffer |
(with-temp-buffer |
206 |
|
(setq default-directory (vc-mcvs-root dir)) |
207 |
(vc-mcvs-command t 0 nil "status" "-l") |
(vc-mcvs-command t 0 nil "status" "-l") |
208 |
(goto-char (point-min)) |
(goto-char (point-min)) |
209 |
(while (re-search-forward "^=+\n\\([^=\n].*\n\\|\n\\)+" nil t) |
(while (re-search-forward "^=+\n\\([^=\n].*\n\\|\n\\)+" nil t) |
218 |
|
|
219 |
(defun vc-mcvs-mode-line-string (file) |
(defun vc-mcvs-mode-line-string (file) |
220 |
(let ((s (vc-mcvs-cvs mode-line-string file))) |
(let ((s (vc-mcvs-cvs mode-line-string file))) |
221 |
(if s (concat "M" s)))) |
(when s |
222 |
|
(if (and (not (memq (vc-state file) '(up-to-date needs-patch))) |
223 |
|
(string-match "\\`CVS-" s)) |
224 |
|
;; The CVS file is not in sync, so we need to adjust the state. |
225 |
|
(concat "MCVS:" (substring s 4)) |
226 |
|
(concat "M" s))))) |
227 |
|
|
228 |
;;; |
;;; |
229 |
;;; State-changing functions |
;;; State-changing functions |
291 |
(error "%s is not a valid symbolic tag name" rev) |
(error "%s is not a valid symbolic tag name" rev) |
292 |
;; If the input revision is a valid symbolic tag name, we create it |
;; If the input revision is a valid symbolic tag name, we create it |
293 |
;; as a branch, commit and switch to it. |
;; as a branch, commit and switch to it. |
294 |
|
;; This file-specific form of branching is deprecated. |
295 |
|
;; We can't use `mcvs branch' and `mcvs switch' because they cannot |
296 |
|
;; be applied just to this one file. |
297 |
(apply 'vc-mcvs-command nil 0 file "tag" "-b" (list rev)) |
(apply 'vc-mcvs-command nil 0 file "tag" "-b" (list rev)) |
298 |
(apply 'vc-mcvs-command nil 0 file "update" "-r" (list rev)) |
(apply 'vc-mcvs-command nil 0 file "update" "-r" (list rev)) |
299 |
(vc-file-setprop file 'vc-mcvs-sticky-tag rev) |
(vc-file-setprop file 'vc-mcvs-sticky-tag rev) |
450 |
|
|
451 |
(defun vc-mcvs-print-log (file) |
(defun vc-mcvs-print-log (file) |
452 |
"Get change log associated with FILE." |
"Get change log associated with FILE." |
453 |
(vc-mcvs-command |
(let ((default-directory (vc-mcvs-root file))) |
454 |
nil |
;; Run the command from the root dir so that `mcvs filt' returns |
455 |
(if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) |
;; valid relative names. |
456 |
file "log")) |
(vc-mcvs-command |
457 |
|
nil |
458 |
|
(if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) |
459 |
|
file "log"))) |
460 |
|
|
461 |
(defun vc-mcvs-diff (file &optional oldvers newvers) |
(defun vc-mcvs-diff (file &optional oldvers newvers) |
462 |
"Get a difference report using Meta-CVS between two versions of FILE." |
"Get a difference report using Meta-CVS between two versions of FILE." |
473 |
;; Even if it's empty, it's locally modified. |
;; Even if it's empty, it's locally modified. |
474 |
1) |
1) |
475 |
(let* ((async (and (vc-stay-local-p file) (fboundp 'start-process))) |
(let* ((async (and (vc-stay-local-p file) (fboundp 'start-process))) |
476 |
|
;; Run the command from the root dir so that `mcvs filt' returns |
477 |
|
;; valid relative names. |
478 |
|
(default-directory (vc-mcvs-root file)) |
479 |
(status |
(status |
480 |
(apply 'vc-mcvs-command "*vc-diff*" |
(apply 'vc-mcvs-command "*vc-diff*" |
481 |
(if async 'async 1) |
(if async 'async 1) |
488 |
(defun vc-mcvs-diff-tree (dir &optional rev1 rev2) |
(defun vc-mcvs-diff-tree (dir &optional rev1 rev2) |
489 |
"Diff all files at and below DIR." |
"Diff all files at and below DIR." |
490 |
(with-current-buffer "*vc-diff*" |
(with-current-buffer "*vc-diff*" |
491 |
(setq default-directory dir) |
;; Run the command from the root dir so that `mcvs filt' returns |
492 |
(if (vc-stay-local-p dir) |
;; valid relative names. |
493 |
;; local diff: do it filewise, and only for files that are modified |
(setq default-directory (vc-mcvs-root dir)) |
494 |
(vc-file-tree-walk |
;; cvs diff: use a single call for the entire tree |
495 |
dir |
(let ((coding-system-for-read (or coding-system-for-read 'undecided))) |
496 |
(lambda (f) |
(apply 'vc-mcvs-command "*vc-diff*" 1 dir "diff" |
497 |
(vc-exec-after |
(and rev1 (concat "-r" rev1)) |
498 |
`(let ((coding-system-for-read (vc-coding-system-for-diff ',f))) |
(and rev2 (concat "-r" rev2)) |
499 |
;; possible optimization: fetch the state of all files |
(vc-switches 'MCVS 'diff))))) |
|
;; in the tree via vc-mcvs-dir-state-heuristic |
|
|
(unless (vc-up-to-date-p ',f) |
|
|
(message "Looking at %s" ',f) |
|
|
(vc-diff-internal ',f ',rev1 ',rev2)))))) |
|
|
;; cvs diff: use a single call for the entire tree |
|
|
(let ((coding-system-for-read |
|
|
(or coding-system-for-read 'undecided))) |
|
|
(apply 'vc-mcvs-command "*vc-diff*" 1 nil "diff" |
|
|
(and rev1 (concat "-r" rev1)) |
|
|
(and rev2 (concat "-r" rev2)) |
|
|
(vc-switches 'MCVS 'diff)))))) |
|
500 |
|
|
501 |
(defun vc-mcvs-annotate-command (file buffer &optional version) |
(defun vc-mcvs-annotate-command (file buffer &optional version) |
502 |
"Execute \"mcvs annotate\" on FILE, inserting the contents in BUFFER. |
"Execute \"mcvs annotate\" on FILE, inserting the contents in BUFFER. |
517 |
"Assign to DIR's current version a given NAME. |
"Assign to DIR's current version a given NAME. |
518 |
If BRANCHP is non-nil, the name is created as a branch (and the current |
If BRANCHP is non-nil, the name is created as a branch (and the current |
519 |
workspace is immediately moved to that new branch)." |
workspace is immediately moved to that new branch)." |
520 |
(vc-mcvs-command nil 0 dir "tag" "-c" (if branchp "-b") name) |
(if (not branchp) |
521 |
(when branchp (vc-mcvs-command nil 0 dir "update" "-r" name))) |
(vc-mcvs-command nil 0 dir "tag" "-c" name) |
522 |
|
(vc-mcvs-command nil 0 dir "branch" name) |
523 |
|
(vc-mcvs-command nil 0 dir "switch" name))) |
524 |
|
|
525 |
(defun vc-mcvs-retrieve-snapshot (dir name update) |
(defun vc-mcvs-retrieve-snapshot (dir name update) |
526 |
"Retrieve a snapshot at and below DIR. |
"Retrieve a snapshot at and below DIR. |
576 |
"A wrapper around `vc-do-command' for use in vc-mcvs.el. |
"A wrapper around `vc-do-command' for use in vc-mcvs.el. |
577 |
The difference to vc-do-command is that this function always invokes `mcvs', |
The difference to vc-do-command is that this function always invokes `mcvs', |
578 |
and that it passes `vc-mcvs-global-switches' to it before FLAGS." |
and that it passes `vc-mcvs-global-switches' to it before FLAGS." |
579 |
(let ((args (append '("--error-continue") |
(let ((args (append '("--error-terminate") |
580 |
(if (stringp vc-mcvs-global-switches) |
(if (stringp vc-mcvs-global-switches) |
581 |
(cons vc-mcvs-global-switches flags) |
(cons vc-mcvs-global-switches flags) |
582 |
(append vc-mcvs-global-switches |
(append vc-mcvs-global-switches flags))))) |
583 |
flags))))) |
(if (not (member (car flags) '("diff" "log" "status"))) |
584 |
(if (member (car flags) '("diff" "log")) |
;; No need to filter: do it the easy way. |
585 |
;; We need to filter the output. |
(apply 'vc-do-command buffer okstatus "mcvs" file args) |
586 |
(vc-do-command buffer okstatus "sh" nil "-c" |
;; We need to filter the output. |
587 |
(concat "mcvs " |
;; The output of the filter uses filenames relative to the root, |
588 |
(mapconcat |
;; so we need to change the default-directory. |
589 |
'shell-quote-argument |
(assert (equal default-directory (vc-mcvs-root file))) |
590 |
(append (remq nil args) |
(vc-do-command |
591 |
(if file (list (file-relative-name file)))) |
buffer okstatus "sh" nil "-c" |
592 |
" ") |
(concat "mcvs " |
593 |
" | mcvs filt")) |
(mapconcat |
594 |
(apply 'vc-do-command buffer okstatus "mcvs" file args)))) |
'shell-quote-argument |
595 |
|
(append (remq nil args) |
596 |
|
(if file (list (file-relative-name file)))) |
597 |
|
" ") |
598 |
|
" | mcvs filt"))))) |
599 |
|
|
600 |
(defun vc-mcvs-repository-hostname (dirname) |
(defun vc-mcvs-repository-hostname (dirname) |
601 |
(vc-cvs-repository-hostname (vc-mcvs-root dirname))) |
(vc-cvs-repository-hostname (vc-mcvs-root dirname))) |