You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

394 lines
15 KiB

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