35 |
;; |
;; |
36 |
;; This program reads TODOFILE and displays interpretations on its |
;; This program reads TODOFILE and displays interpretations on its |
37 |
;; structure, including registered markers and ownership, in various |
;; structure, including registered markers and ownership, in various |
38 |
;; ways. [TODO] |
;; ways. |
39 |
;; |
;; |
40 |
;; A primary interest in any task is its parent task. The output |
;; A primary interest in any task is its parent task. The output |
41 |
;; summarization by default lists every item and its parent chain. |
;; summarization by default lists every item and its parent chain. |
42 |
;; Top-level parents are not items. |
;; 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 |
54 |
;; |
;; |
55 |
;; |
;; |
56 |
;; Usage from a Scheme program: |
;; Usage from a Scheme program: |
63 |
;; somewhat exclusive, which is currently the case for D R X. |
;; somewhat exclusive, which is currently the case for D R X. |
64 |
;; N% used w/ these needs to be something like: "D25%" (this |
;; N% used w/ these needs to be something like: "D25%" (this |
65 |
;; means discussion accounts for 1/4 of the task). |
;; means discussion accounts for 1/4 of the task). |
66 |
|
;; |
67 |
;; TODO: Implement the various ways. (Patches welcome.) |
;; TODO: Implement more various ways. (Patches welcome.) |
68 |
|
;; Add support for ORing criteria. |
69 |
|
|
70 |
;;; Code: |
;;; Code: |
71 |
|
(debug-enable 'debug 'backtrace) |
72 |
|
|
73 |
(define-module (scripts summarize-guile-TODO) |
(define-module (scripts summarize-guile-TODO) |
74 |
:use-module (scripts read-text-outline) |
:use-module (scripts read-text-outline) |
75 |
|
:use-module (ice-9 getopt-long) |
76 |
:autoload (srfi srfi-13) (string-tokenize) ; string library |
:autoload (srfi srfi-13) (string-tokenize) ; string library |
77 |
|
:autoload (ice-9 common-list) (remove-if-not) |
78 |
:export (summarize-guile-TODO)) |
:export (summarize-guile-TODO)) |
79 |
|
|
80 |
(define put set-object-property!) |
(define put set-object-property!) |
122 |
(who . 11))))) |
(who . 11))))) |
123 |
(open-file file "r")))) |
(open-file file "r")))) |
124 |
|
|
125 |
(define (display-item item) |
(define (select-items p items) |
126 |
(format #t "status: ~A~A~A~A~A\nitem : ~A\n" |
(let ((sub '())) |
127 |
(get item 'status) |
(cond ((option-ref p 'involved #f) |
128 |
(if (get item 'design?) "D" "") |
=> (lambda (u) |
129 |
(if (get item 'review?) "R" "") |
(let ((u (string->symbol u))) |
130 |
(if (get item 'extblock?) "X" "") |
(set! sub (cons |
131 |
(cond ((get item 'pct-done) |
(lambda (x) |
132 |
=> (lambda (pct-done) |
(and (get x 'who) |
133 |
(format #f " ~A%" pct-done))) |
(memq u (get x 'who)))) |
134 |
(else "")) |
sub)))))) |
135 |
item) |
(cond ((option-ref p 'personal #f) |
136 |
(let loop ((parent (get item 'parent)) (indent 2)) |
=> (lambda (u) |
137 |
(and parent |
(let ((u (string->symbol u))) |
138 |
(begin |
(set! sub (cons |
139 |
(format #t "under : ~A~A\n" |
(lambda (x) |
140 |
(make-string indent #\space) |
(cond ((get x 'who) |
141 |
parent) |
=> (lambda (ls) |
142 |
(loop (get parent 'parent) (+ 2 indent)))))) |
(eq? (car (reverse ls)) |
143 |
|
u))) |
144 |
(define (display-items items) |
(else #f))) |
145 |
(for-each display-item items)) |
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))) |
189 |
|
|
190 |
(define (summarize-guile-TODO . args) |
(define (summarize-guile-TODO . args) |
191 |
(display-items (read-TODO (car args))) |
(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)) |
200 |
|
(review (single-char #\d)) |
201 |
|
;; Add options here. |
202 |
|
)))) |
203 |
|
(display-items p (select-items p (read-TODO (car (option-ref p '() #f)))))) |
204 |
#t) ; exit val |
#t) ; exit val |
205 |
|
|
206 |
(define main summarize-guile-TODO) |
(define main summarize-guile-TODO) |