org-file-link-to-from-id-link.el

org-file-link-to-from-id-link.el

;;; init
(require 'org-roam)
(require 'org-ql)

;;; Helpers
(defun gw/get-title (&optional buffer-or-name)
  (with-current-buffer (or buffer-or-name (current-buffer))
    (save-excursion
      (goto-char (point-min))
      (when (re-search-forward "^ *#\\+TITLE:" nil t)
        (string-trim (buffer-substring-no-properties (match-end 0) (line-end-position)))))))

(defun gw/get-file-title-heading (id)
  (let ((mark (org-id-find id 'marker))
        file title heading)
    (when mark
      (org-with-point-at mark
        (setq file (buffer-file-name))
        (setq title (gw/get-title))
        (setq heading (org-get-heading t t))))
    (vector file title heading)))

;;; ID-links to file-heading links
(defun id-to-file-heading-change-links-in-buffer (buffer-or-name base-path)
  (with-current-buffer buffer-or-name
    (while (org-element-map (org-element-parse-buffer) 'link
             (lambda (link)
               (when (string= (org-element-property :type link) "id")
                 (goto-char (org-element-property :begin link))
                 (let* ((beg (org-element-property :contents-begin link))
                        (end (org-element-property :contents-end link))
                        (desc (when (and beg end) (buffer-substring-no-properties beg end)))
                        (f-t-h (gw/get-file-title-heading (org-element-property :path link)))
                        (file (file-relative-name (aref f-t-h 0) base-path))
                        (title (aref f-t-h 1))
                        (heading (aref f-t-h 2))
                        (new-desc (or desc
                                      (when title
                                        (concat title (when heading " » ") heading))
                                      (concat (file-name-nondirectory file) (when heading " » ") heading))))
                   (delete-region (org-element-property :begin link)
                                  (- (org-element-property :end link)
                                     (org-element-property :post-blank link)))
                   (cond (heading
                           (insert (format "[[file:%s::*%s][%s]]" file heading new-desc)))
                         (title
                          (insert (format "[[file:%s][%s]" file title)))
                         (file
                          (insert (format "[[file:%s]]" file)))
                         (t
                          (insert (format "[[id-missing:%s]]"
                                          (concat
                                           (org-element-property :path link)
                                           (when desc (concat " (" desc ")")))))))
                   t)))
             nil 'first-match))))

(defun id-to-file-heading-in-path (path regexp &optional recurse)
  (let ((files (directory-files-recursively path regexp))
        (org-startup-folded 'showeverything))
    (save-excursion
      (delay-mode-hooks
        (dolist-with-progress-reporter (file files) "iterate over files..."
          (when-let ((buffer (find-file-noselect file)))
            (id-to-file-heading-change-links-in-buffer buffer path)))))))

;;; file-heading links to ID-links
(defun get-id-title-heading-from-link (link &optional create-id)
  (save-mark-and-excursion
    (org-link-open link)
    (let ((id (org-id-get nil create-id))
          (title (get-title-ish))
          (heading (org-no-properties
                    (when (org-element-property :search-option link)
                      (org-get-heading nil nil nil nil)))))
      (vector id title heading))))

(defun file-heading-to-id-change-links-in-buffer (buffer-or-name base-path)
  (with-current-buffer buffer-or-name
    (org-with-wide-buffer
     (goto-char (point-min))
     (while (re-search-forward org-link-any-re nil 'no-error)
       (let* ((link (save-mark-and-excursion (goto-char (match-beginning 0))
                                             (save-match-data (org-element-link-parser))))
              (type (org-element-property :type link))
              (file-path (org-element-property :path link))
              (beg (org-element-property :contents-begin link))
              (end (org-element-property :contents-end link))
              (dir (when (file-exists-p file-path)
                     (file-name-directory
                      (expand-file-name file-path)))))
         ;; Only replace link if file is within wanted path
         (when (and dir (string-equal type "file")
                    (string-match-p base-path dir))
           (let* ((id-title-heading (save-match-data
                                      (get-id-title-heading-from-link link 'create)))
                  (id (aref id-title-heading 0))
                  (title (aref id-title-heading 1))
                  (heading (aref id-title-heading 2))
                  (desc (when (and beg end) (buffer-substring-no-properties beg end))))
             (replace-match (replace-quote
                             (format "[[id:%s][%s]]"
                                     id
                                     (or desc (concat title (when heading " » ") heading))))
                            nil nil nil 0))))))))

(defun file-heading-to-id-in-path (path regexp &optional recurse)
  (let ((files (directory-files-recursively path regexp))
        (org-startup-folded 'showeverything))
    (save-mark-and-excursion
      (delay-mode-hooks
        (dolist-with-progress-reporter (file files) "iterate over files..."
          (when-let ((buffer (find-file-noselect file)))
            (file-heading-to-id-change-links-in-buffer buffer path)))))))

;;; Do it's
;; (id-to-file-heading-in-path "C:/Temp/2020-11-22" "\\.org\\'" t)
;; (file-heading-to-id-in-path "C:/Temp/2020-11-22" "\\.org\\'" t)