envrc hack for asynchronous direnv call

envrc-hack.el

;; -*- lexical-binding: t; -*-
(with-eval-after-load 'envrc
  (defun envrc--export-async (env-dir result-fn)
    (unless (file-exists-p (expand-file-name ".envrc" env-dir))
      (error "%s is not a directory with a .envrc" env-dir))
    (message "Running direnv in %s..." env-dir)
    (unwind-protect
        (let ((default-directory env-dir)
              (stdout (generate-new-buffer (concat " *direnv output at " env-dir "*")))
              (stderr (generate-new-buffer (concat "*envrc at " env-dir "*"))))
          (let ((process-environment (default-value 'process-environment))
                (exec-path (default-value 'exec-path)))
            (make-process
             :name "direnv"
             :buffer stdout
             :stderr stderr
             :command '("direnv" "export" "json")
             :sentinel
             (lambda (process msg)
               (unless (eq (process-status process) 'run)
                 (let ((exit-code (process-exit-status process))
                       result)
                   (envrc--debug "Direnv exited with %s and output: %S" exit-code (buffer-string))
                   (if (zerop exit-code)
                       (progn
                         (message "Direnv succeeded in %s" env-dir)
                         (with-current-buffer stdout
                           (unless (zerop (buffer-size))
                             (goto-char (point-min))
                             (setq result (let ((json-key-type 'string)) (json-read-object))))))
                     (message "Direnv failed in %s" env-dir)
                     (setq result 'error))
                   (kill-buffer stdout)
                   (envrc--at-end-of-special-buffer "*envrc*"
                     (insert "==== " (format-time-string "%Y-%m-%d %H:%M:%S") " ==== " env-dir " ====\n\n")
                     (let ((initial-pos (point)))
                       (insert-buffer-substring stderr)
                       ;; (insert-file-contents (let (ansi-color-context)
                       ;;                         (ansi-color-apply stderr-file)))
                       (goto-char (point-max))
                       (add-face-text-property initial-pos (point) (if (zerop exit-code)
                                                                       'success 'error)))
                     (insert "\n\n"))
                   (kill-buffer stderr)
                   (funcall result-fn result)))))))))


  (defun envrc--update-env-async (env-dir)
    (when (not (eq 'loading (gethash env-dir envrc--envs)))
      (puthash env-dir 'loading envrc--envs)
      (envrc--apply-all env-dir)
      (envrc--export-async env-dir
                           (lambda (result)
                             (puthash env-dir result envrc--envs)
                             (envrc--apply-all env-dir)))))

  (defun envrc--lighter ()
    "Return a colourised version of `envrc--status' for use in the mode line."
    `(" env["
      (:propertize ,(symbol-name envrc--status)
                   face
                   ,(pcase envrc--status
                      (`on 'envrc-mode-line-on-face)
                      (`error 'envrc-mode-line-error-face)
                      (`loading 'envrc-mode-line-none-face)
                      (`none 'envrc-mode-line-none-face)))
      "]"))

  (defun envrc--apply (buf result)
    "Update BUF with RESULT, which is a result of `envrc--export'."
    (with-current-buffer buf
      (setq-local
       envrc--status
       (pcase result
         (`loading 'loading)
         (`error 'error)
         (`() 'none)
         (_ 'on)))
      (kill-local-variable 'exec-path)
      (kill-local-variable 'process-environment)
      (kill-local-variable 'eshell-path-env)
      (let ((pairs (when (listp result) result)))
        (if pairs
            (progn
              (envrc--debug "[%s] applied merged environment" buf)
              (setq-local process-environment (envrc--merged-environment process-environment pairs))
              (let ((path (getenv "PATH"))) ;; Get PATH from the merged environment: direnv may not have changed it
                (setq-local exec-path (parse-colon-path path))
                (when (derived-mode-p 'eshell-mode)
                  (setq-local eshell-path-env path))))
          (envrc--debug "[%s] reset environment to default" buf)))))

  (setf (symbol-function 'envrc--update-env)  #'envrc--update-env-async))