Re: [O] Structured links to headings with endless depth

[Ihor Radchenko]

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 <address@hidden> writes:

> Hi all
>
> On Wed, Mar 14, 2018 at 7:58 AM Michael Brand
> <address@hidden> 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 <address@hidden>
> 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 <address@hidden>
> 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
>