glyph-venv.el

;;; glyph-venv.el --- Assign a contextually-appropriate virtualenv. -*- lexical-binding: t; -*-

;; This file is not part of GNU Emacs.

;;; Commentary:

;; Automatically figure out what virtualenv is relevant to a buffer, based on
;; my ~/Projects home directory layout.

;;; Code:

(require 'subr-x)

(defvar glyph-setup-with-required-failed nil
  "Error sentinel for `glyph-setup-with-required'.")

(defmacro glyph-setup-with-required (symb &rest code)
  "Require the given symbols (SYMB), then run the given CODE."
  `(if (condition-case nil
           (progn
             (let* ( (req-arg (quote ,symb))
                     (required-symbols
                      (if (listp req-arg) req-arg (list req-arg))) )
               (cl-loop for required-symbol in required-symbols do
                     (require required-symbol)) )
             t)
         (error (progn
                  (setq glyph-setup-with-required-failed
                        (cons ',symb glyph-setup-with-required-failed))
                  nil)))
       (progn ,@code)))

(defun glyph-setup-buffer-homesubdir-name (subdirname)
  "Get name of a direct descendant of a subdirectory `SUBDIRNAME' of $HOME.

Returns nil if the current buffer is not a descendant of that
dir."
  (let ((file-in-project (buffer-file-name)))
    (if (and
         file-in-project
         (string-match (concat (regexp-quote
                                (concat (getenv "HOME")
                                        "/" subdirname "/"))
                               "\\(.*?\\)/")
                       file-in-project))
        (match-string 1 file-in-project))))

(defun glyph-setup-buffer-project-name ()
  "Get the project-name for the current buffer; nil if not in a project."
  (glyph-setup-buffer-homesubdir-name "Projects"))

(defun glyph-setup-buffer-venv-name ()
  "Get the venv name for this buffer, or nil."
  (let ((python-distribution-root
         (or (locate-dominating-file default-directory "pyproject.toml")
             (locate-dominating-file default-directory "setup.py")
             (locate-dominating-file default-directory "flit.ini")
             (locate-dominating-file default-directory "requirements.txt"))))
    (if python-distribution-root
        (subst-char-in-string
         ?/ ?_
         (string-trim-right
          (string-remove-prefix
           (expand-file-name (concat (getenv "HOME") "/Projects/"))
           (expand-file-name python-distribution-root)
           ) "/" ))
      (when (and (functionp 'ein:$kernelspec-name)
                 (fboundp 'polymode-with-current-base-buffer)
                 (fboundp 'ein:get-kernel--worksheet)
                 (fboundp 'ein:$kernel-kernelspec))
        (polymode-with-current-base-buffer
         (lambda ()
           (let ((a-kernel (ein:get-kernel--worksheet)))
             (when a-kernel
               (ein:$kernelspec-name (ein:$kernel-kernelspec a-kernel))))))))))

(defun glyph-setup-buffer-venv ()
  "Get the virtualenv to activate for the current buffer.

nil if no paired venv."
  (let ((a-venv-name (or (glyph-setup-buffer-venv-name)
                         (glyph-setup-buffer-homesubdir-name ".virtualenvs"))))
    (when a-venv-name
      (concat (getenv "HOME")
              "/.virtualenvs/"
              a-venv-name))))

(defvar glyph-py-scripts-dir (if (eq window-system 'w32) "Scripts" "bin")
  "The platform-appropriate scripts directory within a virtualenv.")

(defun glyph-setup-autovenvify ()
  "Try to automatically honor the contextually appropriate venv."
  (let* ((env-to-use (glyph-setup-buffer-venv))
         (path-to-use (concat env-to-use (format "/%s" glyph-py-scripts-dir))))
    (message "autovenvify selected %s"
             (if env-to-use
                 (abbreviate-file-name env-to-use)
               "(no environment)"))
    (when env-to-use
      (set (make-local-variable 'process-environment)
           (copy-tree process-environment))
      (set (make-local-variable 'exec-path)
           (cons path-to-use (copy-tree exec-path)))
      (glyph-setup-with-required (jedi)
        (set (make-local-variable 'jedi:server-args)
             (list "--virtual-env" env-to-use)))
      (setenv "PATH" (concat path-to-use ":" (getenv "PATH")))
      (setenv "VIRTUAL_ENV" env-to-use)
      )))

(provide 'glyph-venv)
;;; glyph-venv.el ends here