This was not as simple as I thought it was going to be. The main issue was that I needed to make sure I didn't break org-store-link. First, I made org-link-normalize-string a public function. I then added an argument to org-link-normalize-string and org-link-heading-search-string. Finally, I replaced org-clock--create-link-for-headline, from my previous patch, with org-link-create-link-for-table.
Le sam. 16 mai 2026 à 11:36, Ihor Radchenko <[email protected]> a écrit : > > [ Adding Org mailing list back to CC ] > > Earl Chase <[email protected]> writes: > > >> Thanks! > > > I am looking at the patch, and I feel like a cleaner approach would be > >> modifying `org-link--normalize-string' instead. That can also be used > >> from `org-clock--create-clean-headline' as it also removes statistic > >> cookies and the pile characters. > >> WDYT? > > > > I could do that. But it may just make more sense to just drop > > org-clock--create-clean-headline. What I would do is have > > org-link--normalize-string remove pipe characters. Then > > org-link-heading-search-string could use org-link-display-format to > > remove links from headings before they are turned into search strings. > > +1. > > -- > Ihor Radchenko // yantar92, > Org mode maintainer, > Learn more about Org mode at <https://orgmode.org/>. > Support Org development at <https://liberapay.com/org-mode>, > or support my work at <https://liberapay.com/yantar92>
From ff6e2f7d23256ff13408b2451842df0708dcb0ce Mon Sep 17 00:00:00 2001 From: ApollonDeParnasse <[email protected]> Date: Wed, 6 May 2026 14:20:02 -0500 Subject: [PATCH] fix: Pipe char (|) in headings breaks clockreport --- lisp/ol.el | 118 ++++++++++++++++++++------------- lisp/org-clock.el | 22 ++---- testing/lisp/test-ol.el | 66 ++++++++++++++++++ testing/lisp/test-org-clock.el | 109 +++++++++++++++++++++++++----- 4 files changed, 240 insertions(+), 75 deletions(-) diff --git a/lisp/ol.el b/lisp/ol.el index 73645fb97..3fb8c2109 100644 --- a/lisp/ol.el +++ b/lisp/ol.el @@ -35,6 +35,7 @@ (require 'org-fold) (require 'calendar) +(require 'subr-x) (defvar clean-buffer-list-kill-buffer-names) (defvar org-agenda-buffer-name) @@ -907,30 +908,31 @@ White spaces are not significant." "\n")))) context))) -(defun org-link--normalize-string (string &optional context) - "Remove ignored contents from STRING string and return it. +(defun org-link-normalize-string (string &optional context remove-pipes) + "Remove ignored contents from STRING and return it. This function removes contiguous white spaces and statistics cookies. When optional argument CONTEXT is non-nil, it assumes STRING is a context string, and also removes special search -syntax around the string." - (let ((string - (org-trim - (replace-regexp-in-string - (rx (one-or-more (any " \t"))) - " " - (replace-regexp-in-string - ;; Statistics cookie regexp. - (rx (seq "[" (0+ digit) (or "%" (seq "/" (0+ digit))) "]")) - " " - string))))) +syntax around the string. When optional argument REMOVE-PIPES +is non-nil, remove pipe chars." + (let ((clean-str + (thread-last (if remove-pipes (replace-regexp-in-string "|" " " string) string) + (replace-regexp-in-string + ;; Statistics cookie regexp. + (rx (seq "[" (0+ digit) (or "%" (seq "/" (0+ digit))) "]")) + " ") + (replace-regexp-in-string + (rx (one-or-more (any " \t"))) + " ") + (org-trim)))) (when context - (while (cond ((and (string-prefix-p "(" string) - (string-suffix-p ")" string)) - (setq string (org-trim (substring string 1 -1)))) - ((string-match "\\`[#*]+[ \t]*" string) - (setq string (substring string (match-end 0)))) + (while (cond ((and (string-prefix-p "(" clean-str) + (string-suffix-p ")" clean-str)) + (setq clean-str (org-trim (substring clean-str 1 -1)))) + ((string-match "\\`[#*]+[ \t]*" clean-str) + (setq clean-str (substring clean-str (match-end 0)))) (t nil)))) - string)) + clean-str)) (defun org-link--reveal-maybe (region _) "Reveal folded link in REGION when needed. @@ -1733,6 +1735,28 @@ Optional argument ARG is passed to `org-open-file' when S is a s (substring s (1- (org-element-end link))))) (link (org-link-open link arg)))) +(cl-defun org-link--search-headlines (words &optional remove-pipes) + "Search headlines in Org mode buffers. +WORDS is a list of strings. When the value of +REMOVE-PIPES is t, pipe chars are removed from +headlines before we test for equality. Ignore +COMMENT keyword, TODO keywords, priority cookies, +statistics cookies and tags." + (let ((title-re + (format "%s.*\\(?:%s[ \t]\\)?.*%s" + org-outline-regexp-bol + org-comment-string + (regexp-opt words))) + (case-fold-search t)) + (goto-char (point-min)) + (catch :found + (while (re-search-forward title-re nil t) + (when-let* ((heading-content (org-get-heading t t t t)) + (heading-parts (split-string (org-link-normalize-string heading-content nil remove-pipes))) + (match-found (equal words heading-parts))) + (throw :found t))) + nil))) + (defun org-link-search (s &optional avoid-pos stealth new-heading-container) "Search for a search string S in the accessible part of the buffer. @@ -1832,25 +1856,15 @@ respects buffer narrowing." (forward-line 0) (throw :name-match t)))) nil)))) - ;; Regular text search. Prefer headlines in Org mode buffers. - ;; Ignore COMMENT keyword, TODO keywords, priority cookies, - ;; statistics cookies and tags. + ;; Regular text search of headlines in Org mode buffers ((and (derived-mode-p 'org-mode) - (let ((title-re - (format "%s.*\\(?:%s[ \t]\\)?.*%s" - org-outline-regexp-bol - org-comment-string - (mapconcat #'regexp-quote words ".+")))) - (goto-char (point-min)) - (catch :found - (while (re-search-forward title-re nil t) - (when (equal (mapcar #'upcase words) - (mapcar #'upcase - (split-string - (org-link--normalize-string - (org-get-heading t t t t))))) - (throw :found t))) - nil))) + (org-link--search-headlines words)) + (forward-line 0) + (setq type 'dedicated)) + ;; Second attempt of regular text search of headlines in Org mode buffers + ;; This time we remove pipes from headlines + ((and (derived-mode-p 'org-mode) + (org-link--search-headlines (split-string (org-link-unescape (if starred (substring s 1) s))) 't)) (forward-line 0) (setq type 'dedicated)) ;; Offer to create non-existent headline depending on @@ -1911,7 +1925,7 @@ respects buffer narrowing." (org-fold-show-context 'link-search)) type)) -(defun org-link-heading-search-string (&optional string) +(defun org-link-heading-search-string (&optional string remove-pipes) "Make search string for the current headline or STRING. Search string starts with an asterisk. COMMENT keyword and @@ -1920,10 +1934,24 @@ into a single one. When optional argument STRING is non-nil, assume it a headline, without any asterisk, TODO or COMMENT keyword, and without any -priority cookie or tag." +priority cookie or tag. + +When optional argument REMOVE-PIPES is non-nil, +remove pipe chars from string." (concat "*" - (org-link--normalize-string - (or string (org-get-heading t t t t))))) + (org-link-normalize-string + (or string (org-get-heading t t t t)) nil remove-pipes))) + +(defun org-link-create-headline-link-for-table (headline) + "Convert HEADLINE into a link for a clocktable. +The link and the description will not contain contiguous +white spaces, statistics cookies or pipe chars." + (let* ((file-name (buffer-file-name)) + (description (org-link-normalize-string headline nil t)) + (link (if file-name + (format "file:%s::%s" file-name (org-link-heading-search-string headline t)) + (org-link-heading-search-string headline t)))) + (org-link-make-string link description))) (defun org-link-precise-link-target () "Determine search string and description for storing a link. @@ -1954,7 +1982,7 @@ matches." (result (cond (region - (list (org-link--normalize-string region t) + (list (org-link-normalize-string region t) nil (region-beginning))) @@ -1974,19 +2002,19 @@ matches." name (org-element-begin element))) ((org-before-first-heading-p) - (list (org-link--normalize-string (org-current-line-string) t) + (list (org-link-normalize-string (org-current-line-string) t) nil (line-beginning-position))) (heading (list (if custom-id (concat "#" custom-id) (org-link-heading-search-string)) - (org-link--normalize-string + (org-link-normalize-string (org-get-heading t t t t)) (org-element-begin heading)))))) ;; Not in an org-mode buffer, no region (t - (list (org-link--normalize-string (org-current-line-string) t) + (list (org-link-normalize-string (org-current-line-string) t) nil (line-beginning-position)))))) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 53d326e58..889b2f786 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -47,7 +47,8 @@ (declare-function org-inlinetask-goto-end "org-inlinetask" ()) (declare-function org-inlinetask-in-task-p "org-inlinetask" ()) (declare-function org-link-display-format "ol" (s)) -(declare-function org-link-heading-search-string "ol" (&optional string)) +(declare-function org-link-normalize-string "ol" (string &optional context remove-pipes)) +(declare-function org-link-create-headline-link-for-table "ol" (headline)) (declare-function org-link-make-string "ol" (link &optional description)) (declare-function org-table-goto-line "org-table" (n)) (declare-function w32-notification-notify "w32fns.c" (&rest params)) @@ -62,6 +63,7 @@ (defvar org-state) (defvar org-link-bracket-re) + (defgroup org-clock nil "Options concerning clocking working time in Org mode." :tag "Org Clock" @@ -3120,6 +3122,8 @@ a number of clock tables." (setq start next)) (end-of-line 0)))) + + (defun org-clock-get-table-data (file params) "Get the clocktable data for file FILE, with parameters PARAMS. FILE is only for identification - this function assumes that @@ -3206,20 +3210,8 @@ PROPERTIES: The list properties specified in the `:properties' parameter (when (<= level maxlevel) (let* ((headline (org-get-heading t t t t)) (hdl - (if (not link) headline - (let ((search - (org-link-heading-search-string headline))) - (org-link-make-string - (if (not (buffer-file-name)) search - (format "file:%s::%s" (buffer-file-name) search)) - ;; Prune statistics cookies. Replace - ;; links with their description, or - ;; a plain link if there is none. - (org-trim - (org-link-display-format - (replace-regexp-in-string - "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" "" - headline))))))) + (if (not link) (org-link-normalize-string headline nil t) + (org-link-create-headline-link-for-table headline))) (tgs (and tags (org-get-tags))) (tsp (and timestamp diff --git a/testing/lisp/test-ol.el b/testing/lisp/test-ol.el index 371bf1e0f..7b5cfee2a 100644 --- a/testing/lisp/test-ol.el +++ b/testing/lisp/test-ol.el @@ -886,5 +886,71 @@ API in `org-link-parameters'. Used in test (org-insert-link nil nil "altered description")) (should (equal (buffer-string) "[[file:file.org][altered description]]")))) +(defun test-regular-org-link-heading-search-string (heading) + "Helper function for `test-org-link-search'. +Inserts HEADING into an org +buffer and then returns the heading value +as a org-link search string." + (org-test-with-temp-text heading + (org-link-heading-search-string))) + +(defun test-org-link-heading-search-string-remove-pipes (heading) + "Helper function for `test-org-link-search'. +Inserts HEADING into an org +buffer and then returns the heading value +as a org-link search string. +Replaces pipe chars with spaces +in order to simulate the way +org-clock removes spaces from +headings when it creates links +for a clocktable." + (org-test-with-temp-text heading + (org-link-heading-search-string nil t))) + +(cl-defun test-org-link-search (search-string-creator) + "Returns a closure that can be used to test `org-link-search'. +SEARCH-STRING-CREATOR should be a function +that returns an org-link search string." + (lambda (buffer-text headline-to-find) + (let ((org-link-search-must-match-exact-headline nil) + (org-todo-regexp "TODO")) + (org-test-with-temp-text buffer-text + (org-link-search (funcall search-string-creator headline-to-find)) + (should (string-equal (buffer-substring-no-properties (point) (line-end-position)) headline-to-find)))))) + +(defalias 'test-org-link-search-basic (test-org-link-search #'test-regular-org-link-heading-search-string)) + +(defalias 'test-org-link-search-replace-pipe-chars (test-org-link-search #'test-org-link-heading-search-string-remove-pipes)) + +(ert-deftest test-org-link/search-first-pass () + "First test for `org-link-search'. +Confirm that we can find an exact match for +a given heading search string." + (test-org-link-search-basic "* Head1\n* Head2\n* Head3\n* [[Head2]]" "* Head2") + (test-org-link-search-basic "* Test 1 2 3\n** Test 1 2\n* [[*Test 1 2]]" "* [[*Test 1 2]]") + (let ((first-line + "*** TODO [#A] [/] Test [1/2] [33%] 1 \t 2 [%] :work:urgent: ")) + (test-org-link-search-basic + (concat "* Foo Bar\n** [[*Test 1 2]]\n" first-line) first-line) + (test-org-link-search-basic + (concat "* Foo Bar\n** [[*Test 1 2]]\n" first-line) "** [[*Test 1 2]]"))) + +(ert-deftest test-org-link/search-second-pass () + "Second test for `org-link-search'. +Confirm that we can find a match for +a heading when the heading search string does +not contain pipe chars even though +the original heading does." + (test-org-link-search-replace-pipe-chars "* Head1\n* Head2\n* | Head3\n* [[Head2]]" "* | Head3") + (test-org-link-search-replace-pipe-chars "* Test 1 2 3\n** Test 1 | 2 |\n* [[*Test 1 2]]" "** Test 1 | 2 |") + (test-org-link-search-replace-pipe-chars "* DONE task \n* WAITING another task \n* [[file:/home/binarin/test.org::*A|B][A|B]]" "* [[file:/home/binarin/test.org::*A|B][A|B]]") + (let ((first-line + "*** TODO [#A] [/] Test [1/2] [33%] 1 | 2 [%] :work:urgent: ")) + (test-org-link-search-replace-pipe-chars + (concat "* Foo Bar\n** [[*Test 1 |2]]\n" first-line) first-line) + (test-org-link-search-replace-pipe-chars + (concat "* Foo Bar\n** [[*Test 1 2 |]]\n" first-line) "** [[*Test 1 2 |]]"))) + + (provide 'test-ol) ;;; test-ol.el ends here diff --git a/testing/lisp/test-org-clock.el b/testing/lisp/test-org-clock.el index 4d5cb055e..164c7de2b 100644 --- a/testing/lisp/test-org-clock.el +++ b/testing/lisp/test-org-clock.el @@ -861,10 +861,26 @@ CLOCK: [2016-12-28 Wed 13:09]--[2016-12-28 Wed 15:09] => 2:00" CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" (test-org-clock-clocktable-contents ":maxlevel 1 :lang foo"))))) +(ert-deftest test-org-clock/clocktable/remove-pipe-chars () + "Confirm pipe chars are removed from headings before they are added to the Clock Table." + (should + (string-match-p "| Foo Bar +| 26:00 +|" + (org-test-with-temp-text + "* Foo | Bar +CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" + (test-org-clock-clocktable-contents ":block untilnow :indent nil")))) + (should + (string-match-p "| Foo Bar Baz +| 26:00 +|" + (org-test-with-temp-text + "* Foo | Bar | Baz +CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" + (test-org-clock-clocktable-contents ":block untilnow :indent nil"))))) + (ert-deftest test-org-clock/clocktable/link () "Test \":link\" parameter in Clock table." ;; If there is no file attached to the document, link directly to ;; the headline. + (should (string-match-p "| +\\[\\[\\*Foo]\\[Foo]] +| 26:00 +|" (org-test-with-temp-text @@ -876,13 +892,13 @@ CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" (string-match-p "| \\[\\[file:filename::\\*Foo]\\[Foo]] +| 26:00 +|" (org-test-with-temp-text - (org-test-with-temp-text-in-file - "* Foo + (org-test-with-temp-text-in-file + "* Foo CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" - (let ((file (buffer-file-name))) + (let ((file (buffer-file-name))) (replace-regexp-in-string (regexp-quote file) "filename" - (test-org-clock-clocktable-contents ":link t :lang en")))) + (test-org-clock-clocktable-contents ":link t :lang en")))) (org-table-align) (buffer-substring-no-properties (point-min) (point-max))))) ;; Ignore TODO keyword, priority cookie, COMMENT and tags in @@ -891,28 +907,28 @@ CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" (string-match-p "| \\[\\[\\*Foo]\\[Foo]] +| 26:00 +|" (org-test-with-temp-text - "* TODO Foo + "* TODO Foo CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" (test-org-clock-clocktable-contents ":link t :lang en")))) (should (string-match-p "| \\[\\[\\*Foo]\\[Foo]] +| 26:00 +|" (org-test-with-temp-text - "* [#A] Foo + "* [#A] Foo CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" (test-org-clock-clocktable-contents ":link t :lang en")))) (should (string-match-p "| \\[\\[\\*Foo]\\[Foo]] +| 26:00 +|" (org-test-with-temp-text - "* COMMENT Foo + "* COMMENT Foo CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" (test-org-clock-clocktable-contents ":link t")))) (should (string-match-p "| \\[\\[\\*Foo]\\[Foo]] +| 26:00 +|" (org-test-with-temp-text - "* Foo :tag: + "* Foo :tag: CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" (test-org-clock-clocktable-contents ":link t :lang en")))) ;; Remove statistics cookie from headline description. @@ -920,32 +936,95 @@ CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" (string-match-p "| \\[\\[\\*Foo]\\[Foo]] +| 26:00 +|" (org-test-with-temp-text - "* Foo [50%] + "* Foo [50%] CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" (test-org-clock-clocktable-contents ":link t :lang en")))) (should (string-match-p "| \\[\\[\\*Foo]\\[Foo]] +| 26:00 +|" (org-test-with-temp-text - "* Foo [1/2] + "* Foo [1/2] CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" (test-org-clock-clocktable-contents ":link t :lang en")))) ;; Replace links with their description, or turn them into plain ;; links if there is no description. (should (string-match-p - "| \\[\\[\\*Foo \\\\\\[\\\\\\[https://orgmode\\.org\\\\]\\\\\\[Org mode\\\\]\\\\]]\\[Foo Org mode]] +| 26:00 +|" + "| \\[\\[\\*Foo \\\\\\[\\\\\\[https://orgmode\\.org\\\\]\\\\\\[Org mode\\\\]\\\\]]\\[Foo \\[\\[https://orgmode\\.org]\\[Org mode]]]] | 26:00 +|" + (org-test-with-temp-text + "* Foo [[https://orgmode.org][Org mode]] +CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" + (test-org-clock-clocktable-contents ":link t :lang en")))) + (should + (string-match-p + "| \\[\\[\\*Foo \\\\\\[\\\\\\[https://orgmode\\.org\\\\]\\\\]]\\[Foo \\[\\[https://orgmode\\.org]]]] | 26:00 +|" (org-test-with-temp-text - "* Foo [[https://orgmode.org][Org mode]] + "* Foo [[https://orgmode.org]] CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" (test-org-clock-clocktable-contents ":link t :lang en")))) + ;; remove pipe characters before creating links (should (string-match-p - "| \\[\\[\\*Foo \\\\\\[\\\\\\[https://orgmode\\.org\\\\]\\\\]]\\[Foo https://orgmode\\.org]] +| 26:00 +|" + "| \\[\\[\\*Foo Bar]\\[Foo Bar]] +| 26:00 +|" (org-test-with-temp-text - "* Foo [[https://orgmode.org]] + "* Foo | Bar CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" - (test-org-clock-clocktable-contents ":link t :lang en"))))) + (test-org-clock-clocktable-contents ":link t :lang en")))) + (should + (string-match-p + "| \\[\\[\\*Foo <file:foo\\.org::\\*Heading with inside>]\\[Foo <file:foo\\.org::\\*Heading with inside>]] | 26:00 +|" + (org-test-with-temp-text + "* Foo <file:foo.org::*Heading with | inside> +CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" + (test-org-clock-clocktable-contents ":link t :lang en")))) + (should + (string-match-p + "| \\[\\[\\*\\\\\\[\\\\\\[file:/home/binarin/test\\.org::\\*A B\\\\]\\\\\\[A B\\\\]\\\\]]\\[\\[\\[file:/home/binarin/test\\.org::\\*A\\.\\.\\.]] | 26:00 +|" + (org-test-with-temp-text + "* [[file:/home/binarin/test.org::*A | B][A | B]] +CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" + (test-org-clock-clocktable-contents ":link t :lang en")))) + ;; Works in files as as well. + (should + (string-match-p + "| \\[\\[file:filename::\\*Foo Bar]\\[Foo Bar]] +| 26:00 +|" + (org-test-with-temp-text + (org-test-with-temp-text-in-file + "* Foo | Bar +CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" + (let ((file (buffer-file-name))) + (replace-regexp-in-string + (regexp-quote file) "filename" + (test-org-clock-clocktable-contents ":link t :lang en")))) + (org-table-align) + (buffer-substring-no-properties (point-min) (point-max))))) + (should + (string-match-p + "| \\[\\[file:filename::\\*Foo <file:foo\\.org::\\*Heading with inside>]\\[Foo <file:foo\\.org::\\*Heading with inside>]] | 26:00 +|" + (org-test-with-temp-text + (org-test-with-temp-text-in-file + "* Foo <file:foo.org::*Heading with | inside> +CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" + (let ((file (buffer-file-name))) + (replace-regexp-in-string + (regexp-quote file) "filename" + (test-org-clock-clocktable-contents ":link t :lang en")))) + (org-table-align) + (buffer-substring-no-properties (point-min) (point-max))))) + (should + (string-match-p + "| \\[\\[file:filename::\\*\\\\\\[\\\\\\[file:/home/binarin/test\\.org::\\*A B\\\\]\\\\\\[A B\\\\]\\\\]]\\[\\[\\[file:/home/binarin/test\\.org::\\*A\\.\\.\\.]] | 26:00 +|" + (org-test-with-temp-text + (org-test-with-temp-text-in-file + "* [[file:/home/binarin/test.org::*A | B][A | B]] +CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00" + (let ((file (buffer-file-name))) + (replace-regexp-in-string + (regexp-quote file) "filename" + (test-org-clock-clocktable-contents ":link t :lang en")))) + (org-table-align) + (buffer-substring-no-properties (point-min) (point-max)))))) + (ert-deftest test-org-clock/clocktable/compact () "Test \":compact\" parameter in Clock table." -- 2.54.0
