Skip to content

Commit

Permalink
Backport org-with-file-buffer (fix #4, #12)
Browse files Browse the repository at this point in the history
  • Loading branch information
@meedstrom
meedstrom committed May 13, 2024
1 parent ec5370e commit 8819177
Show file tree
Hide file tree
Showing 3 changed files with 72 additions and 61 deletions.
94 changes: 39 additions & 55 deletions org-node-backlink.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -71,14 +71,8 @@ as the user command \\[org-node-backlink-regret]."
"Adding/updating :BACKLINKS:... (you may quit and resume anytime) (%d) %s"
(cl-incf org-node-backlink--fix-ctr) file)
(delay-mode-hooks
(org-with-file-buffer file
(org-with-wide-buffer
(org-node-backlink--update-whole-buffer remove))
(and org-file-buffer-created
(buffer-modified-p)
(let ((save-silently t)
(inhibit-message t))
(save-buffer))))))))
(org-node--with-file file
(org-node-backlink--update-whole-buffer remove))))))
(if org-node-backlink--fix-files
;; Keep going
(run-with-timer 1 nil #'org-node-backlink-fix-all remove)
Expand Down Expand Up @@ -226,7 +220,7 @@ merely a wrapper that drops the input."
(org-node-cache-ensure)
(org-node-backlink--add-in-target)))

(defun org-node-backlink--add-in-target (&optional part-of-mass-op)
(defun org-node-backlink--add-in-target ()
"For known link at point, leave a backlink in the target node.
Does NOT try to validate the rest of the target's backlinks."
(unless (derived-mode-p 'org-mode)
Expand All @@ -251,9 +245,9 @@ Does NOT try to validate the rest of the target's backlinks."
(setq file (ignore-errors
(org-node-get-file-path (gethash id org-nodes)))))
(when (and id file)
(org-node-backlink--add-in-target-1 file id part-of-mass-op))))))
(org-node-backlink--add-in-target-1 file id))))))

(defun org-node-backlink--add-in-target-1 (target-file target-id &optional part-of-mass-op)
(defun org-node-backlink--add-in-target-1 (target-file target-id)
(let ((case-fold-search t)
(src-id (org-id-get nil nil nil t)))
(if (not src-id)
Expand All @@ -265,50 +259,40 @@ Does NOT try to validate the rest of the target's backlinks."
(org-get-title)
(file-name-nondirectory (buffer-file-name)))))
(src-link (concat "[[id:" src-id "][" src-title "]]")))
(org-with-file-buffer target-file
(org-with-wide-buffer
(let ((otm (bound-and-true-p org-transclusion-mode)))
(when otm (org-transclusion-mode 0))
(goto-char (point-min))
(if (not (re-search-forward
(concat "^[ \t]*:id: +" (regexp-quote target-id))
nil t))
(push target-id org-node-backlink--fails)
(let ((backlinks-string (org-entry-get nil "BACKLINKS"))
new-value)
;; NOTE: Not sure why, but version 2cff874 dropped some
;; backlinks and it seemed to be fixed by one or both of these
;; changes:
;; - sub `-uniq' for `delete-dups'
;; - sub `remove' for `delete'
(if backlinks-string
;; Build a temp list to check we don't add the same link
;; twice. To use the builtin
;; `org-entry-add-to-multivalued-property', the link
;; descriptions would have to be free of spaces.
(let ((ls (split-string (replace-regexp-in-string
"]][[:space:]]+\\[\\["
"]]\f[["
(string-trim backlinks-string))
"\f" t)))
(dolist (id-dup (--filter (string-search src-id it) ls))
(setq ls (remove id-dup ls)))
(push src-link ls)
(when (-any-p #'null ls)
(org-node-die "nulls in %S" ls))
;; Prevent unnecessary work like putting the most recent
;; link in front even if it was already in the list
(sort ls #'string-lessp)
;; Two spaces between links help them look distinct
(setq new-value (string-join ls " ")))
(setq new-value src-link))
(unless (equal backlinks-string new-value)
(org-entry-put nil "BACKLINKS" new-value)
(unless part-of-mass-op
(and org-file-buffer-created
(buffer-modified-p)
(save-buffer))))
(when otm (org-transclusion-mode)))))))))))
(org-node--with-file target-file
(let ((otm (bound-and-true-p org-transclusion-mode)))
(when otm (org-transclusion-mode 0))
(goto-char (point-min))
(if (not (re-search-forward
(concat "^[ \t]*:id: +" (regexp-quote target-id))
nil t))
(push target-id org-node-backlink--fails)
(let ((backlinks-string (org-entry-get nil "BACKLINKS"))
new-value)
(if backlinks-string
;; Build a temp list to check we don't add the same link
;; twice. To use the builtin
;; `org-entry-add-to-multivalued-property', the link
;; descriptions would have to be free of spaces.
(let ((ls (split-string (replace-regexp-in-string
"]][[:space:]]+\\[\\["
"]]\f[["
(string-trim backlinks-string))
"\f" t)))
(dolist (id-dup (--filter (string-search src-id it) ls))
(setq ls (remove id-dup ls)))
(push src-link ls)
(when (-any-p #'null ls)
(org-node-die "nulls in %S" ls))
;; Prevent unnecessary work like putting the most recent
;; link in front even if it was already in the list
(sort ls #'string-lessp)
;; Two spaces between links help them look distinct
(setq new-value (string-join ls " ")))
(setq new-value src-link))
(unless (equal backlinks-string new-value)
(org-entry-put nil "BACKLINKS" new-value))
(when otm (org-transclusion-mode))))))))))

