insert-image 関数や put-image 関数で画像を作成すると、その場所(テキストプロパティなりオーバーレイなり)には image-map というキーマップが設定されて画像にカーソル(ポイント)を当てて何かキーを押すと画像に対する操作が実行されるようになっています。
image-map の内容はEmacs27の時点では次のようになっています。
(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キーでメニューが表示されるようにしました。
図1: 画像にカーソルを合わせてiを押したところ
(require 'image)
(require 'hydra)
(require 'my-exif)
(require 'my-location)
(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)
(defun my-image-file-at-point ()
(plist-get (cdr (image--get-image)) :file))
(defun my-image-info (file)
(interactive "fImage File: ")
(when (and file (file-exists-p file))
(let* ((fmt (pcase (file-name-extension file)
(_ "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)))
(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* (
(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))
(and time (my-location-latlng-at-time time)))))
(cons time latlng))))
(defun my-image-latlng (file)
(cdr (my-image-timelatlng file)))
(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)))
(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))))
(defun my-image-open-by-app-at-point ()
(interactive)
(when-let ((file (my-image-file-at-point)))
(w32-shell-execute "open" file)))
(defun my-image-edit-by-app-at-point ()
(interactive)
(when-let ((file (my-image-file-at-point)))
(w32-shell-execute "edit" file)))
(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))))
(defun my-shell-command-popup (command output-buffer error-buffer)
"Execute COMMAND and pop up the resulting buffer."
(let* ((kill-buffers
(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でバリバリインライン画像を使っているともっと色々な操作(例えば画像にキャプションを追加したり、属性を設定したり)が欲しくなるのですが、それはここじゃないほうが良いのでしょうね。