Monthly Archives: 8月 2022

2022-08-29 ,

折りたたみ状態によって見出しのマークを切り替える(org-mode)

org-modernを入れたのでこれまで使っていたorg-bulletsをお払い箱にして見出しの表示設定を調整しました。

これまで私が使っていた全角■●▲(←全角で表示されていますか?)等はどうにも野暮ったかったので、半角で表示される右三角にしてみたところ結構いい感じになりました。しかし右三角を使うと、開いたときに下向き三角になって欲しい気がしてしまいます。というわけでやってみました。

結果:

TABキーによって見出しのマークが切り替わる様子
図1: TABキーによって見出しのマークが切り替わる様子

コード:

;; org-modern.el (2022-12-22) に対する変更

;; まずは深さ毎の見出しマーク文字列(展開時、折りたたみ時の両方)をあらかじめ組み立てます。
;; org-modernではorg-modern-modeを起動したときにできるだけpropertizeした文字列を
;; 変数にキャッシュしておくようになっているので、それに倣いました。

(defvar-local org-modern--open-star-cache nil)
(defvar-local org-modern--folded-star-cache nil)

(defun my-org-modern--cache-star ()
  ;; 状態によって次の記号を使う。
  ;;  open(unfolded): BLACK RIGHT POINTING TRIANGLE (U+25B6)
  ;;  folded: BLACK DOWN POINTING SMALL TRIANGLE (U+25BE)
  ;; (SMALLを使ったのは手元の環境できっちり半角で表示される下向き黒三角がこれだけだったので)
  ;; (2022-12-22削除:深さに応じて先頭に空白を入れる。)
  ;; (2022-12-22追加:深さに応じて先頭に空白を入れるには org-modern-hide-stars に空白文字を指定すること。org-modern 0.6以降の機能)
  ;; この辺は好みで。
  (setq
   org-modern--open-star-cache
   (vconcat (cl-loop for level from 1 to 10
                     ;; (2022-12-22修正:本家でpropertizeを使うコードがorg-modern--symbolに変わったので追従。また、levelに応じて空白を入れるのを止めた)
                     collect (org-modern--symbol "▾")))
   org-modern--folded-star-cache
   (vconcat (cl-loop for level from 1 to 10
                     ;; (2022-12-22修正:本家でpropertizeを使うコードがorg-modern--symbolに変わったので追従。また、levelに応じて空白を入れるのを止めた)
                     collect (org-modern--symbol "▶")))))
