(feat): Protect region targeted by org-roam-insert (#974)

Co-authored-by: Jethro Kuan <jethrokuan95@gmail.com>
This commit is contained in:
Leo Vivier 2020-07-27 20:16:39 +02:00 committed by GitHub
parent f2c1500beb
commit 6345d0c22e
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
4 changed files with 113 additions and 56 deletions

View file

@ -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.

View file

@ -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."

View file

@ -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

View file

@ -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)