Re: Structured links to headings with endless depth

[Ihor Radchenko <yantar92@gmail.com>]

Dear Michael,

> ... 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:

I am wondering why you are strictly against ID properties.

The IDs can be set automatically. The property drawer can be hidden (see
https://stackoverflow.com/questions/17478260/completely-hide-the-properties-drawer-in-org-mode)
and will not clutter you org file.

An arbitrary id link can be self-explaining if you add a proper link
description: [[id:your_id][composer_1/work_1/movement_1]]. Moreover it
is not fragile against refiling or duplicate entries.

Best,
Ihor


Michael Brand <michael.ch.brand@gmail.com> writes:

> 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
> 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
>
> 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
>