Commit | Line | Data |
---|---|---|
dee565d0 DC |
1 | (in-package :lol) |
2 | ||
3 | (defvar *lol-example-application* | |
4 | (make-instance 'cookie-session-application | |
5 | :url-prefix "/" | |
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 | (defaction 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 |