[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/nix-mode 414a40fe54 131/500: Add hydra mode (#25)
|
From: |
ELPA Syncer |
|
Subject: |
[nongnu] elpa/nix-mode 414a40fe54 131/500: Add hydra mode (#25) |
|
Date: |
Sat, 29 Jan 2022 08:26:49 -0500 (EST) |
branch: elpa/nix-mode
commit 414a40fe540b071e99ad5a5870e5f6f51b04b031
Author: Matthew Justin Bauer <mjbauer95@gmail.com>
Commit: GitHub <noreply@github.com>
Add hydra mode (#25)
* Add guix modes.
* Rework into nix-modes.
* Update buffer names
---
nix-build-log.el | 365 +++++++++++++++++++++++++++++++++++++++
nix-devel.el | 390 ++++++++++++++++++++++++++++++++++++++++++
nix-hydra-build.el | 370 ++++++++++++++++++++++++++++++++++++++++
nix-hydra-jobset.el | 166 ++++++++++++++++++
nix-hydra.el | 320 +++++++++++++++++++++++++++++++++++
nix-popup.el | 51 ++++++
nix-profiles.el | 202 ++++++++++++++++++++++
nix-ui-messages.el | 260 ++++++++++++++++++++++++++++
nix-ui-profile.el | 136 +++++++++++++++
nix-utils.el | 479 ++++++++++++++++++++++++++++++++++++++++++++++++++++
nix.el | 43 +++++
11 files changed, 2782 insertions(+)
diff --git a/nix-build-log.el b/nix-build-log.el
new file mode 100644
index 0000000000..2a9a316c46
--- /dev/null
+++ b/nix-build-log.el
@@ -0,0 +1,365 @@
+;;; nix-build-log.el --- Major and minor modes for build logs -*-
lexical-binding: t -*-
+
+;; Copyright © 2015 Alex Kost <alezost@gmail.com>
+
+;; This file is part of Emacs-Guix.
+
+;; Emacs-Guix 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 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 Emacs-Guix. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides a major mode (`nix-build-log-mode') and a minor mode
+;; (`nix-build-log-minor-mode') for highlighting Guix build logs.
+
+;;; Code:
+
+(require 'nix)
+(require 'nix-utils)
+
+(defgroup nix-build-log nil
+ "Settings for `nix-build-log-mode'."
+ :group 'guix)
+
+(defgroup nix-build-log-faces nil
+ "Faces for `nix-build-log-mode'."
+ :group 'nix-build-log
+ :group 'nix-faces)
+
+(defface nix-build-log-title-head
+ '((t :inherit font-lock-keyword-face))
+ "Face for '@' symbol of a log title."
+ :group 'nix-build-log-faces)
+
+(defface nix-build-log-title-start
+ '((t :inherit nix-build-log-title-head))
+ "Face for a log title denoting a start of a process."
+ :group 'nix-build-log-faces)
+
+(defface nix-build-log-title-success
+ '((t :inherit nix-build-log-title-head))
+ "Face for a log title denoting a successful end of a process."
+ :group 'nix-build-log-faces)
+
+(defface nix-build-log-title-fail
+ '((t :inherit error))
+ "Face for a log title denoting a failed end of a process."
+ :group 'nix-build-log-faces)
+
+(defface nix-build-log-title-end
+ '((t :inherit nix-build-log-title-head))
+ "Face for a log title denoting an undefined end of a process."
+ :group 'nix-build-log-faces)
+
+(defface nix-build-log-phase-name
+ '((t :inherit font-lock-function-name-face))
+ "Face for a phase name."
+ :group 'nix-build-log-faces)
+
+(defface nix-build-log-phase-start
+ '((default :weight bold)
+ (((class grayscale) (background light)) :foreground "Gray90")
+ (((class grayscale) (background dark)) :foreground "DimGray")
+ (((class color) (min-colors 16) (background light))
+ :foreground "DarkGreen")
+ (((class color) (min-colors 16) (background dark))
+ :foreground "LimeGreen")
+ (((class color) (min-colors 8)) :foreground "green"))
+ "Face for the start line of a phase."
+ :group 'nix-build-log-faces)
+
+(defface nix-build-log-phase-end
+ '((((class grayscale) (background light)) :foreground "Gray90")
+ (((class grayscale) (background dark)) :foreground "DimGray")
+ (((class color) (min-colors 16) (background light))
+ :foreground "ForestGreen")
+ (((class color) (min-colors 16) (background dark))
+ :foreground "LightGreen")
+ (((class color) (min-colors 8)) :foreground "green")
+ (t :weight bold))
+ "Face for the end line of a phase."
+ :group 'nix-build-log-faces)
+
+(defface nix-build-log-phase-success
+ '((t))
+ "Face for the 'succeeded' word of a phase line."
+ :group 'nix-build-log-faces)
+
+(defface nix-build-log-phase-fail
+ '((t :inherit error))
+ "Face for the 'failed' word of a phase line."
+ :group 'nix-build-log-faces)
+
+(defface nix-build-log-phase-seconds
+ '((t :inherit font-lock-constant-face))
+ "Face for the number of seconds for a phase."
+ :group 'nix-build-log-faces)
+
+(defcustom nix-build-log-mode-hook '()
+ "Hook run after `nix-build-log-mode' is entered."
+ :type 'hook
+ :group 'nix-build-log)
+
+(defvar nix-build-log-phase-name-regexp "`\\([^']+\\)'"
+ "Regexp for a phase name.")
+
+(defvar nix-build-log-phase-start-regexp
+ (concat "^starting phase " nix-build-log-phase-name-regexp)
+ "Regexp for the start line of a 'build' phase.")
+
+(defun nix-build-log-title-regexp (&optional state)
+ "Return regexp for the log title.
+STATE is a symbol denoting a state of the title. It should be
+`start', `fail', `success' or `nil' (for a regexp matching any
+state)."
+ (let* ((word-rx (rx (1+ (any word "-"))))
+ (state-rx (cond ((eq state 'start) (concat word-rx "started"))
+ ((eq state 'success) (concat word-rx "succeeded"))
+ ((eq state 'fail) (concat word-rx "failed"))
+ (t word-rx))))
+ (rx-to-string
+ `(and bol (group "@") " " (group (regexp ,state-rx)))
+ t)))
+
+(defun nix-build-log-phase-end-regexp (&optional state)
+ "Return regexp for the end line of a 'build' phase.
+STATE is a symbol denoting how a build phase was ended. It should be
+`fail', `success' or `nil' (for a regexp matching any state)."
+ (let ((state-rx (cond ((eq state 'success) "succeeded")
+ ((eq state 'fail) "failed")
+ (t (regexp-opt '("succeeded" "failed"))))))
+ (rx-to-string
+ `(and bol "phase " (regexp ,nix-build-log-phase-name-regexp)
+ " " (group (regexp ,state-rx)) " after "
+ (group (1+ (or digit "."))) " seconds")
+ t)))
+
+(defvar nix-build-log-phase-end-regexp
+ ;; For efficiency, it is better to have a regexp for the general line
+ ;; of the phase end, then to call the function all the time.
+ (nix-build-log-phase-end-regexp)
+ "Regexp for the end line of a 'build' phase.")
+
+(defvar nix-build-log-font-lock-keywords
+ `((,(nix-build-log-title-regexp 'start)
+ (1 'nix-build-log-title-head)
+ (2 'nix-build-log-title-start))
+ (,(nix-build-log-title-regexp 'success)
+ (1 'nix-build-log-title-head)
+ (2 'nix-build-log-title-success))
+ (,(nix-build-log-title-regexp 'fail)
+ (1 'nix-build-log-title-head)
+ (2 'nix-build-log-title-fail))
+ (,(nix-build-log-title-regexp)
+ (1 'nix-build-log-title-head)
+ (2 'nix-build-log-title-end))
+ (,nix-build-log-phase-start-regexp
+ (0 'nix-build-log-phase-start)
+ (1 'nix-build-log-phase-name prepend))
+ (,(nix-build-log-phase-end-regexp 'success)
+ (0 'nix-build-log-phase-end)
+ (1 'nix-build-log-phase-name prepend)
+ (2 'nix-build-log-phase-success prepend)
+ (3 'nix-build-log-phase-seconds prepend))
+ (,(nix-build-log-phase-end-regexp 'fail)
+ (0 'nix-build-log-phase-end)
+ (1 'nix-build-log-phase-name prepend)
+ (2 'nix-build-log-phase-fail prepend)
+ (3 'nix-build-log-phase-seconds prepend)))
+ "A list of `font-lock-keywords' for `nix-build-log-mode'.")
+
+(defvar nix-build-log-common-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "M-n") 'nix-build-log-next-phase)
+ (define-key map (kbd "M-p") 'nix-build-log-previous-phase)
+ (define-key map (kbd "TAB") 'nix-build-log-phase-toggle)
+ (define-key map (kbd "<tab>") 'nix-build-log-phase-toggle)
+ (define-key map (kbd "<backtab>") 'nix-build-log-phase-toggle-all)
+ (define-key map [(shift tab)] 'nix-build-log-phase-toggle-all)
+ map)
+ "Parent keymap for 'build-log' buffers.
+For `nix-build-log-mode' this map is used as is.
+For `nix-build-log-minor-mode' this map is prefixed with 'C-c'.")
+
+(defvar nix-build-log-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent
+ map (make-composed-keymap (list nix-build-log-common-map)
+ special-mode-map))
+ (define-key map (kbd "c") 'compilation-shell-minor-mode)
+ (define-key map (kbd "v") 'view-mode)
+ map)
+ "Keymap for `nix-build-log-mode' buffers.")
+
+(defvar nix-build-log-minor-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c") nix-build-log-common-map)
+ map)
+ "Keymap for `nix-build-log-minor-mode' buffers.")
+
+(defun nix-build-log-phase-start (&optional with-header?)
+ "Return the start point of the current build phase.
+If WITH-HEADER? is non-nil, do not skip 'starting phase ...' header.
+Return nil, if there is no phase start before the current point."
+ (save-excursion
+ (end-of-line)
+ (when (re-search-backward nix-build-log-phase-start-regexp nil t)
+ (unless with-header? (end-of-line))
+ (point))))
+
+(defun nix-build-log-phase-end ()
+ "Return the end point of the current build phase."
+ (save-excursion
+ (beginning-of-line)
+ (when (re-search-forward nix-build-log-phase-end-regexp nil t)
+ (point))))
+
+(defun nix-build-log-phase-hide ()
+ "Hide the body of the current build phase."
+ (interactive)
+ (let ((beg (nix-build-log-phase-start))
+ (end (nix-build-log-phase-end)))
+ (when (and beg end)
+ ;; If not on the header line, move to it.
+ (when (and (> (point) beg)
+ (< (point) end))
+ (goto-char (nix-build-log-phase-start t)))
+ (remove-overlays beg end 'invisible t)
+ (let ((o (make-overlay beg end)))
+ (overlay-put o 'evaporate t)
+ (overlay-put o 'invisible t)))))
+
+(defun nix-build-log-phase-show ()
+ "Show the body of the current build phase."
+ (interactive)
+ (let ((beg (nix-build-log-phase-start))
+ (end (nix-build-log-phase-end)))
+ (when (and beg end)
+ (remove-overlays beg end 'invisible t))))
+
+(defun nix-build-log-phase-hidden-p ()
+ "Return non-nil, if the body of the current build phase is hidden."
+ (let ((beg (nix-build-log-phase-start)))
+ (and beg
+ (cl-some (lambda (o)
+ (overlay-get o 'invisible))
+ (overlays-at beg)))))
+
+(defun nix-build-log-phase-toggle-function ()
+ "Return a function to toggle the body of the current build phase."
+ (if (nix-build-log-phase-hidden-p)
+ #'nix-build-log-phase-show
+ #'nix-build-log-phase-hide))
+
+(defun nix-build-log-phase-toggle ()
+ "Show/hide the body of the current build phase."
+ (interactive)
+ (funcall (nix-build-log-phase-toggle-function)))
+
+(defun nix-build-log-phase-toggle-all ()
+ "Show/hide the bodies of all build phases."
+ (interactive)
+ (save-excursion
+ ;; Some phases may be hidden, and some shown. Whether to hide or to
+ ;; show them, it is determined by the state of the first phase here.
+ (goto-char (point-min))
+ (let ((fun (save-excursion
+ (re-search-forward nix-build-log-phase-start-regexp nil t)
+ (nix-build-log-phase-toggle-function))))
+ (while (re-search-forward nix-build-log-phase-start-regexp nil t)
+ (funcall fun)))))
+
+(defun nix-build-log-next-phase (&optional arg)
+ "Move to the next build phase.
+With ARG, do it that many times. Negative ARG means move
+backward."
+ (interactive "^p")
+ (if arg
+ (when (zerop arg) (user-error "Try again"))
+ (setq arg 1))
+ (let ((search-fun (if (> arg 0)
+ #'re-search-forward
+ #'re-search-backward))
+ (n (abs arg))
+ found last-found)
+ (save-excursion
+ (end-of-line (if (> arg 0) 1 0)) ; skip the current line
+ (while (and (not (zerop n))
+ (setq found
+ (funcall search-fun
+ nix-build-log-phase-start-regexp
+ nil t)))
+ (setq n (1- n)
+ last-found found)))
+ (when last-found
+ (goto-char last-found)
+ (forward-line 0))
+ (or found
+ (user-error (if (> arg 0)
+ "No next build phase"
+ "No previous build phase")))))
+
+(defun nix-build-log-previous-phase (&optional arg)
+ "Move to the previous build phase.
+With ARG, do it that many times. Negative ARG means move
+forward."
+ (interactive "^p")
+ (nix-build-log-next-phase (- (or arg 1))))
+
+;;;###autoload
+(define-derived-mode nix-build-log-mode special-mode
+ "Nix-Build-Log"
+ "Major mode for viewing Guix build logs.
+
+\\{nix-build-log-mode-map}"
+ (setq font-lock-defaults '(nix-build-log-font-lock-keywords t)))
+
+;;;###autoload
+(define-minor-mode nix-build-log-minor-mode
+ "Toggle Guix Build Log minor mode.
+
+With a prefix argument ARG, enable Guix Build Log minor mode if
+ARG is positive, and disable it otherwise. If called from Lisp,
+enable the mode if ARG is omitted or nil.
+
+When Guix Build Log minor mode is enabled, it highlights build
+log in the current buffer. This mode can be enabled
+programmatically using hooks, like this:
+
+ (add-hook 'shell-mode-hook 'nix-build-log-minor-mode)
+
+\\{nix-build-log-minor-mode-map}"
+ :init-value nil
+ :lighter " Nix-Build-Log"
+ :keymap nix-build-log-minor-mode-map
+ :group 'nix-build-log
+ (if nix-build-log-minor-mode
+ (font-lock-add-keywords nil nix-build-log-font-lock-keywords)
+ (font-lock-remove-keywords nil nix-build-log-font-lock-keywords))
+ (nix-font-lock-flush))
+
+(defun nix-build-log-find-file (file-or-url)
+ "Open FILE-OR-URL in `nix-build-log-mode'."
+ (nix-find-file-or-url file-or-url)
+ (nix-build-log-mode))
+
+;;;###autoload
+(add-to-list 'auto-mode-alist
+ ;; Regexp for log files (usually placed in /var/log/guix/...)
+ (cons (rx "/guix/drvs/" (= 2 alnum) "/" (= 30 alnum)
+ "-" (+ (any alnum "-+.")) ".drv" string-end)
+ 'nix-build-log-mode))
+
+(provide 'nix-build-log)
+
+;;; nix-build-log.el ends here
diff --git a/nix-devel.el b/nix-devel.el
new file mode 100644
index 0000000000..b24634e248
--- /dev/null
+++ b/nix-devel.el
@@ -0,0 +1,390 @@
+;;; nix-devel.el --- Development tools -*- lexical-binding: t -*-
+
+;; Copyright © 2015–2017 Alex Kost <alezost@gmail.com>
+
+;; This file is part of Emacs-Guix.
+
+;; Emacs-Guix 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 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 Emacs-Guix. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides `nix-devel-mode' (minor mode for `scheme-mode'
+;; buffers) that provides highlighting and indentation rules for Guix
+;; Guile code, as well as some tools to work with Guix (or even an
+;; arbitrary Guile code) with Geiser.
+
+;;; Code:
+
+(require 'lisp-mode)
+(require 'bui-utils)
+(require 'guix nil t)
+(require 'nix-utils)
+(require 'nix-guile)
+(require 'nix-geiser)
+(require 'nix-misc)
+
+(defgroup nix-devel nil
+ "Settings for Guix development utils."
+ :group 'guix)
+
+(defgroup nix-devel-faces nil
+ "Faces for `nix-devel-mode'."
+ :group 'nix-devel
+ :group 'nix-faces)
+
+(defface nix-devel-modify-phases-keyword
+ '((t :inherit font-lock-preprocessor-face))
+ "Face for a `modify-phases' keyword ('delete', 'replace', etc.)."
+ :group 'nix-devel-faces)
+
+(defface nix-devel-gexp-symbol
+ '((t :inherit font-lock-keyword-face))
+ "Face for gexp symbols ('#~', '#$', etc.).
+See Info node `(guix) G-Expressions'."
+ :group 'nix-devel-faces)
+
+(defun nix-devel-use-modules (&rest modules)
+ "Use guile MODULES."
+ (apply #'nix-geiser-call "use-modules" modules))
+
+(defun nix-devel-use-module (&optional module)
+ "Use guile MODULE in the current Geiser REPL.
+MODULE is a string with the module name - e.g., \"(ice-9 match)\".
+Interactively, use the module defined by the current scheme file."
+ (interactive (list (nix-guile-current-module)))
+ (nix-devel-use-modules module)
+ (message "Using %s module." module))
+
+(defun nix-devel-copy-module-as-kill ()
+ "Put the name of the current guile module into `kill-ring'."
+ (interactive)
+ (bui-copy-as-kill (nix-guile-current-module)))
+
+(defun nix-devel-setup-repl (&optional repl)
+ "Setup REPL for using `nix-devel-...' commands."
+ (nix-devel-use-modules "(guix monad-repl)"
+ "(guix scripts)"
+ "(guix store)"
+ "(guix ui)")
+ ;; Without this workaround, the warning/build output disappears. See
+ ;; <https://github.com/jaor/geiser/issues/83> for details.
+ (nix-geiser-eval-in-repl-synchronously
+ "(begin
+ (nix-warning-port (current-warning-port))
+ (current-build-output-port (current-error-port)))"
+ repl 'no-history 'no-display))
+
+(defvar nix-devel-repl-processes nil
+ "List of REPL processes configured by `nix-devel-setup-repl'.")
+
+(defun nix-devel-setup-repl-maybe (&optional repl)
+ "Setup (if needed) REPL for using `nix-devel-...' commands."
+ (let ((process (get-buffer-process (or repl (nix-geiser-repl)))))
+ (when (and process
+ (not (memq process nix-devel-repl-processes)))
+ (nix-devel-setup-repl repl)
+ (push process nix-devel-repl-processes))))
+
+(defmacro nix-devel-with-definition (def-var &rest body)
+ "Run BODY with the current guile definition bound to DEF-VAR.
+Bind DEF-VAR variable to the name of the current top-level
+definition, setup the current REPL, use the current module, and
+run BODY."
+ (declare (indent 1) (debug (symbolp body)))
+ `(let ((,def-var (nix-guile-current-definition)))
+ (nix-devel-setup-repl-maybe)
+ (nix-devel-use-modules (nix-guile-current-module))
+ ,@body))
+
+(defun nix-devel-build-package-definition ()
+ "Build a package defined by the current top-level variable definition."
+ (interactive)
+ (nix-devel-with-definition def
+ (when (or (not nix-operation-confirm)
+ (nix-operation-prompt (format "Build '%s'?" def)))
+ (nix-geiser-eval-in-repl
+ (concat ",run-in-store "
+ (nix-guile-make-call-expression
+ "build-package" def
+ "#:use-substitutes?" (nix-guile-boolean
+ nix-use-substitutes)
+ "#:dry-run?" (nix-guile-boolean nix-dry-run)))))))
+
+(defun nix-devel-build-package-source ()
+ "Build the source of the current package definition."
+ (interactive)
+ (nix-devel-with-definition def
+ (when (or (not nix-operation-confirm)
+ (nix-operation-prompt
+ (format "Build '%s' package source?" def)))
+ (nix-geiser-eval-in-repl
+ (concat ",run-in-store "
+ (nix-guile-make-call-expression
+ "build-package-source" def
+ "#:use-substitutes?" (nix-guile-boolean
+ nix-use-substitutes)
+ "#:dry-run?" (nix-guile-boolean nix-dry-run)))))))
+
+(defun nix-devel-download-package-source ()
+ "Download the source of the current package.
+Use this function to compute SHA256 hash of the package source."
+ (interactive)
+ (nix-devel-with-definition def
+ (nix-devel-use-modules "(guix packages)"
+ "(guix scripts download)")
+ (when (or (not nix-operation-confirm)
+ (y-or-n-p (format "Download '%s' package source?" def)))
+ (nix-geiser-eval-in-repl
+ (format "(nix-download (origin-uri (package-source %s)))"
+ def)))))
+
+(defun nix-devel-lint-package ()
+ "Check the current package.
+See Info node `(guix) Invoking guix lint' for details."
+ (interactive)
+ (nix-devel-with-definition def
+ (nix-devel-use-modules "(guix scripts lint)")
+ (when (or (not nix-operation-confirm)
+ (y-or-n-p (format "Lint '%s' package?"
def)))
+ (nix-geiser-eval-in-repl
+ (format "(run-checkers %s)" def)))))
+
+;;; Font-lock
+
+(defvar nix-devel-modify-phases-keyword-regexp
+ (rx (or "delete" "replace" "add-before" "add-after"))
+ "Regexp for a 'modify-phases' keyword.")
+
+(defun nix-devel-modify-phases-font-lock-matcher (limit)
+ "Find a 'modify-phases' keyword.
+This function is used as a MATCHER for `font-lock-keywords'."
+ (ignore-errors
+ (down-list)
+ (or (re-search-forward nix-devel-modify-phases-keyword-regexp
+ limit t)
+ (set-match-data nil))
+ (up-list)
+ t))
+
+(defun nix-devel-modify-phases-font-lock-pre ()
+ "Skip the next sexp, and return the end point of the current list.
+This function is used as a PRE-MATCH-FORM for `font-lock-keywords'
+to find 'modify-phases' keywords."
+ (let ((in-comment? (nth 4 (syntax-ppss))))
+ ;; If 'modify-phases' is commented, do not try to search for its
+ ;; keywords.
+ (unless in-comment?
+ (ignore-errors (forward-sexp))
+ (save-excursion (up-list) (point)))))
+
+(defconst nix-devel-keywords
+ '("call-with-compressed-output-port"
+ "call-with-container"
+ "call-with-decompressed-port"
+ "call-with-derivation-narinfo"
+ "call-with-derivation-substitute"
+ "call-with-error-handling"
+ "call-with-gzip-input-port"
+ "call-with-gzip-output-port"
+ "call-with-temporary-directory"
+ "call-with-temporary-output-file"
+ "define-enumerate-type"
+ "define-gexp-compiler"
+ "define-lift"
+ "define-monad"
+ "define-operation"
+ "define-record-type*"
+ "emacs-substitute-sexps"
+ "emacs-substitute-variables"
+ "mbegin"
+ "mlambda"
+ "mlambdaq"
+ "mlet"
+ "mlet*"
+ "modify-services"
+ "munless"
+ "mwhen"
+ "run-with-state"
+ "run-with-store"
+ "signature-case"
+ "substitute*"
+ "substitute-keyword-arguments"
+ "test-assertm"
+ "use-package-modules"
+ "use-service-modules"
+ "use-system-modules"
+ "with-atomic-file-output"
+ "with-atomic-file-replacement"
+ "with-derivation-narinfo"
+ "with-derivation-substitute"
+ "with-directory-excursion"
+ "with-error-handling"
+ "with-imported-modules"
+ "with-monad"
+ "with-mutex"
+ "with-store"))
+
+(defvar nix-devel-font-lock-keywords
+ `((,(rx (or "#~" "#$" "#$@" "#+" "#+@")) .
+ 'nix-devel-gexp-symbol)
+ (,(nix-guile-keyword-regexp (regexp-opt nix-devel-keywords))
+ (1 'font-lock-keyword-face))
+ (,(nix-guile-keyword-regexp "modify-phases")
+ (1 'font-lock-keyword-face)
+ (nix-devel-modify-phases-font-lock-matcher
+ (nix-devel-modify-phases-font-lock-pre)
+ nil
+ (0 'nix-devel-modify-phases-keyword nil t))))
+ "A list of `font-lock-keywords' for `nix-devel-mode'.")
+
+;;; Indentation
+
+(defmacro nix-devel-scheme-indent (&rest rules)
+ "Set `scheme-indent-function' according to RULES.
+Each rule should have a form (SYMBOL VALUE). See `put' for details."
+ (declare (indent 0))
+ `(progn
+ ,@(mapcar (lambda (rule)
+ `(put ',(car rule) 'scheme-indent-function ,(cadr rule)))
+ rules)))
+
+(defun nix-devel-indent-package (state indent-point normal-indent)
+ "Indentation rule for 'package' form."
+ (let* ((package-eol (line-end-position))
+ (count (if (and (ignore-errors (down-list) t)
+ (< (point) package-eol)
+ (looking-at "inherit\\>"))
+ 1
+ 0)))
+ (lisp-indent-specform count state indent-point normal-indent)))
+
+(defun nix-devel-indent-modify-phases-keyword (count)
+ "Return indentation function for 'modify-phases' keywords."
+ (lambda (state indent-point normal-indent)
+ (when (ignore-errors
+ (goto-char (nth 1 state)) ; start of keyword sexp
+ (backward-up-list)
+ (looking-at "(modify-phases\\>"))
+ (lisp-indent-specform count state indent-point normal-indent))))
+
+(defalias 'nix-devel-indent-modify-phases-keyword-1
+ (nix-devel-indent-modify-phases-keyword 1))
+(defalias 'nix-devel-indent-modify-phases-keyword-2
+ (nix-devel-indent-modify-phases-keyword 2))
+
+(nix-devel-scheme-indent
+ (bag 0)
+ (build-system 0)
+ (call-with-compressed-output-port 2)
+ (call-with-container 1)
+ (call-with-gzip-input-port 1)
+ (call-with-gzip-output-port 1)
+ (call-with-decompressed-port 2)
+ (call-with-error-handling 0)
+ (container-excursion 1)
+ (emacs-batch-edit-file 1)
+ (emacs-batch-eval 0)
+ (emacs-substitute-sexps 1)
+ (emacs-substitute-variables 1)
+ (file-system 0)
+ (graft 0)
+ (manifest-entry 0)
+ (manifest-pattern 0)
+ (mbegin 1)
+ (mlambda 1)
+ (mlambdaq 1)
+ (mlet 2)
+ (mlet* 2)
+ (modify-phases 1)
+ (modify-services 1)
+ (munless 1)
+ (mwhen 1)
+ (operating-system 0)
+ (origin 0)
+ (package 'nix-devel-indent-package)
+ (run-with-state 1)
+ (run-with-store 1)
+ (signature-case 1)
+ (substitute* 1)
+ (substitute-keyword-arguments 1)
+ (test-assertm 1)
+ (with-atomic-file-output 1)
+ (with-derivation-narinfo 1)
+ (with-derivation-substitute 2)
+ (with-directory-excursion 1)
+ (with-error-handling 0)
+ (with-imported-modules 1)
+ (with-monad 1)
+ (with-mutex 1)
+ (with-store 1)
+ (wrap-program 1)
+
+ ;; 'modify-phases' keywords:
+ (replace 'nix-devel-indent-modify-phases-keyword-1)
+ (add-after 'nix-devel-indent-modify-phases-keyword-2)
+ (add-before 'nix-devel-indent-modify-phases-keyword-2))
+
+(defvar nix-devel-keys-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "b") 'nix-devel-build-package-definition)
+ (define-key map (kbd "s") 'nix-devel-build-package-source)
+ (define-key map (kbd "d") 'nix-devel-download-package-source)
+ (define-key map (kbd "l") 'nix-devel-lint-package)
+ (define-key map (kbd "k") 'nix-devel-copy-module-as-kill)
+ (define-key map (kbd "u") 'nix-devel-use-module)
+ map)
+ "Keymap with subkeys for `nix-devel-mode-map'.")
+
+(defvar nix-devel-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c .") nix-devel-keys-map)
+ map)
+ "Keymap for `nix-devel-mode'.")
+
+;;;###autoload
+(define-minor-mode nix-devel-mode
+ "Minor mode for `scheme-mode' buffers.
+
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
+
+When Guix Devel mode is enabled, it highlights various Guix
+keywords. This mode can be enabled programmatically using hooks,
+like this:
+
+ (add-hook 'scheme-mode-hook 'nix-devel-mode)
+
+\\{nix-devel-mode-map}"
+ :init-value nil
+ :lighter " Nix"
+ :keymap nix-devel-mode-map
+ (if nix-devel-mode
+ (progn
+ (setq-local font-lock-multiline t)
+ (font-lock-add-keywords nil nix-devel-font-lock-keywords))
+ (setq-local font-lock-multiline nil)
+ (font-lock-remove-keywords nil nix-devel-font-lock-keywords))
+ (nix-font-lock-flush))
+
+(defvar nix-devel-emacs-font-lock-keywords
+ (eval-when-compile
+ `((,(rx "(" (group "nix-devel-with-definition") symbol-end) . 1))))
+
+(font-lock-add-keywords 'emacs-lisp-mode
+ nix-devel-emacs-font-lock-keywords)
+
+(provide 'nix-devel)
+
+;;; nix-devel.el ends here
diff --git a/nix-hydra-build.el b/nix-hydra-build.el
new file mode 100644
index 0000000000..c4a76243f4
--- /dev/null
+++ b/nix-hydra-build.el
@@ -0,0 +1,370 @@
+;;; nix-hydra-build.el --- Interface for Hydra builds -*- lexical-binding: t
-*-
+
+;; Copyright © 2015–2017 Alex Kost <alezost@gmail.com>
+
+;; This file is part of Emacs-Guix.
+
+;; Emacs-Guix 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 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 Emacs-Guix. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides an interface for displaying Hydra builds in
+;; 'list' and 'info' buffers.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'bui)
+(require 'nix)
+(require 'nix-hydra)
+(require 'nix-utils)
+
+(nix-hydra-define-entry-type build
+ :search-types '((latest . nix-hydra-build-latest-api-url)
+ (queue . nix-hydra-build-queue-api-url))
+ :filters '(nix-hydra-build-filter-status)
+ :filter-names '((nixname . name)
+ (buildstatus . build-status)
+ (timestamp . time))
+ :filter-boolean-params '(finished busy))
+
+(defun nix-hydra-build-get-display (search-type &rest args)
+ "Search for Hydra builds and show results."
+ (apply #'bui-list-get-display-entries
+ 'nix-hydra-build search-type args))
+
+(cl-defun nix-hydra-build-latest-prompt-args (&key project jobset
+ job system)
+ "Prompt for and return a list of 'latest builds' arguments."
+ (let* ((number (read-number "Number of latest builds: "))
+ (project (if current-prefix-arg
+ (nix-hydra-read-project nil project)
+ project))
+ (jobset (if current-prefix-arg
+ (nix-hydra-read-jobset nil jobset)
+ jobset))
+ (job-or-name (if current-prefix-arg
+ (nix-hydra-read-job nil job)
+ job))
+ (job (and job-or-name
+ (string-match-p nix-hydra-job-regexp
+ job-or-name)
+ job-or-name))
+ (system (if (and (not job)
+ (or current-prefix-arg
+ (and job-or-name (not system))))
+ (if job-or-name
+ (guix-while-null
+ (guix-hydra-read-system
+ (concat job-or-name ".") system))
+ (guix-hydra-read-system nil system))
+ system))
+ (job (or job
+ (and job-or-name
+ (concat job-or-name "." system)))))
+ (list number
+ :project project
+ :jobset jobset
+ :job job
+ :system system)))
+
+(declare-function nix-build-log-find-file "nix-build-log" (file))
+
+(defun nix-hydra-build-view-log (id)
+ "View build log of a hydra build ID."
+ (require 'nix-build-log)
+ (nix-build-log-find-file (nix-hydra-build-log-url id)))
+
+;;; Defining URLs
+
+(defun nix-hydra-build-url (id)
+ "Return Hydra URL of a build ID."
+ (nix-hydra-url "build/" (number-to-string id)))
+
+(defun nix-hydra-build-log-url (id)
+ "Return Hydra URL of the log file of a build ID."
+ (concat (nix-hydra-build-url id) "/log/raw"))
+
+(cl-defun nix-hydra-build-latest-api-url
+ (number &key project jobset job system)
+ "Return Hydra API URL to receive latest NUMBER of builds."
+ (nix-hydra-api-url "latestbuilds"
+ `(("nr" . ,number)
+ ("project" . ,project)
+ ("jobset" . ,jobset)
+ ("job" . ,job)
+ ("system" . ,system))))
+
+(defun nix-hydra-build-queue-api-url (number)
+ "Return Hydra API URL to receive the NUMBER of queued builds."
+ (nix-hydra-api-url "queue"
+ `(("nr" . ,number))))
+
+;;; Filters for processing raw entries
+
+(defun nix-hydra-build-filter-status (entry)
+ "Add 'status' parameter to 'hydra-build' ENTRY."
+ (let ((status (if (bui-entry-non-void-value entry 'finished)
+ (nix-hydra-build-status-number->name
+ (bui-entry-non-void-value entry 'build-status))
+ (if (bui-entry-non-void-value entry 'busy)
+ 'running
+ 'scheduled))))
+ (cons `(status . ,status)
+ entry)))
+
+;;; Build status
+
+(defface nix-hydra-build-status-running
+ '((t :inherit bold))
+ "Face used if hydra build is not finished."
+ :group 'nix-hydra-build-faces)
+
+(defface nix-hydra-build-status-scheduled
+ '((t))
+ "Face used if hydra build is scheduled."
+ :group 'nix-hydra-build-faces)
+
+(defface nix-hydra-build-status-succeeded
+ '((t :inherit success))
+ "Face used if hydra build succeeded."
+ :group 'nix-hydra-build-faces)
+
+(defface nix-hydra-build-status-cancelled
+ '((t :inherit warning))
+ "Face used if hydra build was cancelled."
+ :group 'nix-hydra-build-faces)
+
+(defface nix-hydra-build-status-failed
+ '((t :inherit error))
+ "Face used if hydra build failed."
+ :group 'nix-hydra-build-faces)
+
+(defvar nix-hydra-build-status-alist
+ '((0 . succeeded)
+ (1 . failed-build)
+ (2 . failed-dependency)
+ (3 . failed-other)
+ (4 . cancelled))
+ "Alist of hydra build status numbers and status names.
+Status numbers are returned by Hydra API, names (symbols) are
+used internally by the elisp code of this package.")
+
+(defun nix-hydra-build-status-number->name (number)
+ "Convert build status number to a name.
+See `nix-hydra-build-status-alist'."
+ (bui-assq-value nix-hydra-build-status-alist number))
+
+(defun nix-hydra-build-status-string (status)
+ "Return a human readable string for build STATUS."
+ (cl-case status
+ (scheduled
+ (bui-get-string "Scheduled" 'nix-hydra-build-status-scheduled))
+ (running
+ (bui-get-string "Running" 'nix-hydra-build-status-running))
+ (succeeded
+ (bui-get-string "Succeeded" 'nix-hydra-build-status-succeeded))
+ (cancelled
+ (bui-get-string "Cancelled" 'nix-hydra-build-status-cancelled))
+ (failed-build
+ (nix-hydra-build-status-fail-string))
+ (failed-dependency
+ (nix-hydra-build-status-fail-string "dependency"))
+ (failed-other
+ (nix-hydra-build-status-fail-string "other"))))
+
+(defun nix-hydra-build-status-fail-string (&optional reason)
+ "Return a string for a failed build."
+ (let ((base (bui-get-string "Failed" 'nix-hydra-build-status-failed)))
+ (if reason
+ (concat base " (" reason ")")
+ base)))
+
+(defun nix-hydra-build-finished? (entry)
+ "Return non-nil, if hydra build was finished."
+ (bui-entry-non-void-value entry 'finished))
+
+(defun nix-hydra-build-running? (entry)
+ "Return non-nil, if hydra build is running."
+ (eq (bui-entry-non-void-value entry 'status)
+ 'running))
+
+(defun nix-hydra-build-scheduled? (entry)
+ "Return non-nil, if hydra build is scheduled."
+ (eq (bui-entry-non-void-value entry 'status)
+ 'scheduled))
+
+(defun nix-hydra-build-succeeded? (entry)
+ "Return non-nil, if hydra build succeeded."
+ (eq (bui-entry-non-void-value entry 'status)
+ 'succeeded))
+
+(defun nix-hydra-build-cancelled? (entry)
+ "Return non-nil, if hydra build was cancelled."
+ (eq (bui-entry-non-void-value entry 'status)
+ 'cancelled))
+
+(defun nix-hydra-build-failed? (entry)
+ "Return non-nil, if hydra build failed."
+ (memq (bui-entry-non-void-value entry 'status)
+ '(failed-build failed-dependency failed-other)))
+
+;;; Hydra build 'info'
+
+(nix-hydra-define-interface build info
+ :mode-name "Hydra-Build-Info"
+ :buffer-name "*Hydra Build Info*"
+ :format '((name nil (simple bui-info-heading))
+ nil
+ nix-hydra-build-info-insert-url
+ (time format (time))
+ (status format nix-hydra-build-info-insert-status)
+ (project format (format nix-hydra-build-project))
+ (jobset format (format nix-hydra-build-jobset))
+ (job format (format nix-hydra-build-job))
+ (system format (format nix-hydra-build-system))
+ (priority format (format))))
+
+(defface nix-hydra-build-info-project
+ '((t :inherit link))
+ "Face for project names."
+ :group 'nix-hydra-build-info-faces)
+
+(defface nix-hydra-build-info-jobset
+ '((t :inherit link))
+ "Face for jobsets."
+ :group 'nix-hydra-build-info-faces)
+
+(defface nix-hydra-build-info-job
+ '((t :inherit link))
+ "Face for jobs."
+ :group 'nix-hydra-build-info-faces)
+
+(defface nix-hydra-build-info-system
+ '((t :inherit link))
+ "Face for system names."
+ :group 'nix-hydra-build-info-faces)
+
+(defmacro nix-hydra-build-define-button (name)
+ "Define `nix-hydra-build-NAME' button."
+ (let* ((name-str (symbol-name name))
+ (button-name (intern (concat "nix-hydra-build-" name-str)))
+ (face-name (intern (concat "nix-hydra-build-info-" name-str)))
+ (keyword (intern (concat ":" name-str))))
+ `(define-button-type ',button-name
+ :supertype 'bui
+ 'face ',face-name
+ 'help-echo ,(format "\
+Show latest builds for this %s (with prefix, prompt for all parameters)"
+ name-str)
+ 'action (lambda (btn)
+ (let ((args (nix-hydra-build-latest-prompt-args
+ ,keyword (button-label btn))))
+ (apply #'nix-hydra-build-get-display
+ 'latest args))))))
+
+(nix-hydra-build-define-button project)
+(nix-hydra-build-define-button jobset)
+(nix-hydra-build-define-button job)
+(nix-hydra-build-define-button system)
+
+(defun nix-hydra-build-info-insert-url (entry)
+ "Insert Hydra URL for the build ENTRY."
+ (bui-insert-button (nix-hydra-build-url (bui-entry-id entry))
+ 'bui-url)
+ (when (nix-hydra-build-finished? entry)
+ (bui-insert-indent)
+ (bui-insert-action-button
+ "Build log"
+ (lambda (btn)
+ (nix-hydra-build-view-log (button-get btn 'id)))
+ "View build log"
+ 'id (bui-entry-id entry)))
+ (bui-newline))
+
+(defun nix-hydra-build-info-insert-status (status &optional _)
+ "Insert a string with build STATUS."
+ (insert (nix-hydra-build-status-string status)))
+
+;;; Hydra build 'list'
+
+(nix-hydra-define-interface build list
+ :describe-function 'nix-hydra-list-describe
+ :mode-name "Hydra-Build-List"
+ :buffer-name "*Nix Hydra Builds*"
+ :format '((name nil 30 t)
+ (system nil 16 t)
+ (status nix-hydra-build-list-get-status 20 t)
+ (project nil 10 t)
+ (jobset nil 17 t)
+ (time bui-list-get-time 20 t))
+ :hint 'nix-hydra-build-list-hint)
+
+(let ((map nix-hydra-build-list-mode-map))
+ (define-key map (kbd "B") 'nix-hydra-build-list-latest-builds)
+ (define-key map (kbd "L") 'nix-hydra-build-list-view-log))
+
+(defvar nix-hydra-build-list-default-hint
+ '(("\\[nix-hydra-build-list-latest-builds]")
+ " show latest builds of the current job;\n"
+ ("\\[nix-hydra-build-list-view-log]") " show build log;\n"))
+
+(defun nix-hydra-build-list-hint ()
+ (bui-format-hints
+ nix-hydra-build-list-default-hint
+ (bui-default-hint)))
+
+(defun nix-hydra-build-list-get-status (status &optional _)
+ "Return a string for build STATUS."
+ (nix-hydra-build-status-string status))
+
+(defun nix-hydra-build-list-latest-builds (number &rest args)
+ "Display latest NUMBER of Hydra builds of the current job.
+Interactively, prompt for NUMBER. With prefix argument, prompt
+for all ARGS."
+ (interactive
+ (let ((entry (bui-list-current-entry)))
+ (nix-hydra-build-latest-prompt-args
+ :project (bui-entry-non-void-value entry 'project)
+ :jobset (bui-entry-non-void-value entry 'name)
+ :job (bui-entry-non-void-value entry 'job)
+ :system (bui-entry-non-void-value entry 'system))))
+ (apply #'nix-hydra-latest-builds number args))
+
+(defun nix-hydra-build-list-view-log ()
+ "View build log of the current Hydra build."
+ (interactive)
+ (nix-hydra-build-view-log (bui-list-current-id)))
+
+;;; Interactive commands
+
+;;;###autoload
+(defun nix-hydra-latest-builds (number &rest args)
+ "Display latest NUMBER of Hydra builds.
+ARGS are the same arguments as for `nix-hydra-build-latest-api-url'.
+Interactively, prompt for NUMBER. With prefix argument, prompt
+for all ARGS."
+ (interactive (nix-hydra-build-latest-prompt-args))
+ (apply #'nix-hydra-build-get-display
+ 'latest number args))
+
+;;;###autoload
+(defun nix-hydra-queued-builds (number)
+ "Display the NUMBER of queued Hydra builds."
+ (interactive "NNumber of queued builds: ")
+ (nix-hydra-build-get-display 'queue number))
+
+(provide 'nix-hydra-build)
+
+;;; nix-hydra-build.el ends here
diff --git a/nix-hydra-jobset.el b/nix-hydra-jobset.el
new file mode 100644
index 0000000000..d826d85852
--- /dev/null
+++ b/nix-hydra-jobset.el
@@ -0,0 +1,166 @@
+;;; guix-hydra-jobset.el --- Interface for Hydra jobsets -*- lexical-binding:
t -*-
+
+;; Copyright © 2015–2017 Alex Kost <alezost@gmail.com>
+
+;; This file is part of Emacs-Guix.
+
+;; Emacs-Guix 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 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 Emacs-Guix. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides an interface for displaying Hydra jobsets in
+;; 'list' and 'info' buffers.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'bui)
+(require 'nix-hydra)
+(require 'nix-hydra-build)
+
+(nix-hydra-define-entry-type jobset
+ :search-types '((project . nix-hydra-jobset-api-url))
+ :filters '(nix-hydra-jobset-filter-id)
+ :filter-names '((nrscheduled . scheduled)
+ (nrsucceeded . succeeded)
+ (nrfailed . failed)
+ (nrtotal . total)))
+
+(defun nix-hydra-jobset-get-display (search-type &rest args)
+ "Search for Hydra builds and show results."
+ (apply #'bui-list-get-display-entries
+ 'nix-hydra-jobset search-type args))
+
+;;; Defining URLs
+
+(defun nix-hydra-jobset-url (project jobset)
+ "Return Hydra URL of a PROJECT's JOBSET."
+ (nix-hydra-url "jobset/" project "/" jobset))
+
+(defun nix-hydra-jobset-api-url (project)
+ "Return Hydra API URL for jobsets by PROJECT."
+ (nix-hydra-api-url "jobsets"
+ `(("project" . ,project))))
+
+;;; Filters for processing raw entries
+
+(defun nix-hydra-jobset-filter-id (entry)
+ "Add 'ID' parameter to 'hydra-jobset' ENTRY."
+ (cons `(id . ,(bui-entry-non-void-value entry 'name))
+ entry))
+
+;;; Hydra jobset 'info'
+
+(nix-hydra-define-interface jobset info
+ :mode-name "Hydra-Jobset-Info"
+ :buffer-name "*Hydra Jobset Info*"
+ :format '((name nil (simple bui-info-heading))
+ nil
+ nix-hydra-jobset-info-insert-url
+ (project format nix-hydra-jobset-info-insert-project)
+ (scheduled format (format nix-hydra-jobset-info-scheduled))
+ (succeeded format (format nix-hydra-jobset-info-succeeded))
+ (failed format (format nix-hydra-jobset-info-failed))
+ (total format (format nix-hydra-jobset-info-total))))
+
+(defface nix-hydra-jobset-info-scheduled
+ '((t))
+ "Face used for the number of scheduled builds."
+ :group 'nix-hydra-jobset-info-faces)
+
+(defface nix-hydra-jobset-info-succeeded
+ '((t :inherit nix-hydra-build-status-succeeded))
+ "Face used for the number of succeeded builds."
+ :group 'nix-hydra-jobset-info-faces)
+
+(defface nix-hydra-jobset-info-failed
+ '((t :inherit nix-hydra-build-status-failed))
+ "Face used for the number of failed builds."
+ :group 'nix-hydra-jobset-info-faces)
+
+(defface nix-hydra-jobset-info-total
+ '((t))
+ "Face used for the total number of builds."
+ :group 'nix-hydra-jobset-info-faces)
+
+(defun nix-hydra-jobset-info-insert-project (project entry)
+ "Insert PROJECT button for the jobset ENTRY."
+ (let ((jobset (bui-entry-non-void-value entry 'name)))
+ (bui-insert-button
+ project 'nix-hydra-build-project
+ 'action (lambda (btn)
+ (let ((args (nix-hydra-build-latest-prompt-args
+ :project (button-get btn 'project)
+ :jobset (button-get btn 'jobset))))
+ (apply #'nix-hydra-build-get-display
+ 'latest args)))
+ 'project project
+ 'jobset jobset)))
+
+(defun nix-hydra-jobset-info-insert-url (entry)
+ "Insert Hydra URL for the jobset ENTRY."
+ (bui-insert-button (nix-hydra-jobset-url
+ (bui-entry-non-void-value entry 'project)
+ (bui-entry-non-void-value entry 'name))
+ 'bui-url)
+ (bui-newline))
+
+;;; Hydra jobset 'list'
+
+(nix-hydra-define-interface jobset list
+ :describe-function 'nix-hydra-list-describe
+ :mode-name "Hydra-Jobset-List"
+ :buffer-name "*Hydra Jobsets*"
+ :format '((name nil 25 t)
+ (project nil 10 t)
+ (scheduled nil 12 t)
+ (succeeded nil 12 t)
+ (failed nil 9 t)
+ (total nil 10 t))
+ :hint 'nix-hydra-jobset-list-hint)
+
+(let ((map nix-hydra-jobset-list-mode-map))
+ (define-key map (kbd "B") 'nix-hydra-jobset-list-latest-builds))
+
+(defvar nix-hydra-jobset-list-default-hint
+ '(("\\[nix-hydra-jobset-list-latest-builds]")
+ " show latest builds for the current jobset;\n"))
+
+(defun nix-hydra-jobset-list-hint ()
+ (bui-format-hints
+ nix-hydra-jobset-list-default-hint
+ (bui-default-hint)))
+
+(defun nix-hydra-jobset-list-latest-builds (number &rest args)
+ "Display latest NUMBER of Hydra builds of the current jobset.
+Interactively, prompt for NUMBER. With prefix argument, prompt
+for all ARGS."
+ (interactive
+ (let ((entry (bui-list-current-entry)))
+ (nix-hydra-build-latest-prompt-args
+ :project (bui-entry-non-void-value entry 'project)
+ :jobset (bui-entry-non-void-value entry 'name))))
+ (apply #'nix-hydra-latest-builds number args))
+
+;;; Interactive commands
+
+;;;###autoload
+(defun nix-hydra-jobsets (project)
+ "Display jobsets of PROJECT."
+ (interactive (list (nix-hydra-read-project)))
+ (nix-hydra-jobset-get-display 'project project))
+
+(provide 'nix-hydra-jobset)
+
+;;; nix-hydra-jobset.el ends here
diff --git a/nix-hydra.el b/nix-hydra.el
new file mode 100644
index 0000000000..0578959a68
--- /dev/null
+++ b/nix-hydra.el
@@ -0,0 +1,320 @@
+;;; hydra.el --- Common code for interacting with Hydra -*- lexical-binding:
t -*-
+
+;; Copyright © 2015–2017 Alex Kost <alezost@gmail.com>
+
+;; This file is part of Emacs-Guix.
+
+;; Emacs-Guix 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 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 Emacs-Guix. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides some general code for 'list'/'info' interfaces for
+;; Hydra (Guix build farm).
+
+;;; Code:
+
+(require 'json)
+(require 'bui)
+(require 'nix)
+(require 'nix-utils)
+
+(nix-define-groups hydra)
+
+(defvar nix-hydra-job-regexp
+ (concat ".*\\." (regexp-opt nix-system-types) "\\'")
+ "Regexp matching a full name of Hydra job (including system).")
+
+(defun nix-hydra-job-name-specification (name version)
+ "Return Hydra's job name specification by NAME and VERSION."
+ (concat name "-" version))
+
+(defun nix-hydra-message (entries search-type &rest _)
+ "Display a message after showing Hydra ENTRIES."
+ ;; XXX Add more messages maybe.
+ (when (null entries)
+ (if (eq search-type 'fake)
+ (message "The update is impossible due to lack of Hydra API.")
+ (message "Hydra has returned no results."))))
+
+(defun nix-hydra-list-describe (&rest ids)
+ "Describe 'hydra' entries with IDS (list of identifiers)."
+ (bui-display-entries
+ (bui-entries-by-ids (bui-current-entries) ids)
+ (bui-current-entry-type) 'info
+ ;; Hydra does not provide an API to receive builds/jobsets by
+ ;; IDs/names, so we use a 'fake' search type.
+ '(fake)
+ 'add))
+
+;;; Readers
+
+(defvar nix-hydra-projects
+ '("nixpkgs" "nix" "disnix" "gnu" "hydra" "libchop" "nixops" "nixos"
+ "node2nix" "patchelf")
+ "List of available Hydra projects.")
+
+(nix-define-readers
+ :completions-var nix-hydra-projects
+ :single-reader nix-hydra-read-project
+ :single-prompt "Project: ")
+
+(nix-define-readers
+ :require-match nil
+ :single-reader nix-hydra-read-jobset
+ :single-prompt "Jobset: ")
+
+(nix-define-readers
+ :require-match nil
+ :single-reader nix-hydra-read-job
+ :single-prompt "Job: ")
+
+(nix-define-readers
+ :completions-var nix-help-system-types
+ :single-reader nix-hydra-read-system
+ :single-prompt "System: ")
+
+;;; Defining URLs
+
+(defvar nix-hydra-url "https://hydra.nixos.org";
+ "URL of the Hydra build farm.")
+
+(defun nix-hydra-url (&rest url-parts)
+ "Return Hydra URL."
+ (apply #'concat nix-hydra-url "/" url-parts))
+
+(defun nix-hydra-api-url (type args)
+ "Return URL for receiving data using Hydra API.
+TYPE is the name of an allowed method.
+ARGS is alist of (KEY . VALUE) pairs.
+Skip ARG, if VALUE is nil or an empty string."
+ (declare (indent 1))
+ (let* ((fields (mapcar
+ (lambda (arg)
+ (pcase arg
+ (`(,key . ,value)
+ (unless (or (null value)
+ (equal "" value))
+ (concat (nix-hexify key) "="
+ (nix-hexify value))))
+ (_ (error "Wrong argument '%s'" arg))))
+ args))
+ (fields (mapconcat #'identity (delq nil fields) "&")))
+ (nix-hydra-url "api/" type "?" fields)))
+
+;;; Receiving data from Hydra
+
+(defun nix-hydra-receive-data (url)
+ "Return output received from URL and processed with `json-read'."
+ (with-temp-buffer
+ (url-insert-file-contents url)
+ (goto-char (point-min))
+ (let ((json-key-type 'symbol)
+ (json-array-type 'list)
+ (json-object-type 'alist))
+ (json-read))))
+
+(defun nix-hydra-get-entries (entry-type search-type &rest args)
+ "Receive ENTRY-TYPE entries from Hydra.
+SEARCH-TYPE is one of the types defined by `nix-hydra-define-interface'."
+ (unless (eq search-type 'fake)
+ (let* ((url (apply #'nix-hydra-search-url
+ entry-type search-type args))
+ (raw-entries (nix-hydra-receive-data url))
+ (entries (apply #'nix-modify-objects
+ raw-entries
+ (nix-hydra-filters entry-type))))
+ entries)))
+
+;;; Filters for processing raw entries
+
+(defun nix-hydra-filter-names (entry name-alist)
+ "Replace names of ENTRY parameters using NAME-ALIST.
+Each element of NAME-ALIST is (OLD-NAME . NEW-NAME) pair."
+ (mapcar (lambda (param)
+ (pcase param
+ (`(,name . ,val)
+ (let ((new-name (bui-assq-value name-alist name)))
+ (if new-name
+ (cons new-name val)
+ param)))))
+ entry))
+
+(defun nix-hydra-filter-boolean (entry params)
+ "Convert number PARAMS (0/1) of ENTRY to boolean values (nil/t)."
+ (mapcar (lambda (param)
+ (pcase param
+ (`(,name . ,val)
+ (if (memq name params)
+ (cons name (nix-number->bool val))
+ param))))
+ entry))
+
+;;; Wrappers for defined variables
+
+(defun nix-hydra-symbol (&rest symbols)
+ "Return `SYMBOLS-...' symbol."
+ (apply #'nix-make-symbol 'hydra symbols))
+
+(defun nix-hydra-symbol-value (entry-type symbol)
+ "Return SYMBOL's value for ENTRY-TYPE."
+ (symbol-value (nix-hydra-symbol entry-type symbol)))
+
+(defun nix-hydra-search-url (entry-type search-type &rest args)
+ "Return URL to receive ENTRY-TYPE entries from Hydra."
+ (apply (bui-assq-value (nix-hydra-symbol-value
+ entry-type 'search-types)
+ search-type)
+ args))
+
+(defun nix-hydra-filters (entry-type)
+ "Return a list of filters for ENTRY-TYPE."
+ (nix-hydra-symbol-value entry-type 'filters))
+
+;;; Interface definers
+
+(defmacro nix-hydra-define-entry-type (entry-type &rest args)
+ "Define general code for ENTRY-TYPE.
+Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
+
+Required keywords:
+
+ - `:search-types' - default value of the generated
+ `nix-hydra-ENTRY-TYPE-search-types' variable.
+
+Optional keywords:
+
+ - `:filters' - default value of the generated
+ `nix-hydra-ENTRY-TYPE-filters' variable.
+
+ - `:filter-names' - if specified, a generated
+ `nix-hydra-ENTRY-TYPE-filter-names' function for filtering
+ these names will be added to `nix-hydra-ENTRY-TYPE-filters'
+ variable.
+
+ - `:filter-boolean-params' - if specified, a generated
+ `nix-hydra-ENTRY-TYPE-filter-boolean' function for filtering
+ these names will be added to `nix-hydra-ENTRY-TYPE-filters'
+ variable.
+
+The rest keyword arguments are passed to
+`bui-define-entry-type' macro."
+ (declare (indent 1))
+ (let* ((entry-type-str (symbol-name entry-type))
+ (full-entry-type (nix-hydra-symbol entry-type))
+ (prefix (concat "nix-hydra-" entry-type-str))
+ (search-types-var (intern (concat prefix "-search-types")))
+ (filters-var (intern (concat prefix "-filters")))
+ (get-fun (intern (concat prefix "-get-entries"))))
+ (bui-plist-let args
+ ((search-types-val :search-types)
+ (filters-val :filters)
+ (filter-names-val :filter-names)
+ (filter-bool-val :filter-boolean-params))
+ `(progn
+ (defvar ,search-types-var ,search-types-val
+ ,(format "\
+Alist of search types and according URL functions.
+Functions are used to define URL to receive '%s' entries."
+ entry-type-str))
+
+ (defvar ,filters-var ,filters-val
+ ,(format "\
+List of filters for '%s' parameters.
+Each filter is a function that should take an entry as a single
+argument, and should also return an entry."
+ entry-type-str))
+
+ ,(when filter-bool-val
+ (let ((filter-bool-var (intern (concat prefix
+ "-filter-boolean-params")))
+ (filter-bool-fun (intern (concat prefix
+ "-filter-boolean"))))
+ `(progn
+ (defvar ,filter-bool-var ,filter-bool-val
+ ,(format "\
+List of '%s' parameters that should be transformed to boolean values."
+ entry-type-str))
+
+ (defun ,filter-bool-fun (entry)
+ ,(format "\
+Run `nix-hydra-filter-boolean' with `%S' variable."
+ filter-bool-var)
+ (nix-hydra-filter-boolean entry ,filter-bool-var))
+
+ (setq ,filters-var
+ (cons ',filter-bool-fun ,filters-var)))))
+
+ ;; Do not move this clause up!: name filtering should be
+ ;; performed before any other filtering, so this filter should
+ ;; be consed after the boolean filter.
+ ,(when filter-names-val
+ (let* ((filter-names-var (intern (concat prefix
+ "-filter-names")))
+ (filter-names-fun filter-names-var))
+ `(progn
+ (defvar ,filter-names-var ,filter-names-val
+ ,(format "\
+Alist of '%s' parameter names returned by Hydra API and names
+used internally by the elisp code of this package."
+ entry-type-str))
+
+ (defun ,filter-names-fun (entry)
+ ,(format "\
+Run `nix-hydra-filter-names' with `%S' variable."
+ filter-names-var)
+ (nix-hydra-filter-names entry ,filter-names-var))
+
+ (setq ,filters-var
+ (cons ',filter-names-fun ,filters-var)))))
+
+ (defun ,get-fun (search-type &rest args)
+ ,(format "\
+Receive '%s' entries.
+See `nix-hydra-get-entries' for details."
+ entry-type-str)
+ (apply #'nix-hydra-get-entries
+ ',entry-type search-type args))
+
+ (bui-define-groups ,full-entry-type
+ :parent-group nix-hydra
+ :parent-faces-group nix-hydra-faces)
+
+ (bui-define-entry-type ,full-entry-type
+ :message-function 'nix-hydra-message
+ ,@%foreign-args)))))
+
+(defmacro nix-hydra-define-interface (entry-type buffer-type &rest args)
+ "Define BUFFER-TYPE interface for displaying ENTRY-TYPE hydra entries.
+
+This macro should be called after calling
+`nix-hydra-define-entry-type' with the same ENTRY-TYPE.
+
+ARGS are passed to `bui-define-interface' macro."
+ (declare (indent 2))
+ `(bui-define-interface ,(nix-hydra-symbol entry-type) ,buffer-type
+ :get-entries-function ',(nix-hydra-symbol entry-type 'get-entries)
+ ,@args))
+
+(defvar nix-hydra-font-lock-keywords
+ (eval-when-compile
+ `((,(rx "(" (group (or "nix-hydra-define-entry-type"
+ "nix-hydra-define-interface"))
+ symbol-end)
+ . 1))))
+
+(font-lock-add-keywords 'emacs-lisp-mode nix-hydra-font-lock-keywords)
+
+(provide 'nix-hydra)
+
+;;; nix-hydra.el ends here
diff --git a/nix-popup.el b/nix-popup.el
new file mode 100644
index 0000000000..2dd81b0ff6
--- /dev/null
+++ b/nix-popup.el
@@ -0,0 +1,51 @@
+;;; guix-popup.el --- Popup windows library
+
+;; Copyright © 2015 Alex Kost <alezost@gmail.com>
+
+;; This file is part of Emacs-Guix.
+
+;; Emacs-Guix 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 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 Emacs-Guix. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides `guix-define-popup' macro which is just an alias
+;; to `magit-define-popup'. According to the manual:
+;;
+;; (info "(magit-popup) Defining prefix and suffix commands")
+;;
+;; `magit-popup' library will eventually be superseded by a more general
+;; library.
+
+;;; Code:
+
+(require 'magit-popup)
+
+(defalias 'guix-define-popup 'magit-define-popup)
+
+(defvar guix-popup-font-lock-keywords
+ (eval-when-compile
+ `((,(rx "("
+ (group "guix-define-popup")
+ symbol-end
+ (zero-or-more blank)
+ (zero-or-one
+ (group (one-or-more (or (syntax word) (syntax symbol))))))
+ (1 font-lock-keyword-face)
+ (2 font-lock-function-name-face nil t)))))
+
+(font-lock-add-keywords 'emacs-lisp-mode guix-popup-font-lock-keywords)
+
+(provide 'guix-popup)
+
+;;; guix-popup.el ends here
diff --git a/nix-profiles.el b/nix-profiles.el
new file mode 100644
index 0000000000..700afd1221
--- /dev/null
+++ b/nix-profiles.el
@@ -0,0 +1,202 @@
+;;; nix-profiles.el --- Guix profiles
+
+;; Copyright © 2014–2017 Alex Kost <alezost@gmail.com>
+;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
+
+;; This file is part of Emacs-Guix.
+
+;; Emacs-Guix 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 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 Emacs-Guix. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides a general code related to location and contents of
+;; Guix profiles.
+
+;;; Code:
+
+(require 'nix-utils)
+
+(defvar nix-state-directory
+ ("/nix/var/nix"))
+
+(defvar nix-user-profile
+ (expand-file-name "~/.nix-profile")
+ "User profile.")
+
+(defvar nix-system-profile
+ (concat nix-state-directory "/profiles/system")
+ "System profile.")
+
+(defvar nix-default-profile
+ (concat nix-state-directory
+ "/profiles/per-user/"
+ (getenv "USER")
+ "/profile")
+ "Default Nix profile.")
+
+(defvar nix-current-profile nix-default-profile
+ "Current Nix profile.
+It is used by various commands as the default working profile.")
+
+(defvar nix-system-profile-regexp
+ (rx-to-string `(and string-start
+ (or ,nix-system-profile
+ "/run/booted-system"
+ "/run/current-system"))
+ t)
+ "Regexp matching system profiles.")
+
+(defun nix-current-profile? (profile)
+ "Return non-nil, if package PROFILE is `nix-current-profile'."
+ (string= (nix-package-profile profile)
+ nix-current-profile))
+
+(defun nix-system-profile? (profile)
+ "Return non-nil, if PROFILE is a system one."
+ (string-match-p nix-system-profile-regexp profile))
+
+(defun nix-assert-non-system-profile (profile)
+ "Raise an error when PROFILE is a system one."
+ (when (nix-system-profile? profile)
+ (user-error "\
+Packages cannot be installed or removed to/from profile '%s'.
+Use 'guix system reconfigure' shell command to modify a system profile."
+ profile)))
+
+(defun nix-generation-file (profile generation)
+ "Return the file name of a PROFILE's GENERATION."
+ (format "%s-%s-link" profile generation))
+
+(defun nix-profile (profile)
+ "Return normalized file name of PROFILE.
+\"Normalized\" means the returned file name is expanded, does not
+have a trailing slash and it is `nix-default-profile' if PROFILE
+is `nix-user-profile'. `nix-user-profile' is special because
+it is actually a symlink to a real user profile, and the HOME
+directory does not contain profile generations."
+ (let ((profile (directory-file-name (expand-file-name profile))))
+ (if (string= profile nix-user-profile)
+ nix-default-profile
+ profile)))
+
+(defun nix-generation-profile (profile &optional generation)
+ "Return file name of PROFILE or its GENERATION.
+The returned file name is the one that have generations in the
+same parent directory.
+
+If PROFILE matches `nix-system-profile-regexp', then it is
+considered to be a system profile. Unlike usual profiles, for a
+system profile, packages are placed in 'profile' sub-directory,
+so the returned file name does not contain this potential
+trailing '/profile'."
+ (let* ((profile (nix-profile profile))
+ (profile (if (and (nix-system-profile? profile)
+ (string-match (rx (group (* any))
+ "/profile" string-end)
+ profile))
+ (match-string 1 profile)
+ profile)))
+ (if generation
+ (nix-generation-file profile generation)
+ profile)))
+
+(defun nix-package-profile (profile &optional generation)
+ "Return file name of PROFILE or its GENERATION.
+The returned file name is the one where packages are installed.
+
+If PROFILE is a system one (see `nix-generation-profile'), then
+the returned file name ends with '/profile'."
+ (let* ((profile (nix-generation-profile profile))
+ (profile (if generation
+ (nix-generation-file profile generation)
+ profile)))
+ (if (nix-system-profile? profile)
+ (expand-file-name "profile" profile)
+ profile)))
+
+(defun nix-manifest-file (profile &optional generation)
+ "Return manifest file name of PROFILE or its GENERATION."
+ (expand-file-name "manifest"
+ (nix-package-profile profile generation)))
+
+(defun nix-profile-number-of-packages (profile &optional generation)
+ "Return the number of packages installed in PROFILE or its GENERATION."
+ (let ((manifest (nix-manifest-file profile generation)))
+ ;; Just count a number of sexps inside (packages ...) of manifest
+ ;; file. It should be much faster than running the REPL and
+ ;; calculating manifest entries on the Scheme side.
+ (when (file-exists-p manifest)
+ (with-temp-buffer
+ (insert-file-contents-literally manifest)
+ (goto-char (point-min))
+ (re-search-forward "(packages" nil t)
+ (down-list)
+ (let ((num 0)
+ (pos (point)))
+ (while (setq pos (condition-case nil
+ (scan-sexps pos 1)
+ (error nil)))
+ (setq num (1+ num)))
+ num)))))
+
+(defun nix-profile-number-of-generations (profile)
+ "Return the number of generations of PROFILE."
+ (let* ((profile (nix-generation-profile profile))
+ (dir-name (file-name-directory profile))
+ (base-name (file-name-nondirectory profile))
+ (regexp (concat (regexp-quote base-name)
+ "-[[:digit:]]+-link")))
+ (when (file-exists-p profile)
+ (length (directory-files dir-name nil regexp 'no-sort)))))
+
+
+;;; Minibuffer readers
+
+(defun nix-read-profile (&optional default)
+ "Prompt for profile and return it.
+Use DEFAULT as a start directory. If it is nil, use
+`nix-current-profile'."
+ (nix-read-file-name "Profile: "
+ (file-name-directory
+ (or default nix-current-profile))))
+
+(defun nix-read-package-profile (&optional default)
+ "Prompt for a package profile and return it.
+See `nix-read-profile' for the meaning of DEFAULT, and
+`nix-package-profile' for the meaning of package profile."
+ (nix-package-profile (nix-read-profile default)))
+
+(defun nix-read-generation-profile (&optional default)
+ "Prompt for a generation profile and return it.
+See `nix-read-profile' for the meaning of DEFAULT, and
+`nix-generation-profile' for the meaning of generation profile."
+ (nix-generation-profile (nix-read-profile default)))
+
+
+;;;###autoload
+(defun nix-set-current-profile (file-name)
+ "Set `nix-current-profile' to FILE-NAME.
+Interactively, prompt for FILE-NAME. With prefix, use
+`nix-default-profile'."
+ (interactive
+ (list (if current-prefix-arg
+ nix-default-profile
+ (nix-read-package-profile))))
+ (setq nix-current-profile file-name)
+ (message "Current profile has been set to '%s'."
+ nix-current-profile))
+
+(provide 'nix-profiles)
+
+;;; nix-profiles.el ends here
diff --git a/nix-ui-messages.el b/nix-ui-messages.el
new file mode 100644
index 0000000000..93c80b46ee
--- /dev/null
+++ b/nix-ui-messages.el
@@ -0,0 +1,260 @@
+;;; nix-ui-messages.el --- Minibuffer messages for Guix package management
interface
+
+;; Copyright © 2014–2017 Alex Kost <alezost@gmail.com>
+
+;; This file is part of Emacs-Guix.
+
+;; Emacs-Guix 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 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 Emacs-Guix. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides `nix-result-message' function used to show a
+;; minibuffer message after displaying packages/generations in a
+;; list/info buffer.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'bui-utils)
+
+(defvar nix-messages
+ `((package
+ (id
+ ,(lambda (_ entries ids)
+ (nix-message-packages-by-id entries 'package ids)))
+ (name
+ ,(lambda (_ entries names)
+ (nix-message-packages-by-name entries 'package names)))
+ (license
+ ,(lambda (_ entries licenses)
+ (apply #'nix-message-packages-by-license
+ entries 'package licenses)))
+ (location
+ ,(lambda (_ entries locations)
+ (apply #'nix-message-packages-by-location
+ entries 'package locations)))
+ (from-file
+ (0 "No package in file '%s'." val)
+ (1 "Package from file '%s'." val))
+ (from-os-file
+ (0 "No packages in OS file '%s'." val)
+ (1 "Package from OS file '%s'." val)
+ (many "%d packages from OS file '%s'." count val))
+ (regexp
+ (0 "No packages matching '%s'." val)
+ (1 "A single package matching '%s'." val)
+ (many "%d packages matching '%s'." count val))
+ (all-available
+ (0 "No packages are available for some reason.")
+ (1 "A single available package (that's strange).")
+ (many "%d available packages." count))
+ (newest-available
+ (0 "No packages are available for some reason.")
+ (1 "A single newest available package (that's strange).")
+ (many "%d newest available packages." count))
+ (installed
+ (0 "No packages installed in profile '%s'." profile)
+ (1 "A single package installed in profile '%s'." profile)
+ (many "%d packages installed in profile '%s'." count profile))
+ (obsolete
+ (0 "No obsolete packages in profile '%s'." profile)
+ (1 "A single obsolete package in profile '%s'." profile)
+ (many "%d obsolete packages in profile '%s'." count profile)))
+
+ (output
+ (id
+ ,(lambda (_ entries ids)
+ (nix-message-packages-by-id entries 'output ids)))
+ (name
+ ,(lambda (_ entries names)
+ (nix-message-packages-by-name entries 'output names)))
+ (license
+ ,(lambda (_ entries licenses)
+ (apply #'nix-message-packages-by-license
+ entries 'output licenses)))
+ (location
+ ,(lambda (_ entries locations)
+ (apply #'nix-message-packages-by-location
+ entries 'output locations)))
+ (from-file
+ (0 "No package in file '%s'." val)
+ (1 "Package from file '%s'." val)
+ (many "Package outputs from file '%s'." val))
+ (from-os-file
+ (0 "No packages in OS file '%s'." val)
+ (1 "Package from OS file '%s'." val)
+ (many "%d package outputs from OS file '%s'." count val))
+ (regexp
+ (0 "No package outputs matching '%s'." val)
+ (1 "A single package output matching '%s'." val)
+ (many "%d package outputs matching '%s'." count val))
+ (all-available
+ (0 "No package outputs are available for some reason.")
+ (1 "A single available package output (that's strange).")
+ (many "%d available package outputs." count))
+ (newest-available
+ (0 "No package outputs are available for some reason.")
+ (1 "A single newest available package output (that's strange).")
+ (many "%d newest available package outputs." count))
+ (installed
+ (0 "No package outputs installed in profile '%s'." profile)
+ (1 "A single package output installed in profile '%s'." profile)
+ (many "%d package outputs installed in profile '%s'." count profile))
+ (obsolete
+ (0 "No obsolete package outputs in profile '%s'." profile)
+ (1 "A single obsolete package output in profile '%s'." profile)
+ (many "%d obsolete package outputs in profile '%s'." count profile))
+ (profile-diff
+ nix-message-outputs-by-diff))
+
+ (generation
+ (id
+ (0 "Generations not found.")
+ (1 "")
+ (many "%d generations." count))
+ (last
+ (0 "No generations in profile '%s'." profile)
+ (1 "The last generation of profile '%s'." profile)
+ (many "%d last generations of profile '%s'." count profile))
+ (all
+ (0 "No generations in profile '%s'." profile)
+ (1 "A single generation available in profile '%s'." profile)
+ (many "%d generations available in profile '%s'." count profile))
+ (time
+ nix-message-generations-by-time))))
+
+(defun nix-message-string-name (name)
+ "Return a quoted name string."
+ (concat "'" name "'"))
+
+(defun nix-message-string-entry-type (entry-type &optional plural)
+ "Return a string denoting an ENTRY-TYPE."
+ (cl-ecase entry-type
+ (package
+ (if plural "packages" "package"))
+ (output
+ (if plural "package outputs" "package output"))
+ (generation
+ (if plural "generations" "generation"))))
+
+(defun nix-message-string-entries (count entry-type)
+ "Return a string denoting the COUNT of ENTRY-TYPE entries."
+ (cl-case count
+ (0 (concat "No "
+ (nix-message-string-entry-type
+ entry-type 'plural)))
+ (1 (concat "A single "
+ (nix-message-string-entry-type
+ entry-type)))
+ (t (format "%d %s"
+ count
+ (nix-message-string-entry-type
+ entry-type 'plural)))))
+
+(defun nix-message-packages-by-id (entries entry-type ids)
+ "Display a message for packages or outputs searched by IDS."
+ (let* ((count (length entries))
+ (str-beg (nix-message-string-entries count entry-type))
+ (str-end (if (> count 1)
+ (concat "with the following IDs: "
+ (mapconcat #'bui-get-string ids ", "))
+ (concat "with ID " (bui-get-string (car ids))))))
+ (if (zerop count)
+ (message (substitute-command-keys "%s %s.
+Most likely, Guix REPL was restarted, so IDs are not actual
+anymore, because they live only during the REPL process.
+
+Or it may be some package variant that cannot be handled by
+Emacs-Guix. For example, it may be so called 'canonical package'
+used by '%%base-packages' in an operating-system declaration.
+
+Try \"\\[nix-search-by-name]\" to find this package.")
+ str-beg str-end)
+ (message "%s %s." str-beg str-end))))
+
+(defun nix-message-packages-by-name (entries entry-type names)
+ "Display a message for packages or outputs searched by NAMES."
+ (let* ((count (length entries))
+ (str-beg (nix-message-string-entries count entry-type))
+ (str-end (if (cdr names)
+ (concat "matching the following names: "
+ (mapconcat #'nix-message-string-name
+ names ", "))
+ (concat "with name "
+ (nix-message-string-name (car names))))))
+ (message "%s %s." str-beg str-end)))
+
+(defun nix-message-packages-by-license (entries entry-type license)
+ "Display a message for packages or outputs searched by LICENSE."
+ (let* ((count (length entries))
+ (str-beg (nix-message-string-entries count entry-type))
+ (str-end (format "with license '%s'" license)))
+ (message "%s %s." str-beg str-end)))
+
+(defun nix-message-packages-by-location (entries entry-type location)
+ "Display a message for packages or outputs searched by LOCATION."
+ (let* ((count (length entries))
+ (str-beg (nix-message-string-entries count entry-type))
+ (str-end (format "placed in '%s'" location)))
+ (message "%s %s." str-beg str-end)))
+
+(defun nix-message-generations-by-time (profile entries times)
+ "Display a message for generations searched by TIMES."
+ (let* ((count (length entries))
+ (str-beg (nix-message-string-entries count 'generation))
+ (time-beg (bui-get-time-string (car times)))
+ (time-end (bui-get-time-string (cadr times))))
+ (message (concat "%s of profile '%s'\n"
+ "matching time period '%s' - '%s'.")
+ str-beg profile time-beg time-end)))
+
+(defun nix-message-outputs-by-diff (_ entries profiles)
+ "Display a message for outputs searched by PROFILES difference."
+ (let* ((count (length entries))
+ (str-beg (nix-message-string-entries count 'output))
+ (profile1 (car profiles))
+ (profile2 (cadr profiles)))
+ (cl-multiple-value-bind (new old str-action)
+ (if (string-lessp profile2 profile1)
+ (list profile1 profile2 "added to")
+ (list profile2 profile1 "removed from"))
+ (message "%s %s profile '%s' comparing with profile '%s'."
+ str-beg str-action new old))))
+
+(defun nix-result-message (profile entries entry-type
+ search-type search-vals)
+ "Display an appropriate message after displaying ENTRIES."
+ (let* ((type-spec (bui-assq-value nix-messages
+ (if (eq entry-type 'system-generation)
+ 'generation
+ entry-type)
+ search-type))
+ (fun-or-count-spec (car type-spec)))
+ (if (functionp fun-or-count-spec)
+ (funcall fun-or-count-spec profile entries search-vals)
+ (let* ((count (length entries))
+ (count-key (if (> count 1) 'many count))
+ (msg-spec (bui-assq-value type-spec count-key))
+ (msg (car msg-spec))
+ (args (cdr msg-spec)))
+ (mapc (lambda (subst)
+ (setq args (cl-substitute (cdr subst) (car subst) args)))
+ `((count . ,count)
+ (val . ,(car search-vals))
+ (profile . ,profile)))
+ (apply #'message msg args)))))
+
+(provide 'nix-ui-messages)
+
+;;; nix-ui-messages.el ends here
diff --git a/nix-ui-profile.el b/nix-ui-profile.el
new file mode 100644
index 0000000000..f0ff1c7a15
--- /dev/null
+++ b/nix-ui-profile.el
@@ -0,0 +1,136 @@
+;;; nix-ui-profile.el --- Interface for displaying profiles -*-
lexical-binding: t -*-
+
+;; Copyright © 2016–2017 Alex Kost <alezost@gmail.com>
+
+;; This file is part of Emacs-Guix.
+
+;; Emacs-Guix 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 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 Emacs-Guix. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides a 'list' interface for displaying Guix profiles
+;; with `nix-profiles' command.
+;;
+;; `nix-profiles' variable controls what profiles are displayed.
+
+;;; Code:
+
+(require 'dash)
+(require 'bui)
+(require 'nix)
+(require 'nix-profiles)
+(require 'nix-utils)
+
+(nix-define-groups profile)
+
+(defcustom nix-profiles
+ (-filter #'file-exists-p
+ (list nix-user-profile
+ nix-system-profile))
+ "List of profiles displayed by '\\[nix-profiles]' command."
+ :type '(repeat file)
+ :group 'nix-profile)
+
+(defun nix-profile->entry (profile)
+ "Return 'nix-profile' entry by PROFILE file-name."
+ `((id . ,profile)
+ (profile . ,profile)
+ (current . ,(nix-current-profile? profile))
+ (number-of-packages . ,(nix-profile-number-of-packages
+ profile))
+ (number-of-generations . ,(nix-profile-number-of-generations
+ profile))))
+
+(defun nix-profile-get-entries ()
+ "Return 'nix-profile' entries."
+ (mapcar #'nix-profile->entry nix-profiles))
+
+
+;;; Profile 'list'
+
+(bui-define-interface nix-profile list
+ :mode-name "Profile-List"
+ :buffer-name "*Nix Profiles*"
+ :get-entries-function 'nix-profile-get-entries
+ :format '((current nix-profile-list-get-current 10 t)
+ (profile bui-list-get-file-name 40 t)
+ (number-of-packages nil 11 bui-list-sort-numerically-2
+ :right-align t)
+ (number-of-generations nil 14 bui-list-sort-numerically-3
+ :right-align t))
+ :titles '((number-of-packages . "Packages")
+ (number-of-generations . "Generations"))
+ :hint 'nix-profile-list-hint
+ :sort-key '(profile))
+
+(defun nix-profile-list-hint ()
+ (bui-format-hints
+ nix-profile-list-default-hint
+ bui-list-sort-hint
+ bui-common-hint))
+
+(defun nix-profile-list-current-profile ()
+ "Return file name of the current profile."
+ ;; (bui-entry-value (bui-list-current-entry) 'profile)
+ ;; Just get the ID, as currently ID is the profile file name.
+ (bui-list-current-id))
+
+(defun nix-profile-list-get-current (value &optional _)
+ "Return string from VALUE showing whether this profile is current."
+ (if value "(current)" ""))
+
+(defun nix-profile-list-set-current ()
+ "Set `nix-current-profile' to the profile on the current line."
+ (interactive)
+ (nix-set-current-profile (nix-profile-list-current-profile))
+ ;; Now updating "Current" column is needed. It can be done simply by
+ ;; reverting the buffer, but it should be more effective to reset
+ ;; 'current' parameter for all entries and to redisplay the buffer
+ ;; instead.
+ (let* ((current-id (bui-list-current-id))
+ (new-entries (mapcar
+ (lambda (entry)
+ (let ((id (bui-entry-id entry)))
+ (cons `(current . ,(equal id current-id))
+ (--remove-first (eq (car it) 'current)
+ entry))))
+ (bui-current-entries))))
+ (setf (bui-item-entries bui-item)
+ new-entries))
+ (bui-redisplay))
+
+
+;;; Interactive commands
+
+(defun nix-profiles-show ()
+ "Display Nix profiles.
+Unlike `nix-profiles', this command always recreates
+`nix-profile-list-buffer-name' buffer."
+ (interactive)
+ (bui-list-get-display-entries 'nix-profile))
+
+;;;###autoload
+(defun nix-profiles ()
+ "Display Nix profiles.
+Switch to the `nix-profile-list-buffer-name' buffer if it
+already exists.
+
+Modify `nix-profiles' variable to add more profiles."
+ (interactive)
+ (nix-switch-to-buffer-or-funcall
+ nix-profile-list-buffer-name #'nix-profiles-show 'message))
+
+(provide 'nix-ui-profile)
+
+;;; nix-ui-profile.el ends here
diff --git a/nix-utils.el b/nix-utils.el
new file mode 100644
index 0000000000..5b65b007eb
--- /dev/null
+++ b/nix-utils.el
@@ -0,0 +1,479 @@
+;;; nix-utils.el --- General utility functions -*- lexical-binding: t -*-
+
+;; Copyright © 2014–2017 Alex Kost <alezost@gmail.com>
+
+;; This file is part of Emacs-Guix.
+
+;; Emacs-Guix 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 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 Emacs-Guix. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides auxiliary general code for Emacs-Guix package.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'dash)
+(require 'bui-utils)
+
+(defun nix-concat-strings (strings separator &optional location)
+ "Return new string by concatenating STRINGS with SEPARATOR.
+If LOCATION is a symbol `head', add another SEPARATOR to the
+beginning of the returned string; if `tail' - add SEPARATOR to
+the end of the string; if nil, do not add SEPARATOR; otherwise
+add both to the end and to the beginning."
+ (let ((str (mapconcat #'identity strings separator)))
+ (cond ((null location)
+ str)
+ ((eq location 'head)
+ (concat separator str))
+ ((eq location 'tail)
+ (concat str separator))
+ (t
+ (concat separator str separator)))))
+
+(defun nix-hexify (value)
+ "Convert VALUE to string and hexify it."
+ (url-hexify-string (bui-get-string value)))
+
+(defun nix-number->bool (number)
+ "Convert NUMBER to boolean value.
+Return nil, if NUMBER is 0; return t otherwise."
+ (not (zerop number)))
+
+(defun nix-list-maybe (object)
+ "If OBJECT is list, return it; otherwise return (list OBJECT)."
+ (if (listp object)
+ object
+ (list object)))
+
+(defun nix-shell-quote-argument (argument)
+ "Quote shell command ARGUMENT.
+This function is similar to `shell-quote-argument', but less strict."
+ (if (equal argument "")
+ "''"
+ (replace-regexp-in-string
+ "\n" "'\n'"
+ (replace-regexp-in-string
+ (rx (not (any alnum "-=,./\n"))) "\\\\\\&" argument))))
+
+(defun nix-command-symbol (&optional args)
+ "Return symbol by concatenating 'nix' and ARGS (strings)."
+ (intern (nix-concat-strings (cons "nix" args) "-")))
+
+(defun nix-command-string (&optional args)
+ "Return 'guix ARGS ...' string with quoted shell arguments."
+ (let ((args (mapcar #'nix-shell-quote-argument args)))
+ (nix-concat-strings (cons "nix" args) " ")))
+
+(defun nix-copy-command-as-kill (args &optional no-message?)
+ "Put 'guix ARGS ...' string into `kill-ring'.
+See also `nix-copy-as-kill'."
+ (bui-copy-as-kill (nix-command-string args) no-message?))
+
+(defun nix-compose-buffer-name (base-name postfix)
+ "Return buffer name by appending BASE-NAME and POSTFIX.
+
+In a simple case the result is:
+
+ BASE-NAME: POSTFIX
+
+If BASE-NAME is wrapped by '*', then the result is:
+
+ *BASE-NAME: POSTFIX*"
+ (let ((re (rx string-start
+ (group (? "*"))
+ (group (*? any))
+ (group (? "*"))
+ string-end)))
+ (or (string-match re base-name)
+ (error "Unexpected error in defining buffer name"))
+ (let ((first* (match-string 1 base-name))
+ (name-body (match-string 2 base-name))
+ (last* (match-string 3 base-name)))
+ ;; Handle the case when buffer name is wrapped by '*'.
+ (if (and (string= "*" first*)
+ (string= "*" last*))
+ (concat "*" name-body ": " postfix "*")
+ (concat base-name ": " postfix)))))
+
+(defun nix-completing-read (prompt table &optional predicate
+ require-match initial-input
+ hist def inherit-input-method)
+ "Same as `completing-read' but return nil instead of an empty string."
+ (let ((res (completing-read prompt table predicate
+ require-match initial-input
+ hist def inherit-input-method)))
+ (unless (string= "" res) res)))
+
+(defun nix-completing-read-multiple (prompt table &optional predicate
+ require-match initial-input
+ hist def inherit-input-method)
+ "Same as `completing-read-multiple' but remove duplicates in result."
+ (cl-remove-duplicates
+ (completing-read-multiple prompt table predicate
+ require-match initial-input
+ hist def inherit-input-method)
+ :test #'string=))
+
+(declare-function org-read-date "org" t)
+
+(defun nix-read-date (prompt)
+ "Prompt for a date or time using `org-read-date'.
+Return time value."
+ (require 'org)
+ (org-read-date nil t nil prompt))
+
+(declare-function pcmpl-unix-user-names "pcmpl-unix")
+
+(defun nix-read-user-name (&optional prompt initial-input)
+ "Prompt for a user name using completions."
+ (require 'pcmpl-unix)
+ (nix-completing-read (or prompt "User name: ")
+ (pcmpl-unix-user-names)
+ nil nil initial-input))
+
+(defun nix-read-file-name (prompt &optional dir default-filename
+ mustmatch initial predicate)
+ "Read file name.
+This function is similar to `read-file-name' except it also
+expands the file name."
+ (expand-file-name (read-file-name prompt dir default-filename
+ mustmatch initial predicate)))
+
+(defcustom nix-find-file-function #'find-file
+ "Function used to find a file.
+This function is called by `nix-find-file' with a file name as a
+single argument."
+ :type '(choice (function-item find-file)
+ (function-item org-open-file)
+ (function :tag "Other function"))
+ :group 'nix)
+
+(defun nix-find-file (file)
+ "Find FILE (using `nix-find-file-function') if it exists."
+ (if (file-exists-p file)
+ (funcall nix-find-file-function file)
+ (message "File '%s' does not exist." file)))
+
+(defvar url-handler-regexp)
+
+(defun nix-find-file-or-url (file-or-url)
+ "Find FILE-OR-URL."
+ (require 'url-handlers)
+ (let ((file-name-handler-alist
+ (cons (cons url-handler-regexp 'url-file-handler)
+ file-name-handler-alist)))
+ (find-file file-or-url)))
+
+(defun nix-switch-to-buffer-or-funcall (buffer-or-name function
+ &optional message)
+ "Switch to BUFFER-OR-NAME if it exists.
+If BUFFER-OR-NAME does not exist, call FUNCTION without
+arguments, also display a message if MESSAGE is specified (it can
+be either nil, a string, or another value for a default
+message)."
+ (let ((buffer (get-buffer buffer-or-name)))
+ (if buffer
+ (progn
+ (switch-to-buffer buffer)
+ (when message
+ (message (if (stringp message)
+ message
+ (substitute-command-keys "\
+Press '\\[revert-buffer]' to update this buffer.")))))
+ (funcall function))))
+
+(defun nix-pretty-print-buffer (buffer-or-name)
+ "Pretty-print the contents of BUFFER-OR-NAME."
+ (with-current-buffer buffer-or-name
+ (goto-char (point-max))
+ (let (sexp-beg)
+ (while (setq sexp-beg (scan-sexps (point) -1))
+ (goto-char sexp-beg)
+ (delete-horizontal-space t)
+ (unless (= (point) (line-beginning-position))
+ (insert "\n"))
+ (indent-pp-sexp 'pp)))))
+
+(defun nix-pretty-print-file (file-name &optional mode)
+ "Show FILE-NAME contents in MODE and pretty-print it.
+If MODE is nil, use `scheme-mode'.
+Put the point in the beginning of buffer.
+Return buffer with the prettified contents."
+ (let* ((base-name (file-name-nondirectory file-name))
+ (buffer (generate-new-buffer base-name)))
+ (with-current-buffer buffer
+ (insert-file-contents file-name)
+ (goto-char (point-min))
+ (funcall (or mode 'scheme-mode)))
+ (nix-pretty-print-buffer buffer)
+ buffer))
+
+(defmacro nix-while-search (regexp &rest body)
+ "Evaluate BODY after each search for REGEXP in the current buffer."
+ (declare (indent 1) (debug t))
+ `(save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward ,regexp nil t)
+ ,@body)))
+
+(defmacro nix-while-null (&rest body)
+ "Evaluate BODY until its result becomes non-nil."
+ (declare (indent 0) (debug t))
+ (let ((result-var (make-symbol "result")))
+ `(let (,result-var)
+ (while (null ,result-var)
+ (setq ,result-var ,@body))
+ ,result-var)))
+
+(defun nix-modify (object &rest modifiers)
+ "Apply MODIFIERS to OBJECT.
+OBJECT is passed as an argument to the first function from
+MODIFIERS list, the returned result is passed to the second
+function from the list and so on. Return result of the last
+modifier call."
+ (if (null modifiers)
+ object
+ (apply #'nix-modify
+ (funcall (car modifiers) object)
+ (cdr modifiers))))
+
+(defun nix-modify-objects (objects &rest modifiers)
+ "Apply MODIFIERS to each object from a list of OBJECTS.
+See `nix-modify' for details."
+ (--map (apply #'nix-modify it modifiers)
+ objects))
+
+(defun nix-make-symbol (&rest symbols)
+ "Return `nix-SYMBOLS-...' symbol."
+ (apply #'bui-make-symbol 'nix symbols))
+
+(defmacro nix-define-groups (name &rest args)
+ "Define `nix-NAME' and `nix-NAME-faces' customization groups.
+See `bui-define-groups' for details."
+ (declare (indent 1))
+ `(bui-define-groups ,(bui-make-symbol 'nix name)
+ :parent-group nix
+ :parent-faces-group nix-faces
+ ,@args))
+
+;;; Temporary file names
+
+(defvar nix-temporary-directory nil
+ "Directory for writing temporary Nix files.
+If nil, it will be set when it will be used the first time.
+This directory will be deleted on Emacs exit.")
+
+(defun nix-temporary-directory ()
+ "Return `nix-temporary-directory' (set it if needed)."
+ (or (and nix-temporary-directory
+ (file-exists-p nix-temporary-directory)
+ nix-temporary-directory)
+ (setq nix-temporary-directory
+ (make-temp-file "emacs-nix-" 'dir))))
+
+(defun nix-temporary-file-name (name &optional suffix)
+ "Return file NAME from `nix-temporary-directory'.
+If such file name already exists, or if SUFFIX string is
+specified, make the returned name unique."
+ (let* ((file-name (expand-file-name name (nix-temporary-directory)))
+ (file-name (if suffix
+ (concat (make-temp-name file-name) suffix)
+ file-name)))
+ (if (file-exists-p file-name)
+ (nix-temporary-file-name name (or suffix ""))
+ file-name)))
+
+(defun nix-delete-temporary-directory ()
+ "Delete `nix-temporary-directory' if it exists."
+ (when (and nix-temporary-directory
+ (file-exists-p nix-temporary-directory))
+ (condition-case nil
+ (delete-directory (nix-temporary-directory) 'recursive)
+ (error
+ (message "Failed to delete temporary Nix directory: %s"
+ nix-temporary-directory)))))
+
+(add-hook 'kill-emacs-hook 'nix-delete-temporary-directory)
+
+;;; Fontification
+
+(defvar nix-font-lock-flush-function
+ (if (fboundp 'font-lock-flush)
+ #'font-lock-flush ; appeared in Emacs 25.1
+ #'jit-lock-refontify)
+ "Function used to refontify a buffer.
+
+This function is called without arguments after
+enabling/disabling `nix-prettify-mode',
+`nix-build-log-minor-mode' and `nix-devel-mode'.
+
+If nil, do not perform refontifying.")
+
+(defun nix-font-lock-flush ()
+ "Refontify the current buffer using `nix-font-lock-flush-function'."
+ (when nix-font-lock-flush-function
+ (if (fboundp nix-font-lock-flush-function)
+ (funcall nix-font-lock-flush-function)
+ (message "Unknown function: %S" nix-font-lock-flush-function))))
+
+;;; Diff
+
+(defvar nix-diff-switches "-u"
+ "A string or list of strings specifying switches to be passed to diff.")
+
+(defun nix-diff (old new &optional switches no-async)
+ "Same as `diff', but use `nix-diff-switches' as default."
+ (diff old new (or switches nix-diff-switches) no-async))
+
+;;; Completing readers definers
+
+(defmacro nix-define-reader (name read-fun completions prompt
+ &optional require-match default)
+ "Define NAME function to read from minibuffer.
+READ-FUN may be `completing-read', `completing-read-multiple' or
+another function with the same arguments."
+ (declare (indent 1))
+ `(defun ,name (&optional prompt initial-contents)
+ (,read-fun (or prompt ,prompt)
+ ,completions nil ,require-match
+ initial-contents nil ,default)))
+
+(defmacro nix-define-readers (&rest args)
+ "Define reader functions.
+
+ARGS should have a form [KEYWORD VALUE] ... The following
+keywords are available:
+
+ - `completions-var' - variable used to get completions.
+
+ - `completions-getter' - function used to get completions.
+
+ - `require-match' - if the match is required (see
+ `completing-read' for details); default is t.
+
+ - `default' - default value.
+
+ - `single-reader', `single-prompt' - name of a function to read
+ a single value, and a prompt for it.
+
+ - `multiple-reader', `multiple-prompt' - name of a function to
+ read multiple values, and a prompt for it.
+
+ - `multiple-separator' - if specified, another
+ `<multiple-reader-name>-string' function returning a string
+ of multiple values separated the specified separator will be
+ defined."
+ (bui-plist-let args
+ ((completions-var :completions-var)
+ (completions-getter :completions-getter)
+ (require-match :require-match t)
+ (default :default)
+ (single-reader :single-reader)
+ (single-prompt :single-prompt)
+ (multiple-reader :multiple-reader)
+ (multiple-prompt :multiple-prompt)
+ (multiple-separator :multiple-separator))
+ (let ((completions
+ (cond ((and completions-var completions-getter)
+ `(or ,completions-var
+ (setq ,completions-var
+ (funcall ',completions-getter))))
+ (completions-var
+ completions-var)
+ (completions-getter
+ `(funcall ',completions-getter)))))
+ `(progn
+ ,(when (and completions-var
+ (not (boundp completions-var)))
+ `(defvar ,completions-var nil))
+
+ ,(when single-reader
+ `(nix-define-reader ,single-reader
+ nix-completing-read ,completions ,single-prompt
+ ,require-match ,default))
+
+ ,(when multiple-reader
+ `(nix-define-reader ,multiple-reader
+ completing-read-multiple ,completions ,multiple-prompt
+ ,require-match ,default))
+
+ ,(when (and multiple-reader multiple-separator)
+ (let ((name (intern (concat (symbol-name multiple-reader)
+ "-string"))))
+ `(defun ,name (&optional prompt initial-contents)
+ (nix-concat-strings
+ (,multiple-reader prompt initial-contents)
+ ,multiple-separator))))))))
+
+;;; Memoizing
+
+(defun nix-memoize (function)
+ "Return a memoized version of FUNCTION."
+ (let ((cache (make-hash-table :test 'equal)))
+ (lambda (&rest args)
+ (let ((result (gethash args cache 'not-found)))
+ (if (eq result 'not-found)
+ (let ((result (apply function args)))
+ (puthash args result cache)
+ result)
+ result)))))
+
+(defmacro nix-memoized-defun (name arglist docstring &rest body)
+ "Define a memoized function NAME.
+See `defun' for the meaning of arguments."
+ (declare (doc-string 3) (indent 2))
+ `(defalias ',name
+ (nix-memoize (lambda ,arglist ,@body))
+ ;; Add '(name args ...)' string with real arglist to the docstring,
+ ;; because *Help* will display '(name &rest ARGS)' for a defined
+ ;; function (since `nix-memoize' returns a lambda with '(&rest
+ ;; args)').
+ ,(format "(%S %s)\n\n%s"
+ name
+ (mapconcat #'symbol-name arglist " ")
+ docstring)))
+
+(defmacro nix-memoized-defalias (symbol definition &optional docstring)
+ "Set SYMBOL's function definition to memoized version of DEFINITION."
+ (declare (doc-string 3) (indent 1))
+ `(defalias ',symbol
+ (nix-memoize #',definition)
+ ,(or docstring
+ (format "Memoized version of `%S'." definition))))
+
+(defvar nix-utils-font-lock-keywords
+ (eval-when-compile
+ `((,(rx "(" (group (or "nix-define-reader"
+ "nix-define-readers"
+ "nix-define-groups"
+ "nix-while-null"
+ "nix-while-search"))
+ symbol-end)
+ . 1)
+ (,(rx "("
+ (group "nix-memoized-" (or "defun" "defalias"))
+ symbol-end
+ (zero-or-more blank)
+ (zero-or-one
+ (group (one-or-more (or (syntax word) (syntax symbol))))))
+ (1 font-lock-keyword-face)
+ (2 font-lock-function-name-face nil t)))))
+
+(font-lock-add-keywords 'emacs-lisp-mode nix-utils-font-lock-keywords)
+
+(provide 'nix-utils)
+
+;;; nix-utils.el ends here
diff --git a/nix.el b/nix.el
new file mode 100644
index 0000000000..9917802d71
--- /dev/null
+++ b/nix.el
@@ -0,0 +1,43 @@
+;;; help-vars.el --- Variables related to Guix --help output
+
+;; Copyright © 2015 Alex Kost <alezost@gmail.com>
+
+;; This file is part of Emacs-Guix.
+
+;; Emacs-Guix 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 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 Emacs-Guix. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides regular expressions to parse various "guix
+;; ... --help" outputs and lists of non-receivable items (system types,
+;; hash formats, etc.).
+
+;;; Code:
+
+(defgroup nix nil
+ "Interface for Nix package manager."
+ :prefix "nix-"
+ :group 'external')
+
+(defgroup nix-faces nil
+ "Nix faces."
+ :group 'nix
+ :group 'faces)
+
+(defvar nix-system-types
+ '("x86_64-linux" "i686-linux" "aarch64-linux" "x86_64-darwin")
+ "List of supported systems.")
+
+(provide 'nix)
+;;; nix.el ends here
- [nongnu] elpa/nix-mode 1c42c634bf 379/500: Allow missing git repo, (continued)
- [nongnu] elpa/nix-mode 1c42c634bf 379/500: Allow missing git repo, ELPA Syncer, 2022/01/29
- [nongnu] elpa/nix-mode 38958e5203 413/500: Update install-nix-action in GitHub Action, ELPA Syncer, 2022/01/29
- [nongnu] elpa/nix-mode cc60a0d027 417/500: Make nix-drv-mode a derived-mode of javascript-mode, ELPA Syncer, 2022/01/29
- [nongnu] elpa/nix-mode 0de9c70c89 429/500: Split up `nix-search` into two separate functions, ELPA Syncer, 2022/01/29
- [nongnu] elpa/nix-mode e8e5211f6e 426/500: Merge pull request #122 from leungbk/def-obsol, ELPA Syncer, 2022/01/29
- [nongnu] elpa/nix-mode 98426b94e5 280/500: Add function to indent things in blocks for nix-indent-line, ELPA Syncer, 2022/01/29
- [nongnu] elpa/nix-mode 71fda1db41 373/500: add README section for nix-prettify-mode (#100), ELPA Syncer, 2022/01/29
- [nongnu] elpa/nix-mode fc68739bec 011/500: Fix syntax error, ELPA Syncer, 2022/01/29
- [nongnu] elpa/nix-mode cb392d45b6 030/500: tweak indentation, ELPA Syncer, 2022/01/29
- [nongnu] elpa/nix-mode ade1d49841 128/500: Fixup indentation logic., ELPA Syncer, 2022/01/29
- [nongnu] elpa/nix-mode 414a40fe54 131/500: Add hydra mode (#25),
ELPA Syncer <=
- [nongnu] elpa/nix-mode f7fa332705 155/500: Add nix-shell custom group, ELPA Syncer, 2022/01/29
- [nongnu] elpa/nix-mode 6573b1d70e 145/500: Add nix-shell.el, ELPA Syncer, 2022/01/29
- [nongnu] elpa/nix-mode 0af6073003 171/500: Add nix-mode to nix-mode group., ELPA Syncer, 2022/01/29
- [nongnu] elpa/nix-mode af686b570c 159/500: Fix package-lint complaints., ELPA Syncer, 2022/01/29
- [nongnu] elpa/nix-mode 3fa526ee57 165/500: Add MELPA badges to READM.md, ELPA Syncer, 2022/01/29
- [nongnu] elpa/nix-mode 420cbbf94c 215/500: Reorganization, ELPA Syncer, 2022/01/29
- [nongnu] elpa/nix-mode 1090226479 224/500: nix-repl-show -> nix-repl, ELPA Syncer, 2022/01/29
- [nongnu] elpa/nix-mode 588246b499 229/500: Fix escaping of characters, ELPA Syncer, 2022/01/29
- [nongnu] elpa/nix-mode a5bf79a563 425/500: Merge pull request #120 from znewman01/master, ELPA Syncer, 2022/01/29
- [nongnu] elpa/nix-mode 7593b023a7 405/500: Merge pull request #110 from leungbk/repl-history, ELPA Syncer, 2022/01/29