/[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.1 by ttn, Sat Apr 6 08:18:43 2002 UTC revision 1.2 by ttn, Sun Apr 7 21:37:14 2002 UTC
# Line 44  exec ${GUILE-guile} -l $0 -c "(apply $ma Line 44  exec ${GUILE-guile} -l $0 -c "(apply $ma
44  ;;  ;;
45  ;; Usage from a Scheme program:  ;; Usage from a Scheme program:
46  ;;   (summrize-guile-TODO . args)       ; uses first arg only  ;;   (summrize-guile-TODO . args)       ; uses first arg only
47    ;;
48    ;;
49    ;; Bugs: (1) Markers are scanned in sequence: D R X N%.  This means "XD"
50    ;;           and the like are completely dropped.  However, such strings
51    ;;           are unlikely to be used if the markers are chosen to be
52    ;;           somewhat exclusive, which is currently the case for D R X.
53    ;;           N% used w/ these needs to be something like: "D25%" (this
54    ;;           means discussion accounts for 1/4 of the task).
55    
56  ;; TODO: Implement the various ways. (Patches welcome.)  ;; TODO: Implement the various ways. (Patches welcome.)
57    
# Line 51  exec ${GUILE-guile} -l $0 -c "(apply $ma Line 59  exec ${GUILE-guile} -l $0 -c "(apply $ma
59    
60  (define-module (scripts summarize-guile-TODO)  (define-module (scripts summarize-guile-TODO)
61    :use-module (scripts read-text-outline)    :use-module (scripts read-text-outline)
62      :autoload (srfi srfi-13) (string-tokenize) ; string library
63    :export (summarize-guile-TODO))    :export (summarize-guile-TODO))
64    
65  (define put set-object-property!)  (define put set-object-property!)
66  (define get object-property)  (define get object-property)
67    
68    (define (as-leaf x)
69      (cond ((get x 'who)
70             => (lambda (who)
71                  (put x 'who
72                       (map string->symbol
73                            (string-tokenize who #\:))))))
74      (cond ((get x 'pct-done)
75             => (lambda (pct-done)
76                  (put x 'pct-done (string->number pct-done)))))
77      x)
78    
79  (define (hang-by-the-leaves trees)  (define (hang-by-the-leaves trees)
80    (let ((leaves '()))    (let ((leaves '()))
81      (letrec ((hang (lambda (tree parent)      (letrec ((hang (lambda (tree parent)
# Line 67  exec ${GUILE-guile} -l $0 -c "(apply $ma Line 87  exec ${GUILE-guile} -l $0 -c "(apply $ma
87                                       (cdr tree)))                                       (cdr tree)))
88                           (begin                           (begin
89                             (put tree 'parent parent)                             (put tree 'parent parent)
90                             (set! leaves (cons tree leaves)))))))                             (set! leaves (cons (as-leaf tree) leaves)))))))
91        (for-each (lambda (tree)        (for-each (lambda (tree)
92                    (hang tree #f))                    (hang tree #f))
93                  trees))                  trees))
94      leaves))      leaves))
95    
   
96  (define (read-TODO file)  (define (read-TODO file)
97    (hang-by-the-leaves    (hang-by-the-leaves
98     ((make-text-outline-reader "(([ ][ ])*)([-+])(R*) *([^[]*)(.*)"     ((make-text-outline-reader
99                                '((level-substring-divisor . 2)       "(([ ][ ])*)([-+])(D*)(R*)(X*)(([0-9]+)%)* *([^[]*)(\\[(.*)\\])*"
100                                  (body-submatch-number . 5)       '((level-substring-divisor . 2)
101                                  (extra-fields . ((status . 3)         (body-submatch-number . 9)
102                                                   (review? . 4)         (extra-fields . ((status . 3)
103                                                   (who . 6)))))                          (design? . 4)
104                            (review? . 5)
105                            (extblock? . 6)
106                            (pct-done . 8)
107                            (who . 11)))))
108      (open-file file "r"))))      (open-file file "r"))))
109    
110  (define (display-item item)  (define (display-item item)
111    (format #t "status: ~A~A\nitem  : ~A\n" (get item 'status)    (format #t "status: ~A~A~A~A~A\nitem  : ~A\n"
112            (if (get item 'review?) "R" "") item)            (get item 'status)
113              (if (get item 'design?) "D" "")
114              (if (get item 'review?) "R" "")
115              (if (get item 'extblock?) "X" "")
116              (cond ((get item 'pct-done)
117                     => (lambda (pct-done)
118                          (format #f " ~A%" pct-done)))
119                    (else ""))
120              item)
121    (let loop ((parent (get item 'parent)) (indent 2))    (let loop ((parent (get item 'parent)) (indent 2))
122      (and parent      (and parent
123           (begin           (begin

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

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