/[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.37 by monnier, Mon Jun 24 22:49:38 2002 UTC revision 1.38 by monnier, Tue Jun 25 00:11:28 2002 UTC
# Line 62  Line 62 
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
# Line 640  DCD is the `dont-change-disc' flag to us Line 639  DCD is the `dont-change-disc' flag to us
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.
# Line 766  TIN specifies an optional starting point Line 761  TIN specifies an optional starting point
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
# Line 1108  Full documentation is in the Texinfo fil Line 1105  Full documentation is in the Texinfo fil
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
# Line 2144  The exact behavior is determined also by Line 2137  The exact behavior is determined also by
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))
# Line 2156  The exact behavior is determined also by Line 2149  The exact behavior is determined also by
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))))))))

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

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