Yearly Archives: 2021

2021-12-30 ,

org-mode で現在の構文要素に応じて適切なメニューを出す

org-cmenuというのを作りました。

misohena/org-cmenu: Context Sensitive Menu for Emacs Org Mode

org-modeって機能は沢山あるしキー割り当てももの凄く沢山あって大変です。とても全部は覚えられないし覚えたとしてもすぐに忘れます。それに何か新しい機能を作ったとして、それをどのキーに割り当てるのかを決めるのも一苦労です。そして自分で作った機能だとしても結局たまにしか使わなければ忘れます。私はorg-modeを使っていると、人間というのは何かを覚え続けてはいられない存在なのだと言うことを痛感させられるんです。

それはともかく、最近また作業を効率化すべく新しい機能を追加したいと思ったのですが、それを実行するキー割り当てを考えていくうちに、やはりこれは文脈に応じて切り替わるメニューのようなものが必要だろうと思うに至ったのでした。

コンテキストメニュー。一般的には対象を右クリックするとそれに対する操作がポップアップで表示されるあれです。まぁ、Emacsなのでマウス用のポップアップメニューにしても仕方が無いので画面下にテキストで表示するのですが、いずれにせよ対象を選びそれに対する操作の中から選ぶというインタフェースは記憶すべきことを大幅に減らしてくれる素晴らしい仕組みです。覚えておくべきなのはそのメニューを開く操作のみです。対象以外で使う操作はメニューに出てこないのでメニューの中から操作を探す手間も最小限です。

Emacsでキー操作用のメニューを作るパッケージとしてはHydraが有名ですが、Hydraは複数行にわたる巨大な文字列でレイアウトを指定するので固定のメニューを作るのには直感的で良いのですが、変化の大きいメニューを作るには向かない気がします(気がするだけで工夫次第で何とかなるのかもしれませんが)。なので最近良く耳にするようになったtransient.elを試してみたのが前回前々回のお話しでした。

transientを使ったとしても色々問題はあったのですが、それはひとまず置いておいて、まずはorg-modeで現在のポイントがある地点の構文要素を割り出す方法についてご紹介したいと思います。

org-elementの使い方

org-modeには標準でorg-elementというのが入っていて、現在位置の構文要素を簡単に割り出せるようになっています。

バッファ(文書)全体を解析する org-element-parse-buffer という関数もありますが、部分的な解析には org-element-at-point と org-element-context という関数が使いやすいです。この二つの関数は共にセクション(見出しと見出しで区切られた範囲)以上の解析は行わず、現在のポイントの近くにある要素を返す関数です。 org-element-at-point は行内要素を含まない大きな構造のみを返し、org-element-context は内部で org-element-at-point を使用しつつ、行内の細かい要素も解析して一番限定された狭い要素を返します。

なので結論から言えば、現在のポイントにある構文要素に関する情報を得たければ (org-element-context) だけでおしまいです。

org-element-context の結果は、例えば次ような リスト です。

(bold
 (:begin 1739
  :end 1745
  :contents-begin 1740
  :contents-end 1743
  :post-blank 1
  :parent (paragraph
           (:begin 1728
            :end 1750
            :contents-begin 1728
            :contents-end 1749
            :post-blank 1
            :post-affiliated 1728
            :parent nil))))

これは実際に上の太字になっているところで M-: (org-element-context) を実行した結果です。boldで始まるノードの親(:parent)としてparagraphで始まるノードが続いているのが見て取れます。その上はsection、headlineと続くはずなのですが、org-element-context(というかorg-element-at-point)はそこまでは解析しません。

ノードから情報を取得するには org-element-type や org-element-property 関数(アクセッサ)を使用します。次のように。

(let ((datum (org-element-context)))
  (list
    (org-element-type datum) ;; => bold
    (org-element-property :begin datum) ;; => 1739
    (org-element-property :end datum))) ;; => 1745

要素の開始点と終了点は必ず取得できるので、これだけで全ての要素に適用出来るコマンドを記述できます。例えば要素全体のマーク(選択)やカット、コピーを実装するのは簡単です。

(defun my-org-kill-element (datum)
  (interactive (list (org-element-context)))
  (kill-region (org-element-property :begin datum)
               (org-element-property :end datum))) ;;本当は色々細かい問題があるのだけどまぁいいや……

org-element-type関数が返すboldやparagraphといったシンボルは type と呼ばれていて構文要素の種類を表します。

構文要素の種類

ところで皆さんはorg-modeにどのくらいの種類の構文要素があるかご存じですか?

org-elements.elの中には次のように書かれている部分があります。

(defconst org-element-all-elements
  '(babel-call center-block clock comment comment-block diary-sexp drawer
               dynamic-block example-block export-block fixed-width
               footnote-definition headline horizontal-rule inlinetask item
               keyword latex-environment node-property paragraph plain-list
               planning property-drawer quote-block section
               special-block src-block table table-row verse-block)
  "Complete list of element types.")

(defconst org-element-all-objects
  '(bold citation citation-reference code entity export-snippet
         footnote-reference inline-babel-call inline-src-block italic line-break
         latex-fragment link macro radio-target statistics-cookie strike-through
         subscript superscript table-cell target timestamp underline verbatim)
  "Complete list of object types.")

リストの中のシンボルがtypeの種類を表しています。org-element-all-elementsの中にあるのが30、org-element-all-objectsの中にあるのが24で計54種類にもなります(org-version 9.5.1 時点)。

org-element.elでは、bold等の行内に現れる要素のことを object と呼んでいて(HTMLで言えばインライン要素?)、それ以上の大きな要素のことを element と呼んでいるようです(HTMLで言えばブロックレベル要素?)。両者を合わせたもの(+α)はdatumと呼んでいる箇所が多いですが、普通にelementと呼んでいる場所もありややこしいです。

シンボルの名前だけだと何を意味しているのか分かりにくいので、全てのtypeを使用したorg-mode文書を作成して理解を深めました。

https://raw.githubusercontent.com/misohena/org-cmenu/main/examples/all-types.org

Emacsの中で見ないと構文がハイライトされないので見づらいですね……。参考までにtypeとそれに関連したマニュアルへのリンクも載せておきます。

all-elements
keyword headline section planning drawer property-drawer node-property clock center-block quote-block verse-block example-block comment-block dynamic-block export-block special-block src-block babel-call paragraph footnote-definition fixed-width comment plain-list item table table-row diary-sexp horizontal-rule inlinetask latex-environment
all-objects
bold underline italic code strike-through verbatim subscript superscript entity inline-babel-call inline-src-block line-break link target radio-target statistics-cookie footnote-reference table-cell timestamp macro export-snippet citation citation-reference latex-fragment

沢山あって大変ですが、やりたいことはこの全要素を網羅したorg-mode文書の各地点で適切なメニューを表示するということになります。

org-elementとtransientをつなぐ

transientには条件毎にメニューの項目を無効化する仕組みがあり、それを使ってメニューの内容を現在の文脈に合わせることもできます。つまり一つのメニュー(transient prefix)を定義して、その中に全部のコマンドを追加して所々述語で無効化していくわけです。

しかしそれよりは、まずtypeとそれに対して使えるコマンドの一覧表があって、そこからtypeごとのメニューを生成してしまった方がずっと楽な気がします。雑然とコマンドが並んでも分かりづらいので、カテゴリー分けするための情報はある程度持たせる必要はありますが。

なので次のような構造を考えました。

type -> group -> ( command[key desc func] | string | group(入れ子) )

まず事前にtypeとgroupに対してcommandを登録していきます。commandが使用できるtypeに対してのみ登録していきます。例えばリンクを開くコマンドはlinkというidを持つtype内の適当なグループに追加します。上のmy-org-kill-elementのように沢山の種類の要素に適用出来るコマンドもあるので、追加先はリストやallのような別名でも指定できるようにしておきます。

そしてメニューを開くときに、org-elementで現在のtypeを割り出し、そのtypeに応じたメニューをgroupから組み立ててtransient-define-prefixで定義して実行します。

org-cmenu

そんな感じのやり方で作ったのがorg-cmenuです。

misohena/org-cmenu: Context Sensitive Menu for Emacs Org Mode

org-cmenu-setup.elというファイルが前述の「typeとgroupに対してcommandを登録していく」処理になり、ここがメニューの内容を決めています。既存のorg-modeのコマンドを分類して追加しているほか、新たに欲しい機能はorg-cmenu-tools.elの方に書いてから追加しています。

メニューの構造を管理したり実際にメニューを表示する部分はorg-cmenu.elに入っています。コアの部分ですがこれだけでは何も表示されません。

これらを使うための設定は次のようになります。

