GOOPS "Proof of concept"
Doesn't actually do anything yet, but shows where to start.
This commit is contained in:
parent
c11e60df8b
commit
40566cee5b
1 changed files with 39 additions and 1 deletions
|
@ -1,6 +1,7 @@
|
||||||
(define-module (undone main)
|
(define-module (undone main)
|
||||||
#:use-module (ice-9 format)
|
#:use-module (ice-9 format)
|
||||||
#:use-module (ice-9 rdelim)
|
#:use-module (ice-9 rdelim)
|
||||||
|
#:use-module (oop goops)
|
||||||
#:export (main))
|
#:export (main))
|
||||||
|
|
||||||
(define-syntax get-field
|
(define-syntax get-field
|
||||||
|
@ -165,6 +166,41 @@
|
||||||
(string->number (car args)))))
|
(string->number (car args)))))
|
||||||
todo-list)))
|
todo-list)))
|
||||||
|
|
||||||
|
(define-class <view> ())
|
||||||
|
|
||||||
|
(define-generic print-view)
|
||||||
|
(define-generic sort-view)
|
||||||
|
(define-generic filter-view)
|
||||||
|
|
||||||
|
(define-method (sort-view (v <view>) l)
|
||||||
|
l)
|
||||||
|
|
||||||
|
(define-method (filter-view (v <view>))
|
||||||
|
(lambda (elm)
|
||||||
|
(and (assq 'id elm) (assq 'content elm))))
|
||||||
|
|
||||||
|
(define-method (print-view (v <view>))
|
||||||
|
(for-each
|
||||||
|
(lambda (item)
|
||||||
|
(let ((id (let ((field (assq 'id item)))
|
||||||
|
(and field (cdr field))))
|
||||||
|
(content
|
||||||
|
(let ((field (assq 'content item)))
|
||||||
|
(and field (cdr field)))))
|
||||||
|
(if #t (format #t "~2d ~a~%" id content))))
|
||||||
|
(filter (filter-view v)
|
||||||
|
(sort-view v todo-list))))
|
||||||
|
|
||||||
|
(define-class <todo-view> (<view>))
|
||||||
|
|
||||||
|
(define-method (sort-view (v <todo-view>) l)
|
||||||
|
(reverse l))
|
||||||
|
|
||||||
|
(define-method (filter-view (v <todo-view>))
|
||||||
|
(lambda (elm)
|
||||||
|
(let ((id (assq 'id elm)))
|
||||||
|
(and id (> (cdr id) 4)))))
|
||||||
|
|
||||||
(define-view default
|
(define-view default
|
||||||
"Default todo-list view, show only the title."
|
"Default todo-list view, show only the title."
|
||||||
"~2d ~a~%" id content)
|
"~2d ~a~%" id content)
|
||||||
|
@ -208,4 +244,6 @@
|
||||||
(lambda (view)
|
(lambda (view)
|
||||||
(format #t "~a~20t~a~%"
|
(format #t "~a~20t~a~%"
|
||||||
(car view) (procedure-documentation (cdr view))))
|
(car view) (procedure-documentation (cdr view))))
|
||||||
view-list)))))
|
view-list))))
|
||||||
|
|
||||||
|
(print-view (make <todo-view>)))
|
||||||
|
|
Loading…
Reference in a new issue