1 ;;; summarize-guile-TODO --- Display Guile TODO list in various ways
3 ;; Copyright (C) 2002, 2006, 2010, 2011 Free Software Foundation, Inc.
5 ;; This program is free software; you can redistribute it and/or
6 ;; modify it under the terms of the GNU Lesser General Public License
7 ;; as published by the Free Software Foundation; either version 3, or
8 ;; (at your option) any later version.
10 ;; This program is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 ;; Lesser General Public License for more details.
15 ;; You should have received a copy of the GNU Lesser General Public
16 ;; License along with this software; see the file COPYING.LESSER. If
17 ;; not, write to the Free Software Foundation, Inc., 51 Franklin
18 ;; Street, Fifth Floor, Boston, MA 02110-1301 USA
20 ;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
24 ;; Usage: summarize-guile-TODO TODOFILE
26 ;; The TODOFILE is typically Guile's (see workbook/tasks/README)
27 ;; presumed to serve as our signal to ourselves (lest we want real
28 ;; bosses hassling us) wrt to the overt message "items to do" as well as
29 ;; the messages that can be inferred from its structure.
31 ;; This program reads TODOFILE and displays interpretations on its
32 ;; structure, including registered markers and ownership, in various
35 ;; A primary interest in any task is its parent task. The output
36 ;; summarization by default lists every item and its parent chain.
37 ;; Top-level parents are not items. You can use these command-line
38 ;; options to modify the selection and display (selection criteria
39 ;; are ANDed together):
41 ;; -i, --involved USER -- select USER-involved items
42 ;; -p, --personal USER -- select USER-responsible items
43 ;; -t, --todo -- select unfinished items (status "-")
44 ;; -d, --done -- select finished items (status "+")
45 ;; -r, --review -- select review items (marker "R")
47 ;; -w, --who -- also show who is associated w/ the item
48 ;; -n, --no-parent -- do not show parent chain
51 ;; Usage from a Scheme program:
52 ;; (summarize-guile-TODO . args) ; uses first arg only
55 ;; Bugs: (1) Markers are scanned in sequence: D R X N%. This means "XD"
56 ;; and the like are completely dropped. However, such strings
57 ;; are unlikely to be used if the markers are chosen to be
58 ;; somewhat exclusive, which is currently the case for D R X.
59 ;; N% used w/ these needs to be something like: "D25%" (this
60 ;; means discussion accounts for 1/4 of the task).
62 ;; TODO: Implement more various ways. (Patches welcome.)
63 ;; Add support for ORing criteria.
66 (debug-enable 'backtrace)
68 (define-module (scripts summarize-guile-TODO)
69 :use-module (scripts read-text-outline)
70 :use-module (ice-9 getopt-long)
71 :autoload (srfi srfi-13) (string-tokenize) ; string library
72 :autoload (srfi srfi-14) (char-set) ; string library
73 :autoload (ice-9 common-list) (remove-if-not)
74 :export (summarize-guile-TODO))
76 (define %include-in-guild-list #f)
77 (define %summary "A quaint relic of the past.")
79 (define put set-object-property!)
80 (define get object-property)
87 (string-tokenize who (char-set #\:)))))))
88 (cond ((get x 'pct-done)
90 (put x 'pct-done (string->number pct-done)))))
93 (define (hang-by-the-leaves trees)
95 (letrec ((hang (lambda (tree parent)
98 (put (car tree) 'parent parent)
99 (for-each (lambda (child)
100 (hang child (car tree)))
103 (put tree 'parent parent)
104 (set! leaves (cons (as-leaf tree) leaves)))))))
105 (for-each (lambda (tree)
110 (define (read-TODO file)
112 ((make-text-outline-reader
113 "(([ ][ ])*)([-+])(D*)(R*)(X*)(([0-9]+)%)* *([^[]*)(\\[(.*)\\])*"
114 '((level-substring-divisor . 2)
115 (body-submatch-number . 9)
116 (extra-fields . ((status . 3)
122 (open-file file "r"))))
124 (define (select-items p items)
126 (cond ((option-ref p 'involved #f)
128 (let ((u (string->symbol u)))
132 (memq u (get x 'who))))
134 (cond ((option-ref p 'personal #f)
136 (let ((u (string->symbol u)))
141 (eq? (car (reverse ls))
145 (for-each (lambda (pair)
146 (cond ((option-ref p (car pair) #f)
147 (set! sub (cons (cdr pair) sub)))))
148 `((todo . ,(lambda (x) (string=? (get x 'status) "-")))
149 (done . ,(lambda (x) (string=? (get x 'status) "+")))
150 (review . ,(lambda (x) (get x 'review?)))))
151 (let loop ((sub (reverse sub)) (items items))
154 (loop (cdr sub) (remove-if-not (car sub) items))))))
156 (define (make-display-item show-who? show-parent?)
160 (cond ((get item 'who)
161 => (lambda (who) (format #f " ~A" who)))
167 (let loop ((parent (get item 'parent)) (indent 2))
170 (format #t "under : ~A~A\n"
171 (make-string indent #\space)
173 (loop (get parent 'parent) (+ 2 indent))))))
174 (lambda (item) #t))))
176 (format #t "status: ~A~A~A~A~A~A\nitem : ~A\n"
178 (if (get item 'design?) "D" "")
179 (if (get item 'review?) "R" "")
180 (if (get item 'extblock?) "X" "")
181 (cond ((get item 'pct-done)
182 => (lambda (pct-done)
183 (format #f " ~A%" pct-done)))
187 (show-parents item))))
189 (define (display-items p items)
190 (let ((display-item (make-display-item (option-ref p 'who #f)
191 (not (option-ref p 'no-parent #f))
193 (for-each display-item items)))
195 (define (summarize-guile-TODO . args)
196 (let ((p (getopt-long (cons "summarize-guile-TODO" args)
197 '((who (single-char #\w))
198 (no-parent (single-char #\n))
199 (involved (single-char #\i)
201 (personal (single-char #\p)
203 (todo (single-char #\t))
204 (done (single-char #\d))
205 (review (single-char #\r))
208 (display-items p (select-items p (read-TODO (car (option-ref p '() #f))))))
211 (define main summarize-guile-TODO)
213 ;;; summarize-guile-TODO ends here