Teach some operations to avoid mutating buffer during org-capture

This commit is contained in:
Chris Barrett
2023-05-20 13:51:35 +12:00
parent ed35d99c60
commit 3310c444cf
3 changed files with 81 additions and 41 deletions

View File

@@ -12,6 +12,7 @@
;;; Code:
(require 'org)
(require 'org-capture-detect)
(require 'thingatpt)
(defgroup org-format nil
@@ -89,49 +90,50 @@ Only applies to level-1 headings in the document."
(defun org-format-all-headings ()
"Ensure that blank lines exist between headings and their contents."
(interactive)
(let ((scope (if (org-format--in-archived-heading-p)
;; archive files can be enormous--just format the heading at
;; point after archiving.
'tree
'file))
(seen-first-heading-p))
(org-map-entries (lambda ()
;; Widen so we can see space preceding the current
;; headline.
(org-with-wide-buffer
(let* ((level (car (org-heading-components)))
(headline-spacing (cond
((and (equal 1 level) (not seen-first-heading-p))
(setq seen-first-heading-p t)
org-format-blank-lines-before-first-heading)
((equal 1 level)
org-format-blank-lines-before-level-1-headings)
(t
org-format-blank-lines-before-subheadings))))
(org-format--ensure-empty-lines headline-spacing)))
(unless (org-capture-detect)
(let ((scope (if (org-format--in-archived-heading-p)
;; archive files can be enormous--just format the heading at
;; point after archiving.
'tree
'file))
(seen-first-heading-p))
(org-map-entries (lambda ()
;; Widen so we can see space preceding the current
;; headline.
(org-with-wide-buffer
(let* ((level (car (org-heading-components)))
(headline-spacing (cond
((and (equal 1 level) (not seen-first-heading-p))
(setq seen-first-heading-p t)
org-format-blank-lines-before-first-heading)
((equal 1 level)
org-format-blank-lines-before-level-1-headings)
(t
org-format-blank-lines-before-subheadings))))
(org-format--ensure-empty-lines headline-spacing)))
(unless (and (fboundp 'org-transclusion-within-transclusion-p)
(org-transclusion-within-transclusion-p))
(forward-line 1)
(org-format--delete-blank-lines)
(org-format--ensure-empty-lines org-format-blank-lines-before-meta)
(org-end-of-meta-data t)
(org-format--ensure-empty-lines org-format-blank-lines-before-content)))
t
scope)
(unless (and (fboundp 'org-transclusion-within-transclusion-p)
(org-transclusion-within-transclusion-p))
(forward-line 1)
(org-format--delete-blank-lines)
(org-format--ensure-empty-lines org-format-blank-lines-before-meta)
(org-end-of-meta-data t)
(org-format--ensure-empty-lines org-format-blank-lines-before-content)))
t
scope)
(org-with-wide-buffer
;; Clean up trailing whitespace.
(goto-char (point-max))
(org-format--delete-blank-lines)
(org-with-wide-buffer
;; Clean up trailing whitespace.
(goto-char (point-max))
(org-format--delete-blank-lines)
;; Format transcluded headings as if they were really there.
(goto-char (point-min))
(while (search-forward-regexp (rx bol "#+transclude:") nil t)
(save-excursion
(unless (search-forward ":only-content" (line-end-position) t)
(goto-char (line-beginning-position))
(org-format--ensure-empty-lines org-format-blank-lines-before-subheadings)))))))
;; Format transcluded headings as if they were really there.
(goto-char (point-min))
(while (search-forward-regexp (rx bol "#+transclude:") nil t)
(save-excursion
(unless (search-forward ":only-content" (line-end-position) t)
(goto-char (line-beginning-position))
(org-format--ensure-empty-lines org-format-blank-lines-before-subheadings))))))))
;; NB: Set this higher than the default to avoid interfering with things like
;; org-transclusion, etc.