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
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
|
;;; summarize-guile-TODO --- Display Guile TODO list in various ways
;; Copyright (C) 2002, 2006, 2010, 2011 Free Software Foundation, Inc.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public License
;; as published by the Free Software Foundation; either version 3, or
;; (at your option) any later version.
;;
;; This program 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
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this software; see the file COPYING.LESSER. If
;; not, write to the Free Software Foundation, Inc., 51 Franklin
;; Street, Fifth Floor, Boston, MA 02110-1301 USA
;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
;;; Commentary:
;; Usage: summarize-guile-TODO TODOFILE
;;
;; The TODOFILE is typically Guile's (see workbook/tasks/README)
;; presumed to serve as our signal to ourselves (lest we want real
;; bosses hassling us) wrt to the overt message "items to do" as well as
;; the messages that can be inferred from its structure.
;;
;; This program reads TODOFILE and displays interpretations on its
;; structure, including registered markers and ownership, in various
;; ways.
;;
;; A primary interest in any task is its parent task. The output
;; summarization by default lists every item and its parent chain.
;; Top-level parents are not items. You can use these command-line
;; options to modify the selection and display (selection criteria
;; are ANDed together):
;;
;; -i, --involved USER -- select USER-involved items
;; -p, --personal USER -- select USER-responsible items
;; -t, --todo -- select unfinished items (status "-")
;; -d, --done -- select finished items (status "+")
;; -r, --review -- select review items (marker "R")
;;
;; -w, --who -- also show who is associated w/ the item
;; -n, --no-parent -- do not show parent chain
;;
;;
;; Usage from a Scheme program:
;; (summarize-guile-TODO . args) ; uses first arg only
;;
;;
;; Bugs: (1) Markers are scanned in sequence: D R X N%. This means "XD"
;; and the like are completely dropped. However, such strings
;; are unlikely to be used if the markers are chosen to be
;; somewhat exclusive, which is currently the case for D R X.
;; N% used w/ these needs to be something like: "D25%" (this
;; means discussion accounts for 1/4 of the task).
;;
;; TODO: Implement more various ways. (Patches welcome.)
;; Add support for ORing criteria.
;;; Code:
(debug-enable 'backtrace)
(define-module (scripts summarize-guile-TODO)
:use-module (scripts read-text-outline)
:use-module (ice-9 getopt-long)
:autoload (srfi srfi-13) (string-tokenize) ; string library
:autoload (srfi srfi-14) (char-set) ; string library
:autoload (ice-9 common-list) (remove-if-not)
:export (summarize-guile-TODO))
(define %include-in-guild-list #f)
(define %summary "A quaint relic of the past.")
(define put set-object-property!)
(define get object-property)
(define (as-leaf x)
(cond ((get x 'who)
=> (lambda (who)
(put x 'who
(map string->symbol
(string-tokenize who (char-set #\:)))))))
(cond ((get x 'pct-done)
=> (lambda (pct-done)
(put x 'pct-done (string->number pct-done)))))
x)
(define (hang-by-the-leaves trees)
(let ((leaves '()))
(letrec ((hang (lambda (tree parent)
(if (list? tree)
(begin
(put (car tree) 'parent parent)
(for-each (lambda (child)
(hang child (car tree)))
(cdr tree)))
(begin
(put tree 'parent parent)
(set! leaves (cons (as-leaf tree) leaves)))))))
(for-each (lambda (tree)
(hang tree #f))
trees))
leaves))
(define (read-TODO file)
(hang-by-the-leaves
((make-text-outline-reader
"(([ ][ ])*)([-+])(D*)(R*)(X*)(([0-9]+)%)* *([^[]*)(\\[(.*)\\])*"
'((level-substring-divisor . 2)
(body-submatch-number . 9)
(extra-fields . ((status . 3)
(design? . 4)
(review? . 5)
(extblock? . 6)
(pct-done . 8)
(who . 11)))))
(open-file file "r"))))
(define (select-items p items)
(let ((sub '()))
(cond ((option-ref p 'involved #f)
=> (lambda (u)
(let ((u (string->symbol u)))
(set! sub (cons
(lambda (x)
(and (get x 'who)
(memq u (get x 'who))))
sub))))))
(cond ((option-ref p 'personal #f)
=> (lambda (u)
(let ((u (string->symbol u)))
(set! sub (cons
(lambda (x)
(cond ((get x 'who)
=> (lambda (ls)
(eq? (car (reverse ls))
u)))
(else #f)))
sub))))))
(for-each (lambda (pair)
(cond ((option-ref p (car pair) #f)
(set! sub (cons (cdr pair) sub)))))
`((todo . ,(lambda (x) (string=? (get x 'status) "-")))
(done . ,(lambda (x) (string=? (get x 'status) "+")))
(review . ,(lambda (x) (get x 'review?)))))
(let loop ((sub (reverse sub)) (items items))
(if (null? sub)
(reverse items)
(loop (cdr sub) (remove-if-not (car sub) items))))))
(define (make-display-item show-who? show-parent?)
(let ((show-who
(if show-who?
(lambda (item)
(cond ((get item 'who)
=> (lambda (who) (format #f " ~A" who)))
(else "")))
(lambda (item) "")))
(show-parents
(if show-parent?
(lambda (item)
(let loop ((parent (get item 'parent)) (indent 2))
(and parent
(begin
(format #t "under : ~A~A\n"
(make-string indent #\space)
parent)
(loop (get parent 'parent) (+ 2 indent))))))
(lambda (item) #t))))
(lambda (item)
(format #t "status: ~A~A~A~A~A~A\nitem : ~A\n"
(get item 'status)
(if (get item 'design?) "D" "")
(if (get item 'review?) "R" "")
(if (get item 'extblock?) "X" "")
(cond ((get item 'pct-done)
=> (lambda (pct-done)
(format #f " ~A%" pct-done)))
(else ""))
(show-who item)
item)
(show-parents item))))
(define (display-items p items)
(let ((display-item (make-display-item (option-ref p 'who #f)
(not (option-ref p 'no-parent #f))
)))
(for-each display-item items)))
(define (summarize-guile-TODO . args)
(let ((p (getopt-long (cons "summarize-guile-TODO" args)
'((who (single-char #\w))
(no-parent (single-char #\n))
(involved (single-char #\i)
(value #t))
(personal (single-char #\p)
(value #t))
(todo (single-char #\t))
(done (single-char #\d))
(review (single-char #\r))
;; Add options here.
))))
(display-items p (select-items p (read-TODO (car (option-ref p '() #f))))))
#t) ; exit val
(define main summarize-guile-TODO)
;;; summarize-guile-TODO ends here
|
