Clojureでリッチなテキストを書く

導入

自分の中で何らかのGUIアプリを書きたい機運が高まっており、勉強のネタを探していたところ、
10年前に書かれた以下のSwingアプリのチュートリアルがあったので、それをClojureにポートしてみることにした。

使い方

外部の依存ライブラリは一切存在しないので、下記のコードをファイルに書き、REPLから load-fileすれば動く

(load-file "path/to/file.clj")

コード

(ns advent.rich-text
  (:import [java.awt BorderLayout Color Dimension FlowLayout GraphicsEnvironment]
           java.awt.event.ActionListener
           [javax.swing DefaultComboBoxModel JComboBox JFrame JMenu JMenuBar JMenuItem JScrollPane JTextPane JToggleButton JToolBar]
           [javax.swing.text BadLocationException DefaultStyledDocument SimpleAttributeSet StyleConstants StyleContext]
           javax.swing.text.rtf.RTFEditorKit)
  (:require [clojure.string :as str]))

(definterface IStateHolder
  (getStateMap [])
  (swapStateMap [update-fn]))

;; anctionPerformed handlers
(defmulti handle-action (fn [_ cmd] (.getActionCommand cmd)))

(defn set-attribute-set [document text-pane attr]
  (let [start (.getSelectionStart text-pane)
        end (.getSelectionEnd text-pane)]
    (.setCharacterAttributes document start (- end start) attr false)))

(defmethod handle-action "combo-fonts"
  [this e]
  (let [{:keys [combo-fonts text-pane document] :as state}
        (.getStateMap this)
        attr (SimpleAttributeSet.)
        font-name (-> combo-fonts .getSelectedItem .toString)]
    (StyleConstants/setFontFamily attr font-name)
    (set-attribute-set document text-pane attr)
    (.requestFocusInWindow text-pane)))

(defmethod handle-action "combo-sizes"
  [this e]
  (let [{:keys [combo-sizes text-pane document]} (.getStateMap this)
        attr (SimpleAttributeSet.)
        font-size (-> combo-sizes .getSelectedItem Integer/parseInt)]
    (StyleConstants/setFontSize attr font-size)
    (set-attribute-set document text-pane attr)
    (.requestFocusInWindow text-pane)))

(def colors ["000000" "0000FF" "00FF00" "00FFFF" "FF0000" "FF00FF" "FFFF00" "FFFFFF"])
(defmethod handle-action "combo-color"
  [this e]
  (let [{:keys [combo-color text-pane document]} (.getStateMap this)
        attr (SimpleAttributeSet.)
        color (get colors (.getSelectedIndex combo-color))
        b (Integer/parseInt (.substring color 4 6) 16)
        g (Integer/parseInt (.substring color 2 4) 16)
        r (Integer/parseInt (.substring color 0 2) 16)]
    (StyleConstants/setForeground attr (Color. r g b))
    (set-attribute-set document text-pane attr)
    (.requestFocusInWindow text-pane)))

(defmethod handle-action "toggle-bold"
  [this e]
  (let [{:keys [toggle-bold text-pane document]} (.getStateMap this)
        attr (SimpleAttributeSet.)]
    (StyleConstants/setBold attr (.isSelected toggle-bold))
    (set-attribute-set document text-pane attr)
    (.requestFocusInWindow text-pane)))

(defmethod handle-action "toggle-italics"
  [this e]
  (let [{:keys [toggle-italics text-pane document]} (.getStateMap this)
        attr (SimpleAttributeSet.)]
    (StyleConstants/setItalic attr (.isSelected toggle-italics))
    (set-attribute-set document text-pane attr)
    (.requestFocusInWindow text-pane)))

(defmethod handle-action "toggle-underline"
  [this e]
  (let [{:keys [toggle-underline text-pane document]} (.getStateMap this)
        attr (SimpleAttributeSet.)]
    (StyleConstants/setUnderline attr (.isSelected toggle-underline))
    (set-attribute-set document text-pane attr)
    (.requestFocusInWindow text-pane)))

(defmethod handle-action "toggle-strike"
  [this e]
  (let [{:keys [toggle-strike text-pane document]} (.getStateMap this)
        attr (SimpleAttributeSet.)]
    (StyleConstants/setStrikeThrough attr (.isSelected toggle-strike))
    (set-attribute-set document text-pane attr)
    (.requestFocusInWindow text-pane)))

(defn init-document [doc sc]
  (let [sb (str "Merry Christmas, world!\n"
                "Merry Christmas, world!\n"
                "Merry Christmas, world!\n"
                "Merry Christmas, world!\n"
                "Merry Christmas, world!\n"
                "Merry Christmas, world!\n"
                "Merry Christmas, world!\n")]
    (try (.insertString doc 0 sb (.getStyle sc StyleContext/DEFAULT_STYLE))
         (catch BadLocationException ble
           (prn "初期文書の読み込みに失敗しました。")))))

