todo

[Thien-Thi Nguyen <ttn@surf.glug.org>]

nothing a few lines of shell script couldn't replace...  on the other
hand, Some Day we will be able to boot into scheme like the PLT folks...

thi

______________________________________
#!/bin/sh
exec guile -s $0 "$@"
!#
;;; todo --- display TODO files in various ways

;; Copyright (C) 2003 Thien-Thi Nguyen
;; This program is part of ttn-do, released under GNU GPL v2 with ABSOLUTELY
;; NO WARRANTY.  See http://www.gnu.org/copyleft/gpl.txt for details.

;;; Commentary:

;; Usage: todo [OPTIONS] [PROJECT]
;;
;; Summarize PROJECT's todo file using "guile-tools summarize-guile-TODO".
;; PROJECT is a regular expression that may match one or more todo file
;; names registered in the meta data file (see `--meta' below).  If PROJECT
;; is omitted, all projects are selected.
;;
;; OPTIONS are zero or more of:
;;  -L, --list       -- display mtime and name of each todo file regsitered
;;  -M, --meta FILE  -- use FILE for meta data [default: $HOME/.todo.list]
;;
;; These options are also accepted (passed through to summarize-guile-TODO):
;;  -i, --involved USER  -- select USER-involved items
;;  -p, --personal USER  -- select USER-responsible items
;;  -t, --todo           -- select unfinished items (status "-")
;;  -d, --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

;;; Code:

(use-modules (scripts PROGRAM)
             (scripts summarize-guile-TODO)
             (ttn expand-file-name))

(define (display-mtime-and-name name)
  (format #t "~A  ~A\n"
          (let ((full (expand-file-name name)))
            (if (file-exists? full)
                (strftime "%Y-%m-%d  %H:%M:%S"
                          (localtime (stat:mtime (stat full))))
                "  (does not exist)  "))
          name))

(define *summarize-guile-TODO-option-spec*
  '((involved  (single-char #\i)
               (value #t))
    (personal  (single-char #\p)
               (value #t))
    (todo      (single-char #\t))
    (done      (single-char #\d))
    (review    (single-char #\r))
    (who       (single-char #\w))
    (no-parent (single-char #\n))))

(define (make-display-todo-file-proc qop)
  (let* ((options '())
         (chk! (lambda (key)
                 (let ((val (qop key)))
                   (and val (set! options (acons key val options)))))))
    (for-each chk! (map car *summarize-guile-TODO-option-spec*))
    (lambda (name)                      ; rv
      (format #t "todofile: ~A\n" name)
      (summarize-guile-TODO options (expand-file-name name))
      (newline))))

(define (main/qop qop)
  (let ((all (let ((inp (open-input-file
                         (or (qop 'meta)
                             (format #f "~A/.todo.list" (getenv "HOME"))))))
               (let loop ((f (read inp)) (acc '()))
                 (if (eof-object? f)
                     (begin (close-port inp)
                            (reverse acc))
                     (loop (read inp) (cons f acc)))))))
    (cond ((qop 'list)
           (for-each display-mtime-and-name all))
          ((null? (qop '()))
           (for-each (make-display-todo-file-proc qop) all))
          (else
           (let ((rx (make-regexp (car (qop '()))))
                 (spew (make-display-todo-file-proc qop)))
             (for-each (lambda (name)
                         (and (regexp-exec rx name)
                              (spew name)))
                       all)))))
  #t)

(HVQC-MAIN (command-line) main/qop
           '(usage . commentary)
           '(version . "1.0")
           '(package . "ttn-do")
           `(option-spec (meta (single-char #\M)
                               (value #t))
                         (list (single-char #\L))
                         ;; these are passed to `summarize-guile-TODO'
                         ,@*summarize-guile-TODO-option-spec*))

;;; todo ends here


_______________________________________________
Guile-user mailing list
Guile-user@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-user