/[emacs]/emacs/lisp/pcvs.el
ViewVC logotype

Diff of /emacs/lisp/pcvs.el

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

revision 1.36 by monnier, Tue Jun 18 21:50:30 2002 UTC revision 1.37 by monnier, Mon Jun 24 22:49:38 2002 UTC
# Line 1  Line 1 
1  ;;; pcvs.el --- a front-end to CVS  ;;; pcvs.el --- a front-end to CVS
2    
3  ;; Copyright (C) 1991,92,93,94,95,95,97,98,99,2000  Free Software Foundation, Inc.  ;; Copyright (C) 1991,92,93,94,95,95,97,98,99,2000,2002
4    ;;               Free Software Foundation, Inc.
5    
6  ;; Author: (The PCL-CVS Trust) pcl-cvs@cyclic.com  ;; Author: (The PCL-CVS Trust) pcl-cvs@cyclic.com
7  ;;      (Per Cederqvist) ceder@lysator.liu.se  ;;      (Per Cederqvist) ceder@lysator.liu.se
# Line 633  it is finished." Line 634  it is finished."
634          ;; This might not even be necessary          ;; This might not even be necessary
635          (set-buffer obuf)))))          (set-buffer obuf)))))
636    
637  (defun cvs-parse-process (dcd &optional subdir)  (defun cvs-parse-process (dcd &optional subdir old-fis)
638    "FIXME: bad name, no doc."    "Parse the output of a cvs process.
639    DCD is the `dont-change-disc' flag to use when parsing that output.
640    SUBDIR is the subdirectory (if any) where this command was run.
641    OLD-FIS is the list of fileinfos on which the cvs command was applied and
642      which should be considered up-to-date if they are missing from the output."
643    (let* ((from-buf (current-buffer))    (let* ((from-buf (current-buffer))
644           (fileinfos (cvs-parse-buffer 'cvs-parse-table dcd subdir))           (fileinfos (cvs-parse-buffer 'cvs-parse-table dcd subdir))
645           (_ (set-buffer cvs-buffer))           (_ (set-buffer cvs-buffer))
646           last           last
647           (from-pt (point)))           (from-pt (point)))
648      ;; add the new fileinfos      ;; Expand OLD-FIS to actual files.
649        (dolist (fi old-fis)
650          (when (eq (cvs-fileinfo->type fi) 'DIRCHANGE)
651            (setq old-fis (nconc (ewoc-collect cvs-cookies 'cvs-dir-member-p
652                                               (cvs-fileinfo->dir fi))
653                                 old-fis))))
654        ;; Drop OLD-FIS which were already up-to-date.
655        (let ((fis nil))
656          (dolist (fi old-fis)
657            (unless (eq (cvs-fileinfo->type fi) 'UP-TO-DATE) (push fi fis)))
658          (setq old-fis fis))
659        ;; Add the new fileinfos to the ewoc.
660      (dolist (fi fileinfos)      (dolist (fi fileinfos)
661          (setq last (cvs-addto-collection cvs-cookies fi last))
662          ;; This FI was in the output, so remove it from OLD-FIS.
663          (setq old-fis (delq (ewoc-data last) old-fis)))
664        ;; Process the "silent output" (i.e. absence means up-to-date).
665        (dolist (fi old-fis)
666          (setf (cvs-fileinfo->type fi) 'UP-TO-DATE)
667        (setq last (cvs-addto-collection cvs-cookies fi last)))        (setq last (cvs-addto-collection cvs-cookies fi last)))
668        (setq fileinfos (nconc old-fis fileinfos))
669        ;; Clean up the ewoc as requested by the user.
670      (cvs-cleanup-collection cvs-cookies      (cvs-cleanup-collection cvs-cookies
671                              (eq cvs-auto-remove-handled t)                              (eq cvs-auto-remove-handled t)
672                              cvs-auto-remove-directories                              cvs-auto-remove-directories
673                              nil)                              nil)
674      ;; update the display (might be unnecessary)      ;; Revert buffers if necessary.
     ;;(ewoc-refresh cvs-cookies)  
     ;; revert buffers if necessary  
675      (when (and cvs-auto-revert (not dcd) (not cvs-from-vc))      (when (and cvs-auto-revert (not dcd) (not cvs-from-vc))
676        (cvs-revert-if-needed fileinfos))        (cvs-revert-if-needed fileinfos))
677      ;; get back to where we were.  `save-excursion' doesn't seem to      ;; get back to where we were.  `save-excursion' doesn't seem to
# Line 1628  Signal an error if there is no backup fi Line 1650  Signal an error if there is no backup fi
1650                   rev1-buf rev2-buf)))))                   rev1-buf rev2-buf)))))
1651    
1652    
 (defun cvs-fileinfo-kill (c fi)  
   "Mark a fileinfo xor its members (in case of a directory) as dead."  
   (if (eq (cvs-fileinfo->type fi) 'DIRCHANGE)  
       (dolist (fi (ewoc-collect c 'cvs-dir-member-p  
                                 (cvs-fileinfo->dir fi)))  
         (setf (cvs-fileinfo->type fi) 'UP-TO-DATE))  
     (setf (cvs-fileinfo->type fi) 'UP-TO-DATE)))  
   
1653  (defun cvs-is-within-p (fis dir)  (defun cvs-is-within-p (fis dir)
1654    "Non-nil is buffer is inside one of FIS (in DIR)."    "Non-nil is buffer is inside one of FIS (in DIR)."
1655    (when (stringp buffer-file-name)    (when (stringp buffer-file-name)
# Line 1672  POSTPROC is a list of expressions to be Line 1686  POSTPROC is a list of expressions to be
1686                              (eq cvs-auto-remove-handled 'delayed) nil t)                              (eq cvs-auto-remove-handled 'delayed) nil t)
1687      (when (fboundp after-mode)      (when (fboundp after-mode)
1688        (setq postproc (append postproc `((,after-mode)))))        (setq postproc (append postproc `((,after-mode)))))
1689      (when parse (push `(cvs-parse-process ',dont-change-disc) postproc))      (when parse
1690      (when (member cmd '("status" "update"))     ;FIXME: Yuck!!        (let ((old-fis
1691        ;; absence of `cvs update' output has a specific meaning.               (when (member cmd '("status" "update"))    ;FIXME: Yuck!!
1692        (push                  ;; absence of `cvs update' output has a specific meaning.
1693         `(dolist (fi ',(or fis                  (or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." ""))))))
1694                            (list (cvs-create-fileinfo 'DIRCHANGE "" "." ""))))          (push `(cvs-parse-process ',dont-change-disc nil ',old-fis) postproc)))
           (cvs-fileinfo-kill ',cvs-cookies fi))  
        postproc))  
1695      (setq postproc (if (cdr postproc) (cons 'progn postproc) (car postproc)))      (setq postproc (if (cdr postproc) (cons 'progn postproc) (car postproc)))
1696      (cvs-update-header args fis)      (cvs-update-header args fis)
1697      (with-current-buffer buf      (with-current-buffer buf

Legend:
Removed from v.1.36  
changed lines
  Added in v.1.37

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