emacs/guix-backend.el

   1 ;;; guix-backend.el --- Making and using Guix REPL
   2
   3 ;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
   4
   5 ;; This file is part of GNU Guix.
   6
   7 ;; GNU Guix is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; GNU Guix is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 ;;; Commentary:
  21
  22 ;; This file provides the code for interacting with Guile using Guix REPL
  23 ;; (Geiser REPL with some guix-specific additions).
  24
  25 ;; By default (if `guix-use-guile-server' is non-nil) 2 Guix REPLs are
  26 ;; started.  The main one (with "guile --listen" process) is used for
  27 ;; "interacting" with a user - for showing a progress of
  28 ;; installing/deleting Guix packages.  The second (internal) REPL is
  29 ;; used for synchronous evaluating, e.g. when information about
  30 ;; packages/generations should be received for a list/info buffer.
  31 ;;
  32 ;; This "2 REPLs concept" makes it possible to have a running process of
  33 ;; installing/deleting packages and to continue to search/list/get info
  34 ;; about other packages at the same time.  If you prefer to use a single
  35 ;; Guix REPL, do not try to receive any information while there is a
  36 ;; running code in the REPL (see
  37 ;; <https://github.com/jaor/geiser/issues/28>).
  38 ;;
  39 ;; Guix REPLs (unlike the usual Geiser REPLs) are not added to
  40 ;; `geiser-repl--repls' variable, and thus cannot be used for evaluating
  41 ;; while editing scm-files.  The only purpose of Guix REPLs is to be an
  42 ;; intermediate between "Guix/Guile level" and "Emacs interface level".
  43 ;; That being said you can still want to use a Guix REPL while hacking
  44 ;; auxiliary scheme-files for "guix.el".  You can just use
  45 ;; `geiser-connect-local' command with `guix-repl-current-socket' to
  46 ;; have a usual Geiser REPL with all stuff defined by "guix.el" package.
  47
  48 ;;; Code:
  49
  50 (require 'geiser-mode)
  51 (require 'geiser-guile)
  52 (require 'guix-geiser)
  53 (require 'guix-config)
  54 (require 'guix-external)
  55 (require 'guix-emacs)
  56 (require 'guix-profiles)
  57
  58 (defvar guix-load-path guix-config-emacs-interface-directory
  59   "Directory with scheme files for \"guix.el\" package.")
  60
  61 (defvar guix-helper-file
  62   (expand-file-name "guix-helper.scm" guix-load-path)
  63   "Auxiliary scheme file for loading.")
  64
  65 \f
  66 ;;; REPL
  67
  68 (defgroup guix-repl nil
  69   "Settings for Guix REPLs."
  70   :prefix "guix-repl-"
  71   :group 'guix)
  72
  73 (defcustom guix-repl-startup-time 30000
  74   "Time, in milliseconds, to wait for Guix REPL to startup.
  75 Same as `geiser-repl-startup-time' but is used for Guix REPL.
  76 If you have a slow system, try to increase this time."
  77   :type 'integer
  78   :group 'guix-repl)
  79
  80 (defcustom guix-repl-buffer-name "*Guix REPL*"
  81   "Default name of a Geiser REPL buffer used for Guix."
  82   :type 'string
  83   :group 'guix-repl)
  84
  85 (defcustom guix-after-start-repl-hook '(guix-set-directory)
  86   "Hook called after Guix REPL is started."
  87   :type 'hook
  88   :group 'guix-repl)
  89
  90 (defcustom guix-use-guile-server t
  91   "If non-nil, start guile with '--listen' argument.
  92 This allows to receive information about packages using an additional
  93 REPL while some packages are being installed/removed in the main REPL."
  94   :type 'boolean
  95   :group 'guix-repl)
  96
  97 (defcustom guix-repl-socket-file-name-function
  98   #'guix-repl-socket-file-name
  99   "Function used to define a socket file name used by Guix REPL.
 100 The function is called without arguments."
 101   :type '(choice (function-item guix-repl-socket-file-name)
 102                  (function :tag "Other function"))
 103   :group 'guix-repl)
 104
 105 (defcustom guix-emacs-activate-after-operation t
 106   "Activate Emacs packages after installing.
 107 If nil, do not load autoloads of the Emacs packages after
 108 they are successfully installed."
 109   :type 'boolean
 110   :group 'guix-repl)
 111
 112 (defvar guix-repl-current-socket nil
 113   "Name of a socket file used by the current Guix REPL.")
 114
 115 (defvar guix-repl-buffer nil
 116   "Main Geiser REPL buffer used for communicating with Guix.
 117 This REPL is used for processing package actions and for
 118 receiving information if `guix-use-guile-server' is nil.")
 119
 120 (defvar guix-internal-repl-buffer nil
 121   "Additional Geiser REPL buffer used for communicating with Guix.
 122 This REPL is used for receiving information only if
 123 `guix-use-guile-server' is non-nil.")
 124
 125 (defvar guix-internal-repl-buffer-name "*Guix Internal REPL*"
 126   "Default name of an internal Guix REPL buffer.")
 127
 128 (defvar guix-before-repl-operation-hook nil
 129   "Hook run before executing an operation in Guix REPL.")
 130
 131 (defvar guix-after-repl-operation-hook
 132   '(guix-repl-autoload-emacs-packages-maybe
 133     guix-repl-operation-success-message)
 134   "Hook run after executing successful operation in Guix REPL.")
 135
 136 (defvar guix-repl-operation-p nil
 137   "Non-nil, if current operation is performed by `guix-eval-in-repl'.
 138 This internal variable is used to distinguish Guix operations
 139 from operations performed in Guix REPL by a user.")
 140
 141 (defvar guix-repl-operation-type nil
 142   "Type of the current operation performed by `guix-eval-in-repl'.
 143 This internal variable is used to define what actions should be
 144 executed after the current operation succeeds.
 145 See `guix-eval-in-repl' for details.")
 146
 147 (defun guix-repl-autoload-emacs-packages-maybe ()
 148   "Load autoloads for Emacs packages if needed.
 149 See `guix-emacs-activate-after-operation' for details."
 150   (and guix-emacs-activate-after-operation
 151        ;; FIXME Since a user can work with a non-current profile (using
 152        ;; C-u before `guix-search-by-name' and other commands), emacs
 153        ;; packages can be installed to another profile, and the
 154        ;; following code will not work (i.e., the autoloads for this
 155        ;; profile will not be loaded).
 156        (guix-emacs-autoload-packages guix-current-profile)))
 157
 158 (defun guix-repl-operation-success-message ()
 159   "Message telling about successful Guix operation."
 160   (message "Guix operation has been performed."))
 161
 162 (defun guix-get-guile-program (&optional socket)
 163   "Return a value suitable for `geiser-guile-binary'."
 164   (if (null socket)
 165       guix-guile-program
 166     (append (if (listp guix-guile-program)
 167                 guix-guile-program
 168               (list guix-guile-program))
 169             (list (concat "--listen=" socket)))))
 170
 171 (defun guix-repl-socket-file-name ()
 172   "Return a name of a socket file used by Guix REPL."
 173   (make-temp-name
 174    (concat (file-name-as-directory temporary-file-directory)
 175            "guix-repl-")))
 176
 177 (defun guix-repl-delete-socket-maybe ()
 178   "Delete `guix-repl-current-socket' file if it exists."
 179   (and guix-repl-current-socket
 180        (file-exists-p guix-repl-current-socket)
 181        (delete-file guix-repl-current-socket)))
 182
 183 (add-hook 'kill-emacs-hook 'guix-repl-delete-socket-maybe)
 184
 185 (defun guix-start-process-maybe (&optional start-msg end-msg)
 186   "Start Geiser REPL configured for Guix if needed.
 187 START-MSG and END-MSG are strings displayed in the minibuffer in
 188 the beginning and in the end of the starting process.  If nil,
 189 display default messages."
 190   (guix-start-repl-maybe nil
 191                          (or start-msg "Starting Guix REPL ...")
 192                          (or end-msg "Guix REPL has been started."))
 193   (if guix-use-guile-server
 194       (guix-start-repl-maybe 'internal)
 195     (setq guix-internal-repl-buffer guix-repl-buffer)))
 196
 197 (defun guix-start-repl-maybe (&optional internal start-msg end-msg)
 198   "Start Guix REPL if needed.
 199 If INTERNAL is non-nil, start an internal REPL.
 200
 201 START-MSG and END-MSG are strings displayed in the minibuffer in
 202 the beginning and in the end of the process.  If nil, do not
 203 display messages."
 204   (let* ((repl-var (guix-get-repl-buffer-variable internal))
 205          (repl (symbol-value repl-var)))
 206     (unless (and (buffer-live-p repl)
 207                  (get-buffer-process repl))
 208       (and start-msg (message start-msg))
 209       (setq guix-repl-operation-p nil)
 210       (unless internal
 211         ;; Guile leaves socket file after exit, so remove it if it
 212         ;; exists (after the REPL restart).
 213         (guix-repl-delete-socket-maybe)
 214         (setq guix-repl-current-socket
 215               (and guix-use-guile-server
 216                    (or guix-repl-current-socket
 217                        (funcall guix-repl-socket-file-name-function)))))
 218       (let ((geiser-guile-binary (guix-get-guile-program
 219                                   (unless internal
 220                                     guix-repl-current-socket)))
 221             (geiser-guile-init-file (unless internal guix-helper-file))
 222             (repl (get-buffer-create
 223                    (guix-get-repl-buffer-name internal))))
 224         (guix-start-repl repl (and internal guix-repl-current-socket))
 225         (set repl-var repl)
 226         (and end-msg (message end-msg))
 227         (unless internal
 228           (run-hooks 'guix-after-start-repl-hook))))))
 229
 230 (defun guix-start-repl (buffer &optional address)
 231   "Start Guix REPL in BUFFER.
 232 If ADDRESS is non-nil, connect to a remote guile process using
 233 this address (it should be defined by
 234 `geiser-repl--read-address')."
 235   ;; A mix of the code from `geiser-repl--start-repl' and
 236   ;; `geiser-repl--to-repl-buffer'.
 237   (let ((impl 'guile)
 238         (geiser-guile-load-path (cons (expand-file-name guix-load-path)
 239                                       geiser-guile-load-path))
 240         (geiser-repl-startup-time guix-repl-startup-time))
 241     (with-current-buffer buffer
 242       (geiser-repl-mode)
 243       (geiser-impl--set-buffer-implementation impl)
 244       (geiser-repl--autodoc-mode -1)
 245       (goto-char (point-max))
 246       (let ((prompt (geiser-con--combined-prompt
 247                      geiser-guile--prompt-regexp
 248                      geiser-guile--debugger-prompt-regexp)))
 249         (geiser-repl--save-remote-data address)
 250         (geiser-repl--start-scheme impl address prompt)
 251         (geiser-repl--quit-setup)
 252         (geiser-repl--history-setup)
 253         (setq-local geiser-repl--repls (list buffer))
 254         (geiser-repl--set-this-buffer-repl buffer)
 255         (setq geiser-repl--connection
 256               (geiser-con--make-connection
 257                (get-buffer-process (current-buffer))
 258                geiser-guile--prompt-regexp
 259                geiser-guile--debugger-prompt-regexp))
 260         (geiser-repl--startup impl address)
 261         (geiser-repl--autodoc-mode 1)
 262         (geiser-company--setup geiser-repl-company-p)
 263         (add-hook 'comint-output-filter-functions
 264                   'guix-repl-output-filter
 265                   nil t)
 266         (set-process-query-on-exit-flag
 267          (get-buffer-process (current-buffer))
 268          geiser-repl-query-on-kill-p)))))
 269
 270 (defun guix-repl-output-filter (str)
 271   "Filter function suitable for `comint-output-filter-functions'.
 272 This is a replacement for `geiser-repl--output-filter'."
 273   (cond
 274    ((string-match-p geiser-guile--prompt-regexp str)
 275     (geiser-autodoc--disinhibit-autodoc)
 276     (when guix-repl-operation-p
 277       (setq guix-repl-operation-p nil)
 278       (run-hooks 'guix-after-repl-operation-hook)
 279       ;; Run hooks specific to the current operation type.
 280       (when guix-repl-operation-type
 281         (let ((type-hook (intern
 282                           (concat "guix-after-"
 283                                   (symbol-name guix-repl-operation-type)
 284                                   "-hook"))))
 285           (setq guix-repl-operation-type nil)
 286           (and (boundp type-hook)
 287                (run-hooks type-hook))))))
 288    ((string-match geiser-guile--debugger-prompt-regexp str)
 289     (setq guix-repl-operation-p nil)
 290     (geiser-con--connection-set-debugging geiser-repl--connection
 291                                           (match-beginning 0))
 292     (geiser-autodoc--disinhibit-autodoc))))
 293
 294 (defun guix-repl-exit (&optional internal no-wait)
 295   "Exit the current Guix REPL.
 296 If INTERNAL is non-nil, exit the internal REPL.
 297 If NO-WAIT is non-nil, do not wait for the REPL process to exit:
 298 send a kill signal to it and return immediately."
 299   (let ((repl (symbol-value (guix-get-repl-buffer-variable internal))))
 300     (when (get-buffer-process repl)
 301       (with-current-buffer repl
 302         (geiser-con--connection-deactivate geiser-repl--connection t)
 303         (comint-kill-subjob)
 304         (unless no-wait
 305           (while (get-buffer-process repl)
 306             (sleep-for 0.1)))))))
 307
 308 (defun guix-get-repl-buffer (&optional internal)
 309   "Return Guix REPL buffer; start REPL if needed.
 310 If INTERNAL is non-nil, return an additional internal REPL."
 311   (guix-start-process-maybe)
 312   (let ((repl (symbol-value (guix-get-repl-buffer-variable internal))))
 313     ;; If a new Geiser REPL is started, `geiser-repl--repl' variable may
 314     ;; be set to the new value in a Guix REPL, so set it back to a
 315     ;; proper value here.
 316     (with-current-buffer repl
 317       (geiser-repl--set-this-buffer-repl repl))
 318     repl))
 319
 320 (defun guix-get-repl-buffer-variable (&optional internal)
 321   "Return the name of a variable with a REPL buffer."
 322   (if internal
 323       'guix-internal-repl-buffer
 324     'guix-repl-buffer))
 325
 326 (defun guix-get-repl-buffer-name (&optional internal)
 327   "Return the name of a REPL buffer."
 328   (if internal
 329       guix-internal-repl-buffer-name
 330     guix-repl-buffer-name))
 331
 332 (defun guix-switch-to-repl (&optional internal)
 333   "Switch to Guix REPL.
 334 If INTERNAL is non-nil (interactively with prefix), switch to the
 335 additional internal REPL if it exists."
 336   (interactive "P")
 337   (geiser-repl--switch-to-buffer (guix-get-repl-buffer internal)))
 338
 339 \f
 340 ;;; Guix directory
 341
 342 (defvar guix-directory nil
 343   "Default directory with Guix source.
 344 If it is not set by a user, it is set after starting Guile REPL.
 345 This directory is used to define package locations.")
 346
 347 (defun guix-read-directory ()
 348   "Return `guix-directory' or prompt for it.
 349 This function is intended for using in `interactive' forms."
 350   (if current-prefix-arg
 351       (read-directory-name "Directory with Guix modules: "
 352                            guix-directory)
 353     guix-directory))
 354
 355 (defun guix-set-directory ()
 356   "Set `guix-directory' if needed."
 357   (or guix-directory
 358       (setq guix-directory
 359             (guix-eval-read "%guix-dir"))))
 360
 361 \f
 362 ;;; Evaluating expressions
 363
 364 (defvar guix-operation-buffer nil
 365   "Buffer from which the latest Guix operation was performed.")
 366
 367 (defun guix-eval (str)
 368   "Evaluate STR with guile expression using Guix REPL.
 369 See `guix-geiser-eval' for details."
 370   (guix-geiser-eval str (guix-get-repl-buffer 'internal)))
 371
 372 (defun guix-eval-read (str)
 373   "Evaluate STR with guile expression using Guix REPL.
 374 See `guix-geiser-eval-read' for details."
 375   (guix-geiser-eval-read str (guix-get-repl-buffer 'internal)))
 376
 377 (defun guix-eval-in-repl (str &optional operation-buffer operation-type)
 378   "Switch to Guix REPL and evaluate STR with guile expression there.
 379 If OPERATION-BUFFER is non-nil, it should be a buffer from which
 380 the current operation was performed.
 381
 382 If OPERATION-TYPE is non-nil, it should be a symbol.  After
 383 successful executing of the current operation,
 384 `guix-after-OPERATION-TYPE-hook' is called."
 385   (run-hooks 'guix-before-repl-operation-hook)
 386   (setq guix-repl-operation-p t
 387         guix-repl-operation-type operation-type
 388         guix-operation-buffer operation-buffer)
 389   (guix-geiser-eval-in-repl str (guix-get-repl-buffer)))
 390
 391 (provide 'guix-backend)
 392
 393 ;;; guix-backend.el ends here