(Emacs27.1, Windows 10で確認)

まず普段マウスに関してどんなイベントが来るのか調べる。

次のコードを実行した後ウィンドウの中でマウスを色々操作するとイベント(発生した出来事の詳細を表すリスト)の内容が出力される。

(while t
  (message "%s" (read-event)))

(down-mouse-1 (#<window 26 on *scratch*> 186 (400 . 236) 979458359 nil 186 (50 . 6) nil (400 . 104) (8 . 22)))
(mouse-1 (#<window 26 on *scratch*> 186 (400 . 236) 979458625 nil 186 (50 . 6) nil (400 . 104) (8 . 22)))
(down-mouse-1 (#<window 26 on *scratch*> 186 (213 . 271) 979474031 nil 186 (26 . 6) nil (213 . 139) (8 . 22)))
(drag-mouse-1 (#<window 26 on *scratch*> 186 (213 . 271) 979474031 nil 186 (26 . 6) nil (213 . 139) (8 . 22)) (#<window 26 on *scratch*> 186 (271 . 232) 979475453 nil 186 (33 . 6) nil (271 . 100) (8 . 22)))
(down-mouse-1 (#<window 26 on *scratch*> 186 (113 . 250) 979478593 nil 186 (14 . 6) nil (113 . 118) (8 . 22)))
(mouse-1 (#<window 26 on *scratch*> 186 (113 . 250) 979478687 nil 186 (14 . 6) nil (113 . 118) (8 . 22)))
(down-mouse-1 (#<window 26 on *scratch*> 186 (102 . 250) 979479796 nil 186 (12 . 6) nil (102 . 118) (8 . 22)))
(drag-mouse-1 (#<window 26 on *scratch*> 186 (102 . 250) 979479796 nil 186 (12 . 6) nil (102 . 118) (8 . 22)) (#<window 26 on *scratch*> 186 (161 . 244) 979480796 nil 186 (20 . 6) nil (161 . 112) (8 . 22)))
(down-mouse-3 (#<window 26 on *scratch*> 186 (252 . 245) 979484453 nil 186 (31 . 6) nil (252 . 113) (8 . 22)))
(mouse-3 (#<window 26 on *scratch*> 186 (252 . 245) 979484578 nil 186 (31 . 6) nil (252 . 113) (8 . 22)))

リストの各要素の意味はInput Events - Emacs Lisp Reference Manualを参照のこと。

ボタンの押し離しについてはイベントが来るが動きについてはイベントが来ていないことが分かる。

マウスの動きを得るには track-mouse 変数か (track-mouse body ) マクロを使う。あるコマンドで track-mouse 変数を t にして別のコマンドでnilにするやり方もあり得るが、一つのコマンドの中で (track-mouse body ) マクロを使う方がnilに戻し忘れる心配が無くて無難。(Mouse Tracking - Emacs Lisp Reference Manual)

実際にtrack-mouseを使ったときにどんなイベントが来るのか調べる。

(track-mouse
  (while t
    (let ((ev (read-event)))
      (message "basic type=%s modifiers=%s event=%s" (event-basic-type ev) (event-modifiers ev) ev))))

basic type=mouse-movement modifiers=nil event=(mouse-movement (#<window 26 on *scratch*> 301 (265 . 379) 1465867125 nil 301 (32 . 7) nil (89 . 239) (8 . 20)))
basic type=mouse-movement modifiers=nil event=(mouse-movement (#<window 26 on *scratch*> 301 (272 . 361) 1465867531 nil 301 (33 . 7) nil (96 . 221) (8 . 20)))
basic type=mouse-movement modifiers=nil event=(mouse-movement (#<window 26 on *scratch*> 301 (276 . 359) 1465867640 nil 301 (33 . 7) nil (100 . 219) (8 . 20)))
basic type=mouse-movement modifiers=nil event=(mouse-movement (#<window 26 on *scratch*> 301 (280 . 358) 1465867734 nil 301 (34 . 7) nil (104 . 218) (8 . 20)))
basic type=mouse-movement modifiers=nil event=(mouse-movement (#<window 26 on *scratch*> 301 (288 . 358) 1465867859 nil 301 (35 . 7) nil (112 . 218) (8 . 20)))
basic type=mouse-movement modifiers=nil event=(mouse-movement (#<window 26 on *scratch*> 301 (297 . 358) 1465868015 nil 301 (36 . 7) nil (121 . 218) (8 . 20)))
basic type=mouse-movement modifiers=nil event=(mouse-movement (#<window 26 on *scratch*> 301 (305 . 360) 1465868078 nil 301 (37 . 7) nil (129 . 220) (8 . 20)))
basic type=mouse-movement modifiers=nil event=(mouse-movement (#<window 26 on *scratch*> 301 (308 . 380) 1465868828 nil 301 (37 . 7) nil (132 . 240) (8 . 20)))
basic type=mouse-movement modifiers=nil event=(mouse-movement (#<window 26 on *scratch*> 301 (303 . 389) 1465869062 nil 301 (36 . 7) nil (127 . 249) (8 . 20)))
basic type=mouse-movement modifiers=nil event=(mouse-movement (#<window 26 on *scratch*> 301 (295 . 393) 1465869281 nil 301 (35 . 7) nil (119 . 253) (8 . 20)))

マウスを動かしただけで次々とmouse-movementイベントが来る。

マウスイベントには次の種類がある。

• Click (例: mouse-1, wheel-up)
• Drag (例: drag-mouse-1)
• Button Down (例: down-mouse-1)
• Repeat (例: double-mouse-1)(いわゆるダブルクリックやトリプルクリック)
• Motion (例: mouse-movement)

主な操作に対して発生する一連のイベントの流れはだいたい次のようになる。

• クリック時に来るイベントの流れ:

  1. down-mouse-1
  2. mouse-movement (0回以上)
  3. mouse-1

  基本的にはDown→Clickの順に発生する。まれにこの間にMotionが挟まることがある。押し下げと解放の間にわずかに動いた場合mouse-movementが来る場合がある。閾値以下の動きならドラッグではなくクリックと判定される。

  up-mouse-1というのは無い。Click(mouse-1)かDrag(drag-mouse-1)のどちらかのみが来る。

  もちろんマウスボタン押し下げ中にキーボードを押した場合は、そのキーイベントが挟まる。

• ドラッグ時に来るイベントの流れ:

  1. down-mouse-1
  2. mouse-movement (0回以上)
  3. drag-mouse-1

  ドラッグなのでほとんどの場合mouse-movementは来ることになるが、指し示す位置がスクロールによってのみ変わった場合は来ないこともある。つまりマウスボタンを押し下げて動かさずに何らかの方法でスクロールしてから離した場合。これもきちんとDragと判定される。

• シフトキーを押したままクリックした時に来るイベントの流れ:

  1. S-down-mouse-1
  2. mouse-movement (0回以上)
  3. S-mouse-1

  シンボルにS-といった部分が付く。(21.7.4 Click Events - Emacs Lisp Reference Manual)

• クリックの途中でシフトキーを押した場合(mouse down, shift down, mouse up):

  1. down-mouse-1
  2. mouse-movement (0回以上)
  3. S-mouse-1

  つまり、down-mouse-1に対応するmouse upがmouse-1やdrag-mouse-1とは限らない。S-mouse-1とかC-S-drag-mouse-1とかになることもある。逆にS-down-mouse-1(シフトを押しながらマウスボタン押し下げ)に対してmouse upが(S-が付かない)mouse-1になることもある(途中でシフトキーが離された場合)。

  判別にはevent-basic-typeとevent-modifiersを使うと良い。

  • (event-basic-type event) で 'mouse-1 や 'mouse-3 等の(S-等が付かない)ボタンの種類が返ってくる。
  • (event-modifiers event) で '(click) や '(drag) が返ってくる。

  (21.7.12 Classifying Events - Emacs Lisp Reference Manual)

• mouse-movement中にボタンの状態を取得する方法は見当たらない。イベントの中にも無いし、位置における (mouse-position) のような現在の状態を取得する関数も見当たらない。
• フレームの外に出た場合の挙動はOSによって違うかもしれないが、とりあえずWindows 10での動作:
  • フレーム外に出ても特に何かイベントは来ない。出たことを知る確実な方法は見当たらない。
  • ドラッグ中にフレームの外に出た場合、フレームがアクティブな間はマウスイベントはモーションも含めて来続ける。フレームの外でボタンを離したときもdrag-mouse-1が発生する。
  • ドラッグ中にフレームの外に出て、ドラッグしたままで(Alt-Tab等で)フレームが非アクティブになったとき、マウスイベントは来なくなる。この後マウスボタンが離されてもイベントは発生せず、離されたことを検出する方法は見当たらない。マウスカーソルがフレーム内に戻ってきたときにモーションイベントは発生するが、ボタンがすでに離されていることに気がつけない。
  • フレームが非アクティブの時にフレームの上をマウスが通過した場合、モーションイベントが来る。

以上の点に注意しながらプログラムを組んでいくことになる。

ひとまずtrack-mouseマクロとread-eventを使うとして、マウスイベント以外はどう処理したら良いのか。read-eventを使ってイベントを読み込むと当然マウス以外のイベントも来る。マウス入力中の不正入力として破棄しても問題ないのだろうけれど、一応デフォルトの処理をさせてみたい。イベントをデフォルト処理にdispatchする関数は見当たらない。 unread-command-events 変数を使うと、まだ処理していないイベントを先読みしたり、戻ししたり出来る。使わないイベントをread-eventで読んでしまった場合、 (push (cons t event) unread-command-events) で戻せる。実質的にこの操作がdispatchになる。余談だけど全く関係ないイベントを生成してポストすることも出来る。 (push (cons t ?a) unread-command-events) とすれば現在のポイントでaを押したときのキーバインドが呼び出される。その気になればこの変数だけからpeek-eventとかpost-eventとか作れそう。(21.8.6 Miscellaneous Event Input Features - Emacs Lisp Reference Manual)

ちなみにイベントを待つにはread-event等を使っても良いが、 (sit-for seconds) を使っても良い。時間またはイベントの到着を待つ。再描画(redisplay)もしてくれる。(21.10 Waiting for Elapsed Time or Input - Emacs Lisp Reference Manual)

以上の調査を元に、試しに画像(オブジェクト)に対してマウスの押し下げから移動、解放までを追跡してコールバックを呼び出す関数を作ってみた。

(defun track-dragging-on (down-event on-move &optional on-up on-leave)
  "マウスdownイベント(down-mouse-1やdown-mouse-3等)が発生したときにこの関数を呼び出すと、押したところにある画像上で発生するモーションイベントをON-MOVEにコールバックし続ける。ボタンが離されたり画像の外に出たり何かマウスイベント以外が発生したとき関数は終了する。"
  (if (not (memq 'down (event-modifiers down-event)))
      (error "down-event is not a down event. %s" (event-modifiers down-event)))
  (let* ((down-basic-type (event-basic-type down-event))
         (down-position (event-start down-event))
         (target-window (posn-window down-position))
         (target-point (posn-point down-position))
         (target-object (posn-object down-position)))

    (track-mouse
      (let (result)
        (while (null result)
          (let ((event (read-event)))
            (cond
             ;; mouse move
             ((mouse-movement-p event)
              ;; クリックしたときと同じオブジェクト上であることを確認する。
              ;; 単純にobjectをeqで判定できない。
              ;; displayプロパティの値(リスト)は毎回コピーされているようなので。
              ;; SVGを含んだ結構大きなリストになるのでequalを使うのもためらわれるし、一致したところで同じオブジェクトとは限らない。
              ;; 指しているウィンドウとポイントが同じでobjectの最初の要素(おそらく'image)が一致していることで確認している。
              (if (and (eq (posn-window (event-start event))
                           target-window)
                       (= (posn-point (event-start event))
                          target-point)
                       (eq (car (posn-object (event-start event))) ;;ex: 'image
                           (car target-object))) ;;ex: 'image
                  (if on-move (funcall on-move event))
                ;; out of target
                (if on-up (funcall on-leave event))
                (setq result 'leave)))
             ;; mouse up
             ((and (eq (event-basic-type event) down-basic-type)
                   (or (memq 'click (event-modifiers event))
                       (memq 'drag (event-modifiers event))))
              (if on-up (funcall on-up event))
              (setq result 'up))
             ;; otherwise
             (t
              (if on-up (funcall on-up event))
              (setq result 'unknown-event)
              (push (cons t event) unread-command-events)))))
        result))))

この関数を使って試しにSVG画像を作ってその中でドラッグしたときのイベントを表示させてみる。(画像の表示方法については先日の記事を参照のこと)

(let (;;適当な文字列("A")を追加しその範囲をstart,endとする。
      (start (point))
      (end (progn (insert "A") (point))))

  ;; start～endのdisplayプロパティにSVG画像を設定する。
  (put-text-property start end 'display
                     (let ((svg (svg-create 400 300)))
                       (svg-rectangle svg 0 0 400 300 :fill "#333")
                       (svg-image svg)))

  ;; start～endのkeymapプロパティに down-mouse-1 に反応するキーマップを設定する。
  (put-text-property
   start end 'keymap
   (let ((km (make-sparse-keymap)))
     (define-key km [down-mouse-1]
       (lambda (down-event)
         (interactive "e")
         (message "mouse down %s" down-event)

         (track-dragging-on
          down-event
          (lambda (motion-event)
            (message "mouse move %s" motion-event))
          (lambda (up-event)
            (message "mouse up %s" up-event))
          (lambda (leave-event)
            (message "mouse leave %s" leave-event)))

         (message "finish")))
     km))
  )

EmacsでGUIプログラミングをしていると何かをクリックしたときにポップアップメニューを出したくなることがあります。メニューボタンを押したとき、対象を右クリックしてコンテキストメニューを出したいとき、といった具合です。

そんなときに使えるのが x-popup-menu という関数です。

x-popup-menuにペインのリストを指定する

menu にペインのリストを指定するのが一番簡単ですが出来ることは限られます。

例えば次のコードを評価すると……

(x-popup-menu t '("Menu Title"
                  ("Pane Title1"
                   ("Item1-1" . 11)
                   ("Item1-2" . 12))
                  ("Pane Title2"
                   ("Item2-1" . 21)
                   ("Item2-2" . 22))))

次のようなポップアップメニューが表示されます。

項目を選択すると項目の値がそのまま返ってきます。上の例では「Item1-1」を選択すると11が返ってきます。選択しなかった場合はC-gを押したときのようにQuitシグナルが発生します。

複数のペインを持ちたくない場合はペインを一つだけ指定することになりますが、その場合ペインのタイトルは表示されません。次の例では「Pane Title1」は表示されません。

(x-popup-menu t '("Menu Title"
                  ("Pane Title1"
                   ("Item1-1" . 11)
                   ("Item1-2" . 12))))

x-popup-menuにキーマップを指定する

x-popup-menuの機能を完全に利用するにはキーマップを指定する必要があります。

例えば次のコードを評価すると……

(defun test-item-1 () (interactive) (message "Menu Item 1"))
(defun test-item-2 () (interactive) (message "Menu Item 2"))
(setq test-item-toggle-selected t)
(defun test-item-toggle () (interactive) (setq test-item-toggle-selected (not test-item-toggle-selected)))
(setq test-radio-choice 1)
(defun test-item-radio-1 () (interactive) (setq test-radio-choice 1))
(defun test-item-radio-2 () (interactive) (setq test-radio-choice 2))
(defun test-submenu-1-2 () (interactive) (message "hello"))

(let* ((menu '(keymap "Menu Title"
                      ;;イベント型 拡張メニュー 項目名 コマンド プロパティ...
                      (test-item-1 menu-item "Item1" test-item-1)
                      (test-item-2 menu-item "Item2" test-item-2 :keys "HogeHogeKey")
                      (3 menu-item "Item3" test-item-3 :enable nil)
                      (4 menu-item "Item4" test-item-4 :visible nil)
                      (5 menu-item (concat "Item" "5") test-item-3 :enable nil)
                      (test-item-toggle menu-item "ItemToggle" test-item-5 :button (:toggle . test-item-toggle-selected))
                      (separator-1 menu-item "--")
                      (test-item-radio-1 menu-item "ItemRadio1" test-item-radio-1 :button (:radio . (= test-radio-choice 1)))
                      (test-item-radio-2 menu-item "ItemRadio2" test-item-radio-2 :button (:radio . (= test-radio-choice 2)))
                      (separator-2 menu-item "--")
                      (text-1 menu-item "選択できない項目")
                      (separator-3 menu-item "--")
                      (10 menu-item "About Emacs" about-emacs) ;; :keysを書かなくてもglobal-mapから割り出してくれる
                      (submenu-1 menu-item "Submenu" (keymap "Submenu Title"
                                                             (submenu-1-1 menu-item "SubItem1" test-subitem-1)
                                                             (test-submenu-1-2 menu-item "SubItem2" test-subitem-2)))))
       (result (x-popup-menu t menu)))
  ;; 結果の最後の要素が関数なら呼び出す
  (if (and (symbolp (car (last result))) (fboundp (car (last result))))
      (funcall (car (last result)))
    ;; 関数でなければそのまま表示してみる
    (message "result=%s" result)))

次のようなポップアップメニューが表示されます。

このように様々な事が出来るようになっています。

詳しくはマニュアルを参照のこと。

• 22.17 Menu Keymaps - Emacs Lisp Manual
• 22.17.1.2 Extended Menu Items - Emacs Lisp Manual

少しだけ補足。

:keys は通常書く必要はありません。上の例では HogeHogeKey なんて存在しないキーを表示させてましたが、あくまで何でも書けるか試しただけです。特筆すべきは About Emacs のところ。何も指定していなくても C-h C-a と表示されています。コマンド名からキーシーケンスを自動的に割り出して表示してくれます。グローバルマップやローカルマップだけでなく、(ポイントがそこにあれば)テキストプロパティやオーバーレイのkeymapプロパティまで考慮してくれます。

x-popup-menuは選択結果を返すだけでコマンドの呼び出し等は行いません。

easymenu.elというのが標準で入っていてもう少し簡単にメニュー用のキーマップが定義できるのですが、easy-menu-defineでキーマップを作ると項目の一番最初の要素は項目名の文字列をシンボルにしたものになるのでx-popup-menuで選択するとその人間向けな感じのシンボルが返ってきてしまいます。そこから実際にコマンドを呼び出す方法が今ひとつ分かりません。おそらく返ってきたシンボルを使ってキーマップから関数を割り出して呼び出せということなんだと思いますが、それなら最初から関数シンボルが返ってきた方が楽そうですよね……。そうでもないのかな？　キーマップの意味論的に最初の要素はキー、というかイベント(シンボルはその名前のファンクションキーを押したというイベントという意味)なのだから、ルックアップを挟むべきってことなのでしょうか。それならば、こんな感じ？

(easy-menu-define test-menu nil
  "This is a Test Menu."
  '("Test Menu Title"
     ["Forward word desu!" forward-word] ;;x-popup-menuの結果は '(Forward\ word\ desu!)
     ["Backward word desu!" backward-word] ;;結果は '(Backward\ word\ desu!)
     ["Fun" (lambda () (interactive) (message-box "Fun!"))] ;;結果は '(Fun)
     ("Sub"
      ["FunFun" (lambda () (interactive) (message-box "FunFun!"))] ;;結果は'(Sub FunFun)
     )))

(let* ((events (x-popup-menu t test-menu))
       (cmd (lookup-key test-menu (apply 'vector events))))
  (call-interactively cmd))

例えば Sub → FunFun と選ぶとx-popup-menuは (Sub FunFun) というリストを返してきます。これはSubキーを押してからFunFunキーを押すという架空のキーシーケンスを意味します。そのキーシーケンスを元にlookup-keyでキーマップtest-menuからコマンドを割り出しています。

lookup-keyはリストを受け付けてくれなかったのでvectorに変換してから渡しています。これで良いのかな……。

他にも探したら popup-menu なんていう関数がmenu-bar.elにありました。内部でx-popup-menuを使っているようですがちゃんとコマンド呼び出しまでやってくれます。Emacs Lispのマニュアルに書いてない関数だけどこれでいいっぽい？

(popup-menu test-menu)