;; メニューを開くorg-cmenuコマンド実行時にorg-cmenu.elを読み込む
(autoload 'org-cmenu "org-cmenu")
;; org-mode内にorg-cmenuコマンドを起動するキーを割り当てる
(add-hook 'org-mode-hook
          (lambda ()
            ;; お好きなキーを設定してください
            (define-key org-mode-map (kbd "C-^") #'org-cmenu)))

;; org-cmenu.elが読み込まれたらorg-cmenuコマンドが起動する前にメニュー内容を登録する
(with-eval-after-load "org-cmenu"
  (require 'org-cmenu-setup) ;;自分専用のsetupファイルに差し替えることもできる
  ;; ここで自分専用のコマンドを追加することもできる
)

リストに対するメニューを開く例

実際にall-types.orgのplain-listがあるところでメニューを起動すると次のようになります。

リストの段落の中でメニューを起動した様子
図1: リストの段落の中でメニューを起動した様子

現在の構文要素はparagraphです。段落に対してできることはまだそれほど多くはありません。何かobjectを挿入したり、全体をカット・コピーしたりするくらいでしょうか。

^キーを押すと一つ上の親要素が選択されます。2回押してplain-listを選択したところが次です。

親要素を選択したところ
図2: 親要素を選択したところ

リスト全体に対しては段落よりももう少し色々な操作ができるようになっています。 リスト全体をチェックボックス化したりLispのリストにしてコピーしたり。

リンクに対するメニュー

次は画像リンクに対して #+CAPTION#+ATTR_HTML を追加する例。

画像リンクに対して属性を追加する例
図3: 画像リンクに対して属性を追加する例

実は今回のメニューはこれがやりたいが為に作ったものでした。何か専用のキーを割り当てるのもバカバカしいちょっとしたことでした。でもCAPTIONやHTML属性(主にwidthやclass)の設定はこの記事を書くためだけでも既に何度も使用しています。

ちなみに #+CAPTION:#+ATTR_HTML:#+NAME: といった部分はorg-elementではaffiliated keywordsと呼ばれていて、原則的には全てのelement(非object)に付加できるようになっています(現実的には例外あり。table-cell等には付けようがない)。org-elementが返すノードの:beginプロパティはこのaffiliated keywordを含む要素全体の先頭になります。affiliated keywordを除いた先頭は:post-affiliatedプロパティで取得できます。

その他、リンクに対してはパス・説明部分の編集、リンク先を開く、パス・ファイル名のコピー、ファイル情報表示等を行えるようにしました。

画像リンクに対する操作一覧
図4: 画像リンクに対する操作一覧

これを作成しているときに初めて知ったのですが、 C-c C-o (org-open-at-point)によるリンクのオープンは、C-uを一回付けるとEmacs優先で、C-uを二回付けると外部アプリ優先(Windowsだとw32-shell-execute)で開くようになっていたんですね。知りませんでした……。

私は画像リンクに対してはプライベートな設定で撮影位置の地図表示やコピー、撮影日時のコピーなんかも加えています。この間やっていたことの続きですね。

表に対するメニュー

次はtable、table-row、table-cellに対する操作の例。

表に対して色々な操作をする例
図5: 表に対して色々な操作をする例

通常のカーソル移動の操作(C-f, C-b, C-p, C-n, C-a, C-e, M-<, M->)だけでセル単位で移動できるようにしてみました。

そのままC-SPCでリージョンを作成すれば複数のセルを矩形で選択、カット・コピー、ペーストできます。

TABやS-TABによるカラム幅の伸縮も非常に直感的になりました。

tableやtable-rowに対する操作をtable-cell選択時にも表示するかは迷ったのですが、あると便利なものは表示しておくことにしました。現在はファイルエクスポートやS式コピーといった頻繁には使わない機能は^でtableを選択しないと出てこないようにしてあります。

Insertメニュー

sectionやparagraph等で表示されるInsertメニュー。まだ発展途上ですが、objectは一通り挿入できるようになっています。elementはまだまだです。

Insertメニュー
図6: Insertメニュー

特に注目したいのがentityの挿入。entityについては以前org-modeで文字をエスケープする方法でも触れましたが、狙った文字を探すのが案外面倒なんですよね。なので、正引き・逆引きの両方に対応した補完入力を付けることで簡単に狙った文字をentityとして追加できるようにしました。C-^ i e & RETで \amp{} と入力されます。

Export Snippetなんかも(普段使わないので)地味に書き方を忘れたりするので便利です。もう書き方を検索する必要はありません!

上付き文字、下付き文字、entityに対するメニュー

superscript、subscript、entityに対しては org-toggle-pretty-entities が候補に出るようになっています。

prettyを有効にしたところ
図7: prettyを有効にしたところ

使っているところでC-^ pを押せば切り替えられるので多少は便利かもしれません。こういう地味な機能を盛り込むのも躊躇無くできるのがorg-cmenuの良い所です。

マニュアルを開く

ところで全てのメニューに ? キーとして Manual というのが書いてあるのにお気づきでしょうか。?キーを押すとその構文要素について書かれているorg-modeマニュアルの該当部分がブラウザで開きます。

これで覚えておかなければならない事がさらに減りますね。

最後に

まだまだ手つかずの構文要素が残っていますが全て埋める必要は無いでしょう。

考えていくといくらでもアイデアが出てきてキリがありません。必要になったときにちょくちょく追加していくことにします。

スニペットの挿入のような個人的なものも後から簡単に追加できるのが良いですね。

2021-12-27

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

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

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

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

(talk)

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

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

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

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

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

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

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

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

2021-12-21

Transientでメニューを作る

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

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

Developer Quick Start Guide

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

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

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

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

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

資料:

2021-12-19

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

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

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

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

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

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

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

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

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

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

;;;; Modify Image Key Map

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

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

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

(my-image-menu-setup)

;;;; Get File Name at Point

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

;;;; Get Image Information

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

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

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

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

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

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

;;;; Open Map of Image Shooting Location

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

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

;;;; Open Directory Containing Image

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

;;;; Open Image by External App

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

;;;; Edit Image by External App

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

;;;; Copy Image Information

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

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

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

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

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

;;;; Execute Shell Command

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

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

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

2021-12-18

Emacs Lispでgpxを解析して過去に自分がいた位置を求める

前回、JPEG画像のExif情報から撮影日時と撮影場所(GPS情報)を取得する方法について書きました。

しかしスマホのカメラなら良いのですが私が持っている普通のカメラではGPS情報は記録されません。何とかならないものでしょうか。

撮影日時は記録されているので、別途時刻と位置を記録したリストがあればそこから割り出すことが可能です。幸い登山中はGeographicaのようなGPSアプリで位置を記録しています。この手のソフトはGPXという形式で位置情報を出力できます。なので、GPXファイルを読み込んで指定した日時の緯度と経度を割り出すものを作成しました。

misohena/my-location: Emacs Lisp code that finds where you were in the past from GPX files.

また、Googleのロケーション履歴にも常に位置情報が記録されています。こちらは端末が発した全位置情報がJSON形式でダウンロード可能です。非常にサイズが大きいのですが、Node.jsを使って1日分ごとにGPXファイルへ変換しました。

求めたい日付に対応するGPXファイル名の検索パターンを作成し、検索し、マッチしたGPXファイルを読み込む仕組みになっています。登山等で作成した 20120304_丸丸岳.gpx のようなファイルも先頭の日付部分にマッチするので2012年3月4日の位置を調べるときには読み込まれます。

GPXはXMLなので、Emacsの libxml-parse-xml-region 関数で簡単にリストへ変換できました。後は記録されている点と点の間を球面で補間するだけでした。

前回のものと合わせると、任意の写真の撮影位置を推定できます。

(let* (;; FILEからExifを読み込む。
       (exif (or (my-exif-parse-file file)
                 (error "No Exif Data")))
       ;; 撮影日時を取得する。
       (time (or (my-exif-date-time-original exif)
                 (error "No Exif.DateTimeOriginal")))
       ;; 撮影位置を取得する。
       (latlng (or (my-exif-latlng exif) ;;From GPS Info
                   (my-location-latlng-at-time time)))) ;From GPX File
  latlng)
2021-12-16

jpgファイルの撮影日時と撮影場所をEmacs Lispで取得する方法(exif.el)

(2021-12-17追記:末尾に色々まとめて修正したコードを追加しました)

(2021-12-19追記:一部のJPEGファイル(XMPが入っているなど)が読み込めない問題も修正しました)

Emacsから写真の撮影日時と撮影場所を取得しようと思ったのですが、適当な外部ツールを呼び出せば良いのかなと思って調べていたところEmacs27にはexif.elというものが標準で入っていることに気がつきました。

試しに手元にあった画像を exif-parse-file 関数で読み取ってみました。

(require 'exif)
(exif-parse-file "~/tmp/20190826_163620.jpg"))

結果は次のようになりました。

((:tag 256 :tag-name nil :format 4 :format-type long :value 4032)
 (:tag 257 :tag-name nil :format 4 :format-type long :value 3024)
 (:tag 258 :tag-name nil :format 3 :format-type short :value "......")
 (:tag 262 :tag-name nil :format 3 :format-type short :value 2)
 (:tag 271 :tag-name make :format 2 :format-type ascii :value "Google")
 (:tag 272 :tag-name model :format 2 :format-type ascii :value "Pixel 3")
 (:tag 274 :tag-name orientation :format 3 :format-type short :value 1)
 (:tag 277 :tag-name nil :format 3 :format-type short :value 3)
 (:tag 282 :tag-name x-resolution :format 5 :format-type rational :value
       (720000 . 10000))
 (:tag 283 :tag-name y-resolution :format 5 :format-type rational :value
       (720000 . 10000))
 (:tag 296 :tag-name resolution-unit :format 3 :format-type short :value 2)
 (:tag 305 :tag-name software :format 2 :format-type ascii :value "Adobe Photoshop CS6 (Windows)")
 (:tag 306 :tag-name date-time :format 2 :format-type ascii :value "2019:08:28 18:19:45")
 (:tag 531 :tag-name nil :format 3 :format-type short :value 1)
 (:tag 34665 :tag-name nil :format 4 :format-type long :value 296)
 (:tag 34853 :tag-name nil :format 4 :format-type long :value 920)
 (:tag 259 :tag-name nil :format 3 :format-type short :value 6)
 (:tag 282 :tag-name x-resolution :format 5 :format-type rational :value
       (72 . 1))
 (:tag 283 :tag-name y-resolution :format 5 :format-type rational :value
       (72 . 1))
 (:tag 296 :tag-name resolution-unit :format 3 :format-type short :value 2)
 (:tag 513 :tag-name nil :format 4 :format-type long :value 1266)
 (:tag 514 :tag-name nil :format 4 :format-type long :value 7524))

:tag-nameexif-tag-alist に設定されている10種類以外はnilとなっています。

;; exif.elより
(defvar exif-tag-alist
  '((11 processing-software)
    (271 make)
    (272 model)
    (274 orientation)
    (282 x-resolution)
    (283 y-resolution)
    (296 resolution-unit)
    (305 software)
    (306 date-time)
    (315 artist))
  "Alist of tag values and their names.")

Exifには膨大な量のタグが定義されているのでとても全ては網羅できないでしょう。撮影日時や場所に関するtag-nameもここには設定されていません(date-timeは最終更新日時です)。

なので必要な情報は :tag の数値から判断する必要があります。タグの種類についてはCIPA DC-X008-2019-J(Exif 2.32)あたりを見れば良いようです。

exif-parse-file 関数が返したリストは 0th IFD (Image File Directory) というもので、その中には撮影日時や撮影場所といった細かい情報は直接入っていません。撮影日時はExif IFD Pointer(タグ番号34665)の指す先に、場所はGPS Info IFD Pointer(タグ番号34853)の指す先にあります。各Pointerの値は共に一つの整数値(上の写真の場合は296と920)となっていて、情報はその整数値(オフセット)が指し示す先に別途格納されています。exif.elの作者のページ(Parsing Exif Data – Random Thoughts)によれば画像の回転に関するプロパティを取得するために作成したようなので、0th IFD内のorientation(タグ番号274)が読めれば十分でありPointerの先までは読み込んでいないのでしょう。

上の写真のExif IFD Pointerの値は296、GPS Info IFD Pointerの値は920。これらはどこからのオフセットなのでしょうか。exif.elを読んでいくと、 exif-parse-fileexif-parse-bufferexif--parse-jpegexif--parse-exif-chunkexif--parse-directory と処理が流れていることが分かります。ファイル冒頭のコメントによれば全てのオフセットは IIまたはMM で始まるチャンクの先頭からの相対値ということなので、 exif--parse-exif-chunk の中で (delete-region (point-min) (point)) した後のバッファ内のポイント位置-1がオフセットと対応することになります(Emacsのバッファ内ポイント位置は1から始まるのことに注意)。 delete-region で不要な部分を削除することで (goto-char (1+ offset)) という単純な式でジャンプできるようにしているのだと思います。

うーんどうしましょうね。

任意のオフセットからIFDを読み込むにはgoto-charでポイントを移動した上でexif--parse-directoryを呼び出せば良いのですが、肝心のデータを格納したバッファを保持しておく方法が用意されていません。exif-parse-bufferはExifで始まるチャンク全体を一時的なバッファに格納しますが、0th IFDを読み込んだ後にすぐに捨ててしまいます。そこに追加の処理を挟めるようにはできていません。ちゃんとやるならこの関数を切り刻んで再構成するよりありませんが……。

とりあえず exif--parse-directory を一時的に上書きして動作を変えてしまいましょうか。値の読み込みが終わり、バッファにまだアクセスでき、tagの判別ができるポイントがそこしかないので。

(defun my-exif-prop-find (exif tag)
  (seq-find (lambda (e) (equal (plist-get e :tag) tag)) exif))
(defun my-exif-parse-file (file)
  (cl-letf* (((symbol-function 'exif--parse-directory-old)
              (symbol-function 'exif--parse-directory))
             ((symbol-function 'exif--parse-directory)
              (lambda (le)
                (let ((exif (exif--parse-directory-old le)) ;;元の関数を呼び出す
                      (pointer-tags '(34665 34853))) ;;Exif IFD Pointer, GPS Info IFD Pointer
                  (dolist (tag pointer-tags)
                    (let* ((property (my-exif-prop-find exif tag))
                           (offset (plist-get property :value)))
                      (when (integerp offset)
                        (goto-char (1+ offset))
                        ;; :valueのオフセットから情報を読み取り、:pointeeとして追加する
                        (nconc property (list :pointee
                                              (exif--parse-directory le))))))
                  exif))))
    (exif-parse-file file)))

(my-exif-parse-file "~/tmp/20190826_163620.jpg")

実行結果は次のようになります。

((:tag 256 :tag-name nil :format 4 :format-type long :value 4032)
 (:tag 257 :tag-name nil :format 4 :format-type long :value 3024)
 (:tag 258 :tag-name nil :format 3 :format-type short :value "......")
 (:tag 262 :tag-name nil :format 3 :format-type short :value 2)
 (:tag 271 :tag-name make :format 2 :format-type ascii :value "Google")
 (:tag 272 :tag-name model :format 2 :format-type ascii :value "Pixel 3")
 (:tag 274 :tag-name orientation :format 3 :format-type short :value 1)
 (:tag 277 :tag-name nil :format 3 :format-type short :value 3)
 (:tag 282 :tag-name x-resolution :format 5 :format-type rational :value
       (720000 . 10000))
 (:tag 283 :tag-name y-resolution :format 5 :format-type rational :value
       (720000 . 10000))
 (:tag 296 :tag-name resolution-unit :format 3 :format-type short :value 2)
 (:tag 305 :tag-name software :format 2 :format-type ascii :value "Adobe Photoshop CS6 (Windows)")
 (:tag 306 :tag-name date-time :format 2 :format-type ascii :value "2019:08:28 18:19:45")
 (:tag 531 :tag-name nil :format 3 :format-type short :value 1)
 (:tag 34665 :tag-name nil :format 4 :format-type long :value 296 :pointee
       ((:tag 33434 :tag-name nil :format 5 :format-type rational :value
              (810 . 1000000))
        (:tag 33437 :tag-name nil :format 5 :format-type rational :value
              (180 . 100))
        (:tag 34850 :tag-name nil :format 3 :format-type short :value 2)
        (:tag 34855 :tag-name nil :format 3 :format-type short :value 41)
        (:tag 36864 :tag-name nil :format 7 :format-type unknown :value 808596016)
        (:tag 36867 :tag-name nil :format 2 :format-type ascii :value "2019:08:26 16:36:20")
        (:tag 36868 :tag-name nil :format 2 :format-type ascii :value "2019:08:26 16:36:20")
        (:tag 37121 :tag-name nil :format 7 :format-type unknown :value 197121)
        (:tag 37377 :tag-name nil :format 10 :format-type unknown :value 802)
        (:tag 37378 :tag-name nil :format 5 :format-type rational :value
              (170 . 100))
        (:tag 37379 :tag-name nil :format 10 :format-type unknown :value 818)
        (:tag 37380 :tag-name nil :format 10 :format-type unknown :value 826)
        (:tag 37381 :tag-name nil :format 5 :format-type rational :value
              (170 . 100))
        (:tag 37382 :tag-name nil :format 5 :format-type rational :value
              (4294967295 . 1))
        (:tag 37383 :tag-name nil :format 3 :format-type short :value 2)
        (:tag 37385 :tag-name nil :format 3 :format-type short :value 16)
        (:tag 37386 :tag-name nil :format 5 :format-type rational :value
              (4440 . 1000))
        (:tag 37520 :tag-name nil :format 2 :format-type ascii :value "286725")
        (:tag 37521 :tag-name nil :format 2 :format-type ascii :value "286725")
        (:tag 37522 :tag-name nil :format 2 :format-type ascii :value "286725")
        (:tag 40960 :tag-name nil :format 7 :format-type unknown :value 808464688)
        (:tag 40961 :tag-name nil :format 3 :format-type short :value 1)
        (:tag 40962 :tag-name nil :format 4 :format-type long :value 1280)
        (:tag 40963 :tag-name nil :format 4 :format-type long :value 960)
        (:tag 40965 :tag-name nil :format 4 :format-type long :value 888)
        (:tag 41495 :tag-name nil :format 3 :format-type short :value 2)
        (:tag 41729 :tag-name nil :format 7 :format-type unknown :value 1)
        (:tag 41985 :tag-name nil :format 3 :format-type short :value 1)
        (:tag 41986 :tag-name nil :format 3 :format-type short :value 0)
        (:tag 41987 :tag-name nil :format 3 :format-type short :value 0)
        (:tag 41988 :tag-name nil :format 5 :format-type rational :value
              (0 . 1))
        (:tag 41989 :tag-name nil :format 3 :format-type short :value 27)
        (:tag 41990 :tag-name nil :format 3 :format-type short :value 0)
        (:tag 41992 :tag-name nil :format 3 :format-type short :value 0)
        (:tag 41993 :tag-name nil :format 3 :format-type short :value 0)
        (:tag 41994 :tag-name nil :format 3 :format-type short :value 0)
        (:tag 41996 :tag-name nil :format 3 :format-type short :value 3)))
 (:tag 34853 :tag-name nil :format 4 :format-type long :value 920 :pointee
       ((:tag 0 :tag-name nil :format 1 :format-type byte :value 514)
        (:tag 1 :tag-name nil :format 2 :format-type ascii :value "N")
        (:tag 2 :tag-name nil :format 5 :format-type rational :value
              ((36 . 1)
               (17 . 1)
               (4154 . 100)))
        (:tag 3 :tag-name nil :format 2 :format-type ascii :value "E")
        (:tag 4 :tag-name nil :format 5 :format-type rational :value
              ((137 . 1)
               (43 . 1)
               (1775 . 100)))
        (:tag 5 :tag-name nil :format 1 :format-type byte :value 0)
        (:tag 6 :tag-name nil :format 5 :format-type rational :value
              (269007 . 100))
        (:tag 7 :tag-name nil :format 5 :format-type rational :value
              ((7 . 1)
               (36 . 1)
               (16 . 1)))
        (:tag 11 :tag-name processing-software :format 5 :format-type rational :value
              (5029 . 1000))
        (:tag 27 :tag-name nil :format 7 :format-type unknown :value "ASCII...fused")
        (:tag 29 :tag-name nil :format 2 :format-type ascii :value "2019:08:26")))
 (:tag 259 :tag-name nil :format 3 :format-type short :value 6)
 (:tag 282 :tag-name x-resolution :format 5 :format-type rational :value
       (72 . 1))
 (:tag 283 :tag-name y-resolution :format 5 :format-type rational :value
       (72 . 1))
 (:tag 296 :tag-name resolution-unit :format 3 :format-type short :value 2)
 (:tag 513 :tag-name nil :format 4 :format-type long :value 1266)
 (:tag 514 :tag-name nil :format 4 :format-type long :value 7524))

:tag 34665の部分にEXIFデータが、:tag 34853の部分にGPS情報が :pointee プロパティとして追加されました。

試しに撮影日時を取得してみましょう。撮影日時の格納場所は34665(Exif IFD Pointer)が指している先の36867(DateTimeOriginal)です。

(defun my-exif-prop-value (exif tag &optional key)
  (plist-get (my-exif-prop-find exif tag) (or key :value)))

(let* ((exif (my-exif-parse-file "~/tmp/20190826_163620.jpg"))
       (exif-ifd (my-exif-prop-value exif 34665 :pointee))
       (date-time-original (my-exif-prop-value exif-ifd 36867)))
  date-time-original)
"2019:08:26 16:36:20"

いくつか別のカメラで撮影したファイルも確認してみましたが、現地時間で記録されているように見えます。最近の写真だと:tag 36881 としてタイムゾーン("+09:00")が付いているものもあるようです。

続いてGPS情報。

(let* ((exif (my-exif-parse-file "~/tmp/20190826_163620.jpg"))
       (gps-ifd (my-exif-prop-value exif 34853 :pointee)))
  (list
    (my-exif-prop-value gps-ifd 1)
    (my-exif-prop-value gps-ifd 2)
    (my-exif-prop-value gps-ifd 3)
    (my-exif-prop-value gps-ifd 4)))
(N (36 . 1) E (137 . 1))

あれ??? なんだか変な結果になっていますね。緯度経度は「度分秒」三つの分数で表現されているはずなのですがどうやら一つしか読み取っていないようです。

うー、しょうがないですねぇ。 exif--process-value を直接差し替えてしまいましょう。

(defun exif--process-value (value type le)
  "Do type-based post-processing of the value."
  (cl-case type
    ;; Chop off trailing zero byte.
    ('ascii (substring value 0 (1- (length value))))
    ('rational (with-temp-buffer
                 (set-buffer-multibyte nil)
                 (insert value)
                 (goto-char (point-min))
                 ;; ここから
                 (let* ((num-values (/ (length value) 8))
                        (nums (cl-loop repeat num-values
                                       collect (cons (exif--read-number 4 le)
                                                     (exif--read-number 4 le)))))
                   (if (= num-values 1)
                       (car nums)
                     nums))
                 ;; ここまで修正
                 ))
    (otherwise value)))

本当は分数以外の型も同じようにしなければならないはずですが、まぁ、とりあえずということで。(追記:修正したものを末尾に載せました)

これを使うと緯度経度が正しく三つの分数で取得できるようになります。

(let* ((exif (my-exif-parse-file "~/tmp/20190826_163620.jpg"))
       (gps-ifd (my-exif-prop-value exif 34853 :pointee)))
  (list
    (my-exif-prop-value gps-ifd 1)
    (my-exif-prop-value gps-ifd 2)
    (my-exif-prop-value gps-ifd 3)
    (my-exif-prop-value gps-ifd 4)))
("N"
 ((36 . 1)
  (17 . 1)
  (4154 . 100))
 "E"
 ((137 . 1)
  (43 . 1)
  (1775 . 100)))

今度はうまく行きました。小数に直すなら次のようになります。

(defun my-exif-3rationals-to-float (v neg)
  (let ((value (+
                (/ (caar v) (* 1.0 (cdar v)))
                (/ (caadr v) (* 60.0 (cdadr v)))
                (/ (caaddr v) (* 3600.0 (cdaddr v))))))
    (if neg (- value) value)))

(let* ((exif (my-exif-parse-file "~/tmp/20190826_163620.jpg"))
       (gps (my-exif-prop-value exif 34853 :pointee)))
  (format "%.6f,%.6f"
          (my-exif-3rationals-to-float (my-exif-prop-value gps 2)
                                       (string= (my-exif-prop-value gps 1) "S"))
          (my-exif-3rationals-to-float (my-exif-prop-value gps 4)
                                       (string= (my-exif-prop-value gps 1) "W"))))
"36.294872,137.721597"

このように色々一筋縄ではいかない様子を見ると大人しく外部ツールを使えよという声が聞こえてきそうですが、一応このような方法でも取得できるということで。ちなみにimage-diredはexiftoolを使うみたいです。

せっかく標準で入っているのに活用しないのは何だか勿体ないですね。ただ、jpgファイル全体を一度バッファに読み込む実装になっているので、巨大なjpgファイルの場合あまり効率は良くないかもしれません。これは insert-file-contents-literallybegend 引数で改善できるかもしれません。

(2021-12-17追記: Emacs27のexif.elにはビッグエンディアンのファイルが正しく読み込めないバグが二箇所ありました。一箇所は最新版では修正されていますが、もう一箇所はまだ修正されていないようです(for value = (exif--read-number 4 le) の部分)。また、上で書いたように複数の値を正しく読み込めない問題もありました。それらを修正したのが以下のバージョンになります)

(2021-12-19追記: Exif以外のAPP1セグメントを考慮していないバグも修正しました。例えばXMPというメタ情報が入っているとエラーになって読み込めませんでした。 exif--parse-jpeg 関数を my-exif--find-app1-exif-in-jpeg 関数で置き換えて修正しています)

20211219_my-exif.el

(require 'exif)

(defun my-exif-prop-find (exif tag)
  (seq-find (lambda (e) (equal (plist-get e :tag) tag)) exif))

(defun my-exif-prop-value (exif tag &optional key)
  (plist-get (my-exif-prop-find exif tag) (or key :value)))

(defun my-exif-3rationals-to-float (v neg)
  (let ((value (+
                (/ (caar v) (* 1.0 (cdar v)))
                (/ (caadr v) (* 60.0 (cdadr v)))
                (/ (caaddr v) (* 3600.0 (cdaddr v))))))
    (if neg (- value) value)))

;;

(defun my-exif-parse-file (file)
  (cl-letf (((symbol-function 'exif--parse-jpeg)
             #'my-exif--find-app1-exif-in-jpeg) ;; [BugFix] Support APP1 segments that are not Exif (Such as XMP)
            ((symbol-function 'exif--parse-exif-chunk)
             #'my-exif--parse-exif-chunk))
    (exif-parse-file file)))

(defun my-exif--find-app1-exif-in-jpeg ()
  (unless (= (exif--read-number-be 2) #xffd8) ; SOI (start of image)
    (signal 'exif-error "Not a valid JPEG file"))
  (cl-loop for segment = (exif--read-number-be 2)
           for size = (exif--read-number-be 2)
           ;; Stop parsing when we get to SOS (start of stream);
           ;; this is when the image itself starts, and there will
           ;; be no more chunks of interest after that.
           while (not (= segment #xffda)) ;;FFDA=SOS
           do (if (and (= segment #xffe1) ;;FFE1=APP1
                       (equal (save-excursion (exif--read-chunk 6))
                              (string ?E ?x ?i ?f ?\0 ?\0)))
                  ;; Return APP1 Exif
                  ;; (Matched to return value of exif--parse-jpeg)
                  (cl-return (list
                              (cons segment (exif--read-chunk (- size 2)))))
                ;; Skip segment
                (forward-char (- size 2)))))

(defun my-exif--parse-exif-chunk (data)
  (with-temp-buffer
    (set-buffer-multibyte nil)
    (insert data)
    (goto-char (point-min))
    ;; The Exif data is in the APP1 JPEG chunk and starts with
    ;; "Exif\0\0".
    (unless (equal (exif--read-chunk 6) (string ?E ?x ?i ?f ?\0 ?\0))
      (signal 'exif-error "Not a valid Exif chunk"))
    (delete-region (point-min) (point))
    (let* ((endian-marker (exif--read-chunk 2))
           (le (cond
                ;; "Motorola" is big-endian.
                ((equal endian-marker "MM")
                 nil)
                ;; "Intel" is little-endian.
                ((equal endian-marker "II")
                 t)
                (t
                 (signal 'exif-error
                         (format "Invalid endian-ness %s" endian-marker))))))
      ;; Another magical number.
      (unless (= (exif--read-number 2 le) #x002a)
        (signal 'exif-error "Invalid TIFF header length"))
      (let ((offset (exif--read-number 4 le))) ;; <==== [BugFix] 2 => 4 ====
        ;; Jump to where the IFD (directory) starts and parse it.
        (when (> (1+ offset) (point-max))
          (signal 'exif-error "Invalid IFD (directory) offset"))
        (goto-char (1+ offset))
        (my-exif--parse-directory le)))))

(defun my-exif--parse-directory (le)
  (let ((dir
         (cl-loop repeat (exif--read-number 2 le)
                  collect (my-exif--read-value le))))
    (let ((next (exif--read-number 4 le)))
      (if (> next 0)
          ;; There's more than one directory; if so, jump to it and
          ;; keep parsing.
          (progn
            (when (> (1+ next) (point-max))
              (signal 'exif-error "Invalid IFD (directory) next-offset"))
            (goto-char (1+ next))
            (nconc dir (my-exif--parse-directory le)))
        ;; We've reached the end of the directories.
        dir))))

(defvar my-exif-pointer-tags '(34665 ;;Exif IFD Pointer
                               34853)) ;;GPS Info IFD Pointer

(defun my-exif--read-value (le)
  ;; [Add] Support multiple components
  ;; [BugFix] Reading small value length < 4 and big-endian
  (let* ((tag (exif--read-number 2 le))
         (format (exif--read-number 2 le))
         (field-format (my-exif--field-format format))
         (type (car field-format))
         (bytes/component (cdr field-format))
         (num-components (exif--read-number 4 le))
         (num-bytes (* num-components bytes/component))
         (components
          (save-excursion
            (when (> num-bytes 4)
              ;; If the length of the data is
              ;; more than 4 bytes, then it's
              ;; actually stored after this
              ;; directory, and the value
              ;; here is just the offset to
              ;; use to find the data.
              (let ((offset (exif--read-number 4 le)))
                (when (> (+ (1+ offset) num-bytes)
                         (point-max))
                  (signal 'exif-error
                          "Premature end of file"))
                (goto-char (1+ offset))))

            (pcase type
              ;;@todo support signed
              ;;@todo support float and double
              ((or 'byte 'short 'long
                   's-byte 's-short 's-long)
               (cl-loop repeat num-components
                        collect (exif--read-number bytes/component le)))
              ((or 'rational 's-rational)
               (cl-loop repeat num-components
                        collect (cons
                                 (exif--read-number 4 le)
                                 (exif--read-number 4 le))))
              ('ascii
               (buffer-substring (point) (+ (point) num-bytes -1)));;Chop off trailing zero byte.
              ('undefined
               (buffer-substring (point) (+ (point) num-bytes)))
              (_
               nil))))
         (value (cond
                 ((eq type 'ascii)
                  components)
                 ((eq type 'undefined)
                  components)
                 ((= num-components 1)
                  (car components))
                 (t
                  components)))
         (pointee (when (and (memq tag my-exif-pointer-tags)
                             (integerp value))
                    (save-excursion
                      (goto-char (1+ value))
                      (my-exif--parse-directory le)))))
    ;; Skip Value (4 bytes)
    (goto-char (+ (point) 4))

    (nconc
     (list
      :tag tag
      :tag-name (cadr (assq tag my-exif-tag-alist))
      :format format
      :format-type (car field-format)
      :value value)
     (when pointee
       (list :pointee pointee)))))

(defun my-exif--field-format (number)
  (cl-case number
    (1 (cons 'byte 1))
    (2 (cons 'ascii 1))
    (3 (cons 'short 2))
    (4 (cons 'long 4))
    (5 (cons 'rational 8))
    (6 (cons 's-byte 1))
    (7 (cons 'undefined 1))
    (8 (cons 's-short 2))
    (9 (cons 's-long 4))
    (10 (cons 's-rational 8))
    (11 (cons 'float 4))
    (12 (cons 'double 8))
    (otherwise (cons 'unknown 1))))

(defvar my-exif-tag-alist
  '((11 processing-software)
    (256 image-width)
    (257 image-length)
    (258 bits-per-sample)
    (259 compression)
    (262 photometric-interpretation)
    (270 image-description)
    (271 make)
    (272 model)
    (273 strip-offsets)
    (274 orientation)
    (277 samples-per-pixel)
    (282 x-resolution)
    (283 y-resolution)
    (296 resolution-unit)
    (305 software)
    (306 date-time)
    (315 artist)
    (513 jpeg-interchange-format)
    (514 jpeg-interchange-format-length)
    (531 ycbcr-positioning)
    (33434 exposure-time)
    (33437 f-number)
    (34665 exif-ifd-pointer)
    (34850 exposure-program)
    (34853 gps-info-ifd-pointer)
    (34855 iso-speed-ratings)
    (36864 exif-version)
    (36867 date-time-original)
    (36868 date-time-digitized)
    (37121 components-configuration)
    (37377 shutter-speed-value)
    (37378 aperture-value)
    (37379 brightness-value)
    (37380 exposure-bias-value)
    (37381 max-aperture-value)
    (37382 subject-distance)
    (37383 metering-mode)
    (37384 light-source)
    (37385 flash)
    (37386 focal-length)
    (37520 sub-sec-time)
    (37521 sub-sec-time-original)
    (37522 sub-sec-time-digitized)
    (40960 flashpix-version)
    (40961 color-space)
    (40962 pixel-x-dimension)
    (40963 pixel-y-dimension)
    (40964 related-sound-file)
    (40965 interoperability-tag)
    (41495 sensing-method)
    (41729 scene-type)
    (41985 custom-rendered)
    (41986 exposure-mode)
    (41987 white-balance)
    (41988 digital-zoom-ratio)
    (41989 focal-length-in-35mm-film)
    (41990 scene-capture-type)
    (41991 gain-control)
    (41992 contrast)
    (41993 saturation)
    (41994 sharpness)
    (41995 device-setting-description)
    (41996 subject-distance-range))
  "Alist of tag values and their names.")

;;

(defun my-exif-encode-date-time (exif-date-time-str)
  (when exif-date-time-str
    (encode-time
     (nconc
      (nreverse
       (mapcar #'string-to-number
               (split-string exif-date-time-str "[ :]")))
      (list nil nil nil)))))

(defun my-exif-date-time-original (exif)
  (when-let ((exif-ifd (my-exif-prop-value exif 34665 :pointee))
             (date-time-original (my-exif-prop-value exif-ifd 36867)))
    (my-exif-encode-date-time date-time-original)))

(defun my-exif-latlng (exif)
  (when-let ((gps (my-exif-prop-value exif 34853 :pointee))
             (lat-ref (my-exif-prop-value gps 1))
             (lat (my-exif-prop-value gps 2))
             (lng-ref (my-exif-prop-value gps 3))
             (lng (my-exif-prop-value gps 4)))
    (cons
     (my-exif-3rationals-to-float lat
                                  (string= lat-ref "S"))
     (my-exif-3rationals-to-float lng
                                  (string= lng-ref "W")))))

これを使うと撮影日時と撮影場所は次のコードで取得できます。

(let ((exif (my-exif-parse-file "~/tmp/20190826_163620.jpg")))
  (list
   (format-time-string "%Y-%m-%d %H:%M:%S" (my-exif-date-time-original exif))
   (my-exif-latlng exif)))
("2019-08-26 16:36:20"
 (36.29487222222222 . 137.72159722222221))
2021-12-14 ,

HTMLでエクスポートしたorg-modeのリンクを新しいタブで開くようにする

1. 目的

HTMLでリンク先を新しいタブで開くにはa要素の属性として target="_blank" を指定します。全ての文書で常に新しいタブで開くのはどうかと思いますが、特定の文書(ページ)内は一律そうして欲しいケースもあると思います。

org-modeのリンクをHTMLでエクスポートしたとき、デフォルトではもちろんそのような属性は付きません。リンクの前に #+attr_html: :target _blank のような指定を入れれば実現可能ですが沢山のリンクがあると面倒ですし入れ忘れも生じます。また、一つの段落に複数のリンクがある場合、全てのリンクに属性が反映されないという問題もあります。

#+attr_html: :target _blank :rel noopener
[​[http://example.com/]]は別タブで開きます。二つ目のリンク[​[http://example.org/]]は開きません。

というわけで今回はorg-modeのフィルタシステムを使用して自動的に全てのリンクに新しいタブで開くための属性を入れてみたいと思います。

2. フィルタ関数の作成

まずフィルタ関数を作成します。

(defun org-newtab-link-filter (s backend info)
  (if (and
       ;;@todo Support <a data-ex=">" href=...>
       (org-export-derived-backend-p backend 'html) ;; html only
       (not (string-match "\\`[^>]* target=\"" s)) ;; has no target=
       (not (string-match "\\`[^>]* rel=\"" s)) ;; has no rel=
       (string-match "\\`[^>]* href=\"[^#]" s) ;;not internal link
       (string-match "\\`<a " s)) ;; a tag
      (replace-match "<a target=\"_blank\" rel=\"noopener\" " t t s)
    s))

この関数はHTMLのa要素にtarget属性とrel属性を挿入します。ただし追加するのは次の条件が全て満たされているときのみです。

  • HTMLバックエンドかその派生のバックエンドでエクスポート中であること
  • target=rel= がまだ指定されていないこと
  • リンク先が # で始まるページ内リンクではないこと

3. フィルタ関数の登録

次にこのフィルタがエクスポート時に使われるようにするのですが、これには色々な方法があります。

3.1. 変数 org-export-filter-link-functions に設定する方法

org-export-filter-TYPE-functions という名前の変数にフィルタ関数を登録すると、構文要素 TYPE のエクスポート結果を再処理できます。リンク要素に対するフィルタは org-export-filter-link-functions という変数へ登録します。(参考: Advanced Export Configuration (The Org Manual))

この方法で個別のファイルにフィルターを設定する方法については以前書きました。

個別のorg-modeファイルにエクスポート時のフィルターを設定する

例えば次のようにソースブロックを使ってエクスポートするたびにバッファローカル変数を設定するようにします。

#+BEGIN_SRC emacs-lisp :exports results :results none
(setq-local org-export-filter-link-functions '(org-newtab-link-filter))
#+END_SRC

[​[https://example.com]]

#+BIND: を使っても良いのですが org-export-allow-bind-keywordst でないと動作しないので、それならソースブロックにして評価するかyes/no確認を入れた方が良いと思います。

3.2. 派生したバックエンドを作成する方法

次のコードはhtmlバックエンドから派生したnewtab-link-htmlバックエンドを作成するものです。(参考: Advanced Export Configuration (The Org Manual))

;; エクスポートオプションで有効/無効を切り替えるしくみ(後述)
(defvar org-newtab-link-enabled nil) ;;tでデフォルト有効

(defvar org-newtab-link-options-alist
  '((:newtab-link-enabled "HTML_LINK_NEWTAB" nil org-newtab-link-enabled)))

(defun org-newtab-link-filter-opt (s backend info)
  (if (not (member (plist-get info :newtab-link-enabled) '(nil "" "nil" "no")))
      (org-newtab-link-filter s backend info)
    s))

;; HTMLから派生したバックエンドを作る
(defun org-newtab-link-define-backend ()
  (require 'ox-html)
  (org-export-define-derived-backend
      'newtab-link-html 'html
    :filters-alist '((:filter-link . org-newtab-link-filter-opt))
    :options-alist org-newtab-link-options-alist

    :menu-entry
    '(?n "Export to HTML (Enable org-newtab-link)"
         ((?N "As HTML buffer" org-newtab-link-export-as-html)
          (?n "As HTML file" org-newtab-link-export-to-html)
          (?o "As HTML file and open"
              (lambda (a s v b)
                (if a (org-newtab-link-export-to-html t s v b)
                  (org-open-file (org-newtab-link-export-to-html nil s v b)))))))))

(defun org-newtab-link-export-as-html
    (&optional async subtreep visible-only body-only ext-plist)
  (interactive)
  (org-export-to-buffer 'newtab-link-html "*Org Go Game HTML Export*"
    async subtreep visible-only body-only ext-plist
    (lambda () (set-auto-mode t))))

(defun org-newtab-link-export-to-html
    (&optional async subtreep visible-only body-only ext-plist)
  (interactive)
  (let* ((extension (concat "." (or (plist-get ext-plist :html-extension)
                                    org-html-extension
                                    "html")))
         (file (org-export-output-file-name extension subtreep))
         (org-export-coding-system org-html-coding-system))
    (org-export-to-file 'newtab-link-html file
      async subtreep visible-only body-only ext-plist)))

(org-newtab-link-define-backend)

エクスポートメニューにもエントリーを追加するので、 C-c C-e n n といったキー操作でフィルタを有効にしたエクスポートが可能です。

しかしこの方法にはいくつか欠点があります。

  • HTMLから派生した他のバックエンドには適用されない。
  • メニューが煩雑になる。
  • エクスポート時に明示的にバックエンドを選ばなければならない。

こういった問題があることを考えるとバックエンドを派生させるというアイデアはそれほど良いものとは思えなくなってきます。

3.3. HTMLバックエンドを修正する方法

派生したバックエンドを作るよりも既存のHTMLバックエンドを修正した方が使い勝手は良いものになります。ただし、他にもバックエンドを修正するコードがあるかもしれないので干渉しないように注意しましょう。

(defun org-newtab-link-modify-html-backend ()
  (require 'ox-html)
  (let ((backend (org-export-get-backend 'html)))
    ;; org-newtab-link-options-alistで定義されているオプションをバックエンドへ追加
    (let ((backend-options (org-export-backend-options backend))
          (new-option-names (mapcar #'car org-newtab-link-options-alist)))
      (setf (org-export-backend-options backend)
            (nconc
             (seq-remove (lambda (elem) (memq (car elem) new-option-names))
                         backend-options)
             org-newtab-link-options-alist)))

    ;; フィルタ関数org-newtab-link-filter-optをバックエンドの:filter-linkへ追加
    (let ((filter-link (assq :filter-link
                                   (org-export-backend-filters backend))))
      ;; null => (:filter-link . ())
      (when (null filter-link)
        (push (setq filter-link (list :filter-link))
              (org-export-backend-filters backend)))
      ;; (:filter-link . function) => (:filter-link . (function))
      (when (functionp (cdr filter-link))
        (setcdr filter-link (list (cdr filter-link))))
      ;; Add my filter function
      (when (not (memq 'org-newtab-link-filter-opt (cdr filter-link)))
        (push 'org-newtab-link-filter-opt (cdr filter-link))))))

(org-newtab-link-modify-html-backend)

こうすると通常のHTMLバックエンドによるエクスポートでリンクをフィルタできるようになります。

4. フィルタの有効/無効を切り替える

リンクを常に新しいタブで開くのなら良いのですが、たいていの場合目的に応じて切り替える必要があるでしょう。プロジェクトやディレクトリ、ファイルによって柔軟に切り替えられるようにしておく必要があります。

4.1. ファイルローカル変数・ディレクトリローカル変数を使用する方法

一番簡単なのはファイルローカル変数という仕組みを使用して、ファイルやディレクトリ毎に org-export-filter-link-functions 変数を変更することです。

まずバッファローカル変数にフィルタを設定する org-newtab-link-enable という関数を作ります。

(defun org-newtab-link-enable ()
  (setq-local org-export-filter-link-functions
              (cons #'org-newtab-link-filter
                    org-export-filter-link-functions)))

そしてそれをファイルローカル変数として安全に評価できるように設定します。ファイルを開くたびに警告が出るのは鬱陶しいので。

(add-to-list 'safe-local-eval-forms '(org-newtab-link-enable))

その上で次のように .dir-locals.el を作成します(M-x add-dir-local-variableorg-modeeval(org-newtab-link-enable) と入力等)。

;;; Directory Local Variables
;;; For more information see (info "(emacs) Directory Variables")

((org-mode . ((eval . (org-newtab-link-enable)))))

するとそのディレクトリ下にあるorgファイルを開いたときに、自動的に変数 org-export-filter-link-functions にフィルタ関数がバッファローカルとして設定されます。

org-modeはエクスポート時にフィルタ変数の値を読み取ってバックエンドオブジェクトのプロパティにコピーするので、エクスポート用に一時的に作られるバッファ上でも設定したフィルタが正しく使われます。下手に新しく専用のバッファローカル変数を作成すると、その変数はエクスポート用のバッファにコピーされないので正しく動作しません。

4.2. エクスポートオプションを追加する方法

#+HTML_LINK_NEWTAB: t のような記述でファイル毎に制御できると便利です。

これを実現するにはバックエンドオブジェクトにオプション定義を追加する必要があります。そのための仕組みは既に上のバックエンドを定義する方法の所に書いてあります。以下一部を再掲します。

(defvar org-newtab-link-enabled nil) ;;tでデフォルト有効

(defvar org-newtab-link-options-alist
  '((:newtab-link-enabled "HTML_LINK_NEWTAB" nil org-newtab-link-enabled)))

(defun org-newtab-link-filter-opt (s backend info)
  (if (not (member (plist-get info :newtab-link-enabled) '(nil "" "nil" "no")))
      (org-newtab-link-filter s backend info)
    s))

;; これらをバックエンドに仕込む方法は派生させる場合と修正する場合で異なります。

この方法は変数 org-newtab-link-enabled でもフィルタの有効性を制御できるようにします。この変数をファイルローカル変数やディレクトリローカル変数にすることもできます。そうしたい場合、安全な変数に指定しておくと煩わしい警告が出なくて便利です。

(put 'org-newtab-link-enabled 'safe-local-variable #'booleanp)

この方法はバックエンドに何らかの方法(派生させるなり修正するなり)で手を入れる必要があります。もしバックエンドに関わりたくないのであれば、フィルタ関数の中でオプション記述を検索するという方法もあり得ます。

5. 使う

以下は実際の使用例です。

#+html_link_newtab: t
* Chapter1

[​[https://example.com/]]や[​[https://example.org/]]は新しいタブで開きます。

#+attr_html: :target _self
[​[https://example.com/]]のように明示的にtarget属性が指定されているようなリンクには適用されません。[​[https://example.org/]]のような段落中の二つ目のリンクは ~#+attr_html:~ の効果が及ばないので新しいタブで開きます。

[​[*Chapter1][Chapter1]]のような内部リンクには適用されません。

6. 他の方法

今回はorg-modeのフィルタという仕組みを使用しましたが他にも様々なやり方が考えられます。

7. 終わりに

org-modeのエクスポートシステムは複雑でカスタマイズできるポイントも限られているのでちょっとしたことでもいつもどう実現しようか悩んでしまいます。この記事が何か同じようなカスタマイズをする際の参考になれば幸いです。

8. まとめ

;; リンクのフィルタ関数
(defun org-newtab-link-filter (s backend info)
  (if (and
       ;;@todo Support <a data-ex=">" href=...>
       (org-export-derived-backend-p backend 'html) ;; html only
       (not (string-match "\\`[^>]* target=\"" s)) ;; has no target=
       (not (string-match "\\`[^>]* rel=\"" s)) ;; has no rel=
       (string-match "\\`[^>]* href=\"[^#]" s) ;;not internal link
       (string-match "\\`<a " s)) ;; a tag
      (replace-match "<a target=\"_blank\" rel=\"noopener\" " t t s)
    s))

;; エクスポートオプション
(defvar org-newtab-link-enabled nil) ;;tでデフォルト有効
(put 'org-newtab-link-enabled 'safe-local-variable #'booleanp)

(defvar org-newtab-link-options-alist
  '((:newtab-link-enabled "HTML_LINK_NEWTAB" nil org-newtab-link-enabled)))

(defun org-newtab-link-filter-opt (s backend info)
  (if (not (member (plist-get info :newtab-link-enabled) '(nil "" "nil" "no")))
      (org-newtab-link-filter s backend info)
    s))

;; HTMLバックエンドの修正
(defun org-newtab-link-modify-html-backend ()
  (require 'ox-html)
  (let ((backend (org-export-get-backend 'html)))
    ;; org-newtab-link-options-alistで定義されているオプションをバックエンドへ追加
    (let ((backend-options (org-export-backend-options backend))
          (new-option-names (mapcar #'car org-newtab-link-options-alist)))
      (setf (org-export-backend-options backend)
            (nconc
             (seq-remove (lambda (elem) (memq (car elem) new-option-names))
                         backend-options)
             org-newtab-link-options-alist)))
    ;; フィルタ関数org-newtab-link-filter-optをバックエンドの:filter-linkへ追加
    (let ((filter-link (assq :filter-link
                                   (org-export-backend-filters backend))))
      ;; null => (:filter-link . ())
      (when (null filter-link)
        (push (setq filter-link (list :filter-link))
              (org-export-backend-filters backend)))
      ;; (:filter-link . function) => (:filter-link . (function))
      (when (functionp (cdr filter-link))
        (setcdr filter-link (list (cdr filter-link))))
      ;; Add my filter function
      (when (not (memq 'org-newtab-link-filter-opt (cdr filter-link)))
        (push 'org-newtab-link-filter-opt (cdr filter-link))))))

(with-eval-after-load "ox-html"
  (org-newtab-link-modify-html-backend))

一応GitHubにも置いておきます。

misohena/org-newtab-link: Open org-mode links exported as HTML in a new tab.

2021-11-17 ,

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

皆さんは緯度経度で場所を指し示すことって沢山ありますか? 普通そんなに無いですよね。私もそんなには無いんですが、登山をやっていると少しはあるんです。ここに何があったよーとか、ここの分岐は一方が通行止めになっていたよーとか、この写真の場所はどこだよーとか、写真撮り忘れたけどこのあたりだよーとか。

そんなときマップサービスへのリンクを張るのでも良いのですが、沢山位置を指し示す必要があるといちいちURLを生成するのが面倒です。

というわけで、 [[geo:36.2893,137.64785]] のような記述で位置を指定できるようにしました。

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

探せば既にありそうですけどね。

書き方はだいたい geo URI scheme (rfc5870, Wikipedia)に合わせてあります。座標系とか高度とか不確実性とかは全然考慮してません。

上をHTMLでエクスポートすると下のようになります。

<ul class="org-ul">
<li><a href="https://www.openstreetmap.org/#map=15/36.2893/137.64785" target="_blank" rel="noopener" data-geolink="36.2893,137.64785">36.2893,137.64785</a></li>
<li><a href="https://www.openstreetmap.org/#map=18/36.2893/137.64785" target="_blank" rel="noopener" data-geolink="36.2893,137.64785;z=18">36.2893,137.64785</a></li>
<li><a href="https://www.openstreetmap.org/#map=15/36.2893/137.64785" target="_blank" rel="noopener" data-geolink="36.2893,137.64785">奥穂高岳</a></li>
</ul>

実際にこのブログ(Org2Blog)で書くと↓のようになります。

リンク上で C-c C-o したときにブラウザで開くようにもなっています。

設定で使用する地図サービスや生成するURL・HTMLを細かくカスタマイズできるようになっています。カスタマイズ変数だけでなく #+GEOLINK_MAP: google のようにバッファ内のオプションでもカスタマイズできるようになっています。(例: https://raw.githubusercontent.com/misohena/org-geolink/master/example.org)

私は比較的登山道が載っていることが多い地理院地図へのリンクを生成するように設定して使っています。(例: 36.2893,137.64785)

設定によってはリンクを埋め込みの地図に置換することもできます。(設定例: https://github.com/misohena/org-geolink#embedded-map-example)

のように書くと↓になります。

2021-10-31

2021秋の新番組

最近は本当に何をするのも遅くってやになっちゃいますね。もう11月ですよ。

今期は前期よりは大分見られるものが多いですが、これと言ったものはなかなか難しいですね。

印象 Web 更新時刻 タイトル
FOD - 平家物語
ABEMA 月 07:00 がんばれ同期ちゃん
ABEMA 月 07:00 月曜日のたわわ2
Disney+ - スター・ウォーズ:ビジョンズ
Netflix - 範馬刃牙
dアニメ 金 21:54 キミとフィットボクシング -FIt Boxing Animation-
YouTube 金 22:30 メガトン級ムサシ
× dアニメ 金 22:30 SELECTION PROJECT
Netflix - 終末のワルキューレ
dアニメ 土 01:00 魔王イブロギアに身を捧げよ
Netflix - ブルーピリオド
ABEMA 火 02:00 異世界食堂2
dアニメ 土 12:00 でーじミーツガール
dアニメ - 結城友奈は勇者である -大満開の章-
YouTube 月木 17:00 リッチ警官 キャッシュ!
NHK+ - 舞妓さんちのまかないさん
- - 半妖の夜叉姫 弐の章
ABEMA 日 00:00 86―エイティシックス― 第2クール
× dアニメ (10/09) 土 10:00 ぐんまちゃん
dアニメ (10/10) 日 09:30 デジモンゴーストゲーム
dアニメ 月 17:00 ワッチャプリマジ!
Amazon (10/08) 金 22:00 さんかく窓の外側は夜
dアニメ 日 23:30 テスラノート
dアニメ 月 00:00 MUTEKING THE Dancing HERO
dアニメ 月 00:00 無職転生-異世界行ったら本気だす- 第2クール
dアニメ 月 00:30 見える子ちゃん
dアニメ 月 01:00 しょうたいむ!~歌のお姉さんだってしたい~
dアニメ 火 00:30 月とライカと吸血姫
dアニメ 土 02:25 やくならマグカップも 二番窯
dアニメ 火 00:00 吸血鬼すぐ死ぬ
dアニメ 火 00:30 カードファイト!! ヴァンガード overDress Season2
FOD - 海賊王女
YouTube 水 20:00 境界戦機
dアニメ 火 02:00 進化の実~知らないうちに勝ち組人生~
Amazon 水 17:20 チキップダンサーズ
Amazon 水 25:00 takt op.Destiny
dアニメ 水 23:00 プラオレ!~PRIDE OF ORANGE~
dアニメ 水 23:00 真の仲間じゃないと勇者のパーティーを追い出されたので、辺境でスローライフすることにしました
Netflix - 古見さんは、コミュ症です。
FOD - マブラヴ オルタネイティヴ
ABEMA 水 23:30 世界最高の暗殺者、異世界貴族に転生する
dアニメ 木 23:30 サクガン!!
Amazon 木 01:58 プラチナエンド
× ABEMA 土 00:00 ヴィジュアルプリズン
- - 終末のハーレム
ABEMA 土 02:53 大正オトメ御伽話
dアニメ 土 22:00 最果てのパラディン
ABEMA 日 00:30 ビルディバイド -#000000-(コードブラック) 第1期
dアニメ 日 01:30 ルパン三世 PART6
ABEMA 火 01:00 先輩がうざい後輩の話
- - ワールドトリガー 3rdシーズン
dアニメ 火 00:00 逆転世界ノ電池少女
- - BanG Dream! ガルパ☆ピコ ふぃーばー!
ABEMA 水 00:30 Deep Insanity THE LOST CHILD
× - - かぎなど
dアニメ 金 00:00 シキザクラ
dアニメ 月 12:00 闘神機ジーズフレーム
Amazon 金 01:55 王様ランキング
dアニメ 土 00:00 180秒で君の耳を幸せにできるか?
YouTube   ガンダムブレイカー バトローグ

この中で他と少し毛色が違うもので気になるのはさんかく窓の外側は夜でしょうか。なんかpetとかを連想しますね。

2021-09-21 , ,

Emacsの中で動く作図ツールを作る

先日も書きましたが最近はEmacsの中で動く作図ツールを作っています。

ソース: misohena/el-easydraw: Embedded drawing tool for Emacs (github.com)

org-modeの中で思いついた時に図を描きエクスポートするまでの様子
図1: org-modeの中で思いついた時に図を描きエクスポートするまでの様子

以前囲碁の棋譜編集ツールを作ってその時にも書きましたが、Emacsの中でこのくらいのことは出来ても罰は当たらないと思うんですよね(このくらい出来て当然だろ!の意)。

org-modeは素晴らしいツールでいろんな事が出来ますが、文書の中に別の要素を埋め込んで統一的に編集する機能はまだまだ改善の余地が沢山あると思います。(ソースコードブロックのようなテキストベースでプログラマーが誰でも喜ぶような物は充実していますけど) 特にGUI要素が全然足りません。例えば図を描くならditaaやPlantUMLなんかもありますが、やっぱりGUIで描きたくないですか? 20年以上前のWordに出来たようなことが現代の編集環境で出来ないというのはとても残念な事だと思います。(Xwidgetsが使えれば色々出来るのかもしれませんがWindowsなので未だに使ったことがありません。Cygwinで環境を整えれば使えるのかもしれませんが……)

ということでEmacsの中でシームレスに作図が出来るようにと作りました。まだまだ改善するところが沢山あって思っていた以上に難航していますが、日々テストと称していろんな図を作成して遊んでいます。

2021-09-21-edraw1.png
2021-09-21-itsumodori.png
2021-09-21-karasu1.png
2021-09-21-karasu2.png
2021-09-21-increase-issues.png
2021-09-21-diary.png
2021-09-21-edraw2.png
2021-09-21-edraw-svg-path-d-structure1.png
2021-09-21-edraw-svg-path-d-structure2.png
2021-09-21-edraw-self-dev.png
2021-09-21-edraw-propedit.png
2021-09-21-edraw-takao.png
2021-09-21-edraw-copy-paste-test.png

実装

画像表示(ビュー)とマウス操作(コントロール)はこれまで培ってきたEmacsでのSVGやオーバーレイ、マウスイベント処理の延長線上にあります。

その上で一番最初に手を付けたのは当たり判定でした。SVGで図形を表示するのは簡単ですがマウスでクリックした点と図形との当たり判定は自分で行わなければなりません。残念ながらEmacsはそこまで面倒を見てくれません。ベジェ曲線を含んだパスの判定をするにはそれなりに手間がかかりますが、これが出来なければ話になりません。幸いこの手の当たり判定やベジェ曲線については多少扱ったことがあったのですぐに実装出来ました(完全かはともかく)。それでもこういう当たり判定処理はちゃんと動くと嬉しいものですね。

編集対象となる図形データ(モデル)は、基本的にはSVGのDOMツリーです。edraw-bodyというidを持つg要素の下が編集エリアで、それ以外の所にUIに必要なもの(グリッドやアンカー点等)を配置します(もちろん出力時にはUI要素は削除します)。できるだけDOMツリーを尊重して編集対象となるデータは常にDOMツリーに持たせてそれを書き替える形にしようと思いました。しかし今となってはちょっと怪しくなっています。shapeクラスを作ってそれ経由でDOM要素を操作する形になっていますが、shapeオブジェクトが編集中のデータを一部持ってしまっています。毎回属性をparseして編集して文字列に戻すのも大変ですし(特にpathデータ)、ドラッグ移動中や選択中のポイントが必ずしも属性と一対一で対応するわけではないので困るということもありました。とはいえそういったものは一部の例外で、基本的にはshapeオブジェクトはDOMノードをラップする存在です。あ、ちなみに今回初めてeieioを使っています(これもまた色々暗中模索でした)。

そういった所を実装して割とすぐに簡単な図が描けるようになりましたが、その後の細々とした改良に沢山の時間を費やしています。

矢印テスト中の様子
図2: 矢印テスト中の様子

例えば矢印は手間がかかりました。SVGにはマーカーという機能があってあらかじめ定義しておいた図形(マーカー)をパスの頂点にくっつけることが出来るのですが、あらかじめ定義しておく必要がある時点で少し面倒ですし、色も含めて定義しておく必要があるので線の色が変わると定義も更新しなければなりません。重複する定義をまとめる仕組みや変更を検知して更新する仕組みが必要でした。なので中身は見た目よりもずっと面倒くさいことになっています。でもこの手のソフトを作るなら矢印は絶対に欲しいと思っていたので頑張りました。是非矢印を有効(パスを右クリックしてSet→End Marker→Arrow)にした上でstroke色を変えてみてください。矢印の色も一緒に変わるのは決して当たり前なことでは無いんです。それが証拠に線を半透明にするとボロが出ます(笑)。(SVG2ではfill="context-stroke"という指定が出来るようになって多少やりやすくなりますがlibrsvgでは最近対応したばかりでまだ手元のEmacsでは使えません。librsvgでの対応が待たれる事項は他にも沢山あります)

パスの操作はいちいち場合分けが大変で苦労しました。SVGのパスデータ(path要素のd=属性)にはやっかいなところがいくつかあって(本文末尾参照)、アンカーポイントの削除、追加、パスの分割、連結、ハンドルのあれやこれやを実装する際に悩みの種となりました。SVG仕様の細かいところまで対応する必要は無かったのかもしれませんが、将来的にどんなデータを扱うのか分かりませんので。例えば今のところ複数のサブパス(一つのd=の中に複数のパスが存在するケース)は扱えないのですが、将来的には対応したいところです。でないとドーナツ型が作れませんし(ここが抜けない)。いや、まぁ、やってやれないことも無いんですけどね……(←U字になってる)。

その後も先日紹介したカラーピッカー、プロパティエディタ、コピー&ペースト、複数選択、UNDO/REDO等々少しずつ実装していきました。前回の囲碁エディタのようにもう少し短期間で切りの良いところまでいけると思ったのですが、一つ一つの改良とテストに思っていたよりも時間がかかってしまいました。

プロパティエディタの改良でマウス移動イベントが文字単位でしか発生しない事を知る
図3: プロパティエディタの改良でマウス移動イベントが文字単位でしか発生しない事を知る

org-modeとの連携とリンク形式、インライン画像表示、編集、エクスポート

一通り作図が出来るエディタが出来たらorg-modeとの連携部分も作らねばなりません。前回の囲碁エディタは #+begin_igo#+end_igo というスペシャルブロックを使いましたが、今回は [​[edraw:]] という独自のリンクタイプを追加することにしました。ブロックだと行の中に図を挿入できないからですこんな風に(SVG)。もちろんorg-modeで画像を挿入する通常の方法がリンクなのでそれにならったというのもあります。

現在サポートしているリンクの形式は次の通りです。

[​[edraw:file=./example.edraw.svg]​]

[​[edraw:data=<base64data>​]

[​[*Example][edraw:file=./example.edraw.svg]​]

[​[*Example][edraw:data=<base64data>]​]

ファイルへ(.edraw.svg)へのリンクの他、base64によるデータ埋め込みにも対応しています。外部ファイルが必須となると途端にお手軽さが減ってしまいます。一つの文書ファイルで完結していた方が取り扱いが楽なのは間違いありません。幸いSVGはXMLなのでラスター画像よりは大きくありませんし、それをさらにgzip圧縮してからbase64エンコードしています。

外部ファイルの場合、拡張子は.edraw.svgを推奨しています。Emacs Easy Drawが扱えるのは独自のルールに従ったSVGのサブセットのみです。他のソフトが出力したSVGを編集できるわけではありませんが、Emacs Easy Drawが出力したSVGをブラウザなど他のソフトで表示することは可能です。

通常のリンク形式(file, http, https)を拡張することも考えたのですがData URI対応の経験から既存の処理と混ざると非常に面倒だと思ったのでひとまず完全に独自のリンクタイプとしました。gzipで圧縮したSVGはブラウザで直接表示できないので、どのみちエクスポート時には独自の変換処理が必要になります。将来的には.edarw.svgファイルへの通常リンク(例: [​[file:./example.edraw.svg]] )を直接編集できるようにすることも考えています。ただ、データをorgファイル内に埋め込みたいと思うならやはり独自形式の方が都合が良いと思います。

これらのリンクは edraw-org-link-image-mode というマイナーモードによってバッファ内にインライン表示できます。org-modeの org-toggle-inline-images に相当しますが、こちらはマッチする形式は即画像で表示します(私は通常の画像リンクも即更新するように修正して使っているのでそのやり方を踏襲しました)。

リンクまたはインライン表示された画像上で C-c C-o を押すとエディタが開きます。編集の後 C-c C-c (またはメニューからFinish Edit)で編集したSVGデータをバッファ内(ファイルリンクの場合は指しているファイル)に書き戻します。

もちろんEmacsの中で表示・編集できるだけでなく、HTMLエクスポートの際にはimgまたはsvgタグとして出力できます。以下は実際にEmacs Easy Drawで描いた図です。このブログはOrg2blogで書かれているので、手元のorg文書に埋め込まれている図がそのまま皆様の目の前に現れています。

MLLZLLZLLMx1,y1 Lx2,y2 Lx3,y3 Z Lx4,y4 Lx5,y5 Z Lx6,y6 Lx7,y7Subpath1Subpath2Subpath3Subpath1(Closed Path)Subpath2(Closed Path)Subpath3(Open Path)
図4: Emacs Easy Drawで描いた図をSVGとしてエクスポートした例(ブラウザで文字が選択出来る)

Pathツールの使い方

PhotoshopやIllustrator等でおなじみのPathツール(ペンツール)ですが、知らない人は最初戸惑うかもしれません。なので使い方を示すアニメーションを作ってみました。

パスツールの使用例
図5: パスツールの使用例

単にクリックするとその場所に点(アンカーポイント)を追加します。次々にクリックするとアンカーポイント間が直線で結ばれます。

マウスボタンを押し下げてからそのままドラッグすると曲線の制御点(ハンドル)を動かすモードになります。押した点から伸ばした方向に向かう滑らかな曲線が出来ます。

一つのアンカーポイントからは二つのハンドルが伸びています。それぞれ前の区間と後ろの区間に対する制御点なのですが、この二つがアンカーポイントを挟んで互いに180度反対側にあると(要するに三つの点が一つの直線上にあると)、そのアンカーポイントを通る線は尖った部分が無く完全に滑らかになります(その直線を接線とした曲線になります)。

アンカーポイントハンドル
図6: アンカーポイントとハンドル

もしアンカーポイントを選択してもハンドルが二つ現れない場合は、アンカーポイントを右クリックして「Make Smooth」を選んでください。ちょうど良さそうな点を計算してそこに二つのハンドルを置きます。

逆にハンドルを消したい場合は「Make Corner」を選んでください。滑らかさが消えて完全に尖った形(折れ線)になります。

片側のハンドルだけを単独で動かしたい場合は、一つのハンドルをクリックして選択状態にしてください。そのハンドルだけ単独で動くようになります。(PhotoshopやIllustratorの「切り替えツール」は今のところありません)

ちなみに選択中のハンドルやアンカー(もちろんシェイプも)は矢印キーで移動できます。S-矢印キーで10ピクセル単位、M-矢印キーで数値入力で移動します。細かい調整の際には重宝します。

現在のパスを終了して新しいパスを開始したいときは再度Pathツールを選択してください。ツールバーのボタンを押すかaキーを押すとPathツールが初期状態から始まり、次のクリックでは新しいパスシェイプと最初のアンカーポイントが作成されます。

このとき(Pathツールを選択した直後)、現在選択中のパスの端点(一番端っこのアンカーポイント)をクリックすると、そのアンカーポイントからパスを伸ばす(再開する)ことが出来ます。

パスを伸ばしているときに既存のパスの端点をクリックすると、現在のパスをその端点を持つパスと連結します。

クリックで既存のアンカーと繋げたくない場合は、 C-u + クリック で確実に新しいアンカーポイントを追加できます。

操作方法の問題点について

他にも操作には色々注意点がありますが、とりあえず運用でカバーしつつ実用的な図がかけるところまでは出来たのではないかと思います。

完全に私の好みに合わせて作っているので他の方には使いづらい所もあるかとは思いますが、その辺りはご了承ください。

うまく自分の好みに合わせられず使いづらいところもありますが、その辺りは自分の実力が足りないのが悪いのだと諦められるので納得しやすいところではあります(笑)。

細かいところの改善は限りが無く時間は有限なので手を付けていないところも沢山あります。

無限の改善点の狭間で

まだまだ改善点は尽きません。思いついた物はtodo.orgに書き留めています。

一時期は一つ直していくそばから沢山の修正点が見つかる状況でしたが、それも少し落ち着いてきました。

修正点修正済み修正した一つ取り出す修正点を見つける修正作業
図7: 一つ修正すると修正点が増えている図

この手のツールは作っていけば行くほど次第に労多くして功少なしな事項ばかりが残っていくのが常です。

本当に切りがないので、このあたりでひとまず開発のペースを緩めようと思います。元々UNDOを実装するところまでは一気に作ろうと思っていてそれが出来たので。それに秋山の紅葉が私を呼んでいますので。

SVGは本当に表現力があって色々出来るので皆さんもEmacsに足りない要素をどんどん追加していきましょう。

おまけ:SVGパスデータの構造についての図

以下はSVG path要素のd属性について説明するためにEmacs Easy Drawで描いた図です。

pathは <path d="M10,10L30,10C40,20 40,80 30,100" stroke="red" /> のような記述で自由に線を引くための要素ですが、そのd属性(パスデータ)の編集にはいくつか注意点があるのでそれについて描いたものです。

基本的な構造(M, L, Cコマンド):

MLC(previous anchor's)forward handlebackward handleanchoranchoranchorline segmentcurve segmentM commandL commandC command

Zコマンドでパスを閉じると始点と終点が切れ目のない繋がった形状になる(単に始点へ線を引くのとは幅の広い線において色々違いが出てくる)。最後の点と始点の間は直線で結ばれる。

MLLL commandL commandZ command(Line to previous M)* Z commands automatically create a closing segment but cannot represent a curve

曲線で閉じるにはMと同一点までCで閉じ線を引かないといけない(その上でZが必要)。その場合MとCの点は一つのアンカーポイントとして同一視して処理しなければならない(Mを動かしたらCも一緒に動かしたり、Mの前の点を求めるときはCをスキップする等)。

Same coordinatesMCCZClosing Segmentbackward handle of C and M!forward handle of M and C!Length=0

一つのパスデータには複数(0以上)のサブパスを含めることができる。

MLLMLLZClosed SubpathOpen SubpathMLOpen SubpathM L L Z M L L M L

直後にMコマンドが無いZコマンドはMの位置を開始点にした新しいサブパスを作る。

MLLZLM L L Z LSubpath1(Closed Path)Subpath2(Open Path)Subpath12

従って、一つのMコマンドが表す点は複数のサブパスで共有される場合がある。このMの点を削除したり分割したりする場合は注意が必要になる。

MLLZLLZLLMx1,y1 Lx2,y2 Lx3,y3 Z Lx4,y4 Lx5,y5 Z Lx6,y6 Lx7,y7Subpath1Subpath2Subpath3Subpath1(Closed Path)Subpath2(Closed Path)Subpath3(Open Path)

最後のアンカーポイントの前方ハンドルを記録するため、 -forward-handle-point という独自の拡張コマンドを追加している。当然これはSVG出力時には削除される。

C?M or L or CC command-forward-handle-point commandLast anchor point

(あー、矢印の色が……。複数の図を一つのHTMLに出力した(埋め込んだ)ときにマーカーIDが重複する問題に気がついてしまった……。修正するならエクスポート時にマーカーIDに図のIDを付け加えるとかかなぁ)