mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

Use (ice-9 getopt-long).

Browse source 
Autoload (ice-9 common-list).

(select-items): New proc.
(make-display-item): New proc.
(display-item): Delete.
(display-items): Use `make-display-item'.
(summarize-guile-TODO): Add option handling.
This commit is contained in:
Thien-Thi Nguyen 2002-04-08 17:03:57 +00:00
parent e4fcbe23b8
commit b262538585
1 changed files with 95 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

120
scripts/summarize-guile-TODO
View file

@ -35,11 +35,22 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
;; ;;
;; This program reads TODOFILE and displays interpretations on its ;; This program reads TODOFILE and displays interpretations on its
;; structure, including registered markers and ownership, in various ;; structure, including registered markers and ownership, in various
;; ways. [TODO] ;; ways.
;; ;;
;; A primary interest in any task is its parent task. The output ;; A primary interest in any task is its parent task. The output
;; summarization by default lists every item and its parent chain. ;; summarization by default lists every item and its parent chain.
;; Top-level parents are not items. ;; Top-level parents are not items. You can use these command-line
;; options to modify the selection and display (selection criteria
;; are ANDed together):
;;
;; -i, --involved USER -- select USER-involved items
;; -p, --personal USER -- select USER-responsible items
;; -t, --todo -- select unfinished items (status "-")
;; -t, --done -- select finished items (status "+")
;; -r, --review -- select review items (marker "R")
;;
;; -w, --who -- also show who is associated w/ the item
;; -n, --no-parent -- do not show parent chain
;; ;;
;; ;;
;; Usage from a Scheme program: ;; Usage from a Scheme program:
@ -52,14 +63,18 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
;; somewhat exclusive, which is currently the case for D R X. ;; somewhat exclusive, which is currently the case for D R X.
;; N% used w/ these needs to be something like: "D25%" (this ;; N% used w/ these needs to be something like: "D25%" (this
;; means discussion accounts for 1/4 of the task). ;; means discussion accounts for 1/4 of the task).
;;
;; TODO: Implement the various ways. (Patches welcome.) ;; TODO: Implement more various ways. (Patches welcome.)
;; Add support for ORing criteria.
;;; Code: ;;; Code:
(debug-enable 'debug 'backtrace)
(define-module (scripts summarize-guile-TODO) (define-module (scripts summarize-guile-TODO)
:use-module (scripts read-text-outline) :use-module (scripts read-text-outline)
:use-module (ice-9 getopt-long)
:autoload (srfi srfi-13) (string-tokenize) ; string library :autoload (srfi srfi-13) (string-tokenize) ; string library
:autoload (ice-9 common-list) (remove-if-not)
:export (summarize-guile-TODO)) :export (summarize-guile-TODO))
(define put set-object-property!) (define put set-object-property!)
@ -107,30 +122,85 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
(who . 11))))) (who . 11)))))
(open-file file "r")))) (open-file file "r"))))
(define (display-item item) (define (select-items p items)
(format #t "status: ~A~A~A~A~A\nitem : ~A\n" (let ((sub '()))
(get item 'status) (cond ((option-ref p 'involved #f)
(if (get item 'design?) "D" "") => (lambda (u)
(if (get item 'review?) "R" "") (let ((u (string->symbol u)))
(if (get item 'extblock?) "X" "") (set! sub (cons
(cond ((get item 'pct-done) (lambda (x)
=> (lambda (pct-done) (and (get x 'who)
(format #f " ~A%" pct-done))) (memq u (get x 'who))))
(else "")) sub))))))
item) (cond ((option-ref p 'personal #f)
(let loop ((parent (get item 'parent)) (indent 2)) => (lambda (u)
(and parent (let ((u (string->symbol u)))
(begin (set! sub (cons
(format #t "under : ~A~A\n" (lambda (x)
(make-string indent #\space) (cond ((get x 'who)
parent) => (lambda (ls)
(loop (get parent 'parent) (+ 2 indent)))))) (eq? (car (reverse ls))
u)))
(else #f)))
sub))))))
(for-each (lambda (pair)
(cond ((option-ref p (car pair) #f)
(set! sub (cons (cdr pair) sub)))))
`((todo . ,(lambda (x) (string=? (get x 'status) "-")))
(done . ,(lambda (x) (string=? (get x 'status) "+")))
(review . ,(lambda (x) (get x 'review?)))))
(let loop ((sub (reverse sub)) (items items))
(if (null? sub)
(reverse items)
(loop (cdr sub) (remove-if-not (car sub) items))))))
(define (display-items items) (define (make-display-item show-who? show-parent?)
(for-each display-item items)) (lambda (item)
(format #t "status: ~A~A~A~A~A~A\nitem : ~A\n"
(get item 'status)
(if (get item 'design?) "D" "")
(if (get item 'review?) "R" "")
(if (get item 'extblock?) "X" "")
(cond ((get item 'pct-done)
=> (lambda (pct-done)
(format #f " ~A%" pct-done)))
(else ""))
(cond ((get item 'who)
=> (lambda (who)
(if show-who?
(format #f " ~A" who)
"")))
(else ""))
item)
(and show-parent?
(let loop ((parent (get item 'parent)) (indent 2))
(and parent
(begin
(format #t "under : ~A~A\n"
(make-string indent #\space)
parent)
(loop (get parent 'parent) (+ 2 indent))))))))
(define (display-items p items)
(let ((display-item (make-display-item (option-ref p 'who #f)
(not (option-ref p 'no-parent #f))
)))
(for-each display-item items)))
(define (summarize-guile-TODO . args) (define (summarize-guile-TODO . args)
(display-items (read-TODO (car args))) (let ((p (getopt-long (cons "summarize-guile-TODO" args)
'((who (single-char #\w))
(no-parent (single-char #\n))
(involved (single-char #\i)
(value #t))
(personal (single-char #\p)
(value #t))
(todo (single-char #\t))
(done (single-char #\d))
(review (single-char #\d))
;; Add options here.
))))
(display-items p (select-items p (read-TODO (car (option-ref p '() #f))))))
#t) ; exit val #t) ; exit val
(define main summarize-guile-TODO) (define main summarize-guile-TODO)