ryuslash/undone
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Make the <view> class do its work

Browse source 
I still need to rewrite the macros to work with this new style of
view.
This commit is contained in:
Tom Willemsen 2012-10-01 00:35:05 +02:00
parent dcd44d1e93
commit ffcd87e06f
2 changed files with 11 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
undone/main.scm
View file

@ -109,8 +109,6 @@
result) result)
'())) '()))
(define view-list '())
(define (mkdirs path) (define (mkdirs path)
(let ((parent (dirname path))) (let ((parent (dirname path)))
(if (not (file-exists? parent)) (if (not (file-exists? parent))
@ -177,19 +175,17 @@
(cdr (assq 'state item)) (cdr (assq 'state item))
(cdr (assq 'content item)))) (cdr (assq 'content item))))
(define-view default
"Default todo-list view, show only the title."
"~2d ~a~%" id content)
(define (view args) (define (view args)
"Show a list of todo items." "Show a list of todo items."
(let* ((view-name (or (and (pair? args) (car args)) (let* ((view-name (or (and (pair? args) (car args))
"default")) "view"))
(view-symbol (string->symbol view-name)) (view-symbol (string->symbol view-name))
(view-cons (assq view-symbol view-list)) (view-cons (assq view-symbol view-list))
(view-func (if view-cons (cdr view-cons) '()))) (view-class (if view-cons (cdr view-cons) '())))
(if (procedure? view-func) (if (or (eq? <view> view-class)
(apply view-func '())))) (memq view-class (class-subclasses <view>)))
(print-view (make view-class #:todo-list todo-list))
(format #t "Unknown view: ~a~%" view-name))))
(define (load-rc-file) (define (load-rc-file)
"Load the RC file containing custom views and such." "Load the RC file containing custom views and such."
@ -220,6 +216,4 @@
(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> #:todo-list todo-list)))

6
undone/view.scm
View file

@ -1,7 +1,7 @@
(define-module (undone view) (define-module (undone view)
#:use-module (oop goops) #:use-module (oop goops)
#:export (<view> sort-view filter-view print-item get-list-for #:export (<view> view-list sort-view filter-view print-item
print-view)) get-list-for print-view))
(define-generic sort-view) (define-generic sort-view)
(define-generic filter-view) (define-generic filter-view)
@ -12,6 +12,8 @@
(define-class <view> () (define-class <view> ()
(todo-list #:init-value '() #:init-keyword #:todo-list)) (todo-list #:init-value '() #:init-keyword #:todo-list))
(define view-list `((view . ,<view>)))
(define-method (sort-view (v <view>) l) l) (define-method (sort-view (v <view>) l) l)
(define-method (print-item (v <view>) item) (define-method (print-item (v <view>) item)