progress reporting again

[Paul Pogonyshev]

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  <address@hidden>

        * 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  <address@hidden>

        * 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
 
address@hidden 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
address@hidden macro this way:
+
address@hidden
+(dotimes-with-progress-reporter
+    (k 500)
+    "Collecting some mana for Emacs..."
+  (sit-for 0.01))
address@hidden example
address@hidden 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