Browse code
feat: initial enpoint
Ed Langley authored on 29/10/2020 22:11:57Showing 2 changed files
| ... | ... |
@@ -2,16 +2,17 @@ |
| 2 | 2 |
(in-package :asdf-user) |
| 3 | 3 |
|
| 4 | 4 |
(defsystem :fwoar.gluten |
| 5 |
- :description "" |
|
| 6 |
- :author "Ed L <edward@elangley.org>" |
|
| 7 |
- :license "MIT" |
|
| 8 |
- :depends-on (#:alexandria |
|
| 9 |
- #:uiop |
|
| 10 |
- #:serapeum |
|
| 11 |
- #:parenscript |
|
| 12 |
- #:spinneret |
|
| 13 |
- #:lass |
|
| 14 |
- #:hunchentoot) |
|
| 15 |
- :serial t |
|
| 16 |
- :components ((:file "packages") |
|
| 17 |
- (:file "server"))) |
|
| 5 |
+ :description "" |
|
| 6 |
+ :author "Ed L <edward@elangley.org>" |
|
| 7 |
+ :license "MIT" |
|
| 8 |
+ :depends-on (#:alexandria |
|
| 9 |
+ #:uiop |
|
| 10 |
+ #:serapeum |
|
| 11 |
+ #:parenscript |
|
| 12 |
+ #:araneus-2 |
|
| 13 |
+ #:spinneret |
|
| 14 |
+ #:lass |
|
| 15 |
+ #:hunchentoot) |
|
| 16 |
+ :serial t |
|
| 17 |
+ :components ((:file "packages") |
|
| 18 |
+ (:file "server"))) |
| ... | ... |
@@ -1 +1,43 @@ |
| 1 | 1 |
(in-package :fwoar.gluten.main) |
| 2 |
+ |
|
| 3 |
+(defclass gluten-acceptor (araneus-2:acceptor) |
|
| 4 |
+ ()) |
|
| 5 |
+ |
|
| 6 |
+(spinneret:deftag template (body attrs &key title) |
|
| 7 |
+ attrs |
|
| 8 |
+ (alexandria:once-only (title) |
|
| 9 |
+ `(:html |
|
| 10 |
+ (:head |
|
| 11 |
+ (:title ,title) |
|
| 12 |
+ (:link :rel "stylesheet" :href "https://unpkg.com/codemirror@5.42.2/lib/codemirror.css") |
|
| 13 |
+ (:link :rel "stylesheet" :href "https://unpkg.com/codemirror@5.42.2/themes/zenburn.css") |
|
| 14 |
+ (:script :src "https://unpkg.com/codemirror@5.42.2/lib/codemirror.js" :type "text/javascript") |
|
| 15 |
+ (:script :src "https://unpkg.com/codemirror@5.42.2/mode/commonlisp/commonlisp.js" :type "text/javascript") |
|
| 16 |
+ (:script :src "https://unpkg.com/codemirror@5.42.2/keymap/vim.js" :type "text/javascript")) |
|
| 17 |
+ (:body |
|
| 18 |
+ (:header (:h* ,title)) |
|
| 19 |
+ (:main |
|
| 20 |
+ ,@body))))) |
|
| 21 |
+ |
|
| 22 |
+(ps:defpsmacro init (selector) |
|
| 23 |
+ `(let* ((el (ps:chain document (query-selector ,selector))) |
|
| 24 |
+ (cm (ps:chain -code-mirror (from-text-area el)))) |
|
| 25 |
+ (ps:chain cm |
|
| 26 |
+ (set-option "keyMap" "vim")) |
|
| 27 |
+ )) |
|
| 28 |
+ |
|
| 29 |
+ |
|
| 30 |
+(defmethod shared-initialize :after ((acceptor gluten-acceptor) slot-names &key) |
|
| 31 |
+ (with-accessors ((mapper araneus-2:mapper)) acceptor |
|
| 32 |
+ (myway:connect mapper "/" |
|
| 33 |
+ (lambda (&rest r) |
|
| 34 |
+ (let ((*print-case* :downcase)) |
|
| 35 |
+ (spinneret:with-html-string |
|
| 36 |
+ (template :title "A Paste Service" |
|
| 37 |
+ (:textarea :id "paste-out" |
|
| 38 |
+ (with-output-to-string (*standard-output*) |
|
| 39 |
+ (pprint '(defun foo (a b) |
|
| 40 |
+ (+ a b))))) |
|
| 41 |
+ (:script :type "text/javascript" |
|
| 42 |
+ (ps:ps (init "#paste-out")))) |
|
| 43 |
+ )))))) |