Monthly Archives: 1月 2022

2022-01-05 Emacs

360Photo System

これまでに歴代Googleスマホ(Nexus/Pixel)のPhoto Sphereで撮った写真を共有する仕組みを作った。

必要な作業は次の通り。

HDDの中からそれらしき画像をかき集める
画像ファイル名とタイトルの対応表を作る
8192x4096に変換
2～4MBくらいのJPEGに頑張って圧縮(mozjpegで-quality 40くらいに落ち着いた)
600x314のサムネイル画像を作る(ImageMagickで1800幅に縮小して中心600幅を切り抜く)
ついでに、押せるマーク付きサムネイルも作る
画像毎にHTMLを生成する(中身はメタ情報と外部JS起動のみ。OGP、TwitterCard情報付き)
サーバにアップロードする

1と2はある程度手動でやらざるを得ないとして、3以降は自動的に行う。変換処理のスクリプトはEmacs Lispで書いた。私はシェルスクリプトは何もわからんので。Emacs Lispでは directory-files して shell-command 呼べばいいだけ。後はある種のテンプレートエンジンというか、 {{{key}}} をalistを元に置換するような仕組みを作ってHTMLを生成する。わずかにMakefileも使用。必要な操作はtransientで作ったメニューにまとめたので忘れても安心。

一番手間がかかったのは圧縮の方法を決めるところ。元の画像は6～16MBくらいもあるので、転送量・転送時間的にもサーバ容量的にも厳しい。2MB程度に収まらないか色々試したが、あまり品質を低くすると空のグラデーションがはっきり帯状になってしまうので無理だった。最初はImageMagickで圧縮したが、Photoshopで保存した方が綺麗だった。最終的にはmozjpegを使った。

ブラウザでの表示は以前星空を描画するために作ったもの(misohena/drawstars)を転用。正距円筒図法(equirectangular)の画像をWebGLのテクスチャにして描画する。1枚のテクスチャで描画する仕組みになっていたが、8192ピクセルサイズのテクスチャは手元のAndroid端末ではエラーになったので、急遽複数のテクスチャに分割して描画するように変更した。こういうのがあるから私はどうにも3Dグラフィックスハードウェアというのが好きになれない。ただ、WebGLは素のOpenGL ESをいじるよりは(主に周辺的な事情により)幾分気が楽である。変なバグを発見。起動したときになぜか中途半端な方向を向いているなと思ったら現在の恒星時の方向を向いていた。機能を切り忘れていたらしい。内部的には北極に立って全宇宙を眺めているという扱いになっているので。

こうやってブログにも簡単に貼り付けられる。

2022-01-02 Emacs, org-mode

org言語のソースブロックをエクスポートしたときにリンクをそのまま出力する

例えば次のようなソースブロックがあった時に……

