GOOPS "Proof of concept"

Doesn't actually do anything yet, but shows where to start.
This commit is contained in:
Tom Willemsen 2012-09-26 01:05:41 +02:00
parent c11e60df8b
commit 40566cee5b

View file

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