Commit | Line | Data |
---|---|---|
89c87759 TTN |
1 | #!/bin/sh |
2 | # aside from this initial boilerplate, this is actually -*- scheme -*- code | |
3 | main='(module-ref (resolve-module '\''(scripts summarize-guile-TODO)) '\'main')' | |
4 | exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" | |
5 | !# | |
6 | ;;; summarize-guile-TODO --- Display Guile TODO list in various ways | |
7 | ||
8 | ;; Copyright (C) 2002 Free Software Foundation, Inc. | |
9 | ;; | |
10 | ;; This program is free software; you can redistribute it and/or | |
11 | ;; modify it under the terms of the GNU General Public License as | |
12 | ;; published by the Free Software Foundation; either version 2, or | |
13 | ;; (at your option) any later version. | |
14 | ;; | |
15 | ;; This program is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
18 | ;; General Public License for more details. | |
19 | ;; | |
20 | ;; You should have received a copy of the GNU General Public License | |
21 | ;; along with this software; see the file COPYING. If not, write to | |
22 | ;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, | |
23 | ;; Boston, MA 02111-1307 USA | |
24 | ||
25 | ;;; Author: Thien-Thi Nguyen <ttn@gnu.org> | |
26 | ||
27 | ;;; Commentary: | |
28 | ||
29 | ;; Usage: summarize-guile-TODO TODOFILE | |
30 | ;; | |
31 | ;; The TODOFILE is typically Guile's (see workbook/tasks/README) | |
32 | ;; presumed to serve as our signal to ourselves (lest we want real | |
33 | ;; bosses hassling us) wrt to the overt message "items to do" as well as | |
34 | ;; the messages that can be inferred from its structure. | |
35 | ;; | |
36 | ;; This program reads TODOFILE and displays interpretations on its | |
37 | ;; structure, including registered markers and ownership, in various | |
b2625385 | 38 | ;; ways. |
89c87759 TTN |
39 | ;; |
40 | ;; A primary interest in any task is its parent task. The output | |
41 | ;; summarization by default lists every item and its parent chain. | |
b2625385 TTN |
42 | ;; Top-level parents are not items. You can use these command-line |
43 | ;; options to modify the selection and display (selection criteria | |
44 | ;; are ANDed together): | |
45 | ;; | |
46 | ;; -i, --involved USER -- select USER-involved items | |
47 | ;; -p, --personal USER -- select USER-responsible items | |
48 | ;; -t, --todo -- select unfinished items (status "-") | |
49 | ;; -t, --done -- select finished items (status "+") | |
50 | ;; -r, --review -- select review items (marker "R") | |
51 | ;; | |
52 | ;; -w, --who -- also show who is associated w/ the item | |
53 | ;; -n, --no-parent -- do not show parent chain | |
89c87759 TTN |
54 | ;; |
55 | ;; | |
56 | ;; Usage from a Scheme program: | |
57 | ;; (summrize-guile-TODO . args) ; uses first arg only | |
fb1cdefe TTN |
58 | ;; |
59 | ;; | |
60 | ;; Bugs: (1) Markers are scanned in sequence: D R X N%. This means "XD" | |
61 | ;; and the like are completely dropped. However, such strings | |
62 | ;; are unlikely to be used if the markers are chosen to be | |
63 | ;; somewhat exclusive, which is currently the case for D R X. | |
64 | ;; N% used w/ these needs to be something like: "D25%" (this | |
65 | ;; means discussion accounts for 1/4 of the task). | |
b2625385 TTN |
66 | ;; |
67 | ;; TODO: Implement more various ways. (Patches welcome.) | |
68 | ;; Add support for ORing criteria. | |
89c87759 TTN |
69 | |
70 | ;;; Code: | |
b2625385 | 71 | (debug-enable 'debug 'backtrace) |
89c87759 TTN |
72 | |
73 | (define-module (scripts summarize-guile-TODO) | |
74 | :use-module (scripts read-text-outline) | |
b2625385 | 75 | :use-module (ice-9 getopt-long) |
fb1cdefe | 76 | :autoload (srfi srfi-13) (string-tokenize) ; string library |
b2625385 | 77 | :autoload (ice-9 common-list) (remove-if-not) |
89c87759 TTN |
78 | :export (summarize-guile-TODO)) |
79 | ||
80 | (define put set-object-property!) | |
81 | (define get object-property) | |
82 | ||
fb1cdefe TTN |
83 | (define (as-leaf x) |
84 | (cond ((get x 'who) | |
85 | => (lambda (who) | |
86 | (put x 'who | |
87 | (map string->symbol | |
88 | (string-tokenize who #\:)))))) | |
89 | (cond ((get x 'pct-done) | |
90 | => (lambda (pct-done) | |
91 | (put x 'pct-done (string->number pct-done))))) | |
92 | x) | |
93 | ||
89c87759 TTN |
94 | (define (hang-by-the-leaves trees) |
95 | (let ((leaves '())) | |
96 | (letrec ((hang (lambda (tree parent) | |
97 | (if (list? tree) | |
98 | (begin | |
99 | (put (car tree) 'parent parent) | |
100 | (for-each (lambda (child) | |
101 | (hang child (car tree))) | |
102 | (cdr tree))) | |
103 | (begin | |
104 | (put tree 'parent parent) | |
fb1cdefe | 105 | (set! leaves (cons (as-leaf tree) leaves))))))) |
89c87759 TTN |
106 | (for-each (lambda (tree) |
107 | (hang tree #f)) | |
108 | trees)) | |
109 | leaves)) | |
110 | ||
89c87759 TTN |
111 | (define (read-TODO file) |
112 | (hang-by-the-leaves | |
fb1cdefe TTN |
113 | ((make-text-outline-reader |
114 | "(([ ][ ])*)([-+])(D*)(R*)(X*)(([0-9]+)%)* *([^[]*)(\\[(.*)\\])*" | |
115 | '((level-substring-divisor . 2) | |
116 | (body-submatch-number . 9) | |
117 | (extra-fields . ((status . 3) | |
118 | (design? . 4) | |
119 | (review? . 5) | |
120 | (extblock? . 6) | |
121 | (pct-done . 8) | |
122 | (who . 11))))) | |
89c87759 TTN |
123 | (open-file file "r")))) |
124 | ||
b2625385 TTN |
125 | (define (select-items p items) |
126 | (let ((sub '())) | |
127 | (cond ((option-ref p 'involved #f) | |
128 | => (lambda (u) | |
129 | (let ((u (string->symbol u))) | |
130 | (set! sub (cons | |
131 | (lambda (x) | |
132 | (and (get x 'who) | |
133 | (memq u (get x 'who)))) | |
134 | sub)))))) | |
135 | (cond ((option-ref p 'personal #f) | |
136 | => (lambda (u) | |
137 | (let ((u (string->symbol u))) | |
138 | (set! sub (cons | |
139 | (lambda (x) | |
140 | (cond ((get x 'who) | |
141 | => (lambda (ls) | |
142 | (eq? (car (reverse ls)) | |
143 | u))) | |
144 | (else #f))) | |
145 | sub)))))) | |
146 | (for-each (lambda (pair) | |
147 | (cond ((option-ref p (car pair) #f) | |
148 | (set! sub (cons (cdr pair) sub))))) | |
149 | `((todo . ,(lambda (x) (string=? (get x 'status) "-"))) | |
150 | (done . ,(lambda (x) (string=? (get x 'status) "+"))) | |
151 | (review . ,(lambda (x) (get x 'review?))))) | |
152 | (let loop ((sub (reverse sub)) (items items)) | |
153 | (if (null? sub) | |
154 | (reverse items) | |
155 | (loop (cdr sub) (remove-if-not (car sub) items)))))) | |
156 | ||
157 | (define (make-display-item show-who? show-parent?) | |
158 | (lambda (item) | |
159 | (format #t "status: ~A~A~A~A~A~A\nitem : ~A\n" | |
160 | (get item 'status) | |
161 | (if (get item 'design?) "D" "") | |
162 | (if (get item 'review?) "R" "") | |
163 | (if (get item 'extblock?) "X" "") | |
164 | (cond ((get item 'pct-done) | |
165 | => (lambda (pct-done) | |
166 | (format #f " ~A%" pct-done))) | |
167 | (else "")) | |
168 | (cond ((get item 'who) | |
169 | => (lambda (who) | |
170 | (if show-who? | |
171 | (format #f " ~A" who) | |
172 | ""))) | |
173 | (else "")) | |
174 | item) | |
175 | (and show-parent? | |
176 | (let loop ((parent (get item 'parent)) (indent 2)) | |
177 | (and parent | |
178 | (begin | |
179 | (format #t "under : ~A~A\n" | |
180 | (make-string indent #\space) | |
181 | parent) | |
182 | (loop (get parent 'parent) (+ 2 indent)))))))) | |
183 | ||
184 | (define (display-items p items) | |
185 | (let ((display-item (make-display-item (option-ref p 'who #f) | |
186 | (not (option-ref p 'no-parent #f)) | |
187 | ))) | |
188 | (for-each display-item items))) | |
89c87759 TTN |
189 | |
190 | (define (summarize-guile-TODO . args) | |
b2625385 TTN |
191 | (let ((p (getopt-long (cons "summarize-guile-TODO" args) |
192 | '((who (single-char #\w)) | |
193 | (no-parent (single-char #\n)) | |
194 | (involved (single-char #\i) | |
195 | (value #t)) | |
196 | (personal (single-char #\p) | |
197 | (value #t)) | |
198 | (todo (single-char #\t)) | |
199 | (done (single-char #\d)) | |
7e352174 | 200 | (review (single-char #\r)) |
b2625385 TTN |
201 | ;; Add options here. |
202 | )))) | |
203 | (display-items p (select-items p (read-TODO (car (option-ref p '() #f)))))) | |
89c87759 TTN |
204 | #t) ; exit val |
205 | ||
206 | (define main summarize-guile-TODO) | |
207 | ||
208 | ;;; summarize-guile-TODO ends here |