Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 153 lines (134 sloc) 5.432 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 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))

;; ----------------------------------------------------------------------
Something went wrong with that request. Please try again.