/src/sevenri/slix.clj

http://github.com/ksuzuki/Sevenri · Clojure · 1282 lines · 1042 code · 137 blank · 103 comment · 143 complexity · 55a140e613dfcc3e2e03118c7adc2592 MD5 · raw file

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