;;; ben.el --- Asynchronous buffer-local environments via `direnv'  -*- lexical-binding: t; -*-

;; Copyright (C) 2020  Steve Purcell
;; Copyright (c) 2026 Sergio Pastor Pérez <sergio.pastorperez@gmail.com>

;; Author: Steve Purcell <steve@sanityinc.com>
;;         Sergio Pastor Pérez <sergio.pastorperez@gmail.com>
;; Keywords: processes, tools
;; Homepage: https://codeberg.org/pastor/ben.el
;; Package-Requires: ((emacs "29.1") (inheritenv "0.1") (seq "2.24"))
;; Package-Version: 0.12.15
;; Package-Revision: 8cd9b28a43a3

;; 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.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Asynchronous fork of [envrc](https://github.com/purcell/envrc).
;;
;; This package allows you to load environments buffer locally.  The package is
;; named 'ben', which stands for Buffer ENvironments.
;;
;; The project relies on [direnv](https://direnv.net) which allows to setup
;; per-directory environments through '.envrc' files.
;;
;; The main improvement of 'ben' over 'envrc' is the asynchronous processing of
;; environments, which prevents Emacs from freezing.  This is especially useful
;; while loading computationally heavy environments, such when loading '.envrc'
;; files that rely on Guix.  In these cases, computations can take hours to
;; complete.  This package aims to facilitate loading such environments in the
;; background.
;;
;; The main additions of the fork are:
;;
;; - Controlling the synchronousity of the environment loading mechanism through
;; the `ben-async-processing' boolean variable.
;;
;; - Enhanced mode-line lighter for showcasing `none', `loading', `on' and
;;   `deny' status.
;;
;; - Process manager using tabulated list mode.
;;
;; - Minibuffer support which can be controlled through the
;;   `ben-disable-in-minibuffer' boolean variable.
;;
;; Enable `ben-global-mode' late in your startup files.  For
;; interaction with this functionality, see `ben-mode-map', and the
;; commands `ben-reload', `ben-allow' and `ben-deny'.
;;
;; In particular, you can enable keybindings for the above commands by
;; binding your preferred prefix to `ben-command-map' in
;; `ben-mode-map', e.g.
;;
;;    (with-eval-after-load 'ben
;;      (define-key ben-mode-map (kbd "C-c e") 'ben-command-map))
;;
;; For more information about 'ben', please see the README.org file.

;;; Code:

;; TODO: special handling for DIRENV_* vars? exclude them? use them to safely reload more aggressively?
;; TODO: handle nil default-directory (rarely happens, but is possible)
;; TODO: limit size of *direnv* buffer
;; TODO: special handling of compilation-environment?
;; TODO: handle use of "cd" and other changes of `default-directory' in a buffer over time?
;; TODO: handle "allow" asynchronously?
;; TODO: describe env
;; TODO: click on mode lighter to get details
;; TODO: handle when direnv is not installed?
;; TODO: provide a way to disable in certain projects?
;; TODO: cleanup the cache?

(require 'seq)
(require 'json)
(require 'subr-x)
(require 'ansi-color)
(require 'cl-lib)
(require 'diff-mode) ; for its faces
(require 'inheritenv)
(eval-when-compile (require 'tramp))

;;; Custom vars and minor modes

(defgroup ben nil
  "Apply per-buffer environment variables using the direnv tool."
  :group 'processes)

(defcustom ben-debug nil
  "Whether or not to output debug messages while in operation.
Messages are written into the *ben-debug* buffer."
  :type 'boolean)

(defcustom ben-add-to-mode-line-misc-info t
  "When non-nil, append the ben indicator to the mode line.
Experienced users can set this to a nil value and then include the
`ben-indicator' anywhere they want in `mode-line-format' or related."
  :group 'ben
  :type 'boolean)

(defcustom ben-async-processing t
  "Whether or not to update the environment asynchronously."
  :group 'ben
  :type 'boolean)

(defcustom ben-async-prompt-before-kill t
  "Whether or not to prompt the user before killing running ben processes."
  :group 'ben
  :type 'boolean)

(defcustom ben-status-frames '("=  " "== " "===" " ==" "  =" "   ")
  "List of frames for the spinner."
  :group 'ben
  :type '(repeat string))

(defcustom ben-update-on-eshell-directory-change t
  "Whether ben will update environment when changing directory in eshell."
  :type 'boolean)

(defcustom ben-show-summary-in-minibuffer t
  "When non-nil, show a summary of the changes made by direnv in the minibuffer."
  :group 'ben
  :type 'boolean)

(defcustom ben-disable-in-minibuffer nil
  "Whether or not to load environments in the minibuffer.

A non-nil value will prevent the envrionment from propagating into the
minibuffer.  Note that `completing-read' will not provide completion
using the new environment."
  :group 'ben
  :type 'boolean)

(defcustom ben-direnv-executable "direnv"
  "The direnv executable used by ben."
  :type 'string)

(defvar-keymap ben-command-map
  :doc "Prefix keymap for `ben-mode'."
  :prefix 'ben-command-map
  :name "ben"
  "a" '(menu-item "Allow" ben-allow)
  "d" '(menu-item "Deny" ben-deny)
  "r" '(menu-item "Reload" ben-reload)
  "R" '(menu-item "Reload All" ben-reload-all)
  "l" '(menu-item "Show Log" ben-show-log))

(defcustom ben-indicator '(" ben[" (:eval (ben--status)) "]")
  "The mode line lighter for `ben-mode'.
You can set this to nil to disable the lighter."
  :type 'sexp)
(put 'ben-indicator 'risky-local-variable t)

(defun ben-popup-menu (_)
  (interactive "e")
  (popup-menu ben-command-map))

(defun ben--indicator-keymap ()
  (let ((map (make-sparse-keymap)))
    (define-key map [mode-line mouse-1] #'ben-popup-menu)
    map))

(defun ben--make-indicator (label face)
  `((:propertize
     ,label
     local-map ,(ben--indicator-keymap)
     mouse-face mode-line-highlight
     face ,face)))

(defcustom ben-none-indicator
  (ben--make-indicator "none" 'ben-mode-line-none-face)
  "Construct spec used by the default `ben-indicator' when ben is inactive."
  :type 'sexp)

(defcustom ben-on-indicator
  (ben--make-indicator "on" 'ben-mode-line-on-face)
  "Construct spec used by the default `ben-indicator' when ben is on."
  :type 'sexp)

(defcustom ben-denied-indicator
  (ben--make-indicator "denied" 'ben-mode-line-denied-face)
  "Construct spec used by the default `ben-indicator' when ben is blocked."
  :type 'sexp)

(defcustom ben-error-indicator
  (ben--make-indicator "error" 'ben-mode-line-error-face)
  "Construct spec used by the default `ben-indicator' when ben has errored."
  :type 'sexp)

(defcustom ben-remote nil
  "Whether or not to enable direnv over TRAMP."
  :type 'boolean)

(defcustom ben-supported-tramp-methods '("ssh")
  "Tramp connection methods that are supported by ben."
  :type '(repeat string))

(defvar ben--used-mode-line-construct nil
  "Mode line construct to add to `mode-line-misc-info' when `ben-mode' is on.")

(defvar-keymap ben-mode-map
  :doc "Keymap for `ben-mode'.")

(defcustom ben-after-apply-hook nil
  "List of functions to be called after applying an environment."
  :type 'hook
  :group 'ben)

(defun ben--default-directory-watcher (_ newval _ buf)
  "Since some functions, such as `project-find-file', lexically set the
value of `default-directory' in the buffer where the function was
triggered, if `ben--apply' finishes before exiting the minibuffer, the
value of `default-directory' where the `project-find-file' was triggered
will still be part of the environment being activated by BEN, possibly
marking it's status as ON, after exiting the minibuffer, the value of
`default-directory' will return to it's original value, but nothing will
inform BEN that it's status must be updated.

This corner case can be triggered by any function that alters the value
of `default-directory', making `ben--status' outdated.  This variable
watcher, ensures that the value of `ben--status' is consistent by
triggering an update with `default-directory' set to NEWVAL for BUF."
  ;; It is very important not to update the status if NEWVAL is a remote as it
  ;; will recursively trigger TRAMP in an infinite loop.
  (unless (file-remote-p newval)
    (with-current-buffer buf
      (let ((default-directory newval))
        (ben--status-update-buf buf)))))

;;;###autoload
(define-minor-mode ben-mode
  "A local minor mode in which env vars are set by direnv."
  :init-value nil
  :lighter 'ben
  (if ben-mode
      (progn
        (when ben-add-to-mode-line-misc-info
          (setq ben--used-mode-line-construct ben-indicator)
          ;; NOTE since this is a minor mode, `mode-line-misc-info' needs to be
          ;; controlled locally.
          (make-local-variable 'mode-line-misc-info)
          (add-to-list 'mode-line-misc-info ben-indicator)
          (add-variable-watcher 'default-directory #'ben--default-directory-watcher))
        (ben--update)
        (when (and (derived-mode-p 'eshell-mode) ben-update-on-eshell-directory-change)
          (add-hook 'eshell-directory-change-hook #'ben--update nil t)))
    (setq mode-line-misc-info (delete ben--used-mode-line-construct mode-line-misc-info))
    (ben--clear (current-buffer))
    ;; If there is no buffer with `ben-mode' enabled, remove the watcher.
    (unless (ben--mode-buffers)
      (remove-variable-watcher 'default-directory #'ben--default-directory-watcher))
    (remove-hook 'eshell-directory-change-hook #'ben--update t)))

(defun ben--eldoc-buffer-p (buffer)
  (string-prefix-p " *eldoc " (buffer-name buffer)))

(defun ben--disabled-context-p ()
  (or (and (minibufferp) ben-disable-in-minibuffer)
      (ben--eldoc-buffer-p (current-buffer))))

(defun ben--supported-remote-p ()
  (and ben-remote
       (seq-contains-p
        ben-supported-tramp-methods
        (with-parsed-tramp-file-name default-directory vec
          vec-method))))

(defun ben--unavailable-p ()
  (not (if (file-remote-p default-directory)
           (ben--supported-remote-p)
         (executable-find ben-direnv-executable))))

;;;###autoload
(define-globalized-minor-mode ben-global-mode ben-mode
  (lambda ()
    (unless (or ben-mode
                (ben--disabled-context-p)
                (ben--unavailable-p))
      (ben-mode 1)))
  :predicate t)

(defface ben-mode-line-on-face '((t :inherit success))
  "Face used in mode line to indicate that direnv is in effect.")

(defface ben-mode-line-denied-face '((t :inherit shadow))
  "Face used in mode line to indicate that direnv blocking env.")

(defface ben-mode-line-error-face '((t :inherit error))
  "Face used in mode line to indicate that direnv failed.")

(defface ben-mode-line-none-face '((t :inherit warning))
  "Face used in mode line to indicate that direnv is not active.")

(defface ben-mode-line-loading-face '((t :inherit mode-line-emphasis))
  "Face used in mode line to indicate that direnv is loading the environment.")

;;; Global state

(defvar ben--cache (make-hash-table :test 'equal :size 10)
  "Known ben directories and their direnv results.
The values are as produced by `ben--export'.")

(defvar ben--processes (make-hash-table :test 'equal :size 10)
  "Asynchonous processes started by ben.
Each entry uses an environment directory as key.

Each value of this table is an alist of
`((process . <process>) (subscribed . (buf_0 buf_1 ... buf_n)))'

The SUBSCRIBED field allows subscribing buffers to have the new
environment applied once the async process finishes.")

;;; Local state

(defvar-local ben--status 'none
  "Symbol indicating state of the current buffer's direnv.
One of \\='(none loading on error).")

(defvar-local ben--remote-path nil
  "Buffer local variable for remote path.
If set, this will override `tramp-remote-path' via connection
local variables.")

;;; Internals

(defvar ben--status-timer nil
  "Timer for updating the spinner.")

(defvar ben--status-index 0
  "Current index in the spinner frames list.")

(defvar ben--loading-indicator nil
  "Current frame to display during the loading indicator state.")

(defun ben--status ()
  "Get the propertized status to display in the mode line."
  (pcase ben--status
    (`none ben-none-indicator)
    (`loading ben--loading-indicator)
    (`on ben-on-indicator)
    (`denied ben-denied-indicator)
    (`error ben-error-indicator)))

(defvar ben--loading-buf-list '()
  "List of buffers that are loading an environment.")

(defun ben--status-update-buf (buf)
  "Update the spinner in BUF's mode line."
  (with-current-buffer buf
    (let ((loading-environments (hash-table-keys ben--processes))
          (buf-env-dir (ben--find-env-dir)))
      (cond
       ((member buf-env-dir loading-environments)
        (let ((spinner (nth ben--status-index ben-status-frames)))
          (setq ben--loading-indicator `((:propertize ,spinner face ben-mode-line-loading-face))
                ben--status 'loading)))
       ((and (not buf-env-dir)
             (not (equal ben--status 'none)))
        (setq ben--status 'none))))
    (force-mode-line-update)))

(defun ben-status-update ()
  "Update the spinner in the mode line."
  (setq ben--status-index
        (mod (1+ ben--status-index)
             (length ben-status-frames)))
  (walk-windows (lambda (win)
                  (let ((buf (window-buffer win)))
                    (unless (minibufferp buf)
                      (ben--status-update-buf buf))))))

(defun ben-status-start ()
  "Start the spinner and update it periodically."
  (unless ben--status-timer
    (setq ben--status-index 0)
    (setq ben--status-timer
          (run-with-timer 0 0.1 #'ben-status-update))))

(defun ben-status-stop (env-dir)
  "Stop the spinner and remove it from the mode line.
ENV-DIR is the directory where to update the status."
  (when ben--status-timer
    (cancel-timer ben--status-timer)
    (setq ben--status-timer nil))
  (let ((status ben--status))
    (dolist (buf (ben--mode-buffers))
      (with-current-buffer buf
        (let* ((buf-env-dir (ben--find-env-dir))
               (status* (cond
                         ((equal buf-env-dir env-dir)
                          status)
                         ((and (not buf-env-dir)
                               (equal ben--status 'loading))
                          'none)
                         (t nil))))
          (when status*
            (setq ben--status status*)
            (force-mode-line-update)))))))

(defun ben--env-dir-p (dir)
  "Return non-nil if DIR contains a config file for direnv."
  (or
   (file-exists-p (expand-file-name ".envrc" dir))
   (file-exists-p (expand-file-name ".env" dir))))

(defun ben--find-env-dir ()
  "Return the ben directory for the current buffer, if any.
This is based on a file scan.  In most cases we prefer to use the
cached list of known directories.

Regardless of buffer file name, we always use
`default-directory': the two should always match, unless the user
called `cd'"
  (let ((env-dir (locate-dominating-file default-directory #'ben--env-dir-p)))
    (when env-dir
      ;; `locate-dominating-file' appears to sometimes return abbreviated paths, e.g. with ~
      (setq env-dir (expand-file-name env-dir)))
    env-dir))

(defun ben--find-deny-hash (env-dir)
  "Return the ben file hash from ENV-DIR."
  (when-let* ((file-path (let ((envrc (expand-file-name ".envrc" env-dir))
                               (dotenv (expand-file-name ".env" env-dir)))
                           (cond ((file-exists-p envrc) envrc)
                                 ((file-exists-p dotenv) dotenv))))
              (contents (with-temp-buffer
                          (insert file-path "\n")
                          (buffer-string))))
    (secure-hash 'sha256 contents)))

(defun ben--denied-p (env-dir)
  "Return TRUE if ENV-DIR is blocked."
  (let ((deny-hash (ben--find-deny-hash env-dir))
        (deny-path (concat (or (getenv "XDG_DATA_HOME")
                               (concat (getenv "HOME") "/.local/share"))
                           "/direnv/deny")))
    (locate-file deny-hash
                 (list deny-path))))

(defun ben--cache-key (env-dir process-env)
  "Get a hash key for the result of invoking direnv in ENV-DIR with PROCESS-ENV.
PROCESS-ENV should be the environment in which direnv was run,
since its output can vary according to its initial environment."
  (string-join (cons env-dir process-env) "\0"))

(defun ben--update-async ()
  "Update the current buffer's env asynchronously if it is managed by direnv.
All ben.el-managed buffers with this env will have their
environments updated."
  (let* ((cur-buf (current-buffer))
         (env-dir (ben--find-env-dir))
         (cache-key (ben--cache-key env-dir (default-value 'process-environment)))
         (cache (gethash cache-key ben--cache))
         (update-callback
          (lambda (env)
            (unless cache
              (puthash cache-key env ben--cache))
            (unwind-protect
                (when (buffer-live-p cur-buf)
                  (ben--apply cur-buf env))
              (let ((subscribed (alist-get 'subscribed (gethash env-dir ben--processes))))
                (dolist (buf subscribed)
                  (when (buffer-live-p buf)
                    (ben--apply buf env))))))))
    (if env-dir
        (if cache
            (funcall update-callback cache)
          (let ((running-process (alist-get 'process (gethash env-dir ben--processes)))
                (subscribed (alist-get 'subscribed (gethash env-dir ben--processes))))
            (if running-process
                (progn
                  (unless (memq cur-buf subscribed)
                    (push cur-buf subscribed))
                  (puthash env-dir
                           `((process . ,running-process)
                             (subscribed . ,subscribed))
                           ben--processes))
              (ben--export-async update-callback env-dir))))
      (funcall update-callback 'none))))

(defun ben--update-sync ()
  "Update the current buffer's env synchronously if it is managed by direnv.
All ben.el-managed buffers with this env will have their
environments updated."
  (let* ((env-dir (ben--find-env-dir))
         (result
          (if env-dir
              (let ((cache-key (ben--cache-key env-dir (default-value 'process-environment))))
                (pcase (gethash cache-key ben--cache 'missing)
                  (`missing (let ((calculated (ben--export env-dir)))
                              (puthash cache-key calculated ben--cache)
                              calculated))
                  (cached cached)))
            'none)))
    (ben--apply (current-buffer) result)))

(defun ben--update ()
  "Update the current buffer's environment if it is managed by direnv.
All ben.el-managed buffers with this env will have their
environments updated.
Synchronously or asynchronously according to the value of
`ben-async-processing'."
  (if ben-async-processing
      (ben--update-async)
    (ben--update-sync)))

(defmacro ben--at-end-of-special-buffer (name &rest body)
  "At the end of `special-mode' buffer NAME, execute BODY.
To avoid confusion, `ben-mode' is explicitly disabled in the buffer."
  (declare (indent 1))
  `(with-current-buffer (get-buffer-create ,name)
     (unless (derived-mode-p 'special-mode)
       (special-mode))
     (when ben-mode (ben-mode -1))
     (goto-char (point-max))
     (let ((inhibit-read-only t))
       ,@body)))

(defun ben--debug (msg &rest args)
  "A version of `message' which does nothing if `ben-debug' is nil.
MSG and ARGS are as for that function."
  (when ben-debug
    (ben--at-end-of-special-buffer "*ben-debug*"
      (insert (apply #'format msg args))
      (newline))))

(defun ben--summarise-changes (items)
  "Create a summary string for ITEMS."
  (if items
      (cl-loop for (name . val) in items
               with process-environment = (default-value 'process-environment)
               unless (string-prefix-p "DIRENV_" name)
               collect (cons name
                             (if val
                                 (if (getenv name)
                                     '("~" diff-changed)
                                   '("+" diff-added))
                               '("-" diff-removed)))
               into entries
               finally return (cl-loop for (name prefix face) in (seq-sort-by 'car 'string< entries)
                                       collect (propertize (concat prefix name) 'face face) into strings
                                       finally return (string-join strings " ")))
    "no changes"))

(defun ben--show-summary (result directory)
  "Summarise successful RESULT in the minibuffer.
DIRECTORY is the directory in which the environment changes."
  (message "direnv: %s %s"
           (ben--summarise-changes result)
           (propertize (concat "(" (abbreviate-file-name (directory-file-name directory)) ")")
                       'face 'font-lock-comment-face)))

(defun ben--export-async (callback env-dir)
  "Export the env vars for ENV-DIR using direnv.
Return value is either \\='error, \\='none, or an alist of environment
variable names and values.

CALLBACK the function which will get the return value."
  (let* ((default-directory env-dir)
         (stdout (generate-new-buffer "*ben-export*"))
         (stderr (generate-new-buffer "*ben-export-stderr*"))
         (export-callback
          (lambda (exit-code)
            (unless (ben--env-dir-p env-dir)
              (error "%s is not a directory with a .envrc" env-dir))
            (let (result)
              (with-current-buffer stdout
                (ben--debug "Direnv exited with %s and stderr=%S, stdout=%S"
                            exit-code
                            (with-current-buffer stderr
                              (buffer-string))
                            (buffer-string))
                (cond ((eq 0 exit-code) ;; zerop is not an option, as exit-code may sometimes be a symbol
                       (progn
                         (if (zerop (buffer-size))
                             (setq result 'none)
                           (goto-char (point-min))
                           (prog1
                               (if (ben--denied-p env-dir)
                                   (setq result 'denied)
                                 (setq result (let ((json-key-type 'string)) (json-read-object))))
                             (when ben-show-summary-in-minibuffer
                               (ben--show-summary result env-dir))))))
                      ((eq 9 exit-code)
                       (message "Direnv killed in %s" env-dir)
                       (if (ben--denied-p env-dir)
                           (setq result 'denied)
                         (setq result 'error)))
                      (t
                       (message "Direnv failed in %s" env-dir)
                       (setq result 'error)))
                (ben--at-end-of-special-buffer "*ben*"
                  (insert "──── " (format-time-string "%F %T") " ──── " env-dir " ────\n\n")
                  (let ((initial-pos (point))
                        ansi-color-context)
                    (insert (with-current-buffer stderr
                              (ansi-color-apply (buffer-string))))
                    (goto-char (point-max))
                    (add-face-text-property initial-pos (point) (if (eq 0 exit-code) 'success 'error)))
                  (insert "\n\n")
                  ;; Since the async processing interface allows the user to
                  ;; interactively kill the process, do not popup the buffer
                  ;; when `ben-async-processing' is true.
                  (when (and (numberp exit-code) (and (/= 0 exit-code)
                                                      (/= 9 exit-code)))
                    (display-buffer (current-buffer)))))
              (kill-buffer stdout)
              (kill-buffer stderr)
              result)))
         (sentinel (lambda (process msg)
                     (funcall callback
                              (funcall export-callback
                                       (ben--async-process-sentinel process msg))))))
    (message "Running direnv in %s ..." env-dir)
    (ben--start-process-with-global-env sentinel stdout stderr ben-direnv-executable "export" "json")))

(defun ben--export (env-dir)
  "Export the env vars for ENV-DIR using direnv.
Return value is either \\='error, \\='none, or an alist of environment
variable names and values."
  (unless (ben--env-dir-p env-dir)
    (error "%s is not a directory with a .envrc" env-dir))
  (message "Running direnv in %s ... (C-g to abort)" env-dir)
  (let ((stderr-file (make-temp-file "ben"))
        result)
    (unwind-protect
        (let ((default-directory env-dir))
          (with-temp-buffer
            (let ((exit-code (condition-case nil
                                 (ben--call-process-with-global-env ben-direnv-executable nil (list t stderr-file) nil "export" "json")
                               (quit
                                (message "interrupted!!")
                                'interrupted))))
              (ben--debug "Direnv exited with %s and stderr=%S, stdout=%S"
                          exit-code
                          (with-temp-buffer
                            (insert-file-contents stderr-file)
                            (buffer-string))
                          (buffer-string))
              (cond ((eq 0 exit-code) ;; zerop is not an option, as exit-code may sometimes be a symbol
                     (progn
                       (if (zerop (buffer-size))
                           (setq result 'none)
                         (goto-char (point-min))
                         (prog1
                             (if (ben--denied-p env-dir)
                                 (setq result 'denied)
                               (setq result (let ((json-key-type 'string)) (json-read-object))))
                           (when ben-show-summary-in-minibuffer
                             (ben--show-summary result env-dir))))))
                    ((eq 9 exit-code)
                     (message "Direnv killed in %s" env-dir)
                     (if (ben--denied-p env-dir)
                         (setq result 'denied)
                       (setq result 'error)))
                    (t
                     (message "Direnv failed in %s" env-dir)
                     (setq result 'error)))
              (ben--at-end-of-special-buffer "*ben*"
                (insert "──── " (format-time-string "%F %T") " ──── " env-dir " ────\n\n")
                (let ((initial-pos (point)))
                  (insert-file-contents stderr-file)
                  (goto-char (point-max))
                  (let (ansi-color-context)
                    (ansi-color-apply-on-region initial-pos (point)))
                  (add-face-text-property initial-pos (point) (if (eq 0 exit-code) 'success 'error)))
                (insert "\n\n")
                (when (and (numberp exit-code) (/= 0 exit-code))
                  (display-buffer (current-buffer)))))))
      (delete-file stderr-file))
    result))

;; Forward declarations for the byte compiler
(defvar eshell-path-env)
(defvar Info-directory-list)

(defun ben--merged-environment (process-env pairs)
  "Make a `process-environment' value that merges PROCESS-ENV with PAIRS.
PAIRS is an alist obtained from direnv's output.
Values from PROCESS-ENV will be included, but their values will
be masked by Emacs' handling of `process-environment' if they
also appear in PAIRS."
  (append (mapcar (lambda (pair)
                    (if (cdr pair)
                        (format "%s=%s" (car pair) (cdr pair))
                      ;; Plain env name is the syntax for unsetting vars
                      (car pair)))
                  pairs)
          process-env))

(defun ben--clear (buf)
  "Remove any effects of `ben-mode' from BUF."
  (with-current-buffer buf
    (kill-local-variable 'exec-path)
    (kill-local-variable 'process-environment)
    (kill-local-variable 'Info-directory-list)
    (when (derived-mode-p 'eshell-mode)
      (if (fboundp 'eshell-set-path)
          (eshell-set-path (butlast exec-path))
        (kill-local-variable 'eshell-path-env)))))


(defun ben--apply (buf result)
  "Update BUF with RESULT, which is a result of `ben--export'."
  (with-current-buffer buf
    (setq-local ben--status (if (listp result) 'on result))
    (ben--clear buf)
    (if (memq result '(none error denied))
        (progn
          (ben--debug "[%s] reset environment to default" buf))
      (ben--debug "[%s] applied merged environment" buf)
      (let* ((remote (when-let* ((fn (or (buffer-file-name buf) default-directory)))
                       (file-remote-p fn)))
             (env (ben--merged-environment
                   (default-value (if remote
                                      'tramp-remote-process-environment
                                    'process-environment))
                   result))
             (path (getenv-internal "PATH" env))
             (parsed-path (parse-colon-path path)))
        (if remote
            ;; Get PATH from the merged environment: direnv may not have changed
            ;; it.
            (setq-local ben--remote-path parsed-path
                        tramp-remote-process-environment env)
          (setq-local exec-path parsed-path
                      process-environment env))
        (when (boundp 'Info-directory-list)
          (when-let* ((info-path (getenv-internal "INFOPATH" env)))
            (setq-local Info-directory-list
                        (append (seq-filter #'identity (parse-colon-path info-path))
                                (default-value 'Info-directory-list)))))
        (when-let* ((emacs-load-path (getenv-internal "EMACSLOADPATH" env)))
          (setq-local load-path
                      (seq-uniq (append (string-split emacs-load-path ":")
                                        load-path))))
        (when (derived-mode-p 'eshell-mode)
          (if (fboundp 'eshell-set-path)
              (eshell-set-path path)
            (setq-local eshell-path-env path)))
        (run-hooks 'ben-after-apply-hook)))))

(defun ben--update-env (env-dir)
  "Refresh the state of the direnv in ENV-DIR and apply in all relevant buffers."
  (ben--debug "Invalidating cache for env %s" env-dir)
  (cl-loop for k being the hash-keys of ben--cache
           if (string-prefix-p (concat env-dir "\0") k)
           do (remhash k ben--cache))
  (ben--debug "Refreshing all buffers in env  %s" env-dir)
  (dolist (buf (ben--mode-buffers))
    (with-current-buffer buf
      (when (string= (ben--find-env-dir) env-dir)
        (ben--update)))))

(defun ben--mode-buffers ()
  "Return a list of all live buffers in which `ben-mode' is enabled."
  (seq-filter (lambda (b) (and (buffer-live-p b)
                               (with-current-buffer b
                                 ben-mode)))
              (buffer-list)))

(defmacro ben--with-required-current-env (varname &rest body)
  "With VARNAME set to the current env dir path, execute BODY.
If there is no current env dir, abort with a user error."
  (declare (indent 1))
  (cl-assert (symbolp varname))
  `(let ((,varname (ben--find-env-dir)))
     (unless ,varname
       (user-error "No enclosing .envrc"))
     ,@body))

(defun ben--call-process-with-global-env (&rest args)
  "Like `call-process', but always use the global process environment.
In particular, we ensure the default variable `exec-path' and
`process-environment' are used.  This ensures an .envrc doesn't take
`ben-direnv-executable' out of our path.
ARGS is as for `call-process'."
  (let ((exec-path (default-value 'exec-path))
        (process-environment (default-value 'process-environment)))
    (apply #'process-file args)))

(defun ben--start-process-with-global-env (sentinel out-buf err-buf &rest args)
  "Like `start-process', but always use the global process environment.
In particular, we ensure the default variable `exec-path' and
`process-environment' are used.  This ensures an .envrc doesn't take
`ben-direnv-executable' out of our path.

SENTINEL, OUT-BUF, ERR-BUF and ARGS are the respective keywords of
`make-process'."
  (let* ((env-buf (current-buffer))
         (env-dir default-directory)
         (running-process (alist-get 'process (gethash env-dir ben--processes)))
         (wrapped-sentinel (lambda (process msg)
                             (unless (buffer-live-p env-buf)
                               ;; Migrate to any buffer from the same env.
                               (setq env-buf
                                     (seq-find (lambda (buf)
                                                 (with-current-buffer buf
                                                   (equal (ben--find-env-dir) env-dir)))
                                               (ben--mode-buffers))))
                             (unwind-protect
                                 ;; NOTE: the call back and the status stop
                                 ;; should run in a buffer from the same
                                 ;; environment as the async process.
                                 (with-current-buffer env-buf
                                   (funcall sentinel process msg)
                                   ;; `ben--status-timer' is a single timer shared by every buffer that is
                                   ;; currently showing a loading spinner; one timer is enough to animate them all.
                                   ;; Because it is shared, it must only be cancelled once no other environment is
                                   ;; still loading. Otherwise, any other spinner would freeze on its current
                                   ;; frame.
                                   (when (and ben--status-timer
                                              (null (seq-remove (lambda (dir) (equal dir env-dir))
                                                                (hash-table-keys ben--processes))))
                                     (ben-status-stop env-dir)))
                               (remhash env-dir ben--processes)))))
    (if running-process
        (ben--debug "Ignoring, process already running for %s." env-dir)
      (let* ((exec-path (default-value 'exec-path))
             (process-environment (default-value 'process-environment))
             (process (make-process
                       :name "*ben-process*"
                       :buffer out-buf
                       :stderr err-buf
                       :sentinel wrapped-sentinel
                       :connection-type 'pipe
                       :command args)))
        (puthash env-dir `((process . ,process)
                           (subscribed . (,(current-buffer))))
                 ben--processes)
        (when ben-add-to-mode-line-misc-info
          (ben-status-start))))))

(defun ben--kill-running-prompt (env-dir)
  "Prompt user to kill any process loading the environment of ENV-DIR."
  (when-let* ((proc (alist-get 'process (gethash env-dir ben--processes)))
              (kill (if ben-async-prompt-before-kill
                        (yes-or-no-p (format "Process %s is loading the environment, kill it? " proc))
                      t)))
    (kill-process proc)
    (while (alist-get 'process (gethash env-dir ben--processes))
      (sleep-for 0.1))))

(defun ben--run-direnv (verb)
  "Run direnv command named by VERB, then refresh current env."
  (ben--with-required-current-env env-dir
    (ben--kill-running-prompt env-dir)
    (let* ((outbuf (get-buffer-create (format "*ben-%s*" verb)))
           (default-directory env-dir)
           (exit-code (ben--call-process-with-global-env ben-direnv-executable nil outbuf nil verb)))
      (if (zerop exit-code)
          (progn
            (ben--update-env env-dir)
            (kill-buffer outbuf))
        (display-buffer outbuf)
        (user-error "Error running direnv %s" verb)))))

(defun ben-reload ()
  "Reload the current env."
  (interactive)
  (ben--run-direnv "reload"))

(defun ben--async-process-sentinel (process msg)
  "Return PROCESS's exit code.

Display MSG in debug buffer if `ben-debug' is non-nil."
  (when (memq (process-status process) '(exit signal))
    (let ((exit-code (process-exit-status process)))
      (ben--debug (concat (process-name process) " - " msg " - status: " (number-to-string exit-code)))
      exit-code)))

(defun ben-allow ()
  "Run \"direnv allow\" in the current env."
  (interactive)
  (ben--run-direnv "allow"))

(defun ben-deny ()
  "Run \"direnv deny\" in the current env."
  (interactive)
  (ben--run-direnv "deny"))

(defun ben-reload-all ()
  "Reload direnvs for all buffers.
This can be useful if a .envrc has been deleted."
  (interactive)
  (ben--debug "Invalidating cache for all envs")
  (clrhash ben--cache)
  (dolist (buf (ben--mode-buffers))
    (with-current-buffer buf
      (ben--update))))

(defun ben-show-log ()
  "Open ben log buffer."
  (interactive)
  (if-let* ((buffer (get-buffer "*ben*")))
      (pop-to-buffer buffer)
    (message "Ben log buffer does not exist")))


;;; Propagate local environment to commands that use temp buffers

(defun ben-propagate-environment (orig &rest args)
  "Advice function to wrap a command ORIG and make it use our local env.

This can be used to force compliance where ORIG starts processes
in a temp buffer.  ARGS is as for ORIG."
  (if ben-mode
      (inheritenv (apply orig args))
    (apply orig args)))

(defun ben-propagate-tramp-environment (buf)
  "Advice function to propagate environments to tramp.

This will affect `tramp-remote-path' and
`tramp-remote-process-environment' from buffer local values.
BUF is the buffer where to adjust the tramp variables."
  (when ben-mode
    (let ((cur-path ben--remote-path)
          (cur-env tramp-remote-process-environment))
      (with-current-buffer buf
        (setq-local tramp-remote-process-environment cur-env)
        (setq-local ben--remote-path cur-path))))
  buf)

(defun ben-get-remote-path (fn vec)
  "Advice wrap for FN `tramp-get-remote-path' with its argument VEC.

Shortcuts tramp caching direnv sets the variable `exec-path'."
  (with-current-buffer (tramp-get-connection-buffer vec)
    (or ben--remote-path
        (apply fn vec nil))))

;; NOTE: This functions are meant to be invoked by `completing-read'. Therefore,
;; `ben-mode' must be enabled in the minibuffer for the environment to
;; propagate. This can be configured by setting `ben-disable-in-minibuffer' to
;; nil, this is the default.

;; Doc
(declare-function Man-completion-table "man")
(advice-add #'Man-completion-table :around #'ben-propagate-environment)

;; Shells
(declare-function async-shell-command "simple")
(declare-function shell-command "simple")
(declare-function shell-command-to-string "simple")
(advice-add #'async-shell-command :around #'ben-propagate-environment)
(advice-add #'shell-command :around #'ben-propagate-environment)
(advice-add #'shell-command-to-string :around #'ben-propagate-environment)

;; Dired
(declare-function dired-shell-command "dired-aux")
(advice-add #'dired-shell-command :around #'ben-propagate-environment)

;; ORG
(declare-function org-babel-eval "ob-eval")
(advice-add #'org-babel-eval :around #'ben-propagate-environment)

;; TRAMP
(declare-function tramp-get-connection-buffer "tramp")
(declare-function tramp-get-remote-path "tramp-sh")
(advice-add #'tramp-get-connection-buffer :filter-return
            #'ben-propagate-tramp-environment)
(advice-add #'tramp-get-remote-path :around #'ben-get-remote-path)

;; VC
(declare-function vc-call-backend "vc-hooks")
(declare-function vc-dir "vc-dir")
(advice-add #'vc-call-backend :around #'ben-propagate-environment)
(advice-add #'vc-dir :around #'ben-propagate-environment)


;;; Major mode for .envrc files

;; Generate direnv keywords with:
;;     $ rg "Usage:\s+([^_]\w+)" DIRENV_SRC/stdlib.sh -Nor '"$1"' | sort | uniq
(defvar ben-file-extra-keywords
  '("MANPATH_add" "PATH_add" "PATH_rm" "direnv_apply_dump" "direnv_layout_dir"
    "direnv_load" "direnv_version" "dotenv" "dotenv_if_exists"
    "env_vars_required" "expand_path" "fetchurl" "find_up" "has" "join_args"
    "layout" "load_prefix" "log_error" "log_status" "on_git_branch" "path_add"
    "path_rm" "rvm" "semver_search" "source_env" "source_env_if_exists"
    "source_up" "source_up_if_exists" "source_url" "strict_env" "unstrict_env"
    "use" "use_flake" "use_flox" "use_guix" "use_nix" "use_vim" "user_rel_path"
    "watch_dir" "watch_file")
  "Useful direnv keywords to be highlighted.")

(declare-function sh-set-shell "sh-script")

;;;###autoload
(define-derived-mode ben-file-mode
  sh-mode "ben"
  "Major mode for .envrc files as used by direnv.
\\{ben-file-mode-map}"
  (sh-set-shell "bash")
  (font-lock-add-keywords
   nil `((,(regexp-opt ben-file-extra-keywords 'symbols)
          (0 font-lock-keyword-face)))))

;;;###autoload
(add-to-list 'auto-mode-alist '("\\.envrc\\'" . ben-file-mode))

(defun ben-unload-function ()
  "Unload `ben'."
  (advice-remove #'Man-completion-table #'ben-propagate-environment)
  (advice-remove #'shell-command #'ben-propagate-environment)
  (advice-remove #'shell-command-to-string #'ben-propagate-environment)
  (advice-remove #'async-shell-command #'ben-propagate-environment)
  (advice-remove #'org-babel-eval #'ben-propagate-environment)
  (advice-remove #'tramp-get-connection-buffer #'ben-propagate-tramp-environment)
  (advice-remove #'tramp-get-remote-path #'ben-get-remote-path)
  (ben-global-mode -1)
  ;; Return nil to instruct Emacs to proceed with the normal unloading of `ben'.
  nil)

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

;; LocalWords:  ben direnv

;; Local Variables:
;; coding: utf-8
;; indent-tabs-mode: nil
;; End:
