Re: Structured links to headings with endless depth

[Michael Brand <michael.ch.brand@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 2148 bytes --]

Hi all

On Wed, Mar 14, 2018 at 7:58 AM Michael Brand
<michael.ch.brand@gmail.com> wrote:

> ,    (arbitrarily more levels upwards)
> ,      * [...]
> ,        * <composer>
> ,          * <work>
> ,            * TODO <movement>
> ,              * <interpreter> :5:
> ,                - The tag 5 is my rating of this audio recording.
> ,                - The audio recording is stored under the file path
> ,                  [...]/<composer>/<work>/<movement>/<interpreter>/<sth>.mp3
> ,
> ,    * TODO [...]
> ,      - The theme is very similar to this prelude
> ,        [[/:<composer_1>/<work_1>/<movement_1>]].
> ,    * [...]
> ,      - [...] like in this piano concert
> ,        [[/:<composer_2>/<work_2>]].

Despite all the valuable recommendations in this thread I implemented
something simple for my very specific use case of a music database
where I want self-explaining links with the already existing and
complete heading structure and don't want to add any ID, CUSTOM_ID or
<<target>>. See this example:

#+begin_src org
,#+STARTUP: oddeven showeverything

Specs for outline path of links to a heading, any combinations allowed
including none:
- "/" delimits headings of adjacent levels.
- A leading "/" requires matching the top level heading.
- "//" delimits heading levels with 0 to n discarded heading levels
between them.

Demo examples:
- Goes to tag 1: [[*Chopin/Prelude]]
- Goes to tag 2: [[*/Prelude]]
- Goes to tag 3: [[*d/c//b/a]]
- Goes to tag 4: [[*d/c/b/a]]
,* Foo
,** Bach
,*** Prelude
,** Chopin
,*** Prelude :1:
,* Prelude :2:
,* d
,** c
,*** Bar
,**** Baz
,***** b
,****** a :3:
,*** b
,**** a :4:
#+end_src

Limitations of this simplified implementation:
- Export of links with a path to a heading is not supported.
- Links to a heading with "/" that existed before are broken.
- There may be other issues for your use case already discussed in the
current thread (
http://lists.gnu.org/archive/html/emacs-orgmode/2018-03/msg00231.html
).

Due to the limitations this implementation is for private use only and
not meant to be commited upstream although the format of the attached
patches might imply that.

Michael

[-- Attachment #2: 0001-org-get-heading-New-parameter-no-cookie.patch --]
[-- Type: text/x-patch, Size: 2633 bytes --]

From 3a594dfa9967ed4fd70aae04559dde757fb21b1b Mon Sep 17 00:00:00 2001
From: Michael Brand <michael.ch.brand@gmail.com>
Date: Mon, 6 May 2019 18:17:52 +0200
Subject: [PATCH 1/2] org-get-heading: New parameter no-cookie

* lisp/ol.el (org-link-search): Remove regexps for comment and cookie.
* lisp/org.el (org-get-heading:): New parameter no-cookie used above.
---
 lisp/ol.el  | 10 ++--------
 lisp/org.el | 11 +++++++++--
 2 files changed, 11 insertions(+), 10 deletions(-)

diff --git a/lisp/ol.el b/lisp/ol.el
index a6f76a39f..f5bd63e96 100644
--- a/lisp/ol.el
+++ b/lisp/ol.el
@@ -1108,18 +1108,12 @@ of matched result, which is either `dedicated' or `fuzzy'."
 		  (format "%s.*\\(?:%s[ \t]\\)?.*%s"
 			  org-outline-regexp-bol
 			  org-comment-string
-			  (mapconcat #'regexp-quote words ".+")))
-		 (cookie-re "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]")
-		 (comment-re (format "\\`%s[ \t]+" org-comment-string)))
+			  (mapconcat #'regexp-quote words ".+"))))
 	     (goto-char (point-min))
 	     (catch :found
 	       (while (re-search-forward title-re nil t)
 		 (when (equal words
-			      (split-string
-			       (replace-regexp-in-string
-				cookie-re ""
-				(replace-regexp-in-string
-				 comment-re "" (org-get-heading t t t)))))
+			      (split-string (org-get-heading t t t t t)))
 		   (throw :found t)))
 	       nil)))
       (beginning-of-line)
diff --git a/lisp/org.el b/lisp/org.el
index 94713a7e5..48f7874ac 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -6938,12 +6938,14 @@ So this will delete or add empty lines."
     (insert (make-string n ?\n))
     (move-to-column column)))
 
