Author Archives: AKIYAMA

2021-12-27

transient.elで同じdescriptionを持つ二つの無名コマンドが衝突する件

前回に引き続きtransient.elをいじっているのですが、prefixの定義において別のキーに割り当てたコマンド(関数)が呼ばれてしまう現象に遭遇しました。

再現するコードは次の通りです。 

(transient-define-prefix talk ()
  "Let's talk to animal."
  ["Dog" ("d" "Talk" (lambda () (interactive) (message "bowwow")))]
  ["Cat" ("c" "Talk" (lambda () (interactive) (message "meow")))])

(talk)

実行してみれば分かりますが、犬も猫のように鳴いてしまいます(dを押してもmeowと表示されます)。

実際のコードはもう少し複雑で、既存のコマンドを呼び出し規約に合致するようにラッピングする関数が挟まっていてそのあたりを調べたのですが原因が分からず、仕方ないのでtransient.elの中を追ってみたら原因が見つかりました。

原因は transient.el の次の部分です。

https://github.com/magit/transient/blob/51c50d8c828b5fac2878b651e2188ad0c6f44184/lisp/transient.el#L1024

transient.elの中には無名の関数が渡されたときに内部で関数名を付ける処理があって、その関数名が transient:<prefix>:<description> の形式になっていました。上の例だと transient:talk:Talk という名前の関数が定義されます(C-h fでも確認できます)。d(Dog)もc(Cat)もdescriptionが"Talk"で同じです。従って同じ関数名になってしまうので、後に定義するc(Cat)の関数だけが使われてしまうわけです。ちなみにdescriptionが無い場合はkey(割り当てキー)が使われます。

せめて (format "transient:%s:%s:%s" prefix (or (plist-get args :description) "") (plist-get args :key)) くらいだったらなと思いますが、keyも重複が許されている(述語でどれかを無効化するのを前提に)みたいなので、それも完全では無いのかもしれません。gensymみたいにカウンターで数字を割り当てていくというのも手ですが定義のたびにどんどん増えていくのは嫌かもしれません(消せばいいだけ？)。

仕方が無いので自分でfsetで関数名を付けてそれを渡すような実装にしました。上にも書いたようにラッピングする関数を通しているので、元の関数名に何らかのprefixを付ければ大丈夫です。

上の例のような場合、ドキュメントの例にあるようにinfixを使えということになるのかもしれません(最初にdかcを選んでからtを押すというような)。infixについてはまだ理解が十分ではないのですみません。

2021-12-21

Transientでメニューを作る

ちょっと興味があってTransientを見ています。MagitのUIに使われているというアレです。set-transient-map関数とも近いですね。text-scale-adjust…ほら、文字の大きさを+/-で変えられるやつ…なんかで使われていて一時的なキーマップを実現するやつです。あれにコマンドメニュー表示の仕組みを付け加えたような感じ？　コマンドメニューを作るならHydraが便利なのですが、カスタマイズ性や動的な要素が必要になったのでTransientを調べてみることにしました。

最初にGitHub内のプロジェクトトップページを見てよく分からず探し回ってしまったのですが、まずはWikiのクイックスタートガイドをやれって感じみたいですね。

Developer Quick Start Guide

はい、後で苦手な英語と格闘して集中力が続くところまでやっておきます……。

他にも長いマニュアルの方には例えば次のような例が載っていて 

