From a93ef20d4aa5a3aad57cffccad9bb644b2f5b382 Mon Sep 17 00:00:00 2001 From: Kyle S Passarelli Date: Thu, 22 Oct 2026 20:31:58 -0600 Subject: [PATCH] Links --- devops-test.el | 56 +++++++++++++++++++++++++++++++++++++++-- devops.el | 48 +++++++++++++++++++++++++++++++++++ examples/1_commands.org | 18 +++++++++++++ 3 files changed, 120 insertions(+), 2 deletions(-) diff --git a/devops-test.el b/devops-test.el index 0c8f6bf..1c3af40 100644 --- a/devops-test.el +++ b/devops-test.el @@ -93,8 +93,12 @@ The directory is removed afterwards." (should-not (devops-unload-function)) (should-not devops-mode) (should-not (advice-member-p #'devops--execute-on-target - 'org-babel-execute-src-block))) - (devops-mode 1))) + 'org-babel-execute-src-block)) + (should-not (assoc "target" org-link-parameters))) + (devops-mode 1) + (org-link-set-parameters "target" + :follow #'devops--target-link-follow + :complete #'devops--target-link-complete))) ;;; Keyword parsing @@ -321,6 +325,54 @@ The directory is removed afterwards." (devops-set-header-args-from-tags) (should (equal (org-entry-get nil "header-args") ":dir /srv/one/")))) +;;; target: links + +(ert-deftest devops--target-link-destination-test () + "A link joins files as tangling does, and URLs with one slash." + (should (equal (devops--target-link-destination "/ssh:host:" "etc/x.conf") + "/ssh:host:etc/x.conf")) + (should (equal (devops--target-link-destination "/ssh:host:/srv" "/etc/x") + "/ssh:host:/etc/x")) + (should (equal (devops--target-link-destination "/ssh:host:/srv" "") + "/ssh:host:/srv")) + (should (equal (devops--target-link-destination "https://grafana.example.com/" + "/d/abc") + "https://grafana.example.com/d/abc")) + (should (equal (devops--target-link-destination "https://example.com" "a/b") + "https://example.com/a/b"))) + +(ert-deftest devops--target-link-resolve-test () + "A link resolves its tag through the buffer's #+TARGET keywords." + (devops-test--with-org + (concat "#+TARGET: web /ssh:web1:/srv/\n" + "#+TARGET: dash https://dash.example.com\n") + (should (equal (devops--target-link-resolve "web:app/x.conf") + "/ssh:web1:/srv/app/x.conf")) + (should (equal (devops--target-link-resolve "web") "/ssh:web1:/srv/")) + (should (equal (devops--target-link-resolve "dash:status") + "https://dash.example.com/status")) + (should-error (devops--target-link-resolve "nope:x") :type 'user-error))) + +(ert-deftest devops-target-link-follow-test () + "Following a link visits the file, or browses a URL." + (devops-test--with-local-target target + (with-temp-file (expand-file-name "x.txt" target) (insert "hi\n")) + (devops-test--with-org + (format "#+TARGET: local %s\n#+TARGET: dash https://d.example\n" + target) + (let ((org-buf (current-buffer)) + browsed) + (devops--target-link-follow "local:x.txt" nil) + (unwind-protect + (should (equal buffer-file-name + (expand-file-name "x.txt" target))) + (kill-buffer)) + (with-current-buffer org-buf + (cl-letf (((symbol-function 'browse-url) + (lambda (url &rest _) (setq browsed url)))) + (devops--target-link-follow "dash:a" nil))) + (should (equal browsed "https://d.example/a")))))) + ;;; Target/path joining (ert-deftest devops--join-target-test () diff --git a/devops.el b/devops.el index 3f05b14..2ff2e1b 100644 --- a/devops.el +++ b/devops.el @@ -62,6 +62,11 @@ ;; - `devops-drift' (if loaded) report diff between blocks ;; and tangled files ;; +;; Links: +;; +;; - [[target:TAG:PATH]] PATH under TAG's target: a file, or a +;; page when the target is a URL +;; ;; If async is enabled (recommended) ;; - `devops-goto-session' show the target's shell session ;; - `devops-restart-session' kill the target's sessions @@ -849,6 +854,47 @@ ARG, visit it in another window." (t (message "No tangle paths found."))))) +(defun devops--url-p (target) + "Non-nil if TARGET is a URL such as https://host/ rather than a file." + (string-match-p "\\`[[:alpha:]][[:alnum:]+.-]*://" target)) + +(defun devops--target-link-destination (target path) + "Return where a target: link to PATH under TARGET points. +TARGET is a resolved #+TARGET value. A URL gets PATH appended after a +single slash; anything else is joined as `:tangle' paths are." + (cond + ((string-empty-p path) target) + ((devops--url-p target) + (concat (string-trim-right target "/") "/" (string-trim-left path "/"))) + (t (devops--join-target target path)))) + +(defun devops--target-link-resolve (link) + "Resolve LINK, the part of a target: link after the colon. +LINK is TAG or TAG:PATH, TAG being a tag in a #+TARGET keyword of the +current buffer." + (let* ((sep (string-search ":" link)) + (tag (substring link 0 sep)) + (path (if sep (substring link (1+ sep)) "")) + (target (or (devops-with-sync (devops--resolve-target-for-tag tag)) + (user-error "No #+TARGET for tag %s" tag)))) + (devops--target-link-destination target path))) + +(defun devops--target-link-follow (link _arg) + "Open LINK, a target: link, in a browser if a URL or else as a file." + (let ((dest (devops--target-link-resolve link))) + (if (devops--url-p dest) + (browse-url dest) + (find-file dest)))) + +(defun devops--target-link-complete () + "Read a target: link, a #+TARGET tag then a path under it." + (let ((tag (completing-read "Target: " (devops-target-tag-alist) nil t))) + (concat "target:" tag ":" (read-string (format "Path under %s: " tag))))) + +(org-link-set-parameters "target" + :follow #'devops--target-link-follow + :complete #'devops--target-link-complete) + (defun devops--ghostty-command (dir &optional env-vars) "Return a ghostty command line opening a shell in DIR. DIR may be remote, in which case ghostty runs ssh to its host. ENV-VARS @@ -1039,6 +1085,8 @@ block's :var arguments are exported first." "Turn `devops-mode' off, removing its advice before unloading. Return nil, so the rest of the unloading proceeds as usual." (devops-mode -1) + (setq org-link-parameters (assoc-delete-all "target" org-link-parameters)) + (org-link-make-regexps) nil) (provide 'devops) diff --git a/examples/1_commands.org b/examples/1_commands.org index bc219a3..9fcfcd5 100644 --- a/examples/1_commands.org +++ b/examples/1_commands.org @@ -57,3 +57,21 @@ When you execute this, you will get a prompt to choose which server #+begin_src sh :results output ls #+end_src + +* Linking to a target + +A =target:= link points at a path under a target, so a link survives the +target moving to a new host. =C-c C-o= opens it: a file through TRAMP, +or a browser page when the target is a URL. + +#+begin_example +#+TARGET: grafana https://grafana.example.com + +[[target:server1:/etc/nginx/nginx.conf][nginx config on server1]] +[[target:grafana:d/node-exporter][node dashboard]] +#+end_example + +[[target:server1:/etc/nginx/nginx.conf][nginx config on server1]] + +=C-c C-l target: RET= picks a tag and asks for the path. +