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

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