From mboxrd@z Thu Jan 1 00:00:00 1970 From: Adam Porter Subject: Faster version of org-find-olp Date: Fri, 16 Aug 2019 18:53:07 -0500 Message-ID: <871rxku0po.fsf@alphapapa.net> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:470:142:3::10]:53793) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1hym25-0005EO-Ti for emacs-orgmode@gnu.org; Fri, 16 Aug 2019 19:53:23 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hym24-0005eU-DO for emacs-orgmode@gnu.org; Fri, 16 Aug 2019 19:53:21 -0400 Received: from 195-159-176-226.customer.powertech.no ([195.159.176.226]:35930 helo=blaine.gmane.org) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1hym24-0005d0-6A for emacs-orgmode@gnu.org; Fri, 16 Aug 2019 19:53:20 -0400 Received: from list by blaine.gmane.org with local (Exim 4.89) (envelope-from ) id 1hym20-0009TB-6H for emacs-orgmode@gnu.org; Sat, 17 Aug 2019 01:53:16 +0200 List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: "Emacs-orgmode" To: emacs-orgmode@gnu.org --=-=-= Content-Type: text/plain 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 --=-=-= Content-Type: text/x-org Content-Disposition: inline; filename=delta-895b2.org Content-Description: org-olp-marker code and benchmarks #+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 | --=-=-=--