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 |
|
|
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) |
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 |