Browse Source

Fix `org-(next|previous)-link'

* lisp/ol.el (org-next-link): Rewrite function.
* testing/lisp/test-ol.el (test-ol/next-link):
(test-ol/previous-link): New tests.
Nicolas Goaziou 6 years ago
parent
commit
4ff8947ea8
2 changed files with 122 additions and 16 deletions
  1. 30 16
      lisp/ol.el
  2. 92 0
      testing/lisp/test-ol.el

+ 30 - 16
lisp/ol.el

@@ -1314,22 +1314,36 @@ PATH is the command to execute, as a string."
 If the link is in hidden text, expose it.  When SEARCH-BACKWARD
 is non-nil, move backward."
   (interactive)
-  (when (and org-link--search-failed (eq this-command last-command))
-    (goto-char (point-min))
-    (message "Link search wrapped back to beginning of buffer"))
-  (setq org-link--search-failed nil)
-  (let* ((pos (point))
-	 (ct (org-context))
-	 (a (assq :link ct))
-	 (srch-fun (if search-backward 're-search-backward 're-search-forward)))
-    (cond (a (goto-char (nth (if search-backward 1 2) a)))
-	  ((looking-at org-link-any-re)
-	   ;; Don't stay stuck at link without an org-link face
-	   (forward-char (if search-backward -1 1))))
-    (if (funcall srch-fun org-link-any-re nil t)
-	(progn
-	  (goto-char (match-beginning 0))
-	  (when (org-invisible-p) (org-show-context)))
+  (let ((pos (point))
+	(search-fun (if search-backward #'re-search-backward
+		      #'re-search-forward)))
+    ;; Tweak initial position.  If last search failed, wrap around.
+    ;; Otherwise, make sure we do not match current link.
+    (cond
+     ((not (and org-link--search-failed (eq this-command last-command)))
+      (cond
+       ((and (not search-backward) (looking-at org-link-any-re))
+	(goto-char (match-end 0)))
+       (search-backward
+	(pcase (org-in-regexp org-link-any-re nil t)
+	  (`(,beg . ,_) (goto-char beg))
+	  (_ nil)))
+       (t nil)))
+     (search-backward
+      (goto-char (point-max))
+      (message "Link search wrapped back to end of buffer"))
+     (t
+      (goto-char (point-min))
+      (message "Link search wrapped back to beginning of buffer")))
+    (setq org-link--search-failed nil)
+    (catch :found
+      (while (funcall search-fun org-link-any-re nil t)
+	(pcase (org-element-lineage (org-element-context) '(link) t)
+	  (`nil nil)
+	  (link
+	   (goto-char (org-element-property :begin link))
+	   (when (org-invisible-p) (org-show-context))
+	   (throw :found t))))
       (goto-char pos)
       (setq org-link--search-failed t)
       (message "No further link found"))))

+ 92 - 0
testing/lisp/test-ol.el

@@ -248,6 +248,98 @@ http://article.gmane.org/gmane.emacs.orgmode/21459/"
 	 (insert "new")
 	 (org-element-type (org-element-context))))))
 
+
+;;; Navigation
+
+(ert-deftest test-ol/next-link ()
+  "Test `org-next-link' specifications."
+  ;; Move to any type of link.
+  (should
+   (equal "[[link]]"
+	  (org-test-with-temp-text "foo [[link]]"
+	    (org-next-link)
+	    (buffer-substring (point) (line-end-position)))))
+  (should
+   (equal "http://link"
+	  (org-test-with-temp-text "foo http://link"
+	    (org-next-link)
+	    (buffer-substring (point) (line-end-position)))))
+  (should
+   (equal "<http://link>"
+	  (org-test-with-temp-text "foo <http://link>"
+	    (org-next-link)
+	    (buffer-substring (point) (line-end-position)))))
+  ;; Ignore link at point.
+  (should
+   (equal "[[link2]]"
+	  (org-test-with-temp-text "[[link1]] [[link2]]"
+	    (org-next-link)
+	    (buffer-substring (point) (line-end-position)))))
+  ;; Ignore fake links.
+  (should
+   (equal "[[truelink]]"
+	  (org-test-with-temp-text "foo\n: [[link]]\n[[truelink]]"
+	    (org-next-link)
+	    (buffer-substring (point) (line-end-position)))))
+  ;; Do not move point when there is no link.
+  (should
+   (org-test-with-temp-text "foo bar"
+     (org-next-link)
+     (bobp)))
+  ;; Wrap around after a failed search.
+  (should
+   (equal "[[link]]"
+	  (org-test-with-temp-text "[[link]]\n<point>foo"
+	    (org-next-link)
+	    (let* ((this-command 'org-next-link)
+		   (last-command this-command))
+	      (org-next-link))
+	    (buffer-substring (point) (line-end-position))))))
+
+(ert-deftest test-ol/previous-link ()
+  "Test `org-previous-link' specifications."
+  ;; Move to any type of link.
+  (should
+   (equal "[[link]]"
+	  (org-test-with-temp-text "[[link]]\nfoo<point>"
+	    (org-previous-link)
+	    (buffer-substring (point) (line-end-position)))))
+  (should
+   (equal "http://link"
+	  (org-test-with-temp-text "http://link\nfoo<point>"
+	    (org-previous-link)
+	    (buffer-substring (point) (line-end-position)))))
+  (should
+   (equal "<http://link>"
+	  (org-test-with-temp-text "<http://link>\nfoo<point>"
+	    (org-previous-link)
+	    (buffer-substring (point) (line-end-position)))))
+  ;; Ignore link at point.
+  (should
+   (equal "[[link1]]"
+	  (org-test-with-temp-text "[[link1]]\n[[link2<point>]]"
+	    (org-previous-link)
+	    (buffer-substring (point) (line-end-position)))))
+  ;; Ignore fake links.
+  (should
+   (equal "[[truelink]]"
+	  (org-test-with-temp-text "[[truelink]]\n: [[link]]\n<point>"
+	    (org-previous-link)
+	    (buffer-substring (point) (line-end-position)))))
+  ;; Do not move point when there is no link.
+  (should
+   (org-test-with-temp-text "foo bar<point>"
+     (org-previous-link)
+     (eobp)))
+  ;; Wrap around after a failed search.
+  (should
+   (equal "[[link]]"
+	  (org-test-with-temp-text "foo\n[[link]]"
+	    (org-previous-link)
+	    (let* ((this-command 'org-previous-link)
+		   (last-command this-command))
+	      (org-previous-link))
+	    (buffer-substring (point) (line-end-position))))))
 
 (provide 'test-ol)
 ;;; test-ol.el ends here