From: Paul Pogonyshev <pogonyshev@gmx.net>
Subject: progress reporting again
Date: Mon, 15 Nov 2004 18:13:44 +0200 [thread overview]
Message-ID: <200411151813.44859.pogonyshev@gmx.net> (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
next reply other threads:[~2004-11-15 16:13 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
2004-11-15 16:13 Paul Pogonyshev [this message]
2004-11-17 6:35 ` progress reporting again 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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=200411151813.44859.pogonyshev@gmx.net \
--to=pogonyshev@gmx.net \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.