changeset 58717:bd9d0c90fd28

(cvs-header-msg): New function. (cvs-update-header): Use it. Change calling convention. Correctly handle the case of having simultaneous active processes. (cvs-sentinel): Don't call cvs-update-header any more. (cvs-mode-run): Update call and add cvs-update-header to postproc.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Wed, 01 Dec 2004 22:35:15 +0000
parents 599d383ee37d
children 9a437a7c791c
files lisp/ChangeLog lisp/pcvs.el
diffstat 2 files changed, 55 insertions(+), 40 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Wed Dec 01 21:03:24 2004 +0000
+++ b/lisp/ChangeLog	Wed Dec 01 22:35:15 2004 +0000
@@ -1,3 +1,11 @@
+2004-12-01  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* pcvs.el (cvs-header-msg): New function.
+	(cvs-update-header): Use it.  Change calling convention.
+	Correctly handle the case of having simultaneous active processes.
+	(cvs-sentinel): Don't call cvs-update-header any more.
+	(cvs-mode-run): Update call and add cvs-update-header to postproc.
+
 2004-12-01  Jay Belanger  <belanger@truman.edu>
 
 	* calc/calc-ext.el (calc-inverse, calc-hyperbolic):
@@ -32,6 +40,10 @@
 	(x-cut-buffer-or-selection-value): Compare the X cut buffer text
 	with x-last-selected-text-cut-encoded.
 
+2004-11-30  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* man.el (Man-fontify-manpage): Improve handling of ANSI escapes.
+
 2004-11-30  Markus Rost  <rost@ias.edu>
 
 	* textmodes/tex-mode.el (tex-main-file): Add a compatibility with
@@ -87,7 +99,7 @@
 
 2004-11-30  Andre Spiegel  <spiegel@gnu.org>
 
-	* vc-hooks.el (vc-recompute-state): Moved here from vc.el.
+	* vc-hooks.el (vc-recompute-state): Move here from vc.el.
 
 	* vc-cvs.el (vc-cvs-state): Handle the case where vc-state is
 	still nil.
@@ -187,8 +199,7 @@
 
 	* fringe.el (fringe-indicators): Add fake defvar to avoid compiler
 	warning.  Delay real definition, which uses
-	`set-fringe-indicators-1' till after the definition of that
-	function.
+	`set-fringe-indicators-1' till after the definition of that function.
 
 2004-11-28  Kim F. Storm  <storm@cua.dk>
 
@@ -209,8 +220,7 @@
 
 2004-11-27  Richard M. Stallman  <rms@gnu.org>
 
-	* comint.el (comint-read-noecho): Add trivial compatibility
-	definition.
+	* comint.el (comint-read-noecho): Add trivial compatibility definition.
 
 	* generic.el (define-generic-mode): Doc fix.
 
--- a/lisp/pcvs.el	Wed Dec 01 21:03:24 2004 +0000
+++ b/lisp/pcvs.el	Wed Dec 01 22:35:15 2004 +0000
@@ -575,7 +575,7 @@
   ;; emacsen. It shouldn't be needed, but it does no harm.
   (sit-for 0))
 
-(defun cvs-update-header (args fis) ; inline
+(defun cvs-header-msg (args fis)
   (let* ((lastarg nil)
 	 (args (mapcar (lambda (arg)
 			 (cond
@@ -595,38 +595,40 @@
 			   (concat (match-string 0 arg) "<log message>"))
 			  ;; Keep the rest as is.
 			  (t arg)))
-		       args))
-	 ;; turn them into a string
-	 (arg (cvs-strings->string
-	       (append (cvs-flags-query 'cvs-cvs-flags nil 'noquery)
-		       (if cvs-cvsroot (list "-d" cvs-cvsroot))
-		       args
-		       (mapcar 'cvs-fileinfo->full-path fis))))
-	 (str (if args (concat "-- Running " cvs-program " " arg " ...\n")
-		"\n")))
-    (if nil (insert str)		;inline
-      ;;(with-current-buffer cvs-buffer
-      (let* ((prev-msg (car (ewoc-get-hf cvs-cookies)))
-	     (tin (ewoc-nth cvs-cookies 0)))
-	;; look for the first *real* fileinfo (to determine emptyness)
-	(while
-	    (and tin
-		 (memq (cvs-fileinfo->type (ewoc-data tin))
-		       '(MESSAGE DIRCHANGE)))
-	  (setq tin (ewoc-next cvs-cookies tin)))
-	;; cleanup the prev-msg
-	(when (string-match "Running \\(.*\\) ...\n" prev-msg)
-	  (setq prev-msg
-		(concat
-		 "-- last cmd: "
-		 (match-string 1 prev-msg)
-		 " --")))
-	;; set the new header and footer
-	(ewoc-set-hf cvs-cookies
-		     str (concat "\n--------------------- "
-				 (if tin "End" "Empty")
-				 " ---------------------\n"
-				 prev-msg))))))
+		       args)))
+    (concat cvs-program " "
+	    (cvs-strings->string
+	     (append (cvs-flags-query 'cvs-cvs-flags nil 'noquery)
+		     (if cvs-cvsroot (list "-d" cvs-cvsroot))
+		     args
+		     (mapcar 'cvs-fileinfo->full-path fis))))))
+
+(defun cvs-update-header (cmd add)
+  (let* ((hf (ewoc-get-hf cvs-cookies))
+	 (str (car hf))
+	 (done "")
+	 (tin (ewoc-nth cvs-cookies 0)))
+    (if (eq (length str) 1) (setq str ""))
+    ;; look for the first *real* fileinfo (to determine emptyness)
+    (while
+	(and tin
+	     (memq (cvs-fileinfo->type (ewoc-data tin))
+		   '(MESSAGE DIRCHANGE)))
+      (setq tin (ewoc-next cvs-cookies tin)))
+    (if add
+	(setq str (concat "-- Running " cmd " ...\n" str))
+      (if (not (string-match
+		(concat "^-- Running " (regexp-quote cmd) " \\.\\.\\.\n") str))
+	  (error "Internal PCL-CVS error while removing message")
+	(setq str (replace-match "" t t str))
+	(if (zerop (length str)) (setq str "\n"))
+	(setq done (concat "-- last cmd: " cmd " --"))))
+    ;; set the new header and footer
+    (ewoc-set-hf cvs-cookies
+		 str (concat "\n--------------------- "
+			     (if tin "End" "Empty")
+			     " ---------------------\n"
+			     done))))
 
 
 (defun cvs-sentinel (proc msg)
@@ -658,7 +660,6 @@
 	    ;; in a file-like buffer.  -stef
 	    (buffer-enable-undo)
 	    (with-current-buffer cvs-buffer
-	      (cvs-update-header nil nil) ;FIXME: might need to be inline
 	      (message "CVS process has completed in %s" (buffer-name)))))
 	;; This might not even be necessary
 	(set-buffer obuf)))))
@@ -1824,8 +1825,12 @@
 		;; absence of `cvs update' output has a specific meaning.
 		(or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." ""))))))
 	(push `(cvs-parse-process ',dont-change-disc nil ',old-fis) postproc)))
+    (let ((msg (cvs-header-msg args fis)))
+      (cvs-update-header msg 'add)
+      (push `(with-current-buffer cvs-buffer
+	       (cvs-update-header ',msg nil))
+	    postproc))
     (setq postproc (if (cdr postproc) (cons 'progn postproc) (car postproc)))
-    (cvs-update-header args fis)
     (with-current-buffer buf
       (let ((inhibit-read-only t)) (erase-buffer))
       (message "Running cvs %s ..." cmd)