Hello Stephen and fellow Clojurians,

as threatened before here a first stab at a small action and menu
builder suite. It is inspired by what Waterfront does. You basically
create a map describing the action or menu and let the builder functions
create them for you. Example:

(let [frame        (JFrame. "Example")
      save-action  (make-action
                     {:name       "Save"
                      :mnemonic   KeyEvent/VK_S
:long-desc "Save the file to disk. No-op if file not modified"
                      :short-desc "Save file"
                      :handler    save-file-handler})
      menubar-spec [{:name     "File"
                     :mnemonic KeyEvent/VK_F
                     :items    [{:action save-action}
                                {} ; <- adds a separator
                                {:name     "Close Window"
                                 :mnemonic KeyEvent/VK_W
                                 :handler  (fn [_] (.close frame))}]}
                    {:name     "Help"
                     :mnemonic KeyEvent/VK_H
                     :items    [{:name     "About"
                                 :mnemonic KeyEvent/VK_A
                                 :handler  (fn [_] (show-about))}]}]
      menubar      (make-menubar menubar-spec)]
  (doto frame
    (.setJMenbuBar menubar)
    (.pack)
    (.setVisible true)))

So the whole description is code. It can be put in IRefs and be
modified at runtime with the usual means.

Here's the code:

(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))

Sincerely
Meikel


Attachment: smime.p7s
Description: S/MIME cryptographic signature

Reply via email to