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