/src/sevenri/slix.clj
Clojure | 1282 lines | 1042 code | 137 blank | 103 comment | 5 complexity | 55a140e613dfcc3e2e03118c7adc2592 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;; slix - Sevenri library complex 13 14(ns sevenri.slix 15 (:use [sevenri config core defs event log jvm os refs ui utils]) 16 (:import (java.awt.event KeyAdapter KeyEvent) 17 (java.beans ExceptionListener XMLEncoder XMLDecoder) 18 (java.io BufferedOutputStream BufferedInputStream 19 File FileFilter FileInputStream FileOutputStream 20 InputStreamReader PushbackReader) 21 (java.net URL URLClassLoader) 22 (javax.swing JFrame))) 23 24;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 25 26(def *slix* nil) 27 28;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 29 30(defmacro slix-fn 31 [name] 32 (let [fn-name# (symbol (str 'slix- name)) 33 slix-keyword# (keyword name)] 34 `(defn ~fn-name# 35 ([] (~slix-keyword# ~'*slix*)) 36 ([~'slix] (~slix-keyword# ~'slix))))) 37 38;; :id - instance id 39(slix-fn id) 40;; :sn - slix name 41(slix-fn sn) 42;; :name - slix instance name 43(slix-fn name) 44;; :cl - per-slix class loader 45(slix-fn cl) 46;; :context - {:prop (ref {})}, plus {:app-context app-context} optionally 47(slix-fn context) 48;; :frame - associated JFrame 49(slix-fn frame) 50;; :args - arguments 51(slix-fn args) 52 53(defn is-slix? 54 [object] 55 (and (map? object) 56 (every? identity [(slix-id object) (slix-sn object) (slix-name object)]))) 57 58;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 59 60(defn create-slix-context 61 ([] 62 {:prop (ref {})}) 63 ([app-context] 64 {:prop (ref {}) :app-context app-context})) 65 66(defn put-slix-prop 67 ([key val] 68 (put-slix-prop *slix* key val)) 69 ([slix key val] 70 (let [old-prop (:prop (slix-context slix)) 71 new-prop (assoc @old-prop key val)] 72 (dosync (ref-set old-prop new-prop)) 73 new-prop)) 74 ([slix key val & kvs] 75 (let [new-prop (put-slix-prop slix key val)] 76 (if (seq kvs) 77 (recur slix (first kvs) (second kvs) (nnext kvs)) 78 new-prop)))) 79 80(defn get-slix-prop 81 "Returns the value mapped to key of the default or given slix property, 82 or not-found or nil if key not present." 83 ([key] 84 (get-slix-prop *slix* key nil)) 85 ([slix key] 86 (get-slix-prop slix key nil)) 87 ([slix key not-found] 88 (get (deref (:prop (slix-context slix))) key not-found))) 89 90(defn remove-slix-prop 91 ([key] 92 (remove-slix-prop *slix* key)) 93 ([slix key] 94 (let [old-prop (:prop (slix-context slix)) 95 new-prop (dissoc @old-prop key)] 96 (dosync (ref-set old-prop new-prop)) 97 new-prop)) 98 ([slix key & ks] 99 (let [new-prop (remove-slix-prop slix key)] 100 (if (seq ks) 101 (recur slix (first ks) (next ks)) 102 new-prop)))) 103 104(defn clear-slix-prop 105 ([] 106 (clear-slix-prop *slix*)) 107 ([slix] 108 (dosync (ref-set (:prop (slix-context slix)) {})))) 109 110;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 111 112(defn get-xref-slix 113 [] 114 @*xref-slix*) 115 116(defn get-xref-key 117 [] 118 @*xref-key*) 119 120(defn get-xref-val 121 [] 122 @*xref-val*) 123 124(defmulti xref-with 125 (fn [object] 126 (cond 127 (is-slix? object) :slix 128 (keyword? object) :key 129 :else :val))) 130 131(defmethod xref-with :slix 132 [slix] 133 (get (get-xref-slix) slix)) 134 135(defmethod xref-with :key 136 [key] 137 (key (get-xref-key))) 138 139(defmethod xref-with :val 140 [val] 141 (get (get-xref-val) val)) 142 143(defn remove-from-xref 144 ([slix] 145 (when (is-slix? slix) 146 (doseq [[key _] (xref-with slix)] 147 (remove-from-xref slix key)))) 148 ([slix key] 149 (when (and (is-slix? slix) (keyword? key)) 150 (dosync 151 (let [old-ovs (xref-with key)] 152 (doseq [[_ val] (filter (fn [[o v]] (identical? o slix)) old-ovs)] 153 (let [old-oks (xref-with val) 154 new-oks (reduce (fn [m [o k]] (if (identical? o slix) 155 m 156 (assoc m o k))) 157 {} old-oks)] 158 (ref-set *xref-val* (if (empty? new-oks) 159 (dissoc (get-xref-val) val) 160 (assoc (get-xref-val) val new-oks))))) 161 (let [new-ovs (reduce (fn [m [o v]] (if (identical? o slix) 162 m 163 (assoc m o v))) 164 {} old-ovs)] 165 (ref-set *xref-key* (if (empty? new-ovs) 166 (dissoc (get-xref-key) key) 167 (assoc (get-xref-key) key new-ovs)))) 168 (let [new-kvs (reduce (fn [m [k v]] (if (= k key) 169 m 170 (assoc m k v))) 171 {} (xref-with slix))] 172 (ref-set *xref-slix* (if (empty? new-kvs) 173 (dissoc (get-xref-slix) slix) 174 (assoc (get-xref-slix) slix new-kvs))))))))) 175 176(defn add-to-xref 177 [slix key val] 178 (when (and (is-slix? slix) 179 (declare get-slix) 180 (identical? slix (get-slix slix)) 181 (keyword? key)) 182 (remove-from-xref slix key) 183 (dosync 184 (ref-set *xref-slix* (assoc (get-xref-slix) 185 slix 186 (assoc (xref-with slix) key val))) 187 (ref-set *xref-key* (assoc (get-xref-key) 188 key 189 (assoc (xref-with key) slix val))) 190 (ref-set *xref-val* (assoc (get-xref-val) 191 val 192 (assoc (xref-with val) slix key)))))) 193 194;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 195 196(defn get-slixes 197 ([] 198 (vals @*slixes*)) 199 ([sn] 200 (when (or (symbol? sn) (string? sn)) 201 (seq (filter #(= (symbol sn) (slix-sn %)) (get-slixes)))))) 202 203(defmulti get-slix 204 (fn [object] 205 (cond 206 (or (string? object) (symbol? object)) :name 207 (is-slix? object) :slix 208 (instance? JFrame object) :frame 209 :else :default))) 210 211(defmethod get-slix :name 212 [object] 213 (get-prop *slixes* (str object))) 214 215(defmethod get-slix :slix 216 [object] 217 (when (identical? object (get-prop *slixes* (str (slix-name object)))) 218 object)) 219 220(defmethod get-slix :frame 221 [object] 222 (first (filter #(identical? object (slix-frame %)) (get-slixes)))) 223 224(defmethod get-slix :default 225 [object] 226 nil) 227 228(defn get-slix-names 229 [] 230 (keys @*slixes*)) 231 232(defn add-to-slix-sn-cache 233 [sn] 234 (reset! *slix-sn-cache* (conj @*slix-sn-cache* sn))) 235 236(defn remove-from-slix-sn-cache 237 [sn] 238 (reset! *slix-sn-cache* (disj @*slix-sn-cache* sn))) 239 240(defn get-all-slix-sn 241 [] 242 @*slix-sn-cache*) 243 244(defn get-slix-fqns 245 ([sn] 246 (symbol (str (get-default :tln :slix) \. sn))) 247 ([sn pfx] 248 (get-slix-fqns (str sn \. pfx))) 249 ([sn pfx & pfxs] 250 (apply get-slix-fqns sn (str pfx \. (first pfxs)) (rest pfxs)))) 251 252(defn get-slix-sn-meta 253 [sn] 254 (when-let [sns (find-ns (get-slix-fqns sn))] 255 (meta sns))) 256 257(defn get-library-slix-fqns 258 [sn & pfxs] 259 (symbol (str (get-default :tln :library) \. (apply get-slix-fqns sn pfxs)))) 260 261(defn get-slix-fn 262 [sn fnsym] 263 (ns-resolve (get-slix-fqns sn) fnsym)) 264 265(defn get-src-slix-dir 266 ([] 267 (get-dir (get-src-dir) (get-default :src :slix :dir-name))) 268 ([sn & pfxs] 269 (get-dir (get-src-dir) (nssym2path (apply get-slix-fqns sn pfxs))))) 270 271(defmacro get-slix-dir 272 ([] 273 `(get-src-slix-dir)) 274 ([sn & pfxs] 275 `(get-src-slix-dir ~sn ~@pfxs))) 276 277(defn get-src-slix-file 278 [sn & pfxs] 279 (File. (get-src-dir) (str (nssym2path (apply get-slix-fqns sn pfxs)) ".clj"))) 280 281(defmacro get-slix-file 282 [sn & pfxs] 283 `(get-src-slix-file ~sn ~@pfxs)) 284 285(defn get-src-library-slix-dir 286 ([] 287 (get-src-library-dir (get-default :src :library :slix :dir-name))) 288 ([sn & pfxs] 289 (get-dir (get-src-library-dir) (nssym2path (apply get-slix-fqns sn pfxs))))) 290 291(defmacro get-library-slix-dir 292 ([] 293 `(get-src-library-slix-dir)) 294 ([sn & pfxs] 295 `(get-src-library-slix-dir ~sn ~@pfxs))) 296 297(defn get-src-library-slix-file 298 [sn name & pfxs] 299 (if (seq pfxs) 300 (File. (get-src-library-dir (nssym2path (apply get-slix-fqns sn name (butlast pfxs)))) 301 (str (nssym2path (last pfxs)) ".clj")) 302 (File. (get-src-library-dir (nssym2path (get-slix-fqns sn))) 303 (str (nssym2path name) ".clj")))) 304 305(defmacro get-library-slix-file 306 [sn name & pfxs] 307 `(get-src-library-slix-file ~sn ~name ~@pfxs)) 308 309(defn get-sid-classes-slix-dir 310 [sn & pfxs] 311 (get-dir (get-sid-classes-dir) (nssym2path (apply get-slix-fqns sn pfxs)))) 312 313(defn get-sid-slix-dir 314 ([] 315 (get-sid-dir (get-default :sid :slix :dir-name))) 316 ([sn & pfxs] 317 (get-dir (get-sid-root-dir) (apply get-slix-fqns sn pfxs)))) 318 319(defn get-sid-slix-file 320 [sn & pfxs] 321 (File. (get-sid-root-dir) (str (nssym2path (apply get-slix-fqns sn pfxs)) ".clj"))) 322 323(defn get-sid-slix-save-dir 324 [sn] 325 (get-sid-slix-dir sn (get-default :sid :slix :save :dir-name))) 326 327(defn get-sid-slix-name-dir 328 ([slix] 329 (get-sid-slix-name-dir (slix-sn slix) (slix-name slix))) 330 ([sn name] 331 (get-dir (get-sid-slix-save-dir sn) name))) 332 333(defn get-slix-startup-file 334 [] 335 (File. (get-sid-slix-dir) (str (get-default :sid :slix :startup :file-name)))) 336 337;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 338 339(defn find-all-slix-sn 340 "Parse clj files (except scratch) and return slix namespaces without 341 'slix.' prefix." 342 [] 343 (let [slxdn (get-default :src :slix :dir-name) 344 slxdt (str slxdn \.) 345 rpclj (re-pattern (str "/" slxdn "/.*\\.clj$")) 346 rpsct (re-pattern (str ".*/" (get-default :src :slix :scratch-file-name) "$")) 347 cljfs (filter #(not (re-matches rpsct (str %))) 348 (find-files #(re-find rpclj (str %)) (get-slix-dir)))] 349 (filter identity 350 (map (fn [f] 351 (with-open [rdr (PushbackReader. (InputStreamReader. (FileInputStream. f) "UTF-8"))] 352 (when-let [obj (try 353 (read rdr) 354 (catch Exception e 355 (log-severe "find-all-slix-sn failed:" f) 356 nil))] 357 (let [sym1 (first obj) 358 sym2 (second obj) 359 str2 (str sym2) 360 sdln (count slxdt)] ;; 'slix.' 361 (when (and (= 'ns sym1) 362 (< sdln (count str2)) 363 (= slxdt (subs str2 0 sdln)) 364 (true? (:slix (meta sym2)))) 365 (with-meta (symbol (subs str2 sdln)) (meta sym2))))))) 366 cljfs)))) 367 368(defn get-sid-slix-frame-file 369 ([] 370 (when *slix* 371 (get-sid-slix-frame-file *slix*))) 372 ([slix] 373 (get-sid-slix-frame-file (slix-sn slix) (slix-name slix))) 374 ([sn name] 375 (get-sid-slix-frame-file sn name (get-default :sid :slix :save :frame-file-name))) 376 ([sn name frame-file-name] 377 (File. (get-sid-slix-name-dir sn name) (str frame-file-name)))) 378 379(defn get-sid-slix-state-file 380 ([] 381 (when *slix* 382 (get-sid-slix-state-file *slix*))) 383 ([slix] 384 (get-sid-slix-state-file (slix-sn slix) (slix-name slix))) 385 ([sn name] 386 (get-sid-slix-state-file sn name (get-default :sid :slix :save :state-file-name))) 387 ([sn name state-file-name] 388 (File. (get-sid-slix-name-dir sn name) (str state-file-name)))) 389 390(defn get-slix-file-bundle 391 "Return [frame-file state-file] or nil" 392 ([] 393 (when *slix* 394 (get-slix-file-bundle *slix*))) 395 ([slix] 396 (get-slix-file-bundle (slix-sn slix) (slix-name slix))) 397 ([sn name] 398 [(get-sid-slix-frame-file sn name) (get-sid-slix-state-file sn name)])) 399 400(defn is-slix-saved 401 "Return [frame-file state-file/nil] or nil." 402 ([] 403 (when *slix* 404 (is-slix-saved *slix*))) 405 ([slix] 406 (is-slix-saved (slix-sn slix) (slix-name slix))) 407 ([sn name] 408 (let [[f s] (get-slix-file-bundle sn name)] 409 (when (.exists f) 410 [f (when (.exists s) s)])))) 411 412(defn get-saved-slix-names 413 "Return a seq of names or nil" 414 [sn] 415 (when-let [od (get-sid-slix-save-dir sn)] 416 (let [ff (proxy [FileFilter] [] 417 (accept [f] (.isDirectory f)))] 418 (seq (map #(.getName %) (.listFiles od ff)))))) 419 420(defn find-saved-slixes 421 "Return a seq of [sn name [frame-file state-file/nil]] or nil." 422 ([] 423 (let [;; Find any files under sis/slix, convert them in string, and then sort them. 424 afps (sort (map str (find-files #(.isFile %) (get-sid-slix-dir)))) 425 ;; Remove up to sis/slix and go to the next stage. 426 _sv_ (get-default :sid :slix :save :dir-name) 427 rptn (re-pattern (str "^" (get-sid-slix-dir) "/(.*/" _sv_ "/.*)$"))] 428 (find-saved-slixes (filter identity (map #(second (re-find rptn %)) afps)) 429 (str (get-default :sid :slix :save :frame-file-name)) 430 (str (get-default :sid :slix :save :state-file-name))))) 431 ([snfiles ffname sfname] 432 ;; Return a lazy-seq that consumes sn-name-files and return [sn name [f s/nil]]s. 433 (lazy-seq 434 (when (seq snfiles) 435 (let [sn_name (.getParentFile (File. (first snfiles))) ;; sn/_save_/name 436 sn (.getParent (.getParentFile sn_name)) 437 nm (.getName sn_name) 438 create-item (fn [fs] 439 (let [fsv (vec (map #(File. (File. (get-sid-slix-dir) (str sn_name)) %) fs))] 440 [(symbol (path2nssym sn)) (str nm) (if (< (count fsv) 2) (conj fsv nil) fsv)]))] 441 (loop [snfiles snfiles 442 file-bundle nil] 443 (if (seq snfiles) 444 ;; There are snfiles. 445 (let [snfile (File. (first snfiles)) 446 snfname (.getName snfile)] 447 (if (= sn_name (.getParentFile snfile)) 448 ;; Same sn/_save_/name. Add to file-bundle and loop. 449 (cond 450 (= snfname ffname) (recur (rest snfiles) (cons ffname file-bundle)) 451 (= snfname sfname) (recur (rest snfiles) (if (= (first file-bundle) ffname) 452 (concat (list ffname sfname) (rest file-bundle)) 453 (cons sfname file-bundle))) 454 ;; Currently ignore any files other than frame.xml or state.clj. 455 ;; If we want to list others too, do this: 456 ;; :else (recur (rest snfiles) (concat file-bundle (list snfname)))) 457 :else (recur (rest snfiles) file-bundle)) 458 ;; Different sn/_save_/name. 459 (if (seq file-bundle) 460 ;; There is file-bundle. Construct [sn name [...]] and continue lazy-listing snfiles. 461 (cons (create-item file-bundle) 462 (find-saved-slixes snfiles ffname sfname)) 463 ;; No file-bundle. 464 (find-saved-slixes snfiles ffname sfname)))) 465 ;; No more snfiles. 466 (when (seq file-bundle) 467 (list (create-item file-bundle)))))))))) 468 469;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 470 471(defn get-stdio 472 [] 473 [*in* *out* *err*]) 474 475(defn get-base-class-loader 476 [] 477 *base-class-loader*) 478 479(defn get-slix-jvm-and-jar-paths 480 [sn] 481 (let [pa [(get-slix-dir sn (get-default :src :slix :jvm :dir-name))]] 482 (reduce (fn [a p] (conj a p)) pa (find-files '.jar (first pa))))) 483 484(defn create-slix-class-loader 485 [sn] 486 (let [cps (conj (get-slix-jvm-and-jar-paths sn) (get-sid-classes-dir)) 487 cpn (count cps) 488 urls (make-array URL cpn)] 489 (reduce (fn [a i] (aset a i (.toURL (.toURI (cps i)))) a) urls (range cpn)) 490 (clojure.lang.DynamicClassLoader. (URLClassLoader. urls (get-base-class-loader))))) 491 492(defn load-slix-class 493 [slix fqcn] 494 (.loadClass (slix-cl slix) (str fqcn))) 495 496(defn make-slix-class-instance 497 [slix fqcn] 498 (.newInstance (load-slix-class slix fqcn))) 499 500(defmacro with-slix-context 501 [sn slix-class-loader return-value-when-exception & body] 502 `(let [ct# (Thread/currentThread) 503 ccl# (.getContextClassLoader ct#)] 504 (try 505 (.setContextClassLoader ct# ~slix-class-loader) 506 ~@body 507 (catch Exception e# 508 (log-exception e# (get-slix-fqns ~sn)) 509 ~return-value-when-exception) 510 (finally 511 (.setContextClassLoader ct# ccl#))))) 512 513(defn reload-sn? 514 ([sn] 515 (let [fqns (get-slix-fqns sn)] 516 (require fqns :reload) 517 (if (find-ns fqns) 518 true 519 false))) 520 ([sn cl] 521 (with-slix-context sn cl false 522 (reload-sn? sn)))) 523 524(defn- -aot-compiler 525 [sn aot verbose? cl-dump?] 526 (let [aotf (File. (get-slix-dir sn) (str (nssym2path aot) ".clj"))] 527 (if (.exists aotf) 528 (let [cl (create-slix-class-loader sn)] 529 (with-slix-context sn cl false 530 (when cl-dump? 531 (loop [cl cl] 532 (when cl 533 (println cl) 534 (print-seq (seq (.getURLs cl))) 535 (recur (.getParent cl))))) 536 ;; 537 (let [cp (get-sid-classes-dir) 538 fqaot (get-slix-fqns sn aot)] 539 (binding [*compile-path* (str cp)] 540 (compile fqaot) 541 true)))) 542 (let [s (str "aot-compile?: not found aot file: " aotf)] 543 (when verbose? 544 (log-warning s) 545 (print-warning s)) 546 false)))) 547 548(defn aot-compile? 549 ([sn] 550 (aot-compile? sn 'aot true)) 551 ([sn aot] 552 (aot-compile? sn aot true)) 553 ([sn aot verbose?] 554 (aot-compile? sn aot verbose? false)) 555 ([sn aot verbose? cl-dump?] 556 (let [-aot-compiler-bfn (bound-fn [] (-aot-compiler sn aot verbose? cl-dump?)) 557 ac (future (-aot-compiler-bfn))] 558 @ac))) 559 560(defn invoke-later 561 "Take a body of expressions, post it to the event dispatch thread of the 562 current or specified slix, and return with nil immedidately when wait? 563 is false. The body will be evaluated later in the EDT." 564 ([body] 565 (invoke-later *slix* body)) 566 ([slix body] 567 (invoke-later slix body false)) 568 ([slix body wait?] 569 (binding [*slix* slix] 570 (if-let [app-context (:app-context (slix-context slix))] 571 (invoke-later-in-slix-context slix body wait?) 572 (alt-invoke-later-in-slix-context slix body wait?))) 573 nil)) 574 575(defn invoke-and-wait 576 "Call invoke-later with true for wait?. Return nil." 577 ([body] 578 (invoke-and-wait *slix* body)) 579 ([slix body] 580 (invoke-later slix body true))) 581 582;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 583;;;; load/save slix frame 584;;;; - DONOT CALL THESE FUNCTIONS DIRECTLY. CALL VIA INVOKE-LATER OR 585;;;; INVOKE-AND-WAIT. 586;;;; - These save and load slix frame only. Saving and loading slix instance 587;;;; data should be done by the slix event handlers in response to save/load 588;;;; events. 589;;;; - No need to setup per-slix CL because these are (have to be) called in 590;;;; slix's EDT where per-slix CL is set up. 591;;;; 592;;;; Note: make sure to use the same CL used for reload-sn?, or XMLEncoder 593;;;; would go into infinite recursive calls. 594 595(defn- -load-slix-frame 596 ([slix] 597 (-load-slix-frame (slix-sn slix) (slix-name slix))) 598 ([sn name] 599 (let [[f s] (get-slix-file-bundle sn name)] 600 (when (and (.exists f) (.canRead f)) 601 (with-open [s (BufferedInputStream. (FileInputStream. f)) 602 d (XMLDecoder. s)] 603 (try 604 (.readObject d) 605 (catch Exception e 606 (log-exception e) 607 nil))))))) 608 609(defn- -presave-slix-frame 610 [slix] 611 (let [frame (slix-frame slix) 612 presave-slix-frame-os-value (presave-slix-frame-os frame)] 613 [#(postsave-slix-frame-os frame presave-slix-frame-os-value)])) 614 615(defn- -postsave-slix-frame 616 [postsave-slix-frame-fns] 617 (doseq [pofn postsave-slix-frame-fns] 618 (pofn))) 619 620(defn- -save-slix-frame? 621 [slix log-xml-encoder-errors?] 622 (let [postsave-slix-frame-fns (-presave-slix-frame slix)] 623 (try 624 (with-create-sn-get-dir 625 (let [[f s] (get-slix-file-bundle (slix-sn slix) (slix-name slix))] 626 (when (.exists f) 627 (.delete f)) 628 (with-open [xe (XMLEncoder. (BufferedOutputStream. (FileOutputStream. f)))] 629 (when-not log-xml-encoder-errors? 630 (let [el (proxy [ExceptionListener] [] (exceptionThrown [e]))] 631 (.setExceptionListener xe el))) 632 (.writeObject xe (slix-frame slix)) 633 (.flush xe)) 634 true)) 635 (catch Exception e 636 (log-exception e) 637 false) 638 (finally 639 (-postsave-slix-frame postsave-slix-frame-fns))))) 640 641;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 642 643(defn register-slix 644 ([slix] 645 (register-slix slix (slix-name slix))) 646 ([slix name] 647 (dosync 648 (ref-set *slixes* (assoc @*slixes* (str name) slix))))) 649 650(defn unregister-slix 651 ([slix] 652 (unregister-slix slix (slix-name slix))) 653 ([slix name] 654 (remove-from-xref slix) 655 (dosync 656 (ref-set *slixes* (dissoc @*slixes* (str name)))))) 657 658(defn- -slix-is-opening 659 [name opening?] 660 (dosync 661 (ref-set *opening-slix-names* (if opening? 662 (conj @*opening-slix-names* name) 663 (disj @*opening-slix-names* name))))) 664 665(defn- -is-slix-opening? 666 ([name] 667 (contains? @*opening-slix-names* name)) 668 ([name opening?] 669 (if (contains? @*opening-slix-names* name) 670 true 671 (do 672 (when opening? 673 (-slix-is-opening name true)) 674 false)))) 675 676(defn is-singleton-slix? 677 [object] 678 (let [sn (if (is-slix? object) 679 (slix-sn object) 680 (symbol (str object))) 681 fsn (filter #(= sn %) @*slix-sn-cache*)] 682 (if (seq fsn) 683 (true? (:singleton (get-slix-sn-meta (first fsn)))) 684 false))) 685 686(defn- -create-initial-frame 687 [slix] 688 (let [f (JFrame.) 689 n (slix-name slix)] 690 (doto f 691 (.setLocationByPlatform *set-location-by-platform*) 692 (.setDefaultCloseOperation JFrame/DISPOSE_ON_CLOSE) 693 (.setTitle (str n)) 694 (.setSize (get-default :frame :width) (get-default :frame :height))) 695 f)) 696 697(defn- -abort-open-slix 698 ([slix] 699 (-abort-open-slix slix 700 :sevenri.event/slix-error-open 701 :sevenri.event/reason-exception-occurred)) 702 ([slix eid reason] 703 (-abort-open-slix slix eid reason true)) 704 ([slix eid reason post-event?] 705 (-slix-is-opening (slix-name slix) false) 706 (when (identical? (get-slix (slix-name slix)) slix) 707 (unregister-slix slix)) 708 (when-let [frame (slix-frame slix)] 709 (.dispose frame)) 710 (when-let [app-context (:app-context (slix-context slix))] 711 (dispose-app-context app-context)) 712 (when post-event? 713 (post-event eid slix (if (and (map? reason) (:reason reason)) 714 reason 715 {:reason reason}))) 716 (when (= reason :sevenri.event/reason-singleton-slix) 717 (.toFront (slix-frame (first (get-slixes (slix-sn slix)))))) 718 eid)) 719 720(defmacro -send-event-and-continue-unless 721 [deny-res slix eid send-fn & body] 722 `(let [resps# (~send-fn ~eid ~slix) 723 [res# rsn#] (get-event-response (get resps# (slix-name ~slix)))] 724 (if (= res# :sevenri.event/response-exception-occurred) 725 (-abort-open-slix ~slix) 726 (if (and ~deny-res (= ~deny-res res#)) 727 (-abort-open-slix ~slix :sevenri.event/slix-open-canceled rsn#) 728 (do 729 ~@body))))) 730 731(defn- -open-slix 732 "Open slix synchronously." 733 ([slix io] 734 (binding [*in* (first io) *out* (second io) *err* (last io)] 735 (let [sn (slix-sn slix) 736 name (slix-name slix) 737 oeo-eid :sevenri.event/slix-error-open] 738 (if (or (-is-slix-opening? name true) (get-slix name)) 739 ;; name exists 740 (-abort-open-slix slix oeo-eid :sevenri.event/reason-name-exists) 741 ;; continue opening 742 (if (not (and (contains? (get-all-slix-sn) sn) (reload-sn? sn (slix-cl slix)))) 743 ;; reload-sn failed 744 (-abort-open-slix slix oeo-eid :sevenri.event/reason-reload-sn-failed) 745 ;; continue opening 746 (if (and (is-singleton-slix? slix) (get-slixes sn)) 747 ;; singleton exists 748 (-abort-open-slix slix oeo-eid :sevenri.event/reason-singleton-slix) 749 ;; continue opening 750 (let [saved? (if (is-slix-saved slix) true false)] 751 ;; opening 752 (-send-event-and-continue-unless 753 :sevenri.event/response-donot-open 754 slix :sevenri.event/slix-opening send-creation-event 755 (if saved? 756 ;; load frame 757 (let [frame (atom nil) 758 frame-loader #(reset! frame (-load-slix-frame slix))] 759 (-send-event-and-continue-unless 760 nil ;; cannot deny loading frame for now 761 slix :sevenri.event/slix-frame-loading send-creation-event 762 (invoke-and-wait slix frame-loader) 763 (if @frame 764 (-open-slix slix saved? @frame) 765 ;; load frame failed 766 (let [rsn :sevenri.event/reason-load-frame-failed] 767 (post-creation-event oeo-eid slix rsn) 768 (-abort-open-slix slix oeo-eid rsn false))))) 769 ;; create frame (never fail) 770 (let [frame (atom nil) 771 frame-creator #(reset! frame (-create-initial-frame slix))] 772 (-send-event-and-continue-unless 773 nil ;; cannot deny creating frame for now 774 slix :sevenri.event/slix-frame-creating send-creation-event 775 (invoke-and-wait slix frame-creator) 776 (-open-slix slix saved? @frame)))))))))))) 777 ([slix saved? frame] 778 ;; Install the default listeners. 779 (when-not saved? 780 (doto frame 781 (add-default-window-listener) 782 (add-default-key-listener))) 783 (let [slix (assoc slix :frame frame) 784 eid (if saved? 785 :sevenri.event/slix-frame-loaded 786 :sevenri.event/slix-frame-created)] 787 ;; frame created or loaded 788 (-send-event-and-continue-unless 789 nil ;; ignore any response 790 slix eid send-creation-event 791 (register-slix slix) 792 (-send-event-and-continue-unless 793 nil ;; ditto 794 slix :sevenri.event/slix-opened post-event 795 ;; slix opened, finally. 796 ;; If the frame is newly created, change the default close operation 797 ;; to do nothing and let Sevenri handle the close operation. 798 (when-not saved? 799 (.setDefaultCloseOperation frame JFrame/DO_NOTHING_ON_CLOSE)) 800 (-slix-is-opening (slix-name slix) false) 801 :sevenri.event/slix-opened))))) 802 803(defn- -get-context-and-start-slix-creation 804 ([slix] 805 (if-let [app-context (create-app-context (slix-name slix) (slix-cl slix))] 806 ;; EDT per slix 807 (-get-context-and-start-slix-creation slix (create-slix-context app-context)) 808 ;; sharing the same, main EDT 809 (-get-context-and-start-slix-creation slix (create-slix-context)))) 810 ([slix context] 811 (let [slix (assoc slix :context context)] 812 (future (-open-slix slix (get-stdio)))))) 813 814;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 815 816(def -open-slix-args- nil) 817 818(defn generate-slix-name 819 [sn] 820 (let [Name (apply str (.toUpperCase (str (first (str sn)))) (rest (str sn)))] 821 (if-not (or (-is-slix-opening? Name) (get-slix Name)) 822 Name 823 (loop [X 1] 824 (let [NameX (str Name X)] 825 (if-not (get-slix NameX) 826 NameX 827 (recur (inc X)))))))) 828 829(defn open-slix 830 "Return a future oject that creates a slix instance using slix name sn 831 and notifies open events to it. Instance name is optional." 832 ([sn] 833 (open-slix sn (generate-slix-name sn))) 834 ([sn name] 835 (let [sn (symbol sn) 836 name (str name) 837 cl (create-slix-class-loader sn) 838 slix {:id (gensym 'id) :sn sn :name name :cl cl :args -open-slix-args-}] 839 (-get-context-and-start-slix-creation slix)))) 840 841(defn open-slix-and-wait 842 "Return the dereference to the future object returned from the open-slix 843 call with slix name sn. Instance name is optional." 844 ([sn] 845 (open-slix-and-wait sn (generate-slix-name sn))) 846 ([sn name] 847 (let [opener (open-slix sn name)] 848 @opener))) 849 850(defn open-all-slixes-and-wait 851 ([] 852 (open-all-slixes-and-wait false)) 853 ([startup?] 854 (let [sf (get-slix-startup-file) 855 sns (if (and startup? (.exists sf)) 856 (try 857 (read-string (slurp sf :encoding "UTF-8")) 858 (catch Exception e 859 (log-warning e) 860 nil)) 861 (map (fn [[o n [f s]]] [o n]) (find-saved-slixes)))] 862 (doseq [[sn name] sns] 863 ;; Exclude the slix 'Sevenri' because it's special and is opened 864 ;; at the startup time. 865 (declare is-slix-sevenri?) 866 (when-not (is-slix-sevenri? sn name) 867 (when (is-slix-saved sn name) 868 (open-slix-and-wait sn name))))))) 869 870(defmacro open-slix-with-args 871 "Return a future oject that opens a slix instance using slix name sn 872 and arguments contained in an object args and notifies open events to it. 873 Instance name is optional." 874 ([args sn] 875 `(binding [-open-slix-args- ~args] 876 (open-slix ~sn))) 877 ([args sn name] 878 `(binding [-open-slix-args- ~args] 879 (open-slix ~sn ~name)))) 880 881;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 882 883(defn- -save-slix 884 "Save slix (meaning, frame) synchronously." 885 ([slix io] 886 (-save-slix slix io false)) 887 ([slix io save-on-close?] 888 (binding [*in* (first io) *out* (second io) *err* (last io)] 889 (let [info {:sevenri.event/info-save-on-close save-on-close?}] 890 (clear-saved-dynaclass-listeners slix) 891 (let [resps (send-event :sevenri.event/slix-saving slix info) 892 [res rsn] (get-event-response (get resps (slix-name slix)))] 893 (if (= res :sevenri.event/response-exception-occurred) 894 ;; save failed 895 (let [eid :sevenri.event/slix-error-save] 896 (restore-saved-dynaclass-listeners slix) 897 (post-event eid slix (merge info {:reason :sevenri.event/reason-exception-occurred})) 898 eid) 899 (if (= res :sevenri.event/response-donot-save) 900 ;; save canceled 901 (let [eid :sevenri.event/slix-save-canceled] 902 (post-event eid slix (merge info {:reason rsn})) 903 eid) 904 ;; continue saving 905 (let [saved? (atom false) 906 log? (if (= res ::sevenri.event/response-suppress-xml-encoder-errors) 907 false 908 true)] 909 (invoke-and-wait slix #(reset! saved? (-save-slix-frame? slix log?))) 910 (let [eid (if @saved? 911 :sevenri.event/slix-saved 912 :sevenri.event/slix-error-save)] 913 (restore-saved-dynaclass-listeners slix) 914 (post-event eid slix info) 915 eid))))))))) 916 917(defn save-slix 918 "Return a future object that notifies save events to slix instance 919 specified by object, which can be slix instance or instance name in 920 symbol or string. Return nil when object is invalid." 921 [object] 922 (when-let [slix (get-slix object)] 923 (future (-save-slix slix (get-stdio))))) 924 925(defn save-slix-and-wait 926 "Create a future object that notifies save events to slix instance 927 specified by object, which can be slix instance or instance name in 928 symbol or string, and return the dereference to it. Return nil when 929 object is invalid." 930 [object] 931 (when-let [saver (save-slix object)] 932 @saver)) 933 934(defn save-all-slixes-and-wait 935 "Wait for all slixes saved." 936 [] 937 (doseq [name (get-slix-names)] 938 (save-slix-and-wait name))) 939 940;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 941 942(defn- -close-slix 943 "Close slix synchronously." 944 ([slix io] 945 (-close-slix slix io false)) 946 ([slix io close-on-delete?] 947 (binding [*in* (first io) *out* (second io) *err* (last io)] 948 (let [info {:sevenri.event/info-close-on-delete close-on-delete?} 949 lge (get-last-global-event) 950 [can-close? reason] (if (or close-on-delete? ;; cannot deny closing with these conditions 951 (= lge :sevenri.event/slixes-closing) 952 (= lge :sevenri.event/sevenri-quitting)) 953 (let [info (cond 954 (= lge :sevenri.event/slixes-closing) {:sevenri.event/info-close-on-close-slixes true} 955 (= lge :sevenri.event/sevenri-quitting) {:sevenri.event/info-close-on-quit-sevenri true} 956 :else info)] 957 (send-event :sevenri.event/slix-closing slix info) 958 [true nil]) 959 (let [resps (send-event :sevenri.event/slix-closing slix info) 960 [res rsn] (get-event-response (get resps (slix-name slix)))] 961 (if (= res :sevenri.event/response-exception-occurred) 962 [false :sevenri.event/reason-exception-occurred] 963 (if (= res :sevenri.event/response-donot-close) 964 [false rsn] 965 [true nil]))))] 966 (if-not can-close? 967 ;; close canceled or close error by exception 968 (let [eid (if (= reason :sevenri.event/reason-exception-occurred) 969 :sevenri.event/slix-error-close 970 :sevenri.event/slix-close-canceled)] 971 (post-event eid slix (merge info {:reason reason})) 972 eid) 973 ;; continue closing 974 (let [so (-save-slix slix io true)] 975 (if (and (not close-on-delete?) ;; ignore close error when deleting 976 (= so :sevenri.event/slix-error-save)) 977 ;; close error 978 (let [eid :sevenri.event/slix-error-close 979 rsn :sevenri.event/reason-save-error-on-closing] 980 (post-event eid slix (merge info {:reason rsn})) 981 eid) 982 ;; closed 983 (let [eid :sevenri.event/slix-closed] 984 ;; Unregister the slix. Then dispose its frame and 985 ;; optionally its app-context. 986 (unregister-slix slix) 987 (.dispose (slix-frame slix)) 988 (when-let [ac (:app-context (slix-context slix))] 989 (dispose-app-context ac)) 990 ;; 991 (post-event-to slix eid slix info) 992 (post-event eid slix info) 993 eid)))))))) 994 995(defn close-slix 996 "Return a future object that notifies close events to slix instance 997 specified by object, which can be slix instance or instance name in 998 symbol or string. Return nil when object is invalid." 999 [object] 1000 (when-let [slix (get-slix object)] 1001 (future (-close-slix slix (get-stdio))))) 1002 1003(defn close-slix-and-wait 1004 "Create a future object that notifies close events to slix instance 1005 specified by object, which can be slix instance or instance name in 1006 symbol or string, and return the dereference to it. Return nil when 1007 object is invalid." 1008 [object] 1009 (when-let [closer (close-slix object)] 1010 @closer)) 1011 1012(defn close-all-slixes-and-wait 1013 "Wait for all slixes closed." 1014 ([] 1015 (close-all-slixes-and-wait false)) 1016 ([shutdown?] 1017 ;; Exclude the slix 'Sevenri' because it's special and is closed at 1018 ;; the shutdown time. 1019 (let [exclude-fn (fn [col] (filter #(not (is-slix-sevenri? %)) col)) 1020 all-slixes (exclude-fn (get-slixes)) 1021 vis-slixes (exclude-fn (map #(get-slix %) (get-z-ordered-frames))) 1022 unv-slixes (clojure.set/difference (apply hash-set all-slixes) 1023 (apply hash-set vis-slixes))] 1024 (doseq [slix all-slixes] 1025 (close-slix-and-wait slix)) 1026 (when shutdown? 1027 (let [sns (map #(vector (slix-sn %) (slix-name %)) 1028 (concat unv-slixes (reverse vis-slixes))) 1029 ssf (get-slix-startup-file)] 1030 (when (.exists ssf) 1031 (.delete ssf)) 1032 (spit ssf (print-str sns) :encoding "UTF-8")))))) 1033 1034;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1035 1036(defn- -delete-slix 1037 [sn name io] 1038 (binding [*in* (first io) *out* (second io) *err* (last io)] 1039 (let [info {:sn sn :name name} 1040 eid :sevenri.event/slix-deleting] 1041 ;; deleting 1042 (when-let [slix (get-slix name)] 1043 ;; Close the running slix forcibly. 1044 (send-event eid slix) 1045 (-close-slix slix io true)) 1046 (send-event eid nil info) 1047 (if (trash-dir? (get-sid-slix-name-dir sn name) (get-sid-slix-dir)) 1048 ;; deleted 1049 (let [eid :sevenri.event/slix-deleted] 1050 (post-event eid nil info) 1051 eid) 1052 ;; delete failed 1053 (let [eid :sevenri.event/slixe-error-delete 1054 rsn :sevenri.event/reason-trash-files-failed] 1055 (post-event eid nil (merge info {:reason rsn})) 1056 eid))))) 1057 1058(defn delete-slix 1059 "Return a future object that notifies delete events to slix instance 1060 specified by object, which can be slix instance or instance name in 1061 symbol or string. Return nil when object is invalid." 1062 ([object] 1063 (when-let [slix (get-slix object)] 1064 (delete-slix (slix-sn slix) (slix-name slix)))) 1065 ([sn name] 1066 (future (-delete-slix (symbol sn) name (get-stdio))))) 1067 1068(defn delete-slix-and-wait 1069 "Create a future object that notifies delete events to slix instance 1070 specified by object, which can be slix instance or instance name in 1071 symbol or string, and return the dereference to it. Return nil when 1072 object is invalid." 1073 ([object] 1074 (when-let [deleter (delete-slix object)] 1075 @deleter)) 1076 ([sn name] 1077 (when-let [deleter (delete-slix sn name)] 1078 @deleter))) 1079 1080;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1081 1082(defn- generate-slix-code 1083 [sn] 1084 (format (str "(ns ^{:slix true}\n" 1085 " slix.%s\n" 1086 " (:use [sevenri config core event log slix ui utils]))\n\n" 1087 "(defn opened\n" 1088 " [event]\n" 1089 " (set-slix-visible))\n") sn)) 1090 1091(defn create-slix-file? 1092 [slix-file sn] 1093 (try 1094 (spit slix-file (generate-slix-code sn) :encoding "UTF-8") 1095 true 1096 (catch Exception e 1097 (log-exception e) 1098 false))) 1099 1100(defn create-slix 1101 [sn] 1102 (let [info {:sn sn}] 1103 ;; creating 1104 (send-event :sevenri.event/slix-creating nil info) 1105 (let [sod (get-slix-dir) 1106 slix-file (File. sod (str (nssym2path sn) ".clj")) 1107 sn-dir (.getParentFile slix-file)] 1108 (if (.exists slix-file) 1109 ;; create failed 1110 (let [eid :sevenri.event/slix-error-create] 1111 (send-event eid nil (assoc info :reason :sevenri.event/reason-slix-file-exists)) 1112 eid) 1113 (let [eid :sevenri.event/slix-created] 1114 (.mkdirs sn-dir) 1115 (if (create-slix-file? slix-file sn) 1116 ;; created 1117 (let [eid :sevenri.event/slix-created] 1118 (add-to-slix-sn-cache sn) 1119 (post-event eid nil info) 1120 eid) 1121 ;; create failed 1122 (let [eid :sevenri.event/slix-error-create 1123 rsn :sevenri.event/reason-create-slix-file-failed] 1124 (send-event eid nil (assoc info :reason rsn)) 1125 eid))))))) 1126 1127(defn purge-slix 1128 "Purge slix and instance files. Return a purge event id, or nil. 1129 Cannot purge if instance is running." 1130 [sn] 1131 (let [src-sn-file (get-slix-file sn)] 1132 (when (.exists src-sn-file) 1133 (let [info {:sn sn}] 1134 ;; purging 1135 (send-event ::sevenri.event/slix-purging nil info) 1136 (let [slixes (filter #(= sn (slix-sn %)) (get-slixes))] 1137 (if (seq slixes) 1138 ;; purge failed 1139 (let [eid :sevenri.event/slix-error-purge 1140 rsn :sevenri.event/reason-slix-running] 1141 (post-event eid nil (assoc info :reason rsn)) 1142 eid) 1143 ;; continue purging 1144 (let [trash-sof? (trash-file? src-sn-file) 1145 trash-sod? (trash-dir? (get-slix-dir sn) (get-src-dir)) 1146 trash-dod? (trash-dir? (get-sid-slix-dir sn) (get-sid-slix-dir))] 1147 (if (and trash-sof? trash-sod? trash-dod?) 1148 ;; purged 1149 (let [eid :sevenri.event/slix-purged] 1150 (remove-from-slix-sn-cache sn) 1151 (delete-dir? (get-sid-classes-slix-dir sn) (get-sid-classes-dir)) 1152 (post-event eid nil info) 1153 eid) 1154 ;; Purge failed 1155 (let [eid :sevenri.event/slix-error-purge 1156 rsn :sevenri.event/reason-trash-files-failed] 1157 (post-event eid nil (assoc info 1158 :reason rsn 1159 :status {:src-sn-file trash-sof? 1160 :src-slix-dir trash-sod? 1161 :sid-slix-dir trash-dod?})) 1162 eid))))))))) 1163 1164;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1165 1166(defn get-slix-sevenri-sn 1167 [] 1168 (get-default :tln :sevenri)) 1169 1170(defn open-slix-sevenri-and-wait 1171 [] 1172 (open-slix-and-wait (get-slix-sevenri-sn) (get-sevenri-name))) 1173 1174(defn close-slix-sevenri-and-wait 1175 [] 1176 (close-slix-and-wait (get-sevenri-name))) 1177 1178(defn get-slix-sevenri 1179 [] 1180 (get-slix (get-sevenri-name))) 1181 1182(defn update-slix-sevenri-lists 1183 [] 1184 (let [slix-sevenri (get-slix-sevenri)] 1185 (when-let [update-lists-fn (:update-lists-fn (xref-with slix-sevenri))] 1186 (when (fn? (var-get update-lists-fn)) 1187 (invoke-later slix-sevenri update-lists-fn))))) 1188 1189(defn is-slix-sevenri? 1190 ([object] 1191 (if-let [slix (get-slix object)] 1192 (is-slix-sevenri? (slix-sn slix) (slix-name slix)) 1193 false)) 1194 ([sn name] 1195 (if (and (= (symbol sn) (get-slix-sevenri-sn)) 1196 (= (str name) (get-sevenri-name))) 1197 true 1198 false))) 1199 1200(defn can-slix-sevenri-close? 1201 [] 1202 *slix-sevenri-can-close*) 1203 1204;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1205 1206(defn set-slix-title 1207 ([title] 1208 (set-slix-title *slix* title)) 1209 ([slix title] 1210 (when-let [frame (slix-frame slix)] 1211 (.setTitle frame (str title)) 1212 (update-slix-sevenri-lists)))) 1213 1214(defn set-slix-visible 1215 ([] 1216 (set-slix-visible *slix* true)) 1217 ([slix] 1218 (set-slix-visible slix true)) 1219 ([slix visible?] 1220 (.setVisible (slix-frame slix) visible?))) 1221 1222;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1223 1224(defn- -acquire-base-class-loader? 1225 [] 1226 (when-not *base-class-loader* 1227 (reset-base-class-loader (.getContextClassLoader (Thread/currentThread)))) 1228 true) 1229 1230(defn create-sid-slix-dirs? 1231 [] 1232 (get-sid-classes-dir) 1233 (get-sid-slix-dir) 1234 (get-sid-trash-dir) 1235 true) 1236 1237(defn create-src-library-dirs? 1238 [] 1239 (get-library-dir) 1240 (get-library-slix-dir) 1241 true) 1242 1243(defn cache-slix-sns? 1244 [] 1245 (reset! *slix-sn-cache* (apply conj @*slix-sn-cache* (find-all-slix-sn))) 1246 true) 1247 1248(defn register-exception-listeners? 1249 [] 1250 (doseq [sn (get-all-slix-sn)] 1251 (when-let [nm (:exception-listener (if (find-ns (get-slix-fqns sn)) 1252 (get-slix-sn-meta sn) 1253 (meta sn)))] 1254 (if (symbol? nm) 1255 (register-exception-listener sn nm) 1256 (when (and (seq nm) 1257 (symbol? (last nm))) 1258 (register-exception-listener sn (last nm)))))) 1259 true) 1260 1261(defn aot-compile-slixes? 1262 [] 1263 (doseq [sn (get-default :startup :aot-compile-list)] 1264 (aot-compile? sn 'aot false)) 1265 true) 1266 1267;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1268 1269(defn shutdown-slix? 1270 [] 1271 true) 1272 1273(defn startup-slix? 1274 [] 1275 (with-create-sn-get-dir 1276 (and true 1277 (-acquire-base-class-loader?) 1278 (create-sid-slix-dirs?) 1279 (create-src-library-dirs?) 1280 (cache-slix-sns?) 1281 (register-exception-listeners?) 1282 (aot-compile-slixes?))))