unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* progress reporting again
@ 2004-11-15 16:13 Paul Pogonyshev
  2004-11-17  6:35 ` Harald Maier
  0 siblings, 1 reply; 9+ messages in thread
From: Paul Pogonyshev @ 2004-11-15 16:13 UTC (permalink / raw)


Can anyone who uses SES mode check if the following patch works
fine?  I think it is generally a good idea to unify progress
reporting as much as possible in Emacs.

I didn't touch `ses-time-check' function, since progress messages
used with it are non-standard.

Paul


(for lisp/ChangeLog)

2004-11-15  Paul Pogonyshev  <pogonyshev@gmx.net>

	* subr.el (make-progress-reporter): Doc fix.
	(dotimes-with-progress-reporter): New macro.

	* ses.el (ses-dotimes-msg): Remove macro.
	(ses-relocate-all): Use `dotimes-with-progress-reporter' instead
	of `ses-dotimes-msg'.
	(ses-setup): Likewise.
	(ses-reprint-all): Likewise.
	(ses-reconstruct-all): Likewise.
	(ses-insert-row): Likewise.
	(ses-insert-column): Likewise.
	(ses-delete-column): Likewise.
	(ses-yank-cells): Likewise.


(for lispref/ChangeLog)

2004-11-15  Paul Pogonyshev  <pogonyshev@gmx.net>

	* display.texi (Progress): Document new
	`dotimes-with-progress-reporter' macro.


Index: etc/NEWS
===================================================================
RCS file: /cvsroot/emacs/emacs/etc/NEWS,v
retrieving revision 1.1066
diff -u -p -r1.1066 NEWS
--- etc/NEWS	10 Nov 2004 20:15:00 -0000	1.1066
+++ etc/NEWS	15 Nov 2004 16:09:10 -0000
@@ -116,8 +116,9 @@
 
 +++
 ** New functions `make-progress-reporter', `progress-reporter-update',
-`progress-reporter-force-update' and `progress-reporter-done' provide
-a simple and efficient way of printing progress messages to the user.
+`progress-reporter-force-update' and `progress-reporter-done' and
+`dotimes-with-progress-reporter' macro provide a simple and efficient
+way of printing progress messages to the user.
 
 +++
 ** In Enriched mode, `set-left-margin' and `set-right-margin' are now
Index: lispref/display.texi
===================================================================
RCS file: /cvsroot/emacs/emacs/lispref/display.texi,v
retrieving revision 1.132
diff -u -p -r1.132 display.texi
--- lispref/display.texi	8 Oct 2004 17:35:47 -0000	1.132
+++ lispref/display.texi	15 Nov 2004 16:09:40 -0000
@@ -632,6 +632,22 @@
 Secondly, ``done'' is more explicit.
 @end defun
 
+@defmac dotimes-with-progress-reporter (var count [result]) message body...
+This is a convenience macro that works the same way as @code{dotimes}
+does, but also reports loop progress using the functions described
+above.  It allows you to save some typing.
+
+You can rewrite the example in the beginning of this node using
+@code{dotimes-with-progress-reporter} macro this way:
+
+@example
+(dotimes-with-progress-reporter
+    (k 500)
+    "Collecting some mana for Emacs..."
+  (sit-for 0.01))
+@end example
+@end defmac
+
 @node Invisible Text
 @section Invisible Text
 
Index: lisp/ses.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/ses.el,v
retrieving revision 1.9
diff -u -p -r1.9 ses.el
--- lisp/ses.el	4 May 2004 16:13:43 -0000	1.9
+++ lisp/ses.el	15 Nov 2004 16:09:53 -0000
@@ -397,26 +397,6 @@
   (setq ses--header-row row)
   t)
 
