awesome-emacs/nursery
1
0
Fork 0
mirror of https://github.com/chrisbarrett/nursery synced 2025-08-21 13:53:32 -05:00
Code Issues Packages Projects Releases Wiki Activity

Teach some operations to avoid mutating buffer during org-capture

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

37
lisp/org-capture-detect.el Normal file
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

82
lisp/org-format.el
View File

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

3
lisp/org-roam-slipbox.el
View File

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