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.
 
 
 
 
 
 

378 lines
13 KiB

  1. ;;; guix-base.el --- Common definitions -*- lexical-binding: t -*-
  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 some base and common definitions for guix.el
  16. ;; package.
  17. ;;; Code:
  18. (require 'cl-lib)
  19. (require 'guix-backend)
  20. (require 'guix-guile)
  21. (require 'guix-read)
  22. (require 'guix-utils)
  23. (require 'guix-ui)
  24. (require 'guix-profiles)
  25. (defgroup guix nil
  26. "Settings for Guix package manager and friends."
  27. :prefix "guix-"
  28. :group 'external)
  29. (defgroup guix-faces nil
  30. "Guix faces."
  31. :group 'guix
  32. :group 'faces)
  33. (defun guix-package-name-specification (name version &optional output)
  34. "Return Guix package specification by its NAME, VERSION and OUTPUT."
  35. (concat name "@" version
  36. (when output (concat ":" output))))
  37. ;;; Location of profiles and manifests
  38. (defun guix-generation-file (profile generation)
  39. "Return the file name of a PROFILE's GENERATION."
  40. (format "%s-%s-link" profile generation))
  41. (defun guix-packages-profile (profile &optional generation system?)
  42. "Return a directory where packages are installed for the
  43. PROFILE's GENERATION.
  44. If SYSTEM? is non-nil, then PROFILE is considered to be a system
  45. profile. Unlike usual profiles, for a system profile, packages
  46. are placed in 'profile' subdirectory."
  47. (let ((profile (if generation
  48. (guix-generation-file profile generation)
  49. profile)))
  50. (if system?
  51. (expand-file-name "profile" profile)
  52. profile)))
  53. (defun guix-manifest-file (profile &optional generation system?)
  54. "Return the file name of a PROFILE's manifest.
  55. See `guix-packages-profile'."
  56. (expand-file-name "manifest"
  57. (guix-packages-profile profile generation system?)))
  58. ;;; Actions on packages and generations
  59. (defface guix-operation-option-key
  60. '((t :inherit font-lock-warning-face))
  61. "Face used for the keys of operation options."
  62. :group 'guix-faces)
  63. (defcustom guix-operation-confirm t
  64. "If nil, do not prompt to confirm an operation."
  65. :type 'boolean
  66. :group 'guix)
  67. (defcustom guix-use-substitutes t
  68. "If non-nil, use substitutes for the Guix packages."
  69. :type 'boolean
  70. :group 'guix)
  71. (defvar guix-dry-run nil
  72. "If non-nil, do not perform the real actions, just simulate.")
  73. (defvar guix-temp-buffer-name " *Guix temp*"
  74. "Name of a buffer used for displaying info before executing operation.")
  75. (defvar guix-operation-option-true-string "yes"
  76. "String displayed in the mode-line when operation option is t.")
  77. (defvar guix-operation-option-false-string "no "
  78. "String displayed in the mode-line when operation option is nil.")
  79. (defvar guix-operation-option-separator " | "
  80. "String used in the mode-line to separate operation options.")
  81. (defvar guix-operation-options
  82. '((?s "substitutes" guix-use-substitutes)
  83. (?d "dry-run" guix-dry-run))
  84. "List of available operation options.
  85. Each element of the list has a form:
  86. (KEY NAME VARIABLE)
  87. KEY is a character that may be pressed during confirmation to
  88. toggle the option.
  89. NAME is a string displayed in the mode-line.
  90. VARIABLE is a name of an option variable.")
  91. (defun guix-operation-option-by-key (key)
  92. "Return operation option by KEY (character)."
  93. (assq key guix-operation-options))
  94. (defun guix-operation-option-key (option)
  95. "Return key (character) of the operation OPTION."
  96. (car option))
  97. (defun guix-operation-option-name (option)
  98. "Return name of the operation OPTION."
  99. (nth 1 option))
  100. (defun guix-operation-option-variable (option)
  101. "Return name of the variable of the operation OPTION."
  102. (nth 2 option))
  103. (defun guix-operation-option-value (option)
  104. "Return boolean value of the operation OPTION."
  105. (symbol-value (guix-operation-option-variable option)))
  106. (defun guix-operation-option-string-value (option)
  107. "Convert boolean value of the operation OPTION to string and return it."
  108. (if (guix-operation-option-value option)
  109. guix-operation-option-true-string
  110. guix-operation-option-false-string))
  111. (defun guix-operation-prompt (&optional prompt)
  112. "Prompt a user for continuing the current operation.
  113. Return non-nil, if the operation should be continued; nil otherwise.
  114. Ask a user with PROMPT for continuing an operation."
  115. (let* ((option-keys (mapcar #'guix-operation-option-key
  116. guix-operation-options))
  117. (keys (append '(?y ?n) option-keys))
  118. (prompt (concat (propertize (or prompt "Continue operation?")
  119. 'face 'minibuffer-prompt)
  120. " ("
  121. (mapconcat
  122. (lambda (key)
  123. (propertize (string key)
  124. 'face 'guix-operation-option-key))
  125. keys
  126. ", ")
  127. ") ")))
  128. (let ((mode-line mode-line-format))
  129. (prog1 (guix-operation-prompt-1 prompt keys)
  130. (setq mode-line-format mode-line)
  131. ;; Clear the minibuffer after prompting.
  132. (message "")))))
  133. (defun guix-operation-prompt-1 (prompt keys)
  134. "This function is internal for `guix-operation-prompt'."
  135. (guix-operation-set-mode-line)
  136. (let ((key (read-char-choice prompt (cons ?\C-g keys) t)))
  137. (cl-case key
  138. (?y t)
  139. ((?n ?\C-g) nil)
  140. (t (let* ((option (guix-operation-option-by-key key))
  141. (var (guix-operation-option-variable option)))
  142. (set var (not (symbol-value var)))
  143. (guix-operation-prompt-1 prompt keys))))))
  144. (defun guix-operation-set-mode-line ()
  145. "Display operation options in the mode-line of the current buffer."
  146. (setq mode-line-format
  147. (concat (propertize " Options: "
  148. 'face 'mode-line-buffer-id)
  149. (mapconcat
  150. (lambda (option)
  151. (let ((key (guix-operation-option-key option))
  152. (name (guix-operation-option-name option))
  153. (val (guix-operation-option-string-value option)))
  154. (concat name
  155. " ("
  156. (propertize (string key)
  157. 'face 'guix-operation-option-key)
  158. "): " val)))
  159. guix-operation-options
  160. guix-operation-option-separator)))
  161. (force-mode-line-update))
  162. (defun guix-package-source-path (package-id)
  163. "Return a store file path to a source of a package PACKAGE-ID."
  164. (message "Calculating the source derivation ...")
  165. (guix-eval-read
  166. (guix-make-guile-expression
  167. 'package-source-path package-id)))
  168. (defun guix-package-store-path (package-id)
  169. "Return a list of store directories of outputs of package PACKAGE-ID."
  170. (message "Calculating the package derivation ...")
  171. (guix-eval-read
  172. (guix-make-guile-expression
  173. 'package-store-path package-id)))
  174. (defvar guix-after-source-download-hook nil
  175. "Hook run after successful performing a 'source-download' operation.")
  176. (defun guix-package-source-build-derivation (package-id &optional prompt)
  177. "Build source derivation of a package PACKAGE-ID.
  178. Ask a user with PROMPT for continuing an operation."
  179. (when (or (not guix-operation-confirm)
  180. (guix-operation-prompt (or prompt
  181. "Build the source derivation?")))
  182. (guix-eval-in-repl
  183. (guix-make-guile-expression
  184. 'package-source-build-derivation
  185. package-id
  186. :use-substitutes? (or guix-use-substitutes 'f)
  187. :dry-run? (or guix-dry-run 'f))
  188. nil 'source-download)))
  189. (defun guix-build-package (package-id &optional prompt)
  190. "Build package with PACKAGE-ID.
  191. Ask a user with PROMPT for continuing the build operation."
  192. (when (or (not guix-operation-confirm)
  193. (guix-operation-prompt (or prompt "Build package?")))
  194. (guix-eval-in-repl
  195. (format (concat ",run-in-store "
  196. "(build-package (package-by-id %d)"
  197. " #:use-substitutes? %s"
  198. " #:dry-run? %s)")
  199. package-id
  200. (guix-guile-boolean guix-use-substitutes)
  201. (guix-guile-boolean guix-dry-run)))))
  202. ;;;###autoload
  203. (defun guix-apply-manifest (profile file &optional operation-buffer)
  204. "Apply manifest from FILE to PROFILE.
  205. This function has the same meaning as 'guix package --manifest' command.
  206. See Info node `(guix) Invoking guix package' for details.
  207. Interactively, use the current profile and prompt for manifest
  208. FILE. With a prefix argument, also prompt for PROFILE."
  209. (interactive
  210. (let* ((current-profile (guix-ui-current-profile))
  211. (profile (if current-prefix-arg
  212. (guix-profile-prompt)
  213. (or current-profile guix-current-profile)))
  214. (file (read-file-name "File with manifest: "))
  215. (buffer (and current-profile (current-buffer))))
  216. (list profile file buffer)))
  217. (when (or (not guix-operation-confirm)
  218. (y-or-n-p (format "Apply manifest from '%s' to profile '%s'? "
  219. file profile)))
  220. (guix-eval-in-repl
  221. (guix-make-guile-expression
  222. 'guix-command
  223. "package"
  224. (concat "--profile=" (expand-file-name profile))
  225. (concat "--manifest=" (expand-file-name file)))
  226. operation-buffer)))
  227. ;;; Executing guix commands
  228. (defcustom guix-run-in-shell-function #'guix-run-in-shell
  229. "Function used to run guix command.
  230. The function is called with a single argument - a command line string."
  231. :type '(choice (function-item guix-run-in-shell)
  232. (function-item guix-run-in-eshell)
  233. (function :tag "Other function"))
  234. :group 'guix)
  235. (defcustom guix-shell-buffer-name "*shell*"
  236. "Default name of a shell buffer used for running guix commands."
  237. :type 'string
  238. :group 'guix)
  239. (declare-function comint-send-input "comint" t)
  240. (defun guix-run-in-shell (string)
  241. "Run command line STRING in `guix-shell-buffer-name' buffer."
  242. (shell guix-shell-buffer-name)
  243. (goto-char (point-max))
  244. (insert string)
  245. (comint-send-input))
  246. (declare-function eshell-send-input "esh-mode" t)
  247. (defun guix-run-in-eshell (string)
  248. "Run command line STRING in eshell buffer."
  249. (eshell)
  250. (goto-char (point-max))
  251. (insert string)
  252. (eshell-send-input))
  253. (defun guix-run-command-in-shell (args)
  254. "Execute 'guix ARGS ...' command in a shell buffer."
  255. (funcall guix-run-in-shell-function
  256. (guix-command-string args)))
  257. (defun guix-run-command-in-repl (args)
  258. "Execute 'guix ARGS ...' command in Guix REPL."
  259. (guix-eval-in-repl
  260. (apply #'guix-make-guile-expression
  261. 'guix-command args)))
  262. (defun guix-command-output (args)
  263. "Return string with 'guix ARGS ...' output."
  264. (cl-multiple-value-bind (output error)
  265. (guix-eval (apply #'guix-make-guile-expression
  266. 'guix-command-output args))
  267. ;; Remove trailing new space from the error string.
  268. (message (replace-regexp-in-string "\n\\'" "" (read error)))
  269. (read output)))
  270. (defun guix-help-string (&optional commands)
  271. "Return string with 'guix COMMANDS ... --help' output."
  272. (guix-eval-read
  273. (apply #'guix-make-guile-expression
  274. 'help-string commands)))
  275. ;;; Pull
  276. (defcustom guix-update-after-pull t
  277. "If non-nil, update Guix buffers after performing \\[guix-pull]."
  278. :type 'boolean
  279. :group 'guix)
  280. (defvar guix-after-pull-hook
  281. '(guix-restart-repl-after-pull guix-update-buffers-maybe-after-pull)
  282. "Hook run after successful performing `guix-pull' operation.")
  283. (defun guix-restart-repl-after-pull ()
  284. "Restart Guix REPL after `guix-pull' operation."
  285. (guix-repl-exit)
  286. (guix-start-process-maybe
  287. "Restarting Guix REPL after pull operation ..."))
  288. (defun guix-update-buffers-maybe-after-pull ()
  289. "Update buffers depending on `guix-update-after-pull'."
  290. (when guix-update-after-pull
  291. (mapc #'guix-ui-update-buffer
  292. ;; No need to update "generation" buffers.
  293. (guix-ui-buffers '(guix-package-list-mode
  294. guix-package-info-mode
  295. guix-output-list-mode
  296. guix-output-info-mode)))
  297. (message "Guix buffers have been updated.")))
  298. ;;;###autoload
  299. (defun guix-pull (&optional verbose)
  300. "Run Guix pull operation.
  301. If VERBOSE is non-nil (with prefix argument), produce verbose output."
  302. (interactive "P")
  303. (let ((args (and verbose '("--verbose"))))
  304. (guix-eval-in-repl
  305. (apply #'guix-make-guile-expression
  306. 'guix-command "pull" args)
  307. nil 'pull)))
  308. (provide 'guix-base)
  309. ;;; guix-base.el ends here