Whil- · May 25, 2023 15:05
diff --git a/org-gkroam-link-to-from-id-link.el b/org-gkroam-link-to-from-id-link.el
 ;;; init
 (require 'gkroam)
 (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)))

 ;;; gkroam-links to ID-links
 (defun get-id (title heading)
  (when-let* ((file (gkroam-retrive-page title)))
    (if heading
        (car (org-ql-select file
               `(heading ,heading)
               :action '(org-id-get nil 'create)))
      (when-let ((buffer (find-file-noselect file)))
        (with-current-buffer buffer
          (goto-char (point-min))
          (org-id-get nil 'create))))))

 (defun gkroam-to-id-change-links-in-buffer (buffer-or-name)
  (with-current-buffer buffer-or-name
    (while (re-search-forward gkroam-link-regexp nil 'no-error)
      (let* ((title (match-string-no-properties 2))
             (alias (match-string-no-properties 9))
             (heading (match-string-no-properties 5))
             (id (save-match-data (get-id title heading))))
        (replace-match (replace-quote
                        (format "[[id:%s][%s]]" id (or alias heading title))))))))

 (defun gkroam-to-id-in-path (path regexp &optional recurse)
  (let ((files (directory-files-recursively path regexp)))
    (dolist-with-progress-reporter (file files) "iterate over files..."
      (when-let ((buffer (find-file-noselect file)))
        (gkroam-to-id-change-links-in-buffer buffer)))))

 ;;; ID-links to gkroam-links
 (defun id-to-gkroam-change-links-in-buffer (buffer-or-name)
  (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* ((f-t-h (gw/get-file-title-heading (org-element-property :path link)))
                           (file (aref f-t-h 0))
                           (title (aref f-t-h 1))
                           (heading (aref f-t-h 2)))
                      (delete-region (org-element-property :begin link)
                                     (- (org-element-property :end link)
                                        (org-element-property :post-blank link)))
                      (cond ((and title heading)
                             (insert (format "{[%s » %s]}" title heading)))
                            (title
                             (insert (format "{[%s]}" title)))
                            (t
                             (insert (format "[[id-missing:%s]]"
                                             (concat
                                              (org-element-property :path link)
                                              (when desc (concat " (" desc ")")))))))
                      t)))
                nil 'first-match))))

 (defun id-to-gkroam-in-path (path regexp &optional recurse)
  (let ((files (directory-files-recursively path regexp)))
    (dolist-with-progress-reporter (file files) "iterate over files..."
      (when-let ((buffer (find-file-noselect file)))
        (id-to-gkroam-change-links-in-buffer buffer)))))

 ;;; 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-gkroam-in-path "C:/Temp/2020-11-22" "\\.org\\'" t)
 ;; (gkroam-to-id-in-path "C:/Temp/2020-11-22" "\\.org\\'" t)
 ;; (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)
	;;; init
	(require 'gkroam)
	(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)))

	;;; gkroam-links to ID-links
	(defun get-id (title heading)
	(when-let* ((file (gkroam-retrive-page title)))
	(if heading
	(car (org-ql-select file
	`(heading ,heading)
	:action '(org-id-get nil 'create)))
	(when-let ((buffer (find-file-noselect file)))
	(with-current-buffer buffer
	(goto-char (point-min))
	(org-id-get nil 'create))))))

	(defun gkroam-to-id-change-links-in-buffer (buffer-or-name)
	(with-current-buffer buffer-or-name
	(while (re-search-forward gkroam-link-regexp nil 'no-error)
	(let* ((title (match-string-no-properties 2))
	(alias (match-string-no-properties 9))
	(heading (match-string-no-properties 5))
	(id (save-match-data (get-id title heading))))
	(replace-match (replace-quote
	(format "[[id:%s][%s]]" id (or alias heading title))))))))

	(defun gkroam-to-id-in-path (path regexp &optional recurse)
	(let ((files (directory-files-recursively path regexp)))
	(dolist-with-progress-reporter (file files) "iterate over files..."
	(when-let ((buffer (find-file-noselect file)))
	(gkroam-to-id-change-links-in-buffer buffer)))))

	;;; ID-links to gkroam-links
	(defun id-to-gkroam-change-links-in-buffer (buffer-or-name)
	(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* ((f-t-h (gw/get-file-title-heading (org-element-property :path link)))
	(file (aref f-t-h 0))
	(title (aref f-t-h 1))
	(heading (aref f-t-h 2)))
	(delete-region (org-element-property :begin link)
	(- (org-element-property :end link)
	(org-element-property :post-blank link)))
	(cond ((and title heading)
	(insert (format "{[%s » %s]}" title heading)))
	(title
	(insert (format "{[%s]}" title)))
	(t
	(insert (format "[[id-missing:%s]]"
	(concat
	(org-element-property :path link)
	(when desc (concat " (" desc ")")))))))
	t)))
	nil 'first-match))))

	(defun id-to-gkroam-in-path (path regexp &optional recurse)
	(let ((files (directory-files-recursively path regexp)))
	(dolist-with-progress-reporter (file files) "iterate over files..."
	(when-let ((buffer (find-file-noselect file)))
	(id-to-gkroam-change-links-in-buffer buffer)))))

	;;; 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-gkroam-in-path "C:/Temp/2020-11-22" "\\.org\\'" t)
	;; (gkroam-to-id-in-path "C:/Temp/2020-11-22" "\\.org\\'" t)
	;; (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)