[oni-org] Allow project references to work with archived tasks

This commit fixes the issue that project tasks found in the archive of the org
file can't be accessed through the link that's been generated. This fixes that.

1 files changed, 56 insertions, 28 deletions

diff --git a/oni-org/oni-org.el b/oni-org/oni-org.el
index ddb54cc..8e0d741 100644
--- a/oni-org/oni-org.el
+++ b/oni-org/oni-org.el
@@ -4,7 +4,7 @@
 
 ;; Author: Tom Willemse <tom@ryuslash.org>
 ;; Keywords: local
-;; Version: 2022.0928.004858
+;; Version: 2022.1019.224918
 ;; Package-Requires: (oni-yasnippet oni-alert oni-hydra org org-contrib org-bullets org-edna diminish all-the-icons olivetti form-feed)
 
 ;; This program is free software; you can redistribute it and/or modify
@@ -845,36 +845,64 @@ This is an around advice for ‘org-html--svg-image’ as FUN."
 
 (add-hook 'org-property-allowed-value-functions #'oni-org-pick-project)
 
+(defun oni-org-collect-project-references (heading-id)
+  (let ((files (org-add-archive-files (list (buffer-file-name))))
+        backlinks)
+    (save-excursion
+      (mapc (lambda (file)
+              (with-current-buffer (or (get-file-buffer file)
+                                       (progn
+                                         (find-file-noselect file)
+                                         (get-file-buffer file)))
+                (goto-char (point-min))
+                (while (re-search-forward
+                        (rx (or (seq "[[id:" (literal heading-id) "]")
+                                (seq "#" (literal heading-id) "]")))
+                        nil t)
+                  (unless (or (oni-org-in-dblock-p)
+                              (oni-org-at-origin-property-p))
+                    (let ((components (org-heading-components)))
+                      (push `((done . ,(and (org-entry-is-done-p) t))
+                              (position . ,(point))
+                              (title . ,(replace-regexp-in-string (rx (zero-or-more whitespace)
+                                                                      "[" (or (seq (zero-or-more digit) "%")
+                                                                              (seq (zero-or-more digit) "/" (zero-or-more digit)))
+                                                                      "]" eol)
+                                                                  "" (nth 4 components)))
+                              (file . ,file))
+                            backlinks))))))
+            files))
+    backlinks))
+
+(defun oni-org-linkify-backlink (link)
+  (format "- [%s] [[%s*%s][%s]]"
+          (if (alist-get 'done link) "X" " ")
+          (let ((file-name (alist-get 'file link)))
+            (if (string-suffix-p "_archive" file-name t)
+                (format "file:%s::" (alist-get 'file link))
+              ""))
+          (alist-get 'title link)
+          (alist-get 'title link)))
+
+(defun oni-org-link= (a b)
+  (= (alist-get 'position a)
+     (alist-get 'position b)))
+
+(defun oni-org-link< (a b)
+  (< (alist-get 'position a)
+     (alist-get 'position b)))
+
 (defun oni-org-dblock-write-project-steps (_params)
   "Generate back-links to org headings."
-  (let ((current-heading-id
-         (let ((properties (org-entry-properties)))
-           (or (alist-get "CUSTOM_ID" properties nil nil #'string=)
-               (org-id-get-create))))
-        (files (org-add-archive-files (list (buffer-file-name))))
-        backlinks)
-    (when (not (null current-heading-id))
-      (save-excursion
-        (mapc (lambda (file)
-                (with-current-buffer (or (get-file-buffer file)
-                                         (progn
-                                           (find-file-noselect file)
-                                           (get-file-buffer file)))
-                  (goto-char (point-min))
-                  (while (re-search-forward
-                          (rx (or (seq "[[id:" (literal current-heading-id) "]")
-                                  (seq "#" (literal current-heading-id) "]")))
-                          nil t)
-                    (unless (or (oni-org-in-dblock-p)
-                                (oni-org-at-origin-property-p))
-                      (let ((components (org-heading-components)))
-                        (push (list (org-entry-is-done-p) (point) (nth 4 components)) backlinks))))))
-              files)))
+  (let* ((current-heading-id
+          (let ((properties (org-entry-properties)))
+            (or (alist-get "CUSTOM_ID" properties nil nil #'string=)
+                (org-id-get-create))))
+         (backlinks (and (not (null current-heading-id))
+                         (oni-org-collect-project-references current-heading-id))))
     (insert (string-join
-             (mapcar (lambda (link)
-                       (concat "- " (if (car link) "[X]" "[ ]") " [[*" (caddr link) "][" (caddr link) "]]"))
-                     (sort (seq-uniq backlinks (lambda (a b) (= (cadr a) (cadr b))))
-                           (lambda (a b) (< (cadr a) (cadr b)))))
+             (mapcar #'oni-org-linkify-backlink
+                     (sort (seq-uniq backlinks #'oni-org-link=) #'oni-org-link<))
              "\n"))
     (org-update-statistics-cookies nil)))