(require 'transient)
(transient-define-prefix outline-navigate ()
  :transient-suffix     'transient--do-stay
  :transient-non-suffix 'transient--do-warn
  [("p" "previous visible heading" outline-previous-visible-heading)
   ("n" "next visible heading" outline-next-visible-heading)])

これだけで後は M-x outline-navigate を実行するとメニューが出て、outline-mode(org-modeも含む!)における見出しの前後移動がpキーとnキーで出来て、その状態はC-gで止めるまで続きます。

こんなちょっとしたことでも0から実装しようと思うと結構なコード量が必要ですからね。ありがたい話です。いや、 (read-key) とかでもいいならある意味簡単ではあるんですけどね……。

資料:

2021-12-19

Emacsのimage-map(画像に対するキーマップ)をカスタマイズする

insert-image 関数や put-image 関数で画像を作成すると、その場所(テキストプロパティなりオーバーレイなり)には image-map というキーマップが設定されて画像にカーソル(ポイント)を当てて何かキーを押すと画像に対する操作が実行されるようになっています。

image-map の内容はEmacs27の時点では次のようになっています。 

image-map

(keymap
 (111 . image-save) ;;o
 (114 . image-rotate) ;;r
 (C-mouse-4 . image-mouse-increase-size)
 (C-wheel-up . image-mouse-increase-size)
 (C-mouse-5 . image-mouse-decrease-size)
 (C-wheel-down . image-mouse-decrease-size)
 (43 . image-increase-size) ;;-
 (45 . image-decrease-size)) ;;+

できるのは保存したり、回転したり、小さくしたり、大きくしたりといった程度です。

もう少し色々できても良いのではないでしょうか。

というわけで、思いついたものを少し追加してみました。

  • 関連付けられた外部アプリで開く、編集する(Windows版のみ実装。他のOSではopenコマンドとかを使うらしいです)
  • 画像に関する何かを開く
    • 画像情報を別バッファで表示する (Exif ToolやImageMagickのidentify等で)
    • 撮影場所の地図をブラウザで開く (先日のこれやこれを使用。exif.elはまた新しいバグを見つけてしまったので追記しておきました)
    • 画像がある場所のディレクトリを開く (Diredで開いたらファイルの位置へジャンプ)
  • 画像に関する情報を表示・コピーする
    • パス
    • ファイル名
    • 緯度,経度
    • 撮影日時

どうせ覚えられないのでHydraにしてiキーでメニューが表示されるようにしました。

画像にカーソルを合わせてiを押したところ
図1: 画像にカーソルを合わせてiを押したところ
;;;  -*- lexical-binding: t; -*-
(require 'image)
(require 'hydra)
(require 'my-exif) ;;https://misohena.jp/blog/attach/20211219_my-exif.el
(require 'my-location) ;;https://github.com/misohena/my-location

;;;; Modify Image Key Map

(defun my-image-menu-setup ()
  (define-key
    image-map
    (kbd "i")
    (defhydra hydra-image-action (:hint nil :exit t)
      "
Image Menu:
^ExternalApp^  ^Open^          ^Copy^
------------------------------------------------------
_o_: Open      _i_: Info       _p_: Path
_e_: Edit      _m_: Map        _f_: File Name
^ ^            _d_: Directory  _l_: Latitude,Longitude
^ ^            ^ ^             _t_: Time

(ImageMap i:This Menu r:Rotate o:Save -:Decrease +:Increase)
"
      ("q" nil)
      ("i" my-image-info-at-point)
      ("m" my-image-open-map-at-point)
      ("o" my-image-open-by-app-at-point)
      ("e" my-image-edit-by-app-at-point)
      ("d" my-image-open-directory-at-point)

      ("p" my-image-copy-path-at-point)
      ("f" my-image-copy-file-name-at-point)
      ("l" my-image-copy-latlng-at-point)
      ("t" my-image-copy-time-at-point)
      )))

(my-image-menu-setup)

;;;; Get File Name at Point

(defun my-image-file-at-point ()
  ;; I referred to the image-save function defined in image.el
  (plist-get (cdr (image--get-image)) :file))

;;;; Get Image Information

(defun my-image-info (file)
  (interactive "fImage File: ")
  (when (and file (file-exists-p file))
    (let* ((fmt (pcase (file-name-extension file)
                  ;;("jpg" "")
                  ;;(_ "identify -verbose %s")
                  (_ "exiftool %s")))
           (cmd (format fmt file)))
      (my-shell-command-popup cmd "*Image Info*" "*Image Info Error*"))))

(defun my-image-info-at-point ()
  (interactive)
  (my-image-info (my-image-file-at-point)))

;;;; Get Image Date Time and Latitude/Longitude

(defun my-image-guess-time-from-file-name (file)
  (when (and (stringp file)
             (string-match "\\(20[0-9][0-9]\\|19[0-9][0-9]\\)-?\\(0[1-9]\\|1[0-2]\\)-?\\([0-3][0-9]\\)[ _]?\\(0[0-9]\\|1[0-2]\\)\\([0-5][0-9]\\)\\([0-5][0-9]\\)?" file))
    (encode-time
     (make-decoded-time
      :year (string-to-number (match-string 1 file))
      :month (string-to-number (match-string 2 file))
      :day (string-to-number (match-string 3 file))
      :hour (string-to-number (match-string 4 file))
      :minute (string-to-number (match-string 5 file))
      :second (string-to-number (or (match-string 6 file) "0"))))))

(defun my-image-timelatlng (file)
  (when file
    (let* (;; FILEからExifを読み込む。
           (exif (and (member (file-name-extension file) '("jpg" "jpeg"))
                      (my-exif-parse-file file)))
           ;; 撮影日時を取得する。
           (time (or (and exif (my-exif-date-time-original exif))
                     (my-image-guess-time-from-file-name file)))
           ;; 撮影位置を取得する。
           (latlng (or (and exif (my-exif-latlng exif)) ;;From GPS Info
                       (and time (my-location-latlng-at-time time))))) ;From GPX File
      (cons time latlng))))

(defun my-image-latlng (file)
  (cdr (my-image-timelatlng file)))

;;;; Open Map of Image Shooting Location

(defun my-image-open-map (file)
  (interactive "fImage File: ")
  (when (and file (file-exists-p file))
    (when-let ((ll (my-image-latlng file)))
      (my-location-browse-map ll)
      ll)))

(defun my-image-open-map-at-point ()
  (interactive)
  (my-image-open-map (my-image-file-at-point)))

;;;; Open Directory Containing Image

(defun my-image-open-directory-at-point ()
  (interactive)
  (when-let ((file (my-image-file-at-point)))
    (find-file (file-name-directory file))
    (when (eq major-mode 'dired-mode)
      (dired-jump nil file))))

;;;; Open Image by External App

(defun my-image-open-by-app-at-point ()
  (interactive)
  (when-let ((file (my-image-file-at-point)))
    ;;@todo support other platforms
    (w32-shell-execute "open" file)))

;;;; Edit Image by External App

(defun my-image-edit-by-app-at-point ()
  (interactive)
  (when-let ((file (my-image-file-at-point)))
    ;;@todo support other platforms
    (w32-shell-execute "edit" file)))

;;;; Copy Image Information

(defun my-image-copy-and-show (str)
  (when str
    (kill-new str)
    (message "%s" str)))

(defun my-image-copy-path-at-point ()
  (interactive)
  (when-let ((file (my-image-file-at-point)))
    (my-image-copy-and-show file)))

(defun my-image-copy-file-name-at-point ()
  (interactive)
  (when-let ((file (my-image-file-at-point)))
    (my-image-copy-and-show (file-name-nondirectory file))))

(defun my-image-copy-latlng-at-point ()
  (interactive)
  (when-let ((file (my-image-file-at-point))
             (latlng (my-image-latlng file)))
    (my-image-copy-and-show (format "%.6f,%.6f" (car latlng) (cdr latlng)))))

(defun my-image-copy-time-at-point ()
  (interactive)
  (when-let ((file (my-image-file-at-point))
             (time (car (my-image-timelatlng file))))
    (my-image-copy-and-show (format-time-string "%Y-%m-%d %H:%M:%S" time))))

;;;; Execute Shell Command

(defun my-shell-command-popup (command output-buffer error-buffer)
  "Execute COMMAND and pop up the resulting buffer."

  (let* ((kill-buffers ;;lexical binding
          (lambda ()
            (when (get-buffer output-buffer) (kill-buffer output-buffer))
            (when (get-buffer error-buffer) (kill-buffer error-buffer))))
         (quit
          (lambda ()
            (interactive)
            (quit-window)
            (funcall kill-buffers)))
         (init-buffer
          (lambda (buffer-name)
            (when (get-buffer buffer-name)
              (with-current-buffer buffer-name
                (read-only-mode)
                (local-set-key "q" quit)))))
         (result-code
          (progn
            (funcall kill-buffers)
            (shell-command command output-buffer error-buffer))))
    (funcall init-buffer output-buffer)
    (funcall init-buffer error-buffer)
    (pop-to-buffer (if (equal result-code 0) output-buffer error-buffer))
    result-code))

Org-modeでバリバリインライン画像を使っているともっと色々な操作(例えば画像にキャプションを追加したり、属性を設定したり)が欲しくなるのですが、それはここじゃないほうが良いのでしょうね。

© 2025 AKIYAMA Kouhei, all rights reserved.