/
common.cljc
199 lines (170 loc) · 7.24 KB
/
common.cljc
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
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
(ns markdown.common
(:require [clojure.string :as string]))
(def ^{:dynamic true} *substring*)
(def ^:dynamic *inhibit-separator* nil)
(def escape-delimiter (str (char 254) (char 491)))
(defn gen-token [n]
(str escape-delimiter n escape-delimiter))
(defn freeze-string
"Freezes an output string. Converts to a placeholder token and puts that into the output.
Returns the [text, state] pair. Adds it into the state, the 'frozen-strings' hashmap
So that it can be unfrozen later."
[& args]
(let [state (last args)
token (gen-token (count (:frozen-strings state)))]
[token (assoc-in state
[:frozen-strings token]
(reduce str (flatten (drop-last args))))]))
(defn thaw-string
"Recursively replaces the frozen strings in the output with the original text."
[text state]
(if-let [matches (re-seq (re-pattern (str escape-delimiter "\\d+" escape-delimiter)) text)]
(recur
(reduce
(fn [s r]
(string/replace s (re-pattern r) #(get (:frozen-strings state) % %)))
text matches)
(update state :frozen-strings #(apply dissoc % matches)))
[text state]))
(defn thaw-strings
"Terminally encoded strings are ones that we've determined should no longer be processed or evaluated"
[text state]
(if-not (empty? (:frozen-strings state))
(thaw-string text state)
[text state]))
(defn escape-code [s]
(-> s
(string/replace #"&" "&")
(string/replace #"\*" "*")
(string/replace #"\^" "^")
(string/replace #"\_" "_")
(string/replace #"\~" "~")
(string/replace #"\<" "<")
(string/replace #"\>" ">")
;(string/replace #"\/" "⁄") ;screws up ClojureScript compiling
(string/replace #"\[" "[")
(string/replace #"\]" "]")
(string/replace #"\(" "(")
(string/replace #"\)" ")")
(string/replace #"\"" """)))
(defn escaped-chars [text state]
[(if (or (:code state) (:codeblock state))
text
(-> text
(string/replace #"\\\\" "\")
(string/replace #"\\`" "‘")
(string/replace #"\\\*" "*")
(string/replace #"\\_" "_")
(string/replace #"\\\{" "{")
(string/replace #"\\\}" "}")
(string/replace #"\\\[" "[")
(string/replace #"\\\]" "]")
(string/replace #"\\\(" "(")
(string/replace #"\\\)" ")")
(string/replace #"\\#" "#")
(string/replace #"\\\+" "+")
(string/replace #"\\-" "-")
(string/replace #"\\\." ".")
(string/replace #"\\!" "!")
(string/replace #"\\\^" "^")))
state])
(defn open-html-tags [open? token-seq]
(= :open (reduce (fn [state token]
(case token
\< :open
\> :closed
state))
(if open? :open :closed)
token-seq)))
(defn make-separator
"Return a transformer to
- find all the chunks of the string delimited by the `separator',
- wrap the output with the `open' and `close' markers, and
- apply the `transformer' to the text inside the chunk."
([separator open close]
(make-separator separator open close identity))
([separator open close transformer]
(let [separator (seq separator)] ;; allow char seq or string
(fn [text state]
(if (:code state)
[text state]
(loop [out []
buf []
tokens (partition-by (partial = (first separator)) (seq text))
cur-state (assoc state :found-token false :in-tag? false)]
(cond
(empty? tokens)
[(string/join (into (if (:found-token cur-state) (into out separator) out) buf))
(dissoc cur-state :found-token)]
(:found-token cur-state)
(if (= (first tokens) separator)
(let [[new-buf new-state]
(if (identical? transformer identity)
;; Skip the buf->string->buf conversions in the common
;; case.
[buf cur-state]
(let [[s new-state] (transformer (string/join buf) cur-state)]
[(seq s) new-state]))]
(recur (vec (concat out (seq open) new-buf (seq close)))
[]
(rest tokens)
(assoc new-state :found-token false)))
(recur out
(into buf (first tokens))
(rest tokens)
cur-state))
(and (= (first tokens) separator) (not (:in-tag? cur-state)))
(recur out buf (rest tokens) (assoc cur-state :found-token true))
:default
(recur (into out (first tokens)) buf (rest tokens) (assoc cur-state :in-tag? (open-html-tags (:in-tag? cur-state) (first tokens)))))))))))
(defn escape-code-transformer [text state]
[(escape-code text) state])
;; Not used any more internally; kept around just in case third party code
;; depends on this.
(defn separator [escape? text open close separator state]
((make-separator separator open close (if escape? escape-code-transformer identity))
text state))
(def strong (make-separator "**" "<strong>" "</strong>"))
(def bold-italic (make-separator "***" "<b><i>" "</i></b>"))
(def bold (make-separator "__" "<b>" "</b>"))
(def em (make-separator "*" "<em>" "</em>"))
(def italics (make-separator "_" "<i>" "</i>"))
(def strikethrough (make-separator "~~" "<del>" "</del>"))
(def inline-code (make-separator "`" "<code>" "</code>" escape-code-transformer))
(defn inhibit [text state]
(if *inhibit-separator*
((make-separator *inhibit-separator* "" "" freeze-string)
text state)
[text state]))
(defn escape-inhibit-separator [text state]
[(if *inhibit-separator*
(string/replace text
(string/join (concat *inhibit-separator* *inhibit-separator*))
(string/join *inhibit-separator*))
text)
state])
(defn heading-text [text]
(-> (clojure.string/replace text #"^([ ]+)?[#]+" "")
(clojure.string/replace #"[#]+$" "")
string/trim))
(defn heading-level [text]
(let [num-hashes (count (filter #(not= \space %) (take-while #(or (= \# %) (= \space %)) (seq text))))]
(when (pos? num-hashes) num-hashes)))
(defn make-heading [text heading-anchors]
(when-let [heading (heading-level text)]
(let [text (heading-text text)]
;; We do not need to process the id string, HTML5 ids can contain anything except the space character.
;; (https://www.w3.org/TR/html5/dom.html#the-id-attribute)
(str "<h" heading (when heading-anchors (str " id=\"" (-> text string/lower-case (string/replace " " "_")) "\"")) ">"
text "</h" heading ">"))))
(defn dashes [text state]
[(if (or (:code state) (:codeblock state))
text
(-> text
(string/replace #"\-\-\-" "—")
(string/replace #"\-\-" "–")
(string/replace #"<code>.*</code>"
(fn [s](-> s
(string/replace #"—" "---")
(string/replace #"–" "--"))))))
state])