-(defmacro ses-dotimes-msg (spec msg &rest body)
-  "(ses-dotimes-msg (VAR LIMIT) MSG BODY...): Like `dotimes', but
-a message is emitted using MSG every second or so during the loop."
-  (let ((msgvar   (make-symbol "msg"))
-	(limitvar (make-symbol "limit"))
-	(var      (car spec))
-	(limit    (cadr spec)))
-    `(let ((,limitvar ,limit)
-	   (,msgvar   ,msg))
-       (setq ses-start-time (float-time))
-       (message ,msgvar)
-       (setq ,msgvar (concat ,msgvar " (%d%%)"))
-       (dotimes (,var ,limitvar)
-	 (ses-time-check ,msgvar '(/ (* ,var 100) ,limitvar))
-	 ,@body)
-       (message nil))))
-
-(put 'ses-dotimes-msg 'lisp-indent-function 2)
-(def-edebug-spec ses-dotimes-msg ((symbolp form) form body))
-
 (defmacro ses-dorange (curcell &rest body)
   "Execute BODY repeatedly, with the variables `row' and `col' set to each
 cell in the range specified by CURCELL.  The range is available in the
@@ -1210,7 +1190,8 @@
 to each symbol."
   (let (reform)
     (let (mycell newval)
-      (ses-dotimes-msg (row ses--numrows) "Relocating formulas..."
+      (dotimes-with-progress-reporter
+	  (row ses--numrows) "Relocating formulas..."
 	(dotimes (col ses--numcols)
 	  (setq ses-relocate-return nil
 		mycell (ses-get-cell row col)
@@ -1238,7 +1219,8 @@
       (cond
        ((and (<= rowincr 0) (<= colincr 0))
 	;;Deletion of rows and/or columns
-	(ses-dotimes-msg (row (- ses--numrows minrow)) "Relocating variables..."
+	(dotimes-with-progress-reporter
+	    (row (- ses--numrows minrow)) "Relocating variables..."
 	  (setq myrow  (+ row minrow))
 	  (dotimes (col (- ses--numcols mincol))
 	    (setq mycol  (+ col mincol)
@@ -1254,7 +1236,8 @@
 	(let ((disty (1- ses--numrows))
 	      (distx (1- ses--numcols))
 	      myrow mycol)
-	  (ses-dotimes-msg (row (- ses--numrows minrow)) "Relocating variables..."
+	  (dotimes-with-progress-reporter
+	      (row (- ses--numrows minrow)) "Relocating variables..."
 	    (setq myrow (- disty row))
 	    (dotimes (col (- ses--numcols mincol))
 	      (setq mycol (- distx col)
@@ -1468,7 +1451,7 @@
     (put-text-property (point-min) (1+ (point-min)) 'front-sticky t)
     ;;Create intangible properties, which also indicate which cell the text
     ;;came from.
-    (ses-dotimes-msg (row ses--numrows) "Finding cells..."
+    (dotimes-with-progress-reporter (row ses--numrows) "Finding cells..."
       (dotimes (col ses--numcols)
 	(setq pos  end
 	      sym  (ses-cell-symbol row col))
@@ -1731,7 +1714,7 @@
     ;;find the data area when inserting or deleting *skip* values for cells
     (dotimes (row ses--numrows)
       (insert-and-inherit ses--blank-line))
-    (ses-dotimes-msg (row ses--numrows) "Reprinting..."
+    (dotimes-with-progress-reporter (row ses--numrows) "Reprinting..."
       (if (eq (ses-cell-value row 0) '*skip*)
 	  ;;Column deletion left a dangling skip
 	  (ses-set-cell row 0 'value nil))
@@ -1816,11 +1799,13 @@
   ;;Reconstruct reference lists.
   (let (refs x yrow ycol)
     ;;Delete old reference lists
-    (ses-dotimes-msg (row ses--numrows) "Deleting references..."
+    (dotimes-with-progress-reporter
+	(row ses--numrows) "Deleting references..."
       (dotimes (col ses--numcols)
 	(ses-set-cell row col 'references nil)))
     ;;Create new reference lists
-    (ses-dotimes-msg (row ses--numrows) "Computing references..."
+    (dotimes-with-progress-reporter
+	(row ses--numrows) "Computing references..."
       (dotimes (col ses--numcols)
 	(dolist (ref (ses-formula-references (ses-cell-formula row col)))
 	  (setq x    (ses-sym-rowcol ref)
@@ -2080,7 +2065,7 @@
     (ses-set-parameter 'ses--numrows (+ ses--numrows count))
     ;;Insert each row
     (ses-goto-print row 0)
-    (ses-dotimes-msg (x count) "Inserting row..."
+    (dotimes-with-progress-reporter (x count) "Inserting row..."
       ;;Create a row of empty cells.  The `symbol' fields will be set by
       ;;the call to ses-relocate-all.
       (setq newrow (make-vector ses--numcols nil))
@@ -2170,7 +2155,7 @@
     (ses-create-cell-variable-range 0            (1- ses--numrows)
 				    ses--numcols (+ ses--numcols count -1))
     ;;Insert each column.
-    (ses-dotimes-msg (x count) "Inserting column..."
+    (dotimes-with-progress-reporter (x count) "Inserting column..."
       ;;Create a column of empty cells.  The `symbol' fields will be set by
       ;;the call to ses-relocate-all.
       (ses-adjust-print-width col (1+ width))
@@ -2229,7 +2214,7 @@
     (ses-begin-change)
     (ses-set-parameter 'ses--numcols (- ses--numcols count))
     (ses-adjust-print-width col (- width))
-    (ses-dotimes-msg (row ses--numrows) "Deleting column..."
+    (dotimes-with-progress-reporter (row ses--numrows) "Deleting column..."
       ;;Delete lines from cell data area
       (ses-goto-data row col)
       (ses-delete-line count)
@@ -2475,7 +2460,7 @@
 	     (colincr  (- (cdr rowcol) (cdr first)))
 	     (pos      0)
 	     myrow mycol x)
-	(ses-dotimes-msg (row needrows) "Yanking..."
+	(dotimes-with-progress-reporter (row needrows) "Yanking..."
 	  (setq myrow (+ row (car rowcol)))
 	  (dotimes (col needcols)
 	    (setq mycol (+ col (cdr rowcol))
Index: lisp/subr.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/subr.el,v
retrieving revision 1.425
diff -u -p -r1.425 subr.el
--- lisp/subr.el	8 Nov 2004 16:55:56 -0000	1.425
+++ lisp/subr.el	15 Nov 2004 16:10:00 -0000
@@ -2631,7 +2631,7 @@
 (defun make-progress-reporter (message min-value max-value
 				       &optional current-value
 				       min-change min-time)
-  "Return progress reporter object usage with `progress-reporter-update'.
+  "Return progress reporter object to be used with `progress-reporter-update'.
 
 MESSAGE is shown in the echo area.  When at least 1% of operation
 is complete, the exact percentage will be appended to the
@@ -2720,5 +2720,32 @@
   "Print reporter's message followed by word \"done\" in echo area."
   (message "%sdone" (aref (cdr reporter) 3)))
 
+(defmacro dotimes-with-progress-reporter (spec message &rest body)
+  "Loop a certain number of times and report progress in the echo area.
+Evaluate BODY with VAR bound to successive integers running from
+0, inclusive, to COUNT, exclusive.  Then evaluate RESULT to get
+the return value (nil if RESULT is omitted).
+
+At each iteration MESSAGE followed by progress percentage is
+printed in the echo area.  After the loop is finished, MESSAGE
+followed by word \"done\" is printed.  This macro is a
+convenience wrapper around `make-progress-reporter' and friends.
+
+\(fn (VAR COUNT [RESULT]) MESSAGE BODY...)"
+  (declare (indent 2) (debug ((symbolp form &optional form) form body)))
+  (let ((temp (make-symbol "--dotimes-temp--"))
+	(temp2 (make-symbol "--dotimes-temp2--"))
+	(start 0)
+	(end (nth 1 spec)))
+    `(let ((,temp ,end)
+	   (,(car spec) ,start)
+	   (,temp2 (make-progress-reporter ,message ,start ,end)))
+       (while (< ,(car spec) ,temp)
+	 ,@body
+	 (progress-reporter-update ,temp2
+				   (setq ,(car spec) (1+ ,(car spec)))))
+       (progress-reporter-done ,temp2)
+       nil ,@(cdr (cdr spec)))))
+
 ;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc
 ;;; subr.el ends here

^ permalink raw reply	[flat|nested] 9+ messages in thread

end of thread, other threads:[~2005-01-19 23:48 UTC | newest]

Thread overview: 9+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2004-11-15 16:13 progress reporting again Paul Pogonyshev
2004-11-17  6:35 ` Harald Maier
2004-11-17 13:39   ` Paul Pogonyshev
2004-11-17 19:26     ` Stefan Monnier
2004-11-17 20:25       ` Paul Pogonyshev
2004-11-18  0:03         ` Kevin Rodgers
2004-11-18  6:25       ` Harald Maier
2004-11-26 15:21         ` Paul Pogonyshev
2005-01-19 23:48           ` Stefan Monnier

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).