Initial commit.

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