(defn init-toolbar [jframe tool-bar]
  (let [ge (GraphicsEnvironment/getLocalGraphicsEnvironment)
        family-name (.getAvailableFontFamilyNames ge)
        combo-fonts (JComboBox. family-name)
        combo-sizes (JComboBox. (into-array ["8" "9" "10" "11" "12" "14" "16" "18" "20" "22"
                                             "24" "26" "28" "36" "48" "60" "72" "84" "96"]))
        toggle-bold (JToggleButton. "<html><b>B</b></html>")
        toggle-italics (JToggleButton. "<html><i>I</i></html>")
        toggle-underline (JToggleButton. "<html><u>U</u></html>")
        toggle-strike (JToggleButton. "<html><s>S</s></html>")
        color-model (DefaultComboBoxModel.)
        combo-color (JComboBox. color-model)]
    (doto combo-fonts
      (.setMaximumSize (.getPreferredSize combo-fonts))
      (.addActionListener jframe)
      (.setActionCommand "combo-fonts"))
    (doto combo-sizes
      (.setMaximumSize (.getPreferredSize combo-sizes))
      (.addActionListener jframe)
      (.setActionCommand "combo-sizes"))
    (doto toggle-bold
      (.setPreferredSize (Dimension. 26 26))
      (.addActionListener jframe)
      (.setActionCommand "toggle-bold"))
    (doto toggle-italics
      (.setPreferredSize (Dimension. 26 26))
      (.addActionListener jframe)
      (.setActionCommand "toggle-italics"))
    (doto toggle-underline
      (.setPreferredSize (Dimension. 26 26))
      (.addActionListener jframe)
      (.setActionCommand "toggle-underline"))
    (doto toggle-strike
      (.setPreferredSize (Dimension. 26 26))
      (.addActionListener jframe)
      (.setActionCommand "toggle-strike"))
    (doseq [color colors
            :let [html (str "<html><font color=\"#" color "\">■</font></html>")]]
      (.addElement color-model html))
    (doto combo-color
      (.setMaximumSize (.getPreferredSize combo-color))
      (.addActionListener jframe)
      (.setActionCommand "combo-color"))
    (doto tool-bar
      (.setLayout (FlowLayout. FlowLayout/LEFT))
      (.add combo-fonts)
      (.add combo-sizes)
      .addSeparator
      (.add toggle-bold)
      (.add toggle-italics)
      (.add toggle-underline)
      (.add toggle-strike)
      .addSeparator
      (.add combo-color))
    {:combo-fonts combo-fonts
     :combo-sizes combo-sizes
     :combo-color combo-color
     :toggle-bold toggle-bold
     :toggle-italics toggle-italics
     :toggle-strike toggle-strike
     :toggle-underline toggle-underline}))

(defn create-jframe-proxy []
  (let [is-caret-update-atom (atom false)
        state (atom {})]
    (proxy [JFrame ActionListener IStateHolder] []
      (actionPerformed [e]
        (when-not @is-caret-update-atom
          (handle-action this e)))
      (getStateMap [] @state)
      (swapStateMap [update-fn]
        (swap! state update-fn)))))

(defn constructor []
  (let [jframe (doto (create-jframe-proxy)
                 (.setTitle "TextPaneTest test")
                 (.setBounds 10 10 500 300))
        text-pane (JTextPane.)
        scroll-pane (JScrollPane. text-pane
                                  JScrollPane/VERTICAL_SCROLLBAR_ALWAYS
                                  JScrollPane/HORIZONTAL_SCROLLBAR_NEVER)
        sc (StyleContext.)
        doc (DefaultStyledDocument. )
        tool-bar (JToolBar.)
        tool-bar-components (init-toolbar jframe tool-bar)]
    (->  jframe
         (.getContentPane)
         (.add scroll-pane BorderLayout/CENTER))
    (doto text-pane
      (.setDocument doc))
    (init-document doc sc)
    (->  jframe
         (.getContentPane)
         (.add tool-bar BorderLayout/NORTH))
    (.swapStateMap jframe #(merge % {:text-pane text-pane
                                     :scroll-pane scroll-pane
                                     :style-context sc
                                     :document doc
                                     :tool-bar tool-bar}
                                  tool-bar-components))
    jframe))

;;; Start the editor
(doto (constructor)
  (.setVisible true)
  (.setSize 800 400))

デモ

• トグルボタンの状態が残ってしまうのは愛嬌(Javaの例ではCaretの移動に合せて更新するロジックがあったが、時間が足りず)
• Javaの例ではファイルの読み書きも出きたが、上記と合わせて読者への課題ということで(

実装の所感

• イベントを受けとるために、ActionListenerインターフェースを実装したJFrameのインスタンスが必要だったので、proxyを使用して実現した。
• イベントのディスパッチをマルチメソッドで書くと非常にスッキリと書ける。
• トグルボタン等の部品から情報を取得するのにJavaの例ではインスタンス変数を使用していたが、Clojureの例では代りにproxyのレキシカルクロージャーにアトムを作り、IStateHolderというオレオレインターフェースを介してそのアトムに対して操作を行うようにした。
• JFrameを再起動しなくても、動的に関数を変更して振舞いが変更できるのが楽しかった。

まとめ

• 10年前の例がそのまま使えるJavaの後方互換性すごい
• Javaの型システムにそのまま入り込めるClojureすごい
• GUIアプリ楽しい

謝辞

proxyの使い方を丁寧に解説してくれた @ayato_p に感謝!