(internal): replace org-element-parse-buffer calls with regexp search (#1068)

This commit is contained in:
Jethro Kuan
2020-08-26 13:44:35 +08:00
committed by GitHub
parent 4f0b1b8d43
commit cc8a2184b7

View File

@@ -1484,19 +1484,15 @@ update with NEW-DESC."
(with-current-buffer (or (find-buffer-visiting file) (with-current-buffer (or (find-buffer-visiting file)
(find-file-noselect file)) (find-file-noselect file))
(save-excursion (save-excursion
(let ((link-markers (org-element-map (org-element-parse-buffer) 'link (goto-char (point-min))
(lambda (l) (while (re-search-forward org-link-any-re nil t)
(let ((type (org-element-property :type l)) (let* ((link (save-excursion
(path (org-element-property :path l))) (goto-char (match-beginning 0))
(when (string-equal (file-truename path) (org-element-link-parser)))
old-path) (type (org-element-property :type link))
(cons (set-marker (make-marker) (org-element-property :begin l)) (path (org-element-property :path link)))
type))))))) (when (and (string-equal (file-truename path) old-path)
(dolist (m link-markers) (org-in-regexp org-link-bracket-re 1))
(goto-char (car m))
(save-match-data
(unless (org-in-regexp org-link-bracket-re 1)
(user-error "No link at point"))
(let* ((label (if (match-end 2) (let* ((label (if (match-end 2)
(match-string-no-properties 2) (match-string-no-properties 2)
(org-link-unescape (match-string-no-properties 1)))) (org-link-unescape (match-string-no-properties 1))))
@@ -1504,7 +1500,7 @@ update with NEW-DESC."
new-desc new-desc
label))) label)))
(replace-match (org-roam-link-make-string (replace-match (org-roam-link-make-string
(concat (cdr m) ":" (concat type ":"
(file-relative-name new-path (file-name-directory (buffer-file-name)))) (file-relative-name new-path (file-name-directory (buffer-file-name))))
new-label))))))) new-label)))))))
(save-buffer))) (save-buffer)))
@@ -1513,26 +1509,20 @@ update with NEW-DESC."
"Fix file-relative links in current buffer. "Fix file-relative links in current buffer.
File relative links are assumed to originate from OLD-PATH. The File relative links are assumed to originate from OLD-PATH. The
replaced links are made relative to the current buffer." replaced links are made relative to the current buffer."
(let* ((links (org-element-map (org-element-parse-buffer) 'link (save-excursion
(lambda (link) (goto-char (point-min))
(let ((type (org-element-property :type link)) (while (re-search-forward org-link-any-re nil t)
(path (org-element-property :path link))) (let* ((link (save-excursion
(when (f-relative-p path) (goto-char (match-beginning 0))
(cons (set-marker (make-marker) (org-element-link-parser)))
(org-element-property :begin link)) (type (org-element-property :type link))
(cons path type)))))))) (path (org-element-property :path link)))
(save-excursion (when (and (f-relative-p path)
(save-match-data (org-in-regexp org-link-bracket-re 1))
(dolist (link links) (let* ((file-path (expand-file-name path (file-name-directory old-path)))
(pcase-let ((`(,marker . (,path . ,type)) link)) (new-path (file-relative-name file-path (file-name-directory (buffer-file-name)))))
(goto-char marker)
(unless (org-in-regexp org-link-bracket-re 1)
(user-error "No link at point"))
(let* ((file-path (expand-file-name path (file-name-directory old-path)))
(new-path (file-relative-name file-path (file-name-directory (buffer-file-name)))))
(replace-match (concat type ":" new-path) (replace-match (concat type ":" new-path)
nil t nil 1)) nil t nil 1)))))))
(set-marker marker nil)))))))
(defun org-roam--rename-file-advice (old-file new-file-or-dir &rest _args) (defun org-roam--rename-file-advice (old-file new-file-or-dir &rest _args)
"Rename backlinks of OLD-FILE to refer to NEW-FILE-OR-DIR." "Rename backlinks of OLD-FILE to refer to NEW-FILE-OR-DIR."