neotreeを試してみたのですが、neo-smart-openをtにするとf8に割り当てたneotree-toggleを押したときに固まることがありました。普通のファイルを開いているときは固まらず、scratchやdiredでディレクトリを開いているときに固まるようです。

コードを追ってみたところ neo-buffer--select-file-node 関数の中で無限ループに陥ってしまう場所を見つけました。

https://github.com/jaypei/emacs-neotree/blob/98fe21334affaffe2334bf7c987edaf1980d2d0b/neotree.el#L1632

親ディレクトリへ移動するループで、ルートに到達したかの判定を"/"と比較することで行っています。Windowsでは"c:/"等がルートで何度neo-path--updirを適用しても決して"/"になりませんからいつまで経っても終わりません。

とりあえず"/"を"c:/"にしたら直ったのですが、それではあんまりなのでupdirしたときにパスが変化しなかったら終わらせるようにしてみました。

うまくadviceもかけられないしneotree.el読み込み後に関数まるごと再定義。neotreeはそんなに頻繁に更新されていないみたいなのでまあいいか。

(with-eval-after-load "neotree"
  (defun neo-buffer--select-file-node (file &optional recursive-p)
    "Select the node that corresponds to the FILE.
If RECURSIVE-P is non nil, find files will recursively."
    (let ((efile file)
          (iter-prev-dir nil) ;;ADD
          (iter-curr-dir nil)
          (file-node-find-p nil)
          (file-node-list nil))
      (unless (file-name-absolute-p efile)
        (setq efile (expand-file-name efile)))
      (setq iter-curr-dir efile)
      (catch 'return
        (while t
          (setq iter-prev-dir iter-curr-dir) ;;ADD
          (setq iter-curr-dir (neo-path--updir iter-curr-dir))
          (push iter-curr-dir file-node-list)
          (when (neo-path--file-equal-p iter-curr-dir neo-buffer--start-node)
            (setq file-node-find-p t)
            (throw 'return nil))
          (let ((niter-curr-dir (file-remote-p iter-curr-dir 'localname)))
            (unless niter-curr-dir
              (setq niter-curr-dir iter-curr-dir))
            (when (or (string= iter-curr-dir iter-prev-dir) ;;ADD
                      (neo-path--file-equal-p niter-curr-dir "/"))
              (setq file-node-find-p nil)
              (throw 'return nil)))))
      (when file-node-find-p
        (dolist (p file-node-list)
          (neo-buffer--set-expand p t))
        (neo-buffer--save-cursor-pos file)
        (neo-buffer--refresh nil)))))

ふとEmacs Lispマニュアルの Sound Output のところが目に入ったので試してみました。サウンドまわりは大昔に試してあまり良くなかった記憶がありますがその後どれだけ改善されたかな。

• GNU Emacs Lisp Reference Manual: Sound Output (公式)
• GNU Emacs Lisp Reference Manual: Sound Output (日本語)

マニュアルを読んでみると (play-sound '(sound :file "ファイルへのパス")) か (play-sound '(sound :data "サウンドデータ")) で鳴るみたいです。

試しにサイン波でも生成して鳴らしてみましょうか。

対応形式は.wav(RIFF)または.auと書いてあります。.auの方がヘッダーがシンプルなのでそれにしましょう。

• Sunオーディオファイル - Wikipedia

44.1KHzモノラルの16-bit PCMのヘッダーは文字列にすると ".snd\x00\x00\x00\x18\xff\xff\xff\xff\x00\x00\x00\x03\x00\x00\xac\x44\x00\x00\x00\x01" の24バイトですね(長さは不明ffffffffとしてあります)。各要素はビッグエンディアンな32-bit整数です。

16-bit PCMの各要素は負号付き整数みたいですね。-32767~0~32768。

うーん、どうしましょう。文字列バッファを先に確保して、そこにバイト列を埋めていく方が速度的に良さそうでしょうか？　(適当に文字列結合しまくる方が作るのは楽そうですが)

ひとまず16-bit, 32-bit整数を文字列化する関数を作り……

(defun my-snd-aset-i32 (bytearray index x)
  (aset bytearray index (logand 255 (ash x -24)))
  (aset bytearray (+ index 1) (logand 255 (ash x -16)))
  (aset bytearray (+ index 2) (logand 255 (ash x -8)))
  (aset bytearray (+ index 3) (logand 255 x)))

(defun my-snd-aset-i16 (bytearray index x)
  (aset bytearray index (logand 255 (ash x -8)))
  (aset bytearray (+ index 1) (logand 255 x)))

サイン波を生成する関数を作り……

(defconst my-snd-byte-size-i16 2)
(defconst my-snd-amplitude-i16 32767)

(defun my-snd-aset-sin-wave (dst-buffer dst-index num-samples wavelength)
  (let ((2pi/wavelength (/ (* 2 pi) wavelength))
        (i 0))
    (while (< i num-samples)
      (my-snd-aset-i16 dst-buffer dst-index
                       (truncate (* my-snd-amplitude-i16
                                    ;;周期の誤差をどこまで許容するかよく分からないよね
                                    (sin (* i 2pi/wavelength)))))
      (setq dst-index (+ dst-index my-snd-byte-size-i16))
      (setq i (1+ i))))
  dst-buffer)

試しに440Hzのサイン波を含むauデータを生成する関数を作る。

(defun my-snd-generate-au-sin-wave-440hz-1sec ()
  (let* ((samples-per-sec 44100)
         (seconds 1)
         (num-samples (* seconds samples-per-sec))
         (data-size (* my-snd-byte-size-i16 num-samples))
         (data (make-string (+ 24 data-size) 0)))
    ;; header
    (my-snd-aset-i32 data 0 #x2e736e64)
    (my-snd-aset-i32 data 4 24) ;;Data offset
    (my-snd-aset-i32 data 8 data-size)
    (my-snd-aset-i32 data 12 3) ;;16-bit linear PCM
    (my-snd-aset-i32 data 16 samples-per-sec)
    (my-snd-aset-i32 data 20 1) ;;Channels
    ;; data
    (my-snd-aset-sin-wave data 24 num-samples (/ samples-per-sec 440.0))

    data))

鳴らしてみましょぅ。

(play-sound (list 'sound :data (string-as-unibyte ;;string-as-unibyte必要?
                                (my-snd-generate-au-sin-wave-440hz-1sec))))

あれ、結果は (error "Invalid sound specification") だって。

おかしいなデータが壊れているのかな。試しにファイルに書き出してみる。

(with-temp-file "~/tmp/sin440.au"
  (set-buffer-file-coding-system 'no-conversion)
  (insert (string-as-unibyte (my-snd-generate-au-sin-wave-440hz-1sec))))

プレイヤーで鳴らしたら「ポー」っとちゃんと鳴ります。

それならこのファイルをplay-soundで鳴らしてみる。

(play-sound '(sound :file "~/tmp/sin440.au"))

あれ鳴らない、と思ったらプレイヤーで開いていたからでした。プレイヤーを閉じたらEmacsからちゃんと鳴りました。

play-sound関数はsubr.elにあって、Emacsのサウンドサポートを確認してからplay-sound-internal関数を呼び出しています。play-sound-internal関数はsound.cにあって、最初の方でparse_sound関数を呼び出しています。parse_sound関数を見ると……

#else /* WINDOWSNT */
  /*
    Data is not supported in Windows.  Therefore a
    File name MUST be supplied.
  */
  if (!STRINGP (attrs[SOUND_FILE]))
    {
      return 0;
    }
#endif /* WINDOWSNT */

Windowsでは :data をサポートしていないんだって！

完

そういえば昔Emacsから音を鳴らしたくて↓こういうのを作ったのでした。

• misohena/aush: Console Audio Player

これは何万個もある音声ファイルをテキストファイルと付き合わせて確認する作業で活躍したのでした。今でも動くのかは不明。

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