From: Adam Porter <adam@alphapapa.net>
To: emacs-orgmode@gnu.org
Subject: Re: Faster version of org-find-olp
Date: Fri, 16 Aug 2019 19:10:50 -0500 [thread overview]
Message-ID: <87wofcslbp.fsf@alphapapa.net> (raw)
In-Reply-To: 871rxku0po.fsf@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 |
next prev parent reply other threads:[~2019-08-17 0:11 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-08-16 23:53 Faster version of org-find-olp Adam Porter
2019-08-17 0:10 ` Adam Porter [this message]
2020-02-04 8:16 ` Bastien
2020-02-04 17:54 ` Eric Abrahamsen
2020-02-10 7:17 ` Bastien
2020-02-10 18:32 ` Eric Abrahamsen
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87wofcslbp.fsf@alphapapa.net \
--to=adam@alphapapa.net \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).