Mercurial > emacs
comparison lisp/vc-mcvs.el @ 50667:c475369e6995
(vc-mcvs-root): Cache the result.
(vc-mcvs-registered): Simplify. Use file-relative-name.
(vc-mcvs-register): Simplify. Don't burp if MCVS/TYPES doesn't exist.
(vc-mcvs-command): Filter F-NN names in the output for diff and log.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Tue, 22 Apr 2003 19:03:18 +0000 |
parents | 1ce282fd32cf |
children | 02455099d549 |
comparison
equal
deleted
inserted
replaced
50666:771a0e21394b | 50667:c475369e6995 |
---|---|
43 ;; - C-x v i | 43 ;; - C-x v i |
44 ;; - C-x v g | 44 ;; - C-x v g |
45 | 45 |
46 ;;; Bugs: | 46 ;;; Bugs: |
47 | 47 |
48 ;; - Both the diff and log output contain Meta-CVS inode names so that | |
49 ;; several operations in those buffers don't work as advertised. | |
50 ;; - VC-dired doesn't work. | 48 ;; - VC-dired doesn't work. |
51 | 49 |
52 ;;; Code: | 50 ;;; Code: |
53 | 51 |
54 (eval-when-compile (require 'vc)) | 52 (eval-when-compile (require 'vc)) |
133 ;;;###autoload (load "vc-mcvs") | 131 ;;;###autoload (load "vc-mcvs") |
134 ;;;###autoload (vc-mcvs-registered file))))) | 132 ;;;###autoload (vc-mcvs-registered file))))) |
135 | 133 |
136 (defun vc-mcvs-root (file) | 134 (defun vc-mcvs-root (file) |
137 "Return the root directory of a Meta-CVS project, if any." | 135 "Return the root directory of a Meta-CVS project, if any." |
138 (let ((root nil)) | 136 (or (vc-file-getprop file 'mcvs-root) |
139 (while (not (or root (equal file (setq file (file-name-directory file))))) | 137 (vc-file-setprop |
140 (if (file-directory-p (expand-file-name "MCVS/CVS" file)) | 138 file 'mcvs-root |
141 (setq root file) | 139 (let ((root nil)) |
142 (setq file (directory-file-name file)))) | 140 (while (not (or root |
143 root)) | 141 (equal file (setq file (file-name-directory file))))) |
142 (if (file-directory-p (expand-file-name "MCVS/CVS" file)) | |
143 (setq root file) | |
144 (setq file (directory-file-name file)))) | |
145 root)))) | |
144 | 146 |
145 (defun vc-mcvs-read (file) | 147 (defun vc-mcvs-read (file) |
146 (with-temp-buffer | 148 (with-temp-buffer |
147 (insert-file-contents file) | 149 (insert-file-contents file) |
148 (goto-char (point-min)) | 150 (goto-char (point-min)) |
156 | 158 |
157 (defun vc-mcvs-registered (file) | 159 (defun vc-mcvs-registered (file) |
158 (let (root inode cvsfile) | 160 (let (root inode cvsfile) |
159 (when (and (setq root (vc-mcvs-root file)) | 161 (when (and (setq root (vc-mcvs-root file)) |
160 (setq inode (vc-mcvs-map-file | 162 (setq inode (vc-mcvs-map-file |
161 root (substring file (length root))))) | 163 root (file-relative-name file root)))) |
162 (vc-file-setprop file 'mcvs-inode inode) | 164 (vc-file-setprop file 'mcvs-inode inode) |
163 (vc-file-setprop file 'mcvs-root root) | |
164 ;; Avoid calling `mcvs diff' in vc-workfile-unchanged-p. | 165 ;; Avoid calling `mcvs diff' in vc-workfile-unchanged-p. |
165 (vc-file-setprop file 'vc-checkout-time | 166 (vc-file-setprop file 'vc-checkout-time |
166 (if (vc-cvs-registered | 167 (if (vc-cvs-registered |
167 (setq cvsfile (expand-file-name inode root))) | 168 (setq cvsfile (expand-file-name inode root))) |
168 (vc-file-getprop cvsfile 'vc-checkout-time) | 169 (vc-file-getprop cvsfile 'vc-checkout-time) |
241 ;; Make sure meta files like MCVS/MAP are not read-only (happens with | 242 ;; Make sure meta files like MCVS/MAP are not read-only (happens with |
242 ;; CVSREAD) since Meta-CVS doesn't pay attention to it at all and goes | 243 ;; CVSREAD) since Meta-CVS doesn't pay attention to it at all and goes |
243 ;; belly-up. | 244 ;; belly-up. |
244 (unless (file-writable-p map-file) | 245 (unless (file-writable-p map-file) |
245 (vc-checkout map-file t)) | 246 (vc-checkout map-file t)) |
246 (unless (file-writable-p types-file) | 247 (unless (or (file-writable-p types-file) (not (file-exists-p types-file))) |
247 (vc-checkout types-file t)) | 248 (vc-checkout types-file t)) |
248 ;; Make sure the `mcvs add' will not fire up the CVSEDITOR | 249 ;; Make sure the `mcvs add' will not fire up the CVSEDITOR |
249 ;; to add a rule for the given file's extension. | 250 ;; to add a rule for the given file's extension. |
250 (when (and ext (not (assoc ext types))) | 251 (when (and ext (not (assoc ext types))) |
251 (let ((type (completing-read "Type to use [default]: " | 252 (let ((type (completing-read "Type to use [default]: " |
253 "binary" "value-only") | 254 "binary" "value-only") |
254 nil t nil nil "default"))) | 255 nil t nil nil "default"))) |
255 (push (list ext (make-symbol (upcase (concat ":" type)))) types) | 256 (push (list ext (make-symbol (upcase (concat ":" type)))) types) |
256 (setq types (sort types (lambda (x y) (string< (car x) (car y))))) | 257 (setq types (sort types (lambda (x y) (string< (car x) (car y))))) |
257 (with-current-buffer (find-file-noselect types-file) | 258 (with-current-buffer (find-file-noselect types-file) |
258 (if buffer-read-only (vc-checkout buffer-file-name t)) | |
259 (erase-buffer) | 259 (erase-buffer) |
260 (pp types (current-buffer)) | 260 (pp types (current-buffer)) |
261 (save-buffer) | 261 (save-buffer) |
262 (unless (get-buffer-window (current-buffer) t) | 262 (unless (get-buffer-window (current-buffer) t) |
263 (kill-buffer (current-buffer))))))) | 263 (kill-buffer (current-buffer))))))) |
275 (concat "-m" comment)) | 275 (concat "-m" comment)) |
276 switches) | 276 switches) |
277 ;; I'm not sure exactly why, but if we don't setup the inode and root | 277 ;; I'm not sure exactly why, but if we don't setup the inode and root |
278 ;; prop of the file, things break later on in vc-mode-line that | 278 ;; prop of the file, things break later on in vc-mode-line that |
279 ;; ends up calling vc-mcvs-workfile-version. | 279 ;; ends up calling vc-mcvs-workfile-version. |
280 (vc-mcvs-registered file) | |
281 ;; We also need to set vc-checkout-time so that vc-workfile-unchanged-p | 280 ;; We also need to set vc-checkout-time so that vc-workfile-unchanged-p |
282 ;; doesn't try to call `mcvs diff' on the file. | 281 ;; doesn't try to call `mcvs diff' on the file. |
283 (vc-file-setprop file 'vc-checkout-time 0)))) | 282 (vc-mcvs-registered file)))) |
284 | 283 |
285 (defalias 'vc-mcvs-responsible-p 'vc-mcvs-root | 284 (defalias 'vc-mcvs-responsible-p 'vc-mcvs-root |
286 "Return non-nil if CVS thinks it is responsible for FILE.") | 285 "Return non-nil if CVS thinks it is responsible for FILE.") |
287 | 286 |
288 (defalias 'vc-cvs-could-register 'vc-cvs-responsible-p | 287 (defalias 'vc-cvs-could-register 'vc-cvs-responsible-p |
589 | 588 |
590 (defun vc-mcvs-command (buffer okstatus file &rest flags) | 589 (defun vc-mcvs-command (buffer okstatus file &rest flags) |
591 "A wrapper around `vc-do-command' for use in vc-mcvs.el. | 590 "A wrapper around `vc-do-command' for use in vc-mcvs.el. |
592 The difference to vc-do-command is that this function always invokes `mcvs', | 591 The difference to vc-do-command is that this function always invokes `mcvs', |
593 and that it passes `vc-mcvs-global-switches' to it before FLAGS." | 592 and that it passes `vc-mcvs-global-switches' to it before FLAGS." |
594 (apply 'vc-do-command buffer okstatus "mcvs" file | 593 (let ((args (append '("--error-continue") |
595 (append '("--error-continue") | 594 (if (stringp vc-mcvs-global-switches) |
596 (if (stringp vc-mcvs-global-switches) | 595 (cons vc-mcvs-global-switches flags) |
597 (cons vc-mcvs-global-switches flags) | 596 (append vc-mcvs-global-switches |
598 (append vc-mcvs-global-switches | 597 flags))))) |
599 flags))))) | 598 (if (member (car flags) '("diff" "log")) |
599 ;; We need to filter the output. | |
600 (vc-do-command buffer okstatus "sh" nil "-c" | |
601 (concat "mcvs " | |
602 (mapconcat | |
603 'shell-quote-argument | |
604 (append (remq nil args) | |
605 (if file (list (file-relative-name file)))) | |
606 " ") | |
607 " | mcvs filt")) | |
608 (apply 'vc-do-command buffer okstatus "mcvs" file args)))) | |
600 | 609 |
601 (defun vc-mcvs-stay-local-p (file) (vc-mcvs-cvs stay-local-p file)) | 610 (defun vc-mcvs-stay-local-p (file) (vc-mcvs-cvs stay-local-p file)) |
602 | 611 |
603 (defun vc-mcvs-dir-state-heuristic (dir) | 612 (defun vc-mcvs-dir-state-heuristic (dir) |
604 "Find the Meta-CVS state of all files in DIR, using only local information." | 613 "Find the Meta-CVS state of all files in DIR, using only local information." |