diff options
| -rw-r--r-- | modules/org-config.el | 32 | ||||
| -rw-r--r-- | tests/test-org-config--org-follow-link-same-window.el | 72 |
2 files changed, 103 insertions, 1 deletions
diff --git a/modules/org-config.el b/modules/org-config.el index c0c6bb82..90a0a5d2 100644 --- a/modules/org-config.el +++ b/modules/org-config.el @@ -286,6 +286,28 @@ edge, less the tag width.") (org-backward-heading-same-level 1) (org-narrow-to-subtree)) + (defun cj/--org-follow-link-same-window () + "Follow the Org link at point, opening file links in the current window. +Org's default for file links is `find-file-other-window' (via +`org-link-frame-setup'); this overrides it so the file replaces the buffer +the link sits in. Off a link this does nothing, so a stray click is a silent +no-op rather than a \"No link found\" error." + (when (eq (org-element-type (org-element-context)) 'link) + (let ((org-link-frame-setup (cons '(file . find-file) org-link-frame-setup))) + (org-open-at-point)))) + + (defun cj/org-follow-link-at-mouse-same-window (event) + "Follow the Org link clicked in EVENT, opening file links in the same window. +Bound to S-mouse-1 and mouse-3 in `org-mouse-map' -- the keymap org attaches +to each link as a `keymap' text property. That layer outranks both +`org-mode-map' and the `mouse-trap-mode' emulation keymap, so the gesture +lands even where mouse-trap otherwise disables clicks. A shift-click or +right-click on a link opens it in place; org's other-window default +(mouse-2 / plain click) is left alone." + (interactive "e") + (mouse-set-point event) + (cj/--org-follow-link-same-window)) + :hook (org-mode . turn-on-visual-line-mode) (org-mode . (lambda () (setq-local tab-width 8))) @@ -300,7 +322,15 @@ edge, less the tag width.") (cj/org-general-settings) (cj/org-appearance-settings) - (cj/org-todo-settings)) + (cj/org-todo-settings) + + ;; Open a file link in the current window on shift-left-click or right-click. + ;; These bind into `org-mouse-map' (the per-link `keymap' text property) + ;; rather than `org-mode-map' so they outrank the `mouse-trap-mode' emulation + ;; keymap, which otherwise swallows clicks in org buffers. mouse-2 / plain + ;; click keep org's other-window default. + (keymap-set org-mouse-map "S-<mouse-1>" #'cj/org-follow-link-at-mouse-same-window) + (keymap-set org-mouse-map "<mouse-3>" #'cj/org-follow-link-at-mouse-same-window)) ;; ------------------------------- Org Superstar ------------------------------- diff --git a/tests/test-org-config--org-follow-link-same-window.el b/tests/test-org-config--org-follow-link-same-window.el new file mode 100644 index 00000000..57caf691 --- /dev/null +++ b/tests/test-org-config--org-follow-link-same-window.el @@ -0,0 +1,72 @@ +;;; test-org-config--org-follow-link-same-window.el --- same-window link follow -*- lexical-binding: t; -*- + +;;; Commentary: +;; `cj/--org-follow-link-same-window' follows the Org link at point, opening +;; file: links in the *current* window instead of org's default other-window +;; (`org-link-frame-setup' file entry). It is the kernel behind the S-mouse-1 +;; and mouse-3 bindings (`cj/org-follow-link-at-mouse-same-window'). Off a +;; link it does nothing, so a right-click in empty space is a silent no-op +;; rather than org's "No link found" user-error. +;; +;; `org-open-at-point' (the visit boundary) is stubbed to record whether it +;; was called and what the file entry of `org-link-frame-setup' resolved to at +;; call time; real temp Org buffers place point on / off a link. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'org) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-config) + +(ert-deftest test-org-config-follow-link-same-window-file-link () + "Normal: on a file link, follow it with the file frame-setup as find-file." + (with-temp-buffer + (let ((org-mode-hook nil) + (frame-file nil) + (called nil)) + (insert "see [[file:/tmp/notes.org][notes]] here") + (org-mode) + (goto-char (point-min)) + (search-forward "notes]") + (backward-char 2) ; land inside the link's description + (cl-letf (((symbol-function 'org-open-at-point) + (lambda (&rest _) + (setq called t + frame-file (cdr (assq 'file org-link-frame-setup)))))) + (cj/--org-follow-link-same-window)) + (should called) + (should (eq frame-file 'find-file))))) + +(ert-deftest test-org-config-follow-link-same-window-off-link-noop () + "Boundary: off any link, do nothing (no error, no visit)." + (with-temp-buffer + (let ((org-mode-hook nil) + (called nil)) + (insert "plain text, no link at all") + (org-mode) + (goto-char (point-min)) + (cl-letf (((symbol-function 'org-open-at-point) + (lambda (&rest _) (setq called t)))) + (cj/--org-follow-link-same-window)) + (should-not called)))) + +(ert-deftest test-org-config-follow-link-same-window-http-link () + "Boundary: on a non-file link, still follow it (frame-setup is harmless)." + (with-temp-buffer + (let ((org-mode-hook nil) + (called nil)) + (insert "site [[https://example.com][example]] end") + (org-mode) + (goto-char (point-min)) + (search-forward "example]") + (backward-char 2) + (cl-letf (((symbol-function 'org-open-at-point) + (lambda (&rest _) (setq called t)))) + (cj/--org-follow-link-same-window)) + (should called)))) + +(provide 'test-org-config--org-follow-link-same-window) +;;; test-org-config--org-follow-link-same-window.el ends here |