Rough draft.

1 files changed, 127 insertions, 0 deletions

diff --git a/guix-shell.el b/guix-shell.el
new file mode 100644
index 0000000..bf5640f
--- /dev/null
+++ b/guix-shell.el
@@ -0,0 +1,127 @@
+;;; -*- lexical-binding: t -*-
+;;;
+;;; Copyright © 2022 David Thompson <davet@gnu.org>
+;;;
+;;; emacs-guix-shell 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.
+;;;
+;;; emacs-guix-shell 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
+;;; <http://www.gnu.org/licenses/>.
+
+(defvar guix-shell--search-paths '()
+  "Project environment variable cache.")
+
+(defun guix-shell--current-directory ()
+  (project-root (project-current)))
+
+(defvar guix-shell--hooks '(post-command-hook before-hack-local-variables-hook)
+  "Hooks that guix shell should hook into.")
+
+(defvar guix-shell--last-directory nil
+  "The last directory used for running guix shell.")
+
+(defun guix-shell--search-paths-for-directory (directory)
+  (let ((buffer (get-buffer-create "*guix-shell-temp*"))
+        (names '()))
+    (with-current-buffer buffer
+      (setq default-directory directory)
+      (erase-buffer)
+      (call-process "guix" nil t nil "shell" "--search-paths")
+      ;; Gather up the names of all the environment variables and transform
+      ;; the lines into echo commands that we can eval to get the actual
+      ;; search path values.
+      (goto-char (point-min))
+      (while (not (eobp))
+        (let ((start (point)))
+          (forward-word)
+          (let ((word (buffer-substring-no-properties start (point))))
+            (if (string-equal word "export")
+                (progn
+                  (forward-whitespace 1)
+                  (delete-backward-char (- (point) start))
+                  (let ((var-start (point)))
+                    (search-forward "=")
+                    (backward-char 1)
+                    (push (buffer-substring-no-properties var-start (point)) names)
+                    (delete-backward-char (- (point) var-start)))
+                  (delete-char 1)
+                  (insert "echo ")
+                  (beginning-of-line)
+                  (forward-line 1))
+              (progn
+                (goto-char start)
+                (kill-whole-line))))))
+      (setq names (reverse names))
+      ;; Eval the search paths.
+      (call-process-region (point-min) (point-max) "sh" t t nil)
+      ;; Iterate over the result lines and create an environment variable
+      ;; mapping.
+      (goto-char (point-min))
+      (let ((env-vars '()))
+        (dolist (var names)
+          (let ((start (point)))
+            (end-of-line 1)
+            (let ((search-path (buffer-substring-no-properties start (point))))
+              (push (cons var search-path) env-vars))
+            (beginning-of-line)
+            (forward-line 1)))
+        (kill-buffer buffer)
+        env-vars))))
+
+(defun guix-shell--update-search-paths-for-directory (directory)
+  (when directory
+    (let ((search-paths (guix-shell--search-paths-for-directory directory)))
+      (setq guix-shell--search-paths
+            (cons (cons directory search-paths)
+                  (assoc-delete-all directory guix-shell--search-paths)))
+      search-paths)))
+
+(defun guix-shell--cached-search-paths-for-directory (directory)
+  (cdr (assoc directory guix-shell--search-paths)))
+
+(defun guix-shell--apply-search-paths (search-paths)
+  (dolist (pair search-paths)
+    (let ((name (car pair))
+          (search-path (cdr pair)))
+      (setenv name search-path)
+      (when (string-equal name "PATH")
+        (setq exec-path (append (parse-colon-path search-path)
+                                (list exec-directory)))))))
+
+(defun guix-shell--apply-search-paths-for-directory (directory)
+  ;; TODO: What if the search paths have been updated and need to be
+  ;; re-applied?  This doesn't account for that case currently.  The only way
+  ;; to update would be to switch to a buffer in a different project and then
+  ;; change back.
+  (when (and directory
+             (not (string-equal directory guix-shell--last-directory)))
+    (guix-shell--apply-search-paths
+     (or (guix-shell--cached-search-paths-for-directory directory)
+         (guix-shell--update-search-paths-for-directory directory)))
+    (setq guix-shell--last-directory directory)))
+
+(defun guix-shell--apply-search-paths-for-current-directory ()
+  (guix-shell--apply-search-paths-for-directory (guix-shell--current-directory)))
+
+(defun guix-shell-enable ()
+  (interactive)
+  (dolist (hook guix-shell--hooks)
+    (add-hook hook #'guix-shell--apply-search-paths-for-current-directory)))
+
+(defun guix-shell-disable ()
+  (interactive)
+  (dolist (hook guix-shell--hooks)
+    (remove-hook hook #'guix-shell--apply-search-paths-for-current-directory)))
+
+(defun guix-shell-update ()
+  (interactive)
+  (guix-shell--update-search-paths-for-directory
+   (guix-shell--current-directory)))