blob: dca8257486c3f4dd3473bacdaf40e51a79e09e62 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
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)
(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))
|
