emacs-保存ediff结果为带字符级高亮的src-block
有的时候，你很怀念magit/ediff 的字符级别高亮。相较于普通的行级diff ，这种更符合直觉，也更便利。但是自带的 src-block 中只支持 diff 选项，且因为 font-lock 等设置，导致无法显示 (setq diff-refine 'font-lock) 时的高亮。
还好，我们有 LLM 可以帮助我们生成代码。
编辑：提取逻辑使其更加通用之后上传到了这里 https://github.com/TomoeMami/org-diff-src
1. 使用流程
在一个 org-mode buffer 中，执行 M-x my/org-heading-ediff-src-block ，然后选择原 heading 与新 heading ，则会在光标所在位置生成一个字符级别高亮的 ediff src-block 。
结果例：
--- original: 1
+++ new: 2
@@ -1,4 +1,4 @@
-* 1
+* 2
18:09 🌠┈┈┈┈┈┈┈┈┈┈┈┈ now
- 24:00 ┈┈┈┈┈ ┈┈┈┈┈┈┈┈┈┈┈┈
- 英文减少
+ 14:00 ┈┈┈┈┈ ┈┈┈┈┈┈┈┈┈┈┈┈
+ 中文减
2. LLM 分析
2.1. org 本身的限制
font-lock-mode在 Org 的隐藏渲染缓冲区中被禁用 （缓冲区名以空格开头）；diff-refine产生的是 overlay，而 Org 从隐藏缓冲区把渲染结果搬回主缓冲区时只复制 text properties，不复制 overlay 。
2.2. 解决思路
选 heading → 复制 subtree → 临时 buffer → diff -u → 清理 header
→ 插入 src block
→ org-src-font-lock-fontify-block 触发
→ 创建隐藏缓冲区 → ediff-src-mode
→ font-lock-flush
→ 自定义 matcher 执行 diff–refine-hunk
→ 产生精化 overlay
→ copy-fine-overlays 转成 text property
→ Org 把 text properties 搬回主 buffer
→ 主 buffer 中字符级高亮可见
2.3. 更本质的结论
只要拿到一段标准的 unified diff 文本 ，不管来源是 ediff、 git diff 、 diff -u 还是 Magit，都可以塞进 #+begin_src ediff ，然后靠前面那套 fontify 机制出字符级高亮。
git diff/git diff --word-diff的输出 → 直接粘进ediff块；- Magit 的 diff buffer →
(substring-no-properties (buffer-string))提取 → 插入块； diff-no-select→ 同上；- ediff 的
ediff-diff-buffer→ 就是上面那个函数。
代码中那套 ediff-src-mode / copy-fine-overlays / font-lock-flush 的机制 只做一件事 ：给定一段 unified diff 文本，在 Org 的渲染流程里算出字符级精化，并把它转成能被 Org 搬运的 text property。至于这段文本从哪来，它不关心。
3. 相关代码
插入ediff 字级高亮
;;; ediff src blocks for Org
(require 'diff)
(require 'diff-mode)
;;;; 1. Heading selection and subtree extraction ---------------------------
(defun my/org-ediff--consult-lookup (selected candidates &rest _)
"Lookup SELECTED in CANDIDATES and return its heading marker."
(let ((cand (car (member selected candidates))))
(when cand
(or (get-text-property 0 'org-marker cand)
(get-text-property 0 'consult--candidate cand)))))
(defun my/org-ediff--heading-label ()
"Return a one-line title for the heading at point."
(let ((heading (org-get-heading t t t t)))
(if (or (null heading) (string-match-p "\\`[ \t]*\\'" heading))
"heading"
(replace-regexp-in-string "[\t\n\r]+" " "
(substring-no-properties heading)))))
(defun my/org-ediff--select-heading (prompt)
"Select a heading with consult, showing PROMPT in the minibuffer.
Return the heading title."
(let ((candidates (consult-org--headings nil nil nil)))
(unless candidates
(user-error "No headings in buffer"))
;; `consult--read' returns the value produced by :lookup, i.e. the
;; heading marker -- not the candidate string.
(let ((marker (consult--read
candidates
:prompt prompt
:sort nil
:require-match t
:history '(:input consult-org--history)
:narrow (consult-org--narrow)
:state (consult--jump-state)
:lookup #'my/org-ediff--consult-lookup)))
(unless marker
(user-error "No heading selected"))
(goto-char marker)
(my/org-ediff--heading-label))))
(defun my/org-ediff--copy-subtree ()
"Copy the subtree at point and return it as a string.
The kill ring and the system clipboard are left unchanged."
(let ((kill-ring kill-ring)
(kill-ring-yank-pointer kill-ring-yank-pointer)
(interprogram-cut-function nil))
(org-copy-subtree)
org-subtree-clip))
(defun my/org-ediff--read-subtree (prompt prefix)
"Prompt for a heading with PROMPT and copy its subtree.
Return a cons (LABEL . TREE), where LABEL is PREFIX plus the
heading title."
(save-excursion
(let ((title (my/org-ediff--select-heading prompt)))
(cons (concat prefix title)
(my/org-ediff--copy-subtree)))))
;;;; 2. Diff generation -----------------------------------------------------
(defun my/org-ediff--normalize-subtree (tree)
"Paste TREE as a level-1 subtree in a temporary Org buffer.
Return the buffer text."
(with-temp-buffer
(let ((org-mode-hook nil)
(org-inhibit-startup t))
(org-mode))
(org-paste-subtree 1 tree)
(buffer-string)))
(defun my/org-ediff--unified-diff (text-a text-b label-a label-b coding)
"Return a unified diff between TEXT-A and TEXT-B.
LABEL-A and LABEL-B become the names in the `---'/`+++' header.
CODING is used for the temporary files."
(let ((file-a (make-temp-file "org-ediff-a-"))
(file-b (make-temp-file "org-ediff-b-")))
(unwind-protect
(progn
(let ((coding-system-for-write coding))
(with-temp-file file-a (insert text-a))
(with-temp-file file-b (insert text-b)))
(with-temp-buffer
(let ((coding-system-for-read coding)
(status (call-process diff-command nil t nil
"-u"
"--label" label-a
"--label" label-b
file-a file-b)))
(if (memq status '(0 1))
(buffer-string)
(error "diff failed (status %S): %s"
status (buffer-string))))))
(ignore-errors (delete-file file-a))
(ignore-errors (delete-file file-b)))))
;;;; 3. ediff-src-mode ------------------------------------------------------
(defun my/org-ediff--copy-fine-overlays (beg end)
"Turn `diff-mode fine' overlay faces in BEG..END into `face' text properties.
Org's source-block fontification copies text properties, but not
overlays, so this is what makes refinement visible inline."
(dolist (ov (overlays-in beg end))
(when (eq (overlay-get ov 'diff-mode) 'fine)
(let ((face (overlay-get ov 'face))
(obeg (overlay-start ov))
(oend (overlay-end ov)))
(when (and face (< obeg oend))
(let* ((old (get-text-property obeg 'face))
(faces (cond ((null old) nil)
((listp old) old)
(t (list old)))))
;; `face' lists are merged with the first face taking
;; precedence, so put the refinement face first.
(unless (memq face faces)
(put-text-property obeg oend 'face (cons face faces)))))))))
(defun my/org-ediff--font-lock-refined (max)
"Like `diff--font-lock-refined', but write refinement as text properties.
`diff-refine' must be `font-lock'."
(when (eq diff-refine 'font-lock)
(when (get-char-property (point) 'diff--font-lock-refined)
(goto-char (next-single-char-property-change
(point) 'diff--font-lock-refined nil max)))
(condition-case nil
(diff--iterate-hunks
max
(lambda (beg end)
(unless (get-char-property beg 'diff--font-lock-refined)
(diff--refine-hunk beg end)
(let ((ol (make-overlay beg end)))
(overlay-put ol 'diff--font-lock-refined t)
(overlay-put ol 'evaporate t)
(overlay-put ol 'modification-hooks
'(diff--overlay-auto-delete))))
;; Re-copy on every pass: font-lock removes `face'
;; properties before refontifying.
(my/org-ediff--copy-fine-overlays beg end)))
(error nil))))
(defvar my/org-ediff-font-lock-keywords
(mapcar (lambda (kw)
(if (or (eq kw 'diff--font-lock-refined)
(and (consp kw)
(eq (car kw) 'diff--font-lock-refined)))
(list #'my/org-ediff--font-lock-refined)
kw))
diff-font-lock-keywords)
"`diff-font-lock-keywords' with text-property based refinement.")
(define-derived-mode ediff-src-mode diff-mode "Ediff"
"Major mode for `ediff' Org source blocks.
This is `diff-mode' with `diff-refine' set to `font-lock'. The
refinement is turned into `face' text properties so that Org's
source-block fontification can copy it into the Org buffer."
(setq-local diff-refine 'font-lock)
(setq-local diff-font-lock-keywords my/org-ediff-font-lock-keywords)
(font-lock-flush))
;; `org-src-get-lang-mode' appends "-mode", so map "ediff" to
;; `ediff-src', which yields `ediff-src-mode'.
(let ((pair (assoc "ediff" org-src-lang-modes)))
(if pair
(setcdr pair 'ediff-src)
(push '("ediff" . ediff-src) org-src-lang-modes)))
;;;; 4. Command -------------------------------------------------------------
;;;###autoload
(defun my/org-heading-ediff-src-block ()
"Insert an `ediff' src block comparing two Org subtrees.
Select an original heading and a new heading in the current buffer.
Their subtrees are copied with `org-copy-subtree', pasted with
`org-paste-subtree' into temporary Org buffers, and compared with
`diff'. The unified diff is inserted at point as
#+begin_src ediff
...
#+end_src
The block is fontified with `ediff-src-mode', which enables
`diff-refine' = `font-lock' and uses the Magit-style
`diff-refine-removed' / `diff-refine-added' faces for
character-level changes. No Ediff session is started."
(interactive)
(unless (derived-mode-p 'org-mode)
(user-error "Not in an Org buffer"))
(let* ((orig-buf (current-buffer))
(origin (point-marker))
(coding (or buffer-file-coding-system 'utf-8-unix))
(entry-a (my/org-ediff--read-subtree
"Original heading: " "original: "))
(entry-b (my/org-ediff--read-subtree
"New heading: " "new: "))
(label-a (car entry-a))
(label-b (car entry-b))
(text-a (my/org-ediff--normalize-subtree (cdr entry-a)))
(text-b (my/org-ediff--normalize-subtree (cdr entry-b)))
(diff-text (my/org-ediff--unified-diff
text-a text-b label-a label-b coding)))
(pop-to-buffer orig-buf)
(goto-char origin)
(unless (bolp) (insert "\n"))
(insert "#+begin_src ediff\n")
(let ((body-beg (point)))
(if (or (null diff-text) (string= "" diff-text))
(insert "# No differences\n")
(insert diff-text)
(unless (eq (aref diff-text (1- (length diff-text))) ?\n)
(insert "\n")))
(let ((body-end (point)))
(insert "#+end_src\n")
;; Force inline fontification/refinement now.
(when (fboundp 'org-src-font-lock-fontify-block)
(condition-case nil
(org-src-font-lock-fontify-block "ediff"
body-beg body-end)
(error nil)))))))