forked from thephoeron/LLTHW
-
Notifications
You must be signed in to change notification settings - Fork 4
/
handlers.lisp
150 lines (126 loc) · 7.79 KB
/
handlers.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
;;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: LLTHW; Base: 10 -*-
;;;; file: handlers.lisp
;;;; Copyright (c) 2012--2015 "the Phoeron" Colin J.E. Lupton <//thephoeron.com>
;;;; See LICENSE for additional information.
(in-package :llthw)
;; Splash page
(define-easy-handler (llthw-splash-page :uri "/") ()
(basic-llthw-page ()
(cl-who:with-html-output (hunchentoot::*standard-output*)
(:div :class "jumbotron masthead"
(:div :class "container"
(:h1 :align "center" "L(λ)THW")
(:p :class "lead" :align "center"
"Learn Lisp The Hard Way")
(:p :align "center" :style "color: silver;"
"Brought to you by the Toronto Lisp User Group")
(:div :class "row"
(:div :class "col-md-8 col-md-offset-2"
(str (3bmd:parse-and-print-to-stream "splash-example.md" hunchentoot::*standard-output* :format :html))))
(:p :align "center"
(:a :href "/book/" :class "btn btn-info btn-lg"
(:span :class "glyphicon glyphicon-book")
" Read the HTML Ebook") " "
(:a :href "/get-lisp/" :class "btn btn-primary btn-lg" :alt "Download Common Lisp" :title "Download Common Lisp"
(:span :class "glyphicon glyphicon-cloud-download")
" Download Common Lisp") " "
(:a :href "/try-lisp/" :class "btn btn-primary btn-lg"
(:span :class "glyphicon glyphicon-road")
" Try Lisp Now in Your Browser"))
(:ul :class "masthead-links" :align "center"
(:li (:a :href "#" :class "btn btn-default" :disabled "disabled" "Paperback Edition (Coming Soon)"))
(:li (:a :href "/book/" :class "btn btn-default" "Free Online HTML Ebook"))
(:li (:a :href "/resources/" :class "btn btn-default" "Additional Lisp Language Resources")
(:li (:a :href "#" :class "btn btn-default" :disabled "disabled" (fmt "Draft Version ~A (alpha)" *llthw-version*)))))))
(:div :class "social-banner"
(:div :class "container"
(:ul :class "social-banner-buttons"
(:li "Contribute:")
(:li (:a :href "http://github.com/LispTO/llthw" :target "_blank" :title "Learn Lisp The Hard Way on GitHub" (:i :class "fa fa-code-fork fa-2x")))
(:li "Connect with the Authors:")
(:li (:a :href "http://github.com/LispTO" :target "_blank" :title "Toronto Lisp User Group on GitHub" (:i :class "fa fa-github-square fa-2x")))
(:li (:a :href "http://facebook.com/llthw" :target "_blank" :title "Learn Lisp The Hard Way on Facebook" (:i :class "fa fa-facebook-square fa-2x")))
(:li (:a :href "http://lisptoronto.org/" :target "_blank" :title "Toronto Lisp User Group website" (:i :class "fa fa-globe fa-2x")))
(:li "Support this project:")
(:li (:a :href "https://www.digitalocean.com/?refcode=ef3cf1ffcbb7" :title "Get Cloud Hosting on Digital Ocean" (:i :class "fa fa-cloud fa-2x")))
(:li (:a :href "/donate/#paypal" :title "Donate by PayPal" (:i :class "fa fa-paypal fa-2x")))
(:li (:a :href "/donate/#bitcoin" :title "Donate Bitcoin" (:i :class "fa fa-bitcoin fa-2x")))
(:li (:a :href "/donate/#litecoin" :title "Donate Litecoin" (:span :style "font-size: 30px; font-weight: bold; text-decoration: none;" "Ł"))))))
(:div :class "container"
(:div :class "row"
(:div :class "col-md-12"
(str (3bmd:parse-and-print-to-stream "splash-faq.md" hunchentoot::*standard-output* :format :html))))))))
;; Try Lisp pages
(define-easy-handler (llthw-try-lisp :uri "/try-lisp/") ()
(try-lisp-page ()
(cl-who:with-html-output (hunchentoot::*standard-output*)
(str (3bmd:parse-and-print-to-stream "try-lisp/index.md" hunchentoot::*standard-output* :format :html)))))
(define-easy-handler (llthw-try-lisp-math :uri "/try-lisp/math/") ()
(try-lisp-basic-page ()
(cl-who:with-html-output (hunchentoot::*standard-output*)
(str (3bmd:parse-and-print-to-stream "try-lisp/math.md" hunchentoot::*standard-output* :format :html)))))
(define-easy-handler (llthw-try-lisp-print :uri "/try-lisp/print/") ()
(try-lisp-basic-page ()
(cl-who:with-html-output (hunchentoot::*standard-output*)
(str (3bmd:parse-and-print-to-stream "try-lisp/print.md" hunchentoot::*standard-output* :format :html)))))
(define-easy-handler (llthw-try-lisp-end :uri "/try-lisp/end/") ()
(try-lisp-basic-page ()
(cl-who:with-html-output (hunchentoot::*standard-output*)
(str (3bmd:parse-and-print-to-stream "try-lisp/end.md" hunchentoot::*standard-output* :format :html)))))
;; Reference pages
(define-easy-handler (llthw-reference :uri "/reference/") (ref-page)
(let ((the-ref-page (format nil "reference/~(~A~).md" (cl-who:escape-string-all ref-page))))
(if (probe-file the-ref-page)
(reference-basic-page ()
(cl-who:with-html-output (hunchentoot::*standard-output*)
(str (3bmd:parse-and-print-to-stream the-ref-page hunchentoot::*standard-output* :format :html))))
(reference-basic-page ()
(cl-who:with-html-output (hunchentoot::*standard-output*)
(:h4 "Error 404: Not Found"))))))
;; Main site pages
(define-easy-handler (llthw-get-lisp :uri "/get-lisp/") ()
(llthw-page (:subtitle "Download and Install Steel Bank Common Lisp" :section "get-lisp")
(cl-who:with-html-output (hunchentoot::*standard-output*)
(str (3bmd:parse-and-print-to-stream "resources/get-lisp.md" hunchentoot::*standard-output* :format :html)))))
(define-easy-handler (llthw-resources :uri "/resources/") ()
(llthw-page (:subtitle "Additional Common Lisp Resources" :section "resources")
(cl-who:with-html-output (hunchentoot::*standard-output*)
(str (3bmd:parse-and-print-to-stream "resources/index.md" hunchentoot::*standard-output* :format :html)))))
(define-easy-handler (llthw-donations :uri "/donate/") ()
(llthw-page (:subtitle "Support this Project with Your Donations" :section "donations")
(cl-who:with-html-output (hunchentoot::*standard-output*)
(str (3bmd:parse-and-print-to-stream "resources/donations.md" hunchentoot::*standard-output* :format :html)))))
;; Book, Contents at a Glance
;; also available at /book/index/
(define-easy-handler (llthw-book :uri "/book/") ()
(llthw-page ()
(cl-who:with-html-output (hunchentoot::*standard-output*)
(str (3bmd:parse-and-print-to-stream "book/index.md" hunchentoot::*standard-output* :format :html)))))
;; Handle book pages by reference
;; - this function could use some refactoring and clean-up
(defun llthw-book-page ()
"Probe for the book-page file from the current request script name."
(let* ((script-name (hunchentoot:script-name*))
(script-list (split-sequence #\/ script-name :remove-empty-subseqs t)))
(if (= (length script-list) 2)
(let* ((file-name (format nil "~{~(~A~)~^/~}.md" script-list)))
(if (probe-file file-name)
(llthw-page ()
(cl-who:with-html-output (hunchentoot::*standard-output*)
(str (3bmd:parse-and-print-to-stream file-name
hunchentoot::*standard-output*
:format :html))))
(progn
(setf (return-code*) +http-not-found+)
(abort-request-handler))))
(progn
(setf (return-code*) +http-forbidden+)
(abort-request-handler)))))
;; Regex dispatcher for book pages
(push (hunchentoot:create-regex-dispatcher "^/book/[\\w-]+/$" 'llthw-book-page)
hunchentoot:*dispatch-table*)
;; robots.txt file
(define-easy-handler (robots-txt :uri "/robots.txt") ()
(setf (content-type*) "text/plain")
(format nil "User-agent: *~%Disallow: /static/~%Disallow: /reference/"))
;; EOF