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 |
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 |
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) |
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 |