(provide 'org-node-backlink)

Expand Down
31 changes: 31 additions & 0 deletions org-node-common.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -225,6 +225,37 @@ org-id look inside versioned backup files and then complain about



(defmacro org-node--with-file (file &rest body)
"Backport of the `org-with-file-buffer' concept.
Also integrates `org-with-wide-buffer' behavior.
If no buffer was visiting FILE, open a new one else reuse an open
buffer, and execute BODY.
If a new buffer had to be opened, save and kill it afterwards.
Else if the buffer had been unmodified, save it."
(declare (indent 1))
;; REVIEW: do these perf hacks or not?
`(let ((find-file-hook nil)
(after-save-hook nil)
(before-save-hook nil)
(org-agenda-files nil)
(org-inhibit-startup t))
(let* ((was-open (find-buffer-visiting ,file))
(was-modified (and was-open (buffer-modified-p was-open))))
(with-current-buffer (or was-open
(delay-mode-hooks
(find-file-noselect ,file)))
(save-excursion
(without-restriction
,@body))
(unless (and was-open was-modified)
(let ((save-silently t)
(inhibit-message t))
(save-buffer)))
(unless was-open
(kill-buffer))))))

;; TODO: Diff the old value with the new value and schedule a targeted caching
;; of any new files that appeared.
(let (mem)
Expand Down
8 changes: 2 additions & 6 deletions org-node.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -510,7 +510,6 @@ Can also operate on a file at given PATH."
"Look for links to update to match the current title.
Prompt the user for each one."
(interactive)
(require 'org-macs) ;; Test a fix for #4
(require 'ol)
(defface org-node-rewrite-links-face
'((t :inherit 'org-link))
Expand All @@ -520,8 +519,7 @@ Prompt the user for each one."
(not (face-inverse-video-p 'org-link)))
(when (org-node--consent-to-problematic-modes-for-mass-op)
(dolist (file (if file (list file) (org-node-files)))
(find-file-noselect file)
(org-with-file-buffer file
(org-node--with-file file
(goto-char (point-min))
(while-let ((end (re-search-forward org-link-bracket-re nil t)))
(let* ((beg (match-beginning 0))
Expand Down Expand Up @@ -558,9 +556,7 @@ Prompt the user for each one."
;; Give user 110+ ms to glimpse the result before moving on
(redisplay)
(sleep-for .11))
(goto-char end)))))))
(when (yes-or-no-p "Save the edited buffers?")
(save-some-buffers)))
(goto-char end))))))))

;;;###autoload
(defun org-node-extract-subtree ()
Expand Down

0 comments on commit 8819177

Please sign in to comment.