PageRenderTime 126ms CodeModel.GetById 19ms app.highlight 96ms RepoModel.GetById 1ms app.codeStats 0ms

/src/sevenri/slix.clj

http://github.com/ksuzuki/Sevenri
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?))))