2023-08-10

画像形式とimage-converterの設定

前回対応する画像形式を詳しく調べたことやimage-diredを色々いじっていたことを踏まえて、Emacsの画像形式に関する設定を更新しました。

;; (Emacs 29.1で確認)

;; 画像のコンバーターとしてImageMagickを使う。
;; GraphicsMagickは対応形式が少なくmp4やpsdに対応していない。
;; FFmpegは動画中心で色々足りない。
;; see: https://misohena.jp/blog/2023-08-09-imagemagick-vs-graphicsmagick-vs-ffmpeg-for-emacs.html
(setq image-converter 'imagemagick) ;; 注意: 変更時は下の拡張子を修正すること。

;; 変換対象の画像形式を登録する。
(let ((target-extensions
       '(;; ImageMagickが対応する形式のうち問題が無さそうなものを適当に残した。
         ;; セキュリティ的にはもっと絞った方が良いというのはある。
         ;; 他人が作ったファイルを不用意に開くべからず。
         ;; 一覧は (image-converter--probe 'imagemagick) で得られる。
         "3g2" "3gp" "ai" "apng" "art" "avi" "avif"
         "bmp" "cr2" "cr3" "cur" "dcm"
         "dcr" "dds" "dng" "dpx" "dxt1" "dxt5"
         "epdf" "epi" "eps" "epsf" "epsi" "ept" "ept2" "ept3" "erf"
         "fits" "fl32" "flif" "flv"
         "fts" "gif"
         "hdr" "heic" "heif" "hrz"
         "icb" "ico" "icon" "iiq" "ipl" "j2c" "j2k" "jbg" "jbig"
         "jng" "jnx" "jp2" "jpc" "jpe" "jpeg" "jpg" "jpm" "jps" "jpt" "k25"
         "kdc" "m2v" "m4v" "mef" "miff"
         "mkv" "mng" "mono" "mov" "mp4" "mpc" "mpeg" "mpg" "mpo" "mrw"
         "mtv" "mvg" "nef" "nrw" "orf" "otb" "otf"
         "pam" "pbm" "pcd" "pcds" "pcl"
         "pct" "pcx" "pdf" "pdfa" "pef" "pfa" "pfb" "pfm"
         "pgm" "pgx" "phm" "picon" "pict" "pix" "pjpeg" "png"
         "pnm"
         "ppm" "ps" "psb" "psd" "ptif" "pwp" "qoi" "raf" "ras"
         "rgf" "rla" "rle" "rmf" "rw2"
         "sfw"
         "sgi" "six" "sixel" "sr2" "srf"
         "sun"
         "svg" "svgz" "tga" "tiff" "tiff64" "tim"
         "tm2" "ttc" "ttf" "vda" "vicar" "viff" "vips"
         "vst" "wbmp" "webm" "webp" "wmv" "wpg" "x3f" "xbm"
         "xcf" "xpm" "xps" "xv")))

  ;; 対象をimage-file-name-extensionsに追加する。
  ;; おそらく本来はこれだけで良いはず。
  (setq image-file-name-extensions
        (seq-union image-file-name-extensions target-extensions))

  ;; いくつか問題があるので、image-converter.el内の変数を直接変更する。
  ;; (Emacs 29.1時点)
  ;;
  ;; 問題:
  ;;
  ;; - image-file-name-extensionsに指定していない形式もコンバーター
  ;;   を使ってimage-modeやcreate-imageで表示できてしまう。
  ;;
  ;; - コンバーターの初回起動に何秒もかかる。コンバーターの対応形式
  ;;   をリストアップするのに時間がかかるので。
  ;;
  ;; - 一度コンバーターが起動すると、image-file-name-extensionsに指
  ;;   定していない形式もimage-diredでサムネイル表示されるようになっ
  ;;   てしまう。
  ;;
  ;; 対応形式をリストアップする前に手動で設定してしまうことで問題を回避する。
  ;; ここはimage-converter.elの実装が変わると変更が必要になるかもしれない。
  (setq image-converter-file-name-extensions target-extensions)
  (setq image-converter-regexp
        (concat "\\." (regexp-opt target-extensions) "\\'"))

  ;; 変換対象の拡張子を持つファイルをimage-modeで開く。
  ;; auto-mode-alistの初期値には
  ;; 「Image file types probably supported by `image-convert'.」
  ;; として既に含まれているものも多いが、全てが登録されているわけではない。
  ;; psdとか。
  ;; auto-image-file-modeでもいいのかもしれない。
  (dolist (ext target-extensions)
    ;; すでにauto-mode-alistに登録されている拡張子は変更しない。
    (unless (assoc-default (format "a.%s" ext) auto-mode-alist 'string-match)
      (push (cons (format "\\.%s\\'" ext) 'image-mode)
            auto-mode-alist))))

;; create-imageでコンバーターを使う。
(setq image-use-external-converter t)

;; ImageMagickのconvertコマンドをmagick convertに置き換える。
;; convertはWindowsで困るので。
(with-eval-after-load "image-converter" ;;image-converter.elが読み込まれてから
  (setf (plist-get (alist-get 'imagemagick image-converter--converters)
                   :command)
        '("magick" "convert")))

;; 2023-08-12追記
;; MP3等対応
;; image-mode等でMP3等をを表示する方法
(defun my-image-convert-ffmpeg (source format)
  (image-converter--convert 'ffmpeg source format))
(image-converter-add-handler "mp3" #'my-image-convert-ffmpeg)
(image-converter-add-handler "m4a" #'my-image-convert-ffmpeg)
;; image-diredでMP3等をサムネイルを表示する方法
(defun my-image-dired-ffmpeg-options (file-ext)
  (pcase file-ext
    ("mp4" ;;動画のサムネイルもffmpegで生成する。
     '("-stream_loop" "-1" ;;短い動画に備えて無限ループさせる。
       "-ss" "30" ;;開始30秒時点のフレームを使う。
       "-i" "%f"
       "-vf" "scale=%w:%h:force_original_aspect_ratio=decrease"
       "-update" "true"
       "-vframes" "1"
       "%t"))
    ((or "mp3" "m4a")
     '("-i" "%f"
       "-vf" "scale=%w:%h:force_original_aspect_ratio=decrease"
       "-vframes" "1"
       "%t"))))
(defun my-image-dired-create-thumb-1-around (orig-func
                                             original-file thumbnail-file)
  (if-let ((ffmpeg-options (my-image-dired-ffmpeg-options
                            (file-name-extension original-file))))
      (let ((image-dired-cmd-create-thumbnail-program "ffmpeg")
            (image-dired-cmd-create-thumbnail-options ffmpeg-options))
        (funcall orig-func original-file thumbnail-file))
    (funcall orig-func original-file thumbnail-file)))
(advice-add 'image-dired-create-thumb-1 :around #'my-image-dired-create-thumb-1-around)

;; 2023-08-12追記
;; image-converterがImageMagickで動画ファイルを変換するときに長時間
;; 固まるのを避ける。
;; 全フレーム読み込もうとしてしまうのだとか!
;; image-diredの方は対策済み。
(defun my-image-converter--convert-magick (old-fun type source image-format)
  ;; ファイル名の後に[0]をつける。data形式の場合は未対応。
  (unless image-format
    (setq source (concat source "[0]")))
  (funcall old-fun type source image-format))
(advice-add 'image-converter--convert-magick :around
            'my-image-converter--convert-magick)

;; 2023-08-12追記
;; image-diredが生成するサムネイルのファイル名を、元画像の場所が分か
;; るような形式にする。
(defun my-image-dired--encode-thumb-name (path)
  "PATHをファイルのベース名として使える文字列へエンコードします。"
  ;; url-hexify-stringは少し問題があるので使えない。
  (mapconcat (lambda (ch)
               ;; 変換元がファイル名なのでパス区切り文字以外は不要だと思
               ;; うが念のため色々エスケープしておく。
               ;; 拡張子を示す.もエスケープして完全にベース名として認識
               ;; されるようにする。
               (if (or (<= ch 32)
                       (memq ch '(?< ?> ?: ?\" ?/ ?\\ ?| ?? ?* ?. ?%)))
                   (format "%%%02x" ch)
                 (char-to-string ch)))
             path))

(defun my-image-dired-thumb-name (old-func file)
  (if (eq 'image-dired image-dired-thumbnail-storage)
      ;; 独自のファイル名を生成する。
      (let* ((orig-path (expand-file-name file))
             (orig-filename (file-name-nondirectory orig-path))
             (orig-dir (file-name-directory orig-path)) ;;最後のスラッシュは含めてしまっていいかな。c:/とかあるし。
             (thumb-filename
              (concat (my-image-dired--encode-thumb-name orig-filename)
                      ".jpg"))
             (thumb-dir
              (expand-file-name (my-image-dired--encode-thumb-name orig-dir)
                                (image-dired-dir))))
        ;; ここでディレクトリを作ってしまうのはあまり良くないけど……
        (unless (file-directory-p thumb-dir)
          (with-file-modes #o700
            (make-directory thumb-dir t)))
        (file-name-concat thumb-dir thumb-filename))
    ;; 本来の関数を呼び出す。
    (funcall old-func file)))
(advice-add 'image-dired-thumb-name :around 'my-image-dired-thumb-name)

加えて以前書いたimage-dired用の設定を適用。

image-diredの改善 | Misohena Blog

特にWindowsでは、サムネイルを作成する際のconvertをmagick convertに置き換えておいた方が良いです。

というわけで、より多様な形式の画像ファイルをEmacsで扱えるようになりました。

image-diredでフォントファイルを表示した例
図1: image-diredでフォントファイルを表示した例

.ttfファイルってImageMagickで画像ファイルに変換できたんですね。

2023-08-09

ImageMagick vs GraphicsMagick vs FFmpeg (Emacsのimage-converter変数にはどれを指定すべきか)

Emacs 29からGraphicsMagick対応が入りました。image系の機能でImageMagick(convertコマンド)を使う箇所がGraphicsMagick(gmコマンド)にも対応した形です。

早速試してみたのですが、image-diredでmp4ファイルのサムネイルが表示できなくなってしまいました(image-diredで多様なファイル形式を扱うには確か色々設定が必要だったと思うのですが、それはまた別の機会に)。どうもImageMagickとGraphicsMagickでは対応している形式に差があるようです。

というわけで、具体的にどのような差があるのか調べてみました。Emacsにはimage-converterという仕組みがあって、Emacsが標準で対応していない形式の画像でも外部のコンバーターを使用して変換し、表示することが出来ます。image-converter.elの中で定義されている image-converter--probe 関数は指定されたコンバーターがサポートする形式をリストアップします。それを使ってみました。

ImageMagickが対応する形式:

(setq image-converter--converters
  '((graphicsmagick :command ("gm" "convert") :probe ("-list" "format"))
    (ffmpeg :command "ffmpeg" :probe "-decoders")
    (imagemagick :command ("magick" "convert") :probe ("-list" "format")))) ;; magickコマンドを使うように修正する(WindowsだとSystem32にconvert.exeがあるので)
(setq im-formats (image-converter--probe 'imagemagick))
("3fr" "3g2" "3gp" "aai" "ai" "apng" "art" "arw" "avi" "avif" "avs" "bayer"
 "bayera" "bgr" "bgra" "bgro" "bie" "bmp" "bmp2" "bmp3" "cal" "cals" "canvas"
 "caption" "cin" "clip" "clipboard" "cmyk" "cmyka" "cr2" "cr3" "crw" "cube"
 "cur" "cut" "data" "dcm" "dcr" "dcraw" "dcx" "dds" "dfont" "djvu" "dng"
 "dpx" "dxt1" "dxt5" "emf" "epdf" "epi" "eps" "epsf" "epsi" "ept" "ept2"
 "ept3" "erf" "farbfeld" "fax" "ff" "file" "fits" "fl32" "flif" "flv"
 "fractal" "ftp" "fts" "ftxt" "g3" "g4" "gif" "gif87" "gradient" "gray"
 "graya" "group4" "hald" "hdr" "heic" "heif" "hrz" "http" "https" "icb" "ico"
 "icon" "iiq" "inline" "ipl" "j2c" "j2k" "jbg" "jbig" "jng" "jnx" "jp2" "jpc"
 "jpe" "jpeg" "jpg" "jpm" "jps" "jpt" "k25" "kdc" "label" "m2v" "m4v" "mac"
 "map" "mask" "mat" "mef" "miff" "mkv" "mng" "mono" "mov" "mp4" "mpc" "mpeg"
 "mpg" "mpo" "mrw" "msl" "msvg" "mtv" "mvg" "nef" "nrw" "null" "orf" "otb"
 "otf" "pal" "palm" "pam" "pango" "pattern" "pbm" "pcd" "pcds" "pcl" "pct"
 "pcx" "pdb" "pdf" "pdfa" "pef" "pes" "pfa" "pfb" "pfm" "pgm" "pgx" "phm"
 "picon" "pict" "pix" "pjpeg" "plasma" "png" "png00" "png24" "png32" "png48"
 "png64" "png8" "pnm" "pocketmod" "ppm" "ps" "psb" "psd" "ptif" "pwp" "qoi"
 "raf" "ras" "raw" "rgb" "rgb565" "rgba" "rgbo" "rgf" "rla" "rle" "rmf"
 "rsvg" "rw2" "scr" "sct" "sfw" "sgi" "six" "sixel" "sr2" "srf" "stegano"
 "strimg" "sun" "svg" "svgz" "text" "tga" "tiff" "tiff64" "tile" "tim" "tm2"
 "ttc" "ttf" "txt" "uyvy" "vda" "vicar" "vid" "viff" "vips" "vst" "wbmp"
 "webm" "webp" "wmf" "wmv" "wpg" "x3f" "xbm" "xc" "xcf" "xpm" "xps" "xv"
 "ycbcr" "ycbcra" "yuv" "r")

ちなみに処理に9.3秒もかかりました。何にそんなにかかっているんだろう。

次いでGraphicsMagickが対応する形式:

(setq gm-formats (image-converter--probe 'graphicsmagick))
("3fr" "8bim" "8bimtext" "8bimwtext" "app1" "app1jpeg" "art" "arw" "avif"
 "avs" "b" "bie" "bigtiff" "bmp" "c" "cals" "caption" "cin" "clipboard"
 "cmyk" "cmyka" "cr2" "crw" "cur" "cut" "dcm" "dcr" "dcx" "dng" "dpx" "emf"
 "epdf" "epi" "eps" "epsf" "epsi" "ept" "ept2" "ept3" "erf" "exif" "fax"
 "file" "fits" "fractal" "g" "gif" "gif87" "gradient" "gray" "graya" "heic"
 "heif" "hrz" "http" "icb" "icc" "icm" "ico" "icon" "identity" "image" "iptc"
 "iptctext" "iptcwtext" "j2c" "jbg" "jbig" "jng" "jnx" "jp2" "jpc" "jpeg"
 "jpg" "k" "k25" "kdc" "label" "m" "mac" "map" "mat" "mef" "miff" "mng"
 "mono" "mpc" "mrw" "msl" "mtv" "mvg" "nef" "null" "o" "orf" "otb" "p7" "pal"
 "palm" "pam" "pbm" "pcd" "pcds" "pct" "pcx" "pdb" "pdf" "pef" "pfa" "pfb"
 "pgm" "pgx" "picon" "pict" "pix" "plasma" "png" "png00" "png24" "png32"
 "png48" "png64" "png8" "pnm" "ppm" "ps" "ptif" "pwp" "r" "raf" "ras" "rgb"
 "rgba" "rla" "rle" "sct" "sfw" "sgi" "sr2" "srf" "stegano" "sun" "svg"
 "svgz" "text" "tga" "tiff" "tile" "tim" "topol" "ttf" "txt" "uyvy" "vda"
 "vicar" "vid" "viff" "vst" "wbmp" "webp" "wmf" "wmfwin32" "wpg" "x3f" "xbm"
 "xc" "xcf" "xmp" "xpm" "xv" "y" "yuv")

こちらは3.3秒です。

対応フォーマット数の比較:

(list (list "ImageMagick" "GraphicsMagick")
      'hline
      (list (length im-formats) (length gm-formats)))
ImageMagick GraphicsMagick
238 172

どちらにもあるもの:

(seq-intersection im-formats gm-formats)
("3fr" "art" "arw" "avif" "avs" "bie" "bmp" "cals" "caption" "cin"
 "clipboard" "cmyk" "cmyka" "cr2" "crw" "cur" "cut" "dcm" "dcr" "dcx" "dng"
 "dpx" "emf" "epdf" "epi" "eps" "epsf" "epsi" "ept" "ept2" "ept3" "erf" "fax"
 "file" "fits" "fractal" "gif" "gif87" "gradient" "gray" "graya" "heic" "heif"
 "hrz" "http" "icb" "ico" "icon" "j2c" "jbg" "jbig" "jng" "jnx" "jp2" "jpc"
 "jpeg" "jpg" "k25" "kdc" "label" "mac" "map" "mat" "mef" "miff" "mng" "mono"
 "mpc" "mrw" "msl" "mtv" "mvg" "nef" "null" "orf" "otb" "pal" "palm" "pam"
 "pbm" "pcd" "pcds" "pct" "pcx" "pdb" "pdf" "pef" "pfa" "pfb" "pgm" "pgx"
 "picon" "pict" "pix" "plasma" "png" "png00" "png24" "png32" "png48" "png64"
 "png8" "pnm" "ppm" "ps" "ptif" "pwp" "raf" "ras" "rgb" "rgba" "rla" "rle"
 "sct" "sfw" "sgi" "sr2" "srf" "stegano" "sun" "svg" "svgz" "text" "tga"
 "tiff" "tile" "tim" "ttf" "txt" "uyvy" "vda" "vicar" "vid" "viff" "vst"
 "wbmp" "webp" "wmf" "wpg" "x3f" "xbm" "xc" "xcf" "xpm" "xv" "yuv" "r")

これらはどちらでもサポートされます。

ImageMagickにだけあるもの:

(seq-difference im-formats gm-formats)
("3g2" "3gp" "aai" "ai" "apng" "avi" "bayer" "bayera" "bgr" "bgra" "bgro"
 "bmp2" "bmp3" "cal" "canvas" "clip" "cr3" "cube" "data" "dcraw" "dds"
 "dfont" "djvu" "dxt1" "dxt5" "farbfeld" "ff" "fl32" "flif" "flv" "ftp" "fts"
 "ftxt" "g3" "g4" "group4" "hald" "hdr" "https" "iiq" "inline" "ipl" "j2k"
 "jpe" "jpm" "jps" "jpt" "m2v" "m4v" "mask" "mkv" "mov" "mp4" "mpeg" "mpg"
 "mpo" "msvg" "nrw" "otf" "pango" "pattern" "pcl" "pdfa" "pes" "pfm" "phm"
 "pjpeg" "pocketmod" "psb" "psd" "qoi" "raw" "rgb565" "rgbo" "rgf" "rmf"
 "rsvg" "rw2" "scr" "six" "sixel" "strimg" "tiff64" "tm2" "ttc" "vips" "webm"
 "wmv" "xps" "ycbcr" "ycbcra")

GraphicsMagickにだけあるもの:

(seq-difference gm-formats im-formats)
("8bim" "8bimtext" "8bimwtext" "app1" "app1jpeg" "b" "bigtiff" "c" "exif" "g"
 "icc" "icm" "identity" "image" "iptc" "iptctext" "iptcwtext" "k" "m" "o"
 "p7" "topol" "wmfwin32" "xmp" "y")

うーん、やはりmp4など動画系のファイルはImageMagickじゃないと対応していないみたいですね。GraphicsMagick Supported Formatsを見てもmp4はありません。地味にpsdがImageMagickのみというのは大きいです。

ということで私はImageMagickを使うように戻しました。Windowsだとinit.elに多少ごちゃごちゃ書かないといけませんが、その程度は我慢します。GraphicsMagickに対応する前にImageMagick7(magickコマンド)に対応してほしいと思うのは私だけでしょうか……。

ちなみにコンバーターとしてはffmpegも直接指定出来ます。そちらも軽く調べてみましょう。

FFmpegが対応する形式:

(image-converter--probe 'ffmpeg)
("012v" "4xm" "8bps" "aasc" "agm" "aic" "alias_pix" "amv" "anm" "ansi" "apng"
 "arbc" "argo" "asv1" "asv2" "aura" "aura2" "libdav1d" "libaom" "av1"
 "av1_cuvid" "av1_qsv" "avrn" "avrp" "avs" "avui" "ayuv" "bethsoftvid" "bfi"
 "binkvideo" "bintext" "bitpacked" "bmp" "bmv_video" "brender_pix" "c93"
 "cavs" "cdgraphics" "cdtoons" "cdxl" "cfhd" "cinepak" "clearvideo" "cljr"
 "cllc" "eacmv" "cpia" "cri" "camstudio" "cyuv" "dds" "dfa" "dirac" "dnxhd"
 "dpx" "dsicinvideo" "dvvideo" "dxa" "dxtory" "dxv" "escape124" "escape130"
 "exr" "ffv1" "ffvhuff" "fic" "fits" "flashsv" "flashsv2" "flic" "flv" "fmvc"
 "fraps" "frwu" "g2m" "gdv" "gem" "gif" "h261" "h263" "h263i" "h263p" "h264"
 "h264_qsv" "h264_cuvid" "hap" "hdr" "hevc" "hevc_qsv" "hevc_cuvid"
 "hnm4video" "hq_hqa" "hqx" "huffyuv" "hymt" "idcinvideo" "idf" "iff" "imm4"
 "imm5" "indeo2" "indeo3" "indeo4" "indeo5" "interplayvideo" "ipu" "jpeg2000"
 "libopenjpeg" "jpegls" "jv" "kgv1" "kmvc" "lagarith" "loco" "lscr" "m101"
 "eamad" "magicyuv" "mdec" "media100" "mimic" "mjpeg" "mjpeg_cuvid"
 "mjpeg_qsv" "mjpegb" "mmvideo" "mobiclip" "motionpixels" "mpeg1video"
 "mpeg1_cuvid" "mpeg2video" "mpegvideo" "mpeg2_qsv" "mpeg2_cuvid" "mpeg4"
 "mpeg4_cuvid" "msa1" "mscc" "msmpeg4v1" "msmpeg4v2" "msmpeg4" "msp2" "msrle"
 "mss1" "mss2" "msvideo1" "mszh" "mts2" "mv30" "mvc1" "mvc2" "mvdv" "mvha"
 "mwsc" "mxpeg" "notchlc" "nuv" "paf_video" "pam" "pbm" "pcx" "pfm" "pgm"
 "pgmyuv" "pgx" "phm" "photocd" "pictor" "pixlet" "png" "ppm" "prores"
 "prosumer" "psd" "ptx" "qdraw" "qoi" "qpeg" "qtrle" "r10k" "r210" "rasc"
 "rawvideo" "rl2" "roqvideo" "rpza" "rscc" "rv10" "rv20" "rv30" "rv40" "sanm"
 "scpr" "screenpresso" "sga" "sgi" "sgirle" "sheervideo" "simbiosis_imx"
 "smackvid" "smc" "smvjpeg" "snow" "sp5x" "speedhq" "srgc" "sunrast"
 "librsvg" "svq1" "svq3" "targa" "targa_y216" "tdsc" "eatgq" "eatgv" "theora"
 "thp" "tiertexseqvideo" "tiff" "tmv" "eatqi" "truemotion1" "truemotion2"
 "truemotion2rt" "camtasia" "tscc2" "txd" "ultimotion" "utvideo" "v210"
 "v210x" "v308" "v408" "v410" "vb" "vble" "vbn" "vc1" "vc1_qsv" "vc1_cuvid"
 "vc1image" "vcr1" "xl" "vmdvideo" "vmnc" "vnull" "vp3" "vp4" "vp5" "vp6"
 "vp6a" "vp6f" "vp7" "vp8" "libvpx" "vp8_cuvid" "vp8_qsv" "vp9" "libvpx"
 "vp9_cuvid" "vp9_qsv" "vqc" "wbmp" "wcmv" "webp" "wmv1" "wmv2" "wmv3"
 "wmv3image" "wnv1" "wrapped_avframe" "vqavideo" "xan_wc3" "xan_wc4" "xbin"
 "xbm" "xface" "xpm" "xwd" "y41p" "ylc" "yop" "yuv4" "zerocodec" "zlib"
 "zmbv")

数こそ多いもののやはり動画系が中心のようです。画像コンバーターとしてffmpegだけを指定するのはあまりおすすめ出来なそうです。

全部のコンバーターを切り替えて使えば良さそうにも思えますが、基本的にはimage-converter.elはそのようには出来ていないようです。image-converter-add-handler関数を使って逐一登録すればおそらく可能だとは思いますが。


余談ですが、とうとう長年使っていたCygwinを止めてMSYS2に統一しました。FFmpegやGraphicsMagickもパッケージとして登録されていますし。ノートPCの方ではMSYS2だけにしていて特に問題が無かったので。EmacsもMSYS2のを使えば良いかなと思っていたのですが、先日MSYS2版のEmacsにトラブルがあって以来、ノートPCの方でも公式ビルドを使っています。

image-diredでDiredの中に多様な形式の画像をサムネイル表示する方法についてですが、Emacs起動直後には標準で対応している形式しか表示できず、コンバーターを一回でも使った後は表示できるようになるようです(何か私がおかしな設定をしているのでなければ)。これは、image-diredが表示できる形式かどうかを (image-file-name-regexp) が返す正規表現でチェックしているからです。image-file-name-regexp関数は内部でimage-converter-file-name-extensionsという変数を参照しているのですが、その変数は何かimage-converter.el内の関数を呼ぶまでnilのままだからです。init.elで呼び出して初期化してやろうにも、上記の通り9秒もかかったりするのでおいそれとはできません。まぁ、その辺りがちゃんと初期化していない理由なのかもしれません。手動で必要な拡張子だけinit.elで設定するのが現実的かもしれません。

2023-08-06 ,

org-inline-image-fixのEmacs 29対応

先日も書いたように、Emacs 29に移行したらorg-modeで警告が繰り返し沢山出るようになった。

⛔ Warning (emacs): Redefining ‘file-exists-p’ might break native compilation of trampolines.
⛔ Warning (emacs): Redefining ‘expand-file-name’ might break native compilation of trampolines.

file-exists-pexpand-file-name を再定義? そんなことしてないだろう……と思ったが、ふと思い当たってorg-datauri-image.elorg-http-inline-image.elを無効化したら治まった。

これらはorg-inline-image-fixの中にあるEmacs Lispで、 [[data:[[http:[[https: で始まるリンクをインライン画像表示するためのものだ。それをorg-flyimage.elを使ってfont-lockのタイミングで自動的に即事画像化しているので、警告が繰り返し沢山出るというわけだ。

misohena/org-inline-image-fix: A collection of fixes related to the image display feature in org-mode

それらのEmacs Lispは、cl-letfを使ってインライン画像表示関数(org-display-inline-images)の中にいる間だけそこから呼び出される各種関数の挙動を変更し、無理矢理機能を実現している。その挙動を変更した関数の中にfile-exists-pやexpand-file-nameといったC言語で実装された関数があるため、何らかの理由でnative compilationと相性が悪いのだろう。

この方法はかなり強引だが、結果的にはうまく行った。過去何回かのorg-modeのバージョンアップに伴いorg-display-inline-images関数には度々変更が加えられたが、これらのEmacs Lispは何も変更せずに動作し続けた。もしorg-display-inline-imagesの一部をコピーした新しい関数を作成してそれに置き換えたりしていたら、org-modeのバージョンアップに伴い度々変更を取りこむ必要があったことだろう。もちろんこれはたまたま変更箇所が衝突しなかったということであり運が良かっただけとも言えるのだが、その賭けに私は勝ったわけだ。

しかし今、そのcl-letfを使う方法は封じられた。org-display-inline-images関数は一つの関数の中で多くのことをやり過ぎている。単純なadviceの追加ではどうにもならない。もはやorg-display-inline-images関数をコピーして、バラバラに切り刻み、よりカスタマイズしやすい形に再構成するしか道は無いように思える。

というわけで作成したのがorg-better-inline-images.elだ。これはorg-display-inline-images関数をよりカスタマイズしやすいものに置き換える。

そしてorg-datauri-image.elとorg-http-inline-image.elはそれを使うように書き替えた。

それによってEmacs 29でも警告が出ずにdata、http、httpsのリンクをインライン画像表示できるようになった。その代わり、org-modeのバージョンアップに伴うorg-display-inline-images関数の変化に注視し、必要な変更を取りこむ負担を負うことにもなったわけだ。

めでたしめでたし。

ちなみにorg-ytというパッケージがある。YouTubeリンクを実現するためのものだが、インライン画像表示にも対応している。ytリンクタイプのインライン画像表示は、org-display-inline-images関数に:after adviceを仕込むことで実現している。更新範囲の走査が二回になってしまうのが多少気になるところだ。また、結局はorg-display-inline-imagesの一部をコピーしたorg-image-update-overlayという関数を作成しているので、org-display-inline-imagesの変化に追従していく手間は避けられないだろう。一方で、ytリンクタイプに限らず任意のリンクタイプをサポートするための枠組みを提供しているのは興味深い点だ。org-modeが元々そのような仕組みを提供していたら皆ここまで悩まずに済んだことだろう(ただし、org-ytはdescription部分の画像リンクには対応していないように見える)。

2023-07-31

MS-Windows版 Emacs 29.1への移行作業

Emacs 29.1がリリースされたと聞いてファイル置き場を覗いてみたらまだWindows版が置いておらず、1日くらい待ってたまにはビルドしようかなーとソースコードを取りに行ったらすでにWindows版のバイナリが置いてありました。仕事が速いですね。

最近はIMEパッチも使っていないのでビルドする機会がほとんど無くなってしまいました。まぁ、自分でビルドしたら色々良いこともあるとは思いますが。細かい不具合を好きなだけ直せたりとかね!

それで一応移行作業をしたので以下その記録です。

1.ダウンロード

https://ftp.gnu.org/gnu/emacs/

  • emacs-29.1.zip
  • emacs-29.1.tar.xz (展開してfind-function-C-source-directory変数に指定し、describe-functionからソースコードを追えるようにするため)

2.zipを展開して適当な場所に置く

3.起動してみる

パッと見問題無し。

4.補う必要のあるファイルを確認する

  • 相変わらずlibgccjit関連のファイルは含まれていないのでネイティブコンパイルはそのままでは出来ない。
  • gdk_pixbufのloadersもないので、SVG内のimage要素も表示されない。

5.MSYS2で必要なファイルを取り寄せる

あ、MSYS2はucrt64環境に移行してしまったのでmingw64環境のファイルは無いんだった。パッケージアーカイブから直接ダウンロードすることも出来るかもしれないけど、面倒なのでMSYS2環境からインストールしてしまう。

pacman -S mingw-w64-x86_64-libgccjit
pacman -S mingw-w64-x86_64-gdk-pixbuf2

6.SVG内の画像要素を表示できるようにする

まずは簡単な方から。 msys64/mingw64/lib/gdk-pixbuf-2.0 ディレクトリを emacs-29.1/lib/ へコピー。これでSVG内のimage要素は表示できた。 loaders.cache については何もしなくて大丈夫だった。画像形式によっては追加の依存ファイルがあるかも? とりあえずjpgとpngは問題なし。

(以前も書いたが、SVGの描画はlibrsvgが行っており、librsvgはlibgdk_pixbufのローダーライブラリを使用して画像を読み込むので、これらのファイルが無いとSVG内に画像が表示されない。Emacsがjpgやpngを描画する仕組みとSVG内にjpgやpngを描画する仕組みは全然別物なのだ。用途としてはel-easydrawの画像ツール)

7.ネイティブコンパイルできるようにする

次のファイルをコピー。

  • emacs-29.1/binへ
    • msys64/mingw64/binから
      • libgccjit-0.dll
      • libisl-23.dll
      • libmpc-3.dll
      • libmpfr-6.dll
  • emacs-29.1/lib/gccへ
    • msys64/mingw64/binから
      • as.exe
      • ld.exe
    • msys64/mingw64/libから
      • crtbegin.o
      • crtend.o
      • dllcrt2.o
      • libadvapi32.a
      • libgcc_s.a
      • libkernel32.a
      • libmingw32.a
      • libmingwex.a
      • libmoldname.a
      • libmsvcrt.a
      • libpthread.a
      • libshell32.a
      • libuser32.a
    • msys64/mingw64/lib/gcc/x86_64-w64-mingw32/13.1.0/から
      • libgcc.a

.aや.oは全部必要なのか、また、不足するものが無いのかは確認していない。

./emacs.d/early-init.el には次のように設定してあるが、あまり覚えていないので正しいかは知らない。

(when (and (fboundp #'native-comp-available-p) ;;emacs-28以降
           (native-comp-available-p) ;;libgccjitが使える
           (eq system-type 'windows-nt)) ;;Windowsの場合 (他必要に応じて条件を追加すること)

  ;; コンパイル用にemacsを起動する関数をラップし、
  ;; カレントディレクトリを一時的に変更する
  (defun my-comp-set-env-and-call (orig-fun &rest args)
    ;; 一時的にカレントディレクトリを emacs-28.1/bin にする
    ;; でないと emacs-28.1/lib/gcc/as.exe を見つけてくれない
    ;; また、emacs-async-comp-*.elというファイルをあちこちに生成してしまう。
    (let ((default-directory invocation-directory))
      ;; 元の関数を呼び出す
      (apply orig-fun args)))

  (advice-add #'comp-final :around #'my-comp-set-env-and-call)
  (advice-add #'comp-run-async-workers :around #'my-comp-set-env-and-call)

  ;; ライブラリの位置を指定する
  (setq native-comp-driver-options (list "-B" (expand-file-name (file-name-concat invocation-directory "../lib/gcc")) )))

8.org-datauri-image.elとorg-http-inline-image.elを無効化する

次のような警告が沢山出て何かと思ったら自分で書いたクソコードが火を噴いただけだった。

⛔ Warning (emacs): Redefining ‘file-exists-p’ might break native compilation of trampolines.
⛔ Warning (emacs): Redefining ‘expand-file-name’ might break native compilation of trampolines.

cl-letfで一時的にsymbol-function書き替えたから。

そのうち書き直したい。

2023-04-17

新しいマウスを購入(Logicool M750)

一昨日、昨日と新しいマウスを購入した。

これまで使っていたMX Anywhere 2の左ボタンが連打されるようになってしまったからだ。ウィンドウ移動時に最大化されてしまったりあちこちで誤操作して困っていた。ちょっと前にクッキークリッカーで高橋名人バリの連射をしたのが寿命を縮めたのだろうか?

順当に行けば代わりは後継機のMX Anywhere 3なのだろうけど、このマウスはちょっと高い(Amazonで11000円くらい)。それにこれまで2を使ってきて不満も無いわけでは無い。一番はバッテリー。バッテリーがすぐに切れてしまうのでしょっちゅう有線マウス状態で使っていた。ちなみに私は無線マウスにそれほど価値を感じていない。机の上で使っている分には線が付いていようがいまいが操作性に差は無いからだ。ただ、接続が楽なこととPCを引き出すときにケーブルが引っかからないのは良い所だろう。充電だけならテーブルの上に出してあるテーブルタップに繋げれば良いが、机の下のPCに繋げるとなると多少配線に苦労する。自宅のデスクトップ専用のマウスなのでマルチペアリングや軽量性は必要ない。あまりUSBポートにドングルばかり挿したくないのでBluetoothが良い。専用ドングルのみだと困る。左右チルトは使っていない。そう考えると何も後継機にこだわる必要は無いだろう。

そうしてWeb上で新しいマウスを探して目を付けたのがM650。安いマウスでも十分だとは思ったが変なものに当たって何度も買い直すようだと困る(結果的には買い直したがw)。信頼の置ける同じメーカーということでロジクールの中から一番無難そうなM650にした。近所の量販店に行ったついでに購入。意外なことに通販とほとんど変わらない値段だった。

ロジクール Signature M650MOW ワイヤレスマウス

単三乾電池一本で長期間動くのでバッテリー劣化で悩む心配は無い。握りやすさも問題ない。LサイズもあったがMサイズにした。手は大きい方だが、小さめなマウスを指先でちょこちょこ動かしたいので。そういう意味ではこれ以上大きいと困るギリギリのサイズ。モバイル用途ならもう少し小さいものを選びたいところ。ボタンは静音仕様だがクリック感に問題は無い。ホイールを回したときのクリック感も柔らかいがしっかりとある。接続性も問題なし。

しかし実際に使ってすぐに気がついたのが専用の中ボタンが無いということだ。私は中ボタンをよく使うのでMX Anywhere 2ではホイール下のジェスチャーボタンを中ボタンにして使っていた。しかしこのM650にはホイール下に独立したボタンが無い。もちろんホイールはクリックできて中ボタンとして機能する。しかし硬いので押しづらい。ホイールの回転は柔らかいので押そうとすると先にホイールが回ったりもする。長いことMX Anywhere 2を使っている間にこういう問題があったことをすっかり忘れてしまっていた。

el-easydrawにスクロール機能を付けたとき、私は中ボタンドラッグをスクロールに割り当てた。この手のソフトではよく見る操作体系だが私はあまり好きでは無くPhotoshopと同じSPACE+ドラッグが好きだったりする。しかしEmacsではSPACEをmodifierとして使う方法が無いので仕方なく中ドラッグにしたのだった(代わりにSPACEでスクロール・ズームモードになる機能も追加したがモード切替はやはり少々使いづらい)。試しにel-easydrawでスクロールしてみたが、やはりボタンが硬くてスクロールしづらい。ホイールも微妙に回ってしまうので何だか指先が気持ち悪い。

実はM650の上位機種であるM750にはホイールの下に中央ボタンがついているのだった。デフォルトでは速度切り替えボタンになっているが中ボタンに割り当てることも出来る。全体的な形はM650と同じで機能が増えてわずかに重くなっている程度だ。

Logicool Signature M750MOW ワイヤレスマウス

というわけで、かなり勿体ないような気もしたがM750を追加で購入した。中央ボタンの位置がMX Anywhere 2と比べてやや手前でわずかに押しづらくはあるが、まぁ、それほど大きな問題では無い。M650よりは大幅に楽に中ボタンが押せるようになった。ホイールのボタンの方はタブを閉じる操作に割り当てた。こりゃ便利だ。

ホイール(M650、M750で違いは無い)の回転は柔らかいクリック感がありMX Anywhere 2のようなフリースピン切り替えは無いが、フリーモードとクリックモードの中間といったところ。SmartWheelという機能でゆっくり回したときと高速に回したときに挙動が変わるが、かなり自然な動きになっている。ホイールをびゃーっとはじいたときはちゃんとそれらしい動きをする。中間くらいの動きで時々アレ?とわずかに違和感を覚えることもあるが、今のところ実用上特に問題は無い。

全体的にこれまでのMX Anywhere 2と比べて大きな問題は無く、コストパフォーマンスの高いマウスだと感じた。

2023-04-16 , ,

PowerShellからWindows Searchで検索する

el-winsearchからadoquery.exeを起動するのが嫌なのでPowerShellからWindows Searchを実行する方法を調べた。次のようにすれば良いらしい。

$conn = New-Object -ComObject ADODB.Connection
$conn.Open("Provider=Search.CollatorDSO;Extended Properties='Application=Windows';")
$query = "SELECT TOP 10 System.ItemUrl FROM SystemIndex WHERE System.Kind = 'picture'"
$rs = New-Object -ComObject ADODB.Recordset
$rs.Open($query, $conn)
While(-Not $rs.EOF){
  # 2023-04-18: 訂正
  Write-Output ($rs.Fields[0].Value -replace '^file:','');
  $rs.MoveNext()
}
$rs.Close()
$conn.Close()

System.ItemPathDisplayではなくSystem.ItemUrlを使うのは C:\ユーザー\ のようなローカライズされたパス名が出てきて都合が悪いから。しかしSystem.ItemUrlを使うと頭に file: が付いてしまうのでそれは出力前に削除している。

これをセミコロン区切りで1行にしてpowershellの-Commandオプションで実行することも出来る。スクリプトファイルにすると色々面倒なこともあるので。-Commandオプションで実行する場合は実行ポリシーなどは関係ないのだろうか。よく知らない。とりあえず手元では動いている。

というわけでel-winsearchはもはや専用のexeを必要としなくなった。 file: の部分も無くなったのでconsult-winsearchから使ったときにEmbarkやMarginaliaも正しく動くようになった。

consult-winsearchを使ったときにVerticoでtruncate-linesがtにならない問題に遭遇したが、検索オプションの書き方をpromptに無理矢理載せたことと、vertico–resize-windowが改行のあるpromptを考慮していないのが原因のようだ。次のように修正した。

;; truncate-linesにする条件が不完全なのを直す。
(with-eval-after-load 'vertico
  (cl-defgeneric vertico--resize-window (height)
    "Resize active minibuffer window to HEIGHT."
    (setq-local truncate-lines (<
                                ;; 旧:(point)
                                ;; ↑ここを修正した。
                                ;; 横に長いpromptで切り詰め表示すると入力がウィンドウ幅を超えたときに検索結果も水平スクロールされてしまうのを防止しているのだと思う。
                                ;; しかし(point)では改行や全角を考慮していない。
                                ;; 新:
                                (string-width
                                 (buffer-substring
                                  (let ((inhibit-field-text-motion t))
                                    (line-beginning-position))
                                  (point)))
                                ;;以下元のまま
                                (* 0.8 (vertico--window-width)))
                resize-mini-windows 'grow-only
                max-mini-window-height 1.0)
    (unless (frame-root-window-p (active-minibuffer-window))
      (unless vertico-resize
        (setq height (max height vertico-count)))
      (let* ((window-resize-pixelwise t)
             (dp (- (max (cdr (window-text-pixel-size))
                         (* (default-line-height) (1+ height)))
                    (window-pixel-height))))
        (when (or (and (> dp 0) (/= height 0))
                  (and (< dp 0) (eq vertico-resize t)))
          (window-resize nil dp nil nil 'pixelwise))))))
2023-04-13

image-diredの改善

(2023-08-08追記: Emacs 29.1に合わせてコードを修正しました)

皆さんはimage-dired使ってますか? 私は使っていませんでした。だって大量の画像を扱える専門のソフトがあるのにわざわざEmacsでやる必要なんて無いじゃないですか。Diredから外部ビューアを起動して後はそっちでやっていたのです。

しかし有名なビューアをいくつか使ってきましたが常にどこか不満を感じていました。似たようなソフトが沢山乱立している状況を見るに、それだけ皆を満足させるのは難しいということなのかもしれません。

やりたいことは、大量の画像(数千枚で似たような画像も沢山ある)の中から良さそうなものを選び出し、タグ付けしたりコメントを書いたりして整理する作業です。その後にその情報を使用してレポートを作ったりするわけです。単に画像が見られれば良いのではありません。もちろんそのような機能を持つビューアはあります。しかし自分に合ったキー操作で効率的にできるものはなかなか見つかりません。ほんの些細な機能が無くて不満を抱くケースも多いです。

自分で作れば良いのかもしれませんが(単に見るだけの特定の用途のためのものなら以前作りました)、編集機能を有するものを0から作るのもなかなか大変です。

色々な方法があるとは思いますが、今の私が一番気軽に扱えるのは結局Emacsなのでimage-diredを改良して少しは使いやすくなればと思い色々いじってみました。

Windowsでの設定

image-diredを使うにはImageMagickが必要です。WindowsではCygwinなりMSYS2なり公式ビルドなりwingetなり好きな方法でインストールすることが可能でしょう。私はデスクトップPCではCygwin、ノートではMSYS2のものを使っています。

ここで良くあるトラブルが間違ったconvertコマンドを参照してしまうということです。Windowsには c:/Windows/System32/convert.exe というコマンドがあるのでPATHの設定次第ではそちらが優先されてしまいます。

絶対パスで指定し直しても良いのですが、私は次のようにしてconvertコマンドの代わりにmagickコマンドを使うようにしてみました。

(when (eq system-type 'windows-nt)
  (with-eval-after-load "image-dired"
    (setq image-dired-cmd-create-thumbnail-program "magick"
          image-dired-cmd-create-temp-image-program "magick")
    (unless (equal (car image-dired-cmd-create-thumbnail-options) "convert")
      (push "convert" image-dired-cmd-create-thumbnail-options))
    (unless (equal (car image-dired-cmd-create-temp-image-options) "convert")
      (push "convert" image-dired-cmd-create-temp-image-options))))

magick convertmagick はImageMagickのv6構文とv7構文の違いらしくそこまで大きく変わらないらしいので単に ~-programを magick にするだけでも大丈夫なのかもしれませんが、念のため ~-optionsの頭に convert を追加しています。

それにしてもWindowsにせよImageMagickにせよconvertというコマンド名はなかなか酷いですね。コマンドラインなんてだいたいの処理は何かしら変換するものでしょうに。ちなみにWindowsのconvertコマンドはFATボリュームをNTFSにするんだそうです。私は一回も使ったことがありません。

(dired内)サムネイルの幅を揃えて、右に空白を入れ、境界線を引く

image-diredはdiredバッファの中に直接サムネイルを表示できます。画像ファイルの上で(または複数マークしてから)C-t C-tと押すとファイル名の直前にサムネイル画像が表示されます。

仕組みとしては、まずサムネイル画像を参照するオーバーレイをDiredバッファに挿入してから(黒い正方形の四角が表示される)、非同期でサムネイルを作成するプロセスを起動し、完了したらEmacsの画像キャッシュをフラッシュすることで正しいサムネイルが表示されるという流れになっています。サムネイルはデフォルトでは ~/.emacs.d/image-dired/ 以下に作られるようです。最初から既にサムネイルがある場合はすぐに表示されます。

やってみると分かるのですが、確かにサムネイルは表示されるのですがサムネイル画像の幅が揃っていません。また、その後に続くファイル名との間に空白が無く完全にくっついてしまっています。そして境界線が無いので、Emacs内の背景色と同じ色(私の場合黒)が主体の画像だと画像の輪郭が把握できません。

Diredバッファ内にサムネイルを表示させた様子
図1: Diredバッファ内にサムネイルを表示させた様子

次のコードはそれを解決するものです。

(defun my-image-dired-dired-toggle-marked-thumbs (&optional arg)
  ;; Derived from `image-dired-dired-toggle-marked-thumbs'
  "Toggle thumbnails in front of file names in the Dired buffer.
If no marked file could be found, insert or hide thumbnails on the
current line.  ARG, if non-nil, specifies the files to use instead
of the marked files.  If ARG is an integer, use the next ARG (or
previous -ARG, if ARG<0) files."
  (interactive "P")
  (dired-map-over-marks
   (my-image-dired-dired-set-thumb-visibility 'toggle) ;;ファイル毎の処理を分離
   arg             ; Show or hide image on ARG next files.
   'show-progress) ; Update dired display after each image is updated.
  (add-hook 'dired-after-readin-hook
            'image-dired-dired-after-readin-hook nil t))

(defun my-image-dired-dired-set-thumb-visibility (visibility)
  ;; Derived from `image-dired-dired-toggle-marked-thumbs'
  (let ((image-pos  (dired-move-to-filename))
        (image-file (dired-get-filename nil t)))
    (when (and image-file
               (string-match-p (image-file-name-regexp) image-file))
      (let* ((thumb-file
              ;; Emacs 28まで
              ;;(image-dired-get-thumbnail-image image-file)
              ;; Emacs 29から
              (create-image
               (image-dired--get-create-thumbnail-file image-file)))
             (thumb-ov (cl-loop for ov in (overlays-in (point) (1+ (point)))
                                if (overlay-get ov 'thumb-file) return ov)))
        ;; 後述の改良のためにトグル以外もできるようにした
        (if thumb-ov
            (when (memq visibility '(nil toggle))
              (delete-overlay thumb-ov))
          (when (memq visibility '(t toggle))
            (my-image-dired-dired-create-thumbnail-overlay
             image-pos image-file thumb-file)))))))

(defun my-image-dired-dired-create-thumbnail-overlay (image-pos image-file thumb-file)
  ;; Derived from `image-dired-dired-toggle-marked-thumbs'
  (let ((overlay (put-image
                  ;; 枠線を付加
                  (append thumb-file (list :relief 1))
                  image-pos)))
    (overlay-put overlay 'image-file image-file)
    (overlay-put overlay 'thumb-file thumb-file)
    ;; 幅を揃える
    (my-image-dired-dired-update-thumbnail-overlay overlay thumb-file)
    overlay))

(defun my-image-dired-dired-update-thumbnail-overlay (ov image)
  (when-let ((image-file (plist-get (cdr image) :file)))
    (let* ((image-exists-p (file-exists-p image-file))
           (image-size (image-size image t)) ;;float?
           (space-w
            (if image-exists-p
                ;; Emacs 28まで
                ;;(- image-dired-thumb-width (car image-size))
                ;; Emacs 29から
                (- image-dired-thumb-size (car image-size))
              0))
           (space-left (ceiling (/ space-w 2)))
           (space-right (+ 10 ;;space after thumbnail
                           (- space-w space-left))))
      (overlay-put ov 'before-string
                   ;; 元々のbefore-stringの前後にマージン(スペース)を入れる
                   (concat
                    (propertize "_" 'display `(space :width (,space-left)))
                    (overlay-get ov 'before-string)
                    (propertize "_" 'display `(space :width (,space-right))))))))

(with-eval-after-load "dired"
  (define-key dired-mode-map [remap image-dired-dired-toggle-marked-thumbs] 'my-image-dired-dired-toggle-marked-thumbs))

元の image-dired-dired-toggle-marked-thumbs は、サムネイル画像の取得からオーバーレイの作成、削除までをすべてこの中だけで行ってしまいます。オーバーレイ作成部分だけを書き替えるのは難しいため、大人しく関数全体を独自のものに差し替えて解決することにしました。

(dired内)サムネイルを一括で表示/非表示する

C-t C-tは現在のポイントにあるファイルか、またはマークしたファイルをサムネイル表示します。全ての画像を一括で表示するにはいちいち全マークしなければなりません。それにこれはtoggle動作です。一部をすでにサムネイル表示した後に全画像をマークしてC-t C-tすると今表示されているものは消えてしまいます。単純に全画像ファイルのサムネイルを一括で表示したり消したりしたいです。

次のコードはそれを実現するための三つ(全表示、全消去、トグル)のコマンドを定義します。

(defun my-image-dired-dired-toggle-all-thumbs ()
  (interactive)
  (if (cl-loop for ov in (overlays-in (point-min) (point-max))
               when (overlay-get ov 'thumb-file) return t)
      (my-image-dired-dired-hide-all-thumbs)
    (my-image-dired-dired-show-all-thumbs)))

(defun my-image-dired-dired-hide-all-thumbs ()
  (interactive)
  (cl-loop for ov in (overlays-in (point-min) (point-max))
           when (overlay-get ov 'thumb-file)
           do (delete-overlay ov)))

(defun my-image-dired-dired-show-all-thumbs (&optional hide)
  (interactive "P")
  (if hide
      (my-image-dired-dired-hide-all-thumbs)
    (add-hook 'dired-after-readin-hook
              'image-dired-dired-after-readin-hook nil t)
    (if (my-image-dired-confirm-generate-thumbs (my-image-dired-dired-all-image-files))
        (save-excursion
          (goto-char (point-min))
          (while (< (point) (point-max))
            (my-image-dired-dired-set-thumb-visibility t)
            (forward-line 1)))
      (message "Canceled."))))

(defun my-image-dired-dired-all-image-files ()
  (when (derived-mode-p 'dired-mode)
    (save-excursion
      (goto-char (point-min))
      (let ((image-regexp (image-file-name-regexp))
            files)
        (while (< (point) (point-max))
          (let ((file (dired-get-filename nil t)))
            (when (and file
                       (string-match-p image-regexp file))
              (push file files)))
          (forward-line 1))
        (nreverse files)))))

(defun my-image-dired-confirm-generate-thumbs (files)
  (let* ((no-thumb-files (seq-filter (lambda (file)
                                       (not (file-exists-p
                                             (image-dired-thumb-name file))))
                                     files))
         (num-no-thumb-files (length no-thumb-files)))
    (or (<= num-no-thumb-files image-dired-show-all-from-dir-max-files)
        (y-or-n-p
         (format
          "Generate %s new thumbnails. Proceed? "
          num-no-thumb-files)))))

(with-eval-after-load "dired"
  (define-key dired-mode-map (kbd "C-t C-a") 'my-image-dired-dired-toggle-all-thumbs))

実際には全表示用の一つのコマンドだけ C-t C-a に割り当てました。C-u プレフィックスを付けると全消去になります。

また、沢山のサムネイル生成が必要なときは警告を出して確認するようにしました。全ての画像が既にサムネイル化されている場合は何も聞かずに処理します。

(dired内)dired-details-rのレイアウトが乱れるのを直す

私はファイルの詳細情報(サイズやタイムスタンプ)をファイル名の右側に表示して使用していますが、サムネイルを表示させるとその分だけ詳細情報も含めた行全体が右にずれてしまいます。

これについては先日「dired-details-r.elの更新」として書きました。

(dired内)ファイルの削除や移動でサムネイルが消えずに残るのを直す

見た目的にはかなり露骨なバグです。こういうのが当たり前のように転がっているのがEmacsの世界です。

ただこれはdiredバッファに何かを追加するEmacs Lispで良くあることです。私がdired-details-rを作っている時にも経験しましたしall-the-icons-diredでもありました。

diredはファイルの削除や移動を外部から捕捉できるようにするフックを提供していないのでちゃんと実装するのが難しいのです。私が思いつく対処方法としては次の二つがあります。

  • 行が消えるときに自動的に追加したものも一緒に消えるようにしておく(overlayのevaporateプロパティを使う等)
  • dired-remove-entry等の削除に関わる関数にadviceを追加する

最初はサムネイルのオーバーレイに1文字分の範囲を覆わせてevaporateプロパティをtにすることで自動的に消えるようにしようと思いました(今の実装はファイル名直前の空の範囲を覆わせてbefore-stringでサムネイルを表示しているので、そのままevaporateをtにすると即時消えてしまう)。しかしよく調べてみると、image-diredはバッファ全体の更新時(dired-after-readin-hookのタイミング)にバッファ内に存在するオーバーレイを正しい位置に再配置していました。つまり、消してから作り直すのでは無く、使い回す設計になっていました。どちらが速いのかは計測してみなければ分かりませんが今より遅くなっては困るのでその設計は尊重して、adviceを使ってdiredで削除したり移動したりするときだけ明示的にオーバーレイを削除するようにしてみました。

(defun my-image-dired-dired-remove-entry-around (orig-fun file &rest args)
  (save-excursion
    (when (dired-goto-file file)
      (cl-loop for ov in (overlays-in (line-beginning-position)
                                      (line-end-position))
               when (and (overlay-get ov 'put-image)
                         (overlay-get ov 'thumb-file))
               do (delete-overlay ov))))
  (apply orig-fun file args))

(advice-add #'dired-remove-entry :around
            #'my-image-dired-dired-remove-entry-around)

(dired内)C-t iで開いたウィンドウを簡単に閉じる

image-diredには C-t i で現在のポイントにある画像ファイルを別ウィンドウで表示してくれる機能があります。この機能の特筆すべき点は、ちゃんと適切なサイズに縮小した一時ファイルを作ってからEmacsで開いてくれるというところです。解像度の高い巨大な画像でも安心して開けるわけです。

それは良いのですが、開いたウィンドウを簡単に閉じることができません。もちろん C-x o q (バッファも削除したいならC-x o C-u q) で閉じられますが、もう一歩、別ウィンドウに移動しなくても閉じられるようにしたいところです。チラ見してすぐに閉じるような手軽さが欲しいわけです。

ひとまず次のようにしてDiredから C-t q で閉じるようにしてみました。

(defun my-image-dired-quit-display-window (&optional kill)
  (interactive "P")
  (when-let ((window (image-dired-display-window)))
    (quit-window kill window)))

(with-eval-after-load "dired"
  (define-key dired-mode-map (kbd "C-t q") 'my-image-dired-quit-display-window))

さらにもう一歩進めるなら、 q でimage-diredのウィンドウを先にquitして、無ければdiredをquitするというのはどうでしょう。

(defun my-image-dired-dired-quit-window (&optional kill)
  (interactive "P")
  (if-let ((window (or (image-dired-display-window)
                       (image-dired-thumbnail-window))))
      (quit-window kill window)
    (quit-window kill)))

(with-eval-after-load "dired"
  (define-key dired-mode-map (kbd "q") 'my-image-dired-dired-quit-window))

(dired内)全画像ファイルをサムネイルバッファで表示する

image-diredにはサムネイルだけを専用のバッファで一覧表示する機能があります。あるというよりも、おそらくこちらが本来の使い方なのだと思います。

この方法は良くあるビューアに慣れていると最初はギョッとしますが、Diredの中に表示をさせたものと比較すると無駄な余白が少なく一度に多くのサムネイルとファイル情報を表示できるのが利点です(まぁ、実際の理由はDiredバッファ内にサムネイルを表示するのは今回対策しているように色々問題が多いからなのかもしれません)。

Dired内表示(左)と別ウィンドウ表示(右)の比較
図2: Dired内表示(左)と別ウィンドウ表示(右)の比較

画像をサムネイル専用バッファで表示するには、C-t d、C-t .、C-t aあたりを使います。C-t dは現在またはマークした画像だけを表示し(ウィンドウ移動も含む)、C-t .は現在の画像だけを表示し(選択ウィンドウはそのまま)、C-t aは現在またはマークした画像を 追加 します(選択ウィンドウはそのまま)。これはこれで有用なケースはあると思いますが、とりあえず欲しいのは開いているディレクトリの全画像を一括でサムネイル専用バッファに表示するコマンドではないでしょうか。一応そのようなコマンドはあります。

特定のディレクトリ下にある画像を一括でサムネイル表示するには M-x image-dired とします。ディレクトリを尋ねられるのでそのままカレントディレクトリを指定すればOKです。50個以上の画像があると警告が表示されます。

しかしこれには次のような不満もあります。

  • Diredにキー割り当てがない
  • いちいちディレクトリを尋ねられる
  • Dired側で全ての画像ファイルがマークされる(マーク状態が変わってしまう)

その辺りを次のコードで解決しました。

(defun my-image-dired-dired-show-all-images ()
  ;; Derived from `image-dired-show-all-from-dir'
  (interactive)
  (unless (derived-mode-p 'dired-mode)
    (error "Not dired buffer"))
  (let* ((image-regexp (image-file-name-regexp))
         ;; カレントディレクトリにある全画像ファイルを求める
         (files (seq-filter (lambda (file) (string-match-p image-regexp file))
                            (directory-files "." t))))
    (if (my-image-dired-confirm-generate-thumbs files) ;;生成数が多いときは確認する
        ;; Emacs 28まで
        ;; (progn
        ;;   (my-image-dired-display-thumbs files (current-buffer))
        ;;   (image-dired-thumb-update-marks) ;;マークを同期する
        ;;   (pop-to-buffer image-dired-thumbnail-buffer))
        ;; Emacs 29から
        (progn
          (my-image-dired-display-thumbs files (current-buffer))
          (image-dired--thumb-update-marks) ;;マークを同期する
          (pop-to-buffer image-dired-thumbnail-buffer)
          (image-dired--update-header-line))
      (message "Canceled."))))

(defun my-image-dired-display-thumbs (files dired-buf
                                            &optional append do-not-pop)
  ;; Derived from `image-dired-display-thumbs'
  (setq image-dired--generate-thumbs-start  (current-time))
  (let ((buf (image-dired-create-thumbnail-buffer)))
    (with-current-buffer buf
      ;; Emacs 28まで
      ;; (let ((inhibit-read-only t))
      ;;   (if append (goto-char (point-max)) (erase-buffer))
      ;;   (dolist (curr-file files)
      ;;     (let ((thumb-name (image-dired-thumb-name curr-file)))
      ;;       (unless (file-exists-p thumb-name)
      ;;         (image-dired-create-thumb curr-file thumb-name))
      ;;       (image-dired-insert-thumbnail thumb-name curr-file dired-buf)))
      ;;   (if do-not-pop
      ;;       (display-buffer buf)
      ;;     (pop-to-buffer buf))
      ;;   (image-dired--line-up-with-method))
      ;; Emacs 29から
      (let ((inhibit-read-only t))
        (if (not append)
            (progn
              (setq image-dired--number-of-thumbnails 0)
              (erase-buffer))
          (goto-char (point-max)))
        (dolist (file files)
          (when (string-match-p (image-dired--file-name-regexp) file)
            (image-dired-insert-thumbnail
             (image-dired--get-create-thumbnail-file file) file dired-buf
             (cl-incf image-dired--number-of-thumbnails))))))))

(with-eval-after-load "dired"
  (define-key dired-mode-map (kbd "C-t C-d") 'my-image-dired-dired-show-all-images))

my-image-dired-dired-show-all-imagesimage-dired-show-all-from-dir (image-diredコマンドはこれの別名) が元になっていますが、次の点が異なります。

  • diredから呼ばれることが前提
  • diredで開いているディレクトリが対象 (いちいち聞きません)
  • diredのマーク状態を一切変更せずに直接サムネイルバッファに追加する
  • diredでマークしている画像は始めからサムネイルバッファでもマークする
  • サムネイル化されていない画像が多い場合は警告する (画像の数では無く、新たに生成しなければならないサムネイルの数で判断します)

(サムネイルバッファ内)Uでマークを全解除する

(2023-08-08追記: Emacs 29.1からは標準で同等のコマンドがUに割り当てられているため不要です)

M-x image-diredを実行してみるとすぐに気がつくのがUで全てのマークを解除できないことではないでしょうか。M-x image-diredを実行するとdiredバッファ上で全ての画像ファイルがマークされてしまいます。慌ててUを押して全てのマークを解除しようとしても、サムネイルバッファの方に移動してしまっているので効きません。

サムネイルバッファ内ではmやuでマークしたり解除したりできますが、Uで全解除はできません。

次のコードはそれを出来るようにします。

;; Emacs 29.1からは不要。標準で image-dired-unmark-all-marks がある。
(defun my-image-dired-unmark-all ()
  (interactive)
  (when-let ((dired-buf (image-dired-associated-dired-buffer)))
    (with-current-buffer dired-buf
      (dired-unmark-all-marks))) ;;TODO: サムネイルバッファ内にあるファイルだけに限定すべき?
  ;; きちんとサムネイルバッファ内のマークも更新するのがポイント。
  (image-dired-thumb-update-marks))

(with-eval-after-load "image-dired"
  (define-key image-dired-thumbnail-mode-map "U" 'my-image-dired-unmark-all))

他にもdiredがサポートしている様々なマーク操作をサムネイルバッファ上でも行えるようになっていた方が良いかもしれません。特にマークのトグルは欲しいのですが(U tと押せば全マークできるので)、tキーがタグのために使われているので保留。

また、本来はサムネイルバッファ内にあるファイルだけマーク解除すべきかもしれません。その辺りはマークがちゃんと同期されていないという問題と一緒に考えた方がいいかもしれません。

外部ツールで表示するときにw32-shell-executeを使う

特定のツールを直接指定するのも良いのですが、Windowsなので関連付けされているアプリを呼び出すのが普通でしょう。そのためにはw32-shell-execute関数を使用します。

diredにはすでにそのような機能を自分で追加してあるのでimage-diredで対応する必要はあまりないのですが、一応対策しておきます。

(defun my-image-dired-thumbnail-display-external-w32 ()
  ;; Derived from `image-dired-thumbnail-display-external'
  (interactive)
  (let ((file (image-dired-original-file-name)))
    (if (not (image-dired-image-at-point-p))
        (message "No thumbnail at point")
      (if (not file)
          (message "No original file name found")
        ;; ここを変更
        (w32-shell-execute "open" file)))))

(defun my-image-dired-dired-display-external-w32 ()
  ;; Derived from `image-dired-dired-display-external'
  (interactive)
  (let ((file (dired-get-filename)))
    ;; ここを変更
    (w32-shell-execute "open" file)))

(with-eval-after-load "dired"
  (define-key dired-mode-map [remap image-dired-dired-display-external] 'my-image-dired-dired-display-external-w32))

(with-eval-after-load "image-dired"
  (define-key image-dired-thumbnail-mode-map [remap image-dired-thumbnail-display-external] 'my-image-dired-thumbnail-display-external-w32))

何か別のソフト、ビューアではなく編集ソフト等を指定するのもありかもしれません。ビューアが立ち上がればそこから編集ソフトも起動できるようにはしてあるのであまり必要性はありません。

(dired内)ファイルに対応するサムネイルバッファ内の位置へジャンプする

C-t jでサムネイルバッファへジャンプしますが、対応するファイルへはジャンプしません。サムネイルバッファからDiredバッファの対応するファイルへはTABでジャンプできるので、この逆バージョンが欲しい所です。C-t TABに割り当ててみました。

(defun my-image-dired-dired-jump-thumbnail-buffer ()
  (interactive)
  (let ((file (dired-get-filename)))
    ;; Display thumbnail buffer
    (if (image-dired-thumbnail-window)
        (image-dired-jump-thumbnail-buffer)
      (if (buffer-live-p (get-buffer image-dired-thumbnail-buffer))
          (pop-to-buffer image-dired-thumbnail-buffer)
        (message "No thumbnail buffer")))
    ;; Jump
    (my-image-dired-goto-file file)))

(defun my-image-dired-goto-file (file)
  (let ((pos (save-excursion
               (goto-char (point-min))
               (when-let ((match (text-property-search-forward 'original-file-name file t)))
                 (prop-match-beginning match)))))
    (when pos
      (goto-char pos))))

(with-eval-after-load "dired"
  (define-key dired-mode-map (kbd "C-t TAB") 'my-image-dired-dired-jump-thumbnail-buffer))

コードまとめ

沢山修正したのでひとまずこのあたりでまとめます。

(require 'cl-lib)
(require 'text-property-search)
(require 'image-dired)

;;;; image-dired-dired-toggle-marked-thumbsを分解する

(defun my-image-dired-dired-toggle-marked-thumbs (&optional arg)
  ;; Derived from `image-dired-dired-toggle-marked-thumbs'
  "Toggle thumbnails in front of file names in the Dired buffer.
If no marked file could be found, insert or hide thumbnails on the
current line.  ARG, if non-nil, specifies the files to use instead
of the marked files.  If ARG is an integer, use the next ARG (or
previous -ARG, if ARG<0) files."
  (interactive "P")
  (dired-map-over-marks
   (my-image-dired-dired-set-thumb-visibility 'toggle)
   arg             ; Show or hide image on ARG next files.
   'show-progress) ; Update dired display after each image is updated.
  (add-hook 'dired-after-readin-hook
            'image-dired-dired-after-readin-hook nil t))

(defun my-image-dired-dired-set-thumb-visibility (visibility)
  ;; Derived from `image-dired-dired-toggle-marked-thumbs'
  (let ((image-pos  (dired-move-to-filename))
        (image-file (dired-get-filename nil t)))
    (when (and image-file
               (string-match-p (image-file-name-regexp) image-file))
      (let* ((thumb-file
              (thumb-file
               ;; Emacs 28まで
               ;;(image-dired-get-thumbnail-image image-file)
               ;; Emacs 29から
               (create-image
                (image-dired--get-create-thumbnail-file image-file))))
             (thumb-ov (cl-loop for ov in (overlays-in (point) (1+ (point)))
                                if (overlay-get ov 'thumb-file) return ov)))
        (if thumb-ov
            (when (memq visibility '(nil toggle))
              (delete-overlay thumb-ov))
          (when (memq visibility '(t toggle))
            (my-image-dired-dired-create-thumbnail-overlay
             image-pos image-file thumb-file)))))))

;;;; Diredバッファ内でのサムネイルの表示を改善

(defun my-image-dired-dired-create-thumbnail-overlay (image-pos image-file thumb-file)
  ;; Derived from `image-dired-dired-toggle-marked-thumbs'
  (let ((overlay (put-image
                  ;; 枠線で囲む
                  (append thumb-file (list :relief 1))
                  image-pos)))
    (overlay-put overlay 'image-file image-file)
    (overlay-put overlay 'thumb-file thumb-file)
    (my-image-dired-dired-update-thumbnail-overlay overlay thumb-file)
    overlay))

(defun my-image-dired-dired-update-thumbnail-overlay (ov image)
  (when-let ((image-file (plist-get (cdr image) :file)))
    (let* ((image-exists-p (file-exists-p image-file))
           (image-size (image-size image t)) ;;float?
           (space-w
            (if image-exists-p
                ;; Emacs 28まで
                ;;(- image-dired-thumb-width (car image-size))
                ;; Emacs 29から
                (- image-dired-thumb-size (car image-size))
              0))
           (space-left (ceiling (/ space-w 2)))
           (space-right (+ 10 ;; サムネイルの後に空白を入れる
                           (- space-w space-left))))
      ;; 幅を揃える
      (overlay-put ov 'before-string
                   (concat
                    (propertize "_" 'display `(space :width (,space-left)))
                    (overlay-get ov 'before-string)
                    (propertize "_" 'display `(space :width (,space-right))))))))

;;;; Diredバッファ内にサムネイルを一括表示する

(defun my-image-dired-dired-toggle-all-thumbs ()
  (interactive)
  (if (cl-loop for ov in (overlays-in (point-min) (point-max))
               when (overlay-get ov 'thumb-file) return t)
      (my-image-dired-dired-hide-all-thumbs)
    (my-image-dired-dired-show-all-thumbs)))

(defun my-image-dired-dired-hide-all-thumbs ()
  (interactive)
  (cl-loop for ov in (overlays-in (point-min) (point-max))
           when (overlay-get ov 'thumb-file)
           do (delete-overlay ov)))

(defun my-image-dired-dired-show-all-thumbs (&optional hide)
  (interactive "P")
  (if hide
      (my-image-dired-dired-hide-all-thumbs)
    (add-hook 'dired-after-readin-hook
              'image-dired-dired-after-readin-hook nil t)
    (if (my-image-dired-confirm-generate-thumbs (my-image-dired-dired-all-image-files))
        (save-excursion
          (goto-char (point-min))
          (while (< (point) (point-max))
            (my-image-dired-dired-set-thumb-visibility t)
            (forward-line 1)))
      (message "Canceled."))))

(defun my-image-dired-dired-all-image-files ()
  (when (derived-mode-p 'dired-mode)
    (save-excursion
      (goto-char (point-min))
      (let ((image-regexp (image-file-name-regexp))
            files)
        (while (< (point) (point-max))
          (let ((file (dired-get-filename nil t)))
            (when (and file
                       (string-match-p image-regexp file))
              (push file files)))
          (forward-line 1))
        (nreverse files)))))

(defun my-image-dired-confirm-generate-thumbs (files)
  (let* ((no-thumb-files (seq-filter (lambda (file)
                                       (not (file-exists-p
                                             (image-dired-thumb-name file))))
                                     files))
         (num-no-thumb-files (length no-thumb-files)))
    (or (<= num-no-thumb-files image-dired-show-all-from-dir-max-files)
        (y-or-n-p
         (format
          "Generate %s new thumbnails. Proceed? "
          num-no-thumb-files)))))

;;;; ファイル削除時にサムネイルを削除

(defun my-image-dired-dired-remove-entry-around (orig-fun file &rest args)
  (save-excursion
    (when (dired-goto-file file)
      (cl-loop for ov in (overlays-in (line-beginning-position)
                                      (line-end-position))
               when (and (overlay-get ov 'put-image)
                         (overlay-get ov 'thumb-file))
               do (delete-overlay ov))))
  (apply orig-fun file args))

(advice-add #'dired-remove-entry :around
            #'my-image-dired-dired-remove-entry-around)

;;;; Diredバッファからimage-dired関連ウィンドウを閉じる

(defun my-image-dired-quit-display-window (&optional kill)
  (interactive "P")
  (when-let ((window (image-dired-display-window)))
    (quit-window kill window)))

(defun my-image-dired-dired-quit-window (&optional kill)
  (interactive "P")
  (if-let ((window (or (image-dired-display-window)
                       (image-dired-thumbnail-window))))
      (quit-window kill window)
    (quit-window kill)))

;;;; Diredバッファから全画像ファイルを一括でサムネイルバッファに表示する

(defun my-image-dired-dired-show-all-images ()
  ;; Derived from `image-dired-show-all-from-dir'
  (interactive)
  (unless (derived-mode-p 'dired-mode)
    (error "Not dired buffer"))
  (let* ((image-regexp (image-file-name-regexp))
         (files (seq-filter (lambda (file) (string-match-p image-regexp file))
                            (directory-files "." t))))
    (if (my-image-dired-confirm-generate-thumbs files)
        ;; Emacs 28まで
        ;; (progn
        ;;   (my-image-dired-display-thumbs files (current-buffer))
        ;;   (image-dired-thumb-update-marks) ;;マークを同期する
        ;;   (pop-to-buffer image-dired-thumbnail-buffer))
        ;; Emacs 29から
        (progn
          (my-image-dired-display-thumbs files (current-buffer))
          (image-dired--thumb-update-marks) ;;マークを同期する
          (pop-to-buffer image-dired-thumbnail-buffer)
          (image-dired--update-header-line))
      (message "Canceled."))))

(defun my-image-dired-display-thumbs (files dired-buf
                                            &optional append do-not-pop)
  ;; Derived from `image-dired-display-thumbs'
  (setq image-dired--generate-thumbs-start  (current-time))
  (let ((buf (image-dired-create-thumbnail-buffer)))
    (with-current-buffer buf
      ;; Emacs 28まで
      ;; (let ((inhibit-read-only t))
      ;;   (if append (goto-char (point-max)) (erase-buffer))
      ;;   (dolist (curr-file files)
      ;;     (let ((thumb-name (image-dired-thumb-name curr-file)))
      ;;       (unless (file-exists-p thumb-name)
      ;;         (image-dired-create-thumb curr-file thumb-name))
      ;;       (image-dired-insert-thumbnail thumb-name curr-file dired-buf)))
      ;;   (if do-not-pop
      ;;       (display-buffer buf)
      ;;     (pop-to-buffer buf))
      ;;   (image-dired--line-up-with-method))
      ;; Emacs 29から
      (let ((inhibit-read-only t))
        (if (not append)
            (progn
              (setq image-dired--number-of-thumbnails 0)
              (erase-buffer))
          (goto-char (point-max)))
        (dolist (file files)
          (when (string-match-p (image-dired--file-name-regexp) file)
            (image-dired-insert-thumbnail
             (image-dired--get-create-thumbnail-file file) file dired-buf
             (cl-incf image-dired--number-of-thumbnails))))))))

;;;; サムネイルバッファ内から全マークの解除

;; Emacs 29.1からは不要。標準で image-dired-unmark-all-marks がある。
(defun my-image-dired-unmark-all ()
  (interactive)
  (when-let ((dired-buf (image-dired-associated-dired-buffer)))
    (with-current-buffer dired-buf
      (dired-unmark-all-marks)))
  (image-dired-thumb-update-marks))

;;;; 外部ツールで表示

(defun my-image-dired-thumbnail-display-external-w32 ()
  ;; Derived from `image-dired-thumbnail-display-external'
  (interactive)
  (let ((file (image-dired-original-file-name)))
    (if (not (image-dired-image-at-point-p))
        (message "No thumbnail at point")
      (if (not file)
          (message "No original file name found")
        ;; Use shell execute!
        (w32-shell-execute "open" file)))))

(defun my-image-dired-dired-display-external-w32 ()
  ;; Derived from `image-dired-dired-display-external'
  (interactive)
  (let ((file (dired-get-filename)))
    ;; Use shell execute!
    (w32-shell-execute "open" file)))

;;;; Diredからサムネイルバッファの対応するファイルへジャンプ

(defun my-image-dired-dired-jump-thumbnail-buffer ()
  (interactive)
  (let ((file (dired-get-filename)))
    ;; Display thumbnail buffer
    (if (image-dired-thumbnail-window)
        (image-dired-jump-thumbnail-buffer)
      (if (buffer-live-p (get-buffer image-dired-thumbnail-buffer))
          (pop-to-buffer image-dired-thumbnail-buffer)
        (message "No thumbnail buffer")))
    ;; Jump
    (my-image-dired-goto-file file)))

(defun my-image-dired-goto-file (file)
  (let ((pos (save-excursion
               (goto-char (point-min))
               (when-let ((match (text-property-search-forward 'original-file-name file t)))
                 (prop-match-beginning match)))))
    (when pos
      (goto-char pos))))

;;;; 設定

(with-eval-after-load "image-dired"
  (when (eq system-type 'windows-nt)
    (setq image-dired-cmd-create-thumbnail-program "magick"
          image-dired-cmd-create-temp-image-program "magick")
    (unless (equal (car image-dired-cmd-create-thumbnail-options) "convert")
      (push "convert" image-dired-cmd-create-thumbnail-options))
    (unless (equal (car image-dired-cmd-create-temp-image-options) "convert")
      (push "convert" image-dired-cmd-create-temp-image-options))
    (define-key image-dired-thumbnail-mode-map [remap image-dired-thumbnail-display-external] 'my-image-dired-thumbnail-display-external-w32))
  ;; Emacs 29.1からは不要。標準で image-dired-unmark-all-marks がある。
  ;;(define-key image-dired-thumbnail-mode-map "U" 'my-image-dired-unmark-all)
  )

(with-eval-after-load "dired"
  (define-key dired-mode-map [remap image-dired-dired-toggle-marked-thumbs] 'my-image-dired-dired-toggle-marked-thumbs)
  (define-key dired-mode-map (kbd "C-t C-a") 'my-image-dired-dired-toggle-all-thumbs)
  (define-key dired-mode-map (kbd "q") 'my-image-dired-dired-quit-window)
  (define-key dired-mode-map (kbd "C-t q") 'my-image-dired-quit-display-window)
  (define-key dired-mode-map (kbd "C-t C-d") 'my-image-dired-dired-show-all-images)
  (define-key dired-mode-map (kbd "C-t TAB") 'my-image-dired-dired-jump-thumbnail-buffer)
  (when (eq system-type 'windows-nt)
    (define-key dired-mode-map [remap image-dired-dired-display-external] 'my-image-dired-dired-display-external-w32)))

その他の問題

  • サムネイル生成を中断する方法が無い
  • サムネイル生成の進行状況を確認する方法が無い
  • サムネイル生成が終わったのにサムネイルが更新されないことがある
  • サムネイル生成が終わった後にdired-details-rのレイアウトが崩れる
  • サムネイル生成の高速化
  • Diredバッファとサムネイルバッファの間のマークの同期が不完全
  • サムネイルバッファ内でのマーク操作が不足している(全トグル等)
  • サムネイル画像の量を調べたり削除したりする機能が無い

とりあえず

とりあえずすぐに目に付いたものを修正してみましたが、まだまだ直すべき所は沢山ありそうです。

image-diredは本家の方でも継続的に改良されているみたいなので(GitHubのEmacsミラーをチラ見した限り)、最新版はまた状況が異なるかもしれません。私は現在Emacs 28.2に同梱されているものを使用しています。(2023-08-08追記: Emacs 29.1にアップデートしました)

肝心のタグやコメントに関する機能をあまり使っていないので、今後はそれらを使ってみて効率よいワークフローが確立できるかを模索しようと思います。

2023-04-11

dired-details-r.elの更新

次の点を変更しました。

  • image-diredのサムネイルやall-the-icons-diredのアイコンに対応
  • ファイル名が長いときの空白を調整
  • global-dired-details-r-modeを追加
  • find-dired系に一応対応
  • dired-after-readin-hookを使用するようにした

今回の一番の目的はimage-dired対応です。ファイル名の前に存在するオーバーレイの幅を計算に入れてレイアウトします。all-the-icons-diredのオーバーレイも一緒に考慮しなければならなかった(分離できなかった)のでそうしました。all-the-icons-diredは独自に色々手を入れているのでオリジナルでは未確認です。image-diredもサムネイルの幅が揃うように手元では独自に手を入れています。動作が遅くなったり不安定になる可能性が若干あるので無効化する変数も用意してあります。サムネイルのサイズは非同期生成や画像の編集操作で変化するのでその際はレイアウトが崩れます。gを押してください。

image-diredのサムネイルとall-the-icons-diredを考慮して詳細情報の右側表示を行う
図1: image-diredのサムネイルとall-the-icons-diredを考慮して詳細情報の右側表示を行う

以下はついでに直した所です。

ファイル名が長すぎるときはバッファ全体のファイル名欄の幅を拡大せずにそのファイルだけレイアウトが崩れるようにしてありますが、その際ファイル名の右に余分な空白があれば削除するようにしました。ファイルサイズが右寄せされているために無駄に空白が空いていることがありました。

global-dired-details-r-modeは全体のON/OFFをしやすくするために追加しました。

find-dired系(find-name-diredやfind-grep-dired)での動作を改善しました。デフォルトでは見た目を変更しないようになっています。find-diredではファイル名にディレクトリが含まれるため長すぎてレイアウトが崩れがちだからです。 ( を押すとレイアウトを変更するようにはしてあります。私はfind-dired系をあまり使わないのでどうするのが一番良いのかよく分かりません。

dired-after-readin-hookを使用するようにしました。これまではadvice-addでdired-insert-set-propertiesとdired-revertに処理を挟んでいましたが、こちらのやり方の方が普通のようです。ただし、find-diredも含めいくつかdiredバッファを直接書き替えた後にdired-insert-set-propertiesを呼び出してdired-after-readin-hookを呼び出さないケースがあるようです。そういったものにもちゃんと対応するならこれまでのやり方も併用した方が良いのかもしれません。

misohena/dired-details-r: Show file details on the right side of the filename in Emacs Dired mode

(追記: 長すぎるファイル名を切り詰める機能も追加しました)

(追記2: ファイル名の最大幅をウィンドウ幅から決める機能を追加しました)

(追記3: ついに詳細を左にも両側にも表示できるようになってしまいました。dired-details​-r​なのにw)

詳細を左にも両側にも表示する例
図2: 詳細を左にも両側にも表示する例
2023-03-23 ,

Emacs内で地図を見るosm.elを使う

osm.el というものがあることは少し前から知っていたのですが、別にEmacsの中で地図を見なくてもいいんじゃないかと思って試していませんでした。まぁEmacsの中で動く作図ソフトなんかを作ってるお前が言うのかという感じではあるのですが。

とは言え登山計画や登山記録の作成に何か活用できないかと考え、時間があったので少し試してみることにしました。

minad/osm: osm.el - OpenStreetMap viewer for Emacs

使ってみて驚いたのがとにかく速いということ。Emacs内のキー操作でシームレスに使えるというのもあるのですが、起動自体がブラウザでGoogle Mapsを開くよりも速いのです。もちろんタイルをキャッシュしているからというのはあるのですが、それは向こうだって同じ事。きっと余分な処理が少ないからなのでしょう。

キーボードだけで無くマウスでも普通に操作できますし、メニューもあるのでキー割り当てを覚えていなくても問題ありません。閉じる操作だけキーが必要でしょうか。qがquit-windowなので、バッファもkillしたいならC-u qすれば良いのでしょう。

私はC-f, C-b, C-p, C-nでも移動がしたかったので次のような設定を加えました。

(with-eval-after-load 'osm
  (define-key osm-mode-map [remap previous-line] #'osm-up-up)
  (define-key osm-mode-map [remap next-line] #'osm-down-down)
  (define-key osm-mode-map [remap forward-char] #'osm-right-right)
  (define-key osm-mode-map [remap backward-char] #'osm-left-left))

また、次の設定で国土地理院の地理院地図を表示するようにしました。

(with-eval-after-load 'osm
  (setq osm-server 'jgsi)
  (setf (alist-get 'jgsi osm-server-list)
        '(:name
          "地理院地図 標準地図"
          :max-zoom 18
          :description "地理院地図 標準地図"
          :url "https://cyberjapandata.gsi.go.jp/xyz/std/%z/%x/%y.png"
          :group "地理院地図"
          :copyright
          ("Map data © {国土地理院|https://www.gsi.go.jp/}"))))

後は自宅とか言語とか。

(setq osm-home '(35.XXXXXX 139.XXXXXX 14)
      osm-search-language "ja,en")

osm.elにはGPXファイルの軌跡データを表示する機能があります。GPXは登山の記録アプリでも広く使われている形式です。試しに表示させてみたところ次のようになりました。

2023-03-23-osm-el.jpg

大変面白いのですが、しかしこれだけだと単にEmacsの中で地図や軌跡が見られるというだけです。何かもう少し有意義な使い方が出来ないものでしょうか。最低限Emacsの中から任意の地点へリンクを張りたいですよね。

同梱されているosm-ol.elというのを使用すると次のような形式のorg-modeリンクが使えるようになります。

[[geo:36.399109,137.715168;z=15][燕山荘]]

……あれ、これ以前私も同じような仕組みを作りましたよね。

緯度経度リンクタイプをorg-modeに追加する

misohena/org-geolink: Adds geo location link type to org-mode.

私の方はリンクを各種地図サービス(Webブラウザ)で開いたり、エクスポート時に好きな形式に変換するためのものでした。

osm-ol.elの方は単にリンクをosm.elで開くだけのようです。エクスポートや外部サービスで開くことは考慮していないようです。

なのでosm-ol.elは使わず、私のorg-geolinkをosm.elと連携させることにしました。

org-geolinkがgeoリンクを開くときの方法としてosm.elを選べるようにしました。また、osm.elで見ている場所を各種地図サービスで開くコマンドを追加しました。

これによって

[[geo:~]] → osm.el(Emacs内) → 各種地図サービス(Webブラウザ内)

という流れで使うことができるようになりました。

つまり、まずは高速なosm.elで見て、必要に応じて(施設情報閲覧や経路検索がしたいなら)各種地図サービスを開く事が出来ます。

設定例:

(when (locate-library "org-geolink")
  (with-eval-after-load "org"
    (require 'org-geolink))

  (when (locate-library "osm")
    ;; [[geo:]]リンクをosm.elで開く
    (setq org-geolink-follow-function 'org-geolink-open-by-osm-el)

    ;; osmバッファ内において、Oで外部地図サービスを開く
    (with-eval-after-load 'osm
      (define-key osm-mode-map (kbd "O")
        #'org-geolink-open-osm-el-location-by-selected-web-service)))

  ;;地図サービスを追加
  (setq org-geolink-map-services-user
        ;; NAVITIME
        '((navitime
           (name . "NAVITIME")
           (url . "https://www.navitime.co.jp/maps/poi?lat={{{1}}}&lon={{{2}}}"))
          ;; ヤマケイオンライン
          (yamakei
           (name . "ヤマケイオンライン(ヤマタイム)")
           (url . "https://www.yamakei-online.com/yk_map/?latlon={{{1}}},{{{2}}}&zoom={{{z}}}"))
          ;; ヤマレコ
          (yamareco
           (name . "ヤマレコ(ヤマプラ)")
           (url . "https://www.yamareco.com/modules/yr_plan/step1_planner.php?lat={{{1}}}&lon={{{2}}}")))))

もっといろんな活用方法があるような気がするのですが、時間があったら色々やってみるかもしれません。

2022-12-30

cl-defmethodやcl-defunで作成した関数に対するeldocを改善する

例えば次のようなコードを書いたとしましょう。

(require 'eieio)

(defclass myshape-rect () ;;Emacs Lispは何でもかんでも接頭辞必須なのが鬱陶しいですね。
  ((x-min :initarg :x-min :type number)
   (y-min :initarg :y-min :type number)
   (x-max :initarg :x-max :type number)
   (y-max :initarg :y-max :type number)))

(defclass myshape-ellipse ()
  ((cx :initarg :cx :type number)
   (cy :initarg :cy :type number)
   (rx :initarg :rx :type number)
   (ry :initarg :ry :type number)))

(cl-defmethod myshape-scale ((rect myshape-rect) sx &optional (sy sx) &key (ox 0) (oy 0))
  (with-slots (x-min y-min x-max y-max) rect
    (setf x-min (+ (* (- x-min ox) sx) ox)
          x-max (+ (* (- x-max ox) sx) ox)
          y-min (+ (* (- y-min oy) sy) oy)
          y-max (+ (* (- y-max oy) sy) oy)))
  rect)

(cl-defmethod myshape-scale ((ellipse myshape-ellipse) sx &optional (sy sx) &key (ox 0) (oy 0))
  (with-slots (cx cy rx ry) ellipse
    (setf cx (+ (* (- cx ox) sx) ox)
          cy (+ (* (- cy oy) sy) oy)
          rx (* rx sx)
          ry (* ry sy)))
  ellipse)

で、myshape-scaleメソッドを試してみますか。

(let ((rect (myshape-rect :x-min 100 :x-max 200 :y-min 1000 :y-max 1100)))
  (myshape-scale …

ん?

2022-12-30-issue-method-args.png

「ARG &rest ARGS」って何だよ。

こんなの見せられたって一つ以上の引数を取る関数としか分からないじゃないか。

いや、分かってるよ。cl-defgenericを書けって言いたいんでしょ? うっせーバーカ! それにしたって「ARG &rest ARGS」は無いでしょう。こんなの出すなら何も出さない方がマシ。それとも煽ってるの?

……まぁいいや、とりあえずお試しだからcl-defgenericを書くとして

(cl-defgeneric myshape-scale (shape sx &optional (sy sx) &key (ox 0) (oy 0)))

sxは2、syもとりあえず2でいいかな。原点は……

(let ((rect (myshape-rect :x-min 100 :x-max 200 :y-min 1000 :y-max 1100)))
  (myshape-scale rect 2 2

ん? なんでsxの部分がハイライトされてるの?

2022-12-30-issue-divided-arg.png

キーワードも全然ダメじゃないか。

2022-12-30-issue-keyword.png

この部分ってアレでしょ? cl-defunってやつと同じ。Common Lispの。そもそもあれよく知らないんだよね……(cl-defunのお勉強へ)


なるほどね。

cl-defunで定義した関数でも同様の問題が発生します。一つの引数が複数の要素を含むリストになっている場合は必ず問題が生じます。単純に空白で分割しているだけのようです。キーワードも対応するものをハイライトするなんてことにはなっていないようです。

ミニバッファに情報を表示しているのはeldoc。特に関数呼び出し時の表示は elisp-eldoc-funcall の仕事です。

というわけでこの辺りを修正すべく作成したのがこちら。

my-elisp-eldoc-funcall.el

まず関連するメソッドは全て表示します。出し惜しみせず知ってることは素直に全て出せば良いんです。

2022-12-30-fixed-method.png

ちゃんとひとまとまりの部分をハイライトします。

2022-12-30-fixed-divided-arg.png

キーワードも対応する場所をハイライトします。

2022-12-30-fixed-keyword.png

cl-defunで定義した関数にも対応しました。通常の関数と区別が付かないのでちょっと心配ではあるのですが。

&keyと&restは同時にハイライトします。どちらにも入りますからね。

2022-12-30-fixed-cl-defun.png

こういうこともできますが、本当はC++みたいに多重定義を静的に解決してくれたら最高なんですけどね。型推論とか入ってくれてもいいのよ?

2022-12-30-edraw-to-string.png

はぁ、LSPでコードの解析が出来ると騒がしい昨今に何で自分でこんなことやってるんだろう。それも年末に。もう12月30日じゃないですか。

良いお年を。