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

image-map

;;;  -*- 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))