62 |
;; ******** FIX THE DOCUMENTATION ********* |
;; ******** FIX THE DOCUMENTATION ********* |
63 |
;; |
;; |
64 |
;; - rework the displaying of error messages. |
;; - rework the displaying of error messages. |
|
;; - use UP-TO-DATE rather than DEAD when cleaning before `examine'. |
|
65 |
;; - allow to flush messages only |
;; - allow to flush messages only |
66 |
;; - allow to protect files like ChangeLog from flushing |
;; - allow to protect files like ChangeLog from flushing |
67 |
;; - automatically cvs-mode-insert files from find-file-hook |
;; - automatically cvs-mode-insert files from find-file-hook |
639 |
SUBDIR is the subdirectory (if any) where this command was run. |
SUBDIR is the subdirectory (if any) where this command was run. |
640 |
OLD-FIS is the list of fileinfos on which the cvs command was applied and |
OLD-FIS is the list of fileinfos on which the cvs command was applied and |
641 |
which should be considered up-to-date if they are missing from the output." |
which should be considered up-to-date if they are missing from the output." |
642 |
(let* ((from-buf (current-buffer)) |
(let* ((fileinfos (cvs-parse-buffer 'cvs-parse-table dcd subdir)) |
643 |
(fileinfos (cvs-parse-buffer 'cvs-parse-table dcd subdir)) |
last) |
644 |
(_ (set-buffer cvs-buffer)) |
(with-current-buffer cvs-buffer |
645 |
last |
;; Expand OLD-FIS to actual files. |
646 |
(from-pt (point))) |
(let ((fis nil)) |
647 |
;; Expand OLD-FIS to actual files. |
(dolist (fi old-fis) |
648 |
(dolist (fi old-fis) |
(setq fis (if (eq (cvs-fileinfo->type fi) 'DIRCHANGE) |
649 |
(when (eq (cvs-fileinfo->type fi) 'DIRCHANGE) |
(nconc (ewoc-collect cvs-cookies 'cvs-dir-member-p |
650 |
(setq old-fis (nconc (ewoc-collect cvs-cookies 'cvs-dir-member-p |
(cvs-fileinfo->dir fi)) |
651 |
(cvs-fileinfo->dir fi)) |
fis) |
652 |
old-fis)))) |
(cons fi fis)))) |
653 |
;; Drop OLD-FIS which were already up-to-date. |
(setq old-fis fis)) |
654 |
(let ((fis nil)) |
;; 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) |
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) |
(dolist (fi old-fis) |
666 |
(unless (eq (cvs-fileinfo->type fi) 'UP-TO-DATE) (push fi fis))) |
(setf (cvs-fileinfo->type fi) 'UP-TO-DATE) |
667 |
(setq old-fis fis)) |
(setq last (cvs-addto-collection cvs-cookies fi last))) |
668 |
;; Add the new fileinfos to the ewoc. |
(setq fileinfos (nconc old-fis fileinfos)) |
669 |
(dolist (fi fileinfos) |
;; Clean up the ewoc as requested by the user. |
670 |
(setq last (cvs-addto-collection cvs-cookies fi last)) |
(cvs-cleanup-collection cvs-cookies |
671 |
;; This FI was in the output, so remove it from OLD-FIS. |
(eq cvs-auto-remove-handled t) |
672 |
(setq old-fis (delq (ewoc-data last) old-fis))) |
cvs-auto-remove-directories |
673 |
;; Process the "silent output" (i.e. absence means up-to-date). |
nil) |
674 |
(dolist (fi old-fis) |
;; Revert buffers if necessary. |
675 |
(setf (cvs-fileinfo->type fi) 'UP-TO-DATE) |
(when (and cvs-auto-revert (not dcd) (not cvs-from-vc)) |
676 |
(setq last (cvs-addto-collection cvs-cookies fi last))) |
(cvs-revert-if-needed fileinfos))))) |
|
(setq fileinfos (nconc old-fis fileinfos)) |
|
|
;; Clean up the ewoc as requested by the user. |
|
|
(cvs-cleanup-collection cvs-cookies |
|
|
(eq cvs-auto-remove-handled t) |
|
|
cvs-auto-remove-directories |
|
|
nil) |
|
|
;; Revert buffers if necessary. |
|
|
(when (and cvs-auto-revert (not dcd) (not cvs-from-vc)) |
|
|
(cvs-revert-if-needed fileinfos)) |
|
|
;; get back to where we were. `save-excursion' doesn't seem to |
|
|
;; work in this case, probably because the buffer is reconstructed |
|
|
;; by the cookie code. |
|
|
(goto-char from-pt) |
|
|
(set-buffer from-buf))) |
|
677 |
|
|
678 |
(defmacro defun-cvs-mode (fun args docstring interact &rest body) |
(defmacro defun-cvs-mode (fun args docstring interact &rest body) |
679 |
"Define a function to be used in a *cvs* buffer. |
"Define a function to be used in a *cvs* buffer. |
761 |
;; fi == tin |
;; fi == tin |
762 |
(cvs-fileinfo-update (ewoc-data tin) fi) |
(cvs-fileinfo-update (ewoc-data tin) fi) |
763 |
(ewoc-invalidate c tin) |
(ewoc-invalidate c tin) |
764 |
|
;; Move cursor back to where it belongs. |
765 |
|
(when (bolp) (cvs-move-to-goal-column)) |
766 |
tin)))) |
tin)))) |
767 |
|
|
768 |
(defcustom cvs-cleanup-functions nil |
(defcustom cvs-cleanup-functions nil |
1105 |
|
|
1106 |
;; Move around in the buffer |
;; Move around in the buffer |
1107 |
|
|
1108 |
|
(defun cvs-move-to-goal-column () |
1109 |
|
(let* ((eol (line-end-position)) |
1110 |
|
(fpos (next-single-property-change (point) 'cvs-goal-column nil eol))) |
1111 |
|
(when (< fpos eol) |
1112 |
|
(goto-char fpos)))) |
1113 |
|
|
1114 |
(defun-cvs-mode cvs-mode-previous-line (arg) |
(defun-cvs-mode cvs-mode-previous-line (arg) |
1115 |
"Go to the previous line. |
"Go to the previous line. |
1116 |
If a prefix argument is given, move by that many lines." |
If a prefix argument is given, move by that many lines." |
1117 |
(interactive "p") |
(interactive "p") |
1118 |
(ewoc-goto-prev cvs-cookies arg) |
(ewoc-goto-prev cvs-cookies arg) |
1119 |
(let ((fpos (next-single-property-change |
(cvs-move-to-goal-column)) |
|
(point) 'cvs-goal-column |
|
|
(current-buffer) (line-end-position))) |
|
|
(eol (line-end-position))) |
|
|
(when (< fpos eol) |
|
|
(goto-char fpos)))) |
|
1120 |
|
|
1121 |
(defun-cvs-mode cvs-mode-next-line (arg) |
(defun-cvs-mode cvs-mode-next-line (arg) |
1122 |
"Go to the next line. |
"Go to the next line. |
1123 |
If a prefix argument is given, move by that many lines." |
If a prefix argument is given, move by that many lines." |
1124 |
(interactive "p") |
(interactive "p") |
1125 |
(ewoc-goto-next cvs-cookies arg) |
(ewoc-goto-next cvs-cookies arg) |
1126 |
(let ((fpos (next-single-property-change |
(cvs-move-to-goal-column)) |
|
(point) 'cvs-goal-column |
|
|
(current-buffer) (line-end-position))) |
|
|
(eol (line-end-position))) |
|
|
(when (< fpos eol) |
|
|
(goto-char fpos)))) |
|
1127 |
|
|
1128 |
;;;; |
;;;; |
1129 |
;;;; Mark handling |
;;;; Mark handling |
2137 |
(pop flags)) |
(pop flags)) |
2138 |
;; don't parse output we don't understand. |
;; don't parse output we don't understand. |
2139 |
(member (car flags) cvs-parse-known-commands))) |
(member (car flags) cvs-parse-known-commands))) |
2140 |
(save-excursion |
(save-current-buffer |
2141 |
(let ((buffer (current-buffer)) |
(let ((buffer (current-buffer)) |
2142 |
(dir default-directory) |
(dir default-directory) |
2143 |
(cvs-from-vc t)) |
(cvs-from-vc t)) |
2149 |
(let ((subdir (substring dir (length default-directory)))) |
(let ((subdir (substring dir (length default-directory)))) |
2150 |
(set-buffer buffer) |
(set-buffer buffer) |
2151 |
(set (make-local-variable 'cvs-buffer) cvs-buf) |
(set (make-local-variable 'cvs-buffer) cvs-buf) |
2152 |
|
;; `cvs -q add file' produces no useful output :-( |
2153 |
|
(when (and (equal (car flags) "add") |
2154 |
|
(goto-char (point-min)) |
2155 |
|
(looking-at ".*to add this file permanently\n\\'")) |
2156 |
|
(insert "cvs add: scheduling file `" |
2157 |
|
(file-name-nondirectory file) |
2158 |
|
"' for addition\n")) |
2159 |
;; VC never (?) does `cvs -n update' so dcd=nil |
;; VC never (?) does `cvs -n update' so dcd=nil |
2160 |
;; should probably always be the right choice. |
;; should probably always be the right choice. |
2161 |
(cvs-parse-process nil subdir)))))))) |
(cvs-parse-process nil subdir)))))))) |