/[guile]/guile/guile-core/scripts/summarize-guile-TODO
ViewVC logotype

Diff of /guile/guile-core/scripts/summarize-guile-TODO

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by ttn, Sun Apr 7 21:37:14 2002 UTC revision 1.3 by ttn, Mon Apr 8 17:03:57 2002 UTC
# Line 35  exec ${GUILE-guile} -l $0 -c "(apply $ma Line 35  exec ${GUILE-guile} -l $0 -c "(apply $ma
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:
# Line 52  exec ${GUILE-guile} -l $0 -c "(apply $ma Line 63  exec ${GUILE-guile} -l $0 -c "(apply $ma
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!)
# Line 107  exec ${GUILE-guile} -l $0 -c "(apply $ma Line 122  exec ${GUILE-guile} -l $0 -c "(apply $ma
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)

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26