-(defun org-get-heading (&optional no-tags no-todo no-priority no-comment)
+(defun org-get-heading (&optional
+			no-tags no-todo no-priority no-comment no-cookie)
   "Return the heading of the current entry, without the stars.
 When NO-TAGS is non-nil, don't include tags.
 When NO-TODO is non-nil, don't include TODO keywords.
 When NO-PRIORITY is non-nil, don't include priority cookie.
 When NO-COMMENT is non-nil, don't include COMMENT string.
+When NO-COOKIE is non-nil, don't include cookie string.
 Return nil before first heading."
   (unless (org-before-first-heading-p)
     (save-excursion
@@ -6958,7 +6960,12 @@ Return nil before first heading."
 			   (replace-regexp-in-string
 			    (eval-when-compile
 			      (format "\\`%s[ \t]+" org-comment-string))
-			    "" h))
+			    ""
+			    (if no-cookie
+				(replace-regexp-in-string
+				 "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]"
+				 "" h)
+			      h)))
 			  (h h)))
 	      (tags (and (not no-tags) (match-string 5))))
 	  (mapconcat #'identity
-- 
2.20.1


[-- Attachment #3: 0002-org-link-search-Search-for-outline-path.patch --]
[-- Type: text/x-patch, Size: 4394 bytes --]

From fee37436abbe4a7d6b79161b9230f02de6e7d54d Mon Sep 17 00:00:00 2001
From: Michael Brand <michael.ch.brand@gmail.com>
Date: Mon, 6 May 2019 18:19:44 +0200
Subject: [PATCH 2/2] org-link-search: Search for outline path

* lisp/ol.el (org-link-search): Externalize matching logic to new function
  org-link--heading-path-match-p.
  (org-link--heading-path-split):
  (org-link--heading-path-match-p): New function.
---
 lisp/ol.el | 69 +++++++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 66 insertions(+), 3 deletions(-)

diff --git a/lisp/ol.el b/lisp/ol.el
index f5bd63e96..b79efdf6b 100644
--- a/lisp/ol.el
+++ b/lisp/ol.el
@@ -1034,7 +1034,16 @@ of matched result, which is either `dedicated' or `fuzzy'."
 	 (origin (point))
 	 (normalized (replace-regexp-in-string "\n[ \t]*" " " s))
 	 (starred (eq (string-to-char normalized) ?*))
-	 (words (split-string (if starred (substring s 1) s)))
+	 (heading-path (and starred (substring normalized 1)))
+	 (words (split-string
+		 (if starred
+		     (replace-regexp-in-string "^.*/" "" heading-path)
+		   s)))
+	 (path-rest
+	  (and starred
+	       (cdr (org-link--heading-path-split
+		     (replace-regexp-in-string "^/" "" heading-path)))))
+	 (path-rooted-p (and starred (eq ?/ (string-to-char heading-path))))
 	 (s-multi-re (mapconcat #'regexp-quote words "\\(?:[ \t\n]+\\)"))
 	 (s-single-re (mapconcat #'regexp-quote words "[ \t]+"))
 	 type)
@@ -1112,8 +1121,8 @@ of matched result, which is either `dedicated' or `fuzzy'."
 	     (goto-char (point-min))
 	     (catch :found
 	       (while (re-search-forward title-re nil t)
-		 (when (equal words
-			      (split-string (org-get-heading t t t t t)))
+		 (when (org-link--heading-path-match-p
+			words path-rest path-rooted-p)
 		   (throw :found t)))
 	       nil)))
       (beginning-of-line)
@@ -1163,6 +1172,60 @@ of matched result, which is either `dedicated' or `fuzzy'."
       (org-show-context 'link-search))
     type))
 
+(defun org-link--heading-path-split (path)
+  "Split the PATH string and enumerate the headings by contiguous groups.
+For example \"f/e//d/c/b//a\"
+=> ((\"a\" . 0) (\"b\" . 0) (\"c\" . 1) (\"d\" . 2) (\"e\" . 0) (\"f\" . 1))"
+  (apply #'append
+	 (mapcar (lambda (contiguous)
+		   (let* ((headings (reverse (split-string contiguous "/")))
+			  (enum (number-sequence 0 (1- (length headings)))))
+		     (mapcar* #'cons headings enum)))
+		 (reverse (split-string path "//")))))
+
+(defun org-link--heading-path-match-p (current path-rest path-rooted-p)
+  "Match heading hierarchy at point with CURRENT and PATH-REST.
+
+CURRENT is `split-string' of the string for the requested lowest
+level heading.
+
+PATH-REST is the `cdr' of `org-link--heading-path-split' of the
+path string originally still including the current heading.
+PATH-REST can be nil or contains the upper level headings in
+groups indicated by an enumeration starting at 0. Every 0
+indicates the beginning of a new group. Examples for PATH-REST
+values: ((\"a\" . 1) (\"b\" . 2)) which is the `cdr'
+of ((\"current\" . 0) (\"a\" . 1) (\"b\" . 2)) indicates that
+there is one group which means that it matches the Org hierarchy
+b/a/current but not b/x/a/current or b/a/x/current. ((\"a\" .
+1) (\"b\" . 0)) indicates that there are two groups separated
+between a and b which means that it matches b/a/current,
+b/x/a/current, b/x/x/a/current etc. with any number of discarded
+headings x between the groups but not b/a/x/current. ((\"a\" .
+0) (\"b\" . 1)) indicates that there are two groups separated
+between current and a which means that it matches for example
+b/a/x/current.
+
+Non-nil PATH-ROOTED-P means that the first level heading in the
+buffer must be part of the match."
+       (save-excursion
+	 (and (equal current (split-string (org-get-heading t t t t t)))
+	      (or (not path-rest)
+		  (every (lambda (heading)
+			   (let (match)
+			     (while (and (org-up-heading-safe)
+					 (not (setq match
+						    (equal (split-string
+							    (car heading))
+							   (split-string
+							    (org-get-heading
+							     t t t t t)))))
+					 (zerop (cdr heading))))
+			     match))
+			 path-rest))
+	      (or (not path-rooted-p)
+		  (eq 1 (org-outline-level))))))
+
 (defun org-link-heading-search-string (&optional string)
   "Make search string for the current headline or STRING."
   (let ((s (or string
-- 
2.20.1