From 6345d0c22e7df61af094d77aacd8ea70dca22c8b Mon Sep 17 00:00:00 2001 From: Leo Vivier Date: Mon, 27 Jul 2020 20:16:39 +0200 Subject: [PATCH] (feat): Protect region targeted by `org-roam-insert` (#974) Co-authored-by: Jethro Kuan --- CHANGELOG.md | 10 ++++++ org-roam-capture.el | 50 +++++++++++++++----------- org-roam-macs.el | 22 ++++++++++++ org-roam.el | 87 ++++++++++++++++++++++++++------------------- 4 files changed, 113 insertions(+), 56 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 84f63c0..a1ef004 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,15 @@ # Changelog +## 1.2.2 (TBD) + +### Breaking Changes + +### Features + +-[#974](https://github.com/org-roam/org-roam/pull/974) Protect region targeted by `org-roam-insert` + +### Bugfixes + ## 1.2.1 (27-07-2020) This release consisted of a big deal of refactoring and bug fixes. Notably, we fixed several catastrophic failures on db builds with bad setups (#854), and modularized tag and title extractions. diff --git a/org-roam-capture.el b/org-roam-capture.el index 837bcae..5c80f87 100644 --- a/org-roam-capture.el +++ b/org-roam-capture.el @@ -31,6 +31,7 @@ ;;; Code: ;;;; Library Requires (require 'org-capture) +(require 'org-roam-macs) (require 'dash) (require 's) (require 'cl-lib) @@ -320,26 +321,35 @@ the capture)." (defun org-roam-capture--finalize () "Finalize the `org-roam-capture' process." - (unless org-note-abort - (pcase (org-roam-capture--get :finalize) - ('find-file - (when-let ((file-path (org-roam-capture--get :file-path))) - (org-roam--find-file file-path) - (run-hooks 'org-roam-capture-after-find-file-hook))) - ('insert-link - (when-let* ((mkr (org-roam-capture--get :insert-at)) - (buf (marker-buffer mkr))) - (with-current-buffer buf - (when-let ((region (org-roam-capture--get :region))) ;; Remove previously selected text. - (delete-region (car region) (cdr region))) - (let ((path (org-roam-capture--get :file-path)) - (desc (org-roam-capture--get :link-description))) - (if (eq (point) (marker-position mkr)) - (insert (org-roam--format-link path desc)) - (org-with-point-at mkr - (insert (org-roam--format-link path desc)))))))))) - (org-roam-capture--save-file-maybe) - (remove-hook 'org-capture-after-finalize-hook #'org-roam-capture--finalize)) + (let* ((finalize (org-roam-capture--get :finalize)) + ;; In case any regions were shielded before, unshield them + (region (when-let ((region (org-roam-capture--get :region))) + (org-roam-unshield-region (car region) (cdr region)))) + (beg (car region)) + (end (cdr region))) + (unless org-note-abort + (pcase finalize + ('find-file + (when-let ((file-path (org-roam-capture--get :file-path))) + (org-roam--find-file file-path) + (run-hooks 'org-roam-capture-after-find-file-hook))) + ('insert-link + (when-let* ((mkr (org-roam-capture--get :insert-at)) + (buf (marker-buffer mkr))) + (with-current-buffer buf + (when region + (delete-region (car region) (cdr region))) + (let ((path (org-roam-capture--get :file-path)) + (desc (org-roam-capture--get :link-description))) + (if (eq (point) (marker-position mkr)) + (insert (org-roam--format-link path desc)) + (org-with-point-at mkr + (insert (org-roam--format-link path desc)))))))))) + (when region + (set-marker beg nil) + (set-marker end nil)) + (org-roam-capture--save-file-maybe) + (remove-hook 'org-capture-after-finalize-hook #'org-roam-capture--finalize))) (defun org-roam-capture--install-finalize () "Install `org-roam-capture--finalize' if the capture is an Org-roam capture." diff --git a/org-roam-macs.el b/org-roam-macs.el index 5feb83c..5083c00 100644 --- a/org-roam-macs.el +++ b/org-roam-macs.el @@ -77,6 +77,28 @@ to look. (s-replace "\\" "\\\\") (s-replace "\"" "\\\""))) +;;; Shielding regions +(defun org-roam-shield-region (beg end) + "Shield REGION against modifications. +REGION must be a cons-cell containing the marker to the region +beginning and maximum values." + (when (and beg end) + (add-text-properties beg end + '(font-lock-face org-roam-link-shielded + read-only t) + (marker-buffer beg)) + (cons beg end))) + +(defun org-roam-unshield-region (beg end) + "Unshield the shielded REGION." + (when (and beg end) + (let ((inhibit-read-only t)) + (remove-text-properties beg end + '(font-lock-face org-roam-link-shielded + read-only t) + (marker-buffer beg))) + (cons beg end))) + (provide 'org-roam-macs) ;;; org-roam-macs.el ends here diff --git a/org-roam.el b/org-roam.el index 1bfa4fe..c3c04d5 100644 --- a/org-roam.el +++ b/org-roam.el @@ -960,6 +960,13 @@ Return nil if the file does not exist." This face is used for links without a destination." :group 'org-roam-faces) +(defface org-roam-link-shielded + '((t :inherit (warning org-link))) + "Face for Org-roam links that are shielded. +This face is used on the region target by `org-roam-insertion' +during an `org-roam-capture'." + :group 'org-roam-faces) + ;;;; org-roam-backlinks-mode (define-minor-mode org-roam-backlinks-mode "Minor mode for the `org-roam-buffer'. @@ -1420,42 +1427,50 @@ If DESCRIPTION is provided, use this as the link label. See `org-roam--get-title-path-completions' for details." (interactive "P") (unless org-roam-mode (org-roam-mode)) - (let* ((region (and (region-active-p) - ;; following may lose active region, so save it - (cons (region-beginning) (region-end)))) - (region-text (when region - (buffer-substring-no-properties (car region) (cdr region)))) - (completions (--> (or completions - (org-roam--get-title-path-completions)) - (if filter-fn - (funcall filter-fn it) - it))) - (title-with-tags (org-roam-completion--completing-read "File: " completions - :initial-input region-text)) - (res (cdr (assoc title-with-tags completions))) - (title (or (plist-get res :title) - title-with-tags)) - (target-file-path (plist-get res :path)) - (description (or description region-text title)) - (link-description (org-roam--format-link-title (if lowercase - (downcase description) - description)))) - (if (and target-file-path - (file-exists-p target-file-path)) - (progn - (when region ;; Remove previously selected text. - (delete-region (car region) (cdr region))) - (insert (org-roam--format-link target-file-path link-description))) - (let ((org-roam-capture--info `((title . ,title-with-tags) - (slug . ,(funcall org-roam-title-to-slug-function title-with-tags)))) - (org-roam-capture--context 'title)) - (setq org-roam-capture-additional-template-props (list :region region - :insert-at (point-marker) - :link-description link-description - :finalize 'insert-link)) - (org-roam--with-template-error 'org-roam-capture-templates - (org-roam-capture--capture)))) - res)) + ;; Deactivate the mark on quit since `atomic-change-group' prevents it + (unwind-protect + ;; Group functions together to avoid inconsistent state on quit + (atomic-change-group + (let* (region-text + beg end + (_ (when (region-active-p) + (setq beg (set-marker (make-marker) (region-beginning))) + (setq end (set-marker (make-marker) (region-end))) + (setq region-text (buffer-substring-no-properties beg end)))) + (completions (--> (or completions + (org-roam--get-title-path-completions)) + (if filter-fn + (funcall filter-fn it) + it))) + (title-with-tags (org-roam-completion--completing-read "File: " completions + :initial-input region-text)) + (res (cdr (assoc title-with-tags completions))) + (title (or (plist-get res :title) + title-with-tags)) + (target-file-path (plist-get res :path)) + (description (or description region-text title)) + (link-description (org-roam--format-link-title (if lowercase + (downcase description) + description)))) + (cond ((and target-file-path + (file-exists-p target-file-path)) + (when region-text + (delete-region beg end) + (set-marker beg nil) + (set-marker end nil)) + (insert (org-roam--format-link target-file-path link-description))) + (t + (let ((org-roam-capture--info `((title . ,title-with-tags) + (slug . ,(funcall org-roam-title-to-slug-function title-with-tags)))) + (org-roam-capture--context 'title)) + (setq org-roam-capture-additional-template-props (list :region (org-roam-shield-region beg end) + :insert-at (point-marker) + :link-description link-description + :finalize 'insert-link)) + (org-roam--with-template-error 'org-roam-capture-templates + (org-roam-capture--capture))))) + res)) + (deactivate-mark))) ;;;###autoload (defun org-roam-insert-immediate (arg &rest args)