http://tailrecursion.com/~alan/tmp/paranav/

gistfile1.txt

(page "index.html"
  (:require-macros [paranav :refer [dbg]])
  (:require [tailrecursion.hoplon.reload :refer [reload-all]]
            [clojure.zip :as z]))

(def $ js/jQuery)

(when (-> js/window .-location .-hostname (= "localhost")) (reload-all))

(defn ->attr-map "(HLisp attrs workaround)" [m]
  (reduce (fn [xs kv] (conj xs (mapv symbol kv))) {} m))

(defc  point      nil)
(defc= &point     (if point (z/node point)))
(defc= $point     ($ &point))
(defc= point-root (if point (z/root point)))

;;; mode element creation, management

(defn mode-elem [mode {:keys [elem parent terminal valid-re tag]
                       :or {terminal false, valid-re ""}}]
  (with-let [self (elem)]
    (self (merge
           (->attr-map {"mode"      mode
                        "parent"    parent
                        "terminal"  (str terminal)
                        "valid_re"  valid-re
                        "tag"       tag})
           {:class (cell= {:point (= self &point)})}))))

(extend-type js/Element
  cljs.core/ILookup
  (-lookup [this k] (-lookup this k nil))
  (-lookup [this k not-found] (or (.attr ($ this) k) not-found))
  cljs.core/ISeqable
  (-seq [this] #(-> this $ .children .toArray seq)))

(defn non-terminal? [mode-elem]
  (= "false" (get mode-elem "terminal")))

(def terminal? (complement non-terminal?))

(defn valid? [terminal]
  (let [re (js/RegExp. (get terminal "valid_re"))]
    (boolean (.exec re (.text ($ terminal))))))

;;; document mode elements

(defelem document [attrs paragraphs]
  ((mode-elem "prose" {:elem div, :parent "root", :tag "document"})
   attrs
   paragraphs))

(defelem paragraph [attrs sentences]
  ((mode-elem "prose" {:elem p, :parent "document", :tag "paragraph"})
   attrs
   sentences))

(defelem sentence [attrs [string]]
  ((mode-elem "prose" {:elem span
                       :parent "paragraph"
                       :terminal true
                       :valid-re ".*[\\.\\?\\!]$"
                       :tag "sentence"})
   attrs
   string))

(defn attr-names [elem]
  (loop [i 0, names []]
    (if (< i (.-length (.-attributes elem)))
      (recur (inc i) (conj names (.-name (aget (.-attributes elem) i))))
      names)))

(defn attrs [elem]
  (->> (attr-names elem)
       (map #(vector % (get elem %)))
       (into {})))

(defn dup! [node]
  (let [new-attrs (attrs node)
        ctor      (tailrecursion.hoplon/make-elem-ctor
                   (.prop ($ node) "tagName"))]
    (.remove ($ node))
    (with-let [self (ctor)]
      (self (merge
             (->attr-map new-attrs)
             {:class (cell= {:point (= self &point)})})))))

(defn mode-zip [mode-root]
  (z/zipper non-terminal?
            #(-> % js/jQuery .children .toArray seq)
            #((dup! %1) %2)
            mode-root))

(def key-codes  {8  :backspace
                 13 :enter})

(defn new-paragraph [sibling-loc]
  (-> sibling-loc
      (z/insert-right (paragraph))
      z/right
      (z/append-child (sentence))
      z/down))

(def arrows {37 :left 38 :up 39 :right 40 :down})

(def movements
  {:left  #(if (= (z/leftmost %) %) (z/rightmost %) (z/left %))
   :up    z/up
   :right #(if (= (z/rightmost %) %) (z/leftmost %) (z/right %))
   :down  #(or (z/down %) %)})

(defn chr [e]
  (.fromCharCode js/String (.-charCode e)))


(def default-point
  (-> (document (paragraph (sentence "Type a period to complete this sentence")))
      mode-zip
      z/down
      z/down))

(with-init!
  (reset! point default-point)
  (doto ($ js/document)
    (.keyup (fn [e]
              (condp = [(get @&point "tag") (key-codes (.-keyCode e))]
                ["sentence" :backspace]
                (if (empty? (.text @$point))
                  ;; point is a sentence and is empty; remove
                  (let [to-remove @$point]
                    (swap! point z/remove)
                    (.remove to-remove))
                  ;; point is a sentence and has characters; edit in place
                  (swap! point z/edit
                         #(with-let [old %]
                            (.text ($ %) (fn [_ s] (subs s 0 (dec (count s))))))))
                (print "no keyup match"))))
    (.keydown (fn [e]
                (cond
                 ;; command character pressed
                 (contains? key-codes (.-keyCode e))
                 (condp = [(get @&point "tag") (key-codes (.-keyCode e))]
                   ;; point is a sentence and enter was pressed; make a new paragraph with empty sentence
                   ["sentence"  :enter] (swap! point #(-> % z/up new-paragraph))
                   ;; point is a paragraph and enter was pressed; make a new paragraph with empty sentence
                   ["paragraph" :enter] (swap! point #(-> % new-paragraph))
                   (print "no key-codes match for keydown"))
                 (contains? arrows (.-keyCode e))
                 ;; arrow pressed; navigate appropriately
                 (let [move (movements (arrows (.-keyCode e)))]
                   (swap! point move))
                 :else (print "no keywodn match for keyCode" (.-keyCode e)))))
    (.keypress (fn [e]
                 (condp = (get @&point "tag")
                   "sentence" (do (swap! point z/edit
                                         #(with-let [s %]
                                            (.text ($ %) (fn [_ s] (str s (chr e))))))
                                  ;; if the current sentence is valid, make a new one and move to it
                                  (when (valid? @&point)
                                    (swap! point z/insert-right (sentence))
                                    (swap! point z/rightmost))))))))

(html
  (head
    (title "Para Nav")
    (link :rel "stylesheet" :type "text/css" :href "normalize.css")
    (link :rel "stylesheet" :type "text/css" :href "style.css"))
  (body
    (div :id "center" :html point-root)))