Category Archives: 未分類

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-p や expand-file-name を再定義？　そんなことしてないだろう……と思ったが、ふと思い当たってorg-datauri-image.elとorg-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。安いマウスでも十分だとは思ったが変なものに当たって何度も買い直すようだと困る(結果的には買い直したがｗ)。信頼の置ける同じメーカーということでロジクールの中から一番無難そうな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 convert と magick は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-dired--file-name-regexp) image-file)) ;; Emacs28までは(image-file-name-regexp)
      (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-dired--file-name-regexp)) ;; Emacs28までは(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-dired--file-name-regexp)) ;; Emacs28までは(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-images は image-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を使う

(2024-09-15追記: Emacs30からはimage-dired-external-viewerにnilを指定すれば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-dired--file-name-regexp) image-file)) ;; Emacs28までは(image-file-name-regexp)
      (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-dired--file-name-regexp)) ;; Emacs28までは(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-dired--file-name-regexp)) ;; Emacs28までは(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)
            ;; Emacs 29まで
            ;; (image-dired-insert-thumbnail
            ;;  (image-dired--get-create-thumbnail-file file) file dired-buf
            ;;  (cl-incf image-dired--number-of-thumbnails))
            ;; Emacs 30から(引数が一つ減った)
            (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日じゃないですか。

良いお年を。

2022-12-29

cl-defunのお勉強

cl-defunは通常のdefunに加えて便利な機能が付け加えられていますが、正直使いませんしやりたいことに対して過剰に複雑な気がしたのでこれまで学ぶのを避けてきました。

しかし必要になったので諦めて嫌々勉強することにしました。

cl-defunのドキュメント

まずはドキュメントを確認しましょう。 

cl-defun is an autoloaded Lisp macro in ‘cl-macs.el’.
# cl-defun は ‘cl-macs.el’ に自動ロードされる Lisp マクロです。

(cl-defun NAME ARGLIST [DOCSTRING] BODY...)

Define NAME as a function.
# NAME を関数として定義します。
Like normal ‘defun’, except ARGLIST allows full Common Lisp conventions,
and BODY is implicitly surrounded by (cl-block NAME ...).
# ARGLIST が完全な Common Lisp 規則を許可し、BODY が (cl-block NAME ...)
# で暗黙的に囲まれていることを除いて、通常の「defun」と同様です。

The full form of a Common Lisp function argument list is
# Common Lisp 関数の引数リストの完全な形式は

   (VAR...
    [&optional (VAR [INITFORM [SVAR]])...]
    [&rest|&body VAR]
    [&key (([KEYWORD] VAR) [INITFORM [SVAR]])... [&allow-other-keys]]
    [&aux (VAR [INITFORM])...])

VAR may be replaced recursively with an argument list for
destructuring, ‘&whole’ is supported within these sublists.  If
SVAR, INITFORM, and KEYWORD are all omitted, then ‘(VAR)’ may be
written simply ‘VAR’.  See the Info node ‘(cl)Argument Lists’ for
more details.
# VAR は、再帰的に分解用の引数リストに置き換えることができます。これらの
# サブリスト内では「&whole」がサポートされています。 SVAR、INITFORM、
# KEYWORD をすべて省略した場合、「(VAR)」は単に「VAR」と記述できます。詳
# 細については、Info ノード「(cl)Argument Lists」を参照してください。

Web上だとArgument Lists (Common Lisp Extensions)にマニュアルがあります。(ちなみにCommon Lispの場合はCLHS: Section 3.4.1)

通常のdefunと違うのは次の点です:

  • 引数リストの形式を拡張
    • 分割代入(再帰的な引数リストと&whole指定)
    • &optionalの拡張(分割代入、初期値、指定有無変数)
    • &restの拡張(分割代入)
    • &bodyを追加(&restの別名)
    • &keyを追加(名前付き引数(Named parameter - Wikipedia)を実現)
    • &auxを追加(ローカル変数定義)
  • 関数の内部をcl-blockで囲む

cl-blockについては今回の興味の対象外なので、引数について見て行きます。

順番

(VAR...
 [&optional (VAR [INITFORM [SVAR]])...]
 [&rest|&body VAR]
 [&key (([KEYWORD] VAR) [INITFORM [SVAR]])... [&allow-other-keys]]
 [&aux (VAR [INITFORM])...])

&optional、&rest(または&body)、&key、&auxはこの順番でなければならないようです。

違う順番で書くと定義時にエラーになりました。 

(cl-defun test-clfun (a b &rest args &optional e f)
  (list a b c d e f)) ;;Malformed argument list ends with: (&optional e f)

(cl-defun test-clfun (a b &key c d &optional e f)
  (list a b c d e f)) ;;Malformed argument list ends with: (&optional e f)

(cl-defun test-clfun (a b &key c d &rest args)
  (list a b c d args)) ;;Malformed argument list ends with: (&rest args)

(cl-defun test-clfun (a b &aux (z (+ a b)) &optional c d)
  (list a b c d z)) ;;Malformed argument list ends with: (&optional c d)

(cl-defun test-clfun (a b &aux (z (+ a b)) &rest args)
  (list a b c d z)) ;;Malformed argument list ends with: (&rest args)

(cl-defun test-clfun (a b &aux (z (+ a b)) &key c d)
  (list a b c d z)) ;;Malformed argument list ends with: (&key c d)

技術的にはどんな順番でも良さそうな物ですが、処理の順番としては自然な気もします。

同じ物(&～)を複数書いた場合は対応が分かれます。(Emacs 28.2時点) 

(cl-defun test-clfun (a b &optional c d &optional e f)
  (list a b c d e f)) ;;OK!
(test-clfun 1 2) ;;Invalid function

(cl-defun test-clfun (a b &optional (c 100) d &optional e f)
  (list a b c d e f)) ;;OK!
(test-clfun 1 2) ;;OK!

(cl-defun test-clfun (a b &rest rest1 &rest rest2)
  (list a b rest1 rest2)) ;;Malformed argument list ends with: (&rest rest2)

(cl-defun test-clfun (a b &rest rest &body body)
  (list a b rest body)) ;;Malformed argument list ends with: (&rest body)

(cl-defun test-clfun (a b &key c d &key e f)
  (list a b c d e f)) ;;OK!
(test-clfun 1 2) ;;OK!
(test-clfun 1 2 :c 3 :d 4 :e 5 :f 6) ;;OK!

(cl-defun test-clfun (a b &aux (c (+ a b)) &aux (d (* a b)))
  (list a b c d)) ;;OK!
(test-clfun 2 3) ;;OK! (2 3 5 6)

&restで指定出来る変数は必ず一つだけということでしょう。複数の要素が指定出来る物(&～)は(連続する場合に限り)同じ物(&～)を許容する方針のようです(cl–do-arglist内でwhenではなくわざわざwhileが使われています)。ただし&optionalはcl-defun的には良くても実行時にエラーが出る場合がありました。&optionalは元々Emacs Lispで対応しているというあたりが関係しているのかもしれません。元々対応していない初期値指定を入れたら通るようになりました。

&optionalや&key、&auxの後に何も無いのは受け入れられるようです。 

(cl-defun test-clfun (a b &optional)
  (list a b)) ;;OK
(test-clfun 1 2) ;;OK

(cl-defun test-clfun (a b &key)
  (list a b)) ;;OK
(test-clfun 1 2) ;;OK

(cl-defun test-clfun (a b &optional &key &aux)
  (list a b)) ;;OK
(test-clfun 1 2) ;;OK

&restに関しては次の要素が強制的に格納先になる他、末尾での挙動が意図した物なのかは不明です。 

(cl-defun test-clfun (&optional &rest &key &aux)
  (list &key)) ;;OK (&keyという変数になります)
(test-clfun 1 2 3) ;;OK

(cl-defun test-clfun (&optional &rest)
  (list "Hello")) ;;OK! (&rest _と同様の使い方を想定している？ たまたま？)
(test-clfun 1 2 3) ;;OK!

;;ちなみに↑は通常のdefunでは実行時エラーになります。

(defun test-fun (&optional &rest)
  (list "Hello"))
(test-fun 1 2 3) ;;Invalid function

VARに書けるもの(分割代入あるいは再帰的な引数リスト)

(VAR...
 [&optional (VAR [INITFORM [SVAR]])...]
 [&rest|&body VAR]
 [&key (([KEYWORD] VAR) [INITFORM [SVAR]])... [&allow-other-keys]]
 [&aux (VAR [INITFORM])...])

VARと書いてある部分には再帰的に引数リストが書けます。また、その引数リストの先頭には &whole 変数 という指定ができます。

引数リストを書いた場合はその引数に指定した値が分割代入されます。 

(cl-defun test-clfun (a b (c &optional d e))
  (list a b c d e))
(test-clfun 1 2 '(3 4))
;;=> (1 2 3 4 nil)

(cl-defun test-clfun (a b (c1 (c21 c22 &optional c23 c24) &rest c3s) d)
  (list a b c1 c21 c22 c23 c24 c3s d))
(test-clfun 1 2 '(31 (321 322 323) 33 34) 4)
;;=> (1 2 31 321 322 323 nil (33 34) 4)

引数リストの先頭に &whole 変数 と書いてあると引数全体がその 変数 に格納されます。 

(cl-defun test-clfun (a b (&whole all c d))
  (list a b c d all))
(test-clfun 1 2 '(3 4))
;;=> (1 2 3 4 (3 4))

ここで 変数 と書いているのはVARでは無いということです。ここでは分割代入はできません。 

(cl-defun test-clfun (a b (&whole (all-c all-d) c d))
  (list a b c d all-c all-d))
(test-clfun 1 2 '(3 4));;Wrong type argument: symbolp, (all-c all-d)

&optional

[&optional (VAR [INITFORM [SVAR]])...]

&optionalは通常のdefunにもある機能ですが次の点が違います。

  • VARの分割代入
  • 初期値指定 (INITFORM)
  • 指定されたかを判別する変数 (SVAR)

INITFORM

INITFORMは&optionalや&keyword、&auxで変数の初期化に使う式です。

&optionalと&keyの所にあるINITFORMは指定されなかったときだけ評価されます。初期化されてから上書きされるわけではありません。 

(let ((opt1-count 0)
      (kw1-count 0))
  (cl-defun test-clfun (&optional
                        (opt1 (cl-incf opt1-count))
                        &key
                        (kw1 (cl-incf kw1-count)))
    (list opt1 kw1))
  (test-clfun 100 :kw1 200)
  (message "%s %s" opt1-count kw1-count) ;;0 0
  (test-clfun)
  (message "%s %s" opt1-count kw1-count) ;;1 1
  (test-clfun 2)
  (message "%s %s" opt1-count kw1-count)) ;;1 2

INITFORMは関数内の最初の方で評価されます。呼び出す場所でマクロ展開・評価されるわけではありません。 

(funcall
 (let ((a 2))
   (cl-defun test-clfun (b &optional (c (* a b)))
     (list a b c))
   #'test-clfun)
 3)
;;=>
;;レキシカルバインディング時: (2 3 6)
;;ダイナミックバインディング時: Symbol’s value as variable is void: a

(cl-defun test-clfun (b &optional (c (* a b)))
  (list a b c))

(let ((a 2))
  (test-clfun 3)))
;;=>
;;レキシカルバインディング時: Symbol’s value as variable is void: a
;;ダイナミックバインディング時: (2 3 6)

引数の左側は参照できて右側は参照できません。 

(cl-defun test-clfun (a &optional (b (* a c)) &aux (c 100))
  (list a b c))
(test-clfun 2) ;;Symbol’s value as variable is void: c

SVAR

SVARには省略可能(&optionalまたは&key)な引数が指定されたかどうか(nilまたはt)を格納する変数を指定出来ます。 

(cl-defun test-clfun (&optional
                      (opt1 100 opt1-supplied)
                      &key
                      (kw1 200 kw1-supplied))
  (list opt1 opt1-supplied kw1 kw1-supplied))
(test-clfun) ;;=> (100 nil 200 nil)
(test-clfun 1) => (1 t 200 nil)
(test-clfun nil :kw1 nil) ;;=> (nil t nil t)

引数の値がnilのときに省略されてnilになったのかnilを指定されたのかが区別できます。

ちなみにSVARは分割代入が可能ですが、nilかtしか渡されないのであまり意味は無いと思います。 

(cl-defun test-clfun (&optional (opt1 100 (&whole opt1-sup-all &rest opt1-sup-args)))
  (list opt1 opt1-sup-all opt1-sup-args))
(test-clfun 1) ;;=> (1 t t)

&restまたは&body

[&rest|&body VAR]

&restまたは&bodyの後には一つのVARが続きます。

&restは通常のdefunにもある機能ですが、VARなので分割代入が出来ます。 

(cl-defun test-clfun (a &rest (b c d &key e f))
  (list a b c d e f))
(test-clfun 1 2 3 4 :f 6) ;;=> (1 2 3 4 nil 6)

&bodyという表記には何か意味があるみたいですが詳しいことは知りません。

上でも書きましたが、末尾でVARを書かなくても受け入れられるケースがありますが意図的かは分かりません。

&key

[&key (([KEYWORD] VAR) [INITFORM [SVAR]])... [&allow-other-keys]]

&keyはいわゆる名前付き引数を実現するための機能です。

例えば次のような関数呼び出しを実現します。 

(cl-defun test-clfun (&key a b c d)
  (list a b c d))
(test-clfun :d 345 :b 234 :a 123) ;;=> (123 234 nil 345)

;; より複雑な例 b:初期値, c:分割代入、初期値、指定の有無
(cl-defun test-clfun (&key a (b 222) ((:c (c1 c2)) '(301 302) c-supplied))
  (list a b c1 c2 c-supplied))
(test-clfun :c '(30001 30002) :a 1 :b 2) ;;=> (1 2 30001 30002 t)

キーワードの順番は自由です。

同じキーワードが指定された場合は最初のものが採用され後のものは無視(破棄)されます。 

(cl-defun test-clfun (&key a b c d)
  (list a b c d))
(test-clfun :b 100 :b 101 :b 102) ;;=> (nil 100 nil nil)

INITFORMやSVARは&optionalの時と同じです。省略時はINITFORMの評価値か、INITFORMが無ければnilです。キーワードが指定されたかはSVARに指定した変数で判別可能です。

問題は肝心のキーワードと受け取る変数を指定する部分です。 

(([KEYWORD] VAR) 略)

と書いてありますが、実際にはもう少し説明が必要でしょう。ここに書けるのは次の3パターンです。

シンボル
次の (シンボル) と等価です。
(シンボル 略)
キーワードと変数を同時に指定します。 シンボル の頭に:を付けたものがキーワードになります。もし シンボル の頭に_があるなら先に取り除いてからキーワードにします(未使用変数をマークできるようにするため)。引数の値は シンボル で指定した名前の変数に格納されます。
((シンボル VAR) 略)
シンボル がそのままキーワードになります。引数の値はVARに格納されます。VARなので分割代入が可能です。

末尾に&allow-other-keysが指定されていると定義されていないキーワードでも受け入れます。これは&restと組み合わせて取得したり単に無視することもできます。 

(cl-defun test-clfun (&key a b c d)
  (list a b c d))
(test-clfun :d 345 :b 234 :a 123 :z 999) ;;Keyword argument :z not one of (:a :b :c :d)

(cl-defun test-clfun (&key a b c d &allow-other-keys)
  (list a b c d))
(test-clfun :d 345 :b 234 :a 123 :z 999) ;;=> (123 234 nil 345)

または呼び出し側で許可させることも出来ます。 

(cl-defun test-clfun (&key a b c d)
  (list a b c d))
(test-clfun :d 345 :b 234 :a 123 :z 999 :allow-other-keys t) ;;=> (123 234 nil 345)
(test-clfun :allow-other-keys t :d 345 :b 234 :a 123 :z 999) ;;=> (123 234 nil 345)
(test-clfun :allow-other-keys nil :d 345 :b 234 :a 123 :z 999) ;;Keyword argument :z not one of (:a :b :c :d)

&optionalと&keyを同時に指定した場合

&optionalと&keyの両方が引数リストにある場合は注意が必要です。

例えば次のような書き方は問題ありませんが…… 

(cl-defun test-clfun (a b &optional c d &key e f)
  (list a b c d e f))
(test-clfun 1 2 3 4 :e 5 :f 6) ;;=> (1 2 3 4 5 6)
(test-clfun 1 2 3 4) ;;=> (1 2 3 4 nil nil)
(test-clfun 1 2 nil nil :e 5 :f 6) ;;=> (1 2 nil nil 5 6)

&optionalを省略して&keyを指定することはできません。 

(test-clfun 1 2 :e 5 :f 6) ;;=> (1 2 :e 5 nil 6)

そもそも最初から次のようなミスもあり得ます。 

(test-clfun :e 5 :f 6) ;;=> (:e 5 :f 6 nil nil)

位置引数(positional parameter)と名前付き引数(named parameter)の食い合わせが悪いという言い方も出来るかもしれません。&optionalまでが位置で指定する引数であり、キーワードはその後からになります。

&restと&keyを同時に指定した場合

&restと&keyは並列に処理されます。 

(cl-defun test-clfun (a b &rest args &key c d e)
  (list a b c d e args))
(test-clfun 111 222 :c 3 :d 4 :e 5) ;;=> (111 222 3 4 5 (:c 3 :d 4 :e 5))

&optional引数の最後より後は全て&restで指定されたVARに入るとともに、それらは同時にキーワード引数として処理されます。

&restの方にはあくまで指定されたものがそのまま入ります。 

(cl-defun test-clfun (a b &rest args &key c d e)
  (list a b c d e args))
(test-clfun 111 222 :c 3 :e 5 :c 33 :c 333 999 :allow-other-keys t) ;;=> (111 222 3 nil 5 (:c 3 :e 5 :c 33 :c 333 999 :allow-other-keys t))

&aux

[&aux (VAR [INITFORM])...])

&auxは関数内部で使える変数を定義するためのものらしいです。

次の二つの関数は等価です。 

(cl-defun test-clfun (a b &aux (z (+ a b)))
  ""
  ...)
(cl-defun test-clfun (a b)
  ""
  (let ((z (+ a b)))
    ...))

&auxの部分はドキュメント文字列にも載りません。

なぜこんなものがあるのかは次のページの議論が参考になりそうです。

what is &aux used for?

あながち互換性のためだけのものとは言えないかもしれません。letの字下げが鬱陶しいと思ったことは度々あるので、それが抑えられるのは案外嬉しいかもしれませんね。

もし&auxが引数リストのどこにでも書けてINITFORMから参照できたらもっと有用だったかもしれません。……と思いましたが、VARには分割代入で再帰的な引数リストが書けるのですから次のような使い方は出来ますね。 

(cl-defun test-clfun ((&rest lst &aux (lst-len (length lst))) ;;lengthを1回で済ます！
                      &optional (mid (/ lst-len 2)) (upper lst-len))
  (list lst mid upper lst-len))
(test-clfun '(1 2 3 4 5 6 7 8)) ;;=> ((1 2 3 4 5 6 7 8) 4 8 8)

(追記)&optionalな引数は指定もINITFORMも無い場合でもnilが分割代入されるのでしょうか。 

(cl-defun test-clfun (&optional ((&rest lst &aux (lst-len (length lst)))))
  (list lst lst-len))
(test-clfun) ;;=> (nil 0)

うん、ちゃんと&auxの評価されて0になりますね。

実態に即した文法

以上を踏まえて実態に即した文法を書くとだいたい次のような感じでしょうか？ 

LAMBDA-LIST :
  ([VAR]...
   [&optional [SYMBOL|(VAR [INITFORM [SVAR]])]...]...
   [&rest|&body VAR]
   [&key [SYMBOL|(SYMBOL|(SYMBOL VAR) [INITFORM [SVAR]])]... [&allow-other-keys]]...
   [&aux [(VAR [INITFORM])]...]...)

VAR :
  SYMBOL|
  ([VAR]...
   [&whole SYMBOL]
   [&optional [SYMBOL|(VAR [INITFORM [SVAR]])]...]...
   [&rest|&body VAR]
   [&key [SYMBOL|(SYMBOL|(SYMBOL VAR) [INITFORM [SVAR]])]... [&allow-other-keys]]...
   [&aux [(VAR [INITFORM])]...]...)

SVAR :
  VAR

まぁ、ほとんどは明文化されていない未定義状態なのである日突然変わって鼻から悪魔が出ても文句は言えないかもしれません。

続く

何でこんな重箱の隅をつつくようなことをしているかというと引数リストを解析する必要があったからなのですが、それはまた次のお話しということで。あー、やっぱり面倒くさかった。嫌だ嫌だ。

© 2024 AKIYAMA Kouhei, all rights reserved.