From 960d864dd6587190a78353f27c2de10790560f31 Mon Sep 17 00:00:00 2001
From: Kosyrev Serge <serge.kosyrev@iohk.io>
Date: Thu, 25 May 2023 19:30:01 +0800
Subject: [PATCH] org-id: implement arbitrary cross-file table referencing

* Table formulae can now refer to data from tables in other files.

TINYCHANGE
---
 etc/ORG-NEWS      | 10 +++++++++
 lisp/org-id.el    | 57 ++++++++++++++++++++++++++++++++++++++---------
 lisp/org-table.el |  2 +-
 3 files changed, 58 insertions(+), 11 deletions(-)

diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 6b40198b5..311067628 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -221,6 +221,16 @@ Running shell blocks with the ~:session~ header freezes Emacs until
 execution completes.  The new ~:async~ header allows users to continue
 editing with Emacs while a ~:session~ block executes.
 
+*** ~remote~ ~org-table~ can now refer to variables in other files
+
+Table formulae can now refer to data from tables in other files.
+
+Example:
+
+#+BEGIN_src org
+#+TBLFM: $2='(identity remote(file:./org-wile-with-tables.org,@@#$Value))
+#+END_src
+
 ** Miscellaneous
 *** =org-crypt.el= now applies initial visibility settings to decrypted entries
 
diff --git a/lisp/org-id.el b/lisp/org-id.el
index aa9610f16..413babcd6 100644
--- a/lisp/org-id.el
+++ b/lisp/org-id.el
@@ -337,6 +337,40 @@ Move the cursor to that entry in that buffer."
     (move-marker m nil)
     (org-fold-show-context)))
 
+(defun org-id-parse-remote-table-ref (refstr)
+  (save-match-data
+    (when-let* ((match (string-match "^file:\\([^:]+\\)\\(\\|:.+\\)$" refstr))
+                (m1 (match-string 1 refstr))
+                (m2 (match-string 2 refstr))
+                (filename (cl-remove-if (lambda (c) (member c '(40 41)))
+                                        (org-table-formula-substitute-names m1)))
+                (table-name (org-table-formula-substitute-names m2)))
+      (list filename table-name))))
+
+(defun org-id-find-remote (file table-id markerp)
+  (if (file-exists-p file)
+      (let ((buffer (let ((query-about-changed-file nil))
+                      (find-file-noselect file))))
+        (unwind-protect
+	    (with-current-buffer buffer
+              (goto-char (point-min))
+	      (let ((pos (progn
+                           (unless (string= table-id "")
+                             (let* ((ident (cl-subseq table-id 1))
+                                    (id-match (search-forward (concat "#+NAME: " ident) nil t)))
+                               (unless id-match
+                                 (error "org-id-find-remote: file \"%s\" has no table with NAME \"%s\"." file ident))
+                               (forward-line)))
+                           (re-search-forward "^|-")
+                           (move-beginning-of-line nil))))
+                (cond
+	         ((null pos) nil)
+	         (markerp (move-marker (make-marker) pos buffer))
+	         (t (cons file pos)))))
+	  ;; Remove opened buffer in the process.
+	  (unless markerp (kill-buffer buffer))))
+    (error "org-id-find-remote:  reference to missing file %s" file)))
+
 ;;;###autoload
 (defun org-id-find (id &optional markerp)
   "Return the location of the entry with the id ID.
@@ -346,16 +380,19 @@ With optional argument MARKERP, return the position as a new marker."
   (cond
    ((symbolp id) (setq id (symbol-name id)))
    ((numberp id) (setq id (number-to-string id))))
-  (let ((file (org-id-find-id-file id))
-	org-agenda-new-buffers where)
-    (when file
-      (setq where (org-id-find-id-in-file id file markerp)))
-    (unless where
-      (org-id-update-id-locations nil t)
-      (setq file (org-id-find-id-file id))
-      (when file
-	(setq where (org-id-find-id-in-file id file markerp))))
-    where))
+  (let ((remote-match (org-id-parse-remote-table-ref id)))
+    (if remote-match
+        (org-id-find-remote (car remote-match) (cadr remote-match) markerp)
+      (let ((file (org-id-find-id-file id))
+	    org-agenda-new-buffers where)
+        (when file
+          (setq where (org-id-find-id-in-file id file markerp)))
+        (unless where
+          (org-id-update-id-locations nil t)
+          (setq file (org-id-find-id-file id))
+          (when file
+	    (setq where (org-id-find-id-in-file id file markerp))))
+        where))))
 
 ;;; Internal functions
 
diff --git a/lisp/org-table.el b/lisp/org-table.el
index ac685c41e..e894d563a 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -6281,7 +6281,7 @@ list of the fields in the rectangle."
     (let ((case-fold-search t) (id-loc nil)
 	  ;; Protect a bunch of variables from being overwritten by
 	  ;; the context of the remote table.
-	  org-table-column-names org-table-column-name-regexp
+          org-table-column-names (org-table-column-name-regexp org-table-column-name-regexp)
 	  org-table-local-parameters org-table-named-field-locations
 	  org-table-current-line-types
 	  org-table-current-begin-pos org-table-dlines
-- 
2.40.1