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

;; 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)))