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

@@ -0,0 +1,37 @@
;;; org-capture-detect.el --- Detect whether we're currently in an org-capture context -*- lexical-binding: t; -*-
;; Copyright (C) 2023 Chris Barrett
;; Author: Chris Barrett <chris@walrus.cool>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'org-capture)
(defvar org-capture-detect--in-org-capture-p nil)
(defun org-capture-detect ()
(or (bound-and-true-p org-capture-mode)
org-capture-detect--in-org-capture-p))
(define-advice org-capture (:around (fn &rest args) detect-capture)
(let ((org-capture-detect--in-org-capture-p t))
(apply fn args)))
(provide 'org-capture-detect)
;;; org-capture-detect.el ends here

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.

View File

@@ -63,6 +63,7 @@
(require 'f)
(require 'magit)
(require 'org-capture-detect)
(require 'org-roam)
(require 'org-roam-review)
(require 'org-roam-rewrite)
@@ -242,7 +243,7 @@ This means titles can be restored if
;; Save the default buffer identification settings.
(setq org-roam-slipbox--original-buffer-identification mode-line-buffer-identification)
(unless org-inhibit-startup
(unless (or org-inhibit-startup (org-capture-detect))
(org-roam-slipbox-update-buffer-identification)
(add-hook 'after-save-hook #'org-roam-slipbox-update-buffer-identification nil t)))