summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGravatar Tom Willemsen2012-08-13 01:16:04 +0200
committerGravatar Tom Willemsen2012-08-13 01:16:04 +0200
commitffbff6beb68c69cd3876e9a61ae85f079dedcfdd (patch)
treea2e8fee48886554706a08ced70c86ce375698a68
downloadundone-ffbff6beb68c69cd3876e9a61ae85f079dedcfdd.tar.gz
undone-ffbff6beb68c69cd3876e9a61ae85f079dedcfdd.zip
Initial commit.
-rw-r--r--undone/main.scm105
1 files changed, 105 insertions, 0 deletions
diff --git a/undone/main.scm b/undone/main.scm
new file mode 100644
index 0000000..4f30005
--- /dev/null
+++ b/undone/main.scm
@@ -0,0 +1,105 @@
+(define-module (undone main)
+ #:use-module (ice-9 format)
+ #:use-module (ice-9 rdelim)
+ #:export (main))
+
+(define-syntax define-view
+ (lambda (x)
+ (syntax-case x ()
+ ((_ name doc exps exps* ...)
+ (with-syntax ((viewname
+ (datum->syntax
+ x (symbol-append (syntax->datum #'name) '-view))))
+ #'(begin
+ (define (viewname)
+ doc
+ exps exps* ...)
+ (set! view-list
+ (append view-list
+ (list (cons 'name viewname))))))))))
+
+(define todo-list-file "todo.scm")
+
+(define todo-list
+ (if (file-exists? todo-list-file)
+ (let* ((port (open-input-file todo-list-file))
+ (result (read port)))
+ (close-port port)
+ result)
+ '()))
+
+(define view-list '())
+
+(define (data-dir)
+ "Get the location for data files."
+ (let ((xdg (getenv "XDG_DATA_HOME")))
+ (string-append (if xdg
+ (string-append xdg "/")
+ (string-append (getenv "HOME") "/."))
+ "undone")))
+
+(define (config-dir)
+ "Get the location for configuration files."
+ (let ((xdg (getenv "XDG_CONFIG_HOME")))
+ (string-append (if xdg
+ (string-append xdg "/")
+ (string-append (getenv "HOME") "/."))
+ "undone")))
+
+(define (save)
+ "Save the list."
+ (let ((port (open-output-file todo-list-file)))
+ (write todo-list port)
+ (close-port port)))
+
+(define (add args)
+ "Add item to the list."
+ (set! todo-list
+ (append todo-list
+ (list
+ (append
+ `((content . ,(read-delimited "")))
+ (map (lambda (arg)
+ (let ((pair (string-split arg #\=)))
+ (cons (string->symbol (car pair))
+ (cadr pair))))
+ args))))))
+
+(define-view default
+ "Default todo-list view, show only the title."
+ (map (lambda (todo)
+ (display (cdr (assq 'content todo))))
+ todo-list))
+
+(define-view test
+ "Just a test view, see everything in todo-list."
+ (write todo-list))
+
+(define (view args)
+ "Show a list of todo items."
+ (let* ((view-name (or (and (pair? args) (car args))
+ "default"))
+ (view-symbol (string->symbol view-name))
+ (view-cons (assq view-symbol view-list))
+ (view-func (if view-cons (cdr view-cons) '())))
+ (if (procedure? view-func)
+ (apply view-func '()))))
+
+(define (main args)
+ ;; (primitive-load "/home/slash/undonerc.scm")
+ (if (> (length args) 1)
+ (case (string->symbol (cadr args))
+ ((add)
+ (add (list-tail args 2))
+ (save))
+ ((view)
+ (view (list-tail args 2)))
+ ((views)
+ (display "Defined views:")
+ (newline)
+ (map (lambda (view)
+ (format #t "~a~20t~a~%"
+ (car view) (procedure-documentation (cdr view))))
+ view-list)))))
+
+(main (program-arguments))