git.fiddlerwoaroof.com
server.lisp
e5c36e15
 (in-package :fwoar.gluten.main)
01ff76b6
 
 (defclass gluten-acceptor (araneus-2:acceptor)
   ())
 
 (spinneret:deftag template (body attrs &key title)
   attrs
   (alexandria:once-only (title)
     `(:html
       (:head
        (:title ,title)
        (:link :rel "stylesheet" :href "https://unpkg.com/codemirror@5.42.2/lib/codemirror.css")
        (:link :rel "stylesheet" :href "https://unpkg.com/codemirror@5.42.2/themes/zenburn.css")
        (:script :src "https://unpkg.com/codemirror@5.42.2/lib/codemirror.js" :type "text/javascript")
        (:script :src "https://unpkg.com/codemirror@5.42.2/mode/commonlisp/commonlisp.js" :type "text/javascript")
        (:script :src "https://unpkg.com/codemirror@5.42.2/keymap/vim.js" :type "text/javascript"))
       (:body
        (:header (:h* ,title))
        (:main
         ,@body)))))
 
 (ps:defpsmacro init (selector)
   `(let* ((el (ps:chain document (query-selector ,selector)))
           (cm (ps:chain -code-mirror (from-text-area el))))
      (ps:chain cm
                (set-option "keyMap" "vim"))
      ))
 
 
 (defmethod shared-initialize :after ((acceptor gluten-acceptor) slot-names &key)
   (with-accessors ((mapper araneus-2:mapper)) acceptor
     (myway:connect mapper "/"
                    (lambda (&rest r)
                      (let ((*print-case* :downcase))
                        (spinneret:with-html-string
                          (template :title "A Paste Service"
                                    (:textarea :id "paste-out"
                                               (with-output-to-string (*standard-output*)
                                                 (pprint '(defun foo (a b)
                                                           (+ a b)))))
                                    (:script :type "text/javascript"
                                             (ps:ps (init "#paste-out"))))
                          ))))))