aboutsummaryrefslogtreecommitdiff
path: root/modules/swing-utils
diff options
context:
space:
mode:
authorStuart Sierra <mail@stuartsierra.com>2010-08-07 16:41:53 -0400
committerStuart Sierra <mail@stuartsierra.com>2010-08-07 16:41:53 -0400
commita6a92b9b3d2bfd9a56e1e5e9cfba706d1aeeaae5 (patch)
treef1f3da9887dc2dc557df3282b0bcbd4d701ec593 /modules/swing-utils
parente7930c85290f77815cdb00a60604feedfa2d0194 (diff)
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.
Diffstat (limited to 'modules/swing-utils')
-rw-r--r--modules/swing-utils/pom.xml21
-rw-r--r--modules/swing-utils/src/main/clojure/clojure/contrib/swing_utils.clj152
2 files changed, 173 insertions, 0 deletions
diff --git a/modules/swing-utils/pom.xml b/modules/swing-utils/pom.xml
new file mode 100644
index 00000000..53106cde
--- /dev/null
+++ b/modules/swing-utils/pom.xml
@@ -0,0 +1,21 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<project xmlns="http://maven.apache.org/POM/4.0.0"
+ xmlns:xsi="http//www.w3.org/2001/XMLSchema-instance"
+ xsi:schemaLocation="http://maven.apache.org/POM/4.0.0
+ http://maven.apache.org/maven-v4_0_0.xsd">
+ <modelVersion>4.0.0</modelVersion>
+ <parent>
+ <groupId>org.clojure.contrib</groupId>
+ <artifactId>parent</artifactId>
+ <version>1.3.0-SNAPSHOT</version>
+ <relativePath>../parent</relativePath>
+ </parent>
+ <artifactId>swing-utils</artifactId>
+ <dependencies>
+ <dependency>
+ <groupId>org.clojure.contrib</groupId>
+ <artifactId>def</artifactId>
+ <version>1.3.0-SNAPSHOT</version>
+ </dependency>
+ </dependencies>
+</project> \ No newline at end of file
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))
+
+;; ----------------------------------------------------------------------