Browse Source

Refactor context part in file links

* lisp/ol.el (org-link--context-from-region):
(org-link--squeeze-white-spaces): New functions.
(org-link-heading-search-string): Refactor code. Always start with an asterisk.
(org-store-link): Use new functions.
* lisp/org-pcomplete.el (pcomplete/org-mode/searchhead):
* testing/lisp/test-org-clock.el (test-org-clock/clocktable/link):
Update tests.
Nicolas Goaziou 1 year ago
parent
commit
12c09be3a6
3 changed files with 71 additions and 60 deletions
  1. 58 48
      lisp/ol.el
  2. 3 2
      lisp/org-pcomplete.el
  3. 10 10
      testing/lisp/test-org-clock.el

+ 58 - 48
lisp/ol.el

@@ -45,6 +45,7 @@
 (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
 (declare-function org-at-heading-p "org" (&optional _))
 (declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-before-first-heading-p "org" ())
 (declare-function org-do-occur "org" (regexp &optional cleanup))
 (declare-function org-element-at-point "org-element" ())
 (declare-function org-element-cache-refresh "org-element" (pos))
@@ -57,7 +58,6 @@
 (declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
 (declare-function org-find-property "org" (property &optional value))
 (declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment))
-(declare-function org-heading-components "org" ())
 (declare-function org-id-find-id-file "org-id" (id))
 (declare-function org-id-store-link "org-id" ())
 (declare-function org-insert-heading "org" (&optional arg invisible-ok top))
@@ -731,6 +731,23 @@ White spaces are not significant."
       (goto-char origin)
       (user-error "No match for radio target: %s" target))))
 
+(defun org-link--context-from-region ()
+  "Return context string from active region, or nil."
+  (when (org-region-active-p)
+    (let ((context (buffer-substring (region-beginning) (region-end))))
+      (when (and (wholenump org-link-context-for-files)
+		 (> org-link-context-for-files 0))
+	(let ((lines (org-split-string context "\n")))
+	  (setq context
+		(mapconcat #'identity
+			   (cl-subseq lines 0 org-link-context-for-files)
+			   "\n"))))
+      (org-link--squeeze-white-spaces context))))
+
+(defun org-link--squeeze-white-spaces (string)
+  "Trim STRING, pack contiguous white spaces, and return it."
+  (replace-regexp-in-string "[ \t\n]+" " " (org-trim string)))
+
 
 ;;; Public API
 
