Re: Faster version of org-find-olp

[Adam Porter <adam@alphapapa.net>]

[-- Attachment #1: Type: text/plain, Size: 173 bytes --]

I see that using an "inline" attachment was a bad idea.  At least, the
lists.gnu.org Web UI wraps the lines.  Here it is as an "attachment"
attachment, in case that helps.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Code and benchmark results --]
[-- Type: text/x-org, Size: 5817 bytes --]

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