From a6a92b9b3d2bfd9a56e1e5e9cfba706d1aeeaae5 Mon Sep 17 00:00:00 2001 From: Stuart Sierra Date: Sat, 7 Aug 2010 16:41:53 -0400 Subject: 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. --- modules/swing-utils/pom.xml | 21 +++ .../main/clojure/clojure/contrib/swing_utils.clj | 152 +++++++++++++++++++++ 2 files changed, 173 insertions(+) create mode 100644 modules/swing-utils/pom.xml create mode 100644 modules/swing-utils/src/main/clojure/clojure/contrib/swing_utils.clj (limited to 'modules/swing-utils') 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 @@ + + + 4.0.0 + + org.clojure.contrib + parent + 1.3.0-SNAPSHOT + ../parent + + swing-utils + + + org.clojure.contrib + def + 1.3.0-SNAPSHOT + + + \ 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)) + +;; ---------------------------------------------------------------------- -- cgit v1.2.3-18-g5258