git.fiddlerwoaroof.com
Raw Blame History
(in-package :fwoar.gluten.main)

(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"))))
                         ))))))