Drop usage of defaction
[clinton/lisp-on-lines.git] / reddit-example.lisp
1 (in-package :lol)
2
3 (defvar *lol-example-application*
4 (make-instance 'cookie-session-application
5 :url-prefix "/lisp-on-lines/"
6 :tal-generator (make-instance 'yaclml:file-system-generator
7 :cachep t
8 :root-directories (list *ucw-tal-root*))
9 :www-roots (list (merge-pathnames "./" *ucw-tal-root*))
10 :debug-on-error t))
11
12 (defentry-point "reddit" (:application *lol-example-application*) ()
13 (call 'front-page))
14
15 (defcomponent front-page (simple-window-component)
16 ()
17 (:default-initargs
18 :javascript "/dojo/dojo.js"))
19
20 (defmethod render ((self front-page))
21 (with-component (self)
22 (<:h1 (<:as-html "Lisp on Lines : Reddit Example"))
23
24 (<ucw:a :action (add-link self)
25 (<:as-html "Add Lispy Link"))
26 (<:div
27 :class "main"
28 (display (find-links)
29 :attributes '(link
30 (submitter :label "Submitted By :")
31 (score :label "Score :")
32 buttons)))))
33
34 (defclass/meta link ()
35 ((url :accessor url :initarg :url :type string)
36 (title :accessor title :initarg :title :type string)
37 (submitter :accessor submitter :initarg :submitter :type string)
38 (score :accessor score :initarg :score :type integer :initform 0)))
39
40 (define-attributes (link)
41 (link link :label "")
42 (buttons score-buttons :label ""))
43
44 (defvar *links* (list))
45
46 (defmethod/cc add-link ((self component))
47 (let ((l (call-display (make-instance 'link)
48 :type 'editor)))
49 (when l (push l *links*))))
50
51 (defun find-links ()
52 (sort (copy-list *links*) #'> :key #'score))
53
54 (defattribute link-attribute ()
55 ()
56 (:type-name link))
57
58 (defdisplay (:description (link link-attribute))
59 (<:a :href (url object)
60 (<:as-html (title object))))
61
62 (defattribute score-buttons ()
63 ()
64 (:type-name score-buttons))
65
66 (defdisplay (:description (score score-buttons))
67 (<ucw:a
68 :action (incf (score object))
69 (<:as-html "Up " ))
70 (<ucw:a
71 :action (decf (score object))
72 (<:as-html " Down" )))
73
74
75 (defdisplay (:combination :around :in-layer editor :class link)
76 (with-component (component)
77
78 (<ucw:form
79 :action (refresh-component component)
80 (<:h2 (<:as-html "Add a new Link"))
81 (call-next-method)
82 (<ucw:submit
83 :action (answer link)
84 :value "Ok")
85 (<ucw:submit
86 :action (answer nil)
87 :value "Cancel"))))
88
89
90 ;;;; We are going to use a POSTGRES database.
91 ;;;; It's a good idea to have created it already.
92
93 ;; template1=# CREATE USER lol PASSWORD 'lol';
94 ;; CREATE USER
95 ;; template1=# CREATE DATABASE lol OWNER lol;
96 ;; CREATE DATABASE
97 ;; template1=#
98
99