Add outline-jump-to-heading command

1 files changed, 53 insertions, 2 deletions

diff --git a/lisp/init-outline.el b/lisp/init-outline.el
index 433ab0f..440db21 100644
--- a/lisp/init-outline.el
+++ b/lisp/init-outline.el
@@ -1,4 +1,54 @@
 
+(defun km/outline--parent-levels (n)
+  "Return list of parent levels.
+4 -> (1 2 3)
+1 -> nil"
+  (unless (> n 0)
+    (user-error "N must be positive"))
+  (let (parents)
+    (while (/= n 1)
+      (setq n (1- n))
+      (push n parents))
+    parents))
+
+(defun km/outline-imenu-create-index ()
+  "Generate Imenu index for headings.
+This assumes that `outline-regexp' marks the characters that
+indicate a heading, but not the text following it.  The heading
+text is taken as everything on the line after the
+`outline-regexp' match (except for any leading whitespace)."
+  (goto-char (point-min))
+  (let (path-alist                      ; ((level . heading))
+        index)
+    (while (re-search-forward (concat "^" outline-regexp) nil t)
+      (let* ((head (replace-regexp-in-string
+                    "\\`\\s-*" ""
+                    (buffer-substring-no-properties (point) (point-at-eol))))
+             (head-level (save-excursion (beginning-of-line)
+                                         (funcall outline-level)))
+             (parent-levels (km/outline--parent-levels head-level))
+             (parent-heads
+              (delq nil (mapcar (lambda (n) (cdr (assoc n path-alist)))
+                                parent-levels)))
+             (target (concat (mapconcat #'identity
+                                        (append parent-heads
+                                                (list head))
+                                        " / "))))
+        (unless (string= head "")
+          (push (cons target (save-excursion (beginning-of-line) (point-marker)))
+                index))
+        (push (cons head-level head) path-alist)))
+    (nreverse index)))
+
+(defun km/outline-jump-to-heading ()
+  "Jump to heading specified by `outline-regexp'."
+  (interactive)
+  (let ((imenu-create-index-function #'km/outline-imenu-create-index)
+        helm-cached-imenu-tick
+        helm-cached-imenu-alist
+        helm-cached-imenu-candidates)
+    (call-interactively #'helm-imenu)))
+
 ;; Modified from https://github.com/abo-abo/hydra/wiki/Emacs
 (defhydra hydra-outline-mode (:hint nil)
   "
@@ -7,7 +57,7 @@ _q_ sublevels  _a_ all       _u_ up
 _t_ body       _e_ entry     _n_ next visible
 _o_ other      _i_ children  _p_ previous visible
 _c_ entry      _k_ branches  _f_ forward same level
-_l_ leaves     _s_ subtree   _b_ backward same level
+_h_ leaves     _s_ subtree   _b_ backward same level
 _d_ subtree
 
 "
@@ -15,7 +65,7 @@ _d_ subtree
   ("t" hide-body)
   ("o" hide-other)
   ("c" hide-entry)
-  ("l" hide-leaves)
+  ("h" hide-leaves)
   ("d" hide-subtree)
 
   ("a" show-all)
@@ -30,6 +80,7 @@ _d_ subtree
   ("f" outline-forward-same-level)
   ("b" outline-backward-same-level)
 
+  ("l" km/outline-jump-to-heading "jump" :color blue)
   ("m" outline-mark-subtree "mark" :color blue))
 
 (defun km/hydra-outline-mode ()