From 875e63d62a3190e916d42c488262d849a2d3d421 Mon Sep 17 00:00:00 2001
From: Tom Willemse <tom@ryuslash.org>
Date: Wed, 19 Oct 2022 22:52:45 -0700
Subject: [PATCH] [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.
---
 oni-org/oni-org.el | 84 ++++++++++++++++++++++++++++++----------------
 1 file 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)))