path: root/duet.el

;;; duet.el --- Dual-pane file commander over dirvish/dired -*- lexical-binding: t -*-

;; Author: Craig Jennings <c@cjennings.net>
;; URL: https://github.com/cjennings/duet
;; Version: 0.1.0
;; Package-Requires: ((emacs "29.1"))
;; Keywords: files, tools, convenience

;; This file is not part of GNU Emacs.

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;;; Commentary:

;; DUET — "DUET Unifies Endpoint Trees" — is a two-pane orthodox file
;; manager (Midnight Commander / FileZilla style) built on dirvish/dired.
;; Two dired panes show any location, local or remote; single-key actions
;; on the file under point use the opposite pane as the implied target.
;;
;; Transfers route through a pluggable backend registry: rsync for
;; Unix-to-Unix (delta-transfer, faithful metadata, zero remote install),
;; rclone for cloud and the long protocol tail, lftp for FTP/FTPS/HTTP, and
;; unison for bidirectional sync.  TRAMP is the universal substrate.
;;
;; dirvish is recommended as the renderer but not required; DUET degrades to
;; plain dired.
;;
;; STATUS: pre-alpha skeleton.  See the design document for the full plan and
;; the staged roadmap.

;;; Code:

(require 'tramp)
(require 'cl-lib)
(require 'dired)

(defgroup duet nil
  "Dual-pane file commander over dirvish/dired."
  :group 'files
  :prefix "duet-")

;;; Path classification

(defun duet--classify-path (path)
  "Classify PATH into a plist describing its locality and components.

The returned plist has these keys:

  :locality   `local' or `remote'
  :method     TRAMP method (e.g. \"ssh\"), or nil when local
  :user       remote user, or nil
  :host       remote host (the final hop for a multi-hop path), or nil
  :port       remote port as a string, or nil
  :localname  the path on the target filesystem
  :hop        the leading-hops string for a multi-hop path, or nil

TRAMP performs the dissection, so any path `file-remote-p' recognizes is
remote and everything else is local.  A local PATH has its name expanded
\(so a leading ~ resolves to the home directory); a remote localname is kept
verbatim because a ~ there is the remote home, not this machine's.

Classification is total: a TRAMP-looking string TRAMP does not accept as a
remote name (an incomplete \"/ssh:host\") is treated as a local path rather
than signaling.  Validating raw TRAMP input is the connection reader's job."
  (if (file-remote-p path)
      (let ((v (tramp-dissect-file-name path)))
        (list :locality 'remote
              :method (tramp-file-name-method v)
              :user (tramp-file-name-user v)
              :host (tramp-file-name-host v)
              :port (tramp-file-name-port v)
              :localname (tramp-file-name-localname v)
              :hop (tramp-file-name-hop v)))
    (list :locality 'local
          :method nil
          :user nil
          :host nil
          :port nil
          :localname (expand-file-name path)
          :hop nil)))

;;; Transport-backend registry

(cl-defstruct (duet-backend (:constructor duet-backend-create) (:copier nil))
  "A transport backend: a scorer, a command builder, and contract metadata.

Slots:

  name          unique symbol; re-registering a name replaces the backend
  handles       (lambda (SRC DST) ...) -> numeric cost (lower preferred) or
                nil when the backend cannot handle the endpoint pair
  command       (lambda (SRC DST OPTS) ...) -> a process-spec plist (its
                :argv is an argument list, never a shell string)
  capabilities  plist of advertised flags: :async :resume :bidirectional
                :progress
  temp-pattern  regexp naming the backend's temp/partial files, or nil
  cleanup       cleanup semantics: `:verifiable', `:best-effort', or `:none'
  redaction     list of regexps whose matches are stripped from logs (each
                pattern's capture group 1 is the field label kept verbatim),
                or the symbol `:none' for a backend with no secret surface
  normalizer    failure-normalizer function, or nil to use the minimal one"
  name handles command capabilities temp-pattern cleanup redaction normalizer)

(defvar duet--backend-registry nil
  "List of registered `duet-backend' structs, most recently registered first.")

(defun duet-register-backend (backend)
  "Register BACKEND, replacing any existing backend of the same name.
Re-registering a name is how a user or plugin overrides a built-in.  Return
BACKEND."
  (setq duet--backend-registry
        (cons backend
              (cl-remove (duet-backend-name backend)
                         duet--backend-registry
                         :key #'duet-backend-name)))
  backend)

(defun duet-backends ()
  "Return the registered backends, most recently registered first."
  duet--backend-registry)

(defun duet-backend-by-name (name)
  "Return the registered backend named NAME, or nil."
  (cl-find name duet--backend-registry :key #'duet-backend-name))

(defun duet--select-backend (src dst)
  "Return the registered backend best suited to transfer SRC to DST.
Each backend's scorer is called with the classified endpoints SRC and DST and
returns a numeric cost (lower preferred) or nil when it cannot handle the
pair.  The lowest-cost backend wins; ties resolve to the most recently
registered one.  Return nil when no backend handles the pair."
  (let ((best nil) (best-score nil))
    (dolist (b duet--backend-registry best)
      (let ((score (funcall (duet-backend-handles b) src dst)))
        (when (and (numberp score)
                   (or (null best-score) (< score best-score)))
          (setq best b
                best-score score))))))

;;; Secret redaction

(defconst duet--redaction-marker "<redacted>"
  "Replacement text substituted for matched secrets in logs and bug reports.")

(defun duet--redact (text patterns)
  "Return TEXT with every regexp in PATTERNS redacted.
Each pattern keeps its capture group 1 (the field label) and replaces the
rest of the match with the redaction marker, so a log can show that a secret
field was present without leaking its value.  A pattern with no group 1
redacts the whole match.  TEXT is returned unchanged when PATTERNS is nil or
the symbol `:none' (a backend declaring it has no secret surface)."
  (if (or (null patterns) (eq patterns :none))
      text
    (let ((out text))
      (dolist (re patterns out)
        (setq out (replace-regexp-in-string
                   re
                   (lambda (match)
                     (save-match-data
                       (if (and (string-match re match) (match-beginning 1))
                           (concat (match-string 1 match) duet--redaction-marker)
                         duet--redaction-marker)))
                   out t t))))))

;;; Failure normalization

(defun duet--failure-evidence (context)
  "Return the evidence lines from a failure CONTEXT as a list of strings."
  (delq nil (list (plist-get context :launch-error)
                  (plist-get context :stderr))))

(defun duet-backend-minimal-failure-normalizer (context)
  "Map a generic failure CONTEXT into a normalized explanation plist.
CONTEXT is a plist with any of :launch-error, :executable-missing, :timeout,
:signal, :exit, and :stderr.  The result carries :class, :cause, :evidence,
:safety, and :next-actions.  Every backend gets this for free; a backend's
own normalizer refines the classification for failures it recognizes."
  (let ((exit (plist-get context :exit))
        (signal (plist-get context :signal))
        (evidence (duet--failure-evidence context)))
    (cond
     ((plist-get context :executable-missing)
      (list :class 'missing-executable
            :cause "The backend program was not found on PATH."
            :evidence evidence :safety "Source unchanged; nothing ran."
            :next-actions '(run-doctor)))
     ((plist-get context :launch-error)
      (list :class 'launch-failure
            :cause "DUET could not launch the backend process."
            :evidence evidence :safety "Source unchanged; nothing ran."
            :next-actions '(run-doctor)))
     ((plist-get context :timeout)
      (list :class 'stalled
            :cause "The transfer produced no output before the stall timeout."
            :evidence evidence
            :safety "Source unchanged; the destination may hold a partial."
            :next-actions '(retry cancel)))
     (signal
      (list :class 'cancelled
            :cause (format "The backend was terminated by signal %s." signal)
            :evidence evidence
            :safety "Source unchanged; the destination may hold a partial."
            :next-actions '(retry)))
     ((and (integerp exit) (/= exit 0))
      (list :class 'backend-unknown-failure
            :cause (format "The backend exited with status %d." exit)
            :evidence evidence :safety :generic
            :next-actions '(retry run-doctor)))
     (t
      (list :class 'backend-unknown-failure
            :cause "The backend failed for an unrecognized reason."
            :evidence evidence :safety :generic
            :next-actions '(run-doctor))))))

(defun duet--failure-pattern-match-p (match context)
  "Return non-nil when MATCH applies to failure CONTEXT.
MATCH is a regexp tested against the context's :stderr, or a predicate
function called with the whole context."
  (cond
   ((functionp match) (funcall match context))
   ((stringp match)
    (let ((stderr (plist-get context :stderr)))
      (and stderr (string-match-p match stderr))))
   (t nil)))

(defun duet--apply-failure-pattern (pattern context)
  "Return a normalized failure for PATTERN if it matches CONTEXT, else nil."
  (when (duet--failure-pattern-match-p (plist-get pattern :match) context)
    (list :class (plist-get pattern :class)
          :cause (plist-get pattern :cause)
          :evidence (duet--failure-evidence context)
          :safety (or (plist-get pattern :safety) :generic)
          :next-actions (plist-get pattern :next-actions))))

(defun duet-define-cli-failure-patterns (patterns)
  "Return a failure-normalizer function built from PATTERNS.
Each entry is a plist with :match (a regexp over stderr or a predicate over
the context), :class, :cause, :next-actions, and an optional :safety.  The
returned function tries each pattern in order and falls back to
`duet-backend-minimal-failure-normalizer' when none match."
  (lambda (context)
    (or (cl-some (lambda (p) (duet--apply-failure-pattern p context)) patterns)
        (duet-backend-minimal-failure-normalizer context))))

(defun duet--normalize-failure (backend context)
  "Normalize a failure CONTEXT for BACKEND into an explanation plist.
Consult BACKEND's own normalizer when it has one, otherwise the minimal
normalizer."
  (funcall (or (duet-backend-normalizer backend)
               #'duet-backend-minimal-failure-normalizer)
           context))

;;; Backend contract checks (tiered)

(defun duet--check-name (backend)
  "Return a minimum-tier name violation for BACKEND, or nil."
  (unless (and (duet-backend-name backend)
               (symbolp (duet-backend-name backend)))
    "name must be a non-nil symbol"))

(defun duet--check-handles (backend src dst)
  "Return a minimum-tier scorer violation for BACKEND on SRC/DST, or nil."
  (if (not (functionp (duet-backend-handles backend)))
      "handles must be a function"
    (let ((score (funcall (duet-backend-handles backend) src dst)))
      (unless (or (null score) (numberp score))
        "handles must return a number or nil"))))

(defun duet--command-spec-executable-p (spec)
  "Return non-nil when process SPEC has a recognized, runnable execution shape.
A SPEC is runnable when it is a non-empty plist carrying either a non-empty
:argv whose elements are all strings (a CLI backend) or an explicit non-argv
mode -- :tramp for an in-process copy, or :exec-mode for a route that Phase 6
orchestrates (a both-remote rsync).  A nil spec, a bare nil argv, or a shell
string is not runnable."
  (and (listp spec) spec
       (not (plist-get spec :shell-command))
       (or (plist-get spec :tramp)
           (plist-get spec :exec-mode)
           (let ((argv (plist-get spec :argv)))
             (and (consp argv) (cl-every #'stringp argv))))))

(defun duet--check-command (backend src dst opts)
  "Return a minimum-tier command violation for BACKEND on SRC/DST/OPTS, or nil."
  (if (not (functionp (duet-backend-command backend)))
      "command must be a function"
    (let ((spec (funcall (duet-backend-command backend) src dst opts)))
      (cond
       ((not (and (listp spec) spec))
        "command must return a non-empty process-spec plist")
       ((plist-get spec :shell-command)
        "command must not build a shell string; use :argv")
       ((not (duet--command-spec-executable-p spec))
        "command must return a runnable spec: a non-empty :argv of strings, or a declared in-process mode such as :tramp")))))

(defun duet--check-redaction (backend)
  "Return a minimum-tier redaction violation for BACKEND, or nil.
A backend declares either a non-empty list of regexps or `:none' (no secret
surface).  An unset slot (nil) is a forgotten declaration and is flagged."
  (let ((r (duet-backend-redaction backend)))
    (unless (or (eq r :none) (and (listp r) r))
      "redaction metadata must be declared (a non-empty list of regexps, or :none)")))

(defun duet--check-normalizer (backend)
  "Return a minimum-tier failure-explainer violation for BACKEND, or nil."
  (let ((n (duet--normalize-failure backend '(:exit 1 :stderr "sample"))))
    (unless (and (plist-member n :class)
                 (plist-member n :cause)
                 (plist-member n :next-actions))
      "failure normalizer must return a class/cause/next-actions plist")))

(defun duet-backend-check-minimum (backend &optional src dst opts)
  "Return a list of minimum-tier contract violations for BACKEND, or nil.
SRC, DST, and OPTS are a sample endpoint pair and options the backend should
handle; they default to a local-to-local pair.  An empty result means
BACKEND is registrable: it names itself, scores and builds an argv command
for the sample (never a shell string), declares redaction metadata, and
produces a well-formed failure explanation.  An author wraps this in an ERT
test: (should-not (duet-backend-check-minimum my-backend))."
  (let ((src (or src '(:locality local :localname "/tmp/a")))
        (dst (or dst '(:locality local :localname "/tmp/b"))))
    (delq nil (list (duet--check-name backend)
                    (duet--check-handles backend src dst)
                    (duet--check-command backend src dst opts)
                    (duet--check-redaction backend)
                    (duet--check-normalizer backend)))))

(defun duet-backend-check-publishable (backend &optional src dst opts)
  "Return minimum-tier violations for BACKEND plus publishable-tier ones.
A publishable backend additionally declares cleanup semantics and carries its
own failure normalizer, so DUET can recommend it safely."
  (append (duet-backend-check-minimum backend src dst opts)
          (delq nil
                (list (unless (duet-backend-cleanup backend)
                        "cleanup semantics must be declared (:verifiable/:best-effort/:none)")
                      (unless (duet-backend-normalizer backend)
                        "a backend-specific failure normalizer is required to publish")))))

(defun duet-backend-check-capability (backend capability &optional src dst opts)
  "Return publishable-tier violations for BACKEND plus a CAPABILITY assertion.
CAPABILITY (e.g. :resume) must be declared in the backend's `capabilities'
before DUET will trust it."
  (append (duet-backend-check-publishable backend src dst opts)
          (delq nil
                (list (unless (plist-get (duet-backend-capabilities backend) capability)
                        (format "capability %s is asserted but not declared" capability))))))

;;; Endpoint matrix and routing

(defconst duet--ssh-methods '("ssh" "sshx" "scp" "rsync")
  "TRAMP methods rsync can transport over directly.")

(defun duet--local-endpoint-p (ep)
  "Return non-nil when classified endpoint EP is local."
  (eq (plist-get ep :locality) 'local))

(defun duet--remote-endpoint-p (ep)
  "Return non-nil when classified endpoint EP is remote."
  (eq (plist-get ep :locality) 'remote))

(defun duet--ssh-endpoint-p (ep)
  "Return non-nil when classified endpoint EP is reachable over ssh."
  (and (duet--remote-endpoint-p ep)
       (member (plist-get ep :method) duet--ssh-methods)))

(defun duet--same-remote-host-p (a b)
  "Return non-nil when classified endpoints A and B name the same remote host."
  (and (duet--remote-endpoint-p a)
       (duet--remote-endpoint-p b)
       (equal (plist-get a :method) (plist-get b :method))
       (equal (plist-get a :user) (plist-get b :user))
       (equal (plist-get a :host) (plist-get b :host))
       (equal (plist-get a :port) (plist-get b :port))))

(defun duet--transfer-route (src dst opts)
  "Determine the transfer route between classified SRC and DST given OPTS.

  :local            both endpoints local
  :local-remote     exactly one endpoint remote
  :remote-same-host both on the same remote host (ssh in once, copy there)
  :remote-direct    different remote hosts, direct host-to-host (override only)
  :remote-roundtrip different remote hosts, routed through this machine

Different-host transfers default to the round-trip; direct mode is never
automatic and requires `:direct-remote-to-remote' in OPTS."
  (let ((s-local (duet--local-endpoint-p src))
        (d-local (duet--local-endpoint-p dst)))
    (cond
     ((and s-local d-local) :local)
     ((or s-local d-local) :local-remote)
     ((duet--same-remote-host-p src dst) :remote-same-host)
     ((plist-get opts :direct-remote-to-remote) :remote-direct)
     (t :remote-roundtrip))))

;;; Built-in backends: rsync (native) and TRAMP (fallback)

(defun duet--rsync-handles (src dst)
  "Score rsync for classified SRC and DST.
rsync handles local and ssh-reachable endpoints.  A local pair or a
local/ssh pair scores 10; an ssh-to-ssh pair scores 20 (it needs routing).
Anything not ssh-reachable scores nil so a fallback backend takes it."
  (let ((s-ok (or (duet--local-endpoint-p src) (duet--ssh-endpoint-p src)))
        (d-ok (or (duet--local-endpoint-p dst) (duet--ssh-endpoint-p dst))))
    (when (and s-ok d-ok)
      (if (and (duet--remote-endpoint-p src) (duet--remote-endpoint-p dst))
          20
        10))))

(defun duet--rsync-endpoint-arg (ep)
  "Return the rsync path argument for classified endpoint EP.
A local endpoint uses its localname; a remote one uses rsync's native
\[user@]host:path form (the port travels in the ssh transport flag)."
  (if (duet--local-endpoint-p ep)
      (plist-get ep :localname)
    (concat (when (plist-get ep :user) (concat (plist-get ep :user) "@"))
            (plist-get ep :host) ":" (plist-get ep :localname))))

(defun duet--rsync-ssh-transport (src dst)
  "Return rsync's -e ssh transport flags for SRC/DST, honoring a port."
  (let ((port (or (plist-get src :port) (plist-get dst :port))))
    (list "-e" (if port (format "ssh -p %s" port) "ssh"))))

(defun duet--rsync-local-command (src dst sources)
  "Build a single-invocation rsync spec where at most one endpoint is remote.
SOURCES are the source paths; SRC and DST are the classified representative
endpoints.  A remote endpoint adds an ssh transport.  File names reach rsync
as argv elements, never interpolated into a shell string."
  (let ((remote (or (duet--ssh-endpoint-p src) (duet--ssh-endpoint-p dst)))
        (src-args (mapcar (lambda (p)
                            (duet--rsync-endpoint-arg (duet--classify-path p)))
                          sources)))
    (list :argv (append '("rsync" "-a" "--partial" "--info=progress2")
                        (when remote (duet--rsync-ssh-transport src dst))
                        src-args
                        (list (duet--rsync-endpoint-arg dst)))
          :default-directory "/")))

(defun duet--rsync-command (src dst opts)
  "Build an rsync process spec for SRC to DST with OPTS.
rsync moves data in one invocation only when at most one endpoint is remote
\(routes :local and :local-remote).  It refuses a source and destination that
are both remote, so a both-remote pair yields a deferred spec carrying the
route and an :exec-mode marker; Phase 6 runs rsync on a host or routes through
the local machine per the route.  OPTS carries :sources and :route."
  (if (and (duet--remote-endpoint-p src) (duet--remote-endpoint-p dst))
      (list :argv nil
            :exec-mode 'rsync-remote-to-remote
            :route (plist-get opts :route))
    (duet--rsync-local-command src dst (plist-get opts :sources))))

(defun duet--tramp-handles (_src _dst)
  "Score TRAMP: the universal fallback, costlier than a native transport."
  100)

(defun duet--tramp-command (_src _dst opts)
  "Build the in-process TRAMP transfer spec from OPTS.
TRAMP copies in process rather than spawning a CLI, so there is no argv; the
:tramp marker tells the executor to use the in-process path."
  (list :argv nil
        :tramp t
        :sources (plist-get opts :sources)
        :destination (plist-get opts :destination)))

(defconst duet--rsync-failure-patterns
  '((:match "[Pp]ermission denied" :class permission-denied
     :cause "The destination rejected the write (permission denied)."
     :next-actions (fix-permissions) :safety "Source unchanged.")
    (:match "No space left on device" :class destination-full
     :cause "The destination filesystem is full."
     :next-actions (free-space retry)
     :safety "Source unchanged; the destination may hold a partial.")
    (:match "\\(protocol version mismatch\\|unexpected tag\\|is your shell clean\\)"
     :class rsync-protocol-mismatch
     :cause "The remote shell printed text that corrupted rsync's protocol stream."
     :next-actions (run-doctor) :safety "Source unchanged."))
  "Known rsync stderr signatures mapped to DUET failure classes.")

(defun duet--register-builtin-backends ()
  "Register the stage-1 built-in backends: rsync, with TRAMP as the fallback.
Idempotent: re-registering replaces the prior definitions."
  (duet-register-backend
   (duet-backend-create
    :name 'tramp
    :handles #'duet--tramp-handles
    :command #'duet--tramp-command
    :capabilities '()
    :redaction '("\\(://[^:@/]+:\\)[^@]+@")
    :cleanup :none))
  (duet-register-backend
   (duet-backend-create
    :name 'rsync
    :handles #'duet--rsync-handles
    :command #'duet--rsync-command
    :capabilities '(:async t :resume t :progress t)
    :redaction :none
    :temp-pattern "\\`\\..*\\.[A-Za-z0-9]\\{6\\}\\'"
    :cleanup :verifiable
    :normalizer (duet-define-cli-failure-patterns duet--rsync-failure-patterns))))

(duet--register-builtin-backends)

;;; Transfer-spec assembly

(defun duet--transfer-spec (sources destination-directory &optional opts)
  "Build a transfer-spec plist to copy SOURCES into DESTINATION-DIRECTORY.
SOURCES is a list of source paths; the first is representative for backend
selection and routing.  Classify both endpoints, select the lowest-cost
backend, determine the route, and delegate argv construction to that
backend's command builder.  Return nil when no backend handles the pair."
  (let* ((src (duet--classify-path (car sources)))
         (dst (duet--classify-path destination-directory))
         (backend (duet--select-backend src dst)))
    (when backend
      (let* ((route (duet--transfer-route src dst opts))
             (bopts (append (list :sources sources
                                  :destination destination-directory
                                  :route route)
                            opts))
             (cmd (funcall (duet-backend-command backend) src dst bopts)))
        (list :sources sources
              :destination-directory destination-directory
              :destination-name (plist-get opts :destination-name)
              :backend (duet-backend-name backend)
              :route route
              :src-endpoint src
              :dst-endpoint dst
              :argv (plist-get cmd :argv)
              :tramp (plist-get cmd :tramp)
              :exec-mode (plist-get cmd :exec-mode)
              :default-directory (plist-get cmd :default-directory)
              :process-environment (plist-get cmd :process-environment)
              :async (if (plist-member opts :async) (plist-get opts :async) t))))))

;;; Conflict and move planning (pure, prompt-free)

(defun duet--unique-name (dest existing-p)
  "Return a free basename near DEST, probing candidates with EXISTING-P.
Append \" (N)\" before the extension, incrementing N until EXISTING-P reports
the candidate path free.  Return the basename only."
  (let* ((dir (file-name-directory dest))
         (base (file-name-base dest))
         (ext (file-name-extension dest t))
         (n 1)
         (candidate (concat dir base " (" (number-to-string n) ")" ext)))
    (while (funcall existing-p candidate)
      (setq n (1+ n)
            candidate (concat dir base " (" (number-to-string n) ")" ext)))
    (file-name-nondirectory candidate)))

(defun duet--conflict-entry (src dst action existing-p)
  "Return a conflict-plan entry for SRC/DST resolved with ACTION.
A `rename' action gets a computed free :new-name via EXISTING-P."
  (if (eq action 'rename)
      (list :source src :dest dst :action 'rename
            :new-name (duet--unique-name dst existing-p))
    (list :source src :dest dst :action action)))

(defun duet--plan-conflicts (items existing-p resolver)
  "Return a per-item action plan for ITEMS, prompt-free.
ITEMS is a list of (SOURCE . DEST).  EXISTING-P, called on a DEST, reports
whether it already exists.  RESOLVER, called on a colliding (SOURCE . DEST),
returns an action (`overwrite', `skip', or `rename') or a cons (ACTION . all)
to apply ACTION to every remaining collision without being called again.
Non-colliding items plan a plain `copy'.  Each entry is a plist
\(:source :dest :action [:new-name]); no file is touched."
  (let ((sticky nil) (plan nil))
    (dolist (item items (nreverse plan))
      (let ((src (car item)) (dst (cdr item)))
        (if (not (funcall existing-p dst))
            (push (list :source src :dest dst :action 'copy) plan)
          (let ((action (or sticky (funcall resolver item))))
            (when (and (consp action) (eq (cdr action) 'all))
              (setq sticky (car action)
                    action (car action)))
            (push (duet--conflict-entry src dst action existing-p) plan)))))))

(defun duet--plan-move (sources)
  "Return a move plan for SOURCES, prompt-free.
Each source yields a copy step followed by a delete step gated on that
source's copy success, so a source is never deleted before its copy is
confirmed.  Return a flat list of step plists in execution order."
  (apply #'append
         (mapcar (lambda (s)
                   (list (list :op 'copy :source s)
                         (list :op 'delete :source s :gate 'copy-success)))
                 sources)))

;;; Data-safety planning (pure, prompt-free)

;; The category's recurring data-loss traps are decided here, before any byte
;; moves.  Every check is pure: filesystem facts (a path's lstat type, the
;; names already at a destination, whether the destination filesystem folds
;; case, its path-length limit, its reserved names) are injected, so the
;; planner is testable without touching a file.  Each problem is a plist
;; (:class :severity :file :message); `error' severity blocks, `warning'
;; surfaces a decision (follow-vs-preserve a symlink).

(defun duet--norm (path)
  "Lexically normalize PATH: expand it and strip a trailing slash."
  (directory-file-name (expand-file-name path)))

(defun duet--trailing-slash-p (path)
  "Return non-nil when PATH ends with a slash."
  (and (> (length path) 0)
       (eq (aref path (1- (length path))) ?/)))

(defun duet--check-same-file (source destination)
  "Flag a transfer whose SOURCE and DESTINATION are the same file."
  (when (string= (duet--norm source) (duet--norm destination))
    (list :class 'same-file :severity 'error :file source
          :message "Source and destination are the same file.")))

(defun duet--check-dir-into-itself (source destination)
  "Flag a transfer whose DESTINATION is inside the SOURCE directory."
  (let ((s (file-name-as-directory (duet--norm source)))
        (d (file-name-as-directory (duet--norm destination))))
    (when (and (not (string= s d))
               (string-prefix-p s d))
      (list :class 'destination-within-source :severity 'error :file destination
            :message "The destination is inside the source directory."))))

(defun duet--resolved-destination (source destination-directory)
  "Return the path SOURCE lands at when copied into DESTINATION-DIRECTORY.
A SOURCE with a trailing slash copies its contents, landing in the
destination directory itself; without one, SOURCE lands as a named child.
Making the resolved path explicit defuses the trailing-slash \"into vs
contents\" footgun."
  (let ((dest (file-name-as-directory (expand-file-name destination-directory))))
    (if (duet--trailing-slash-p source)
        (directory-file-name dest)
      (concat dest (file-name-nondirectory (duet--norm source))))))

(defun duet--check-special-file (path type)
  "Flag PATH when its lstat TYPE is a device/fifo/socket DUET will not transfer.
TYPE is a symbol from an lstat-based classifier: `file', `directory',
`symlink', or a special type; nil means the type is unknown.  Regular files,
directories, symlinks, and unknown types are allowed."
  (unless (memq type '(file directory symlink nil))
    (list :class 'unsupported-special-file :severity 'error :file path
          :message (format "%s is a special file (%s) DUET will not transfer."
                           path type))))

(defun duet--check-symlink (path type)
  "Surface PATH as a warning when its lstat TYPE is a symlink.
A symlink is transferable, but follow-versus-preserve is a decision the user
must make, so it is surfaced rather than silently chosen."
  (when (eq type 'symlink)
    (list :class 'symlink :severity 'warning :file path
          :message "Source is a symlink; choose follow or preserve before transfer.")))

(defun duet--check-case-collision (destination existing-names case-insensitive)
  "Flag a case-only collision at DESTINATION on a case-insensitive filesystem.
EXISTING-NAMES are the basenames already at the destination directory, and
CASE-INSENSITIVE says whether that filesystem folds case.  An exact match is
an ordinary conflict, not a case collision, so it is not flagged here."
  (when case-insensitive
    (let ((base (file-name-nondirectory (duet--norm destination))))
      (when (cl-some (lambda (n)
                       (and (not (string= n base))
                            (string-equal-ignore-case n base)))
                     existing-names)
        (list :class 'case-collision :severity 'error :file destination
              :message (format "%s collides with an existing name by case only."
                               base))))))

(defun duet--check-path-length (destination max-length)
  "Flag DESTINATION when it is longer than MAX-LENGTH.
MAX-LENGTH is the destination filesystem's limit, or nil when unknown."
  (when (and max-length (> (length destination) max-length))
    (list :class 'path-too-long :severity 'error :file destination
          :message (format "Destination path is %d chars; the limit is %d."
                           (length destination) max-length))))

(defun duet--check-reserved-name (destination reserved-p)
  "Flag DESTINATION when its basename is reserved on the target filesystem.
RESERVED-P is a predicate called with the basename, or nil when the
destination has no reserved names."
  (let ((base (file-name-nondirectory (duet--norm destination))))
    (when (and reserved-p (funcall reserved-p base))
      (list :class 'reserved-name :severity 'error :file destination
            :message (format "%s is a reserved name on the destination." base)))))

(defun duet--plan-safety (source destination &optional caps)
  "Return the data-safety problems for moving SOURCE to DESTINATION.
Pure: every filesystem fact comes from CAPS, so no file is touched.  CAPS
keys: :file-type (fn PATH -> lstat type symbol), :existing-names (fn DEST ->
basenames), :case-insensitive (fn DEST -> bool), :max-path-length (int), and
:reserved-name (fn BASENAME -> bool).  Each problem is a plist
\(:class :severity :file :message)."
  (let ((type (let ((f (plist-get caps :file-type))) (and f (funcall f source))))
        (existing (let ((f (plist-get caps :existing-names))) (and f (funcall f destination))))
        (ci (let ((f (plist-get caps :case-insensitive))) (and f (funcall f destination)))))
    (delq nil
          (list (duet--check-same-file source destination)
                (duet--check-dir-into-itself source destination)
                (duet--check-special-file source type)
                (duet--check-symlink source type)
                (duet--check-case-collision destination existing ci)
                (duet--check-path-length destination (plist-get caps :max-path-length))
                (duet--check-reserved-name destination (plist-get caps :reserved-name))))))

(defun duet--plan-move-safe (sources destination-directory &optional caps)
  "Return a move plan for SOURCES into DESTINATION-DIRECTORY with safety gating.
Each source is resolved to its destination and run through `duet--plan-safety'
with CAPS.  A source carrying a blocking (`error' severity) problem is skipped
\(no copy, no delete) as an :op skip recording its :problems; a safe source
gets a copy followed by a delete gated on copy success.  No delete is ever
ungated."
  (apply #'append
         (mapcar
          (lambda (s)
            (let* ((dest (duet--resolved-destination s destination-directory))
                   (problems (duet--plan-safety s dest caps))
                   (errors (cl-remove-if-not
                            (lambda (p) (eq 'error (plist-get p :severity)))
                            problems)))
              (if errors
                  (list (list :op 'skip :source s :destination dest :problems problems))
                (list (list :op 'copy :source s :destination dest :problems problems)
                      (list :op 'delete :source s :gate 'copy-success)))))
          sources)))

;;; Commander mode, pane layout, and entry

(defcustom duet-default-left-directory nil
  "Directory shown in DUET's left pane at launch.
nil means the current directory when `duet' is invoked."
  :type '(choice (const :tag "Current directory" nil) directory)
  :group 'duet)

(defcustom duet-default-right-directory nil
  "Directory shown in DUET's right pane at launch.
nil means the current directory when `duet' is invoked."
  :type '(choice (const :tag "Current directory" nil) directory)
  :group 'duet)

(defvar duet--saved-window-configuration nil
  "Window configuration saved when DUET launched, restored by `duet-quit'.")

;; The transfer/file actions land with their owning phases; until then they
;; announce themselves so the key is bound and its precedence is testable.

(defun duet-view ()
  "View the file under point.  Arrives with the viewer phase."
  (interactive)
  (user-error "DUET: view is not implemented yet"))

(defun duet-edit ()
  "Edit the file under point.  Arrives with the viewer phase."
  (interactive)
  (user-error "DUET: edit is not implemented yet"))

;; duet-copy, duet-move, duet-mkdir, and duet-delete are defined with the
;; transfer execution engine below, since they drive it.

(defun duet-quit ()
  "Close the DUET commander, restoring the window layout from before launch."
  (interactive)
  (if duet--saved-window-configuration
      (progn
        (set-window-configuration duet--saved-window-configuration)
        (setq duet--saved-window-configuration nil))
    (message "DUET: no saved layout to restore")))

(defvar duet-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "<f3>") #'duet-view)
    (define-key map (kbd "<f4>") #'duet-edit)
    (define-key map (kbd "<f5>") #'duet-copy)
    (define-key map (kbd "<f6>") #'duet-move)
    (define-key map (kbd "<f7>") #'duet-mkdir)
    (define-key map (kbd "<f8>") #'duet-delete)
    (define-key map (kbd "<f10>") #'duet-quit)
    (define-key map (kbd "q") #'duet-quit)
    map)
  "Keymap active in DUET commander panes.
mc/Norton F-keys, taking precedence inside a pane only.  q also quits the
commander (tearing down both panes), since dired's own q only quits its one
window.  dired's data chords (C, R, D, v, +) keep working as free aliases.")

(define-minor-mode duet-mode
  "Buffer-local minor mode marking a buffer as a DUET commander pane.
Carries `duet-mode-map', so the single-key F-key actions fire only inside a
commander pane and leave the global F-keys untouched elsewhere."
  :lighter " Duet"
  :keymap duet-mode-map)

(defun duet--sibling-pane (window panes)
  "Return the commander pane in PANES that is not WINDOW.
PANES is the list of commander windows.  Signal a `user-error' unless there
are exactly two panes and WINDOW is one of them.  This is the explicit
other-pane resolution that replaces `dired-dwim-target' (the dirvish#36 fix)."
  (cond
   ((/= (length panes) 2)
    (user-error "DUET needs exactly two commander panes (found %d)"
                (length panes)))
   ((not (memq window panes))
    (user-error "Point is not in a DUET commander pane"))
   (t (car (delq window (copy-sequence panes))))))

(defun duet--commander-windows ()
  "Return the live windows whose buffer has `duet-mode' enabled."
  (cl-remove-if-not (lambda (w) (buffer-local-value 'duet-mode (window-buffer w)))
                    (window-list)))

(defun duet--other-pane (&optional window)
  "Return the sibling commander pane window to WINDOW (default selected)."
  (duet--sibling-pane (or window (selected-window)) (duet--commander-windows)))

(defun duet--pane-directory (window)
  "Return the directory shown in commander pane WINDOW."
  (with-current-buffer (window-buffer window) default-directory))

(defun duet--open-pane (directory)
  "Open DIRECTORY in the selected window as a DUET commander pane.
The pane is a dired buffer with `duet-mode' enabled; when the user has dirvish
rendering dired buffers, it renders as dirvish with no extra work, which is why
dirvish is recommended but never required."
  (let ((buffer (dired-noselect (expand-file-name directory))))
    (set-window-buffer (selected-window) buffer)
    (with-current-buffer buffer (duet-mode 1))
    buffer))

;;;###autoload
(defun duet (&optional left right)
  "Launch the DUET dual-pane file commander.
Lay out two side-by-side commander panes: LEFT (or
`duet-default-left-directory', else the current directory) on the left and
RIGHT (or `duet-default-right-directory', else the current directory) on the
right.  Each pane is a dired buffer with `duet-mode' enabled.  `duet-quit'
\(F10) restores the window layout from before launch."
  (interactive)
  (setq duet--saved-window-configuration (current-window-configuration))
  (let ((left-dir (or left duet-default-left-directory default-directory))
        (right-dir (or right duet-default-right-directory default-directory)))
    (delete-other-windows)
    (duet--open-pane left-dir)
    (with-selected-window (split-window-right)
      (duet--open-pane right-dir))))

;;; Transfer execution engine, serial queue, and log

;; A transfer is built from a transfer-spec, enqueued, and run as an async
;; subprocess.  The queue runs `duet-max-concurrent-transfers' at a time; the
;; rest wait.  The process filter is the hot path, so it only counts and bounds
;; output and schedules a coalesced log render — it never refreshes panes or
;; draws directly.  Pane refresh happens once per batch, after the sentinel.
;; The state machine: queued -> running (-> stalled <-> running) -> done |
;; failed | cleanup-unverified, with cancelling as the transient kill state.

(defcustom duet-max-concurrent-transfers 1
  "Maximum number of transfers DUET runs at once.
Transfers submitted past this limit wait in the queue until a slot frees.  The
default of 1 keeps disk and network contention predictable; raise it when
independent transfers target unrelated devices."
  :type 'integer
  :group 'duet)

(defcustom duet-transfer-stderr-limit 65536
  "Trailing bytes of a transfer's output DUET retains for failure evidence.
A long transfer's progress output is bounded to this many trailing bytes so it
cannot grow memory without limit; the total byte count is tracked separately."
  :type 'integer
  :group 'duet)

(defcustom duet-log-render-interval 0.2
  "Seconds DUET coalesces transfer output before redrawing the log.
Output arrives in many small chunks; rendering is deferred to one timer per
interval so a high-volume transfer never drives the display from its filter."
  :type 'number
  :group 'duet)

(defcustom duet-transfer-stall-timeout 60
  "Seconds without output after which a running transfer is flagged stalled.
Flagging is advisory: the transfer keeps running and clears the flag on its
next chunk of output.  nil disables stall detection."
  :type '(choice (const :tag "Disabled" nil) integer)
  :group 'duet)

(cl-defstruct (duet-transfer (:constructor duet-transfer-create) (:copier nil))
  "One transfer's identity, live process, and terminal result.

Slots:

  id                    stable monotonic identifier
  spec                  the originating transfer-spec plist
  backend               backend name (symbol)
  route                 the endpoint route (e.g. `:local')
  status                queued/running/stalled/cancelling/done/failed/
                        cleanup-unverified
  process               the live process object, or nil
  exit                  integer exit status, or nil
  signal                terminating signal number, or nil
  failure               normalized failure plist, or nil on success
  stderr                bounded trailing output retained as evidence
  stderr-bytes          total output byte count seen
  output-count          number of output chunks received
  move-p                non-nil when this transfer is the copy half of a move
  destination-directory directory the transfer writes into
  source-directories    parent directories of the sources, for refresh
  cleanup-verified      non-nil when no stray temp files remain after a stop
  stall-timer           the per-transfer stall timer, or nil"
  id spec backend route status process
  exit signal failure
  (stderr "") (stderr-bytes 0) (output-count 0)
  move-p destination-directory source-directories
  cleanup-verified stall-timer)

(defconst duet--active-statuses '(running stalled cancelling)
  "Statuses at which a transfer still occupies a concurrency slot.")

(defconst duet--terminal-statuses '(done failed cleanup-unverified)
  "Statuses at which a transfer is finished and off the queue.")

(defvar duet--transfer-id-counter 0
  "Monotonic source of stable transfer ids.")

(defvar duet--transfers nil
  "All transfers created this session, most recent first.")

(defvar duet--transfer-queue nil
  "Non-terminal transfers, in submission order.")

(defun duet--next-transfer-id ()
  "Return the next stable transfer id."
  (cl-incf duet--transfer-id-counter))

(defun duet--source-directories (sources)
  "Return the unique, normalized parent directories of SOURCES."
  (delete-dups
   (mapcar (lambda (s)
             (file-name-as-directory
              (expand-file-name (or (file-name-directory s) "."))))
           sources)))

(defun duet--make-transfer (spec &optional move-p)
  "Create a queued `duet-transfer' from transfer-spec SPEC.
Non-nil MOVE-P marks the transfer as the copy half of a move."
  (duet-transfer-create
   :id (duet--next-transfer-id)
   :spec spec
   :backend (plist-get spec :backend)
   :route (plist-get spec :route)
   :status 'queued
   :move-p move-p
   :destination-directory (plist-get spec :destination-directory)
   :source-directories (duet--source-directories (plist-get spec :sources))))

;;; Queue and concurrency

(defun duet--running-transfers ()
  "Return the queued transfers that currently occupy a concurrency slot."
  (cl-remove-if-not
   (lambda (tr) (memq (duet-transfer-status tr) duet--active-statuses))
   duet--transfer-queue))

(defun duet--enqueue-transfer (tr)
  "Record TR in the history and append it to the run queue.  Return TR."
  (push tr duet--transfers)
  (setq duet--transfer-queue (append duet--transfer-queue (list tr)))
  tr)

(defun duet--pump-queue ()
  "Start queued transfers until the concurrency limit is reached."
  (let ((next nil))
    (while (and (< (length (duet--running-transfers))
                   duet-max-concurrent-transfers)
                (setq next (cl-find 'queued duet--transfer-queue
                                    :key #'duet-transfer-status)))
      (duet--start-transfer next))))

(defun duet--run-transfer (spec &optional move-p)
  "Enqueue transfer-SPEC, pump the queue, and return the `duet-transfer'.
SPEC must carry a runnable :argv.  An in-process (:tramp) or both-remote
\(:exec-mode) spec is not executed in this phase and signals a `user-error';
those routes land with Phase 6.  MOVE-P marks the transfer as a move so its
sources are deleted once the copy succeeds."
  (unless (and (consp (plist-get spec :argv))
               (cl-every #'stringp (plist-get spec :argv)))
    (user-error "DUET: this transfer route is not executable yet (no local argv)"))
  (let ((tr (duet--make-transfer spec move-p)))
    (duet--enqueue-transfer tr)
    (duet--pump-queue)
    tr))

;;; Launch and the process boundary

(defvar duet--transfer-launcher #'duet--launch-process
  "Function called with a `duet-transfer' to spawn its process and return it.
The process-boundary tests stub this so no real subprocess runs.")

(defun duet--launch-process (tr)
  "Spawn TR's backend process with a bounded filter and a sentinel."
  (let* ((spec (duet-transfer-spec tr))
         (default-directory (or (plist-get spec :default-directory) "/"))
         (proc (make-process
                :name (format "duet-transfer-%d" (duet-transfer-id tr))
                :command (plist-get spec :argv)
                :connection-type 'pipe
                :noquery t
                :filter (lambda (_p chunk) (duet--transfer-filter tr chunk))
                :sentinel (lambda (p _e) (duet--transfer-sentinel tr p)))))
    (setf (duet-transfer-process tr) proc)
    proc))

(defun duet--start-transfer (tr)
  "Move TR to `running' and launch it; a launch error fails it cleanly."
  (setf (duet-transfer-status tr) 'running)
  (condition-case err
      (progn (funcall duet--transfer-launcher tr)
             (duet--arm-stall-timer tr))
    (error
     (duet--transfer-handle-result
      tr (list :launch-error (error-message-string err))))))

;;; Bounded output filter and stall flagging

(defun duet--transfer-accumulate-stderr (tr chunk)
  "Append CHUNK to TR's retained output, bounded to `duet-transfer-stderr-limit'."
  (let* ((combined (concat (duet-transfer-stderr tr) chunk))
         (limit duet-transfer-stderr-limit)
         (kept (if (> (length combined) limit)
                   (substring combined (- (length combined) limit))
                 combined)))
    (setf (duet-transfer-stderr tr) kept
          (duet-transfer-stderr-bytes tr)
          (+ (duet-transfer-stderr-bytes tr) (length chunk)))))

(defun duet--transfer-filter (tr chunk)
  "Record output CHUNK for TR: count it, bound it, recover, redraw.
Runs from the process filter, so it does no pane refresh and no direct
rendering — it only schedules a coalesced log render."
  (cl-incf (duet-transfer-output-count tr))
  (duet--transfer-accumulate-stderr tr chunk)
  (when (eq (duet-transfer-status tr) 'stalled)
    (setf (duet-transfer-status tr) 'running))
  (duet--rearm-stall-timer tr)
  (duet--schedule-log-render))

(defun duet--arm-stall-timer (tr)
  "Arm TR's stall timer when stall detection is enabled."
  (when duet-transfer-stall-timeout
    (setf (duet-transfer-stall-timer tr)
          (run-with-timer duet-transfer-stall-timeout nil
                          #'duet--mark-stalled tr))))

(defun duet--cancel-stall-timer (tr)
  "Cancel and clear TR's stall timer."
  (when (timerp (duet-transfer-stall-timer tr))
    (cancel-timer (duet-transfer-stall-timer tr)))
  (setf (duet-transfer-stall-timer tr) nil))

(defun duet--rearm-stall-timer (tr)
  "Reset TR's stall timer after fresh output."
  (duet--cancel-stall-timer tr)
  (duet--arm-stall-timer tr))

(defun duet--mark-stalled (tr)
  "Flag a still-running TR as stalled after a silent stretch."
  (when (eq (duet-transfer-status tr) 'running)
    (setf (duet-transfer-status tr) 'stalled)
    (duet--schedule-log-render)))

;;; Throttled log render

(defvar duet--log-render-timer nil
  "Pending coalesced log-render timer, or nil.")

(defconst duet--transfer-log-buffer "*DUET Transfers*"
  "Name of the buffer holding the transfer log.")

(defun duet--schedule-log-render ()
  "Schedule a single coalesced redraw of the transfer log."
  (unless duet--log-render-timer
    (setq duet--log-render-timer
          (run-with-timer duet-log-render-interval nil
                          #'duet--render-transfer-log))))

(defun duet--render-transfer-log ()
  "Clear the pending render timer and draw the transfer log once."
  (when (timerp duet--log-render-timer)
    (cancel-timer duet--log-render-timer))
  (setq duet--log-render-timer nil)
  (duet--draw-transfer-log))

(defun duet--draw-transfer-log ()
  "Write every transfer's log record into the transfer-log buffer."
  (with-current-buffer (get-buffer-create duet--transfer-log-buffer)
    (let ((inhibit-read-only t))
      (erase-buffer)
      (dolist (tr (reverse duet--transfers))
        (insert (duet--format-log-line (duet--transfer-log-record tr)) "\n")))))

(defun duet--format-log-line (record)
  "Format one transfer-log RECORD as a single display line."
  (format "[%s] #%d %s %s %s"
          (plist-get record :status)
          (plist-get record :id)
          (plist-get record :backend)
          (or (plist-get record :route) "")
          (plist-get record :argv)))

;;; Log-record schema

(defun duet--redact-argv (tr)
  "Return TR's argv as a single string with the backend's secrets redacted."
  (let* ((argv (plist-get (duet-transfer-spec tr) :argv))
         (joined (mapconcat #'identity argv " "))
         (backend (duet-backend-by-name (duet-transfer-backend tr)))
         (patterns (and backend (duet-backend-redaction backend))))
    (duet--redact joined patterns)))

(defun duet--transfer-log-record (tr)
  "Return TR's log record: a plist of its id, route, redacted argv, and result."
  (list :id (duet-transfer-id tr)
        :backend (duet-transfer-backend tr)
        :route (duet-transfer-route tr)
        :argv (duet--redact-argv tr)
        :exit (duet-transfer-exit tr)
        :signal (duet-transfer-signal tr)
        :class (plist-get (duet-transfer-failure tr) :class)
        :evidence (plist-get (duet-transfer-failure tr) :evidence)
        :status (duet-transfer-status tr)))

;;; Stray temp-file detection (cleanup verification)

(defvar duet--temp-file-lister #'duet--list-stray-temp-files
  "Function called with a `duet-transfer' returning stray temp-file paths.
The cancellation/cleanup tests inject a stub.")

(defun duet--list-stray-temp-files (tr)
  "Return TR backend's leftover temp files in the destination directory."
  (let* ((backend (duet-backend-by-name (duet-transfer-backend tr)))
         (pattern (and backend (duet-backend-temp-pattern backend)))
         (dir (duet-transfer-destination-directory tr)))
    (when (and pattern dir (file-directory-p dir))
      (directory-files dir t pattern t))))

;;; Sentinel and terminal-result handling

(defun duet--process-result (proc)
  "Return a result plist for finished process PROC: (:signal N) or (:exit N)."
  (let ((status (process-status proc))
        (code (process-exit-status proc)))
    (if (eq status 'signal) (list :signal code) (list :exit code))))

(defun duet--transfer-sentinel (tr proc)
  "Resolve TR's result when its process PROC has exited or been signalled."
  (when (memq (process-status proc) '(exit signal))
    (duet--transfer-handle-result tr (duet--process-result proc))))

(defun duet--result-failure-context (tr result)
  "Return a failure context plist for RESULT, or nil for a clean exit.
TR supplies the retained output as evidence."
  (cond
   ((plist-get result :launch-error)
    (list :launch-error (plist-get result :launch-error)))
   ((plist-get result :signal)
    (list :signal (plist-get result :signal) :stderr (duet-transfer-stderr tr)))
   ((and (integerp (plist-get result :exit)) (zerop (plist-get result :exit)))
    nil)
   (t (list :exit (plist-get result :exit) :stderr (duet-transfer-stderr tr)))))

(defun duet--transfer-handle-result (tr result)
  "Resolve TR's terminal state from process RESULT and advance the queue."
  (duet--cancel-stall-timer tr)
  (setf (duet-transfer-exit tr) (plist-get result :exit)
        (duet-transfer-signal tr) (plist-get result :signal))
  (let ((context (duet--result-failure-context tr result)))
    (if (null context)
        (duet--finish-transfer tr 'done)
      (let ((backend (duet-backend-by-name (duet-transfer-backend tr))))
        (setf (duet-transfer-failure tr)
              (and backend (duet--normalize-failure backend context)))
        (duet--finish-transfer tr 'failed)))))

(defun duet--needs-cleanup-check-p (tr proposed)
  "Return non-nil when TR's non-success stop (PROPOSED) needs a temp-file check."
  (and (not (eq proposed 'done))
       (let ((b (duet-backend-by-name (duet-transfer-backend tr))))
         (and b
              (eq (duet-backend-cleanup b) :verifiable)
              (duet-backend-temp-pattern b)))))

(defun duet--resolve-terminal-status (tr proposed)
  "Return TR's terminal status, refining a stopped transfer that left temps.
A success keeps PROPOSED; a non-success with stray temp files becomes
`cleanup-unverified'.  Records `cleanup-verified' either way."
  (if (not (duet--needs-cleanup-check-p tr proposed))
      (progn (setf (duet-transfer-cleanup-verified tr) t) proposed)
    (let ((strays (funcall duet--temp-file-lister tr)))
      (setf (duet-transfer-cleanup-verified tr) (null strays))
      (if strays 'cleanup-unverified proposed))))

(defun duet--finish-transfer (tr proposed)
  "Commit TR to its terminal status, finalize a move, refresh, and pump.
PROPOSED is `done' or `failed'; cleanup verification can refine it."
  (let ((status (duet--resolve-terminal-status tr proposed)))
    (setf (duet-transfer-status tr) status)
    (setq duet--transfer-queue (delq tr duet--transfer-queue))
    (when (eq status 'done)
      (when (duet-transfer-move-p tr) (duet--finalize-move tr))
      (duet--schedule-completion-refresh tr))
    (duet--schedule-log-render)
    (duet--pump-queue)
    status))

;;; Move finalization (delete sources only after the copy succeeds)

(defun duet--delete-source (path)
  "Delete PATH (file or directory) outright; missing is a no-op."
  (cond ((not (file-exists-p path)) nil)
        ((file-directory-p path) (delete-directory path t))
        (t (delete-file path))))

(defun duet--finalize-move (tr)
  "Delete TR's sources now that its copy has succeeded (success is the gate)."
  (dolist (s (plist-get (duet-transfer-spec tr) :sources))
    (duet--delete-source s)))

;;; Coalesced pane refresh

(defvar duet--refresh-pending nil
  "Set of directories awaiting a coalesced refresh.")

(defvar duet--refresh-timer nil
  "Pending coalesced pane-refresh timer, or nil.")

(defun duet--schedule-pane-refresh (dir)
  "Queue DIR for a single coalesced pane refresh."
  (cl-pushnew (file-name-as-directory (expand-file-name dir))
              duet--refresh-pending :test #'equal)
  (unless duet--refresh-timer
    (setq duet--refresh-timer
          (run-with-timer 0 nil #'duet--do-pane-refresh))))

(defun duet--do-pane-refresh ()
  "Refresh every pending directory exactly once, then clear the set."
  (when (timerp duet--refresh-timer) (cancel-timer duet--refresh-timer))
  (setq duet--refresh-timer nil)
  (let ((dirs duet--refresh-pending))
    (setq duet--refresh-pending nil)
    (dolist (d dirs) (duet--refresh-dir d))))

(defun duet--refresh-dir (dir)
  "Revert any Dired buffer visiting DIR."
  (dolist (buf (dired-buffers-for-dir (expand-file-name dir)))
    (with-current-buffer buf (revert-buffer nil t))))

(defun duet--schedule-completion-refresh (tr)
  "Schedule a refresh of TR's destination, and its sources after a move."
  (when (duet-transfer-destination-directory tr)
    (duet--schedule-pane-refresh (duet-transfer-destination-directory tr)))
  (when (duet-transfer-move-p tr)
    (dolist (d (duet-transfer-source-directories tr))
      (duet--schedule-pane-refresh d))))

;;; Cancellation

(defun duet--kill-process (tr)
  "Interrupt then delete TR's process if it is live."
  (let ((proc (duet-transfer-process tr)))
    (when (process-live-p proc)
      (interrupt-process proc)
      (delete-process proc))))

(defun duet--cancel-transfer (tr)
  "Request cancellation of non-terminal TR.
Move it to `cancelling' and kill its process; the sentinel then records
whether the backend's temp cleanup could be verified."
  (unless (memq (duet-transfer-status tr) duet--terminal-statuses)
    (setf (duet-transfer-status tr) 'cancelling)
    (duet--cancel-stall-timer tr)
    (duet--kill-process tr)))

(defun duet-cancel-transfer ()
  "Cancel the most recent transfer that has not yet finished."
  (interactive)
  (let ((tr (cl-find-if
             (lambda (x) (not (memq (duet-transfer-status x) duet--terminal-statuses)))
             duet--transfers)))
    (unless tr (user-error "DUET: no active transfer to cancel"))
    (duet--cancel-transfer tr)
    (message "DUET: cancelling transfer #%d" (duet-transfer-id tr))))

;;; Failure explanation

(defun duet--safety-text (safety)
  "Render a failure SAFETY value (string or symbol) as user-facing text."
  (cond ((stringp safety) safety)
        ((eq safety :generic) "Outcome unverified; inspect the destination.")
        (t "Unknown.")))

(defun duet--format-failure-explanation (tr)
  "Return a human-readable explanation of TR's outcome.
For a failure it states the class, cause, safety, evidence, and next actions;
for a success it says so."
  (let ((f (duet-transfer-failure tr)))
    (if (null f)
        (format "Transfer #%d completed successfully." (duet-transfer-id tr))
      (mapconcat
       #'identity
       (list (format "Transfer #%d failed: %s" (duet-transfer-id tr)
                     (plist-get f :class))
             (format "Cause: %s" (plist-get f :cause))
             (format "Safety: %s" (duet--safety-text (plist-get f :safety)))
             (format "Evidence: %s"
                     (if (plist-get f :evidence)
                         (mapconcat #'identity (plist-get f :evidence) " | ")
                       "(none)"))
             (format "Next: %s"
                     (mapconcat #'symbol-name (plist-get f :next-actions) ", ")))
       "\n"))))

(defun duet-explain-transfer-failure ()
  "Show the failure explanation for the most recent transfer in a buffer."
  (interactive)
  (let ((tr (car duet--transfers)))
    (unless tr (user-error "DUET: no transfers to explain"))
    (with-current-buffer (get-buffer-create "*DUET Transfer Failure*")
      (let ((inhibit-read-only t))
        (erase-buffer)
        (insert (duet--format-failure-explanation tr)))
      (display-buffer (current-buffer)))))

;;; Pane actions wired to the engine

(defun duet--submit-transfer (sources destination-directory move-p)
  "Build and run a transfer of SOURCES into DESTINATION-DIRECTORY.
MOVE-P marks a move.  Draw the log and return the `duet-transfer'.  Signal a
`user-error' when nothing is selected or no backend handles the pair."
  (unless sources (user-error "DUET: no files selected"))
  (let ((spec (duet--transfer-spec sources destination-directory)))
    (unless spec (user-error "DUET: no backend handles this transfer"))
    (prog1 (duet--run-transfer spec move-p)
      (duet--draw-transfer-log))))

(defun duet--start-pane-transfer (move-p)
  "Transfer the selected files in the active pane to the other pane.
MOVE-P marks a move.  Show the transfer log afterward."
  (let ((tr (duet--submit-transfer (dired-get-marked-files)
                                   (duet--pane-directory (duet--other-pane))
                                   move-p)))
    (display-buffer duet--transfer-log-buffer)
    tr))

(defun duet-copy ()
  "Copy the marked files in the active pane to the other pane."
  (interactive)
  (duet--start-pane-transfer nil))

(defun duet-move ()
  "Move the marked files in the active pane to the other pane."
  (interactive)
  (duet--start-pane-transfer t))

(defun duet-mkdir (name)
  "Create directory NAME in the active pane, then refresh it."
  (interactive "sNew directory name: ")
  (let ((dir (expand-file-name name default-directory)))
    (make-directory dir t)
    (duet--schedule-pane-refresh default-directory)
    (message "DUET: created %s" dir)))

(defun duet-delete ()
  "Delete the marked files in the active pane to trash, then refresh."
  (interactive)
  (let ((files (dired-get-marked-files))
        (delete-by-moving-to-trash t))
    (unless files (user-error "DUET: no files selected"))
    (when (yes-or-no-p (format "Delete %d item(s) to trash? " (length files)))
      (dolist (f files)
        (if (file-directory-p f)
            (delete-directory f t t)
          (delete-file f t)))
      (duet--schedule-pane-refresh default-directory)
      (message "DUET: deleted %d item(s)" (length files)))))

(provide 'duet)
;;; duet.el ends here