Monthly Archives: 1月 2022

2022-01-02 ,

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

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))))
2022-01-01

Emacsでdisplayプロパティを使って改行を置き換えると非常に遅くなる件

私はDiredをファイル名が一番左に来るように改造して使っているのですが、ファイル数が多いディレクトリを開くと動作が重くなって困ることが度々ありました(一時的に効果を切れば回避できます)。

オーバーレイが多いから仕方が無いくらいに思っていたのですが、今日少し調べたら原因は行末の "\n" を "文字列… \n" に置き換えているのが原因だと分かりました。オーバーレイでもテキストプロパティでも関係ありません。

次のコードは "\n" を "EOL\n" に置き換えるdisplayプロパティがついた文字列を20000行追加するものです(バッファにはオーバーレイではなくテキストプロパティのdisplayプロパティが設定されます)。 

(dotimes (_ 20000)
  (insert "1234567890" (propertize "\n" 'display "EOL\n"))) ;;NG

結果の見た目は次のようになります。 

1234567890EOL
1234567890EOL
...19997行略...
1234567890EOL

scratchバッファで実行した後バッファの末尾でprevious-line(C-p)してみると一行上に移動するのに1秒程度かかります。上に行けば行くほど時間は短くなり、バッファの冒頭付近では全く気がつかないくらいの時間になります。

"\n" を置換しなければこの現象は発生しません。例えば "0" を "0EOL" に置換しても(見た目は同じですが)全く遅くはなりません。 

(dotimes (_ 20000)
  (insert "123456789" (propertize "0" 'display "0EOL") "\n")) ;;OK

オーバーレイのbefore-stringで"\n"の前に文字列を挿入しても(C-pは)遅くなりません(挿入自体の時間はテキストプロパティに比べてややかかります)。 

(dotimes (_ 20000)
  (insert "1234567890\n")
  (let ((ov (make-overlay (1- (point)) (point)))) ;;\nのところを覆う
    (overlay-put ov 'before-string "EOL") ;;OK
    (overlay-put ov 'evaporate t)))

また、空の範囲のオーバーレイを許容するのであれば、"0"と"\n"の間にオーバーレイを挟むこともできます。この場合displayプロパティは効かないのでbefore-stringかafter-stringを使うことになります(evaporateが使えないので消すのが面倒になるので注意)。 

(dotimes (_ 20000)
  (insert "1234567890\n")
  (let ((ov (make-overlay (1- (point)) (1- (point))))) ;;\nの前の空の範囲！
    (overlay-put ov 'after-string "EOL"))) ;;OK: before-stringでも同じ。displayは空の範囲では表示されないので使えない
;; 消すときは (remove-overlays (point-min) (point-max)) あたりで。

displayプロパティで "\n" 込みの文字列で置換してしまうと、やっぱり遅くなるわけです(激重注意)。 

(dotimes (_ 20000)
  (insert "1234567890\n")
  (let ((ov (make-overlay (1- (point)) (point)))) ;;\nのところを覆う
    (overlay-put ov 'display "EOL\n") ;;NG
    (overlay-put ov 'evaporate t)))

しかもテキストプロパティに比べて格段に遅いです。一行上に移動するのに何十秒もかかります。

私が"\n"を置換したかったのは、そうしないとカーソルをファイル名の末尾に置けないからです。例えば上の問題が起きないどのケースを使用しても"0"の直後にカーソルを置くことができません。"0"を指しているところでforward-charすると"0"の直後ではなく"EOL"の直後に飛んでしまいます。"0"を"0EOL"に置換した場合ならともかく、"\n"にbefore-stringをかけたときはbefore-stringの前にカーソルが来て欲しいものですが残念ながらそうはなりません。diredで表示を変えるだけならそれほど問題にはならないのですが、wdiredでファイル名を直接編集するときには問題になります(対策はwdiredが起動したら一時的に効果を消すくらいか)。

面白いのは一行下に移動するnext-line(C-n)は遅くならないこと。また、同じ一行上に移動するのでもM-: (forward-line -1)では遅くなりません。(previous-line)は(forward-line -1)に比べると色々な処理を追加で行っているので、そのどこかに原因があるのでしょう。previous-line → line-move → line-move-1 → vertical-motion と呼び出していて、vertical-motionはindent.cの中にあり細々とした処理をしているので追っていませんがdisplayとか'\n'とかが出てくるのでそのあたりで何かあるのでしょう。

ちなみに、連続した行でなければ問題は起きません。 

(dotimes (_ 20000)
  ;; 最初に\nを入れる
  (insert "\n1234567890" (propertize "\n" 'display "EOL\n"))) ;;OK

1行空行を入れるととたんに問題は起きなくなります。

重いのは嫌なので結局一番速いテキストプロパティで改行の一つ前の文字を置き換えるように変更しました。

Improve performance · misohena/dired-details-r@c7699cb

(2022-01-02追記) before-stringの前にカーソルが置けないと書きましたが、cursorプロパティを使うと置けることに気がつきました。次のコードを使うと、previous-lineで遅くならず(\nをdisplayプロパティで置き換えていないので)、かつ、0とEOLの間にカーソルが置けて('cursor 1の部分の効果)、さらにそこで文字を入力するとEOLの前に挿入されます(make-overlayの第四引数の効果)。 

(dotimes (_ 20000)
  (insert "1234567890\n")
  (let ((ov (make-overlay (1- (point)) (point) nil t))) ;;\nのところを覆う。直前に入力した文字はオーバーレイに含めない。
    (overlay-put ov 'before-string (propertize "EOL" 'cursor 1)) ;;EOLのテキストプロパティに1を付けるとなぜかEOLの直前にカーソルを置けるようになる。
    (overlay-put ov 'evaporate t)))

cursorテキストプロパティはマニュアルを読んでも正直意味が分からないので、なぜこうなるのかは不明です。

dired-details-rですが、大量のオーバーレイは移動こそ重くならないまでも追加と削除には時間がかかるので、テキストプロパティのままで行こうと思います。カーソルの移動に問題が残りますが我慢できないほどではないです。いや、行数で実装を切り替えるというのもアリですかね……？

(2022-01-06追記) wdiredでファイル名末尾にカーソルが置けないのがやっぱりストレスなので上記cursorプロパティを使う方法をdired-details-rに採用しました。オーバーレイはテキストプロパティよりも遅いので、1000行越えたらテキストプロパティに切り替える(+wdired起動時は表示を戻す)という荒技も組み合わせました。なおcursorプロパティの挙動は相変わらずよく分かっていません。

Fix issue can't move to the end of file names in wdired mode · misohena/dired-details-r@ae2f690

2022-01-01 ,

org-downloadで保存前にファイル名を入力する

私はこれまでorg-downloadを保存するファイル名が「orgファイル名_タイムスタンプ_ダウンロードファイル名」 になるように設定して使っていたのですが、十中八九後からファイル名を変更しなければならなくていちいちファイルとリンクの両方を修正しなければならず面倒くさいなーと思っていました。

よく考えたらorg-download-file-format-function変数に指定する関数内でread-file-nameを呼び出せば良いだけですね。この変数はなぜかdefcustomではなくdefvarなのですが、使っているのはfuncallする一箇所だけ。カスタマイズするのに使っても問題ないように見えます。私はファイル名にorgファイル名を入れるために既に書き替えていたのでそこを修正すれば良いだけでした。 

(setq org-download-file-format-function 'my-org-download-file-format)
(defun my-org-download-file-format (filename)
  (read-file-name
   "File Name: "
   nil nil nil
   (concat
    (if-let ((fn (buffer-file-name)))
        (concat (file-name-base fn) "_"))
    (format-time-string "%Y%m%d_%H%M%S_")
    filename)))

ついでに前回作ったメニュー(org-cmenu)に登録。

これまでHydraでorg-download用のメニューを作っていたので、それをtransientに書き替えてorg-cmenuのInsertメニューに追加しました。

現在の設定はだいたいこんな感じ。 

(autoload #'org-download-clipboard "org-download")
(autoload #'org-download-yank "org-download")
(require 'transient)
(transient-define-prefix my-org-download ()
  "Insert an image."
  ["Copy an image from:"
   ("c" "Clipboard" org-download-clipboard)
   ("y" "Full-path or URL on kill-ring" org-download-yank)
   ("a" "All monitors" my-org-download-screenshot-all)
   ("p" "Primary monitor" my-org-download-screenshot-primary)
   ("f" "Foreground window" my-org-download-screenshot-active-window)
   "or drop from a local image file."])

(with-eval-after-load "org-cmenu-setup"
  (transient-append-suffix
    'org-cmenu-insert
    '(0 -1 -1) ;;Insertメニューの一番最後に追加
    '("D" "org-download" my-org-download)))

(defun my-org-download-screenshot-all ()
  (interactive)
  (my-org-download-screenshot "screenshot-all.ps1"))

(defun my-org-download-screenshot-primary ()
  (interactive)
  (my-org-download-screenshot "screenshot-primary.ps1"))

(defun my-org-download-screenshot-active-window ()
  (interactive)
  (my-org-download-screenshot "screenshot-activewin.ps1"))

(defun my-org-download-screenshot (script-name)
  (require 'org-download)
  (let ((org-download-screenshot-method
         (format
          "powershell %s %%s"
          (expand-file-name
           (concat
            my-org-download-script-path ;;別途設定のこと
            script-name)))))
    (message "Waiting 3 seconds...")
    (sleep-for 3)
    (message nil)
    (org-download-screenshot)))

WindowsなのでPowerShellを使用してスクリーンショットを撮っていますが、スクリプトはWindowsのコマンドラインからスクリーンショットを撮る(PowerShell)で紹介したものです。

……あ、今気がついたのですが、org-download-rename-at-pointなんてコマンドがあるんですね。ファイル名とリンクを一緒にリネームしてくれるようです。まぁ、別に毎回ファイル名を確認してくれた方が良いんじゃないでしょうか。沢山の画像をドロップしまくるような使い方をするなら毎回確認されると困るでしょうけど、私はそういう使い方はしませんし。でもファイル名とリンクの同時リネームは便利だからorg-cmenuに加えておこっと。

(追記:追加しました。orgのリンクを書き替えただけでその先のファイル名も変わってるなんてマジカル！)

Add feature to rename linked file · misohena/org-cmenu@8805f27

© 2024 AKIYAMA Kouhei, all rights reserved.