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