feat(upload): add commands for manual/temporary mappings

Close: #8529
Co-authored-by: stfl <stfl@users.noreply.github.com>

modules/tools/upload/README.org

@@ -40,7 +40,7 @@ Uses ~ssh-deploy~ to map a local folder to a remote one.
 /This module has no external requirements./
 
 * Usage
-There are two ways to map a local directory to a remote one:
+There are three ways to map a local directory to a remote one:
 
 1. With a =.dir-locals.el= file at the root of your project/directory. E.g.
    #+begin_src emacs-lisp
@@ -64,6 +64,9 @@ There are two ways to map a local directory to a remote one:
    ;; End:
    #+end_src
 
+3. Manually, on a per-buffer basis, with the ~M-x +upload/register-remote~
+   command. Use ~M-x +upload/unregister-all-remotes~ to undo all manual remotes.
+
 #+begin_quote
  󰐃 ~ssh-deploy-root-local~ is optional, and will resort to ~doom-project-root~ if
     unspecified.

modules/tools/upload/autoload.el

@@ -0,0 +1,48 @@
+;;; tools/upload/autoload.el -*- lexical-binding: t; -*-
+
+(defvar +upload--old-remote nil)
+(defvar +upload--old-local nil)
+
+;;;###autoload
+(defun +upload/register-remote (remote)
+  "Map the local buffer to a given REMOTE in the current buffer.
+
+If REMOTE is nil, removes any local mapping, or restores the old values for
+`ssh-deploy-root-local' and `ssh-deploy-root-remote' if one existed before this
+command was used."
+  (interactive
+   (list (unless current-prefix-arg
+             (expand-file-name (or (read-directory-name "Remote directory: ")
+                                   (user-error "Aborted"))))))
+  (let* ((buffer (or (buffer-base-buffer) (current-buffer)))
+         (buffer-file (or (buffer-file-name buffer)
+                          (user-error "Not in a file-visiting buffer")))
+         (local (or ssh-deploy-root-local
+                    (doom-project-root (expand-file-name buffer-file))
+                    default-directory)))
+    (if remote
+        (progn
+          (message "ssh-deploy: mapping %S to %S (in %S)"
+                   local remote (buffer-name buffer))
+          (setq-local +upload--old-local ssh-deploy-root-local
+                      +upload--old-remote ssh-deploy-root-remote
+                      ssh-deploy-root-local local
+                      ssh-deploy-root-remote remote))
+      (if (or +upload--old-local
+              +upload--old-remote)
+          (message "ssh-deploy: reverting mapping to %s -> %s (in %S)"
+                   +upload--old-local +upload--old-remote (buffer-name buffer))
+        (message  "ssh-deploy: clearing mapping (in %S)" (buffer-name buffer)))
+      (setq-local ssh-deploy-root-local +upload--old-local
+                  ssh-deploy-root-remote +upload--old-remote)
+      (mapc #'kill-local-variable '(+upload--old-local +upload--old-remote)))))
+
+;;;###autoload
+(defun +upload/unregister-all-remotes ()
+  "Undo manual local->remote mappings created with `+upload/register-remote'."
+  (interactive)
+  (dolist (buf (doom-buffer-list))
+    (when (and (buffer-live-p buf)
+               (local-variable-p '+upload--old-local buf))
+      (with-current-buffer buf
+        (+upload/register-remote nil)))))