/[emacs]/emacs/lisp/vc-mcvs.el
ViewVC logotype

Diff of /emacs/lisp/vc-mcvs.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.8 by monnier, Fri May 9 17:05:40 2003 UTC revision 1.9 by monnier, Sun May 11 23:55:07 2003 UTC
# Line 50  Line 50 
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    
# Line 185  This is only meaningful if you don't use Line 186  This is only meaningful if you don't use
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    
# Line 202  This is only meaningful if you don't use Line 203  This is only meaningful if you don't use
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)
# Line 216  This is only meaningful if you don't use Line 218  This is only meaningful if you don't use
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
# Line 284  This is only possible if Meta-CVS is res Line 291  This is only possible if Meta-CVS is res
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)
# Line 440  The changes are between FIRST-VERSION an Line 450  The changes are between FIRST-VERSION an
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."
# Line 460  The changes are between FIRST-VERSION an Line 473  The changes are between FIRST-VERSION an
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)
# Line 472  The changes are between FIRST-VERSION an Line 488  The changes are between FIRST-VERSION an
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.
# Line 512  Optional arg VERSION is a version to ann Line 517  Optional arg VERSION is a version to ann
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.
# Line 569  If UPDATE is non-nil, then update (resyn Line 576  If UPDATE is non-nil, then update (resyn
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)))

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26