(advice-add #'org-modern-mode :before #'my-org-modern--cache-star)

;; 次に折りたたみ状態に(開閉状態)によってfontify時に使うキャッシュを切り替えます。
;; 折りたたみ状態は見出し行の直後が不可視状態になっているかで判断しています。

(defun my-org-modern--star-around (original-fun &rest args)
  "Prettify headline stars."
  ;; 開閉状況によって org-modern--star-cache を切り替える。
  (let* ((folded (invisible-p (line-end-position)))
         (org-modern--star-cache (if folded
                                     org-modern--folded-star-cache
                                   org-modern--open-star-cache)))
    (apply original-fun args)))
(advice-add #'org-modern--star :around #'my-org-modern--star-around)

;; 最後に折りたたみ状態が切り替わったときに見出し行をfontifyし直します。
;; org-modeがセクションを表示したり非表示にしたりするとき、必ず
;; org-flag-regionやoutline-flag-regionが呼ばれます。
;; 表示/非表示する範囲の一行前くらいから見出し行を抽出してfont-lock-flushで
;; 再fontifyを促します。

(defun my-org-modern-flush-headings (from to flag)
  (save-match-data
    (save-excursion
      (goto-char from)

      ;; 1行前から更新する。更新すべき見出しが先行しているかもしれないので。
      (forward-line -1)

      ;; 閉じるときは一行前からFROMまでを処理すれば十分。
      ;; FROM以降は隠されて見えないし、開くときはflag=nilでここが呼ばれる。
      (when flag ;;hide region FROM..TO
        (setq to from))

      (while (re-search-forward (concat "^" org-outline-regexp) to t)
        (font-lock-flush (line-beginning-position)
                         (min (1+ (line-end-position)) (point-max)))))))

(defun my-org-modern-flag-region-advice (original-fun from to flag &rest args)
  (apply original-fun from to flag args)
  ;; org-modeやoutline-modeでFROMからTOまでを表示したり隠したりしたときに、
  ;; その中にある見出し行をfont-lockし直す。
  ;; font-lock側では現在の開閉状況によって見出し行を変化させる。
  (my-org-modern-flush-headings from to flag))

(advice-add #'outline-flag-region :around #'my-org-modern-flag-region-advice)

;; (2022-12-22修正:Org 9.6からorg-flag-regionはobsoleteになってorg-fold-core-regionが使われるようになったので修正。)
(if (version<= "9.6" (org-version))
    (when (fboundp 'org-fold-core-region)
      (advice-add #'org-fold-core-region :around #'my-org-modern-flag-region-advice))
  (when (fboundp 'org-flag-region)
    (advice-add #'org-flag-region :around #'my-org-modern-flag-region-advice)))

今回のことでorg-mode(やoutline-mode)が領域を表示/非表示にする流れについて理解が深まりました。

以前、折りたたみ状態によって見出し行の大きさや行間スペースを変えたいと思ったこともあるので、今回の応用でそういったことも可能になるかもしれません。

2022-08-27 ,

org-modernとorg-indentを併用したときの表の乱れを直す

org-modern

先日org-modernを試してみました。org-modeの各部の見た目を綺麗に(モダンに)してくれます。

そんな中で私が最も気に入ったのは、表(テーブル)の線を綺麗にしてくれるという点です。

org-modernで見た目を改善したorg-modeの表
図1: org-modernで見た目を改善したorg-modeの表

もはやorg-modeと言われなければ分からないと思います。

いくつか問題もあって、 org-table-toggle-coordinate-overlays による座標表示は機能しなくなります。まぁ、仕方ないですね。(2022-08-27追記: org-table-toggle-column-width あたりも問題がありますね。これはちょっと気になるかなぁ)

その辺りは許容するとして、私が使っていて最も気になったのはorg-indentと併用した際の問題です。org-indentは階層に応じて左にインデントをつけてくれるモードです。org-modernはこのorg-indentと相性が悪いです。例えばブロック(#+begin_???から#+end_???までの間)の左に装飾を入れる機能があるのですが、これはorg-indentが有効になっているときは機能しません。

org-indentの併用で表に発生する問題

表の線についてはorg-indent使用時でも一見正しく機能するように見えましたが、よく見ると二つほど問題がありました。

  • 横線の下に大きく空白が空く
  • ウィンドウの先頭にある行がインデントされない
修正前
図2: 修正前

原因

横線の下に大きく空白が空く原因は、org-indentが挿入する空白文字が高さを持ってしまっているところにあります。高さを持っている以上、その行がそれ以上縮まることはありません。

ウィンドウの先頭がインデントされない原因は、先日書いたEmacsのバグにあります。

原因
図3: 原因

修正

org-indentで挿入する空白の高さを1ピクセルにする

org-indentが挿入する文字列が高さを持ってしまっていることが原因なので、それを無くせば良いのです。文字列では無くdisplayプロパティのspace指定を使うことで高さ1ピクセルの空白を作ります。

;; org-indentを使っていると表の水平線の高さが狭まらない問題を修正する。
;; インデントの空白文字列の高さよりも小さくならないのが原因。
;; インデントの空白文字列をdisplayプロパティで高さ1pxのspaceに置き換える。
;; @todo wrap-indentも修正すべき?
(defun my-org-indent--compute-prefixes-after ()
  ;; org-indent--text-line-prefixesはレベル毎のline-prefix。
  ;; org-indent--compute-prefixesがそれを計算した後ここが呼ばれる。
  (let ((prefixes org-indent--text-line-prefixes))
    ;; 各レベルのprefixを修正する。
    (dotimes (i (length prefixes))
      (let* ((space-str (aref prefixes i))
             (space-length (length space-str)))
        (when (> space-length 0)
          (aset prefixes i
                ;; テキストプロパティ
                ;; display (space :width i :height (1))
                ;; を追加する。
                ;; つまり、line-prefixとして空白文字ではなく高さ1pxのspace
                ;; が表示されるようになる。
                ;; これによって、(prefix以外の)行の高さが正しく反映される
                ;; ようになる。これまでは行が小さくなってもprefixの空白文
                ;; 字の高さより小さくならなかった。
                (org-add-props
                    space-str
                    nil
                  'display (cons 'space
                                 (list :width space-length
                                              ;; (list (* space-length
                                              ;;          (frame-char-width)))
                                       :height '(1))))))))))
(advice-add #'org-indent--compute-prefixes :after
            #'my-org-indent--compute-prefixes-after)

元々このorg-indentの空白文字を入れるという挙動は、org-modernに限らず他でも同様の問題を引き起こす可能性があるはずです。例えばfaceをカスタマイズして特定の行の文字サイズを小さくしたとき、文字は小さくなったのに行が一緒に小さくならなず無駄に空白が空くという問題が生じる可能性があります。

表の縦線部分をdisplay (space …)ではなくdisplay " "にする

先日書いた通りこの問題はdisplayプロパティにspaceではなく文字列を指定すれば発生しません。文字列にすると幅と高さを自由に指定できなくなってしまいますが、face属性に:height 0.1を設定することで極小文字にして回避します。

;; org-modern--tableを差し替える。
(defun org-modern--table ()
  "Prettify vertical table lines."
  (save-excursion
    (let* ((beg (match-beginning 0))
           (end (match-end 0))
           (tbeg (match-beginning 1))
           (tend (match-end 1))
           ;; Unique objects
           (sp1 (list 'space :width 1))
           (sp2 (list 'space :width 1))
           (color (face-attribute 'org-table :foreground nil t))
           (inner (progn
                    (goto-char beg)
                    (forward-line)
                    (re-search-forward "^[ \t]*|" (line-end-position) t)))
           (separator (progn
                        (goto-char beg)
                        (re-search-forward "^[ \t]*|-" end 'noerror))))

      ;; 横線を引く
      (goto-char beg)
      (when separator
        ;; overlineを引いて高さを縮める
        (when (numberp org-modern-table-horizontal)
          (add-face-text-property tbeg tend `(:overline ,color) 'append)
          (add-face-text-property beg (1+ end) `(:height ,org-modern-table-horizontal) 'append))
        ;; 横幅を1文字分確保する(縦線部分以外)
        (while (re-search-forward "[^|+]+" tend 'noerror)
          (let ((a (match-beginning 0))
                (b (match-end 0)))
            ;; TODO Text scaling breaks the table formatting since the space is not scaled accordingly
            (cl-loop for i from a below b do
                     (put-text-property i (1+ i) 'display
                                        (if (= 0 (mod i 2)) sp1 sp2))))))

      ;; 縦線を引く
      (goto-char beg)
      (while (re-search-forward
              "-+\\(?1:+\\)-\\|\\(?:^\\|[- ]\\)\\(?1:|\\)\\(?:$\\|[- ]\\)"
              end 'noerror)
        (let ((a (match-beginning 1))
              (b (match-end 1)))
          (cond
           ((and org-modern-table-vertical (or (not separator) inner))
            (add-text-properties
             a b
             `(;; vertical lineにspaceを使うとウィンドウ先頭でline-prefixが効かなくなる。
               ;;display (space :width (,org-modern-table-vertical))
               display
               " "
               face
               (:inherit org-table :inverse-video t)
               ))
            (add-face-text-property a b`(:height 0.1) 'append) ;;0.1の部分は,org-modern-table-verticalとしたいところだけどピクセル数で指定されるので無理。
            )
           ((and org-modern-table-horizontal separator)
            (put-text-property
             a b
             ;; vertical lineにspaceを使うとウィンドウ先頭でline-prefixが効かなくなる。
             ;;'display `(space :width (,org-modern-table-vertical))
             'display " "))
           (t (put-text-property a b 'face 'org-hide)))))
      )))

結果

修正後
図4: 修正後
2022-08-18

display spaceを併用するとウィンドウの先頭でline-prefixが効かなくなる件(Emacs Bug?)

org-modernを試したときに表の先頭が(org-indentによって)インデントされていないことに気がついた。(Emacs 28.1で確認)

ウィンドウの先頭部分が崩れている表
図1: ウィンドウの先頭部分が崩れている表

原因を調べたところ、org-modernに限らず次の条件で問題が起きることが分かった。

  • 行の先頭に対してline-prefixテキストプロパティとdisplayテキストプロパティの両方が指定されている
  • displayプロパティに(space …)を指定している
  • その行がウィンドウの先頭にある

この条件を満たすとき、なぜかline-prefixの効果が消えてしまう。

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

(progn
  ;; ウィンドウの先頭へ移動
  (goto-char (window-start))
  ;; line-prefixとdisplayの両方のテキストプロパティを持つテキストを挿入
  (insert (propertize "TEXT" ;;←この文字列はdisplayプロパティで置換される
                      'line-prefix "[PREFIX-STR]" ;;←行の前にこれが表示されるはず
                      'display '(space :width 1) ;;NG
                      ;;'display (svg-image (svg-create 10 10)) ;;OK
                      ;;'display "[DISPLAY-STR]" ;;OK
                      )))

displayテキストプロパティの値が(image …)の場合や単なる文字列の場合この現象は起きない。例えば単なる文字列の場合は[PREFIX-STR][DISPLAY-STR]と表示されるが、(space …)の場合は[PREFIX-STR]が表示されず1文字分の空白が表示されるだけとなる。

回避方法はちょっと思いつかない。いっそ表の部分はインデントを全部無効化するとか?

最初phscrollのせいかと思ったがそういうわけでは無さそうだ。

以前にもline-prefixでマウス入力の座標がずれる問題に遭遇したことがある。Emacsのソースコードを確認していないが、この辺りの処理には何らかの構造的な問題があるのかもしれない。私の経験的にもレイアウト処理というのはちゃんと設計しないと複雑怪奇なものになりがちだ。

それにしてもorg-modernの罫線の引き方、displayテキストプロパティの(space :width (1)) で幅1pxの空白を作って、faceに:inverse-video tを指定することで実現してるんだ! だからline-spacingがあっても隙間無く線が表示される。そんな方法考えもしなかった。

(insert
 ;; 1行目 赤い縦線にABC 行間は10
 (propertize "X"
             'display '(space :width (1))
             'font-lock-face '(:inverse-video t :foreground "red"))
 (propertize "ABC\n" 'line-spacing 10)
 ;; 2行目 赤い縦線にDEF
 (propertize "X"
             'display '(space :width (1))
             'font-lock-face '(:inverse-video t :foreground "red"))
 "DEF")

あー、透明な画像で1pxの空白を作れば回避可能かもしれない。でも全行に画像を挿入しまくるのもなぁ……。

(2022-08-27追記: org-modernでorg-indentを使っていると表のウィンドウ先頭部分がインデントされない問題は、displayテキストプロパティを" "にしてfaceの:heightを0.1にすることで回避した。org-modern–tableを色々といじると直せる。ちなみにこれとは別の話だが、org-indentを使っていると表の水平線の下に空白が空いてしまう問題は、org-indentが挿入する空白文字列の高さを小さくすることで回避できる。詳しくはorg-modernとorg-indentを併用したときの表の乱れを直すに書いた)