Mercurial > emacs

comparison lisp/vc-mcvs.el @ 50667:c475369e6995

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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."