Split all namespaces into sub-modules.

* Examples and tests have not been copied over.
* Clojure test/compile phases are commented out in parent POM.
* May require installing parent POM before full build.

1 files changed, 152 insertions, 0 deletions

diff --git a/modules/swing-utils/src/main/clojure/clojure/contrib/swing_utils.clj b/modules/swing-utils/src/main/clojure/clojure/contrib/swing_utils.clj
new file mode 100644
index 00000000..013d7d29
--- /dev/null
+++ b/modules/swing-utils/src/main/clojure/clojure/contrib/swing_utils.clj
@@ -0,0 +1,152 @@
+;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
+;;  distribution terms for this software are covered by the Eclipse Public
+;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
+;;  be found in the file epl-v10.html at the root of this distribution.  By
+;;  using this software in any fashion, you are agreeing to be bound by the
+;;  terms of this license.  You must not remove this notice, or any other,
+;;  from this software.
+;;
+;;  clojure.contrib.swing-utils
+;;
+;;  Useful functions for interfacing Clojure to Swing
+;;
+;;  scgilardi (gmail)
+;;  Created 31 May 2009
+
+(ns clojure.contrib.swing-utils
+  (:import (java.awt.event ActionListener KeyAdapter)
+           (javax.swing AbstractAction Action 
+                        JMenu JMenuBar JMenuItem
+                        SwingUtilities))
+  (:use [clojure.contrib.def :only (defvar)]))
+
+(defn add-action-listener
+  "Adds an ActionLister to component. When the action fires, f will be
+  invoked with the event as its first argument followed by args.
+  Returns the listener."
+  [component f & args]
+  (let [listener (proxy [ActionListener] []
+                   (actionPerformed [event] (apply f event args)))]
+    (.addActionListener component listener)
+    listener))
+
+(defn add-key-typed-listener
+  "Adds a KeyListener to component that only responds to KeyTyped events.
+  When a key is typed, f is invoked with the KeyEvent as its first argument
+  followed by args. Returns the listener."
+  [component f & args]
+  (let [listener (proxy [KeyAdapter] []
+                   (keyTyped [event] (apply f event args)))]
+    (.addKeyListener component listener)
+    listener))
+
+;; ----------------------------------------------------------------------
+;; Meikel Brandmeyer
+
+(defn do-swing*
+  "Runs thunk in the Swing event thread according to schedule:
+    - :later => schedule the execution and return immediately
+    - :now   => wait until the execution completes."
+  [schedule thunk]
+  (cond
+   (= schedule :later) (SwingUtilities/invokeLater thunk)
+   (= schedule :now) (if (SwingUtilities/isEventDispatchThread)
+                       (thunk)
+                       (SwingUtilities/invokeAndWait thunk)))
+  nil)
+
+(defmacro do-swing
+  "Executes body in the Swing event thread asynchronously. Returns
+  immediately after scheduling the execution."
+  [& body]
+  `(do-swing* :later (fn [] ~@body)))
+
+(defmacro do-swing-and-wait
+  "Executes body in the Swing event thread synchronously. Returns
+  after the execution is complete."
+  [& body]
+  `(do-swing* :now (fn [] ~@body)))
+
+(defvar action-translation-table
+  (atom {:name        Action/NAME
+         :accelerator Action/ACCELERATOR_KEY
+         :command-key Action/ACTION_COMMAND_KEY
+         :long-desc   Action/LONG_DESCRIPTION
+         :short-desc  Action/SHORT_DESCRIPTION
+         :mnemonic    Action/MNEMONIC_KEY
+         :icon        Action/SMALL_ICON})
+  "Translation table for the make-action constructor.")
+
+(defn make-action
+  "Create an Action proxy from the given action spec. The standard keys
+  recognised are: :name, :accelerator, :command-key, :long-desc,
+  :short-desc, :mnemonic and :icon - corresponding to the similar named
+  Action properties.  The :handler value is used in the actionPerformed
+  method of the proxy to pass on the event."
+  [spec]
+  (let [t-table @action-translation-table
+        handler (:handler spec)
+        spec    (dissoc spec :handler)
+        spec    (map (fn [[k v]] [(t-table k) v]) spec)
+        action  (proxy [AbstractAction] []
+                  (actionPerformed [evt] (handler evt)))]
+    (doseq [[k v] spec]
+      (.putValue action k v))
+    action))
+
+(defvar menu-constructor-dispatch
+  (atom #{:action :handler :items})
+  "An atom containing the dispatch set for the add-menu-item method.")
+
+(defmulti add-menu-item
+  "Adds a menu item to the parent according to the item description.
+   The item description is a map of the following structure.
+
+ Either:
+   - one single :action specifying a javax.swing.Action to be associated
+     with the item.
+   - a specification suitable for make-action
+   - a set of :name, :mnemonic and :items keys, specifying a submenu with
+     the given sequence of item entries.
+   - an empty map specifying a separator."
+  {:arglists '([parent item])}
+  (fn add-menu-item-dispatch [_ item]
+    (some @menu-constructor-dispatch (keys item))))
+
+(defmethod add-menu-item :action
+  add-menu-item-action
+  [parent {:keys [action]}]
+  (let [item (JMenuItem. action)]
+    (.add parent item)))
+
+(defmethod add-menu-item :handler
+  add-menu-item-handler
+  [parent spec]
+  (add-menu-item parent {:action (make-action spec)}))
+
+(defmethod add-menu-item :items
+  add-menu-item-submenu
+  [parent {:keys [items mnemonic name]}]
+  (let [menu (JMenu. name)]
+    (when mnemonic
+      (.setMnemonic menu mnemonic))
+    (doseq [item items]
+      (add-menu-item menu item))
+    (.add parent menu)))
+
+(defmethod add-menu-item nil ; nil meaning separator
+  add-menu-item-separator
+  [parent _]
+  (.addSeparator parent))
+
+(defn make-menubar
+  "Create a menubar containing the given sequence of menu items. The menu
+  items are described by a map as is detailed in the docstring of the
+  add-menu-item function."
+  [menubar-items]
+  (let [menubar (JMenuBar.)]
+    (doseq [item menubar-items]
+      (add-menu-item menubar item))
+    menubar))
+
+;; ----------------------------------------------------------------------