[O] Faster version of org-find-olp

[Adam Porter]

Hi,

While working on org-recent-headings, I thought I needed a version of
org-find-olp that behaved slightly differently, so I wrote a new
function.  It turned out that I didn't need the new function, but I
found that it seems to be much faster than org-find-olp, so it might be
worth using in Org.

Here is the code and test results.  The bench-multi-lexical macro is
from:

https://github.com/alphapapa/emacs-package-dev-handbook#bench-multi-macros

You'll note that it slightly differs in behavior in two ways:

1.  When an outline path is not found, it returns nil instead of raising
an error.  This could easily be changed to match the behavior of
org-find-olp, of course.  However, it makes the function easier to use
to check for the existence of an OLP without raising an error, and
AFAICT org-find-olp is only used in a few places, so it might be worth
considering to use this new behavior.

2.  Checking for duplicate OLPs is optional.  Sometimes it may be useful
to find an OLP regardless of whether a duplicate exists, and this allows
for that.

Provided are two versions of the function: the only difference between
them is that the *-named version uses:

  (format org-complex-heading-regexp-format ...)

...while the non-* version uses rx-to-string with an rx form.  The
rx-to-string version appears to be significantly faster.  I'm not sure
why.  Perhaps format is an expensive call--it's the only difference
between the two versions--but my cursory profiling didn't necessarily
indicate that was the source of the difference.

As far as finding duplicates, it seems to work properly in my testing.
But beware, I have only tested the code, not proven it correct.*  ;)

If this would be useful to have in Org, whether as a replacement for
org-find-olp or otherwise, I could submit a patch.

Thanks,
Adam

#+BEGIN_SRC elisp :results silent
  (defun org-olp-marker (olp &optional this-buffer unique)
    "Return a marker pointing to outline path OLP.
  Return nil if not found.  If THIS-BUFFER, search current buffer;
  otherwise search file found at path in first element of OLP.  If
  UNIQUE, display a warning if OLP points to multiple headings."
    ;; NOTE: Disabling `case-fold-search' is important to avoid voluntary hair 
loss.
    (let* ((case-fold-search nil)
           (file (unless this-buffer
                   (pop olp)))
           (buffer (if this-buffer
                       (current-buffer)
                     (or (find-file-noselect file)
                         (error "File in outline path not found: %s" file)))))
      (cl-labels ((find-at (level headings)
                           (let ((re (rx-to-string `(seq bol (repeat ,level 
"*") (1+ blank)
                                                         (optional (1+ upper) 
(1+ blank)) ; To-do keyword
                                                         (optional "[#" (in 
"ABC") "]" (1+ blank)) ; Priority
                                                         ,(car headings) (0+ 
blank) (or eol ":")))))
                             (when (re-search-forward re nil t)
                               (when (and unique (save-excursion
                                                   (save-restriction
                                                     (when (re-search-forward 
re nil t)
                                                       (if (cdr headings)
                                                           (find-at (1+ level) 
(cdr headings))
                                                         t)))))
                                 (display-warning 'org-recent-headings
                                                  (format "Multiple headings 
found in %S for outline path: %S" (current-buffer) olp)
                                                  :warning))
                               (if (cdr headings)
                                   (progn
                                     (org-narrow-to-subtree)
                                     (find-at (1+ level) (cdr headings)))
                                 (copy-marker (point-at-bol)))))))
        (with-current-buffer buffer
          (org-with-wide-buffer
           (goto-char (point-min))
           (find-at 1 olp))))))

  (defun org-olp-marker* (olp &optional this-buffer unique)
    ;; NOTE: This version uses `org-complex-heading-regexp-format'.
    "Return a marker pointing to outline path OLP.
  Return nil if not found.  If THIS-BUFFER, search current buffer;
  otherwise search file found at path in first element of OLP.  If
  UNIQUE, display a warning if OLP points to multiple headings."
    ;; NOTE: Disabling `case-fold-search' is important to avoid voluntary hair 
loss.
    (let* ((case-fold-search nil)
           (file (unless this-buffer
                   (pop olp)))
           (buffer (if this-buffer
                       (current-buffer)
                     (or (find-file-noselect file)
                         (error "File in outline path not found: %s" file)))))
      (cl-labels ((find-at (level headings)
                           (let ((re (format org-complex-heading-regexp-format 
(regexp-quote (car headings)))))
                             (when (re-search-forward re nil t)
                               (when (and unique (save-excursion
                                                   (save-restriction
                                                     (when (re-search-forward 
re nil t)
                                                       (if (cdr headings)
                                                           (find-at (1+ level) 
(cdr headings))
                                                         t)))))
                                 (display-warning 'org-recent-headings
                                                  (format "Multiple headings 
found in %S for outline path: %S" (current-buffer) olp)
                                                  :warning))
                               (if (cdr headings)
                                   (progn
                                     (org-narrow-to-subtree)
                                     (find-at (1+ level) (cdr headings)))
                                 (copy-marker (point-at-bol)))))))
        (with-current-buffer buffer
          (org-with-wide-buffer
           (goto-char (point-min))
           (find-at 1 olp))))))
#+END_SRC

#+BEGIN_SRC elisp
  (let* ((content "* Text before [[Test heading]] Text after 1

  blah blah
  ,** Text before [[Test heading]] Text after 2

  foo bar
  ,*** Text before [[Test heading]] Text after 3

  buzz

  ")
         (olp '("Text before [[Test heading]] Text after 1"
                "Text before [[Test heading]] Text after 2"
                "Text before [[Test heading]] Text after 3")))
    (with-temp-buffer
      (org-mode)
      (dotimes (_ 2000)
        (insert "* Heading 1
  text
  ,** Heading 2
  text
  ,*** Heading 3
  text
  "))
      (insert content)
      (bench-multi-lexical :times 500 :ensure-equal t
        :forms (("org-find-olp" (org-find-olp olp t))
                ("org-olp-marker" (org-olp-marker olp t t))
                ("org-olp-marker*" (org-olp-marker* olp t t))))))
#+END_SRC

#+RESULTS:
| Form            | x faster than next | Total runtime | # of GCs | Total GC 
runtime |
|-----------------+--------------------+---------------+----------+------------------|
| org-olp-marker  |               2.66 |      0.857414 |        0 |             
   0 |
| org-olp-marker* |               1.29 |      2.283076 |        0 |             
   0 |
| org-find-olp    |            slowest |      2.946619 |        0 |             
   0 |