@@ -1221,24 +1238,23 @@ of matched result, which is either `dedicated' or `fuzzy'."
     type))
 
 (defun org-link-heading-search-string (&optional string)
-  "Make search string for the current headline or STRING."
-  (let ((s (or string
-	       (and (derived-mode-p 'org-mode)
-		    (save-excursion
-		      (org-back-to-heading t)
-		      (org-element-property :raw-value
-					    (org-element-at-point))))))
-	(lines org-link-context-for-files))
-    (unless string (setq s (concat "*" s))) ;Add * for headlines
-    (setq s (replace-regexp-in-string "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" s))
-    (when (and string (integerp lines) (> lines 0))
-      (let ((slines (org-split-string s "\n")))
-	(when (< lines (length slines))
-	  (setq s (mapconcat
-		   #'identity
-		   (reverse (nthcdr (- (length slines) lines)
-				    (reverse slines))) "\n")))))
-    (mapconcat #'identity (split-string s) " ")))
+  "Make search string for the current headline or STRING.
+When optional argument STRING is non-nil, assume it a headline.
+Search string starts with an asterisk.  COMMENT keyword and
+statistics cookies are removed, and contiguous spaces are packed
+into a single one."
+  (let ((context
+	 (if (not string)
+	     (concat "*" (org-trim (org-get-heading nil nil nil t)))
+	   (let ((s (org-trim string))
+		 (comment-re (format "\\`%s[ \t]+" org-comment-string)))
+	     (unless (string-prefix-p "*" s) (setq s (concat "*" s)))
+	     (replace-regexp-in-string comment-re "" s))))
+	(cookie-re "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]"))
+    (org-trim
+     (replace-regexp-in-string
+      cookie-re ""
+      (org-link--squeeze-white-spaces context)))))
 
 (defun org-link-open-as-file (path arg)
   "Pretend PATH is a file name and open it.
@@ -1446,7 +1462,7 @@ non-nil."
 	    (move-beginning-of-line 2)
 	    (set-mark (point)))))
     (setq org-store-link-plist nil)
-    (let (link cpltxt desc description search txt custom-id agenda-link)
+    (let (link cpltxt desc description search custom-id agenda-link)
       (cond
        ;; Store a link using an external link type, if any function is
        ;; available. If more than one can generate a link from current
@@ -1605,30 +1621,25 @@ non-nil."
 				 (abbreviate-file-name
 				  (buffer-file-name (buffer-base-buffer))))))))
 	  (t
-	   ;; Just link to current headline
+	   ;; Just link to current headline.
 	   (setq cpltxt (concat "file:"
 				(abbreviate-file-name
 				 (buffer-file-name (buffer-base-buffer)))))
-	   ;; Add a context search string
+	   ;; Add a context search string.
 	   (when (org-xor org-link-context-for-files (equal arg '(4)))
 	     (let* ((element (org-element-at-point))
-		    (name (org-element-property :name element)))
-	       (setq txt (cond
-			  ((org-at-heading-p) nil)
-			  (name)
-			  ((org-region-active-p)
-			   (buffer-substring (region-beginning) (region-end)))))
-	       (when (or (null txt) (string-match "\\S-" txt))
-		 (setq cpltxt
-		       (concat cpltxt "::"
-			       (condition-case nil
-				   (org-link-heading-search-string txt)
-				 (error "")))
-		       desc (or name
-				(nth 4 (ignore-errors (org-heading-components)))
-				"NONE")))))
-	   (when (string-match "::\\'" cpltxt)
-	     (setq cpltxt (substring cpltxt 0 -2)))
+		    (name (org-element-property :name element))
+		    (context
+		     (cond
+		      ((org-link--context-from-region))
+		      (name)
+		      ((org-before-first-heading-p)
+		       (org-link--squeeze-white-spaces
+			(org-current-line-string)))
+		      (t (org-link-heading-search-string)))))
+	       (when (org-string-nw-p context)
+		 (setq cpltxt (format "%s::%s" cpltxt context))
+		 (setq desc (or name (org-get-heading t t t t) "NONE")))))
 	   (setq link cpltxt)))))
 
        ((buffer-file-name (buffer-base-buffer))
@@ -1636,16 +1647,15 @@ non-nil."
 	(setq cpltxt (concat "file:"
 			     (abbreviate-file-name
 			      (buffer-file-name (buffer-base-buffer)))))
-	;; Add a context string.
+	;; Add a context search string.
 	(when (org-xor org-link-context-for-files (equal arg '(4)))
-	  (setq txt (if (org-region-active-p)
-			(buffer-substring (region-beginning) (region-end))
-		      (buffer-substring (point-at-bol) (point-at-eol))))
-	  ;; Only use search option if there is some text.
-	  (when (string-match "\\S-" txt)
-	    (setq cpltxt
-		  (concat cpltxt "::" (org-link-heading-search-string txt))
-		  desc "NONE")))
+	  (let ((context (or (org-link--context-from-region)
+			     (org-link--squeeze-white-spaces
+			      (org-current-line-string)))))
+	    ;; Only use search option if there is some text.
+	    (when (org-string-nw-p context)
+	      (setq cpltxt (format "%s::%s" cpltxt context))
+	      (setq desc "NONE"))))
 	(setq link cpltxt))
 
        (interactive?

+ 3 - 2
lisp/org-pcomplete.el

@@ -352,8 +352,9 @@ This needs more work, to handle headings with lots of spaces in them."
 	    (goto-char (point-min))
 	    (let (tbl)
 	      (while (re-search-forward org-outline-regexp nil t)
-		(push (org-link-heading-search-string (org-get-heading t t t t))
-		      tbl))
+		;; Remove the leading asterisk from
+		;; `org-link-heading-search-string' result.
+		(push (substring (org-link-heading-search-string) 1) tbl))
 	      (pcomplete-uniquify-list tbl)))
 	  ;; When completing a bracketed link, i.e., "[[*", argument
 	  ;; starts at the star, so remove this character.

+ 10 - 10
testing/lisp/test-org-clock.el

@@ -577,7 +577,7 @@ CLOCK: [2016-12-28 Wed 13:09]--[2016-12-28 Wed 15:09] =>  2:00"
   ;; If there is no file attached to the document, link directly to
   ;; the headline.
   (should
-   (string-match-p "| +\\[\\[Foo]\\[Foo]] +| 26:00 +|"
+   (string-match-p "| +\\[\\[\\*Foo]\\[Foo]] +| 26:00 +|"
 		   (org-test-with-temp-text
 		       "* Foo
 CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"
@@ -585,7 +585,7 @@ CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"
   ;; Otherwise, link to the headline in the current file.
   (should
    (string-match-p
-    "| \\[\\[file:filename::Foo]\\[Foo]] +| 26:00 +|"
+    "| \\[\\[file:filename::\\*Foo]\\[Foo]] +| 26:00 +|"
     (org-test-with-temp-text
 	(org-test-with-temp-text-in-file
 	    "* Foo
@@ -600,28 +600,28 @@ CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"
   ;; headline.
   (should
    (string-match-p
-    "| \\[\\[Foo]\\[Foo]] +| 26:00 +|"
+    "| \\[\\[\\*Foo]\\[Foo]] +| 26:00 +|"
     (org-test-with-temp-text
 	"* 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 +|"
+    "| \\[\\[\\*Foo]\\[Foo]] +| 26:00 +|"
     (org-test-with-temp-text
 	"* [#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 +|"
+    "| \\[\\[\\*Foo]\\[Foo]] +| 26:00 +|"
     (org-test-with-temp-text
 	"* 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 +|"
+    "| \\[\\[\\*Foo]\\[Foo]] +| 26:00 +|"
     (org-test-with-temp-text
 	"* Foo :tag:
 CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"
@@ -629,14 +629,14 @@ CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"
   ;; Remove statistics cookie from headline description.
   (should
    (string-match-p
-    "| \\[\\[Foo]\\[Foo]] +| 26:00 +|"
+    "| \\[\\[\\*Foo]\\[Foo]] +| 26:00 +|"
     (org-test-with-temp-text
 	"* 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 +|"
+    "| \\[\\[\\*Foo]\\[Foo]] +| 26:00 +|"
     (org-test-with-temp-text
 	"* Foo [1/2]
 CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"
@@ -645,14 +645,14 @@ CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"
   ;; 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 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 +|"
+    "| \\[\\[\\*Foo \\\\\\[\\\\\\[https://orgmode\\.org\\\\]\\\\]]\\[Foo https://orgmode\\.org]] +| 26:00 +|"
     (org-test-with-temp-text
 	"* Foo [[https://orgmode.org]]
 CLOCK: [2016-12-27 Wed 13:09]--[2016-12-28 Wed 15:09] => 26:00"