リンクは次のように書きます。
#+begin_src org
[[https://example.com/][example.com]] へ行ってみよう。
#+end_src

エクスポートすると……

リンクは次のように書きます。

example.com へ行ってみよう。

みたいに出力されてしまいます。リンクの書き方を説明したいのに、リンクのブラケットやパスの部分が消えてしまうわけです。

昔からそうだったけ？とモヤモヤしながらもう長いこと経つのですが、org-modeの書き方を例示することが多い私はよくこの問題に引っかかります(最近ではこういうのとかこういうのとか)。

C-x 8 RET zero width space と打って見えない空白を[と[の間に入れて回避するのが常なのですが、そろそろ何とかしたいなぁと思って調べました。そのコードをコピペすると空白までコピーされて機能しませんからね。

結果、次のようなコードで回避できました。

(defvar-local my-org-in-html-fontify-code nil)

(advice-add 'org-html-fontify-code :around 'my-org-html-fontify-code-advice)
(advice-add 'org-html-htmlize-region-for-paste :around 'my-org-html-htmlize-region-for-paste)

(defun my-org-html-fontify-code-advice (old-func &rest rest)
  (cl-letf (((default-value 'org-link-descriptive) nil)
            ((default-value 'my-org-in-html-fontify-code) t))
    (apply old-func rest)))

(defun my-org-html-htmlize-region-for-paste (old-fun beg end &rest rest)
  ;; Erase htmlize-link properties
  (when (and my-org-in-html-fontify-code
             (eq major-mode 'org-mode))
    (remove-text-properties beg end '(htmlize-link nil)))
  ;; Call original
  (apply old-fun beg end rest))

ソースブロックがどのようにHTMLへ変換されるかは org-html-fontify-code を見ると良いです。テンポラリバッファを作って言語用のメジャーモードを起動し、ソースブロックの内容を挿入します。確実にfont-lockしたら、テキストプロパティを元にhtml化するわけです。

org-modeにはリンクを文字通りに表示する org-link-descriptive というオプションがあるので、この関数が呼ばれている間だけ nil になってもらうのが先のコードです。

org-link-descriptive はorg-modeが立ち上がるとバッファローカル変数になってしまいます。なのでエクスポート元のバッファでいくら let で nil にしても、新しく作られるテンポラリバッファでは nil になりません。そこでcl-letfでデフォルト値の方を nil にしています。

何かエクスポート中であることを判別する方法があるならorg-mode-hookでorg-toggle-link-displayでも呼んでしまおうかと思ったのですが、残念ながら見つかりませんでした。

まずはその辺りを修正してからエクスポートしたのがこちら。

リンクは次のように書きます。

[[https://example.com/][example.com]] へ行ってみよう。

リンクがクリックできるようになっているのがちょっと気持ち悪いです。この例では正しいURLになっていますが、URLとは解釈できないようなorg-mode独自のリンクパスも問答無用でHTMLのリンクにしてくれます。

これはhtmlize-linkというテキストプロパティの作用です。ソースのHTML化はhtmlizeというパッケージがバッファ内のテキストプロパティを元に行いますが、org-modeのfont-lockがhtmlize-linkというテキストプロパティを付けるので、それを見たhtmlizeが自動的にリンクに置き換えてしまうのです。

ソースブロックの中からリンクを張りたいなどとは思わないので、こちらも問答無用でhtmlize-linkというテキストプロパティを削除するようにしました。

最終結果は次の通りです。

リンクは次のように書きます。

[[https://example.com/][example.com]] へ行ってみよう。

2022-01-01 Emacs

all-the-icons-diredを修正

dired-details-rをいじったついでに、前々から気になっていた挙動を手元で二点修正した。

ファイル操作でアイコンが崩れることがある
リモート(tramp)越しに沢山のファイルがあるディレクトリを開こうとすると待たされる

(ちなみに、アイコンの幅が不揃いでズレている件はフォントファイルをFontForgeで加工して解決した)

修正点

wyuenho/all-the-icons-dired at 5e9b097f9950cc9f86de922b07903a4e5fefc733 のバージョンからの修正、のはず。

ファイル操作でアイコンが崩れることがある

evaporate

オーバーレイは基本的にevaporateにした方が安全。diredはファイルを移動したり削除したりしたときに行を消すので、その時に自動的にオーバーレイも消えてくれる。

 (defun all-the-icons-dired--add-overlay (pos string)
   "Add overlay to display STRING at POS."
   (let ((ov (make-overlay (1- pos) pos)))
     (overlay-put ov 'all-the-icons-dired-overlay t)
-    (overlay-put ov 'after-string string)))
+    (overlay-put ov 'after-string string)
+    (overlay-put ov 'evaporate t)))

after-readin-hookのみで更新

基本的にafter-readin-hookのタイミングで更新すれば十分なはず。……だけど、すでにdired-readinはadviceをかけてるな……。不十分だったらこれはキャンセル。

-(defun all-the-icons-dired--refresh-advice (fn &rest args)
-  "Advice function for FN with ARGS."
-  (prog1 (apply fn args)
-    (when all-the-icons-dired-mode
-      (all-the-icons-dired--refresh))))
-
-(defvar all-the-icons-dired-advice-alist
-  '((dired-aux     dired-create-directory       all-the-icons-dired--refresh-advice)
-    (dired-aux     dired-do-create-files        all-the-icons-dired--refresh-advice)
-    (dired-aux     dired-do-kill-lines          all-the-icons-dired--refresh-advice)
-    (dired-aux     dired-do-rename              all-the-icons-dired--refresh-advice)
-    (dired-aux     dired-insert-subdir          all-the-icons-dired--refresh-advice)
-    (dired-aux     dired-kill-subdir            all-the-icons-dired--refresh-advice)
-    (dired         wdired-abort-changes         all-the-icons-dired--refresh-advice)
-    (dired         dired-internal-do-deletions  all-the-icons-dired--refresh-advice)
-    (dired-narrow  dired-narrow--internal       all-the-icons-dired--refresh-advice)
-    (dired-subtree dired-subtree-insert         all-the-icons-dired--refresh-advice)
-    (dired-subtree dired-subtree-remove         all-the-icons-dired--refresh-advice)
-    (dired         dired-readin                 all-the-icons-dired--refresh-advice)
-    (dired         dired-revert                 all-the-icons-dired--refresh-advice)
-    (find-dired    find-dired-sentinel          all-the-icons-dired--refresh-advice))
-  "A list of file, adviced function, and advice function.")
 
+(defun all-the-icons-dired--after-readin-hook ()
+  (when all-the-icons-dired-mode
+    (if (> (line-number-at-pos (point-max)) 1000)
+        ;; If there are many files, it will be very slow, so disable icons.
+        (all-the-icons-dired--remove-all-overlays)
+      (all-the-icons-dired--refresh))))
 
 (defun all-the-icons-dired--setup ()
   "Setup `all-the-icons-dired'."
   (setq-local tab-width 1)
-  (pcase-dolist (`(,file ,sym ,fn) all-the-icons-dired-advice-alist)
-    (with-eval-after-load file
-      (advice-add sym :around fn)))
-  (all-the-icons-dired--refresh))
+  (add-hook 'dired-after-readin-hook #'all-the-icons-dired--after-readin-hook nil t))
 
 (defun all-the-icons-dired--teardown ()
   "Functions used as advice when redisplaying buffer."
   (kill-local-variable 'tab-width)
-  (pcase-dolist (`(,file ,sym ,fn) all-the-icons-dired-advice-alist)
-    (with-eval-after-load file
-      (advice-remove sym fn)))
+  (remove-hook 'dired-after-readin-hook #'all-the-icons-dired--after-readin-hook t)
   (all-the-icons-dired--remove-all-overlays))

(2023-04-10追記: ファイル数が1000を超えたらアイコンを表示しないようにした。重いので)

現在ナローイングされている範囲だけ削除

上の修正をしたせいか(?)、iキーでサブディレクトリを追加したら追加したもの以外が消えてしまったので。いや、 all-the-icons-dired–remove-all-overlaysではwidenしているのに、all-the-icons-dired–refreshでwidenしていないからとも言えるかもしれない。

そもそもevaporateにしたから自動的に消えるので不要かもしれない(?)

 (defun all-the-icons-dired--remove-all-overlays ()
   "Remove all `all-the-icons-dired' overlays."
   (save-restriction
     (widen)
     (mapc #'delete-overlay
           (all-the-icons-dired--overlays-in (point-min) (point-max)))))

+(defun all-the-icons-dired--remove-narrowed-overlays ()
+  "Remove all `all-the-icons-dired' overlays."
+  (mapc #'delete-overlay
+        (all-the-icons-dired--overlays-in (point-min) (point-max))))

 (defun all-the-icons-dired--refresh ()
   "Display the icons of files in a dired buffer."
-  (all-the-icons-dired--remove-all-overlays)
+  (all-the-icons-dired--remove-narrowed-overlays)

リモート(tramp)越しに沢山のファイルがあるディレクトリを開こうとすると長時間待たされる

ファイル毎にファイル種別判別のための関数を呼んでいるのが原因。リモートの場合は避ける。

 (defun all-the-icons-dired--refresh ()
   "Display the icons of files in a dired buffer."
   (all-the-icons-dired--remove-narrowed-overlays)
   (save-excursion
     (goto-char (point-min))
     (while (not (eobp))
       (when (dired-move-to-filename nil)
         (let ((case-fold-search t))
-          (when-let* ((file (dired-get-filename 'relative 'noerror))
+          (when-let* ((file (dired-get-filename nil 'noerror)) ;;フルパスで取得
-                      (icon (if (file-directory-p file)
-                                (all-the-icons-icon-for-dir file
-                                                            :face 'all-the-icons-dired-dir-face
-                                                            :v-adjust all-the-icons-dired-v-adjust)
-                              (apply 'all-the-icons-icon-for-file file
-                                     (append
-                                      `(:v-adjust ,all-the-icons-dired-v-adjust)
-                                      (when all-the-icons-dired-monochrome
-                                        `(:face ,(face-at-point))))))))
+                      (icon
+                       (if (save-excursion (forward-line 0) (looking-at-p dired-re-dir)) ;;file-directory-pはリモートアクセスを引き起こすので避ける
+                           (if (file-remote-p file)
+                               ;; all-the-icons-icon-for-dirの中でも file-*-p 関数を使っているので避ける
+                               (all-the-icons-octicon "file-directory"  :height 1.0 :v-adjust -0.1
+                                                      :face 'all-the-icons-dired-dir-face
+                                                      :v-adjust all-the-icons-dired-v-adjust)
+                             (all-the-icons-icon-for-dir file
+                                                         :face 'all-the-icons-dired-dir-face
+                                                         :v-adjust all-the-icons-dired-v-adjust))
+                         (apply 'all-the-icons-icon-for-file file
+                                (append
+                                 `(:v-adjust ,all-the-icons-dired-v-adjust)
+                                 (when all-the-icons-dired-monochrome
+                                   `(:face ,(face-at-point))))))))
             (if (member file '("." ".."))
-                (all-the-icons-dired--add-overlay (point) "  \t")
-              (all-the-icons-dired--add-overlay (point) (concat icon "\t"))))))
+                (all-the-icons-dired--add-overlay (point) "   ") ;;この辺は個人的な修正。タブを記号で表示しているので。どのみち位置は揃わないのでフォントの方を加工して揃えた。
+              (all-the-icons-dired--add-overlay (point) (concat icon " "))))
       (forward-line 1))))