forked from tarsius/map-progress
/
map-progress.el
142 lines (109 loc) · 6.22 KB
/
map-progress.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
;;; map-progress.el --- mapping macros that report progress -*- lexical-binding: t -*-
;; Copyright (C) 2010-2014, 2019 Jonas Bernoulli
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Homepage: https://github.com/tarsius/map-progress
;; Keywords: convenience
;; Package-Requires: ((cl-lib "0.6.1"))
;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This package defines mapping macros that report progress.
;; For many of the standard and CL mapping functions like `mapc' macros
;; like `mapc-with-progress-reporter' are defined here. The arguments
;; have the same meaning as the respective arguments of the mapping
;; function or of `make-progress-reporter', which ever has an argument by
;; the same name.
;; Even when the original mapping function supports multiple sequences the
;; macros defined here only support one. All of `make-progress-reporter's
;; arguments except for MESSAGE are optional. This includes the starting
;; and final state arguments.
;; All standard mapping function with exactly two mandatory arguments that
;; call the function applied to each element with exactly one argument are
;; supported by `map-with-progress-reporter', which can be used when no
;; progress reporting variant of that function has been defined here. But
;; any optional arguments the original might have are not supported.
;;; Code:
(require 'cl-lib)
(defmacro map-with-progress-reporter (msg map fn seq &optional min max &rest rest)
"Apply FUNCTION to each element of SEQUENCE using mapping function MAP.
Report progress in the echo area. Also see `make-progress-reporter'.
\(fn MESSAGE MAP FUNCTION SEQUENCE [MIN-VALUE MAX-VALUE CURRENT-VALUE MIN-CHANGE MIN-TIME])"
(let ((idx (make-symbol "--map-with-progress-idx--"))
(msm (make-symbol "--map-with-progress-msm--"))
(lst (make-symbol "--map-with-progress-lst--"))
(prg (make-symbol "--map-with-progress-prg--"))
(elt (make-symbol "--map-with-progress-elt--")))
`(let* ((,idx 0)
(,msm ,msg)
(,lst ,seq)
(,prg (make-progress-reporter
,msm (or ,min 0) (or ,max (length ,lst)) ,@rest)))
(prog1 (funcall ,map (lambda (,elt)
(prog1 (funcall ,fn ,elt)
(progress-reporter-update ,prg (incf ,idx))))
,lst)
(progress-reporter-done ,prg)))))
(defmacro mapc-with-progress-reporter (msg fn seq &optional min max &rest rest)
"Like `mapc' but report progress in the echo area.
Also see `make-progress-reporter'.
\(fn MESSAGE FUNCTION SEQUENCE [MIN-VALUE MAX-VALUE CURRENT-VALUE MIN-CHANGE MIN-TIME])"
`(map-with-progress-reporter ,msg 'mapc ,fn ,seq ,min ,max ,@rest))
(defmacro mapcar-with-progress-reporter (msg fn seq &optional min max &rest rest)
"Like `mapcar' but report progress in the echo area.
Also see `make-progress-reporter'.
\(fn MESSAGE FUNCTION SEQUENCE [MIN-VALUE MAX-VALUE CURRENT-VALUE MIN-CHANGE MIN-TIME])"
`(map-with-progress-reporter ,msg 'mapcar ,fn ,seq ,min ,max ,@rest))
(defmacro mapatoms-with-progress-reporter (msg fn seq &optional min max &rest rest)
"Like `mapatoms' but report progress in the echo area.
Also see `make-progress-reporter'.
\(fn MESSAGE FUNCTION [OBARRAY MIN-VALUE MAX-VALUE CURRENT-VALUE MIN-CHANGE MIN-TIME])"
`(map-with-progress-reporter ,msg 'mapatoms ,fn ,seq ,min ,max ,@rest))
(defmacro mapcan-with-progress-reporter (msg fn seq &optional min max &rest rest)
"Like `cl-mapcan' but report progress in the echo area.
There may be only one SEQUENCE. Also see `make-progress-reporter'.
\(fn MESSAGE FUNCTION SEQUENCE [MIN-VALUE MAX-VALUE CURRENT-VALUE MIN-CHANGE MIN-TIME])"
`(map-with-progress-reporter ,msg 'cl-mapcan ,fn ,seq ,min ,max ,@rest))
(defmacro mapcon-with-progress-reporter (msg fn seq &optional min max &rest rest)
"Like `cl-mapcon' but report progress in the echo area.
There may be only one SEQUENCE. Also see `make-progress-reporter'.
\(fn MESSAGE FUNCTION SEQUENCE [MIN-VALUE MAX-VALUE CURRENT-VALUE MIN-CHANGE MIN-TIME])"
`(map-with-progress-reporter ,msg 'cl-mapcon ,fn ,seq ,min ,max ,@rest))
(defmacro mapl-with-progress-reporter (msg fn seq &optional min max &rest rest)
"Like `cl-mapl' but report progress in the echo area.
There may be only one SEQUENCE. Also see `make-progress-reporter'.
\(fn MESSAGE FUNCTION SEQUENCE [MIN-VALUE MAX-VALUE CURRENT-VALUE MIN-CHANGE MIN-TIME])"
`(map-with-progress-reporter ,msg 'cl-mapl ,fn ,seq ,min ,max ,@rest))
(defmacro maplist-with-progress-reporter (msg fn seq &optional min max &rest rest)
"Like `cl-maplist' but report progress in the echo area.
There may be only one SEQUENCE. Also see `make-progress-reporter'.
\(fn MESSAGE FUNCTION SEQUENCE [MIN-VALUE MAX-VALUE CURRENT-VALUE MIN-CHANGE MIN-TIME])"
`(map-with-progress-reporter ,msg 'cl-maplist ,fn ,seq ,min ,max ,@rest))
(defmacro mprg-with-message (message &rest body)
"Display MESSAGE before and after executing the forms in BODY.
Display MESSAGE, with \"...\" respectively \"...done\" appended, before and
after evaluationg BODY using function `message' . MESSAGE can also have
the form (SYMBOL MESSAGE) in which case SYMBOL is lexically bound to
\"MESSAGE...\". The value of the last form in BODY is returned."
(declare (indent 1))
(let ((sym (if (listp message)
(prog1 (car message)
(setq message (cadr message)))
(make-symbol "--with-message--"))))
`(let ((,sym (concat ,message "...")))
(message ,sym)
(prog1 (progn ,@body)
(message (concat ,sym "done"))))))
(provide 'map-progress)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; map-progress.el ends here