/src/library/slix/ced/doclib.clj
Clojure | 363 lines | 286 code | 59 blank | 18 comment | 1 complexity | 1073ed40548e0bfb2cdda7ca769d9c59 MD5 | raw file
Possible License(s): EPL-1.0, LGPL-3.0
1;; %! Copyright (C) 2011 Kei Suzuki All rights reserved. !% 2;; 3;; This file is part of Sevenri, a Clojure environment ("This Software"). 4;; 5;; The use and distribution terms for this software are covered by the Eclipse 6;; Public License version 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 7;; which can be found in the COPYING at the root of this distribution. 8;; By using this software in any fashion, you are agreeing to be bound by the 9;; terms of this license. 10;; You must not remove this notice, or any other, from this software. 11 12(ns library.slix.ced.doclib 13 (:use [sevenri log]) 14 (:import (javax.swing.text Segment))) 15 16;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 17 18(def *dcntxt* nil) 19(def *txtseg* nil) 20 21(def *open-close-pairs* {\( [\( \)] 22 \{ [\{ \}] 23 \[ [\[ \]] 24 \) [\) \(] 25 \} [\} \{] 26 \] [\] \[]}) 27 28(def *open-close-pairs-s* {"(" ["(" ")"] 29 "{" ["{" "}"] 30 "[" ["[" "]"] 31 ")" [")" "("] 32 "}" ["}" "{"] 33 "]" ["]" "["]}) 34 35;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 36 37(defn create-doc-context 38 [ced] 39 (let [doc (.getDocument ced) 40 doc-elm (.getDefaultRootElement doc)] 41 {:ced ced 42 :doc doc 43 :pos (.getCaretPosition ced) 44 :min-pos 0 45 :max-pos (dec (.getLength doc)) 46 :doc-elm doc-elm 47 :doc-ect (.getElementCount doc-elm)})) 48 49(defmacro setup-doc-context 50 [ced dcntxt & body] 51 `(binding [~'*dcntxt* (merge (create-doc-context ~ced) ~dcntxt)] 52 ~@body)) 53 54(defmacro get-doc-context 55 ([] 56 `~'*dcntxt*) 57 ([kwd] 58 `(~kwd ~'*dcntxt*))) 59 60(defmacro update-doc-context 61 [dcntxt & body] 62 `(binding [~'*dcntxt* (merge (get-doc-context) ~dcntxt)] 63 ~@body)) 64 65(defmacro do-assert 66 [x] 67 ;;`(#_(assert ~x))) 68 `(assert ~x)) 69 70;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 71 72(defmacro partial-segment 73 ([] 74 `(.setPartialReturn ~'*txtseg* true)) 75 ([seg] 76 `(.setPartialReturn ~seg true))) 77 78(defmacro get-partial-txtseg 79 [beg len] 80 `(let [seg# (Segment.)] 81 (partial-segment seg#) 82 (.getText (get-doc-context :doc) ~beg ~len seg#) 83 seg#)) 84 85(defmacro exact-segment 86 ([] 87 `(.setPartialReturn ~'*txtseg* false)) 88 ([seg] 89 `(.setPartialReturn ~seg false))) 90 91(defmacro get-exact-txtseg 92 [beg len] 93 `(let [seg# (Segment.)] 94 (exact-segment seg#) 95 (.getText (get-doc-context :doc) ~beg ~len seg#) 96 seg#)) 97 98(defmacro get-txtseg-begin-end 99 ([] 100 `(let [seg# ~'*txtseg*] 101 [(.getBeginIndex seg#) (.getEndIndex seg#)])) 102 ([seg] 103 `[(.getBeginIndex ~seg) (.getEndIndex ~seg)])) 104 105(defmacro get-txtseg-begin-len 106 ([] 107 `(let [seg# ~'*txtseg*] 108 [(.getBeginIndex seg#) (.length seg#)])) 109 ([seg] 110 `[(.getBeginIndex ~seg) (.length ~seg)])) 111 112(defn get-txtseg 113 [beg len] 114 (let [seg (get-partial-txtseg beg len) 115 [_ slen] (get-txtseg-begin-len seg)] 116 (if (= len slen) 117 seg 118 (let [seg (get-exact-txtseg beg len)] 119 (do-assert (= len (.length seg))) 120 #_(lg "exact seg for beg:" beg "len:" len) 121 seg)))) 122 123(defmacro setup-txt-segment 124 [beg len & body] 125 `(binding [~'*txtseg* (get-txtseg ~beg ~len)] 126 ~@body)) 127 128(defmacro txtseg-char-at 129 ([off] 130 `(.charAt ~'*txtseg* ~off)) 131 ([seg off] 132 `(.carAt ~seg ~off))) 133 134;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 135 136(defmacro str-at 137 ([pos] 138 `(.getText (get-doc-context :doc) ~pos 1)) 139 ([pos len] 140 `(.getText (get-doc-context :doc) ~pos ~len))) 141 142(defmacro line-index 143 [pos] 144 `(.getElementIndex (get-doc-context :doc-elm) ~pos)) 145 146(defmacro line-index-to-start-pos 147 [lindex] 148 `(.getStartOffset (.getElement (get-doc-context :doc-elm) ~lindex))) 149 150(defmacro line-index-to-end-pos 151 [lindex] 152 `(.getEndOffset (.getElement (get-doc-context :doc-elm) ~lindex))) 153 154(defmacro start-of-line 155 [pos] 156 `(.getStartOffset (.getParagraphElement (get-doc-context :doc) ~pos))) 157 158(defmacro end-of-line 159 [pos] 160 `(dec (.getEndOffset (.getParagraphElement (get-doc-context :doc) ~pos)))) 161 162(defmacro start-and-end-line 163 [pos] 164 `(let [e# (.getParagraphElement (get-doc-context :doc) ~pos)] 165 [(.getStartOffset e#) (.getEndOffset e#)])) 166 167(defmacro start-and-len-line 168 [pos] 169 `(let [e# (.getParagraphElement (get-doc-context :doc) ~pos) 170 s# (.getStartOffset e#)] 171 [s# (- (.getEndOffset e#) s#)])) 172 173(defmacro pos-to-col 174 [pos] 175 `(- ~pos (start-of-line ~pos))) 176 177(defn start-of-prev-line 178 [pos] 179 (let [doc-elm (get-doc-context :doc-elm) 180 idx (.getElementIndex doc-elm pos)] 181 (when (< (get-doc-context :min-pos) idx) 182 (.getStartOffset (.getElement doc-elm (dec idx)))))) 183 184(defn end-of-prev-line 185 [pos] 186 (let [doc-elm (get-doc-context :doc-elm) 187 idx (.getElementIndex doc-elm pos)] 188 (when (< (get-doc-context :min-pos) idx) 189 (dec (.getEndOffset (.getElement doc-elm (dec idx))))))) 190 191(defmacro newline? 192 [c] 193 `(= ~c \newline)) 194 195(defmacro newline-s? 196 [s] 197 `(= ~s "\n")) 198 199(defmacro space? 200 [c] 201 `(or (= ~c \space) (= ~c \tab) (= ~c \newline))) 202 203(defmacro space-s? 204 [s] 205 `(or (= ~s " ") (= ~s "\t") (= ~s "\n"))) 206 207(defmacro escape? 208 [c] 209 `(= ~c \\)) 210 211(defmacro escape-s? 212 [s] 213 `(= ~s "\\")) 214 215(defmacro comment? 216 [c] 217 `(= ~c \;)) 218 219(defmacro comment-s? 220 [s] 221 `(= ~s ";")) 222 223(defmacro dquote? 224 [c] 225 `(= ~c \")) 226 227(defmacro dquote-s? 228 [s] 229 `(= ~s "\"")) 230 231(defmacro opening? 232 [c] 233 `(or (= ~c \() (= ~c \{) (= ~c \[))) 234 235(defmacro opening-s? 236 [s] 237 `(or (= ~s "(") (= ~s "{") (= ~s "["))) 238 239(defmacro closing? 240 [c] 241 `(or (= ~c \]) (= ~c \}) (= ~c \)))) 242 243(defmacro closing-s? 244 [s] 245 `(or (= ~s "]") (= ~s "}") (= ~s ")"))) 246 247(defmacro opening-or-closing? 248 [c] 249 `(get *open-close-pairs* ~c)) 250 251(defmacro opening-or-closing-s? 252 [s] 253 `(get *open-close-pairs-s* ~s)) 254 255(defmacro matching-paren-of 256 [c] 257 `(second (get *open-close-pairs* ~c))) 258 259(defmacro matching-paren-of-s 260 [s] 261 `(second (get *open-close-pairs-s* ~s))) 262 263;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 264 265(defn first-char 266 "Returns [pos beg seg] or nil" 267 ([pos] 268 (let [[s l] (start-and-len-line pos)] 269 (first-char (get-txtseg s l) s 0 l))) 270 ([seg beg off len] 271 (when (< off len) 272 (if (space? (.charAt seg off)) 273 (recur seg beg (inc off) len) 274 [(+ beg off) beg seg])))) 275 276(defn last-char 277 "Returns [pos beg seg first] or nil" 278 [pos] 279 (when-let [a (first-char pos)] 280 (let [[first beg seg] a 281 len (.length seg)] 282 (loop [lof (- first beg) 283 off lof] 284 (if (= off len) 285 [(+ beg lof) beg seg first] 286 (recur (if (space? (.charAt seg off)) lof off) (inc off))))))) 287 288(defn last-code-char 289 "Returns [pos beg seg first] or nil" 290 [pos] 291 (when-let [a (first-char pos)] 292 (let [[first beg seg] a 293 len (.length seg)] 294 (loop [lof nil 295 off (- first beg) 296 lc 0 297 ins? false] 298 (if (= off len) 299 (when lof 300 [(+ beg lof) beg seg first]) 301 (let [c (.charAt seg off)] 302 (if ins? 303 (if (dquote? c) 304 (recur off (inc off) c (if (escape? lc) true false)) 305 (recur off (inc off) c true)) 306 (if (and (comment? c) 307 (or (zero? off) 308 (and (pos? off) (not (escape? (.charAt seg (dec off))))))) 309 (when lof 310 [(+ beg lof) beg seg first]) 311 (if (dquote? c) 312 (recur off (inc off) c (if (escape? lc) false true)) 313 (recur (if (space? c) lof off) (inc off) c false)))))))))) 314 315;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 316 317(defn top-level-form 318 "Return pos or nil. All top level forms should start at the first column 319 after a blank line, except at the beginning of the document." 320 [pos] 321 (letfn [(abl [p] 322 (if (= p (get-doc-context :min-pos)) 323 p 324 (when-not (last-code-char (dec p)) 325 p))) 326 (tlf [p l] 327 (let [s (str-at p)] 328 (if (= s "(") 329 (abl p) 330 (when (and (= s "#") 331 (re-matches #"^(#_\s*)?\(.*\n$" (str-at p l))) 332 (abl p)))))] 333 (if-let [p (apply tlf (start-and-len-line pos))] 334 p 335 (loop [pos (start-of-prev-line pos)] 336 (when pos 337 (if-let [p (apply tlf (start-and-len-line pos))] 338 p 339 (recur (start-of-prev-line pos)))))))) 340 341;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 342 343(defn fetch-symbol 344 ([ced] 345 (setup-doc-context ced nil 346 (let [pos (get-doc-context :pos) 347 [s l] (start-and-len-line pos) 348 off (- pos s)] 349 (setup-txt-segment s l 350 (if (space? (txtseg-char-at off)) 351 (when (pos? off) 352 (when-not (space? (txtseg-char-at (dec off))) 353 (fetch-symbol ced s l (dec off)))) 354 (fetch-symbol ced s l off)))))) 355 ([ced start len off] 356 (loop [off off] 357 (if (and (pos? off) 358 (not (space? (txtseg-char-at off)))) 359 (recur (dec off)) 360 (when-let [match (re-matches #"[^\w\*\+\!\-\_\?\.]*([\w\*\+\!\-\_\?\.\$]+).*\n$" 361 (.toString (.subSequence *txtseg* off len)))] 362 #_(lg "fetched symbol:" (second match)) 363 (second match))))))