aboutsummaryrefslogtreecommitdiff
path: root/emacs
diff options
context:
space:
mode:
authorLeo Famulari <leo@famulari.name>2017-01-06 17:14:41 -0500
committerLeo Famulari <leo@famulari.name>2017-01-06 17:14:41 -0500
commit74288230ea8b2310495dc2739f39ceadcc143fd0 (patch)
tree73ba6c7c13d59c5f92b409c94dccfff159e08f4d /emacs
parent92e779592d269ca1924f184496eb4ca832997b12 (diff)
parentaa21c764d65068783ae31febee2a92eb3d138a24 (diff)
downloadpatches-74288230ea8b2310495dc2739f39ceadcc143fd0.tar
patches-74288230ea8b2310495dc2739f39ceadcc143fd0.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'emacs')
-rw-r--r--emacs/guix-about.el37
-rw-r--r--emacs/guix-backend.el393
-rw-r--r--emacs/guix-base.el377
-rw-r--r--emacs/guix-buffer.el624
-rw-r--r--emacs/guix-build-log.el381
-rw-r--r--emacs/guix-command.el830
-rw-r--r--emacs/guix-config.el.in44
-rw-r--r--emacs/guix-devel.el382
-rw-r--r--emacs/guix-entry.el59
-rw-r--r--emacs/guix-external.el88
-rw-r--r--emacs/guix-geiser.el126
-rw-r--r--emacs/guix-guile.el98
-rw-r--r--emacs/guix-help-vars.el108
-rw-r--r--emacs/guix-helper.scm.in65
-rw-r--r--emacs/guix-history.el92
-rw-r--r--emacs/guix-hydra-build.el362
-rw-r--r--emacs/guix-hydra-jobset.el162
-rw-r--r--emacs/guix-hydra.el367
-rw-r--r--emacs/guix-info.el482
-rw-r--r--emacs/guix-init.el3
-rw-r--r--emacs/guix-license.el65
-rw-r--r--emacs/guix-list.el585
-rw-r--r--emacs/guix-location.el79
-rw-r--r--emacs/guix-main.scm1163
-rw-r--r--emacs/guix-messages.el247
-rw-r--r--emacs/guix-pcomplete.el370
-rw-r--r--emacs/guix-popup.el48
-rw-r--r--emacs/guix-prettify.el210
-rw-r--r--emacs/guix-profiles.el77
-rw-r--r--emacs/guix-read.el147
-rw-r--r--emacs/guix-ui-generation.el456
-rw-r--r--emacs/guix-ui-license.el150
-rw-r--r--emacs/guix-ui-location.el83
-rw-r--r--emacs/guix-ui-package.el1191
-rw-r--r--emacs/guix-ui-system-generation.el105
-rw-r--r--emacs/guix-ui.el323
-rw-r--r--emacs/guix-utils.el609
-rw-r--r--emacs/local.mk77
38 files changed, 0 insertions, 11065 deletions
diff --git a/emacs/guix-about.el b/emacs/guix-about.el
deleted file mode 100644
index 27a79fe162..0000000000
--- a/emacs/guix-about.el
+++ /dev/null
@@ -1,37 +0,0 @@
-;;; guix-about.el --- Various info about Guix
-
-;; Copyright © 2016 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU Guix is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public Location as published by
-;; the Free Software Foundation, either version 3 of the Location, or
-;; (at your option) any later version.
-
-;; GNU 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 Location for more details.
-
-;; You should have received a copy of the GNU General Public Location
-;; along with this program. If not, see <http://www.gnu.org/locations/>.
-
-;;; Commentary:
-
-;; This file provides the code to display various info about Guix (e.g., its
-;; version).
-
-;;; Code:
-
-(require 'guix-config)
-
-;;;###autoload
-(defun guix-version ()
- "Display Guix version in the echo area."
- (interactive)
- (message "%s %s" guix-config-name guix-config-version))
-
-(provide 'guix-about)
-
-;;; guix-about.el ends here
diff --git a/emacs/guix-backend.el b/emacs/guix-backend.el
deleted file mode 100644
index 6341aacae1..0000000000
--- a/emacs/guix-backend.el
+++ /dev/null
@@ -1,393 +0,0 @@
-;;; guix-backend.el --- Making and using Guix REPL
-
-;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides the code for interacting with Guile using Guix REPL
-;; (Geiser REPL with some guix-specific additions).
-
-;; By default (if `guix-use-guile-server' is non-nil) 2 Guix REPLs are
-;; started. The main one (with "guile --listen" process) is used for
-;; "interacting" with a user - for showing a progress of
-;; installing/deleting Guix packages. The second (internal) REPL is
-;; used for synchronous evaluating, e.g. when information about
-;; packages/generations should be received for a list/info buffer.
-;;
-;; This "2 REPLs concept" makes it possible to have a running process of
-;; installing/deleting packages and to continue to search/list/get info
-;; about other packages at the same time. If you prefer to use a single
-;; Guix REPL, do not try to receive any information while there is a
-;; running code in the REPL (see
-;; <https://github.com/jaor/geiser/issues/28>).
-;;
-;; Guix REPLs (unlike the usual Geiser REPLs) are not added to
-;; `geiser-repl--repls' variable, and thus cannot be used for evaluating
-;; while editing scm-files. The only purpose of Guix REPLs is to be an
-;; intermediate between "Guix/Guile level" and "Emacs interface level".
-;; That being said you can still want to use a Guix REPL while hacking
-;; auxiliary scheme-files for "guix.el". You can just use
-;; `geiser-connect-local' command with `guix-repl-current-socket' to
-;; have a usual Geiser REPL with all stuff defined by "guix.el" package.
-
-;;; Code:
-
-(require 'geiser-mode)
-(require 'geiser-guile)
-(require 'guix-geiser)
-(require 'guix-config)
-(require 'guix-external)
-(require 'guix-emacs)
-(require 'guix-profiles)
-
-(defvar guix-load-path guix-config-emacs-interface-directory
- "Directory with scheme files for \"guix.el\" package.")
-
-(defvar guix-helper-file
- (expand-file-name "guix-helper.scm" guix-load-path)
- "Auxiliary scheme file for loading.")
-
-
-;;; REPL
-
-(defgroup guix-repl nil
- "Settings for Guix REPLs."
- :prefix "guix-repl-"
- :group 'guix)
-
-(defcustom guix-repl-startup-time 30000
- "Time, in milliseconds, to wait for Guix REPL to startup.
-Same as `geiser-repl-startup-time' but is used for Guix REPL.
-If you have a slow system, try to increase this time."
- :type 'integer
- :group 'guix-repl)
-
-(defcustom guix-repl-buffer-name "*Guix REPL*"
- "Default name of a Geiser REPL buffer used for Guix."
- :type 'string
- :group 'guix-repl)
-
-(defcustom guix-after-start-repl-hook '(guix-set-directory)
- "Hook called after Guix REPL is started."
- :type 'hook
- :group 'guix-repl)
-
-(defcustom guix-use-guile-server t
- "If non-nil, start guile with '--listen' argument.
-This allows to receive information about packages using an additional
-REPL while some packages are being installed/removed in the main REPL."
- :type 'boolean
- :group 'guix-repl)
-
-(defcustom guix-repl-socket-file-name-function
- #'guix-repl-socket-file-name
- "Function used to define a socket file name used by Guix REPL.
-The function is called without arguments."
- :type '(choice (function-item guix-repl-socket-file-name)
- (function :tag "Other function"))
- :group 'guix-repl)
-
-(defcustom guix-emacs-activate-after-operation t
- "Activate Emacs packages after installing.
-If nil, do not load autoloads of the Emacs packages after
-they are successfully installed."
- :type 'boolean
- :group 'guix-repl)
-
-(defvar guix-repl-current-socket nil
- "Name of a socket file used by the current Guix REPL.")
-
-(defvar guix-repl-buffer nil
- "Main Geiser REPL buffer used for communicating with Guix.
-This REPL is used for processing package actions and for
-receiving information if `guix-use-guile-server' is nil.")
-
-(defvar guix-internal-repl-buffer nil
- "Additional Geiser REPL buffer used for communicating with Guix.
-This REPL is used for receiving information only if
-`guix-use-guile-server' is non-nil.")
-
-(defvar guix-internal-repl-buffer-name "*Guix Internal REPL*"
- "Default name of an internal Guix REPL buffer.")
-
-(defvar guix-before-repl-operation-hook nil
- "Hook run before executing an operation in Guix REPL.")
-
-(defvar guix-after-repl-operation-hook
- '(guix-repl-autoload-emacs-packages-maybe
- guix-repl-operation-success-message)
- "Hook run after executing successful operation in Guix REPL.")
-
-(defvar guix-repl-operation-p nil
- "Non-nil, if current operation is performed by `guix-eval-in-repl'.
-This internal variable is used to distinguish Guix operations
-from operations performed in Guix REPL by a user.")
-
-(defvar guix-repl-operation-type nil
- "Type of the current operation performed by `guix-eval-in-repl'.
-This internal variable is used to define what actions should be
-executed after the current operation succeeds.
-See `guix-eval-in-repl' for details.")
-
-(defun guix-repl-autoload-emacs-packages-maybe ()
- "Load autoloads for Emacs packages if needed.
-See `guix-emacs-activate-after-operation' for details."
- (and guix-emacs-activate-after-operation
- ;; FIXME Since a user can work with a non-current profile (using
- ;; C-u before `guix-search-by-name' and other commands), emacs
- ;; packages can be installed to another profile, and the
- ;; following code will not work (i.e., the autoloads for this
- ;; profile will not be loaded).
- (guix-emacs-autoload-packages guix-current-profile)))
-
-(defun guix-repl-operation-success-message ()
- "Message telling about successful Guix operation."
- (message "Guix operation has been performed."))
-
-(defun guix-get-guile-program (&optional socket)
- "Return a value suitable for `geiser-guile-binary'."
- (if (null socket)
- guix-guile-program
- (append (if (listp guix-guile-program)
- guix-guile-program
- (list guix-guile-program))
- (list (concat "--listen=" socket)))))
-
-(defun guix-repl-socket-file-name ()
- "Return a name of a socket file used by Guix REPL."
- (make-temp-name
- (concat (file-name-as-directory temporary-file-directory)
- "guix-repl-")))
-
-(defun guix-repl-delete-socket-maybe ()
- "Delete `guix-repl-current-socket' file if it exists."
- (and guix-repl-current-socket
- (file-exists-p guix-repl-current-socket)
- (delete-file guix-repl-current-socket)))
-
-(add-hook 'kill-emacs-hook 'guix-repl-delete-socket-maybe)
-
-(defun guix-start-process-maybe (&optional start-msg end-msg)
- "Start Geiser REPL configured for Guix if needed.
-START-MSG and END-MSG are strings displayed in the minibuffer in
-the beginning and in the end of the starting process. If nil,
-display default messages."
- (guix-start-repl-maybe nil
- (or start-msg "Starting Guix REPL ...")
- (or end-msg "Guix REPL has been started."))
- (if guix-use-guile-server
- (guix-start-repl-maybe 'internal)
- (setq guix-internal-repl-buffer guix-repl-buffer)))
-
-(defun guix-start-repl-maybe (&optional internal start-msg end-msg)
- "Start Guix REPL if needed.
-If INTERNAL is non-nil, start an internal REPL.
-
-START-MSG and END-MSG are strings displayed in the minibuffer in
-the beginning and in the end of the process. If nil, do not
-display messages."
- (let* ((repl-var (guix-get-repl-buffer-variable internal))
- (repl (symbol-value repl-var)))
- (unless (and (buffer-live-p repl)
- (get-buffer-process repl))
- (and start-msg (message start-msg))
- (setq guix-repl-operation-p nil)
- (unless internal
- ;; Guile leaves socket file after exit, so remove it if it
- ;; exists (after the REPL restart).
- (guix-repl-delete-socket-maybe)
- (setq guix-repl-current-socket
- (and guix-use-guile-server
- (or guix-repl-current-socket
- (funcall guix-repl-socket-file-name-function)))))
- (let ((geiser-guile-binary (guix-get-guile-program
- (unless internal
- guix-repl-current-socket)))
- (geiser-guile-init-file (unless internal guix-helper-file))
- (repl (get-buffer-create
- (guix-get-repl-buffer-name internal))))
- (guix-start-repl repl (and internal guix-repl-current-socket))
- (set repl-var repl)
- (and end-msg (message end-msg))
- (unless internal
- (run-hooks 'guix-after-start-repl-hook))))))
-
-(defun guix-start-repl (buffer &optional address)
- "Start Guix REPL in BUFFER.
-If ADDRESS is non-nil, connect to a remote guile process using
-this address (it should be defined by
-`geiser-repl--read-address')."
- ;; A mix of the code from `geiser-repl--start-repl' and
- ;; `geiser-repl--to-repl-buffer'.
- (let ((impl 'guile)
- (geiser-guile-load-path (cons (expand-file-name guix-load-path)
- geiser-guile-load-path))
- (geiser-repl-startup-time guix-repl-startup-time))
- (with-current-buffer buffer
- (geiser-repl-mode)
- (geiser-impl--set-buffer-implementation impl)
- (geiser-repl--autodoc-mode -1)
- (goto-char (point-max))
- (let ((prompt (geiser-con--combined-prompt
- geiser-guile--prompt-regexp
- geiser-guile--debugger-prompt-regexp)))
- (geiser-repl--save-remote-data address)
- (geiser-repl--start-scheme impl address prompt)
- (geiser-repl--quit-setup)
- (geiser-repl--history-setup)
- (setq-local geiser-repl--repls (list buffer))
- (geiser-repl--set-this-buffer-repl buffer)
- (setq geiser-repl--connection
- (geiser-con--make-connection
- (get-buffer-process (current-buffer))
- geiser-guile--prompt-regexp
- geiser-guile--debugger-prompt-regexp))
- (geiser-repl--startup impl address)
- (geiser-repl--autodoc-mode 1)
- (geiser-company--setup geiser-repl-company-p)
- (add-hook 'comint-output-filter-functions
- 'guix-repl-output-filter
- nil t)
- (set-process-query-on-exit-flag
- (get-buffer-process (current-buffer))
- geiser-repl-query-on-kill-p)))))
-
-(defun guix-repl-output-filter (str)
- "Filter function suitable for `comint-output-filter-functions'.
-This is a replacement for `geiser-repl--output-filter'."
- (cond
- ((string-match-p geiser-guile--prompt-regexp str)
- (geiser-autodoc--disinhibit-autodoc)
- (when guix-repl-operation-p
- (setq guix-repl-operation-p nil)
- (run-hooks 'guix-after-repl-operation-hook)
- ;; Run hooks specific to the current operation type.
- (when guix-repl-operation-type
- (let ((type-hook (intern
- (concat "guix-after-"
- (symbol-name guix-repl-operation-type)
- "-hook"))))
- (setq guix-repl-operation-type nil)
- (and (boundp type-hook)
- (run-hooks type-hook))))))
- ((string-match geiser-guile--debugger-prompt-regexp str)
- (setq guix-repl-operation-p nil)
- (geiser-con--connection-set-debugging geiser-repl--connection
- (match-beginning 0))
- (geiser-autodoc--disinhibit-autodoc))))
-
-(defun guix-repl-exit (&optional internal no-wait)
- "Exit the current Guix REPL.
-If INTERNAL is non-nil, exit the internal REPL.
-If NO-WAIT is non-nil, do not wait for the REPL process to exit:
-send a kill signal to it and return immediately."
- (let ((repl (symbol-value (guix-get-repl-buffer-variable internal))))
- (when (get-buffer-process repl)
- (with-current-buffer repl
- (geiser-con--connection-deactivate geiser-repl--connection t)
- (comint-kill-subjob)
- (unless no-wait
- (while (get-buffer-process repl)
- (sleep-for 0.1)))))))
-
-(defun guix-get-repl-buffer (&optional internal)
- "Return Guix REPL buffer; start REPL if needed.
-If INTERNAL is non-nil, return an additional internal REPL."
- (guix-start-process-maybe)
- (let ((repl (symbol-value (guix-get-repl-buffer-variable internal))))
- ;; If a new Geiser REPL is started, `geiser-repl--repl' variable may
- ;; be set to the new value in a Guix REPL, so set it back to a
- ;; proper value here.
- (with-current-buffer repl
- (geiser-repl--set-this-buffer-repl repl))
- repl))
-
-(defun guix-get-repl-buffer-variable (&optional internal)
- "Return the name of a variable with a REPL buffer."
- (if internal
- 'guix-internal-repl-buffer
- 'guix-repl-buffer))
-
-(defun guix-get-repl-buffer-name (&optional internal)
- "Return the name of a REPL buffer."
- (if internal
- guix-internal-repl-buffer-name
- guix-repl-buffer-name))
-
-(defun guix-switch-to-repl (&optional internal)
- "Switch to Guix REPL.
-If INTERNAL is non-nil (interactively with prefix), switch to the
-additional internal REPL if it exists."
- (interactive "P")
- (geiser-repl--switch-to-buffer (guix-get-repl-buffer internal)))
-
-
-;;; Guix directory
-
-(defvar guix-directory nil
- "Default directory with Guix source.
-If it is not set by a user, it is set after starting Guile REPL.
-This directory is used to define package locations.")
-
-(defun guix-read-directory ()
- "Return `guix-directory' or prompt for it.
-This function is intended for using in `interactive' forms."
- (if current-prefix-arg
- (read-directory-name "Directory with Guix modules: "
- guix-directory)
- guix-directory))
-
-(defun guix-set-directory ()
- "Set `guix-directory' if needed."
- (or guix-directory
- (setq guix-directory
- (guix-eval-read "%guix-dir"))))
-
-
-;;; Evaluating expressions
-
-(defvar guix-operation-buffer nil
- "Buffer from which the latest Guix operation was performed.")
-
-(defun guix-eval (str)
- "Evaluate STR with guile expression using Guix REPL.
-See `guix-geiser-eval' for details."
- (guix-geiser-eval str (guix-get-repl-buffer 'internal)))
-
-(defun guix-eval-read (str)
- "Evaluate STR with guile expression using Guix REPL.
-See `guix-geiser-eval-read' for details."
- (guix-geiser-eval-read str (guix-get-repl-buffer 'internal)))
-
-(defun guix-eval-in-repl (str &optional operation-buffer operation-type)
- "Switch to Guix REPL and evaluate STR with guile expression there.
-If OPERATION-BUFFER is non-nil, it should be a buffer from which
-the current operation was performed.
-
-If OPERATION-TYPE is non-nil, it should be a symbol. After
-successful executing of the current operation,
-`guix-after-OPERATION-TYPE-hook' is called."
- (run-hooks 'guix-before-repl-operation-hook)
- (setq guix-repl-operation-p t
- guix-repl-operation-type operation-type
- guix-operation-buffer operation-buffer)
- (guix-geiser-eval-in-repl str (guix-get-repl-buffer)))
-
-(provide 'guix-backend)
-
-;;; guix-backend.el ends here
diff --git a/emacs/guix-base.el b/emacs/guix-base.el
deleted file mode 100644
index 658cfdb5fa..0000000000
--- a/emacs/guix-base.el
+++ /dev/null
@@ -1,377 +0,0 @@
-;;; guix-base.el --- Common definitions -*- lexical-binding: t -*-
-
-;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides some base and common definitions for guix.el
-;; package.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'guix-backend)
-(require 'guix-guile)
-(require 'guix-read)
-(require 'guix-utils)
-(require 'guix-ui)
-(require 'guix-profiles)
-
-(defgroup guix nil
- "Settings for Guix package manager and friends."
- :prefix "guix-"
- :group 'external)
-
-(defgroup guix-faces nil
- "Guix faces."
- :group 'guix
- :group 'faces)
-
-(defun guix-package-name-specification (name version &optional output)
- "Return Guix package specification by its NAME, VERSION and OUTPUT."
- (concat name "@" version
- (when output (concat ":" output))))
-
-
-;;; Location of profiles and manifests
-
-(defun guix-generation-file (profile generation)
- "Return the file name of a PROFILE's GENERATION."
- (format "%s-%s-link" profile generation))
-
-(defun guix-packages-profile (profile &optional generation system?)
- "Return a directory where packages are installed for the
-PROFILE's GENERATION.
-
-If SYSTEM? is non-nil, then PROFILE is considered to be a system
-profile. Unlike usual profiles, for a system profile, packages
-are placed in 'profile' subdirectory."
- (let ((profile (if generation
- (guix-generation-file profile generation)
- profile)))
- (if system?
- (expand-file-name "profile" profile)
- profile)))
-
-(defun guix-manifest-file (profile &optional generation system?)
- "Return the file name of a PROFILE's manifest.
-See `guix-packages-profile'."
- (expand-file-name "manifest"
- (guix-packages-profile profile generation system?)))
-
-
-;;; Actions on packages and generations
-
-(defface guix-operation-option-key
- '((t :inherit font-lock-warning-face))
- "Face used for the keys of operation options."
- :group 'guix-faces)
-
-(defcustom guix-operation-confirm t
- "If nil, do not prompt to confirm an operation."
- :type 'boolean
- :group 'guix)
-
-(defcustom guix-use-substitutes t
- "If non-nil, use substitutes for the Guix packages."
- :type 'boolean
- :group 'guix)
-
-(defvar guix-dry-run nil
- "If non-nil, do not perform the real actions, just simulate.")
-
-(defvar guix-temp-buffer-name " *Guix temp*"
- "Name of a buffer used for displaying info before executing operation.")
-
-(defvar guix-operation-option-true-string "yes"
- "String displayed in the mode-line when operation option is t.")
-
-(defvar guix-operation-option-false-string "no "
- "String displayed in the mode-line when operation option is nil.")
-
-(defvar guix-operation-option-separator " | "
- "String used in the mode-line to separate operation options.")
-
-(defvar guix-operation-options
- '((?s "substitutes" guix-use-substitutes)
- (?d "dry-run" guix-dry-run))
- "List of available operation options.
-Each element of the list has a form:
-
- (KEY NAME VARIABLE)
-
-KEY is a character that may be pressed during confirmation to
-toggle the option.
-NAME is a string displayed in the mode-line.
-VARIABLE is a name of an option variable.")
-
-(defun guix-operation-option-by-key (key)
- "Return operation option by KEY (character)."
- (assq key guix-operation-options))
-
-(defun guix-operation-option-key (option)
- "Return key (character) of the operation OPTION."
- (car option))
-
-(defun guix-operation-option-name (option)
- "Return name of the operation OPTION."
- (nth 1 option))
-
-(defun guix-operation-option-variable (option)
- "Return name of the variable of the operation OPTION."
- (nth 2 option))
-
-(defun guix-operation-option-value (option)
- "Return boolean value of the operation OPTION."
- (symbol-value (guix-operation-option-variable option)))
-
-(defun guix-operation-option-string-value (option)
- "Convert boolean value of the operation OPTION to string and return it."
- (if (guix-operation-option-value option)
- guix-operation-option-true-string
- guix-operation-option-false-string))
-
-(defun guix-operation-prompt (&optional prompt)
- "Prompt a user for continuing the current operation.
-Return non-nil, if the operation should be continued; nil otherwise.
-Ask a user with PROMPT for continuing an operation."
- (let* ((option-keys (mapcar #'guix-operation-option-key
- guix-operation-options))
- (keys (append '(?y ?n) option-keys))
- (prompt (concat (propertize (or prompt "Continue operation?")
- 'face 'minibuffer-prompt)
- " ("
- (mapconcat
- (lambda (key)
- (propertize (string key)
- 'face 'guix-operation-option-key))
- keys
- ", ")
- ") ")))
- (let ((mode-line mode-line-format))
- (prog1 (guix-operation-prompt-1 prompt keys)
- (setq mode-line-format mode-line)
- ;; Clear the minibuffer after prompting.
- (message "")))))
-
-(defun guix-operation-prompt-1 (prompt keys)
- "This function is internal for `guix-operation-prompt'."
- (guix-operation-set-mode-line)
- (let ((key (read-char-choice prompt (cons ?\C-g keys) t)))
- (cl-case key
- (?y t)
- ((?n ?\C-g) nil)
- (t (let* ((option (guix-operation-option-by-key key))
- (var (guix-operation-option-variable option)))
- (set var (not (symbol-value var)))
- (guix-operation-prompt-1 prompt keys))))))
-
-(defun guix-operation-set-mode-line ()
- "Display operation options in the mode-line of the current buffer."
- (setq mode-line-format
- (concat (propertize " Options: "
- 'face 'mode-line-buffer-id)
- (mapconcat
- (lambda (option)
- (let ((key (guix-operation-option-key option))
- (name (guix-operation-option-name option))
- (val (guix-operation-option-string-value option)))
- (concat name
- " ("
- (propertize (string key)
- 'face 'guix-operation-option-key)
- "): " val)))
- guix-operation-options
- guix-operation-option-separator)))
- (force-mode-line-update))
-
-(defun guix-package-source-path (package-id)
- "Return a store file path to a source of a package PACKAGE-ID."
- (message "Calculating the source derivation ...")
- (guix-eval-read
- (guix-make-guile-expression
- 'package-source-path package-id)))
-
-(defun guix-package-store-path (package-id)
- "Return a list of store directories of outputs of package PACKAGE-ID."
- (message "Calculating the package derivation ...")
- (guix-eval-read
- (guix-make-guile-expression
- 'package-store-path package-id)))
-
-(defvar guix-after-source-download-hook nil
- "Hook run after successful performing a 'source-download' operation.")
-
-(defun guix-package-source-build-derivation (package-id &optional prompt)
- "Build source derivation of a package PACKAGE-ID.
-Ask a user with PROMPT for continuing an operation."
- (when (or (not guix-operation-confirm)
- (guix-operation-prompt (or prompt
- "Build the source derivation?")))
- (guix-eval-in-repl
- (guix-make-guile-expression
- 'package-source-build-derivation
- package-id
- :use-substitutes? (or guix-use-substitutes 'f)
- :dry-run? (or guix-dry-run 'f))
- nil 'source-download)))
-
-(defun guix-build-package (package-id &optional prompt)
- "Build package with PACKAGE-ID.
-Ask a user with PROMPT for continuing the build operation."
- (when (or (not guix-operation-confirm)
- (guix-operation-prompt (or prompt "Build package?")))
- (guix-eval-in-repl
- (format (concat ",run-in-store "
- "(build-package (package-by-id %d)"
- " #:use-substitutes? %s"
- " #:dry-run? %s)")
- package-id
- (guix-guile-boolean guix-use-substitutes)
- (guix-guile-boolean guix-dry-run)))))
-
-;;;###autoload
-(defun guix-apply-manifest (profile file &optional operation-buffer)
- "Apply manifest from FILE to PROFILE.
-This function has the same meaning as 'guix package --manifest' command.
-See Info node `(guix) Invoking guix package' for details.
-
-Interactively, use the current profile and prompt for manifest
-FILE. With a prefix argument, also prompt for PROFILE."
- (interactive
- (let* ((current-profile (guix-ui-current-profile))
- (profile (if current-prefix-arg
- (guix-profile-prompt)
- (or current-profile guix-current-profile)))
- (file (read-file-name "File with manifest: "))
- (buffer (and current-profile (current-buffer))))
- (list profile file buffer)))
- (when (or (not guix-operation-confirm)
- (y-or-n-p (format "Apply manifest from '%s' to profile '%s'? "
- file profile)))
- (guix-eval-in-repl
- (guix-make-guile-expression
- 'guix-command
- "package"
- (concat "--profile=" (expand-file-name profile))
- (concat "--manifest=" (expand-file-name file)))
- operation-buffer)))
-
-
-;;; Executing guix commands
-
-(defcustom guix-run-in-shell-function #'guix-run-in-shell
- "Function used to run guix command.
-The function is called with a single argument - a command line string."
- :type '(choice (function-item guix-run-in-shell)
- (function-item guix-run-in-eshell)
- (function :tag "Other function"))
- :group 'guix)
-
-(defcustom guix-shell-buffer-name "*shell*"
- "Default name of a shell buffer used for running guix commands."
- :type 'string
- :group 'guix)
-
-(declare-function comint-send-input "comint" t)
-
-(defun guix-run-in-shell (string)
- "Run command line STRING in `guix-shell-buffer-name' buffer."
- (shell guix-shell-buffer-name)
- (goto-char (point-max))
- (insert string)
- (comint-send-input))
-
-(declare-function eshell-send-input "esh-mode" t)
-
-(defun guix-run-in-eshell (string)
- "Run command line STRING in eshell buffer."
- (eshell)
- (goto-char (point-max))
- (insert string)
- (eshell-send-input))
-
-(defun guix-run-command-in-shell (args)
- "Execute 'guix ARGS ...' command in a shell buffer."
- (funcall guix-run-in-shell-function
- (guix-command-string args)))
-
-(defun guix-run-command-in-repl (args)
- "Execute 'guix ARGS ...' command in Guix REPL."
- (guix-eval-in-repl
- (apply #'guix-make-guile-expression
- 'guix-command args)))
-
-(defun guix-command-output (args)
- "Return string with 'guix ARGS ...' output."
- (cl-multiple-value-bind (output error)
- (guix-eval (apply #'guix-make-guile-expression
- 'guix-command-output args))
- ;; Remove trailing new space from the error string.
- (message (replace-regexp-in-string "\n\\'" "" (read error)))
- (read output)))
-
-(defun guix-help-string (&optional commands)
- "Return string with 'guix COMMANDS ... --help' output."
- (guix-eval-read
- (apply #'guix-make-guile-expression
- 'help-string commands)))
-
-
-;;; Pull
-
-(defcustom guix-update-after-pull t
- "If non-nil, update Guix buffers after performing \\[guix-pull]."
- :type 'boolean
- :group 'guix)
-
-(defvar guix-after-pull-hook
- '(guix-restart-repl-after-pull guix-update-buffers-maybe-after-pull)
- "Hook run after successful performing `guix-pull' operation.")
-
-(defun guix-restart-repl-after-pull ()
- "Restart Guix REPL after `guix-pull' operation."
- (guix-repl-exit)
- (guix-start-process-maybe
- "Restarting Guix REPL after pull operation ..."))
-
-(defun guix-update-buffers-maybe-after-pull ()
- "Update buffers depending on `guix-update-after-pull'."
- (when guix-update-after-pull
- (mapc #'guix-ui-update-buffer
- ;; No need to update "generation" buffers.
- (guix-ui-buffers '(guix-package-list-mode
- guix-package-info-mode
- guix-output-list-mode
- guix-output-info-mode)))
- (message "Guix buffers have been updated.")))
-
-;;;###autoload
-(defun guix-pull (&optional verbose)
- "Run Guix pull operation.
-If VERBOSE is non-nil (with prefix argument), produce verbose output."
- (interactive "P")
- (let ((args (and verbose '("--verbose"))))
- (guix-eval-in-repl
- (apply #'guix-make-guile-expression
- 'guix-command "pull" args)
- nil 'pull)))
-
-(provide 'guix-base)
-
-;;; guix-base.el ends here
diff --git a/emacs/guix-buffer.el b/emacs/guix-buffer.el
deleted file mode 100644
index 4cefe9989e..0000000000
--- a/emacs/guix-buffer.el
+++ /dev/null
@@ -1,624 +0,0 @@
-;;; guix-buffer.el --- Buffer interface for displaying data -*- lexical-binding: t -*-
-
-;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides a general 'buffer' interface for displaying an
-;; arbitrary data.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'guix-history)
-(require 'guix-utils)
-
-(defvar guix-buffer-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "l") 'guix-history-back)
- (define-key map (kbd "r") 'guix-history-forward)
- (define-key map (kbd "g") 'revert-buffer)
- (define-key map (kbd "R") 'guix-buffer-redisplay)
- map)
- "Parent keymap for Guix buffer modes.")
-
-
-;;; Buffer item
-
-(cl-defstruct (guix-buffer-item
- (:constructor nil)
- (:constructor guix-buffer-make-item
- (entries buffer-type entry-type args))
- (:copier nil))
- entries buffer-type entry-type args)
-
-(defvar-local guix-buffer-item nil
- "Data (structure) for the current Guix buffer.
-The structure consists of the following elements:
-
-- `entries': list of the currently displayed entries.
-
- Each element of the list is an alist with an entry data of the
- following form:
-
- ((PARAM . VAL) ...)
-
- PARAM is a name of the entry parameter.
- VAL is a value of this parameter.
-
-- `entry-type': type of the currently displayed entries.
-
-- `buffer-type': type of the current buffer.
-
-- `args': search arguments used to get the current entries.")
-(put 'guix-buffer-item 'permanent-local t)
-
-(defmacro guix-buffer-with-item (item &rest body)
- "Evaluate BODY using buffer ITEM.
-The following local variables are available inside BODY:
-`%entries', `%buffer-type', `%entry-type', `%args'.
-See `guix-buffer-item' for details."
- (declare (indent 1) (debug t))
- (let ((item-var (make-symbol "item")))
- `(let ((,item-var ,item))
- (let ((%entries (guix-buffer-item-entries ,item-var))
- (%buffer-type (guix-buffer-item-buffer-type ,item-var))
- (%entry-type (guix-buffer-item-entry-type ,item-var))
- (%args (guix-buffer-item-args ,item-var)))
- ,@body))))
-
-(defmacro guix-buffer-with-current-item (&rest body)
- "Evaluate BODY using `guix-buffer-item'.
-See `guix-buffer-with-item' for details."
- (declare (indent 0) (debug t))
- `(guix-buffer-with-item guix-buffer-item
- ,@body))
-
-(defmacro guix-buffer-define-current-item-accessor (name)
- "Define `guix-buffer-current-NAME' function to access NAME
-element of `guix-buffer-item' structure.
-NAME should be a symbol."
- (let* ((name-str (symbol-name name))
- (accessor (intern (concat "guix-buffer-item-" name-str)))
- (fun-name (intern (concat "guix-buffer-current-" name-str)))
- (doc (format "\
-Return '%s' of the current Guix buffer.
-See `guix-buffer-item' for details."
- name-str)))
- `(defun ,fun-name ()
- ,doc
- (and guix-buffer-item
- (,accessor guix-buffer-item)))))
-
-(defmacro guix-buffer-define-current-item-accessors (&rest names)
- "Define `guix-buffer-current-NAME' functions for NAMES.
-See `guix-buffer-define-current-item-accessor' for details."
- `(progn
- ,@(mapcar (lambda (name)
- `(guix-buffer-define-current-item-accessor ,name))
- names)))
-
-(guix-buffer-define-current-item-accessors
- entries entry-type buffer-type args)
-
-(defmacro guix-buffer-define-current-args-accessor (n prefix name)
- "Define `PREFIX-NAME' function to access Nth element of 'args'
-field of `guix-buffer-item' structure.
-PREFIX and NAME should be strings."
- (let ((fun-name (intern (concat prefix "-" name)))
- (doc (format "\
-Return '%s' of the current Guix buffer.
-'%s' is the element number %d in 'args' of `guix-buffer-item'."
- name name n)))
- `(defun ,fun-name ()
- ,doc
- (nth ,n (guix-buffer-current-args)))))
-
-(defmacro guix-buffer-define-current-args-accessors (prefix &rest names)
- "Define `PREFIX-NAME' functions for NAMES.
-See `guix-buffer-define-current-args-accessor' for details."
- `(progn
- ,@(cl-loop for name in names
- for i from 0
- collect `(guix-buffer-define-current-args-accessor
- ,i ,prefix ,name))))
-
-
-;;; Wrappers for defined variables
-
-(defvar guix-buffer-data nil
- "Alist with 'buffer' data.
-This alist is filled by `guix-buffer-define-interface' macro.")
-
-(defun guix-buffer-value (buffer-type entry-type symbol)
- "Return SYMBOL's value for BUFFER-TYPE/ENTRY-TYPE from `guix-buffer-data'."
- (symbol-value
- (guix-assq-value guix-buffer-data buffer-type entry-type symbol)))
-
-(defun guix-buffer-get-entries (buffer-type entry-type args)
- "Return ENTRY-TYPE entries.
-Call an appropriate 'get-entries' function from `guix-buffer'
-using ARGS as its arguments."
- (apply (guix-buffer-value buffer-type entry-type 'get-entries)
- args))
-
-(defun guix-buffer-mode-enable (buffer-type entry-type)
- "Turn on major mode to display ENTRY-TYPE ENTRIES in BUFFER-TYPE buffer."
- (funcall (guix-buffer-value buffer-type entry-type 'mode)))
-
-(defun guix-buffer-mode-initialize (buffer-type entry-type)
- "Set up the current BUFFER-TYPE buffer to display ENTRY-TYPE entries."
- (let ((fun (guix-buffer-value buffer-type entry-type 'mode-init)))
- (when fun
- (funcall fun))))
-
-(defun guix-buffer-insert-entries (entries buffer-type entry-type)
- "Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer."
- (funcall (guix-buffer-value buffer-type entry-type 'insert-entries)
- entries))
-
-(defun guix-buffer-show-entries-default (entries buffer-type entry-type)
- "Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer."
- (let ((inhibit-read-only t))
- (erase-buffer)
- (guix-buffer-mode-enable buffer-type entry-type)
- (guix-buffer-insert-entries entries buffer-type entry-type)
- (goto-char (point-min))))
-
-(defun guix-buffer-show-entries (entries buffer-type entry-type)
- "Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer."
- (funcall (guix-buffer-value buffer-type entry-type 'show-entries)
- entries))
-
-(defun guix-buffer-message (entries buffer-type entry-type args)
- "Display a message for BUFFER-ITEM after showing entries."
- (let ((fun (guix-buffer-value buffer-type entry-type 'message)))
- (when fun
- (apply fun entries args))))
-
-(defun guix-buffer-name (buffer-type entry-type args)
- "Return name of BUFFER-TYPE buffer for displaying ENTRY-TYPE entries."
- (let ((str-or-fun (guix-buffer-value buffer-type entry-type
- 'buffer-name)))
- (if (stringp str-or-fun)
- str-or-fun
- (apply str-or-fun args))))
-
-(defun guix-buffer-param-title (buffer-type entry-type param)
- "Return PARAM title for BUFFER-TYPE/ENTRY-TYPE."
- (or (guix-assq-value (guix-buffer-value buffer-type entry-type 'titles)
- param)
- ;; Fallback to a title defined in 'info' interface.
- (unless (eq buffer-type 'info)
- (guix-assq-value (guix-buffer-value 'info entry-type 'titles)
- param))
- (guix-symbol-title param)))
-
-(defun guix-buffer-history-size (buffer-type entry-type)
- "Return history size for BUFFER-TYPE/ENTRY-TYPE."
- (guix-buffer-value buffer-type entry-type 'history-size))
-
-(defun guix-buffer-revert-confirm? (buffer-type entry-type)
- "Return 'revert-confirm' value for BUFFER-TYPE/ENTRY-TYPE."
- (guix-buffer-value buffer-type entry-type 'revert-confirm))
-
-
-;;; Displaying entries
-
-(defun guix-buffer-display (buffer)
- "Switch to a Guix BUFFER."
- (pop-to-buffer buffer
- '((display-buffer-reuse-window
- display-buffer-same-window))))
-
-(defun guix-buffer-history-item (buffer-item)
- "Make and return a history item for displaying BUFFER-ITEM."
- (list #'guix-buffer-set buffer-item))
-
-(defun guix-buffer-set (buffer-item &optional history)
- "Set up the current buffer for displaying BUFFER-ITEM.
-HISTORY should be one of the following:
-
- `nil' - do not save BUFFER-ITEM in history,
-
- `add' - add it to history,
-
- `replace' - replace the current history item."
- (guix-buffer-with-item buffer-item
- (when %entries
- ;; Set buffer item before showing entries, so that its value can
- ;; be used by the code for displaying entries.
- (setq guix-buffer-item buffer-item)
- (guix-buffer-show-entries %entries %buffer-type %entry-type)
- (when history
- (funcall (cl-ecase history
- (add #'guix-history-add)
- (replace #'guix-history-replace))
- (guix-buffer-history-item buffer-item))))
- (guix-buffer-message %entries %buffer-type %entry-type %args)))
-
-(defun guix-buffer-display-entries-current
- (entries buffer-type entry-type args &optional history)
- "Show ENTRIES in the current Guix buffer.
-See `guix-buffer-item' for the meaning of BUFFER-TYPE, ENTRY-TYPE
-and ARGS, and `guix-buffer-set' for the meaning of HISTORY."
- (let ((item (guix-buffer-make-item entries buffer-type
- entry-type args)))
- (guix-buffer-set item history)))
-
-(defun guix-buffer-get-display-entries-current
- (buffer-type entry-type args &optional history)
- "Search for entries and show them in the current Guix buffer.
-See `guix-buffer-display-entries-current' for details."
- (guix-buffer-display-entries-current
- (guix-buffer-get-entries buffer-type entry-type args)
- buffer-type entry-type args history))
-
-(defun guix-buffer-display-entries
- (entries buffer-type entry-type args &optional history)
- "Show ENTRIES in a BUFFER-TYPE buffer.
-See `guix-buffer-display-entries-current' for details."
- (let ((buffer (get-buffer-create
- (guix-buffer-name buffer-type entry-type args))))
- (with-current-buffer buffer
- (guix-buffer-display-entries-current
- entries buffer-type entry-type args history))
- (when entries
- (guix-buffer-display buffer))))
-
-(defun guix-buffer-get-display-entries
- (buffer-type entry-type args &optional history)
- "Search for entries and show them in a BUFFER-TYPE buffer.
-See `guix-buffer-display-entries-current' for details."
- (guix-buffer-display-entries
- (guix-buffer-get-entries buffer-type entry-type args)
- buffer-type entry-type args history))
-
-(defun guix-buffer-revert (_ignore-auto noconfirm)
- "Update the data in the current Guix buffer.
-This function is suitable for `revert-buffer-function'.
-See `revert-buffer' for the meaning of NOCONFIRM."
- (guix-buffer-with-current-item
- (when (or noconfirm
- (not (guix-buffer-revert-confirm? %buffer-type %entry-type))
- (y-or-n-p "Update the current buffer? "))
- (guix-buffer-get-display-entries-current
- %buffer-type %entry-type %args 'replace))))
-
-(defvar guix-buffer-after-redisplay-hook nil
- "Hook run by `guix-buffer-redisplay'.
-This hook is called before seting up a window position.")
-
-(defun guix-buffer-redisplay ()
- "Redisplay the current Guix buffer.
-Restore the point and window positions after redisplaying.
-
-This function does not update the buffer data, use
-'\\[revert-buffer]' if you want the full update."
- (interactive)
- (let* ((old-point (point))
- ;; For simplicity, ignore an unlikely case when multiple
- ;; windows display the same buffer.
- (window (car (get-buffer-window-list (current-buffer) nil t)))
- (window-start (and window (window-start window))))
- (guix-buffer-set guix-buffer-item)
- (goto-char old-point)
- (run-hooks 'guix-buffer-after-redisplay-hook)
- (when window
- (set-window-point window (point))
- (set-window-start window window-start))))
-
-(defun guix-buffer-redisplay-goto-button ()
- "Redisplay the current buffer and go to the next button, if needed."
- (let ((guix-buffer-after-redisplay-hook
- (cons (lambda ()
- (unless (button-at (point))
- (forward-button 1)))
- guix-buffer-after-redisplay-hook)))
- (guix-buffer-redisplay)))
-
-
-;;; Interface definers
-
-(defmacro guix-define-groups (type &rest args)
- "Define `guix-TYPE' and `guix-TYPE-faces' custom groups.
-Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
-
-Optional keywords:
-
- - `:parent-group' - name of a parent custom group.
-
- - `:parent-faces-group' - name of a parent custom faces group.
-
- - `:group-doc' - docstring of a `guix-TYPE' group.
-
- - `:faces-group-doc' - docstring of a `guix-TYPE-faces' group."
- (declare (indent 1))
- (let* ((type-str (symbol-name type))
- (prefix (concat "guix-" type-str))
- (group (intern prefix))
- (faces-group (intern (concat prefix "-faces"))))
- (guix-keyword-args-let args
- ((parent-group :parent-group 'guix)
- (parent-faces-group :parent-faces-group 'guix-faces)
- (group-doc :group-doc
- (format "Settings for '%s' buffers."
- type-str))
- (faces-group-doc :faces-group-doc
- (format "Faces for '%s' buffers."
- type-str)))
- `(progn
- (defgroup ,group nil
- ,group-doc
- :group ',parent-group)
-
- (defgroup ,faces-group nil
- ,faces-group-doc
- :group ',group
- :group ',parent-faces-group)))))
-
-(defmacro guix-define-entry-type (entry-type &rest args)
- "Define general code for ENTRY-TYPE.
-See `guix-define-groups'."
- (declare (indent 1))
- `(guix-define-groups ,entry-type
- ,@args))
-
-(defmacro guix-define-buffer-type (buffer-type &rest args)
- "Define general code for BUFFER-TYPE.
-See `guix-define-groups'."
- (declare (indent 1))
- `(guix-define-groups ,buffer-type
- ,@args))
-
-(defmacro guix-buffer-define-interface (buffer-type entry-type &rest args)
- "Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries.
-Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
-In the following description TYPE means ENTRY-TYPE-BUFFER-TYPE.
-
-Required keywords:
-
- - `:buffer-name' - default value of the generated
- `guix-TYPE-buffer-name' variable.
-
- - `:get-entries-function' - default value of the generated
- `guix-TYPE-get-function' variable.
-
- - `:show-entries-function' - default value of the generated
- `guix-TYPE-show-function' variable.
-
- Alternatively, if `:show-entries-function' is not specified, a
- default `guix-TYPE-show-entries' will be generated, and the
- following keyword should be specified instead:
-
- - `:insert-entries-function' - default value of the generated
- `guix-TYPE-insert-function' variable.
-
-Optional keywords:
-
- - `:message-function' - default value of the generated
- `guix-TYPE-message-function' variable.
-
- - `:titles' - default value of the generated
- `guix-TYPE-titles' variable.
-
- - `:history-size' - default value of the generated
- `guix-TYPE-history-size' variable.
-
- - `:revert-confirm?' - default value of the generated
- `guix-TYPE-revert-confirm' variable.
-
- - `:mode-name' - name (a string appeared in the mode-line) of
- the generated `guix-TYPE-mode'.
-
- - `:mode-init-function' - default value of the generated
- `guix-TYPE-mode-initialize-function' variable.
-
- - `:reduced?' - if non-nil, generate only group, faces group
- and titles variable (if specified); all keywords become
- optional."
- (declare (indent 2))
- (let* ((entry-type-str (symbol-name entry-type))
- (buffer-type-str (symbol-name buffer-type))
- (prefix (concat "guix-" entry-type-str "-"
- buffer-type-str))
- (group (intern prefix))
- (faces-group (intern (concat prefix "-faces")))
- (get-entries-var (intern (concat prefix "-get-function")))
- (show-entries-var (intern (concat prefix "-show-function")))
- (show-entries-fun (intern (concat prefix "-show-entries")))
- (message-var (intern (concat prefix "-message-function")))
- (buffer-name-var (intern (concat prefix "-buffer-name")))
- (titles-var (intern (concat prefix "-titles")))
- (history-size-var (intern (concat prefix "-history-size")))
- (revert-confirm-var (intern (concat prefix "-revert-confirm"))))
- (guix-keyword-args-let args
- ((get-entries-val :get-entries-function)
- (show-entries-val :show-entries-function)
- (insert-entries-val :insert-entries-function)
- (mode-name :mode-name (capitalize prefix))
- (mode-init-val :mode-init-function)
- (message-val :message-function)
- (buffer-name-val :buffer-name)
- (titles-val :titles)
- (history-size-val :history-size 20)
- (revert-confirm-val :revert-confirm? t)
- (reduced? :reduced?))
- `(progn
- (defgroup ,group nil
- ,(format "Displaying '%s' entries in '%s' buffer."
- entry-type-str buffer-type-str)
- :group ',(intern (concat "guix-" entry-type-str))
- :group ',(intern (concat "guix-" buffer-type-str)))
-
- (defgroup ,faces-group nil
- ,(format "Faces for displaying '%s' entries in '%s' buffer."
- entry-type-str buffer-type-str)
- :group ',group
- :group ',(intern (concat "guix-" entry-type-str "-faces"))
- :group ',(intern (concat "guix-" buffer-type-str "-faces")))
-
- (defcustom ,titles-var ,titles-val
- ,(format "Alist of titles of '%s' parameters."
- entry-type-str)
- :type '(alist :key-type symbol :value-type string)
- :group ',group)
-
- ,(unless reduced?
- `(progn
- (defvar ,get-entries-var ,get-entries-val
- ,(format "\
-Function used to receive '%s' entries for '%s' buffer."
- entry-type-str buffer-type-str))
-
- (defvar ,show-entries-var
- ,(or show-entries-val `',show-entries-fun)
- ,(format "\
-Function used to show '%s' entries in '%s' buffer."
- entry-type-str buffer-type-str))
-
- (defvar ,message-var ,message-val
- ,(format "\
-Function used to display a message after showing '%s' entries.
-If nil, do not display messages."
- entry-type-str))
-
- (defcustom ,buffer-name-var ,buffer-name-val
- ,(format "\
-Default name of '%s' buffer for displaying '%s' entries.
-May be a string or a function returning a string. The function
-is called with the same arguments as `%S'."
- buffer-type-str entry-type-str get-entries-var)
- :type '(choice string function)
- :group ',group)
-
- (defcustom ,history-size-var ,history-size-val
- ,(format "\
-Maximum number of items saved in history of `%S' buffer.
-If 0, the history is disabled."
- buffer-name-var)
- :type 'integer
- :group ',group)
-
- (defcustom ,revert-confirm-var ,revert-confirm-val
- ,(format "\
-If non-nil, ask to confirm for reverting `%S' buffer."
- buffer-name-var)
- :type 'boolean
- :group ',group)
-
- (guix-alist-put!
- '((get-entries . ,get-entries-var)
- (show-entries . ,show-entries-var)
- (message . ,message-var)
- (buffer-name . ,buffer-name-var)
- (history-size . ,history-size-var)
- (revert-confirm . ,revert-confirm-var))
- 'guix-buffer-data ',buffer-type ',entry-type)
-
- ,(unless show-entries-val
- `(defun ,show-entries-fun (entries)
- ,(format "\
-Show '%s' ENTRIES in the current '%s' buffer."
- entry-type-str buffer-type-str)
- (guix-buffer-show-entries-default
- entries ',buffer-type ',entry-type)))
-
- ,(when (or insert-entries-val
- (null show-entries-val))
- (let ((insert-entries-var
- (intern (concat prefix "-insert-function"))))
- `(progn
- (defvar ,insert-entries-var ,insert-entries-val
- ,(format "\
-Function used to print '%s' entries in '%s' buffer."
- entry-type-str buffer-type-str))
-
- (guix-alist-put!
- ',insert-entries-var 'guix-buffer-data
- ',buffer-type ',entry-type
- 'insert-entries))))
-
- ,(when (or mode-name
- mode-init-val
- (null show-entries-val))
- (let* ((mode-str (concat prefix "-mode"))
- (mode-map-str (concat mode-str "-map"))
- (mode (intern mode-str))
- (parent-mode (intern
- (concat "guix-" buffer-type-str
- "-mode")))
- (mode-var (intern
- (concat mode-str "-function")))
- (mode-init-var (intern
- (concat mode-str
- "-initialize-function"))))
- `(progn
- (defvar ,mode-var ',mode
- ,(format "\
-Major mode for displaying '%s' entries in '%s' buffer."
- entry-type-str buffer-type-str))
-
- (defvar ,mode-init-var ,mode-init-val
- ,(format "\
-Function used to set up '%s' buffer for displaying '%s' entries."
- buffer-type-str entry-type-str))
-
- (define-derived-mode ,mode ,parent-mode ,mode-name
- ,(format "\
-Major mode for displaying '%s' entries in '%s' buffer.
-
-\\{%s}"
- entry-type-str buffer-type-str mode-map-str)
- (setq-local revert-buffer-function
- 'guix-buffer-revert)
- (setq-local guix-history-size
- (guix-buffer-history-size
- ',buffer-type ',entry-type))
- (guix-buffer-mode-initialize
- ',buffer-type ',entry-type))
-
- (guix-alist-put!
- ',mode-var 'guix-buffer-data
- ',buffer-type ',entry-type 'mode)
- (guix-alist-put!
- ',mode-init-var 'guix-buffer-data
- ',buffer-type ',entry-type
- 'mode-init))))))
-
- (guix-alist-put!
- ',titles-var 'guix-buffer-data
- ',buffer-type ',entry-type 'titles)))))
-
-
-(defvar guix-buffer-font-lock-keywords
- (eval-when-compile
- `((,(rx "(" (group (or "guix-buffer-with-item"
- "guix-buffer-with-current-item"
- "guix-buffer-define-interface"
- "guix-define-groups"
- "guix-define-entry-type"
- "guix-define-buffer-type"))
- symbol-end)
- . 1))))
-
-(font-lock-add-keywords 'emacs-lisp-mode guix-buffer-font-lock-keywords)
-
-(provide 'guix-buffer)
-
-;;; guix-buffer.el ends here
diff --git a/emacs/guix-build-log.el b/emacs/guix-build-log.el
deleted file mode 100644
index f67be16326..0000000000
--- a/emacs/guix-build-log.el
+++ /dev/null
@@ -1,381 +0,0 @@
-;;; guix-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 GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides a major mode (`guix-build-log-mode') and a minor mode
-;; (`guix-build-log-minor-mode') for highlighting Guix build logs.
-
-;;; Code:
-
-(require 'guix-utils)
-
-(defgroup guix-build-log nil
- "Settings for `guix-build-log-mode'."
- :group 'guix)
-
-(defgroup guix-build-log-faces nil
- "Faces for `guix-build-log-mode'."
- :group 'guix-build-log
- :group 'guix-faces)
-
-(defface guix-build-log-title-head
- '((t :inherit font-lock-keyword-face))
- "Face for '@' symbol of a log title."
- :group 'guix-build-log-faces)
-
-(defface guix-build-log-title-start
- '((t :inherit guix-build-log-title-head))
- "Face for a log title denoting a start of a process."
- :group 'guix-build-log-faces)
-
-(defface guix-build-log-title-success
- '((t :inherit guix-build-log-title-head))
- "Face for a log title denoting a successful end of a process."
- :group 'guix-build-log-faces)
-
-(defface guix-build-log-title-fail
- '((t :inherit error))
- "Face for a log title denoting a failed end of a process."
- :group 'guix-build-log-faces)
-
-(defface guix-build-log-title-end
- '((t :inherit guix-build-log-title-head))
- "Face for a log title denoting an undefined end of a process."
- :group 'guix-build-log-faces)
-
-(defface guix-build-log-phase-name
- '((t :inherit font-lock-function-name-face))
- "Face for a phase name."
- :group 'guix-build-log-faces)
-
-(defface guix-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 'guix-build-log-faces)
-
-(defface guix-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 'guix-build-log-faces)
-
-(defface guix-build-log-phase-success
- '((t))
- "Face for the 'succeeded' word of a phase line."
- :group 'guix-build-log-faces)
-
-(defface guix-build-log-phase-fail
- '((t :inherit error))
- "Face for the 'failed' word of a phase line."
- :group 'guix-build-log-faces)
-
-(defface guix-build-log-phase-seconds
- '((t :inherit font-lock-constant-face))
- "Face for the number of seconds for a phase."
- :group 'guix-build-log-faces)
-
-(defcustom guix-build-log-minor-mode-activate t
- "If non-nil, then `guix-build-log-minor-mode' is automatically
-activated in `shell-mode' buffers."
- :type 'boolean
- :group 'guix-build-log)
-
-(defcustom guix-build-log-mode-hook '()
- "Hook run after `guix-build-log-mode' is entered."
- :type 'hook
- :group 'guix-build-log)
-
-(defvar guix-build-log-phase-name-regexp "`\\([^']+\\)'"
- "Regexp for a phase name.")
-
-(defvar guix-build-log-phase-start-regexp
- (concat "^starting phase " guix-build-log-phase-name-regexp)
- "Regexp for the start line of a 'build' phase.")
-
-(defun guix-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 guix-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 ,guix-build-log-phase-name-regexp)
- " " (group (regexp ,state-rx)) " after "
- (group (1+ (or digit "."))) " seconds")
- t)))
-
-(defvar guix-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.
- (guix-build-log-phase-end-regexp)
- "Regexp for the end line of a 'build' phase.")
-
-(defvar guix-build-log-font-lock-keywords
- `((,(guix-build-log-title-regexp 'start)
- (1 'guix-build-log-title-head)
- (2 'guix-build-log-title-start))
- (,(guix-build-log-title-regexp 'success)
- (1 'guix-build-log-title-head)
- (2 'guix-build-log-title-success))
- (,(guix-build-log-title-regexp 'fail)
- (1 'guix-build-log-title-head)
- (2 'guix-build-log-title-fail))
- (,(guix-build-log-title-regexp)
- (1 'guix-build-log-title-head)
- (2 'guix-build-log-title-end))
- (,guix-build-log-phase-start-regexp
- (0 'guix-build-log-phase-start)
- (1 'guix-build-log-phase-name prepend))
- (,(guix-build-log-phase-end-regexp 'success)
- (0 'guix-build-log-phase-end)
- (1 'guix-build-log-phase-name prepend)
- (2 'guix-build-log-phase-success prepend)
- (3 'guix-build-log-phase-seconds prepend))
- (,(guix-build-log-phase-end-regexp 'fail)
- (0 'guix-build-log-phase-end)
- (1 'guix-build-log-phase-name prepend)
- (2 'guix-build-log-phase-fail prepend)
- (3 'guix-build-log-phase-seconds prepend)))
- "A list of `font-lock-keywords' for `guix-build-log-mode'.")
-
-(defvar guix-build-log-common-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "M-n") 'guix-build-log-next-phase)
- (define-key map (kbd "M-p") 'guix-build-log-previous-phase)
- (define-key map (kbd "TAB") 'guix-build-log-phase-toggle)
- (define-key map (kbd "<tab>") 'guix-build-log-phase-toggle)
- (define-key map (kbd "<backtab>") 'guix-build-log-phase-toggle-all)
- (define-key map [(shift tab)] 'guix-build-log-phase-toggle-all)
- map)
- "Parent keymap for 'build-log' buffers.
-For `guix-build-log-mode' this map is used as is.
-For `guix-build-log-minor-mode' this map is prefixed with 'C-c'.")
-
-(defvar guix-build-log-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent
- map (make-composed-keymap (list guix-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 `guix-build-log-mode' buffers.")
-
-(defvar guix-build-log-minor-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-c") guix-build-log-common-map)
- map)
- "Keymap for `guix-build-log-minor-mode' buffers.")
-
-(defun guix-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 guix-build-log-phase-start-regexp nil t)
- (unless with-header? (end-of-line))
- (point))))
-
-(defun guix-build-log-phase-end ()
- "Return the end point of the current build phase."
- (save-excursion
- (beginning-of-line)
- (when (re-search-forward guix-build-log-phase-end-regexp nil t)
- (point))))
-
-(defun guix-build-log-phase-hide ()
- "Hide the body of the current build phase."
- (interactive)
- (let ((beg (guix-build-log-phase-start))
- (end (guix-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 (guix-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 guix-build-log-phase-show ()
- "Show the body of the current build phase."
- (interactive)
- (let ((beg (guix-build-log-phase-start))
- (end (guix-build-log-phase-end)))
- (when (and beg end)
- (remove-overlays beg end 'invisible t))))
-
-(defun guix-build-log-phase-hidden-p ()
- "Return non-nil, if the body of the current build phase is hidden."
- (let ((beg (guix-build-log-phase-start)))
- (and beg
- (cl-some (lambda (o)
- (overlay-get o 'invisible))
- (overlays-at beg)))))
-
-(defun guix-build-log-phase-toggle-function ()
- "Return a function to toggle the body of the current build phase."
- (if (guix-build-log-phase-hidden-p)
- #'guix-build-log-phase-show
- #'guix-build-log-phase-hide))
-
-(defun guix-build-log-phase-toggle ()
- "Show/hide the body of the current build phase."
- (interactive)
- (funcall (guix-build-log-phase-toggle-function)))
-
-(defun guix-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 guix-build-log-phase-start-regexp nil t)
- (guix-build-log-phase-toggle-function))))
- (while (re-search-forward guix-build-log-phase-start-regexp nil t)
- (funcall fun)))))
-
-(defun guix-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
- guix-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 guix-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")
- (guix-build-log-next-phase (- (or arg 1))))
-
-;;;###autoload
-(define-derived-mode guix-build-log-mode special-mode
- "Guix-Build-Log"
- "Major mode for viewing Guix build logs.
-
-\\{guix-build-log-mode-map}"
- (setq font-lock-defaults '(guix-build-log-font-lock-keywords t)))
-
-;;;###autoload
-(define-minor-mode guix-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:
-
- (add-hook 'shell-mode-hook 'guix-build-log-minor-mode)
-
-\\{guix-build-log-minor-mode-map}"
- :init-value nil
- :lighter " Guix-Build-Log"
- :keymap guix-build-log-minor-mode-map
- :group 'guix-build-log
- (if guix-build-log-minor-mode
- (font-lock-add-keywords nil guix-build-log-font-lock-keywords)
- (font-lock-remove-keywords nil guix-build-log-font-lock-keywords))
- (when font-lock-mode
- (font-lock-fontify-buffer)))
-
-;;;###autoload
-(defun guix-build-log-minor-mode-activate-maybe ()
- "Activate `guix-build-log-minor-mode' depending on
-`guix-build-log-minor-mode-activate' variable."
- (when guix-build-log-minor-mode-activate
- (guix-build-log-minor-mode)))
-
-(defun guix-build-log-find-file (file-or-url)
- "Open FILE-OR-URL in `guix-build-log-mode'."
- (guix-find-file-or-url file-or-url)
- (guix-build-log-mode))
-
-;;;###autoload
-(add-hook 'shell-mode-hook 'guix-build-log-minor-mode-activate-maybe)
-
-;;;###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)
- 'guix-build-log-mode))
-
-(provide 'guix-build-log)
-
-;;; guix-build-log.el ends here
diff --git a/emacs/guix-command.el b/emacs/guix-command.el
deleted file mode 100644
index 7069c51649..0000000000
--- a/emacs/guix-command.el
+++ /dev/null
@@ -1,830 +0,0 @@
-;;; guix-command.el --- Popup interface for guix commands -*- lexical-binding: t -*-
-
-;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides a magit-like popup interface for running guix
-;; commands in Guix REPL. The entry point is "M-x guix". When it is
-;; called the first time, "guix --help" output is parsed and
-;; `guix-COMMAND-action' functions are generated for each available guix
-;; COMMAND. Then a window with these commands is popped up. When a
-;; particular COMMAND is called, "guix COMMAND --help" output is parsed,
-;; and a user get a new popup window with available options for this
-;; command and so on.
-
-;; To avoid hard-coding all guix options, actions, etc., as much data is
-;; taken from "guix ... --help" outputs as possible. But this data is
-;; still incomplete: not all long options have short analogs, also
-;; special readers should be used for some options (for example, to
-;; complete package names while prompting for a package). So after
-;; parsing --help output, the arguments are "improved". All arguments
-;; (switches, options and actions) are `guix-command-argument'
-;; structures.
-
-;; Only "M-x guix" command is available after this file is loaded. The
-;; rest commands/actions/popups are generated on the fly only when they
-;; are needed (that's why there is a couple of `eval'-s in this file).
-
-;; COMMANDS argument is used by many functions in this file. It means a
-;; list of guix commands without "guix" itself, e.g.: ("build"),
-;; ("import" "gnu"). The empty list stands for the plain "guix" without
-;; subcommands.
-
-;; All actions in popup windows are divided into 2 groups:
-;;
-;; - 'Popup' actions - used to pop up another window. For example, every
-;; action in the 'guix' or 'guix import' window is a popup action. They
-;; are defined by `guix-command-define-popup-action' macro.
-;;
-;; - 'Execute' actions - used to do something with the command line (to
-;; run a command in Guix REPL or to copy it into kill-ring) constructed
-;; with the current popup. They are defined by
-;; `guix-command-define-execute-action' macro.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'guix-popup)
-(require 'guix-utils)
-(require 'guix-help-vars)
-(require 'guix-read)
-(require 'guix-base)
-(require 'guix-build-log)
-(require 'guix-guile)
-(require 'guix-external)
-
-(defgroup guix-commands nil
- "Settings for guix popup windows."
- :group 'guix)
-
-(defvar guix-command-complex-with-shared-arguments
- '("system")
- "List of guix commands which have subcommands with shared options.
-I.e., 'guix foo --help' is the same as 'guix foo bar --help'.")
-
-(defun guix-command-action-name (&optional commands &rest name-parts)
- "Return name of action function for guix COMMANDS."
- (guix-command-symbol (append commands name-parts (list "action"))))
-
-
-;;; Command arguments
-
-(cl-defstruct (guix-command-argument
- (:constructor guix-command-make-argument)
- (:copier guix-command-copy-argument))
- name char doc fun switch? option? action?)
-
-(cl-defun guix-command-modify-argument
- (argument &key
- (name nil name-bound?)
- (char nil char-bound?)
- (doc nil doc-bound?)
- (fun nil fun-bound?)
- (switch? nil switch?-bound?)
- (option? nil option?-bound?)
- (action? nil action?-bound?))
- "Return a modified version of ARGUMENT."
- (declare (indent 1))
- (let ((copy (guix-command-copy-argument argument)))
- (and name-bound? (setf (guix-command-argument-name copy) name))
- (and char-bound? (setf (guix-command-argument-char copy) char))
- (and doc-bound? (setf (guix-command-argument-doc copy) doc))
- (and fun-bound? (setf (guix-command-argument-fun copy) fun))
- (and switch?-bound? (setf (guix-command-argument-switch? copy) switch?))
- (and option?-bound? (setf (guix-command-argument-option? copy) option?))
- (and action?-bound? (setf (guix-command-argument-action? copy) action?))
- copy))
-
-(defun guix-command-modify-argument-from-alist (argument alist)
- "Return a modified version of ARGUMENT or nil if it wasn't modified.
-Each assoc from ALIST have a form (NAME . PLIST). NAME is an
-argument name. PLIST is a property list of argument parameters
-to be modified."
- (let* ((name (guix-command-argument-name argument))
- (plist (guix-assoc-value alist name)))
- (when plist
- (apply #'guix-command-modify-argument
- argument plist))))
-
-(defmacro guix-command-define-argument-improver (name alist)
- "Define NAME variable and function to modify an argument from ALIST."
- (declare (indent 1))
- `(progn
- (defvar ,name ,alist)
- (defun ,name (argument)
- (guix-command-modify-argument-from-alist argument ,name))))
-
-(guix-command-define-argument-improver
- guix-command-improve-action-argument
- '(("container" :char ?C)
- ("graph" :char ?G)
- ("environment" :char ?E)
- ("publish" :char ?u)
- ("pull" :char ?P)
- ("size" :char ?z)))
-
-(guix-command-define-argument-improver
- guix-command-improve-common-argument
- '(("--help" :switch? nil)
- ("--version" :switch? nil)))
-
-(guix-command-define-argument-improver
- guix-command-improve-target-argument
- '(("--target" :char ?T)))
-
-(guix-command-define-argument-improver
- guix-command-improve-system-type-argument
- '(("--system" :fun guix-read-system-type)))
-
-(guix-command-define-argument-improver
- guix-command-improve-load-path-argument
- '(("--load-path" :fun read-directory-name)))
-
-(guix-command-define-argument-improver
- guix-command-improve-search-paths-argument
- '(("--search-paths" :char ?P)))
-
-(guix-command-define-argument-improver
- guix-command-improve-substitute-urls-argument
- '(("--substitute-urls" :char ?U)))
-
-(guix-command-define-argument-improver
- guix-command-improve-hash-argument
- '(("--format" :fun guix-read-hash-format)))
-
-(guix-command-define-argument-improver
- guix-command-improve-key-policy-argument
- '(("--key-download" :fun guix-read-key-policy)))
-
-(defvar guix-command-improve-common-build-argument
- '(("--no-substitutes" :char ?s)
- ("--no-build-hook" :char ?h)
- ("--max-silent-time" :char ?x)
- ("--rounds" :char ?R :fun read-number)
- ("--with-input" :char ?W)))
-
-(defun guix-command-improve-common-build-argument (argument)
- (guix-command-modify-argument-from-alist
- argument
- (append guix-command-improve-load-path-argument
- guix-command-improve-substitute-urls-argument
- guix-command-improve-common-build-argument)))
-
-(guix-command-define-argument-improver
- guix-command-improve-archive-argument
- '(("--generate-key" :char ?k)))
-
-(guix-command-define-argument-improver
- guix-command-improve-build-argument
- '(("--no-grafts" :char ?g)
- ("--file" :fun guix-read-file-name)
- ("--root" :fun guix-read-file-name)
- ("--sources" :char ?S :fun guix-read-source-type :switch? nil)
- ("--with-source" :fun guix-read-file-name)))
-
-(guix-command-define-argument-improver
- guix-command-improve-environment-argument
- '(("--ad-hoc"
- :name "--ad-hoc " :fun guix-read-package-names-string
- :switch? nil :option? t)
- ("--expose" :char ?E)
- ("--share" :char ?S)
- ("--load" :fun guix-read-file-name)))
-
-(guix-command-define-argument-improver
- guix-command-improve-gc-argument
- '(("--list-dead" :char ?D)
- ("--list-live" :char ?L)
- ("--referrers" :char ?f)
- ("--verify" :fun guix-read-verify-options-string)))
-
-(guix-command-define-argument-improver
- guix-command-improve-graph-argument
- '(("--type" :fun guix-read-graph-type)))
-
-(guix-command-define-argument-improver
- guix-command-improve-import-argument
- '(("cran" :char ?r)))
-
-(guix-command-define-argument-improver
- guix-command-improve-import-elpa-argument
- '(("--archive" :fun guix-read-elpa-archive)))
-
-(guix-command-define-argument-improver
- guix-command-improve-lint-argument
- '(("--checkers" :fun guix-read-lint-checker-names-string)))
-
-(guix-command-define-argument-improver
- guix-command-improve-package-argument
- ;; Unlike all other options, --install/--remove do not have a form
- ;; '--install=foo,bar' but '--install foo bar' instead, so we need
- ;; some tweaks.
- '(("--install"
- :name "--install " :fun guix-read-package-names-string
- :switch? nil :option? t)
- ("--remove"
- :name "--remove " :fun guix-read-package-names-string
- :switch? nil :option? t)
- ("--install-from-file" :fun guix-read-file-name)
- ("--manifest" :fun guix-read-file-name)
- ("--profile" :fun guix-read-file-name)
- ("--do-not-upgrade" :char ?U)
- ("--roll-back" :char ?R)
- ("--show" :char ?w :fun guix-read-package-name)))
-
-(guix-command-define-argument-improver
- guix-command-improve-refresh-argument
- '(("--select" :fun guix-read-refresh-subset)
- ("--type" :fun guix-read-refresh-updater-names-string)
- ("--key-server" :char ?S)))
-
-(guix-command-define-argument-improver
- guix-command-improve-size-argument
- '(("--map-file" :fun guix-read-file-name)))
-
-(guix-command-define-argument-improver
- guix-command-improve-system-argument
- '(("disk-image" :char ?D)
- ("vm-image" :char ?V)
- ("--on-error" :char ?E)
- ("--no-grub" :char ?g)
- ("--full-boot" :char ?b)))
-
-(defvar guix-command-argument-improvers
- '((()
- guix-command-improve-action-argument)
- (("archive")
- guix-command-improve-common-build-argument
- guix-command-improve-target-argument
- guix-command-improve-system-type-argument
- guix-command-improve-archive-argument)
- (("build")
- guix-command-improve-common-build-argument
- guix-command-improve-target-argument
- guix-command-improve-system-type-argument
- guix-command-improve-build-argument)
- (("download")
- guix-command-improve-hash-argument)
- (("hash")
- guix-command-improve-hash-argument)
- (("environment")
- guix-command-improve-common-build-argument
- guix-command-improve-search-paths-argument
- guix-command-improve-system-type-argument
- guix-command-improve-environment-argument)
- (("gc")
- guix-command-improve-gc-argument)
- (("graph")
- guix-command-improve-graph-argument)
- (("import")
- guix-command-improve-import-argument)
- (("import" "gnu")
- guix-command-improve-key-policy-argument)
- (("import" "elpa")
- guix-command-improve-import-elpa-argument)
- (("lint")
- guix-command-improve-lint-argument)
- (("package")
- guix-command-improve-common-build-argument
- guix-command-improve-search-paths-argument
- guix-command-improve-package-argument)
- (("refresh")
- guix-command-improve-key-policy-argument
- guix-command-improve-refresh-argument)
- (("size")
- guix-command-improve-system-type-argument
- guix-command-improve-substitute-urls-argument
- guix-command-improve-size-argument)
- (("system")
- guix-command-improve-common-build-argument
- guix-command-improve-system-argument))
- "Alist of guix commands and argument improvers for them.")
-
-(defun guix-command-improve-argument (argument improvers)
- "Return ARGUMENT modified with IMPROVERS."
- (or (cl-some (lambda (improver)
- (funcall improver argument))
- improvers)
- argument))
-
-(defun guix-command-improve-arguments (arguments commands)
- "Return ARGUMENTS for 'guix COMMANDS ...' modified for popup interface."
- (let ((improvers (cons 'guix-command-improve-common-argument
- (guix-assoc-value guix-command-argument-improvers
- commands))))
- (mapcar (lambda (argument)
- (guix-command-improve-argument argument improvers))
- arguments)))
-
-(defun guix-command-parse-arguments (&optional commands)
- "Return a list of parsed 'guix COMMANDS ...' arguments."
- (with-temp-buffer
- (insert (guix-help-string commands))
- (let (args)
- (guix-while-search guix-help-parse-option-regexp
- (let* ((short (match-string-no-properties 1))
- (name (match-string-no-properties 2))
- (arg (match-string-no-properties 3))
- (doc (match-string-no-properties 4))
- (char (if short
- (elt short 1) ; short option letter
- (elt name 2))) ; first letter of the long option
- ;; If "--foo=bar" or "--foo[=bar]" then it is 'option'.
- (option? (not (string= "" arg)))
- ;; If "--foo" or "--foo[=bar]" then it is 'switch'.
- (switch? (or (string= "" arg)
- (eq ?\[ (elt arg 0)))))
- (push (guix-command-make-argument
- :name name
- :char char
- :doc doc
- :switch? switch?
- :option? option?)
- args)))
- (guix-while-search guix-help-parse-command-regexp
- (let* ((name (match-string-no-properties 1))
- (char (elt name 0)))
- (push (guix-command-make-argument
- :name name
- :char char
- :fun (guix-command-action-name commands name)
- :action? t)
- args)))
- args)))
-
-(defun guix-command-rest-argument (&optional commands)
- "Return '--' argument for COMMANDS."
- (cl-flet ((argument (&rest args)
- (apply #'guix-command-make-argument
- :name "-- " :char ?= :option? t args)))
- (let ((command (car commands)))
- (cond
- ((member command
- '("archive" "build" "challenge" "edit"
- "graph" "lint" "refresh"))
- (argument :doc "Packages" :fun 'guix-read-package-names-string))
- ((equal commands '("container" "exec"))
- (argument :doc "PID Command [Args...]"))
- ((string= command "download")
- (argument :doc "URL"))
- ((string= command "environment")
- (argument :doc "Command [Args...]" :fun 'read-shell-command))
- ((string= command "gc")
- (argument :doc "Paths" :fun 'guix-read-file-name))
- ((member command '("hash" "system"))
- (argument :doc "File" :fun 'guix-read-file-name))
- ((string= command "size")
- (argument :doc "Package" :fun 'guix-read-package-name))
- ((equal commands '("import" "nix"))
- (argument :doc "Nixpkgs Attribute"))
- ;; Other 'guix import' subcommands, but not 'import' itself.
- ((and (cdr commands)
- (string= command "import"))
- (argument :doc "Package name"))))))
-
-(defvar guix-command-additional-arguments
- `((("environment")
- ,(guix-command-make-argument
- :name "++packages " :char ?p :option? t
- :doc "build inputs of the specified packages"
- :fun 'guix-read-package-names-string)))
- "Alist of guix commands and additional arguments for them.
-These are 'fake' arguments that are not presented in 'guix' shell
-commands.")
-
-(defun guix-command-additional-arguments (&optional commands)
- "Return additional arguments for COMMANDS."
- (let ((rest-arg (guix-command-rest-argument commands)))
- (append (guix-assoc-value guix-command-additional-arguments
- commands)
- (and rest-arg (list rest-arg)))))
-
-;; Ideally only `guix-command-arguments' function should exist with the
-;; contents of `guix-command-all-arguments', but we need to make a
-;; special case for `guix-command-complex-with-shared-arguments' commands.
-
-(defun guix-command-all-arguments (&optional commands)
- "Return list of all arguments for 'guix COMMANDS ...'."
- (let ((parsed (guix-command-parse-arguments commands)))
- (append (guix-command-improve-arguments parsed commands)
- (guix-command-additional-arguments commands))))
-
-(guix-memoized-defalias guix-command-all-arguments-memoize
- guix-command-all-arguments)
-
-(defun guix-command-arguments (&optional commands)
- "Return list of arguments for 'guix COMMANDS ...'."
- (let ((command (car commands)))
- (if (member command
- guix-command-complex-with-shared-arguments)
- ;; Take actions only for 'guix system', and switches+options for
- ;; 'guix system foo'.
- (funcall (if (null (cdr commands))
- #'cl-remove-if-not
- #'cl-remove-if)
- #'guix-command-argument-action?
- (guix-command-all-arguments-memoize (list command)))
- (guix-command-all-arguments commands))))
-
-(defun guix-command-switch->popup-switch (switch)
- "Return popup switch from command SWITCH argument."
- (list (guix-command-argument-char switch)
- (or (guix-command-argument-doc switch)
- "Unknown")
- (guix-command-argument-name switch)))
-
-(defun guix-command-option->popup-option (option)
- "Return popup option from command OPTION argument."
- (list (guix-command-argument-char option)
- (or (guix-command-argument-doc option)
- "Unknown")
- (let ((name (guix-command-argument-name option)))
- (if (string-match-p " \\'" name) ; ends with space
- name
- (concat name "=")))
- (or (guix-command-argument-fun option)
- 'read-from-minibuffer)))
-
-(defun guix-command-action->popup-action (action)
- "Return popup action from command ACTION argument."
- (list (guix-command-argument-char action)
- (or (guix-command-argument-doc action)
- (guix-command-argument-name action)
- "Unknown")
- (guix-command-argument-fun action)))
-
-(defun guix-command-sort-arguments (arguments)
- "Sort ARGUMENTS by name in alphabetical order."
- (sort arguments
- (lambda (a1 a2)
- (let ((name1 (guix-command-argument-name a1))
- (name2 (guix-command-argument-name a2)))
- (cond ((null name1) nil)
- ((null name2) t)
- (t (string< name1 name2)))))))
-
-(defun guix-command-switches (arguments)
- "Return switches from ARGUMENTS."
- (cl-remove-if-not #'guix-command-argument-switch? arguments))
-
-(defun guix-command-options (arguments)
- "Return options from ARGUMENTS."
- (cl-remove-if-not #'guix-command-argument-option? arguments))
-
-(defun guix-command-actions (arguments)
- "Return actions from ARGUMENTS."
- (cl-remove-if-not #'guix-command-argument-action? arguments))
-
-
-;;; Post processing popup arguments
-
-(defvar guix-command-post-processors
- '(("environment"
- guix-command-post-process-environment-packages
- guix-command-post-process-environment-ad-hoc
- guix-command-post-process-rest-multiple-leave)
- ("hash"
- guix-command-post-process-rest-single)
- ("package"
- guix-command-post-process-package-args)
- ("system"
- guix-command-post-process-rest-single))
- "Alist of guix commands and functions for post-processing
-a list of arguments returned from popup interface.
-Each function is called on the returned arguments in turn.")
-
-(defvar guix-command-rest-arg-regexp
- (rx string-start "-- " (group (+ any)))
- "Regexp to match a string with the 'rest' arguments.")
-
-(defun guix-command-replace-args (args predicate modifier)
- "Replace arguments matching PREDICATE from ARGS.
-Call MODIFIER on each argument matching PREDICATE and append the
-returned list of strings to the end of ARGS. Remove the original
-arguments."
- (let* ((rest nil)
- (args (mapcar (lambda (arg)
- (if (funcall predicate arg)
- (progn
- (push (funcall modifier arg) rest)
- nil)
- arg))
- args)))
- (if rest
- (apply #'append (delq nil args) rest)
- args)))
-
-(cl-defun guix-command-post-process-matching-args (args regexp
- &key group split?)
- "Modify arguments from ARGS matching REGEXP by moving them to
-the end of ARGS list. If SPLIT? is non-nil, split matching
-arguments into multiple subarguments."
- (guix-command-replace-args
- args
- (lambda (arg)
- (string-match regexp arg))
- (lambda (arg)
- (let ((val (match-string (or group 0) arg))
- (fun (if split? #'split-string #'list)))
- (funcall fun val)))))
-
-(defun guix-command-post-process-rest-single (args)
- "Modify ARGS by moving '-- ARG' argument to the end of ARGS list."
- (guix-command-post-process-matching-args
- args guix-command-rest-arg-regexp
- :group 1))
-
-(defun guix-command-post-process-rest-multiple (args)
- "Modify ARGS by splitting '-- ARG ...' into multiple subarguments
-and moving them to the end of ARGS list.
-Remove '-- ' string."
- (guix-command-post-process-matching-args
- args guix-command-rest-arg-regexp
- :group 1
- :split? t))
-
-(defun guix-command-post-process-rest-multiple-leave (args)
- "Modify ARGS by splitting '-- ARG ...' into multiple subarguments
-and moving them to the end of ARGS list.
-Leave '--' string as a separate argument."
- (guix-command-post-process-matching-args
- args guix-command-rest-arg-regexp
- :split? t))
-
-(defun guix-command-post-process-package-args (args)
- "Adjust popup ARGS for 'guix package' command."
- (guix-command-post-process-matching-args
- args (rx string-start (or "--install " "--remove ") (+ any))
- :split? t))
-
-(defun guix-command-post-process-environment-packages (args)
- "Adjust popup ARGS for specified packages of 'guix environment'
-command."
- (guix-command-post-process-matching-args
- args (rx string-start "++packages " (group (+ any)))
- :group 1
- :split? t))
-
-(defun guix-command-post-process-environment-ad-hoc (args)
- "Adjust popup ARGS for '--ad-hoc' argument of 'guix environment'
-command."
- (guix-command-post-process-matching-args
- args (rx string-start "--ad-hoc " (+ any))
- :split? t))
-
-(defun guix-command-post-process-args (commands args)
- "Adjust popup ARGS for guix COMMANDS."
- (let* ((command (car commands))
- (processors
- (append (guix-assoc-value guix-command-post-processors commands)
- (guix-assoc-value guix-command-post-processors command))))
- (guix-modify args
- (or processors
- (list #'guix-command-post-process-rest-multiple)))))
-
-
-;;; 'Execute' actions
-
-(defvar guix-command-default-execute-arguments
- (list
- (guix-command-make-argument
- :name "repl" :char ?r :doc "Run in Guix REPL")
- (guix-command-make-argument
- :name "shell" :char ?s :doc "Run in shell")
- (guix-command-make-argument
- :name "copy" :char ?c :doc "Copy command line"))
- "List of default 'execute' action arguments.")
-
-(defvar guix-command-additional-execute-arguments
- (let ((graph-arg (guix-command-make-argument
- :name "view" :char ?v :doc "View graph")))
- `((("build")
- ,(guix-command-make-argument
- :name "log" :char ?l :doc "View build log"))
- (("graph") ,graph-arg)
- (("size")
- ,(guix-command-make-argument
- :name "view" :char ?v :doc "View map"))
- (("system" "shepherd-graph") ,graph-arg)
- (("system" "extension-graph") ,graph-arg)))
- "Alist of guix commands and additional 'execute' action arguments.")
-
-(defun guix-command-execute-arguments (commands)
- "Return a list of 'execute' action arguments for COMMANDS."
- (mapcar (lambda (arg)
- (guix-command-modify-argument arg
- :action? t
- :fun (guix-command-action-name
- commands (guix-command-argument-name arg))))
- (append guix-command-default-execute-arguments
- (guix-assoc-value
- guix-command-additional-execute-arguments commands))))
-
-(defvar guix-command-special-executors
- '((("environment")
- ("repl" . guix-run-environment-command-in-repl))
- (("pull")
- ("repl" . guix-run-pull-command-in-repl))
- (("build")
- ("log" . guix-run-view-build-log))
- (("graph")
- ("view" . guix-run-view-graph))
- (("size")
- ("view" . guix-run-view-size-map))
- (("system" "shepherd-graph")
- ("view" . guix-run-view-graph))
- (("system" "extension-graph")
- ("view" . guix-run-view-graph)))
- "Alist of guix commands and alists of special executers for them.
-See also `guix-command-default-executors'.")
-
-(defvar guix-command-default-executors
- '(("repl" . guix-run-command-in-repl)
- ("shell" . guix-run-command-in-shell)
- ("copy" . guix-copy-command-as-kill))
- "Alist of default executers for action names.")
-
-(defun guix-command-executor (commands name)
- "Return function to run command line arguments for guix COMMANDS."
- (or (guix-assoc-value guix-command-special-executors commands name)
- (guix-assoc-value guix-command-default-executors name)))
-
-(defun guix-run-environment-command-in-repl (args)
- "Run 'guix ARGS ...' environment command in Guix REPL."
- ;; As 'guix environment' usually tries to run another process, it may
- ;; be fun but not wise to run this command in Geiser REPL.
- (when (or (member "--dry-run" args)
- (member "--search-paths" args)
- (when (y-or-n-p
- (format "'%s' command will spawn an external process.
-Do you really want to execute this command in Geiser REPL? "
- (guix-command-string args)))
- (message "May \"M-x shell-mode\" be with you!")
- t))
- (guix-run-command-in-repl args)))
-
-(defun guix-run-pull-command-in-repl (args)
- "Run 'guix ARGS ...' pull command in Guix REPL.
-Perform pull-specific actions after operation, see
-`guix-after-pull-hook' and `guix-update-after-pull'."
- (guix-eval-in-repl
- (apply #'guix-make-guile-expression 'guix-command args)
- nil 'pull))
-
-(defun guix-run-view-build-log (args)
- "Add --log-file to ARGS, run 'guix ARGS ...' build command, and
-open the log file(s)."
- (let* ((args (if (member "--log-file" args)
- args
- (cl-list* (car args) "--log-file" (cdr args))))
- (output (guix-command-output args))
- (files (split-string output "\n" t)))
- (dolist (file files)
- (guix-build-log-find-file file))))
-
-(defun guix-run-view-graph (args)
- "Run 'guix ARGS ...' graph command, make the image and open it."
- (let* ((graph-file (guix-dot-file-name))
- (dot-args (guix-dot-arguments graph-file)))
- (if (guix-eval-read (guix-make-guile-expression
- 'pipe-guix-output args dot-args))
- (guix-find-file graph-file)
- (error "Couldn't create a graph"))))
-
-(defun guix-run-view-size-map (args)
- "Run 'guix ARGS ...' size command, and open the map file."
- (let* ((wished-map-file
- (cl-some (lambda (arg)
- (and (string-match "--map-file=\\(.+\\)" arg)
- (match-string 1 arg)))
- args))
- (map-file (or wished-map-file (guix-png-file-name)))
- (args (if wished-map-file
- args
- (cl-list* (car args)
- (concat "--map-file=" map-file)
- (cdr args)))))
- (guix-command-output args)
- (guix-find-file map-file)))
-
-
-;;; Generating popups, actions, etc.
-
-(defmacro guix-command-define-popup-action (name &optional commands)
- "Define NAME function to generate (if needed) and run popup for COMMANDS."
- (declare (indent 1) (debug t))
- (let* ((popup-fun (guix-command-symbol `(,@commands "popup")))
- (doc (format "Call `%s' (generate it if needed)."
- popup-fun)))
- `(defun ,name (&optional arg)
- ,doc
- (interactive "P")
- (unless (fboundp ',popup-fun)
- (guix-command-generate-popup ',popup-fun ',commands))
- (,popup-fun arg))))
-
-(defmacro guix-command-define-execute-action (name executor
- &optional commands)
- "Define NAME function to execute the current action for guix COMMANDS.
-EXECUTOR function is called with the current command line arguments."
- (declare (indent 1) (debug t))
- (let* ((arguments-fun (guix-command-symbol `(,@commands "arguments")))
- (doc (format "Call `%s' with the current popup arguments."
- executor)))
- `(defun ,name (&rest args)
- ,doc
- (interactive (,arguments-fun))
- (,executor (append ',commands
- (guix-command-post-process-args
- ',commands args))))))
-
-(defun guix-command-generate-popup-actions (actions &optional commands)
- "Generate 'popup' commands from ACTIONS arguments for guix COMMANDS."
- (dolist (action actions)
- (let ((fun (guix-command-argument-fun action)))
- (unless (fboundp fun)
- (eval `(guix-command-define-popup-action ,fun
- ,(append commands
- (list (guix-command-argument-name action)))))))))
-
-(defun guix-command-generate-execute-actions (actions &optional commands)
- "Generate 'execute' commands from ACTIONS arguments for guix COMMANDS."
- (dolist (action actions)
- (let ((fun (guix-command-argument-fun action)))
- (unless (fboundp fun)
- (eval `(guix-command-define-execute-action ,fun
- ,(guix-command-executor
- commands (guix-command-argument-name action))
- ,commands))))))
-
-(defun guix-command-generate-popup (name &optional commands)
- "Define NAME popup with 'guix COMMANDS ...' interface."
- (let* ((command (car commands))
- (man-page (concat "guix" (and command (concat "-" command))))
- (doc (format "Popup window for '%s' command."
- (guix-concat-strings (cons "guix" commands)
- " ")))
- (args (guix-command-arguments commands))
- (switches (guix-command-sort-arguments
- (guix-command-switches args)))
- (options (guix-command-sort-arguments
- (guix-command-options args)))
- (popup-actions (guix-command-sort-arguments
- (guix-command-actions args)))
- (execute-actions (unless popup-actions
- (guix-command-execute-arguments commands)))
- (actions (or popup-actions execute-actions)))
- (if popup-actions
- (guix-command-generate-popup-actions popup-actions commands)
- (guix-command-generate-execute-actions execute-actions commands))
- (eval
- `(guix-define-popup ,name
- ,doc
- 'guix-commands
- :man-page ,man-page
- :switches ',(mapcar #'guix-command-switch->popup-switch switches)
- :options ',(mapcar #'guix-command-option->popup-option options)
- :actions ',(mapcar #'guix-command-action->popup-action actions)
- :max-action-columns 4))))
-
-;;;###autoload (autoload 'guix "guix-command" "Popup window for 'guix'." t)
-(guix-command-define-popup-action guix)
-
-(defalias 'guix-edit-action #'guix-edit)
-
-
-(defvar guix-command-font-lock-keywords
- (eval-when-compile
- `((,(rx "("
- (group "guix-command-define-"
- (or "popup-action"
- "execute-action"
- "argument-improver"))
- 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-command-font-lock-keywords)
-
-(provide 'guix-command)
-
-;;; guix-command.el ends here
diff --git a/emacs/guix-config.el.in b/emacs/guix-config.el.in
deleted file mode 100644
index c09c2fe86a..0000000000
--- a/emacs/guix-config.el.in
+++ /dev/null
@@ -1,44 +0,0 @@
-;;; guix-config.el --- Compile-time configuration of Guix.
-
-;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
-;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(defconst guix-config-name "@PACKAGE_NAME@"
- "Guix full name.")
-
-(defconst guix-config-version "@PACKAGE_VERSION@"
- "Guix version.")
-
-(defconst guix-config-emacs-interface-directory
- (replace-regexp-in-string "${prefix}" "@prefix@" "@emacsuidir@"))
-
-(defconst guix-config-state-directory
- ;; This must match `NIX_STATE_DIR' as defined in `nix/local.mk'.
- (or (getenv "NIX_STATE_DIR") "@guix_localstatedir@/guix"))
-
-(defconst guix-config-guile-program "@GUILE@"
- "Name of the 'guile' executable defined at configure time.")
-
-(defconst guix-config-dot-program "@DOT_USER_PROGRAM@"
- "Name of the 'dot' executable defined at configure time.")
-
-(provide 'guix-config)
-
-;;; guix-config.el ends here
diff --git a/emacs/guix-devel.el b/emacs/guix-devel.el
deleted file mode 100644
index b71670cdfb..0000000000
--- a/emacs/guix-devel.el
+++ /dev/null
@@ -1,382 +0,0 @@
-;;; guix-devel.el --- Development tools -*- lexical-binding: t -*-
-
-;; Copyright © 2015 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides commands useful for developing Guix (or even
-;; arbitrary Guile code) with Geiser.
-
-;;; Code:
-
-(require 'lisp-mode)
-(require 'guix-guile)
-(require 'guix-geiser)
-(require 'guix-utils)
-(require 'guix-base)
-
-(defgroup guix-devel nil
- "Settings for Guix development utils."
- :group 'guix)
-
-(defgroup guix-devel-faces nil
- "Faces for `guix-devel-mode'."
- :group 'guix-devel
- :group 'guix-faces)
-
-(defface guix-devel-modify-phases-keyword
- '((t :inherit font-lock-preprocessor-face))
- "Face for a `modify-phases' keyword ('delete', 'replace', etc.)."
- :group 'guix-devel-faces)
-
-(defface guix-devel-gexp-symbol
- '((t :inherit font-lock-keyword-face))
- "Face for gexp symbols ('#~', '#$', etc.).
-See Info node `(guix) G-Expressions'."
- :group 'guix-devel-faces)
-
-(defcustom guix-devel-activate-mode t
- "If non-nil, then `guix-devel-mode' is automatically activated
-in Scheme buffers."
- :type 'boolean
- :group 'guix-devel)
-
-(defun guix-devel-use-modules (&rest modules)
- "Use guile MODULES."
- (apply #'guix-geiser-call "use-modules" modules))
-
-(defun guix-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 (guix-guile-current-module)))
- (guix-devel-use-modules module)
- (message "Using %s module." module))
-
-(defun guix-devel-copy-module-as-kill ()
- "Put the name of the current guile module into `kill-ring'."
- (interactive)
- (guix-copy-as-kill (guix-guile-current-module)))
-
-(defun guix-devel-setup-repl (&optional repl)
- "Setup REPL for using `guix-devel-...' commands."
- (guix-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.
- (guix-geiser-eval-in-repl-synchronously
- "(begin
- (guix-warning-port (current-warning-port))
- (current-build-output-port (current-error-port)))"
- repl 'no-history 'no-display))
-
-(defvar guix-devel-repl-processes nil
- "List of REPL processes configured by `guix-devel-setup-repl'.")
-
-(defun guix-devel-setup-repl-maybe (&optional repl)
- "Setup (if needed) REPL for using `guix-devel-...' commands."
- (let ((process (get-buffer-process (or repl (guix-geiser-repl)))))
- (when (and process
- (not (memq process guix-devel-repl-processes)))
- (guix-devel-setup-repl repl)
- (push process guix-devel-repl-processes))))
-
-(defmacro guix-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 (guix-guile-current-definition)))
- (guix-devel-setup-repl-maybe)
- (guix-devel-use-modules (guix-guile-current-module))
- ,@body))
-
-(defun guix-devel-build-package-definition ()
- "Build a package defined by the current top-level variable definition."
- (interactive)
- (guix-devel-with-definition def
- (when (or (not guix-operation-confirm)
- (guix-operation-prompt (format "Build '%s'?" def)))
- (guix-geiser-eval-in-repl
- (concat ",run-in-store "
- (guix-guile-make-call-expression
- "build-package" def
- "#:use-substitutes?" (guix-guile-boolean
- guix-use-substitutes)
- "#:dry-run?" (guix-guile-boolean guix-dry-run)))))))
-
-(defun guix-devel-build-package-source ()
- "Build the source of the current package definition."
- (interactive)
- (guix-devel-with-definition def
- (when (or (not guix-operation-confirm)
- (guix-operation-prompt
- (format "Build '%s' package source?" def)))
- (guix-geiser-eval-in-repl
- (concat ",run-in-store "
- (guix-guile-make-call-expression
- "build-package-source" def
- "#:use-substitutes?" (guix-guile-boolean
- guix-use-substitutes)
- "#:dry-run?" (guix-guile-boolean guix-dry-run)))))))
-
-(defun guix-devel-lint-package ()
- "Check the current package.
-See Info node `(guix) Invoking guix lint' for details."
- (interactive)
- (guix-devel-with-definition def
- (guix-devel-use-modules "(guix scripts lint)")
- (when (or (not guix-operation-confirm)
- (y-or-n-p (format "Lint '%s' package?" def)))
- (guix-geiser-eval-in-repl
- (format "(run-checkers %s)" def)))))
-
-
-;;; Font-lock
-
-(defvar guix-devel-modify-phases-keyword-regexp
- (rx (+ word))
- "Regexp for a 'modify-phases' keyword ('delete', 'replace', etc.).")
-
-(defun guix-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 guix-devel-modify-phases-keyword-regexp
- limit t)
- (set-match-data nil))
- (up-list)
- t))
-
-(defun guix-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 guix-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-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"
- "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 guix-devel-font-lock-keywords
- `((,(rx (or "#~" "#$" "#$@" "#+" "#+@")) .
- 'guix-devel-gexp-symbol)
- (,(guix-guile-keyword-regexp (regexp-opt guix-devel-keywords))
- (1 'font-lock-keyword-face))
- (,(guix-guile-keyword-regexp "modify-phases")
- (1 'font-lock-keyword-face)
- (guix-devel-modify-phases-font-lock-matcher
- (guix-devel-modify-phases-font-lock-pre)
- nil
- (0 'guix-devel-modify-phases-keyword nil t))))
- "A list of `font-lock-keywords' for `guix-devel-mode'.")
-
-
-;;; Indentation
-
-(defmacro guix-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 guix-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 guix-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 'guix-devel-indent-modify-phases-keyword-1
- (guix-devel-indent-modify-phases-keyword 1))
-(defalias 'guix-devel-indent-modify-phases-keyword-2
- (guix-devel-indent-modify-phases-keyword 2))
-
-(guix-devel-scheme-indent
- (bag 0)
- (build-system 0)
- (call-with-compressed-output-port 2)
- (call-with-container 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)
- (mlet 2)
- (mlet* 2)
- (modify-phases 1)
- (modify-services 1)
- (munless 1)
- (mwhen 1)
- (operating-system 0)
- (origin 0)
- (package 'guix-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 'guix-devel-indent-modify-phases-keyword-1)
- (add-after 'guix-devel-indent-modify-phases-keyword-2)
- (add-before 'guix-devel-indent-modify-phases-keyword-2))
-
-
-(defvar guix-devel-keys-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "b") 'guix-devel-build-package-definition)
- (define-key map (kbd "s") 'guix-devel-build-package-source)
- (define-key map (kbd "l") 'guix-devel-lint-package)
- (define-key map (kbd "k") 'guix-devel-copy-module-as-kill)
- (define-key map (kbd "u") 'guix-devel-use-module)
- map)
- "Keymap with subkeys for `guix-devel-mode-map'.")
-
-(defvar guix-devel-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-c .") guix-devel-keys-map)
- map)
- "Keymap for `guix-devel-mode'.")
-
-;;;###autoload
-(define-minor-mode guix-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 provides the following key
-bindings:
-
-\\{guix-devel-mode-map}"
- :init-value nil
- :lighter " Guix"
- :keymap guix-devel-mode-map
- (if guix-devel-mode
- (progn
- (setq-local font-lock-multiline t)
- (font-lock-add-keywords nil guix-devel-font-lock-keywords))
- (setq-local font-lock-multiline nil)
- (font-lock-remove-keywords nil guix-devel-font-lock-keywords))
- (when font-lock-mode
- (font-lock-fontify-buffer)))
-
-;;;###autoload
-(defun guix-devel-activate-mode-maybe ()
- "Activate `guix-devel-mode' depending on
-`guix-devel-activate-mode' variable."
- (when guix-devel-activate-mode
- (guix-devel-mode)))
-
-;;;###autoload
-(add-hook 'scheme-mode-hook 'guix-devel-activate-mode-maybe)
-
-
-(defvar guix-devel-emacs-font-lock-keywords
- (eval-when-compile
- `((,(rx "(" (group "guix-devel-with-definition") symbol-end) . 1))))
-
-(font-lock-add-keywords 'emacs-lisp-mode
- guix-devel-emacs-font-lock-keywords)
-
-(provide 'guix-devel)
-
-;;; guix-devel.el ends here
diff --git a/emacs/guix-entry.el b/emacs/guix-entry.el
deleted file mode 100644
index 5eed2ed015..0000000000
--- a/emacs/guix-entry.el
+++ /dev/null
@@ -1,59 +0,0 @@
-;;; guix-entry.el --- 'Entry' type -*- lexical-binding: t -*-
-
-;; Copyright © 2015 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides an API for 'entry' type which is just an alist of
-;; KEY/VALUE pairs (KEY should be a symbol) with the required 'id' KEY.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'guix-utils)
-
-(defalias 'guix-entry-value #'guix-assq-value)
-
-(defun guix-entry-id (entry)
- "Return ENTRY ID."
- (guix-entry-value entry 'id))
-
-(defun guix-entry-by-id (id entries)
- "Return an entry from ENTRIES by its ID."
- (cl-find-if (lambda (entry)
- (equal (guix-entry-id entry) id))
- entries))
-
-(defun guix-entries-by-ids (ids entries)
- "Return entries with IDS (a list of identifiers) from ENTRIES."
- (cl-remove-if-not (lambda (entry)
- (member (guix-entry-id entry) ids))
- entries))
-
-(defun guix-replace-entry (id new-entry entries)
- "Replace an entry with ID from ENTRIES by NEW-ENTRY.
-Return a list of entries with the replaced entry."
- (cl-substitute-if new-entry
- (lambda (entry)
- (equal id (guix-entry-id entry)))
- entries
- :count 1))
-
-(provide 'guix-entry)
-
-;;; guix-entry.el ends here
diff --git a/emacs/guix-external.el b/emacs/guix-external.el
deleted file mode 100644
index f571ffd845..0000000000
--- a/emacs/guix-external.el
+++ /dev/null
@@ -1,88 +0,0 @@
-;;; guix-external.el --- External programs -*- lexical-binding: t -*-
-
-;; Copyright © 2015 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides auxiliary code for running external programs.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'guix-config)
-
-(defgroup guix-external nil
- "Settings for external programs."
- :group 'guix)
-
-(defcustom guix-guile-program guix-config-guile-program
- "Name of the 'guile' executable used for Guix REPL.
-May be either a string (the name of the executable) or a list of
-strings of the form:
-
- (NAME . ARGS)
-
-Where ARGS is a list of arguments to the guile program."
- :type 'string
- :group 'guix-external)
-
-(defcustom guix-dot-program
- (if (file-name-absolute-p guix-config-dot-program)
- guix-config-dot-program
- (executable-find "dot"))
- "Name of the 'dot' executable."
- :type 'string
- :group 'guix-external)
-
-(defcustom guix-dot-default-arguments
- '("-Tpng")
- "Default arguments for 'dot' program."
- :type '(repeat string)
- :group 'guix-external)
-
-(defcustom guix-dot-file-name-function #'guix-png-file-name
- "Function used to define a file name of a temporary 'dot' file.
-The function is called without arguments."
- :type '(choice (function-item guix-png-file-name)
- (function :tag "Other function"))
- :group 'guix-external)
-
-(defun guix-dot-arguments (output-file &rest args)
- "Return a list of dot arguments for writing a graph into OUTPUT-FILE.
-If ARGS is nil, use `guix-dot-default-arguments'."
- (or guix-dot-program
- (error (concat "Couldn't find 'dot'.\n"
- "Set guix-dot-program to a proper value")))
- (cl-list* guix-dot-program
- (concat "-o" output-file)
- (or args guix-dot-default-arguments)))
-
-(defun guix-dot-file-name ()
- "Call `guix-dot-file-name-function'."
- (funcall guix-dot-file-name-function))
-
-(defun guix-png-file-name ()
- "Return '.png' file name in the `temporary-file-directory'."
- (concat (make-temp-name
- (concat (file-name-as-directory temporary-file-directory)
- "guix-emacs-graph-"))
- ".png"))
-
-(provide 'guix-external)
-
-;;; guix-external.el ends here
diff --git a/emacs/guix-geiser.el b/emacs/guix-geiser.el
deleted file mode 100644
index 833f5bb2b3..0000000000
--- a/emacs/guix-geiser.el
+++ /dev/null
@@ -1,126 +0,0 @@
-;;; guix-geiser.el --- Interacting with Geiser -*- lexical-binding: t -*-
-
-;; Copyright © 2015 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides functions to evaluate guile code using Geiser.
-
-;;; Code:
-
-(require 'geiser-mode)
-(require 'guix-guile)
-
-(defun guix-geiser-repl ()
- "Return the current Geiser REPL."
- (or geiser-repl--repl
- (geiser-repl--repl/impl 'guile)
- (error "Geiser REPL not found")))
-
-(defun guix-geiser-eval (str &optional repl)
- "Evaluate STR with guile expression using Geiser REPL.
-If REPL is nil, use the current Geiser REPL.
-Return a list of strings with result values of evaluation."
- (with-current-buffer (or repl (guix-geiser-repl))
- (let ((res (geiser-eval--send/wait `(:eval (:scm ,str)))))
- (if (geiser-eval--retort-error res)
- (error "Error in evaluating guile expression: %s"
- (geiser-eval--retort-output res))
- (cdr (assq 'result res))))))
-
-(defun guix-geiser-eval-read (str &optional repl)
- "Evaluate STR with guile expression using Geiser REPL.
-Return elisp expression of the first result value of evaluation."
- ;; The goal is to convert a string with scheme expression into elisp
- ;; expression.
- (let ((result (car (guix-geiser-eval str repl))))
- (cond
- ((or (string= result "#f")
- (string= result "#<unspecified>"))
- nil)
- ((string= result "#t")
- t)
- (t
- (read (replace-regexp-in-string
- "[ (]\\(#f\\)" "nil"
- (replace-regexp-in-string
- "[ (]\\(#t\\)" "t"
- result
- nil nil 1)
- nil nil 1))))))
-
-(defun guix-repl-send (cmd &optional save-history)
- "Send CMD input string to the current REPL buffer.
-This is the same as `geiser-repl--send', but with SAVE-HISTORY
-argument. If SAVE-HISTORY is non-nil, save CMD in the REPL
-history."
- (when (and cmd (eq major-mode 'geiser-repl-mode))
- (geiser-repl--prepare-send)
- (goto-char (point-max))
- (comint-kill-input)
- (insert cmd)
- (let ((comint-input-filter (if save-history
- comint-input-filter
- 'ignore)))
- (comint-send-input nil t))))
-
-(defun guix-geiser-eval-in-repl (str &optional repl no-history no-display)
- "Switch to Geiser REPL and evaluate STR with guile expression there.
-If NO-HISTORY is non-nil, do not save STR in the REPL history.
-If NO-DISPLAY is non-nil, do not switch to the REPL buffer."
- (let ((repl (or repl (guix-geiser-repl))))
- (with-current-buffer repl
- ;; XXX Since Geiser 0.8, `geiser-repl--send' has SAVE-HISTORY
- ;; argument, so use this function eventually and remove
- ;; `guix-repl-send'.
- (guix-repl-send str (not no-history)))
- (unless no-display
- (geiser-repl--switch-to-buffer repl))))
-
-(defun guix-geiser-eval-in-repl-synchronously (str &optional repl
- no-history no-display)
- "Evaluate STR in Geiser REPL synchronously, i.e. wait until the
-REPL operation will be finished.
-See `guix-geiser-eval-in-repl' for the meaning of arguments."
- (let* ((repl (if repl (get-buffer repl) (guix-geiser-repl)))
- (running? nil)
- (filter (lambda (output)
- (setq running?
- (and (get-buffer-process repl)
- (not (guix-guile-prompt? output))))))
- (comint-output-filter-functions
- (cons filter comint-output-filter-functions)))
- (guix-geiser-eval-in-repl str repl no-history no-display)
- (while running?
- (sleep-for 0.1))))
-
-(defun guix-geiser-call (proc &rest args)
- "Call (PROC ARGS ...) synchronously using the current Geiser REPL.
-PROC and ARGS should be strings."
- (guix-geiser-eval
- (apply #'guix-guile-make-call-expression proc args)))
-
-(defun guix-geiser-call-in-repl (proc &rest args)
- "Call (PROC ARGS ...) in the current Geiser REPL.
-PROC and ARGS should be strings."
- (guix-geiser-eval-in-repl
- (apply #'guix-guile-make-call-expression proc args)))
-
-(provide 'guix-geiser)
-
-;;; guix-geiser.el ends here
diff --git a/emacs/guix-guile.el b/emacs/guix-guile.el
deleted file mode 100644
index 792f825ca5..0000000000
--- a/emacs/guix-guile.el
+++ /dev/null
@@ -1,98 +0,0 @@
-;;; guix-guile.el --- Auxiliary tools for working with guile code -*- lexical-binding: t -*-
-
-;; Copyright © 2015 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides functions for parsing guile code, making guile
-;; expressions, etc.
-
-;;; Code:
-
-(require 'geiser-guile)
-
-(defvar guix-guile-definition-regexp
- (rx bol "(define"
- (zero-or-one "*")
- (zero-or-one "-public")
- (one-or-more space)
- (zero-or-one "(")
- (group (one-or-more (or word (syntax symbol)))))
- "Regexp used to find the guile definition.")
-
-(defun guix-guile-current-definition ()
- "Return string with name of the current top-level guile definition."
- (save-excursion
- (beginning-of-defun)
- (if (looking-at guix-guile-definition-regexp)
- (match-string-no-properties 1)
- (error "Couldn't find the current definition"))))
-
-(defun guix-guile-current-module ()
- "Return a string with the current guile module.
-Return nil, if current buffer does not define a module."
- ;; Modified version of `geiser-guile--get-module'.
- (save-excursion
- (geiser-syntax--pop-to-top)
- (when (or (re-search-backward geiser-guile--module-re nil t)
- (looking-at geiser-guile--library-re)
- (re-search-forward geiser-guile--module-re nil t))
- (match-string-no-properties 1))))
-
-(defun guix-guile-boolean (arg)
- "Return a string with guile boolean value.
-Transform elisp ARG (nil or non-nil) to the guile boolean (#f or #t)."
- (if arg "#t" "#f"))
-
-(defun guix-guile-keyword-regexp (keyword)
- "Return regexp to find guile KEYWORD."
- (format "(\\(%s\\)\\_>" keyword))
-
-(defun guix-guile-make-call-expression (proc &rest args)
- "Return \"(PROC ARGS ...)\" string.
-PROC and ARGS should be strings."
- (format "(%s %s)"
- proc
- (mapconcat #'identity args " ")))
-
-(defun guix-make-guile-expression (fun &rest args)
- "Return string containing a guile expression for calling FUN with ARGS."
- (format "(%S %s)" fun
- (mapconcat
- (lambda (arg)
- (cond
- ((null arg) "'()")
- ((or (eq arg t)
- ;; An ugly hack to separate 'false' from nil.
- (equal arg 'f)
- (keywordp arg))
- (concat "#" (prin1-to-string arg t)))
- ((or (symbolp arg) (listp arg))
- (concat "'" (prin1-to-string arg)))
- (t (prin1-to-string arg))))
- args
- " ")))
-
-(defun guix-guile-prompt? (string)
- "Return non-nil, if STRING contains a Guile prompt."
- (or (string-match-p geiser-guile--prompt-regexp string)
- (string-match-p geiser-guile--debugger-prompt-regexp string)))
-
-(provide 'guix-guile)
-
-;;; guix-guile.el ends here
diff --git a/emacs/guix-help-vars.el b/emacs/guix-help-vars.el
deleted file mode 100644
index 8117d28f3e..0000000000
--- a/emacs/guix-help-vars.el
+++ /dev/null
@@ -1,108 +0,0 @@
-;;; guix-help-vars.el --- Variables related to --help output
-
-;; Copyright © 2015 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. 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:
-
-
-;;; Regexps for parsing "guix ..." outputs
-
-(defvar guix-help-parse-option-regexp
- (rx bol " "
- (zero-or-one (group "-" (not (any "- ")))
- ",")
- (one-or-more " ")
- (group "--" (one-or-more (or wordchar "-")))
- (group (zero-or-one "[")
- (zero-or-one "="))
- (zero-or-more (not space))
- (one-or-more space)
- (group (one-or-more any)))
- "Common regexp used to find command options.")
-
-(defvar guix-help-parse-command-regexp
- (rx bol " "
- (group wordchar (one-or-more (or wordchar "-"))))
- "Regexp used to find guix commands.
-'Command' means any option not prefixed with '-'. For example,
-guix subcommand, system action, importer, etc.")
-
-(defvar guix-help-parse-long-option-regexp
- (rx (or " " ", ")
- (group "--" (one-or-more (or wordchar "-"))
- (zero-or-one "=")))
- "Regexp used to find long options.")
-
-(defvar guix-help-parse-short-option-regexp
- (rx bol (one-or-more blank)
- "-" (group (not (any "- "))))
- "Regexp used to find short options.")
-
-(defvar guix-help-parse-package-regexp
- (rx bol (group (one-or-more (not blank))))
- "Regexp used to find names of the packages.")
-
-(defvar guix-help-parse-list-regexp
- (rx bol (zero-or-more blank) "- "
- (group (one-or-more (or wordchar "-"))))
- "Regexp used to find various lists (lint checkers, graph types).")
-
-(defvar guix-help-parse-regexp-group 1
- "Parenthesized expression of regexps used to find commands and
-options.")
-
-
-;;; Non-receivable lists of system types, hash formats, etc.
-
-(defvar guix-help-system-types
- '("x86_64-linux" "i686-linux" "armhf-linux" "mips64el-linux")
- "List of supported systems.")
-
-(defvar guix-help-source-types
- '("package" "all" "transitive")
- "List of supported sources types.")
-
-(defvar guix-help-hash-formats
- '("nix-base32" "base32" "base16" "hex" "hexadecimal")
- "List of supported hash formats.")
-
-(defvar guix-help-refresh-subsets
- '("core" "non-core")
- "List of supported 'refresh' subsets.")
-
-(defvar guix-help-key-policies
- '("interactive" "always" "never")
- "List of supported key download policies.")
-
-(defvar guix-help-verify-options
- '("repair" "contents")
- "List of supported 'verify' options")
-
-(defvar guix-help-elpa-archives
- '("gnu" "melpa" "melpa-stable")
- "List of supported ELPA archives.")
-
-(provide 'guix-help-vars)
-
-;;; guix-help-vars.el ends here
diff --git a/emacs/guix-helper.scm.in b/emacs/guix-helper.scm.in
deleted file mode 100644
index 0bbd36be21..0000000000
--- a/emacs/guix-helper.scm.in
+++ /dev/null
@@ -1,65 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU 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.
-;;;
-;;; GNU 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This is an auxiliary file for the Emacs UI. It is used to add Guix
-;; directories to path variables and to load the main code.
-
-;;; Code:
-
-(use-modules (ice-9 regex)
- (srfi srfi-26))
-
-(define %guix-dir)
-
-;; The code is taken from ‘guix’ executable script
-(define (set-paths!)
- (define-syntax-rule (push! elt v) (set! v (cons elt v)))
-
- (define config-lookup
- (let ((config '(("prefix" . "@prefix@")
- ("guilemoduledir" . "@guilemoduledir@")))
- (var-ref-regexp (make-regexp "\\$\\{([a-z]+)\\}")))
- (define (expand-var-ref match)
- (lookup (match:substring match 1)))
- (define (expand str)
- (regexp-substitute/global #f var-ref-regexp str
- 'pre expand-var-ref 'post))
- (define (lookup name)
- (expand (assoc-ref config name)))
- lookup))
-
- (let ((module-dir (config-lookup "guilemoduledir"))
- (updates-dir (and=> (or (getenv "XDG_CONFIG_HOME")
- (and=> (getenv "HOME")
- (cut string-append <> "/.config")))
- (cut string-append <> "/guix/latest"))))
- (push! module-dir %load-path)
- (push! module-dir %load-compiled-path)
- (if (and updates-dir (file-exists? updates-dir))
- (begin
- (set! %guix-dir updates-dir)
- (push! updates-dir %load-path)
- (push! updates-dir %load-compiled-path))
- (set! %guix-dir module-dir))))
-
-(set-paths!)
-
-(load-from-path "guix-main")
-
diff --git a/emacs/guix-history.el b/emacs/guix-history.el
deleted file mode 100644
index 5d301a689e..0000000000
--- a/emacs/guix-history.el
+++ /dev/null
@@ -1,92 +0,0 @@
-;;; guix-history.el --- History of buffer information
-
-;; Copyright © 2014 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides support for history of buffers similar to the
-;; history of a `help-mode' buffer.
-
-;;; Code:
-
-(require 'cl-macs)
-
-(defvar-local guix-history-stack-item nil
- "Current item of the history.
-A list of the form (FUNCTION [ARGS ...]).
-The item is used by calling (apply FUNCTION ARGS).")
-(put 'guix-history-stack-item 'permanent-local t)
-
-(defvar-local guix-history-back-stack nil
- "Stack (list) of visited items.
-Each element of the list has a form of `guix-history-stack-item'.")
-(put 'guix-history-back-stack 'permanent-local t)
-
-(defvar-local guix-history-forward-stack nil
- "Stack (list) of items visited with `guix-history-back'.
-Each element of the list has a form of `guix-history-stack-item'.")
-(put 'guix-history-forward-stack 'permanent-local t)
-
-(defvar guix-history-size 0
- "Maximum number of items saved in history.
-If 0, the history is disabled.")
-
-(defun guix-history-add (item)
- "Add ITEM to history."
- (and guix-history-stack-item
- (push guix-history-stack-item guix-history-back-stack))
- (setq guix-history-forward-stack nil
- guix-history-stack-item item)
- (when (>= (length guix-history-back-stack)
- guix-history-size)
- (setq guix-history-back-stack
- (cl-loop for elt in guix-history-back-stack
- for i from 1 to guix-history-size
- collect elt))))
-
-(defun guix-history-replace (item)
- "Replace current item in history with ITEM."
- (setq guix-history-stack-item item))
-
-(defun guix-history-goto (item)
- "Go to the ITEM of history.
-ITEM should have the form of `guix-history-stack-item'."
- (or (listp item)
- (error "Wrong value of history element"))
- (setq guix-history-stack-item item)
- (apply (car item) (cdr item)))
-
-(defun guix-history-back ()
- "Go back to the previous element of history in the current buffer."
- (interactive)
- (or guix-history-back-stack
- (user-error "No previous element in history"))
- (push guix-history-stack-item guix-history-forward-stack)
- (guix-history-goto (pop guix-history-back-stack)))
-
-(defun guix-history-forward ()
- "Go forward to the next element of history in the current buffer."
- (interactive)
- (or guix-history-forward-stack
- (user-error "No next element in history"))
- (push guix-history-stack-item guix-history-back-stack)
- (guix-history-goto (pop guix-history-forward-stack)))
-
-(provide 'guix-history)
-
-;;; guix-history.el ends here
diff --git a/emacs/guix-hydra-build.el b/emacs/guix-hydra-build.el
deleted file mode 100644
index 232221e773..0000000000
--- a/emacs/guix-hydra-build.el
+++ /dev/null
@@ -1,362 +0,0 @@
-;;; guix-hydra-build.el --- Interface for Hydra builds -*- lexical-binding: t -*-
-
-;; Copyright © 2015 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. 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 'guix-buffer)
-(require 'guix-list)
-(require 'guix-info)
-(require 'guix-hydra)
-(require 'guix-build-log)
-(require 'guix-utils)
-
-(guix-hydra-define-entry-type hydra-build
- :search-types '((latest . guix-hydra-build-latest-api-url)
- (queue . guix-hydra-build-queue-api-url))
- :filters '(guix-hydra-build-filter-status)
- :filter-names '((nixname . name)
- (buildstatus . build-status)
- (timestamp . time))
- :filter-boolean-params '(finished busy))
-
-(defun guix-hydra-build-get-display (search-type &rest args)
- "Search for Hydra builds and show results."
- (apply #'guix-list-get-display-entries
- 'hydra-build search-type args))
-
-(cl-defun guix-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
- (guix-hydra-read-project nil project)
- project))
- (jobset (if current-prefix-arg
- (guix-hydra-read-jobset nil jobset)
- jobset))
- (job-or-name (if current-prefix-arg
- (guix-hydra-read-job nil job)
- job))
- (job (and job-or-name
- (string-match-p guix-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)))
-
-(defun guix-hydra-build-view-log (id)
- "View build log of a hydra build ID."
- (guix-build-log-find-file (guix-hydra-build-log-url id)))
-
-
-;;; Defining URLs
-
-(defun guix-hydra-build-url (id)
- "Return Hydra URL of a build ID."
- (guix-hydra-url "build/" (number-to-string id)))
-
-(defun guix-hydra-build-log-url (id)
- "Return Hydra URL of the log file of a build ID."
- (concat (guix-hydra-build-url id) "/log/raw"))
-
-(cl-defun guix-hydra-build-latest-api-url
- (number &key project jobset job system)
- "Return Hydra API URL to receive latest NUMBER of builds."
- (guix-hydra-api-url "latestbuilds"
- `(("nr" . ,number)
- ("project" . ,project)
- ("jobset" . ,jobset)
- ("job" . ,job)
- ("system" . ,system))))
-
-(defun guix-hydra-build-queue-api-url (number)
- "Return Hydra API URL to receive the NUMBER of queued builds."
- (guix-hydra-api-url "queue"
- `(("nr" . ,number))))
-
-
-;;; Filters for processing raw entries
-
-(defun guix-hydra-build-filter-status (entry)
- "Add 'status' parameter to 'hydra-build' ENTRY."
- (let ((status (if (guix-entry-value entry 'finished)
- (guix-hydra-build-status-number->name
- (guix-entry-value entry 'build-status))
- (if (guix-entry-value entry 'busy)
- 'running
- 'scheduled))))
- (cons `(status . ,status)
- entry)))
-
-
-;;; Build status
-
-(defface guix-hydra-build-status-running
- '((t :inherit bold))
- "Face used if hydra build is not finished."
- :group 'guix-hydra-build-faces)
-
-(defface guix-hydra-build-status-scheduled
- '((t))
- "Face used if hydra build is scheduled."
- :group 'guix-hydra-build-faces)
-
-(defface guix-hydra-build-status-succeeded
- '((t :inherit success))
- "Face used if hydra build succeeded."
- :group 'guix-hydra-build-faces)
-
-(defface guix-hydra-build-status-cancelled
- '((t :inherit warning))
- "Face used if hydra build was cancelled."
- :group 'guix-hydra-build-faces)
-
-(defface guix-hydra-build-status-failed
- '((t :inherit error))
- "Face used if hydra build failed."
- :group 'guix-hydra-build-faces)
-
-(defvar guix-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 guix-hydra-build-status-number->name (number)
- "Convert build status number to a name.
-See `guix-hydra-build-status-alist'."
- (guix-assq-value guix-hydra-build-status-alist number))
-
-(defun guix-hydra-build-status-string (status)
- "Return a human readable string for build STATUS."
- (cl-case status
- (scheduled
- (guix-get-string "Scheduled" 'guix-hydra-build-status-scheduled))
- (running
- (guix-get-string "Running" 'guix-hydra-build-status-running))
- (succeeded
- (guix-get-string "Succeeded" 'guix-hydra-build-status-succeeded))
- (cancelled
- (guix-get-string "Cancelled" 'guix-hydra-build-status-cancelled))
- (failed-build
- (guix-hydra-build-status-fail-string))
- (failed-dependency
- (guix-hydra-build-status-fail-string "dependency"))
- (failed-other
- (guix-hydra-build-status-fail-string "other"))))
-
-(defun guix-hydra-build-status-fail-string (&optional reason)
- "Return a string for a failed build."
- (let ((base (guix-get-string "Failed" 'guix-hydra-build-status-failed)))
- (if reason
- (concat base " (" reason ")")
- base)))
-
-(defun guix-hydra-build-finished? (entry)
- "Return non-nil, if hydra build was finished."
- (guix-entry-value entry 'finished))
-
-(defun guix-hydra-build-running? (entry)
- "Return non-nil, if hydra build is running."
- (eq (guix-entry-value entry 'status)
- 'running))
-
-(defun guix-hydra-build-scheduled? (entry)
- "Return non-nil, if hydra build is scheduled."
- (eq (guix-entry-value entry 'status)
- 'scheduled))
-
-(defun guix-hydra-build-succeeded? (entry)
- "Return non-nil, if hydra build succeeded."
- (eq (guix-entry-value entry 'status)
- 'succeeded))
-
-(defun guix-hydra-build-cancelled? (entry)
- "Return non-nil, if hydra build was cancelled."
- (eq (guix-entry-value entry 'status)
- 'cancelled))
-
-(defun guix-hydra-build-failed? (entry)
- "Return non-nil, if hydra build failed."
- (memq (guix-entry-value entry 'status)
- '(failed-build failed-dependency failed-other)))
-
-
-;;; Hydra build 'info'
-
-(guix-hydra-info-define-interface hydra-build
- :mode-name "Hydra-Build-Info"
- :buffer-name "*Guix Hydra Build Info*"
- :format '((name ignore (simple guix-info-heading))
- ignore
- guix-hydra-build-info-insert-url
- (time format (time))
- (status format guix-hydra-build-info-insert-status)
- (project format (format guix-hydra-build-project))
- (jobset format (format guix-hydra-build-jobset))
- (job format (format guix-hydra-build-job))
- (system format (format guix-hydra-build-system))
- (priority format (format))))
-
-(defface guix-hydra-build-info-project
- '((t :inherit link))
- "Face for project names."
- :group 'guix-hydra-build-info-faces)
-
-(defface guix-hydra-build-info-jobset
- '((t :inherit link))
- "Face for jobsets."
- :group 'guix-hydra-build-info-faces)
-
-(defface guix-hydra-build-info-job
- '((t :inherit link))
- "Face for jobs."
- :group 'guix-hydra-build-info-faces)
-
-(defface guix-hydra-build-info-system
- '((t :inherit link))
- "Face for system names."
- :group 'guix-hydra-build-info-faces)
-
-(defmacro guix-hydra-build-define-button (name)
- "Define `guix-hydra-build-NAME' button."
- (let* ((name-str (symbol-name name))
- (button-name (intern (concat "guix-hydra-build-" name-str)))
- (face-name (intern (concat "guix-hydra-build-info-" name-str)))
- (keyword (intern (concat ":" name-str))))
- `(define-button-type ',button-name
- :supertype 'guix
- '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 (guix-hydra-build-latest-prompt-args
- ,keyword (button-label btn))))
- (apply #'guix-hydra-build-get-display
- 'latest args))))))
-
-(guix-hydra-build-define-button project)
-(guix-hydra-build-define-button jobset)
-(guix-hydra-build-define-button job)
-(guix-hydra-build-define-button system)
-
-(defun guix-hydra-build-info-insert-url (entry)
- "Insert Hydra URL for the build ENTRY."
- (guix-insert-button (guix-hydra-build-url (guix-entry-id entry))
- 'guix-url)
- (when (guix-hydra-build-finished? entry)
- (guix-info-insert-indent)
- (guix-info-insert-action-button
- "Build log"
- (lambda (btn)
- (guix-hydra-build-view-log (button-get btn 'id)))
- "View build log"
- 'id (guix-entry-id entry))))
-
-(defun guix-hydra-build-info-insert-status (status &optional _)
- "Insert a string with build STATUS."
- (insert (guix-hydra-build-status-string status)))
-
-
-;;; Hydra build 'list'
-
-(guix-hydra-list-define-interface hydra-build
- :mode-name "Hydra-Build-List"
- :buffer-name "*Guix Hydra Build List*"
- :format '((name nil 30 t)
- (system nil 16 t)
- (status guix-hydra-build-list-get-status 20 t)
- (project nil 10 t)
- (jobset nil 17 t)
- (time guix-list-get-time 20 t)))
-
-(let ((map guix-hydra-build-list-mode-map))
- (define-key map (kbd "B") 'guix-hydra-build-list-latest-builds)
- (define-key map (kbd "L") 'guix-hydra-build-list-view-log))
-
-(defun guix-hydra-build-list-get-status (status &optional _)
- "Return a string for build STATUS."
- (guix-hydra-build-status-string status))
-
-(defun guix-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 (guix-list-current-entry)))
- (guix-hydra-build-latest-prompt-args
- :project (guix-entry-value entry 'project)
- :jobset (guix-entry-value entry 'name)
- :job (guix-entry-value entry 'job)
- :system (guix-entry-value entry 'system))))
- (apply #'guix-hydra-latest-builds number args))
-
-(defun guix-hydra-build-list-view-log ()
- "View build log of the current Hydra build."
- (interactive)
- (guix-hydra-build-view-log (guix-list-current-id)))
-
-
-;;; Interactive commands
-
-;;;###autoload
-(defun guix-hydra-latest-builds (number &rest args)
- "Display latest NUMBER of Hydra builds.
-ARGS are the same arguments as for `guix-hydra-build-latest-api-url'.
-Interactively, prompt for NUMBER. With prefix argument, prompt
-for all ARGS."
- (interactive (guix-hydra-build-latest-prompt-args))
- (apply #'guix-hydra-build-get-display
- 'latest number args))
-
-;;;###autoload
-(defun guix-hydra-queued-builds (number)
- "Display the NUMBER of queued Hydra builds."
- (interactive "NNumber of queued builds: ")
- (guix-hydra-build-get-display 'queue number))
-
-(provide 'guix-hydra-build)
-
-;;; guix-hydra-build.el ends here
diff --git a/emacs/guix-hydra-jobset.el b/emacs/guix-hydra-jobset.el
deleted file mode 100644
index a4a55a36f2..0000000000
--- a/emacs/guix-hydra-jobset.el
+++ /dev/null
@@ -1,162 +0,0 @@
-;;; guix-hydra-jobset.el --- Interface for Hydra jobsets -*- lexical-binding: t -*-
-
-;; Copyright © 2015 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. 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 'guix-buffer)
-(require 'guix-list)
-(require 'guix-info)
-(require 'guix-hydra)
-(require 'guix-hydra-build)
-(require 'guix-utils)
-
-(guix-hydra-define-entry-type hydra-jobset
- :search-types '((project . guix-hydra-jobset-api-url))
- :filters '(guix-hydra-jobset-filter-id)
- :filter-names '((nrscheduled . scheduled)
- (nrsucceeded . succeeded)
- (nrfailed . failed)
- (nrtotal . total)))
-
-(defun guix-hydra-jobset-get-display (search-type &rest args)
- "Search for Hydra builds and show results."
- (apply #'guix-list-get-display-entries
- 'hydra-jobset search-type args))
-
-
-;;; Defining URLs
-
-(defun guix-hydra-jobset-url (project jobset)
- "Return Hydra URL of a PROJECT's JOBSET."
- (guix-hydra-url "jobset/" project "/" jobset))
-
-(defun guix-hydra-jobset-api-url (project)
- "Return Hydra API URL for jobsets by PROJECT."
- (guix-hydra-api-url "jobsets"
- `(("project" . ,project))))
-
-
-;;; Filters for processing raw entries
-
-(defun guix-hydra-jobset-filter-id (entry)
- "Add 'ID' parameter to 'hydra-jobset' ENTRY."
- (cons `(id . ,(guix-entry-value entry 'name))
- entry))
-
-
-;;; Hydra jobset 'info'
-
-(guix-hydra-info-define-interface hydra-jobset
- :mode-name "Hydra-Jobset-Info"
- :buffer-name "*Guix Hydra Jobset Info*"
- :format '((name ignore (simple guix-info-heading))
- ignore
- guix-hydra-jobset-info-insert-url
- (project format guix-hydra-jobset-info-insert-project)
- (scheduled format (format guix-hydra-jobset-info-scheduled))
- (succeeded format (format guix-hydra-jobset-info-succeeded))
- (failed format (format guix-hydra-jobset-info-failed))
- (total format (format guix-hydra-jobset-info-total))))
-
-(defface guix-hydra-jobset-info-scheduled
- '((t))
- "Face used for the number of scheduled builds."
- :group 'guix-hydra-jobset-info-faces)
-
-(defface guix-hydra-jobset-info-succeeded
- '((t :inherit guix-hydra-build-status-succeeded))
- "Face used for the number of succeeded builds."
- :group 'guix-hydra-jobset-info-faces)
-
-(defface guix-hydra-jobset-info-failed
- '((t :inherit guix-hydra-build-status-failed))
- "Face used for the number of failed builds."
- :group 'guix-hydra-jobset-info-faces)
-
-(defface guix-hydra-jobset-info-total
- '((t))
- "Face used for the total number of builds."
- :group 'guix-hydra-jobset-info-faces)
-
-(defun guix-hydra-jobset-info-insert-project (project entry)
- "Insert PROJECT button for the jobset ENTRY."
- (let ((jobset (guix-entry-value entry 'name)))
- (guix-insert-button
- project 'guix-hydra-build-project
- 'action (lambda (btn)
- (let ((args (guix-hydra-build-latest-prompt-args
- :project (button-get btn 'project)
- :jobset (button-get btn 'jobset))))
- (apply #'guix-hydra-build-get-display
- 'latest args)))
- 'project project
- 'jobset jobset)))
-
-(defun guix-hydra-jobset-info-insert-url (entry)
- "Insert Hydra URL for the jobset ENTRY."
- (guix-insert-button (guix-hydra-jobset-url
- (guix-entry-value entry 'project)
- (guix-entry-value entry 'name))
- 'guix-url))
-
-
-;;; Hydra jobset 'list'
-
-(guix-hydra-list-define-interface hydra-jobset
- :mode-name "Hydra-Jobset-List"
- :buffer-name "*Guix Hydra Jobset List*"
- :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)))
-
-(let ((map guix-hydra-jobset-list-mode-map))
- (define-key map (kbd "B") 'guix-hydra-jobset-list-latest-builds))
-
-(defun guix-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 (guix-list-current-entry)))
- (guix-hydra-build-latest-prompt-args
- :project (guix-entry-value entry 'project)
- :jobset (guix-entry-value entry 'name))))
- (apply #'guix-hydra-latest-builds number args))
-
-
-;;; Interactive commands
-
-;;;###autoload
-(defun guix-hydra-jobsets (project)
- "Display jobsets of PROJECT."
- (interactive (list (guix-hydra-read-project)))
- (guix-hydra-jobset-get-display 'project project))
-
-(provide 'guix-hydra-jobset)
-
-;;; guix-hydra-jobset.el ends here
diff --git a/emacs/guix-hydra.el b/emacs/guix-hydra.el
deleted file mode 100644
index 9f876e7eea..0000000000
--- a/emacs/guix-hydra.el
+++ /dev/null
@@ -1,367 +0,0 @@
-;;; guix-hydra.el --- Common code for interacting with Hydra -*- lexical-binding: t -*-
-
-;; Copyright © 2015 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. 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 'guix-buffer)
-(require 'guix-entry)
-(require 'guix-utils)
-(require 'guix-help-vars)
-
-(guix-define-groups hydra)
-
-(defvar guix-hydra-job-regexp
- (concat ".*\\." (regexp-opt guix-help-system-types) "\\'")
- "Regexp matching a full name of Hydra job (including system).")
-
-(defun guix-hydra-job-name-specification (name version)
- "Return Hydra's job name specification by NAME and VERSION."
- (concat name "-" version))
-
-(defun guix-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 guix-hydra-list-describe (ids)
- "Describe 'hydra' entries with IDS (list of identifiers)."
- (guix-buffer-display-entries
- (guix-entries-by-ids ids (guix-buffer-current-entries))
- 'info (guix-buffer-current-entry-type)
- ;; Hydra does not provide an API to receive builds/jobsets by
- ;; IDs/names, so we use a 'fake' search type.
- '(fake)
- 'add))
-
-
-;;; Readers
-
-(defvar guix-hydra-projects
- '("gnu" "guix")
- "List of available Hydra projects.")
-
-(guix-define-readers
- :completions-var guix-hydra-projects
- :single-reader guix-hydra-read-project
- :single-prompt "Project: ")
-
-(guix-define-readers
- :single-reader guix-hydra-read-jobset
- :single-prompt "Jobset: ")
-
-(guix-define-readers
- :single-reader guix-hydra-read-job
- :single-prompt "Job: ")
-
-(guix-define-readers
- :completions-var guix-help-system-types
- :single-reader guix-hydra-read-system
- :single-prompt "System: ")
-
-
-;;; Defining URLs
-
-(defvar guix-hydra-url "http://hydra.gnu.org"
- "URL of the Hydra build farm.")
-
-(defun guix-hydra-url (&rest url-parts)
- "Return Hydra URL."
- (apply #'concat guix-hydra-url "/" url-parts))
-
-(defun guix-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 (guix-hexify key) "="
- (guix-hexify value))))
- (_ (error "Wrong argument '%s'" arg))))
- args))
- (fields (mapconcat #'identity (delq nil fields) "&")))
- (guix-hydra-url "api/" type "?" fields)))
-
-
-;;; Receiving data from Hydra
-
-(defun guix-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 guix-hydra-get-entries (entry-type search-type &rest args)
- "Receive ENTRY-TYPE entries from Hydra.
-SEARCH-TYPE is one of the types defined by `guix-hydra-define-interface'."
- (unless (eq search-type 'fake)
- (let* ((url (apply #'guix-hydra-search-url
- entry-type search-type args))
- (raw-entries (guix-hydra-receive-data url))
- (entries (guix-hydra-filter-entries
- raw-entries
- (guix-hydra-filters entry-type))))
- entries)))
-
-
-;;; Filters for processing raw entries
-
-(defun guix-hydra-filter-entries (entries filters)
- "Filter ENTRIES using FILTERS.
-Call `guix-modify' on each entry from ENTRIES."
- (mapcar (lambda (entry)
- (guix-modify entry filters))
- entries))
-
-(defun guix-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 (guix-assq-value name-alist name)))
- (if new-name
- (cons new-name val)
- param)))))
- entry))
-
-(defun guix-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 (guix-number->bool val))
- param))))
- entry))
-
-
-;;; Wrappers for defined variables
-
-(defvar guix-hydra-entry-type-data nil
- "Alist with hydra entry type data.
-This alist is filled by `guix-hydra-define-entry-type' macro.")
-
-(defun guix-hydra-entry-type-value (entry-type symbol)
- "Return SYMBOL's value for ENTRY-TYPE from `guix-hydra'."
- (symbol-value (guix-assq-value guix-hydra-entry-type-data
- entry-type symbol)))
-
-(defun guix-hydra-search-url (entry-type search-type &rest args)
- "Return URL to receive ENTRY-TYPE entries from Hydra."
- (apply (guix-assq-value (guix-hydra-entry-type-value
- entry-type 'search-types)
- search-type)
- args))
-
-(defun guix-hydra-filters (entry-type)
- "Return a list of filters for ENTRY-TYPE."
- (guix-hydra-entry-type-value entry-type 'filters))
-
-
-;;; Interface definers
-
-(defmacro guix-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
- `guix-ENTRY-TYPE-search-types' variable.
-
-Optional keywords:
-
- - `:filters' - default value of the generated
- `guix-ENTRY-TYPE-filters' variable.
-
- - `:filter-names' - if specified, a generated
- `guix-ENTRY-TYPE-filter-names' function for filtering these
- names will be added to `guix-ENTRY-TYPE-filters' variable.
-
- - `:filter-boolean-params' - if specified, a generated
- `guix-ENTRY-TYPE-filter-boolean' function for filtering these
- names will be added to `guix-ENTRY-TYPE-filters' variable.
-
-The rest keyword arguments are passed to
-`guix-define-entry-type' macro."
- (declare (indent 1))
- (let* ((entry-type-str (symbol-name entry-type))
- (prefix (concat "guix-" entry-type-str))
- (search-types-var (intern (concat prefix "-search-types")))
- (filters-var (intern (concat prefix "-filters")))
- (get-fun (intern (concat prefix "-get-entries"))))
- (guix-keyword-args-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 `guix-hydra-filter-boolean' with `%S' variable."
- filter-bool-var)
- (guix-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 `guix-hydra-filter-names' with `%S' variable."
- filter-names-var)
- (guix-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 `guix-hydra-get-entries' for details."
- entry-type-str)
- (apply #'guix-hydra-get-entries
- ',entry-type search-type args))
-
- (guix-alist-put!
- '((search-types . ,search-types-var)
- (filters . ,filters-var))
- 'guix-hydra-entry-type-data ',entry-type)
-
- (guix-define-entry-type ,entry-type
- :parent-group guix-hydra
- :parent-faces-group guix-hydra-faces
- ,@%foreign-args)))))
-
-(defmacro guix-hydra-define-interface (buffer-type entry-type &rest args)
- "Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries.
-
-This macro should be called after calling
-`guix-hydra-define-entry-type' with the same ENTRY-TYPE.
-
-ARGS are passed to `guix-BUFFER-TYPE-define-interface' macro."
- (declare (indent 2))
- (let* ((entry-type-str (symbol-name entry-type))
- (buffer-type-str (symbol-name buffer-type))
- (get-fun (intern (concat "guix-" entry-type-str
- "-get-entries")))
- (definer (intern (concat "guix-" buffer-type-str
- "-define-interface"))))
- `(,definer ,entry-type
- :get-entries-function ',get-fun
- :message-function 'guix-hydra-message
- ,@args)))
-
-(defmacro guix-hydra-info-define-interface (entry-type &rest args)
- "Define 'info' interface for displaying ENTRY-TYPE entries.
-See `guix-hydra-define-interface'."
- (declare (indent 1))
- `(guix-hydra-define-interface info ,entry-type
- ,@args))
-
-(defmacro guix-hydra-list-define-interface (entry-type &rest args)
- "Define 'list' interface for displaying ENTRY-TYPE entries.
-Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
-
-Optional keywords:
-
- - `:describe-function' - default value of the generated
- `guix-ENTRY-TYPE-list-describe-function' variable (if not
- specified, use `guix-hydra-list-describe').
-
-The rest keyword arguments are passed to
-`guix-hydra-define-interface' macro."
- (declare (indent 1))
- (guix-keyword-args-let args
- ((describe-val :describe-function))
- `(guix-hydra-define-interface list ,entry-type
- :describe-function ,(or describe-val ''guix-hydra-list-describe)
- ,@args)))
-
-
-(defvar guix-hydra-font-lock-keywords
- (eval-when-compile
- `((,(rx "(" (group (or "guix-hydra-define-entry-type"
- "guix-hydra-define-interface"
- "guix-hydra-info-define-interface"
- "guix-hydra-list-define-interface"))
- symbol-end)
- . 1))))
-
-(font-lock-add-keywords 'emacs-lisp-mode guix-hydra-font-lock-keywords)
-
-(provide 'guix-hydra)
-
-;;; guix-hydra.el ends here
diff --git a/emacs/guix-info.el b/emacs/guix-info.el
deleted file mode 100644
index 6aefd2f3f6..0000000000
--- a/emacs/guix-info.el
+++ /dev/null
@@ -1,482 +0,0 @@
-;;; guix-info.el --- 'Info' buffer interface for displaying data -*- lexical-binding: t -*-
-
-;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
-;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides 'info' (help-like) buffer interface for displaying
-;; an arbitrary data.
-
-;;; Code:
-
-(require 'guix-buffer)
-(require 'guix-entry)
-(require 'guix-utils)
-
-(guix-define-buffer-type info)
-
-(defface guix-info-heading
- '((((type tty pc) (class color)) :weight bold)
- (t :height 1.6 :weight bold :inherit variable-pitch))
- "Face for headings."
- :group 'guix-info-faces)
-
-(defface guix-info-param-title
- '((t :inherit font-lock-type-face))
- "Face used for titles of parameters."
- :group 'guix-info-faces)
-
-(defface guix-info-file-name
- '((t :inherit link))
- "Face used for file names."
- :group 'guix-info-faces)
-
-(defface guix-info-url
- '((t :inherit link))
- "Face used for URLs."
- :group 'guix-info-faces)
-
-(defface guix-info-time
- '((t :inherit font-lock-constant-face))
- "Face used for timestamps."
- :group 'guix-info-faces)
-
-(defface guix-info-action-button
- '((((type x w32 ns) (class color))
- :box (:line-width 2 :style released-button)
- :background "lightgrey" :foreground "black")
- (t :inherit button))
- "Face used for action buttons."
- :group 'guix-info-faces)
-
-(defface guix-info-action-button-mouse
- '((((type x w32 ns) (class color))
- :box (:line-width 2 :style released-button)
- :background "grey90" :foreground "black")
- (t :inherit highlight))
- "Mouse face used for action buttons."
- :group 'guix-info-faces)
-
-(defcustom guix-info-ignore-empty-values nil
- "If non-nil, do not display parameters with nil values."
- :type 'boolean
- :group 'guix-info)
-
-(defcustom guix-info-fill t
- "If non-nil, fill string parameters to fit the window.
-If nil, insert text parameters (like synopsis or description) in
-a raw form."
- :type 'boolean
- :group 'guix-info)
-
-(defvar guix-info-param-title-format "%-18s: "
- "String used to format a title of a parameter.
-It should be a '%s'-sequence. After inserting a title formatted
-with this string, a value of the parameter is inserted.
-This string is used by `guix-info-insert-title-format'.")
-
-(defvar guix-info-multiline-prefix
- (make-string (length (format guix-info-param-title-format " "))
- ?\s)
- "String used to format multi-line parameter values.
-If a value occupies more than one line, this string is inserted
-in the beginning of each line after the first one.
-This string is used by `guix-info-insert-value-format'.")
-
-(defvar guix-info-indent 2
- "Number of spaces used to indent various parts of inserted text.")
-
-(defvar guix-info-delimiter "\n\f\n"
- "String used to separate entries.")
-
-
-;;; Wrappers for 'info' variables
-
-(defvar guix-info-data nil
- "Alist with 'info' data.
-This alist is filled by `guix-info-define-interface' macro.")
-
-(defun guix-info-value (entry-type symbol)
- "Return SYMBOL's value for ENTRY-TYPE from `guix-info-data'."
- (symbol-value (guix-assq-value guix-info-data entry-type symbol)))
-
-(defun guix-info-param-title (entry-type param)
- "Return a title of an ENTRY-TYPE parameter PARAM."
- (guix-buffer-param-title 'info entry-type param))
-
-(defun guix-info-format (entry-type)
- "Return 'info' format for ENTRY-TYPE."
- (guix-info-value entry-type 'format))
-
-(defun guix-info-displayed-params (entry-type)
- "Return a list of ENTRY-TYPE parameters that should be displayed."
- (delq nil
- (mapcar (lambda (spec)
- (pcase spec
- (`(,param . ,_) param)))
- (guix-info-format entry-type))))
-
-
-;;; Inserting entries
-
-(defvar guix-info-title-aliases
- '((format . guix-info-insert-title-format)
- (simple . guix-info-insert-title-simple))
- "Alist of aliases and functions to insert titles.")
-
-(defvar guix-info-value-aliases
- '((format . guix-info-insert-value-format)
- (indent . guix-info-insert-value-indent)
- (simple . guix-info-insert-value-simple)
- (time . guix-info-insert-time))
- "Alist of aliases and functions to insert values.")
-
-(defun guix-info-title-function (fun-or-alias)
- "Convert FUN-OR-ALIAS into a function to insert a title."
- (or (guix-assq-value guix-info-title-aliases fun-or-alias)
- fun-or-alias))
-
-(defun guix-info-value-function (fun-or-alias)
- "Convert FUN-OR-ALIAS into a function to insert a value."
- (or (guix-assq-value guix-info-value-aliases fun-or-alias)
- fun-or-alias))
-
-(defun guix-info-title-method->function (method)
- "Convert title METHOD into a function to insert a title."
- (pcase method
- ((pred null) #'ignore)
- ((pred symbolp) (guix-info-title-function method))
- (`(,fun-or-alias . ,rest-args)
- (lambda (title)
- (apply (guix-info-title-function fun-or-alias)
- title rest-args)))
- (_ (error "Unknown title method '%S'" method))))
-
-(defun guix-info-value-method->function (method)
- "Convert value METHOD into a function to insert a value."
- (pcase method
- ((pred null) #'ignore)
- ((pred functionp) method)
- (`(,fun-or-alias . ,rest-args)
- (lambda (value _)
- (apply (guix-info-value-function fun-or-alias)
- value rest-args)))
- (_ (error "Unknown value method '%S'" method))))
-
-(defun guix-info-fill-column ()
- "Return fill column for the current window."
- (min (window-width) fill-column))
-
-(defun guix-info-get-indent (&optional level)
- "Return `guix-info-indent' \"multiplied\" by LEVEL spaces.
-LEVEL is 1 by default."
- (make-string (* guix-info-indent (or level 1)) ?\s))
-
-(defun guix-info-insert-indent (&optional level)
- "Insert `guix-info-indent' spaces LEVEL times (1 by default)."
- (insert (guix-info-get-indent level)))
-
-(defun guix-info-insert-entries (entries entry-type)
- "Display ENTRY-TYPE ENTRIES in the current info buffer."
- (guix-mapinsert (lambda (entry)
- (guix-info-insert-entry entry entry-type))
- entries
- guix-info-delimiter))
-
-(defun guix-info-insert-entry (entry entry-type &optional indent-level)
- "Insert ENTRY of ENTRY-TYPE into the current info buffer.
-If INDENT-LEVEL is non-nil, indent displayed data by this number
-of `guix-info-indent' spaces."
- (guix-with-indent (* (or indent-level 0)
- guix-info-indent)
- (dolist (spec (guix-info-format entry-type))
- (guix-info-insert-entry-unit spec entry entry-type))))
-
-(defun guix-info-insert-entry-unit (format-spec entry entry-type)
- "Insert title and value of a PARAM at point.
-ENTRY is alist with parameters and their values.
-ENTRY-TYPE is a type of ENTRY."
- (pcase format-spec
- ((pred functionp)
- (funcall format-spec entry)
- (insert "\n"))
- (`(,param ,title-method ,value-method)
- (let ((value (guix-entry-value entry param)))
- (unless (and guix-info-ignore-empty-values (null value))
- (let ((title (guix-info-param-title entry-type param))
- (insert-title (guix-info-title-method->function title-method))
- (insert-value (guix-info-value-method->function value-method)))
- (funcall insert-title title)
- (funcall insert-value value entry)
- (insert "\n")))))
- (_ (error "Unknown format specification '%S'" format-spec))))
-
-(defun guix-info-insert-title-simple (title &optional face)
- "Insert \"TITLE: \" string at point.
-If FACE is nil, use `guix-info-param-title'."
- (guix-format-insert title
- (or face 'guix-info-param-title)
- "%s: "))
-
-(defun guix-info-insert-title-format (title &optional face)
- "Insert TITLE using `guix-info-param-title-format' at point.
-If FACE is nil, use `guix-info-param-title'."
- (guix-format-insert title
- (or face 'guix-info-param-title)
- guix-info-param-title-format))
-
-(defun guix-info-insert-value-simple (value &optional button-or-face indent)
- "Format and insert parameter VALUE at point.
-
-VALUE may be split into several short lines to fit the current
-window, depending on `guix-info-fill', and each line is indented
-with INDENT number of spaces.
-
-If BUTTON-OR-FACE is a button type symbol, transform VALUE into
-this (these) button(s) and insert each one on a new line. If it
-is a face symbol, propertize inserted line(s) with this face."
- (or indent (setq indent 0))
- (guix-with-indent indent
- (let* ((button? (guix-button-type? button-or-face))
- (face (unless button? button-or-face))
- (fill-col (unless (or button?
- (and (stringp value)
- (not guix-info-fill)))
- (- (guix-info-fill-column) indent)))
- (value (if (and value button?)
- (guix-buttonize value button-or-face "\n")
- value)))
- (guix-split-insert value face fill-col "\n"))))
-
-(defun guix-info-insert-value-indent (value &optional button-or-face)
- "Format and insert parameter VALUE at point.
-
-This function is intended to be called after inserting a title
-with `guix-info-insert-title-simple'.
-
-VALUE may be split into several short lines to fit the current
-window, depending on `guix-info-fill', and each line is indented
-with `guix-info-indent'.
-
-For the meaning of BUTTON-OR-FACE, see `guix-info-insert-value-simple'."
- (when value (insert "\n"))
- (guix-info-insert-value-simple value button-or-face guix-info-indent))
-
-(defun guix-info-insert-value-format (value &optional button-or-face
- &rest button-properties)
- "Format and insert parameter VALUE at point.
-
-This function is intended to be called after inserting a title
-with `guix-info-insert-title-format'.
-
-VALUE may be split into several short lines to fit the current
-window, depending on `guix-info-fill' and
-`guix-info-multiline-prefix'. If VALUE is a list, its elements
-will be separated with `guix-list-separator'.
-
-If BUTTON-OR-FACE is a button type symbol, transform VALUE into
-this (these) button(s). If it is a face symbol, propertize
-inserted line(s) with this face.
-
-BUTTON-PROPERTIES are passed to `guix-buttonize' (only if
-BUTTON-OR-FACE is a button type)."
- (let* ((button? (guix-button-type? button-or-face))
- (face (unless button? button-or-face))
- (fill-col (when (or button?
- guix-info-fill
- (not (stringp value)))
- (- (guix-info-fill-column)
- (length guix-info-multiline-prefix))))
- (value (if (and value button?)
- (apply #'guix-buttonize
- value button-or-face guix-list-separator
- button-properties)
- value)))
- (guix-split-insert value face fill-col
- (concat "\n" guix-info-multiline-prefix))))
-
-(defun guix-info-insert-time (seconds &optional face)
- "Insert formatted time string using SECONDS at point."
- (guix-format-insert (guix-get-time-string seconds)
- (or face 'guix-info-time)))
-
-
-;;; Buttons
-
-(defvar guix-info-button-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map button-map)
- (define-key map (kbd "c") 'guix-info-button-copy-label)
- map)
- "Keymap for buttons in info buffers.")
-
-(define-button-type 'guix
- 'keymap guix-info-button-map
- 'follow-link t)
-
-(define-button-type 'guix-action
- :supertype 'guix
- 'face 'guix-info-action-button
- 'mouse-face 'guix-info-action-button-mouse)
-
-(define-button-type 'guix-file
- :supertype 'guix
- 'face 'guix-info-file-name
- 'help-echo "Find file"
- 'action (lambda (btn)
- (guix-find-file (button-label btn))))
-
-(define-button-type 'guix-url
- :supertype 'guix
- 'face 'guix-info-url
- 'help-echo "Browse URL"
- 'action (lambda (btn)
- (browse-url (button-label btn))))
-
-(defun guix-info-button-copy-label (&optional pos)
- "Copy a label of the button at POS into kill ring.
-If POS is nil, use the current point position."
- (interactive)
- (let ((button (button-at (or pos (point)))))
- (when button
- (guix-copy-as-kill (button-label button)))))
-
-(defun guix-info-insert-action-button (label action &optional message
- &rest properties)
- "Make action button with LABEL and insert it at point.
-ACTION is a function called when the button is pressed. It
-should accept button as the argument.
-MESSAGE is a button message.
-See `insert-text-button' for the meaning of PROPERTIES."
- (apply #'guix-insert-button
- label 'guix-action
- 'action action
- 'help-echo message
- properties))
-
-
-;;; Major mode and interface definer
-
-(defvar guix-info-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent
- map (make-composed-keymap (list guix-buffer-map button-buffer-map)
- special-mode-map))
- map)
- "Keymap for `guix-info-mode' buffers.")
-
-(define-derived-mode guix-info-mode special-mode "Guix-Info"
- "Parent mode for displaying data in 'info' form."
- (setq-local revert-buffer-function 'guix-buffer-revert))
-
-(defun guix-info-mode-initialize ()
- "Set up the current 'info' buffer."
- ;; Without this, syntactic fontification is performed, and it may
- ;; break our highlighting. For example, description of "emacs-typo"
- ;; package contains a single " (double-quote) character, so the
- ;; default syntactic fontification highlights the rest text after it
- ;; as a string. See (info "(elisp) Font Lock Basics") for details.
- (setq font-lock-defaults '(nil t)))
-
-(defmacro guix-info-define-interface (entry-type &rest args)
- "Define 'info' interface for displaying ENTRY-TYPE entries.
-Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
-
-Required keywords:
-
- - `:format' - default value of the generated
- `guix-ENTRY-TYPE-info-format' variable.
-
-The rest keyword arguments are passed to
-`guix-buffer-define-interface' macro."
- (declare (indent 1))
- (let* ((entry-type-str (symbol-name entry-type))
- (prefix (concat "guix-" entry-type-str "-info"))
- (group (intern prefix))
- (format-var (intern (concat prefix "-format"))))
- (guix-keyword-args-let args
- ((show-entries-val :show-entries-function)
- (format-val :format))
- `(progn
- (defcustom ,format-var ,format-val
- ,(format "\
-List of methods for inserting '%s' entry.
-Each METHOD should be either a function or should have the
-following form:
-
- (PARAM INSERT-TITLE INSERT-VALUE)
-
-If METHOD is a function, it is called with an entry as argument.
-
-PARAM is a name of '%s' entry parameter.
-
-INSERT-TITLE may be either a symbol or a list. If it is a
-symbol, it should be a function or an alias from
-`guix-info-title-aliases', in which case it is called with title
-as argument. If it is a list, it should have a
-form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is
-called with title and ARGS as arguments.
-
-INSERT-VALUE may be either a symbol or a list. If it is a
-symbol, it should be a function or an alias from
-`guix-info-value-aliases', in which case it is called with value
-and entry as arguments. If it is a list, it should have a
-form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is
-called with value and ARGS as arguments.
-
-Parameters are inserted in the same order as defined by this list.
-After calling each METHOD, a new line is inserted."
- entry-type-str entry-type-str)
- :type 'sexp
- :group ',group)
-
- (guix-alist-put!
- '((format . ,format-var))
- 'guix-info-data ',entry-type)
-
- ,(if show-entries-val
- `(guix-buffer-define-interface info ,entry-type
- :show-entries-function ,show-entries-val
- ,@%foreign-args)
-
- (let ((insert-fun (intern (concat prefix "-insert-entries"))))
- `(progn
- (defun ,insert-fun (entries)
- ,(format "\
-Print '%s' ENTRIES in the current 'info' buffer."
- entry-type-str)
- (guix-info-insert-entries entries ',entry-type))
-
- (guix-buffer-define-interface info ,entry-type
- :insert-entries-function ',insert-fun
- :mode-init-function 'guix-info-mode-initialize
- ,@%foreign-args))))))))
-
-
-(defvar guix-info-font-lock-keywords
- (eval-when-compile
- `((,(rx "(" (group "guix-info-define-interface")
- symbol-end)
- . 1))))
-
-(font-lock-add-keywords 'emacs-lisp-mode guix-info-font-lock-keywords)
-
-(provide 'guix-info)
-
-;;; guix-info.el ends here
diff --git a/emacs/guix-init.el b/emacs/guix-init.el
deleted file mode 100644
index bd75e54e03..0000000000
--- a/emacs/guix-init.el
+++ /dev/null
@@ -1,3 +0,0 @@
-(require 'guix-autoloads)
-(message "(require 'guix-init) is obsolete, use (require 'guix-autoloads) instead.")
-(provide 'guix-init)
diff --git a/emacs/guix-license.el b/emacs/guix-license.el
deleted file mode 100644
index 6003a21aac..0000000000
--- a/emacs/guix-license.el
+++ /dev/null
@@ -1,65 +0,0 @@
-;;; guix-license.el --- Licenses
-
-;; Copyright © 2016 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides the code to work with licenses of Guix packages.
-
-;;; Code:
-
-(require 'guix-read)
-(require 'guix-backend)
-(require 'guix-guile)
-
-(defun guix-license-file (&optional directory)
- "Return name of the file with license definitions.
-DIRECTORY is a directory with Guix source (`guix-directory' by default)."
- (expand-file-name "guix/licenses.scm"
- (or directory guix-directory)))
-
-(defun guix-lookup-license-url (license)
- "Return URL of a LICENSE."
- (or (guix-eval-read (guix-make-guile-expression
- 'lookup-license-uri license))
- (error "Hm, I don't know URL of '%s' license" license)))
-
-;;;###autoload
-(defun guix-find-license-definition (license &optional directory)
- "Open licenses file from DIRECTORY and move to the LICENSE definition.
-See `guix-license-file' for the meaning of DIRECTORY.
-Interactively, with prefix argument, prompt for DIRECTORY."
- (interactive
- (list (guix-read-license-name)
- (guix-read-directory)))
- (find-file (guix-license-file directory))
- (goto-char (point-min))
- (when (re-search-forward (concat "\"" (regexp-quote license) "\"")
- nil t)
- (beginning-of-defun)
- (recenter 1)))
-
-;;;###autoload
-(defun guix-browse-license-url (license)
- "Browse URL of a LICENSE."
- (interactive (list (guix-read-license-name)))
- (browse-url (guix-lookup-license-url license)))
-
-(provide 'guix-license)
-
-;;; guix-license.el ends here
diff --git a/emacs/guix-list.el b/emacs/guix-list.el
deleted file mode 100644
index c91c67cb29..0000000000
--- a/emacs/guix-list.el
+++ /dev/null
@@ -1,585 +0,0 @@
-;;; guix-list.el --- 'List' buffer interface for displaying data -*- lexical-binding: t -*-
-
-;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides 'list' buffer interface for displaying an arbitrary
-;; data.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'tabulated-list)
-(require 'guix-buffer)
-(require 'guix-info)
-(require 'guix-entry)
-(require 'guix-utils)
-
-(guix-define-buffer-type list)
-
-(defface guix-list-file-name
- '((t :inherit guix-info-file-name))
- "Face used for file names."
- :group 'guix-list-faces)
-
-(defface guix-list-url
- '((t :inherit guix-info-url))
- "Face used for URLs."
- :group 'guix-list-faces)
-
-(defface guix-list-time
- '((t :inherit guix-info-time))
- "Face used for time stamps."
- :group 'guix-list-faces)
-
-(defun guix-list-describe (&optional mark-names)
- "Describe entries marked with a general mark.
-'Describe' means display entries in 'info' buffer.
-If no entries are marked, describe the current entry.
-With prefix argument, describe entries marked with any mark."
- (interactive (list (unless current-prefix-arg '(general))))
- (let* ((ids (or (apply #'guix-list-get-marked-id-list mark-names)
- (list (guix-list-current-id))))
- (count (length ids))
- (entry-type (guix-buffer-current-entry-type)))
- (when (or (<= count (guix-list-describe-warning-count entry-type))
- (y-or-n-p (format "Do you really want to describe %d entries? "
- count)))
- (guix-list-describe-entries entry-type ids))))
-
-
-;;; Wrappers for 'list' variables
-
-(defvar guix-list-data nil
- "Alist with 'list' data.
-This alist is filled by `guix-list-define-interface' macro.")
-
-(defun guix-list-value (entry-type symbol)
- "Return SYMBOL's value for ENTRY-TYPE from `guix-list-data'."
- (symbol-value (guix-assq-value guix-list-data entry-type symbol)))
-
-(defun guix-list-param-title (entry-type param)
- "Return column title of an ENTRY-TYPE parameter PARAM."
- (guix-buffer-param-title 'list entry-type param))
-
-(defun guix-list-format (entry-type)
- "Return column format for ENTRY-TYPE."
- (guix-list-value entry-type 'format))
-
-(defun guix-list-displayed-params (entry-type)
- "Return a list of ENTRY-TYPE parameters that should be displayed."
- (mapcar #'car (guix-list-format entry-type)))
-
-(defun guix-list-sort-key (entry-type)
- "Return sort key for ENTRY-TYPE."
- (guix-list-value entry-type 'sort-key))
-
-(defun guix-list-additional-marks (entry-type)
- "Return alist of additional marks for ENTRY-TYPE."
- (guix-list-value entry-type 'marks))
-
-(defun guix-list-single-entry? (entry-type)
- "Return non-nil, if a single entry of ENTRY-TYPE should be listed."
- (guix-list-value entry-type 'list-single))
-
-(defun guix-list-describe-warning-count (entry-type)
- "Return the maximum number of ENTRY-TYPE entries to describe."
- (guix-list-value entry-type 'describe-count))
-
-(defun guix-list-describe-entries (entry-type ids)
- "Describe ENTRY-TYPE entries with IDS in 'info' buffer"
- (funcall (guix-list-value entry-type 'describe)
- ids))
-
-
-;;; Tabulated list internals
-
-(defun guix-list-sort-numerically (column a b)
- "Compare COLUMN of tabulated entries A and B numerically.
-This function is used for sort predicates for `tabulated-list-format'.
-Return non-nil, if B is bigger than A."
- (cl-flet ((num (entry)
- (string-to-number (aref (cadr entry) column))))
- (> (num b) (num a))))
-
-(defmacro guix-list-define-numerical-sorter (column)
- "Define numerical sort predicate for COLUMN.
-See `guix-list-sort-numerically' for details."
- (let ((name (intern (format "guix-list-sort-numerically-%d" column)))
- (doc (format "\
-Predicate to sort tabulated list by column %d numerically.
-See `guix-list-sort-numerically' for details."
- column)))
- `(defun ,name (a b)
- ,doc
- (guix-list-sort-numerically ,column a b))))
-
-(defmacro guix-list-define-numerical-sorters (n)
- "Define numerical sort predicates for columns from 0 to N.
-See `guix-list-define-numerical-sorter' for details."
- `(progn
- ,@(mapcar (lambda (i)
- `(guix-list-define-numerical-sorter ,i))
- (number-sequence 0 n))))
-
-(guix-list-define-numerical-sorters 9)
-
-(defun guix-list-tabulated-sort-key (entry-type)
- "Return ENTRY-TYPE sort key for `tabulated-list-sort-key'."
- (let ((sort-key (guix-list-sort-key entry-type)))
- (and sort-key
- (cons (guix-list-param-title entry-type (car sort-key))
- (cdr sort-key)))))
-
-(defun guix-list-tabulated-vector (entry-type fun)
- "Call FUN on each column specification for ENTRY-TYPE.
-
-FUN is applied to column specification as arguments (see
-`guix-list-format').
-
-Return a vector made of values of FUN calls."
- (apply #'vector
- (mapcar (lambda (col-spec)
- (apply fun col-spec))
- (guix-list-format entry-type))))
-
-(defun guix-list-tabulated-format (entry-type)
- "Return ENTRY-TYPE list specification for `tabulated-list-format'."
- (guix-list-tabulated-vector
- entry-type
- (lambda (param _ &rest rest-spec)
- (cons (guix-list-param-title entry-type param)
- rest-spec))))
-
-(defun guix-list-tabulated-entries (entries entry-type)
- "Return a list of ENTRY-TYPE values for `tabulated-list-entries'."
- (mapcar (lambda (entry)
- (list (guix-entry-id entry)
- (guix-list-tabulated-entry entry entry-type)))
- entries))
-
-(defun guix-list-tabulated-entry (entry entry-type)
- "Return array of values for `tabulated-list-entries'.
-Parameters are taken from ENTRY-TYPE ENTRY."
- (guix-list-tabulated-vector
- entry-type
- (lambda (param fun &rest _)
- (let ((val (guix-entry-value entry param)))
- (if fun
- (funcall fun val entry)
- (guix-get-string val))))))
-
-
-;;; Displaying entries
-
-(defun guix-list-get-display-entries (entry-type &rest args)
- "Search for entries and show them in a 'list' buffer preferably."
- (let ((entries (guix-buffer-get-entries 'list entry-type args)))
- (if (or (null entries) ; = 0
- (cdr entries) ; > 1
- (guix-list-single-entry? entry-type)
- (null (guix-buffer-value 'info entry-type 'show-entries)))
- (guix-buffer-display-entries entries 'list entry-type args 'add)
- (if (equal (guix-buffer-value 'info entry-type 'get-entries)
- (guix-buffer-value 'list entry-type 'get-entries))
- (guix-buffer-display-entries entries 'info entry-type args 'add)
- (guix-buffer-get-display-entries 'info entry-type args 'add)))))
-
-(defun guix-list-insert-entries (entries entry-type)
- "Print ENTRY-TYPE ENTRIES in the current buffer."
- (setq tabulated-list-entries
- (guix-list-tabulated-entries entries entry-type))
- (tabulated-list-print))
-
-(defun guix-list-get-one-line (val &optional _)
- "Return one-line string from a multi-line string VAL.
-VAL may be nil."
- (if val
- (guix-get-one-line val)
- (guix-get-string nil)))
-
-(defun guix-list-get-time (seconds &optional _)
- "Return formatted time string from SECONDS."
- (guix-get-string (guix-get-time-string seconds)
- 'guix-list-time))
-
-(defun guix-list-get-file-name (file-name &optional _)
- "Return FILE-NAME button specification for `tabulated-list-entries'."
- (list file-name
- 'face 'guix-list-file-name
- 'action (lambda (btn) (find-file (button-label btn)))
- 'follow-link t
- 'help-echo "Find file"))
-
-(defun guix-list-get-url (url &optional _)
- "Return URL button specification for `tabulated-list-entries'."
- (list url
- 'face 'guix-list-url
- 'action (lambda (btn) (browse-url (button-label btn)))
- 'follow-link t
- 'help-echo "Browse URL"))
-
-
-;;; 'List' lines
-
-(defun guix-list-current-id ()
- "Return ID of the entry at point."
- (or (tabulated-list-get-id)
- (user-error "No entry here")))
-
-(defun guix-list-current-entry ()
- "Return entry at point."
- (guix-entry-by-id (guix-list-current-id)
- (guix-buffer-current-entries)))
-
-(defun guix-list-for-each-line (fun &rest args)
- "Call FUN with ARGS for each entry line."
- (or (derived-mode-p 'guix-list-mode)
- (error "The current buffer is not in Guix List mode"))
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (apply fun args)
- (forward-line))))
-
-(defun guix-list-fold-lines (fun init)
- "Fold over entry lines in the current list buffer.
-Call FUN with RESULT as argument for each line, using INIT as
-the initial value of RESULT. Return the final result."
- (let ((res init))
- (guix-list-for-each-line
- (lambda () (setq res (funcall fun res))))
- res))
-
-
-;;; Marking and sorting
-
-(defvar-local guix-list-marked nil
- "List of the marked entries.
-Each element of the list has a form:
-
- (ID MARK-NAME . ARGS)
-
-ID is an entry ID.
-MARK-NAME is a symbol from `guix-list-marks'.
-ARGS is a list of additional values.")
-
-(defvar-local guix-list-marks nil
- "Alist of available mark names and mark characters.")
-
-(defvar guix-list-default-marks
- '((empty . ?\s)
- (general . ?*))
- "Alist of default mark names and mark characters.")
-
-(defun guix-list-marks (entry-type)
- "Return alist of available marks for ENTRY-TYPE."
- (append guix-list-default-marks
- (guix-list-additional-marks entry-type)))
-
-(defun guix-list-get-mark (name)
- "Return mark character by its NAME."
- (or (guix-assq-value guix-list-marks name)
- (error "Mark '%S' not found" name)))
-
-(defun guix-list-get-mark-string (name)
- "Return mark string by its NAME."
- (string (guix-list-get-mark name)))
-
-(defun guix-list-current-mark ()
- "Return mark character of the current line."
- (char-after (line-beginning-position)))
-
-(defun guix-list-get-marked (&rest mark-names)
- "Return list of specs of entries marked with any mark from MARK-NAMES.
-Entry specs are elements from `guix-list-marked' list.
-If MARK-NAMES are not specified, use all marks from
-`guix-list-marks' except the `empty' one."
- (or mark-names
- (setq mark-names
- (delq 'empty
- (mapcar #'car guix-list-marks))))
- (cl-remove-if-not (lambda (assoc)
- (memq (cadr assoc) mark-names))
- guix-list-marked))
-
-(defun guix-list-get-marked-args (mark-name)
- "Return list of (ID . ARGS) elements from lines marked with MARK-NAME.
-See `guix-list-marked' for the meaning of ARGS."
- (mapcar (lambda (spec)
- (let ((id (car spec))
- (args (cddr spec)))
- (cons id args)))
- (guix-list-get-marked mark-name)))
-
-(defun guix-list-get-marked-id-list (&rest mark-names)
- "Return list of IDs of entries marked with any mark from MARK-NAMES.
-See `guix-list-get-marked' for details."
- (mapcar #'car (apply #'guix-list-get-marked mark-names)))
-
-(defun guix-list--mark (mark-name &optional advance &rest args)
- "Put a mark on the current line.
-Also add the current entry to `guix-list-marked' using its ID and ARGS.
-MARK-NAME is a symbol from `guix-list-marks'.
-If ADVANCE is non-nil, move forward by one line after marking."
- (let ((id (guix-list-current-id)))
- (if (eq mark-name 'empty)
- (setq guix-list-marked (assq-delete-all id guix-list-marked))
- (let ((assoc (assq id guix-list-marked))
- (val (cons mark-name args)))
- (if assoc
- (setcdr assoc val)
- (push (cons id val) guix-list-marked)))))
- (tabulated-list-put-tag (guix-list-get-mark-string mark-name)
- advance))
-
-(defun guix-list-mark (&optional arg)
- "Mark the current line and move to the next line.
-With ARG, mark all lines."
- (interactive "P")
- (if arg
- (guix-list-mark-all)
- (guix-list--mark 'general t)))
-
-(defun guix-list-mark-all (&optional mark-name)
- "Mark all lines with MARK-NAME mark.
-MARK-NAME is a symbol from `guix-list-marks'.
-Interactively, put a general mark on all lines."
- (interactive)
- (or mark-name (setq mark-name 'general))
- (guix-list-for-each-line #'guix-list--mark mark-name))
-
-(defun guix-list-unmark (&optional arg)
- "Unmark the current line and move to the next line.
-With ARG, unmark all lines."
- (interactive "P")
- (if arg
- (guix-list-unmark-all)
- (guix-list--mark 'empty t)))
-
-(defun guix-list-unmark-backward ()
- "Move up one line and unmark it."
- (interactive)
- (forward-line -1)
- (guix-list--mark 'empty))
-
-(defun guix-list-unmark-all ()
- "Unmark all lines."
- (interactive)
- (guix-list-mark-all 'empty))
-
-(defun guix-list-restore-marks ()
- "Put marks according to `guix-list-marked'."
- (guix-list-for-each-line
- (lambda ()
- (let ((mark-name (car (guix-assq-value guix-list-marked
- (guix-list-current-id)))))
- (tabulated-list-put-tag
- (guix-list-get-mark-string (or mark-name 'empty)))))))
-
-(defun guix-list-sort (&optional n)
- "Sort guix list entries by the column at point.
-With a numeric prefix argument N, sort the Nth column.
-Same as `tabulated-list-sort', but also restore marks after sorting."
- (interactive "P")
- (tabulated-list-sort n)
- (guix-list-restore-marks))
-
-
-;;; Major mode and interface definer
-
-(defvar guix-list-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent
- map (make-composed-keymap guix-buffer-map
- tabulated-list-mode-map))
- (define-key map (kbd "RET") 'guix-list-describe)
- (define-key map (kbd "i") 'guix-list-describe)
- (define-key map (kbd "m") 'guix-list-mark)
- (define-key map (kbd "*") 'guix-list-mark)
- (define-key map (kbd "u") 'guix-list-unmark)
- (define-key map (kbd "DEL") 'guix-list-unmark-backward)
- (define-key map [remap tabulated-list-sort] 'guix-list-sort)
- map)
- "Keymap for `guix-list-mode' buffers.")
-
-(define-derived-mode guix-list-mode tabulated-list-mode "Guix-List"
- "Parent mode for displaying data in 'list' form.")
-
-(defun guix-list-mode-initialize (entry-type)
- "Set up the current 'list' buffer for displaying ENTRY-TYPE entries."
- (setq tabulated-list-padding 2
- tabulated-list-format (guix-list-tabulated-format entry-type)
- tabulated-list-sort-key (guix-list-tabulated-sort-key entry-type))
- (setq-local guix-list-marks (guix-list-marks entry-type))
- (tabulated-list-init-header))
-
-(defmacro guix-list-define-interface (entry-type &rest args)
- "Define 'list' interface for displaying ENTRY-TYPE entries.
-Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
-
-Required keywords:
-
- - `:format' - default value of the generated
- `guix-ENTRY-TYPE-list-format' variable.
-
-Optional keywords:
-
- - `:sort-key' - default value of the generated
- `guix-ENTRY-TYPE-list-sort-key' variable.
-
- - `:describe-function' - default value of the generated
- `guix-ENTRY-TYPE-describe-function' variable.
-
- - `:list-single?' - default value of the generated
- `guix-ENTRY-TYPE-list-single' variable.
-
- - `:marks' - default value of the generated
- `guix-ENTRY-TYPE-list-marks' variable.
-
-The rest keyword arguments are passed to
-`guix-buffer-define-interface' macro."
- (declare (indent 1))
- (let* ((entry-type-str (symbol-name entry-type))
- (prefix (concat "guix-" entry-type-str "-list"))
- (group (intern prefix))
- (describe-var (intern (concat prefix "-describe-function")))
- (describe-count-var (intern (concat prefix
- "-describe-warning-count")))
- (format-var (intern (concat prefix "-format")))
- (sort-key-var (intern (concat prefix "-sort-key")))
- (list-single-var (intern (concat prefix "-single")))
- (marks-var (intern (concat prefix "-marks"))))
- (guix-keyword-args-let args
- ((show-entries-val :show-entries-function)
- (describe-val :describe-function)
- (describe-count-val :describe-count 10)
- (format-val :format)
- (sort-key-val :sort-key)
- (list-single-val :list-single?)
- (marks-val :marks))
- `(progn
- (defcustom ,format-var ,format-val
- ,(format "\
-List of format values of the displayed columns.
-Each element of the list has a form:
-
- (PARAM VALUE-FUN WIDTH SORT . PROPS)
-
-PARAM is a name of '%s' entry parameter.
-
-VALUE-FUN may be either nil or a function returning a value that
-will be inserted. The function is called with 2 arguments: the
-first one is the value of the parameter; the second one is an
-entry (alist of parameter names and values).
-
-For the meaning of WIDTH, SORT and PROPS, see
-`tabulated-list-format'."
- entry-type-str)
- :type 'sexp
- :group ',group)
-
- (defcustom ,sort-key-var ,sort-key-val
- ,(format "\
-Default sort key for 'list' buffer with '%s' entries.
-Should be nil (no sort) or have a form:
-
- (PARAM . FLIP)
-
-PARAM is the name of '%s' entry parameter. For the meaning of
-FLIP, see `tabulated-list-sort-key'."
- entry-type-str entry-type-str)
- :type '(choice (const :tag "No sort" nil)
- (cons symbol boolean))
- :group ',group)
-
- (defvar ,marks-var ,marks-val
- ,(format "\
-Alist of additional marks for 'list' buffer with '%s' entries.
-Marks from this list are used along with `guix-list-default-marks'."
- entry-type-str))
-
- (defcustom ,list-single-var ,list-single-val
- ,(format "\
-If non-nil, list '%s' entry even if it is the only matching result.
-If nil, show a single '%s' entry in the 'info' buffer."
- entry-type-str entry-type-str)
- :type 'boolean
- :group ',group)
-
- (defcustom ,describe-count-var ,describe-count-val
- ,(format "\
-The maximum number of '%s' entries to describe without a warning.
-If a user wants to describe more than this number of marked
-entries, he will be prompted for confirmation.
-See also `guix-list-describe'."
- entry-type-str)
- :type 'integer
- :group ',group)
-
- (defvar ,describe-var ,describe-val
- ,(format "Function used to describe '%s' entries."
- entry-type-str))
-
- (guix-alist-put!
- '((describe . ,describe-var)
- (describe-count . ,describe-count-var)
- (format . ,format-var)
- (sort-key . ,sort-key-var)
- (list-single . ,list-single-var)
- (marks . ,marks-var))
- 'guix-list-data ',entry-type)
-
- ,(if show-entries-val
- `(guix-buffer-define-interface list ,entry-type
- :show-entries-function ,show-entries-val
- ,@%foreign-args)
-
- (let ((insert-fun (intern (concat prefix "-insert-entries")))
- (mode-init-fun (intern (concat prefix "-mode-initialize"))))
- `(progn
- (defun ,insert-fun (entries)
- ,(format "\
-Print '%s' ENTRIES in the current 'list' buffer."
- entry-type-str)
- (guix-list-insert-entries entries ',entry-type))
-
- (defun ,mode-init-fun ()
- ,(format "\
-Set up the current 'list' buffer for displaying '%s' entries."
- entry-type-str)
- (guix-list-mode-initialize ',entry-type))
-
- (guix-buffer-define-interface list ,entry-type
- :insert-entries-function ',insert-fun
- :mode-init-function ',mode-init-fun
- ,@%foreign-args))))))))
-
-
-(defvar guix-list-font-lock-keywords
- (eval-when-compile
- `((,(rx "(" (group "guix-list-define-interface")
- symbol-end)
- . 1))))
-
-(font-lock-add-keywords 'emacs-lisp-mode guix-list-font-lock-keywords)
-
-(provide 'guix-list)
-
-;;; guix-list.el ends here
diff --git a/emacs/guix-location.el b/emacs/guix-location.el
deleted file mode 100644
index 81396b4017..0000000000
--- a/emacs/guix-location.el
+++ /dev/null
@@ -1,79 +0,0 @@
-;;; guix-location.el --- Package locations
-
-;; Copyright © 2016 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU Guix is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public Location as published by
-;; the Free Software Foundation, either version 3 of the Location, or
-;; (at your option) any later version.
-
-;; GNU 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 Location for more details.
-
-;; You should have received a copy of the GNU General Public Location
-;; along with this program. If not, see <http://www.gnu.org/locations/>.
-
-;;; Commentary:
-
-;; This file provides the code to work with locations of Guix packages.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'guix-backend)
-(require 'guix-read)
-(require 'guix-guile)
-
-(defun guix-package-location (id-or-name)
- "Return location of a package with ID-OR-NAME.
-For the meaning of location, see `guix-find-location'."
- (guix-eval-read (guix-make-guile-expression
- 'package-location-string id-or-name)))
-
-;;;###autoload
-(defun guix-find-location (location &optional directory)
- "Go to LOCATION of a package.
-LOCATION is a string of the form:
-
- \"FILE:LINE:COLUMN\"
-
-If FILE is relative, it is considered to be relative to
-DIRECTORY (`guix-directory' by default).
-
-Interactively, prompt for LOCATION. With prefix argument, prompt
-for DIRECTORY as well."
- (interactive
- (list (guix-read-package-location)
- (guix-read-directory)))
- (cl-multiple-value-bind (file line column)
- (split-string location ":")
- (find-file (expand-file-name file (or directory guix-directory)))
- (when (and line column)
- (let ((line (string-to-number line))
- (column (string-to-number column)))
- (goto-char (point-min))
- (forward-line (- line 1))
- (move-to-column column)
- (recenter 1)))))
-
-;;;###autoload
-(defun guix-edit (id-or-name &optional directory)
- "Edit (go to location of) package with ID-OR-NAME.
-See `guix-find-location' for the meaning of package location and
-DIRECTORY.
-Interactively, with prefix argument, prompt for DIRECTORY."
- (interactive
- (list (guix-read-package-name)
- (guix-read-directory)))
- (let ((loc (guix-package-location id-or-name)))
- (if loc
- (guix-find-location loc directory)
- (message "Couldn't find package location."))))
-
-(provide 'guix-location)
-
-;;; guix-location.el ends here
diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm
deleted file mode 100644
index 040932f307..0000000000
--- a/emacs/guix-main.scm
+++ /dev/null
@@ -1,1163 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU 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.
-;;;
-;;; GNU 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Information about packages and generations is passed to the elisp
-;; side in the form of alists of parameters (such as ‘name’ or
-;; ‘version’) and their values.
-
-;; ‘entries’ procedure is the “entry point” for the elisp side to get
-;; information about packages and generations.
-
-;; Since name/version pair is not necessarily unique, we use
-;; `object-address' to identify a package (for ‘id’ parameter), if
-;; possible. However for the obsolete packages (that can be found in
-;; installed manifest but not in a package directory), ‘id’ parameter is
-;; still "name-version" string. So ‘id’ package parameter in the code
-;; below is either an object-address number or a full-name string.
-
-;;; Code:
-
-(use-modules
- (ice-9 vlist)
- (ice-9 match)
- (ice-9 popen)
- (srfi srfi-1)
- (srfi srfi-2)
- (srfi srfi-11)
- (srfi srfi-19)
- (srfi srfi-26)
- (guix)
- (guix combinators)
- (guix git-download)
- (guix grafts)
- (guix packages)
- (guix profiles)
- (guix licenses)
- (guix utils)
- (guix ui)
- (guix scripts)
- (guix scripts package)
- (gnu packages)
- (gnu system))
-
-(define-syntax-rule (first-or-false lst)
- (and (not (null? lst))
- (first lst)))
-
-(define (list-maybe obj)
- (if (list? obj) obj (list obj)))
-
-(define (output+error thunk)
- "Call THUNK and return 2 values: output and error output as strings."
- (let ((output-port (open-output-string))
- (error-port (open-output-string)))
- (with-output-to-port output-port
- (lambda () (with-error-to-port error-port thunk)))
- (let ((strings (list (get-output-string output-port)
- (get-output-string error-port))))
- (close-output-port output-port)
- (close-output-port error-port)
- (apply values strings))))
-
-(define (full-name->name+version spec)
- "Given package specification SPEC with or without output,
-return two values: name and version. For example, for SPEC
-\"foo@0.9.1b:lib\", return \"foo\" and \"0.9.1b\"."
- (let-values (((name version output)
- (package-specification->name+version+output spec)))
- (values name version)))
-
-(define (name+version->full-name name version)
- (string-append name "@" version))
-
-(define* (make-package-specification name #:optional version output)
- (let ((full-name (if version
- (name+version->full-name name version)
- name)))
- (if output
- (string-append full-name ":" output)
- full-name)))
-
-(define (manifest-entry->name+version+output entry)
- (values
- (manifest-entry-name entry)
- (manifest-entry-version entry)
- (manifest-entry-output entry)))
-
-(define (manifest-entry->package-specification entry)
- (call-with-values
- (lambda () (manifest-entry->name+version+output entry))
- make-package-specification))
-
-(define (manifest-entries->package-specifications entries)
- (map manifest-entry->package-specification entries))
-
-(define (profile-package-specifications profile)
- "Return a list of package specifications for PROFILE."
- (let ((manifest (profile-manifest profile)))
- (manifest-entries->package-specifications
- (manifest-entries manifest))))
-
-(define (profile->specifications+paths profile)
- "Return a list of package specifications and paths for PROFILE.
-Each element of the list is a list of the package specification and its path."
- (let ((manifest (profile-manifest profile)))
- (map (lambda (entry)
- (list (manifest-entry->package-specification entry)
- (manifest-entry-item entry)))
- (manifest-entries manifest))))
-
-(define (profile-difference profile1 profile2)
- "Return a list of package specifications for outputs installed in PROFILE1
-and not installed in PROFILE2."
- (let ((specs1 (profile-package-specifications profile1))
- (specs2 (profile-package-specifications profile2)))
- (lset-difference string=? specs1 specs2)))
-
-(define (manifest-entries->hash-table entries)
- "Return a hash table of name keys and lists of matching manifest ENTRIES."
- (let ((table (make-hash-table (length entries))))
- (for-each (lambda (entry)
- (let* ((key (manifest-entry-name entry))
- (ref (hash-ref table key)))
- (hash-set! table key
- (if ref (cons entry ref) (list entry)))))
- entries)
- table))
-
-(define (manifest=? m1 m2)
- (or (eq? m1 m2)
- (equal? m1 m2)))
-
-(define manifest->hash-table
- (let ((current-manifest #f)
- (current-table #f))
- (lambda (manifest)
- "Return a hash table of name keys and matching MANIFEST entries."
- (unless (manifest=? manifest current-manifest)
- (set! current-manifest manifest)
- (set! current-table (manifest-entries->hash-table
- (manifest-entries manifest))))
- current-table)))
-
-(define* (manifest-entries-by-name manifest name #:optional version output)
- "Return a list of MANIFEST entries matching NAME, VERSION and OUTPUT."
- (let ((entries (or (hash-ref (manifest->hash-table manifest) name)
- '())))
- (if (or version output)
- (filter (lambda (entry)
- (and (or (not version)
- (equal? version (manifest-entry-version entry)))
- (or (not output)
- (equal? output (manifest-entry-output entry)))))
- entries)
- entries)))
-
-(define (manifest-entry-by-output entries output)
- "Return a manifest entry from ENTRIES matching OUTPUT."
- (find (lambda (entry)
- (string= output (manifest-entry-output entry)))
- entries))
-
-(define (fold-manifest-by-name manifest proc init)
- "Fold over MANIFEST entries.
-Call (PROC NAME VERSION ENTRIES RESULT), using INIT as the initial value
-of RESULT. ENTRIES is a list of manifest entries with NAME/VERSION."
- (hash-fold (lambda (name entries res)
- (proc name (manifest-entry-version (car entries))
- entries res))
- init
- (manifest->hash-table manifest)))
-
-(define* (object-transformer param-alist #:optional (params '()))
- "Return procedure transforming objects into alist of parameter/value pairs.
-
-PARAM-ALIST is alist of available parameters (symbols) and procedures
-returning values of these parameters. Each procedure is applied to
-objects.
-
-PARAMS is list of parameters from PARAM-ALIST that should be returned by
-a resulting procedure. If PARAMS is not specified or is an empty list,
-use all available parameters.
-
-Example:
-
- (let* ((alist `((plus1 . ,1+) (minus1 . ,1-) (mul2 . ,(cut * 2 <>))))
- (number->alist (object-transformer alist '(plus1 mul2))))
- (number->alist 8))
- =>
- ((plus1 . 9) (mul2 . 16))
-"
- (let* ((use-all-params (null? params))
- (alist (filter-map (match-lambda
- ((param . proc)
- (and (or use-all-params
- (memq param params))
- (cons param proc)))
- (_ #f))
- param-alist)))
- (lambda objects
- (map (match-lambda
- ((param . proc)
- (cons param (apply proc objects))))
- alist))))
-
-(define %manifest-entry-param-alist
- `((output . ,manifest-entry-output)
- (path . ,manifest-entry-item)
- (dependencies . ,manifest-entry-dependencies)))
-
-(define manifest-entry->sexp
- (object-transformer %manifest-entry-param-alist))
-
-(define (manifest-entries->sexps entries)
- (map manifest-entry->sexp entries))
-
-(define (package-inputs-names inputs)
- "Return a list of full names of the packages from package INPUTS."
- (filter-map (match-lambda
- ((_ (? package? package))
- (make-package-specification (package-name package)
- (package-version package)))
- ((_ (? package? package) output)
- (make-package-specification (package-name package)
- (package-version package)
- output))
- (_ #f))
- inputs))
-
-(define (package-license-names package)
- "Return a list of license names of the PACKAGE."
- (filter-map (lambda (license)
- (and (license? license)
- (license-name license)))
- (list-maybe (package-license package))))
-
-(define (package-source-names package)
- "Return a list of source names (URLs) of the PACKAGE."
- (let ((source (package-source package)))
- (and (origin? source)
- (filter-map (lambda (uri)
- (cond ((string? uri)
- uri)
- ((git-reference? uri)
- (git-reference-url uri))
- (else "Unknown source type")))
- (list-maybe (origin-uri source))))))
-
-(define (package-unique? package)
- "Return #t if PACKAGE is a single package with such name/version."
- (match (packages-by-name (package-name package)
- (package-version package))
- ((package) #t)
- (_ #f)))
-
-(define %package-param-alist
- `((id . ,object-address)
- (package-id . ,object-address)
- (name . ,package-name)
- (version . ,package-version)
- (license . ,package-license-names)
- (source . ,package-source-names)
- (synopsis . ,package-synopsis)
- (description . ,package-description-string)
- (home-url . ,package-home-page)
- (outputs . ,package-outputs)
- (systems . ,package-supported-systems)
- (non-unique . ,(negate package-unique?))
- (inputs . ,(lambda (pkg)
- (package-inputs-names
- (package-inputs pkg))))
- (native-inputs . ,(lambda (pkg)
- (package-inputs-names
- (package-native-inputs pkg))))
- (propagated-inputs . ,(lambda (pkg)
- (package-inputs-names
- (package-propagated-inputs pkg))))
- (location . ,(lambda (pkg)
- (location->string (package-location pkg))))))
-
-(define (package-param package param)
- "Return a value of a PACKAGE PARAM."
- (and=> (assq-ref %package-param-alist param)
- (cut <> package)))
-
-
-;;; Finding packages.
-
-(define-values (package-by-address
- register-package)
- (let ((table (delay (fold-packages
- (lambda (package table)
- (vhash-consq (object-address package)
- package table))
- vlist-null))))
- (values
- (lambda (address)
- "Return package by its object ADDRESS."
- (match (vhash-assq address (force table))
- ((_ . package) package)
- (_ #f)))
- (lambda (package)
- "Register PACKAGE by its 'object-address', so that later
-'package-by-address' can be used to access it."
- (let ((table* (force table)))
- (set! table
- (delay (vhash-consq (object-address package)
- package table*))))))))
-
-(define packages-by-name+version
- (let ((table (delay (fold-packages
- (lambda (package table)
- (let ((file (location-file
- (package-location package))))
- (vhash-cons (cons (package-name package)
- (package-version package))
- package table)))
- vlist-null))))
- (lambda (name version)
- "Return packages matching NAME and VERSION."
- (vhash-fold* cons '() (cons name version) (force table)))))
-
-(define (packages-by-full-name full-name)
- (call-with-values
- (lambda () (full-name->name+version full-name))
- packages-by-name+version))
-
-(define (packages-by-id id)
- (if (integer? id)
- (let ((pkg (package-by-address id)))
- (if pkg (list pkg) '()))
- (packages-by-full-name id)))
-
-(define (id->name+version id)
- (if (integer? id)
- (and=> (package-by-address id)
- (lambda (pkg)
- (values (package-name pkg)
- (package-version pkg))))
- (full-name->name+version id)))
-
-(define (package-by-id id)
- (first-or-false (packages-by-id id)))
-
-(define (newest-package-by-id id)
- (and=> (id->name+version id)
- (lambda (name)
- (first-or-false (find-best-packages-by-name name #f)))))
-
-(define (matching-packages predicate)
- (fold-packages (lambda (pkg res)
- (if (predicate pkg)
- (cons pkg res)
- res))
- '()))
-
-(define (filter-packages-by-output packages output)
- (filter (lambda (package)
- (member output (package-outputs package)))
- packages))
-
-(define* (packages-by-name name #:optional version output)
- "Return a list of packages matching NAME, VERSION and OUTPUT."
- (let ((packages (if version
- (packages-by-name+version name version)
- (matching-packages
- (lambda (pkg) (string=? name (package-name pkg)))))))
- (if output
- (filter-packages-by-output packages output)
- packages)))
-
-(define (manifest-entry->packages entry)
- (call-with-values
- (lambda () (manifest-entry->name+version+output entry))
- packages-by-name))
-
-(define (packages-by-regexp regexp match-params)
- "Return a list of packages matching REGEXP string.
-MATCH-PARAMS is a list of parameters that REGEXP can match."
- (define (package-match? package regexp)
- (any (lambda (param)
- (let ((val (package-param package param)))
- (and (string? val) (regexp-exec regexp val))))
- match-params))
-
- (let ((re (make-regexp regexp regexp/icase)))
- (matching-packages (cut package-match? <> re))))
-
-(define (packages-by-license license)
- "Return a list of packages with LICENSE."
- (matching-packages
- (lambda (package)
- (memq license (list-maybe (package-license package))))))
-
-(define (all-available-packages)
- "Return a list of all available packages."
- (matching-packages (const #t)))
-
-(define (newest-available-packages)
- "Return a list of the newest available packages."
- (vhash-fold (lambda (name elem res)
- (match elem
- ((_ newest pkgs ...)
- (cons newest res))))
- '()
- (find-newest-available-packages)))
-
-(define (packages-from-file file)
- "Return a list of packages from FILE."
- (let ((package (load (canonicalize-path file))))
- (if (package? package)
- (begin
- (register-package package)
- (list package))
- '())))
-
-
-;;; Making package/output patterns.
-
-(define (specification->package-pattern specification)
- (call-with-values
- (lambda ()
- (full-name->name+version specification))
- list))
-
-(define (specification->output-pattern specification)
- (call-with-values
- (lambda ()
- (package-specification->name+version+output specification #f))
- list))
-
-(define (id->package-pattern id)
- (if (integer? id)
- (package-by-address id)
- (specification->package-pattern id)))
-
-(define (id->output-pattern id)
- "Return an output pattern by output ID.
-ID should be '<package-address>:<output>' or '<name>-<version>:<output>'."
- (let-values (((name version output)
- (package-specification->name+version+output id)))
- (if version
- (list name version output)
- (list (package-by-address (string->number name))
- output))))
-
-(define (specifications->package-patterns . specifications)
- (map specification->package-pattern specifications))
-
-(define (specifications->output-patterns . specifications)
- (map specification->output-pattern specifications))
-
-(define (ids->package-patterns . ids)
- (map id->package-pattern ids))
-
-(define (ids->output-patterns . ids)
- (map id->output-pattern ids))
-
-(define* (manifest-patterns-result packages res obsolete-pattern
- #:optional installed-pattern)
- "Auxiliary procedure for 'manifest-package-patterns' and
-'manifest-output-patterns'."
- (if (null? packages)
- (cons (obsolete-pattern) res)
- (if installed-pattern
- ;; We don't need duplicates for a list of installed packages,
- ;; so just take any (car) package.
- (cons (installed-pattern (car packages)) res)
- res)))
-
-(define* (manifest-package-patterns manifest #:optional obsolete-only?)
- "Return a list of package patterns for MANIFEST entries.
-If OBSOLETE-ONLY? is #f, use all entries, otherwise make patterns only
-for obsolete packages."
- (fold-manifest-by-name
- manifest
- (lambda (name version entries res)
- (manifest-patterns-result (packages-by-name name version)
- res
- (lambda () (list name version entries))
- (and (not obsolete-only?)
- (cut list <> entries))))
- '()))
-
-(define* (manifest-output-patterns manifest #:optional obsolete-only?)
- "Return a list of output patterns for MANIFEST entries.
-If OBSOLETE-ONLY? is #f, use all entries, otherwise make patterns only
-for obsolete packages."
- (fold (lambda (entry res)
- (manifest-patterns-result (manifest-entry->packages entry)
- res
- (lambda () entry)
- (and (not obsolete-only?)
- (cut list <> entry))))
- '()
- (manifest-entries manifest)))
-
-(define (obsolete-package-patterns manifest)
- (manifest-package-patterns manifest #t))
-
-(define (obsolete-output-patterns manifest)
- (manifest-output-patterns manifest #t))
-
-
-;;; Transforming package/output patterns into alists.
-
-(define (obsolete-package-sexp name version entries)
- "Return an alist with information about obsolete package.
-ENTRIES is a list of installed manifest entries."
- `((id . ,(name+version->full-name name version))
- (name . ,name)
- (version . ,version)
- (outputs . ,(map manifest-entry-output entries))
- (obsolete . #t)
- (installed . ,(manifest-entries->sexps entries))))
-
-(define (package-pattern-transformer manifest params)
- "Return 'package-pattern->package-sexps' procedure."
- (define package->sexp
- (object-transformer %package-param-alist params))
-
- (define* (sexp-by-package package #:optional
- (entries (manifest-entries-by-name
- manifest
- (package-name package)
- (package-version package))))
- (cons (cons 'installed (manifest-entries->sexps entries))
- (package->sexp package)))
-
- (define (->sexps pattern)
- (match pattern
- ((? package? package)
- (list (sexp-by-package package)))
- (((? package? package) entries)
- (list (sexp-by-package package entries)))
- ((name version entries)
- (list (obsolete-package-sexp
- name version entries)))
- ((name version)
- (let ((packages (packages-by-name name version)))
- (if (null? packages)
- (let ((entries (manifest-entries-by-name
- manifest name version)))
- (if (null? entries)
- '()
- (list (obsolete-package-sexp
- name version entries))))
- (map sexp-by-package packages))))
- (_ '())))
-
- ->sexps)
-
-(define (output-pattern-transformer manifest params)
- "Return 'output-pattern->output-sexps' procedure."
- (define package->sexp
- (object-transformer (alist-delete 'id %package-param-alist)
- params))
-
- (define manifest-entry->sexp
- (object-transformer (alist-delete 'output %manifest-entry-param-alist)
- params))
-
- (define* (output-sexp pkg-alist pkg-address output
- #:optional entry)
- (let ((entry-alist (if entry
- (manifest-entry->sexp entry)
- '()))
- (base `((id . ,(string-append
- (number->string pkg-address)
- ":" output))
- (output . ,output)
- (installed . ,(->bool entry)))))
- (append entry-alist base pkg-alist)))
-
- (define (obsolete-output-sexp entry)
- (let-values (((name version output)
- (manifest-entry->name+version+output entry)))
- (let ((base `((id . ,(make-package-specification
- name version output))
- (package-id . ,(name+version->full-name name version))
- (name . ,name)
- (version . ,version)
- (output . ,output)
- (obsolete . #t)
- (installed . #t))))
- (append (manifest-entry->sexp entry) base))))
-
- (define* (sexps-by-package package #:optional output
- (entries (manifest-entries-by-name
- manifest
- (package-name package)
- (package-version package))))
- ;; Assuming that PACKAGE has this OUTPUT.
- (let ((pkg-alist (package->sexp package))
- (address (object-address package))
- (outputs (if output
- (list output)
- (package-outputs package))))
- (map (lambda (output)
- (output-sexp pkg-alist address output
- (manifest-entry-by-output entries output)))
- outputs)))
-
- (define* (sexps-by-manifest-entry entry #:optional
- (packages (manifest-entry->packages
- entry)))
- (if (null? packages)
- (list (obsolete-output-sexp entry))
- (map (lambda (package)
- (output-sexp (package->sexp package)
- (object-address package)
- (manifest-entry-output entry)
- entry))
- packages)))
-
- (define (->sexps pattern)
- (match pattern
- ((? package? package)
- (sexps-by-package package))
- ((package (? string? output))
- (sexps-by-package package output))
- ((? manifest-entry? entry)
- (list (obsolete-output-sexp entry)))
- ((package entry)
- (sexps-by-manifest-entry entry (list package)))
- ((name version output)
- (let ((packages (packages-by-name name version output)))
- (if (null? packages)
- (let ((entries (manifest-entries-by-name
- manifest name version output)))
- (append-map (cut sexps-by-manifest-entry <>)
- entries))
- (append-map (cut sexps-by-package <> output)
- packages))))
- (_ '())))
-
- ->sexps)
-
-(define (entry-type-error entry-type)
- (error (format #f "Wrong entry-type '~a'" entry-type)))
-
-(define (search-type-error entry-type search-type)
- (error (format #f "Wrong search type '~a' for entry-type '~a'"
- search-type entry-type)))
-
-(define %pattern-transformers
- `((package . ,package-pattern-transformer)
- (output . ,output-pattern-transformer)))
-
-(define (pattern-transformer entry-type)
- (assq-ref %pattern-transformers entry-type))
-
-;; All procedures from inner alists are called with (MANIFEST . SEARCH-VALS)
-;; as arguments; see `package/output-sexps'.
-(define %patterns-makers
- (let* ((apply-to-rest (lambda (proc)
- (lambda (_ . rest) (apply proc rest))))
- (apply-to-first (lambda (proc)
- (lambda (first . _) (proc first))))
- (manifest-package-proc (apply-to-first manifest-package-patterns))
- (manifest-output-proc (apply-to-first manifest-output-patterns))
- (regexp-proc (lambda (_ regexp params . __)
- (packages-by-regexp regexp params)))
- (license-proc (lambda (_ license-name)
- (packages-by-license
- (lookup-license license-name))))
- (location-proc (lambda (_ location)
- (packages-by-location-file location)))
- (file-proc (lambda (_ file)
- (packages-from-file file)))
- (all-proc (lambda _ (all-available-packages)))
- (newest-proc (lambda _ (newest-available-packages))))
- `((package
- (id . ,(apply-to-rest ids->package-patterns))
- (name . ,(apply-to-rest specifications->package-patterns))
- (installed . ,manifest-package-proc)
- (obsolete . ,(apply-to-first obsolete-package-patterns))
- (regexp . ,regexp-proc)
- (license . ,license-proc)
- (location . ,location-proc)
- (from-file . ,file-proc)
- (all-available . ,all-proc)
- (newest-available . ,newest-proc))
- (output
- (id . ,(apply-to-rest ids->output-patterns))
- (name . ,(apply-to-rest specifications->output-patterns))
- (installed . ,manifest-output-proc)
- (obsolete . ,(apply-to-first obsolete-output-patterns))
- (regexp . ,regexp-proc)
- (license . ,license-proc)
- (location . ,location-proc)
- (from-file . ,file-proc)
- (all-available . ,all-proc)
- (newest-available . ,newest-proc)))))
-
-(define (patterns-maker entry-type search-type)
- (or (and=> (assq-ref %patterns-makers entry-type)
- (cut assq-ref <> search-type))
- (search-type-error entry-type search-type)))
-
-(define (package/output-sexps profile params entry-type
- search-type search-vals)
- "Return information about packages or package outputs.
-See 'entry-sexps' for details."
- (let* ((manifest (profile-manifest profile))
- (patterns (if (and (eq? entry-type 'output)
- (eq? search-type 'profile-diff))
- (match search-vals
- ((p1 p2)
- (map specification->output-pattern
- (profile-difference p1 p2)))
- (_ '()))
- (apply (patterns-maker entry-type search-type)
- manifest search-vals)))
- (->sexps ((pattern-transformer entry-type) manifest params)))
- (append-map ->sexps patterns)))
-
-
-;;; Getting information about generations.
-
-(define (generation-param-alist profile)
- "Return an alist of generation parameters and procedures for PROFILE."
- (let ((current (generation-number profile)))
- `((id . ,identity)
- (number . ,identity)
- (prev-number . ,(cut previous-generation-number profile <>))
- (current . ,(cut = current <>))
- (path . ,(cut generation-file-name profile <>))
- (time . ,(lambda (gen)
- (time-second (generation-time profile gen)))))))
-
-(define (matching-generations profile predicate)
- "Return a list of PROFILE generations matching PREDICATE."
- (filter predicate (profile-generations profile)))
-
-(define (last-generations profile number)
- "Return a list of last NUMBER generations.
-If NUMBER is 0 or less, return all generations."
- (let ((generations (profile-generations profile))
- (number (if (<= number 0) +inf.0 number)))
- (if (> (length generations) number)
- (list-head (reverse generations) number)
- generations)))
-
-(define (find-generations profile search-type search-vals)
- "Find PROFILE's generations matching SEARCH-TYPE and SEARCH-VALS."
- (case search-type
- ((id)
- (matching-generations profile (cut memq <> search-vals)))
- ((last)
- (last-generations profile (car search-vals)))
- ((all)
- (last-generations profile +inf.0))
- ((time)
- (match search-vals
- ((from to)
- (matching-generations
- profile
- (lambda (gen)
- (let ((time (time-second (generation-time profile gen))))
- (< from time to)))))
- (_ '())))
- (else (search-type-error "generation" search-type))))
-
-(define (generation-sexps profile params search-type search-vals)
- "Return information about generations.
-See 'entry-sexps' for details."
- (let ((generations (find-generations profile search-type search-vals))
- (->sexp (object-transformer (generation-param-alist profile)
- params)))
- (map ->sexp generations)))
-
-(define system-generation-boot-parameters
- (memoize
- (lambda (profile generation)
- "Return boot parameters for PROFILE's system GENERATION."
- (let* ((gen-file (generation-file-name profile generation))
- (param-file (string-append gen-file "/parameters")))
- (call-with-input-file param-file read-boot-parameters)))))
-
-(define (system-generation-param-alist profile)
- "Return an alist of system generation parameters and procedures for
-PROFILE."
- (append (generation-param-alist profile)
- `((label . ,(lambda (gen)
- (boot-parameters-label
- (system-generation-boot-parameters
- profile gen))))
- (root-device . ,(lambda (gen)
- (boot-parameters-root-device
- (system-generation-boot-parameters
- profile gen))))
- (kernel . ,(lambda (gen)
- (boot-parameters-kernel
- (system-generation-boot-parameters
- profile gen)))))))
-
-(define (system-generation-sexps profile params search-type search-vals)
- "Return an alist with information about system generations."
- (let ((generations (find-generations profile search-type search-vals))
- (->sexp (object-transformer (system-generation-param-alist profile)
- params)))
- (map ->sexp generations)))
-
-
-;;; Getting package/output/generation entries (alists).
-
-(define (entries profile params entry-type search-type search-vals)
- "Return information about entries.
-
-ENTRY-TYPE is a symbol defining a type of returning information. Should
-be: 'package', 'output' or 'generation'.
-
-SEARCH-TYPE and SEARCH-VALS define how to get the information.
-SEARCH-TYPE should be one of the following symbols:
-
-- If ENTRY-TYPE is 'package' or 'output':
- 'id', 'name', 'regexp', 'all-available', 'newest-available',
- 'installed', 'obsolete', 'generation'.
-
-- If ENTRY-TYPE is 'generation':
- 'id', 'last', 'all', 'time'.
-
-PARAMS is a list of parameters for receiving. If it is an empty list,
-get information with all available parameters, which are:
-
-- If ENTRY-TYPE is 'package':
- 'id', 'name', 'version', 'outputs', 'license', 'synopsis',
- 'description', 'home-url', 'inputs', 'native-inputs',
- 'propagated-inputs', 'location', 'installed'.
-
-- If ENTRY-TYPE is 'output':
- 'id', 'package-id', 'name', 'version', 'output', 'license',
- 'synopsis', 'description', 'home-url', 'inputs', 'native-inputs',
- 'propagated-inputs', 'location', 'installed', 'path', 'dependencies'.
-
-- If ENTRY-TYPE is 'generation':
- 'id', 'number', 'prev-number', 'path', 'time'.
-
-Returning value is a list of alists. Each alist consists of
-parameter/value pairs."
- (case entry-type
- ((package output)
- (package/output-sexps profile params entry-type
- search-type search-vals))
- ((generation)
- (generation-sexps profile params
- search-type search-vals))
- ((system-generation)
- (system-generation-sexps profile params
- search-type search-vals))
- (else (entry-type-error entry-type))))
-
-
-;;; Package actions.
-
-(define* (package->manifest-entry* package #:optional output)
- (and package
- (package->manifest-entry package output)))
-
-(define* (make-install-manifest-entries id #:optional output)
- (package->manifest-entry* (package-by-id id) output))
-
-(define* (make-upgrade-manifest-entries id #:optional output)
- (package->manifest-entry* (newest-package-by-id id) output))
-
-(define* (make-manifest-pattern id #:optional output)
- "Make manifest pattern from a package ID and OUTPUT."
- (let-values (((name version)
- (id->name+version id)))
- (and name version
- (manifest-pattern
- (name name)
- (version version)
- (output output)))))
-
-(define (convert-action-pattern pattern proc)
- "Convert action PATTERN into a list of objects returned by PROC.
-PROC is called: (PROC ID) or (PROC ID OUTPUT)."
- (match pattern
- ((id . outputs)
- (if (null? outputs)
- (let ((obj (proc id)))
- (if obj (list obj) '()))
- (filter-map (cut proc id <>)
- outputs)))
- (_ '())))
-
-(define (convert-action-patterns patterns proc)
- (append-map (cut convert-action-pattern <> proc)
- patterns))
-
-(define* (process-package-actions
- profile #:key (install '()) (upgrade '()) (remove '())
- (use-substitutes? #t) dry-run?)
- "Perform package actions.
-
-INSTALL, UPGRADE, REMOVE are lists of 'package action patterns'.
-Each pattern should have the following form:
-
- (ID . OUTPUTS)
-
-ID is an object address or a full-name of a package.
-OUTPUTS is a list of package outputs (may be an empty list)."
- (format #t "The process begins ...~%")
- (let* ((install (append
- (convert-action-patterns
- install make-install-manifest-entries)
- (convert-action-patterns
- upgrade make-upgrade-manifest-entries)))
- (remove (convert-action-patterns remove make-manifest-pattern))
- (transaction (manifest-transaction (install install)
- (remove remove)))
- (manifest (profile-manifest profile))
- (new-manifest (manifest-perform-transaction
- manifest transaction)))
- (unless (and (null? install) (null? remove))
- (parameterize ((%graft? (not dry-run?)))
- (with-store store
- (set-build-options store
- #:print-build-trace #f
- #:use-substitutes? use-substitutes?)
- (show-manifest-transaction store manifest transaction
- #:dry-run? dry-run?)
- (build-and-use-profile store profile new-manifest
- #:use-substitutes? use-substitutes?
- #:dry-run? dry-run?))))))
-
-(define (delete-generations* profile generations)
- "Delete GENERATIONS from PROFILE.
-GENERATIONS is a list of generation numbers."
- (with-store store
- (delete-generations store profile generations)))
-
-(define (package-location-string id-or-name)
- "Return a location string of a package with ID-OR-NAME."
- (and=> (or (package-by-id id-or-name)
- (match (packages-by-name id-or-name)
- (() #f)
- ((package _ ...) package)))
- (compose location->string package-location)))
-
-(define (package-store-path package-id)
- "Return a list of store directories of outputs of package PACKAGE-ID."
- (match (package-by-id package-id)
- (#f '())
- (package
- (with-store store
- (map (match-lambda
- ((_ . drv)
- (derivation-output-path drv)))
- (derivation-outputs (package-derivation store package)))))))
-
-(define (package-source-derivation->store-path derivation)
- "Return a store path of the package source DERIVATION."
- (match (derivation-outputs derivation)
- ;; Source derivation is always (("out" . derivation)).
- (((_ . output-drv))
- (derivation-output-path output-drv))
- (_ #f)))
-
-(define (package-source-path package-id)
- "Return a store file path to a source of a package PACKAGE-ID."
- (and-let* ((package (package-by-id package-id))
- (source (package-source package)))
- (with-store store
- (package-source-derivation->store-path
- (package-source-derivation store source)))))
-
-(define* (package-source-build-derivation package-id #:key dry-run?
- (use-substitutes? #t))
- "Build source derivation of a package PACKAGE-ID."
- (and-let* ((package (package-by-id package-id))
- (source (package-source package)))
- (with-store store
- (let* ((derivation (package-source-derivation store source))
- (derivations (list derivation)))
- (set-build-options store
- #:print-build-trace #f
- #:use-substitutes? use-substitutes?)
- (show-what-to-build store derivations
- #:use-substitutes? use-substitutes?
- #:dry-run? dry-run?)
- (unless dry-run?
- (build-derivations store derivations))
- (format #t "The source store path: ~a~%"
- (package-source-derivation->store-path derivation))))))
-
-(define (package-build-log-file package-id)
- "Return the build log file of a package PACKAGE-ID.
-Return #f if the build log is not found."
- (and-let* ((package (package-by-id package-id)))
- (with-store store
- (let* ((derivation (package-derivation store package))
- (file (derivation-file-name derivation)))
- (or (log-file store file)
- ((@@ (guix scripts build) log-url) store file))))))
-
-
-;;; Executing guix commands
-
-(define (guix-command . args)
- "Run 'guix ARGS ...' command."
- (catch 'quit
- (lambda () (apply run-guix args))
- (const #t)))
-
-(define (guix-command-output . args)
- "Return 2 strings with 'guix ARGS ...' output and error output."
- (output+error
- (lambda ()
- (parameterize ((guix-warning-port (current-error-port)))
- (apply guix-command args)))))
-
-(define (help-string . commands)
- "Return string with 'guix COMMANDS ... --help' output."
- (apply guix-command-output `(,@commands "--help")))
-
-(define (pipe-guix-output guix-args command-args)
- "Run 'guix GUIX-ARGS ...' command and pipe its output to a shell command
-defined by COMMAND-ARGS.
-Return #t if the shell command was executed successfully."
- (let ((pipe (apply open-pipe* OPEN_WRITE command-args)))
- (with-output-to-port pipe
- (lambda () (apply guix-command guix-args)))
- (zero? (status:exit-val (close-pipe pipe)))))
-
-
-;;; Lists of packages, lint checkers, etc.
-
-(define (graph-type-names)
- "Return a list of names of available graph node types."
- (map (@ (guix graph) node-type-name)
- (@ (guix scripts graph) %node-types)))
-
-(define (refresh-updater-names)
- "Return a list of names of available refresh updater types."
- (map (@ (guix upstream) upstream-updater-name)
- (@ (guix scripts refresh) %updaters)))
-
-(define (lint-checker-names)
- "Return a list of names of available lint checkers."
- (map (lambda (checker)
- (symbol->string ((@ (guix scripts lint) lint-checker-name)
- checker)))
- (@ (guix scripts lint) %checkers)))
-
-(define (package-names)
- "Return a list of names of available packages."
- (delete-duplicates
- (fold-packages (lambda (pkg res)
- (cons (package-name pkg) res))
- '())))
-
-;; See the comment to 'guix-package-names' function in "guix-popup.el".
-(define (package-names-lists)
- (map list (package-names)))
-
-
-;;; Licenses
-
-(define %licenses
- (delay
- (filter license?
- (module-map (lambda (_ var)
- (variable-ref var))
- (resolve-interface '(guix licenses))))))
-
-(define (licenses)
- (force %licenses))
-
-(define (license-names)
- "Return a list of names of available licenses."
- (map license-name (licenses)))
-
-(define lookup-license
- (memoize
- (lambda (name)
- "Return a license by its name."
- (find (lambda (l)
- (string=? name (license-name l)))
- (licenses)))))
-
-(define (lookup-license-uri name)
- "Return a license URI by its name."
- (and=> (lookup-license name)
- license-uri))
-
-(define %license-param-alist
- `((id . ,license-name)
- (name . ,license-name)
- (url . ,license-uri)
- (comment . ,license-comment)))
-
-(define license->sexp
- (object-transformer %license-param-alist))
-
-(define (find-licenses search-type . search-values)
- "Return a list of licenses depending on SEARCH-TYPE and SEARCH-VALUES."
- (case search-type
- ((id name)
- (let ((names search-values))
- (filter-map lookup-license names)))
- ((all)
- (licenses))))
-
-(define (license-entries search-type . search-values)
- (map license->sexp
- (apply find-licenses search-type search-values)))
-
-
-;;; Package locations
-
-(define-values (packages-by-location-file
- package-location-files)
- (let* ((table (delay (fold-packages
- (lambda (package table)
- (let ((file (location-file
- (package-location package))))
- (vhash-cons file package table)))
- vlist-null)))
- (files (delay (vhash-fold
- (lambda (file _ result)
- (if (member file result)
- result
- (cons file result)))
- '()
- (force table)))))
- (values
- (lambda (file)
- "Return the (possibly empty) list of packages defined in location FILE."
- (vhash-fold* cons '() file (force table)))
- (lambda ()
- "Return the list of file names of all package locations."
- (force files)))))
-
-(define %package-location-param-alist
- `((id . ,identity)
- (location . ,identity)
- (number-of-packages . ,(lambda (location)
- (length (packages-by-location-file location))))))
-
-(define package-location->sexp
- (object-transformer %package-location-param-alist))
-
-(define (package-location-entries)
- (map package-location->sexp (package-location-files)))
diff --git a/emacs/guix-messages.el b/emacs/guix-messages.el
deleted file mode 100644
index 52436af9e4..0000000000
--- a/emacs/guix-messages.el
+++ /dev/null
@@ -1,247 +0,0 @@
-;;; guix-messages.el --- Minibuffer messages
-
-;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides `guix-result-message' function used to show a
-;; minibuffer message after displaying packages/generations in a
-;; list/info buffer.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'guix-utils)
-
-(defvar guix-messages
- `((package
- (id
- ,(lambda (_ entries ids)
- (guix-message-packages-by-id entries 'package ids)))
- (name
- ,(lambda (_ entries names)
- (guix-message-packages-by-name entries 'package names)))
- (license
- ,(lambda (_ entries licenses)
- (apply #'guix-message-packages-by-license
- entries 'package licenses)))
- (location
- ,(lambda (_ entries locations)
- (apply #'guix-message-packages-by-location
- entries 'package locations)))
- (from-file
- (0 "No package in file '%s'." val)
- (1 "Package from file '%s'." 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)
- (guix-message-packages-by-id entries 'output ids)))
- (name
- ,(lambda (_ entries names)
- (guix-message-packages-by-name entries 'output names)))
- (license
- ,(lambda (_ entries licenses)
- (apply #'guix-message-packages-by-license
- entries 'output licenses)))
- (location
- ,(lambda (_ entries locations)
- (apply #'guix-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))
- (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
- guix-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
- guix-message-generations-by-time))))
-
-(defun guix-message-string-name (name)
- "Return a quoted name string."
- (concat "'" name "'"))
-
-(defun guix-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 guix-message-string-entries (count entry-type)
- "Return a string denoting the COUNT of ENTRY-TYPE entries."
- (cl-case count
- (0 (concat "No "
- (guix-message-string-entry-type
- entry-type 'plural)))
- (1 (concat "A single "
- (guix-message-string-entry-type
- entry-type)))
- (t (format "%d %s"
- count
- (guix-message-string-entry-type
- entry-type 'plural)))))
-
-(defun guix-message-packages-by-id (entries entry-type ids)
- "Display a message for packages or outputs searched by IDS."
- (let* ((count (length entries))
- (str-beg (guix-message-string-entries count entry-type))
- (str-end (if (> count 1)
- (concat "with the following IDs: "
- (mapconcat #'guix-get-string ids ", "))
- (concat "with ID " (guix-get-string (car ids))))))
- (if (zerop count)
- (message "%s %s.
-Most likely, Guix REPL was restarted, so IDs are not actual
-anymore, because they live only during the REPL process.
-Try \"M-x guix-search-by-name\"."
- str-beg str-end)
- (message "%s %s." str-beg str-end))))
-
-(defun guix-message-packages-by-name (entries entry-type names)
- "Display a message for packages or outputs searched by NAMES."
- (let* ((count (length entries))
- (str-beg (guix-message-string-entries count entry-type))
- (str-end (if (cdr names)
- (concat "matching the following names: "
- (mapconcat #'guix-message-string-name
- names ", "))
- (concat "with name "
- (guix-message-string-name (car names))))))
- (message "%s %s." str-beg str-end)))
-
-(defun guix-message-packages-by-license (entries entry-type license)
- "Display a message for packages or outputs searched by LICENSE."
- (let* ((count (length entries))
- (str-beg (guix-message-string-entries count entry-type))
- (str-end (format "with license '%s'" license)))
- (message "%s %s." str-beg str-end)))
-
-(defun guix-message-packages-by-location (entries entry-type location)
- "Display a message for packages or outputs searched by LOCATION."
- (let* ((count (length entries))
- (str-beg (guix-message-string-entries count entry-type))
- (str-end (format "placed in '%s'" location)))
- (message "%s %s." str-beg str-end)))
-
-(defun guix-message-generations-by-time (profile entries times)
- "Display a message for generations searched by TIMES."
- (let* ((count (length entries))
- (str-beg (guix-message-string-entries count 'generation))
- (time-beg (guix-get-time-string (car times)))
- (time-end (guix-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 guix-message-outputs-by-diff (_ entries profiles)
- "Display a message for outputs searched by PROFILES difference."
- (let* ((count (length entries))
- (str-beg (guix-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 guix-result-message (profile entries entry-type
- search-type search-vals)
- "Display an appropriate message after displaying ENTRIES."
- (let* ((type-spec (guix-assq-value guix-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 (guix-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 'guix-messages)
-
-;;; guix-messages.el ends here
diff --git a/emacs/guix-pcomplete.el b/emacs/guix-pcomplete.el
deleted file mode 100644
index 785e54ef6d..0000000000
--- a/emacs/guix-pcomplete.el
+++ /dev/null
@@ -1,370 +0,0 @@
-;;; guix-pcomplete.el --- Functions for completing guix commands -*- lexical-binding: t -*-
-
-;; Copyright © 2015 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides completions for "guix" command that may be used in
-;; `shell', `eshell' and wherever `pcomplete' works.
-
-;;; Code:
-
-(require 'pcomplete)
-(require 'pcmpl-unix)
-(require 'cl-lib)
-(require 'guix-utils)
-(require 'guix-help-vars)
-
-
-;;; Interacting with guix
-
-(defcustom guix-pcomplete-guix-program (executable-find "guix")
- "Name of the 'guix' program.
-It is used to find guix commands, options, packages, etc."
- :type 'file
- :group 'pcomplete
- :group 'guix)
-
-(defun guix-pcomplete-run-guix (&rest args)
- "Run `guix-pcomplete-guix-program' with ARGS.
-Insert the output to the current buffer."
- (apply #'call-process
- guix-pcomplete-guix-program nil t nil args))
-
-(defun guix-pcomplete-run-guix-and-search (regexp &optional group
- &rest args)
- "Run `guix-pcomplete-guix-program' with ARGS and search for matches.
-Return a list of strings matching REGEXP.
-GROUP specifies a parenthesized expression used in REGEXP."
- (with-temp-buffer
- (apply #'guix-pcomplete-run-guix args)
- (let (result)
- (guix-while-search regexp
- (push (match-string-no-properties group) result))
- (nreverse result))))
-
-(defmacro guix-pcomplete-define-options-finder (name docstring regexp
- &optional filter)
- "Define function NAME to receive guix options and commands.
-
-The defined function takes an optional COMMAND argument. This
-function will run 'guix COMMAND --help' (or 'guix --help' if
-COMMAND is nil) using `guix-pcomplete-run-guix-and-search' and
-return its result.
-
-If FILTER is specified, it should be a function. The result is
-passed to this FILTER as argument and the result value of this
-function call is returned."
- (declare (doc-string 2) (indent 1))
- `(guix-memoized-defun ,name (&optional command)
- ,docstring
- (let* ((args '("--help"))
- (args (if command (cons command args) args))
- (res (apply #'guix-pcomplete-run-guix-and-search
- ,regexp guix-help-parse-regexp-group args)))
- ,(if filter
- `(funcall ,filter res)
- 'res))))
-
-(guix-pcomplete-define-options-finder guix-pcomplete-commands
- "If COMMAND is nil, return a list of available guix commands.
-If COMMAND is non-nil (it should be a string), return available
-subcommands, actions, etc. for this guix COMMAND."
- guix-help-parse-command-regexp)
-
-(guix-pcomplete-define-options-finder guix-pcomplete-long-options
- "Return a list of available long options for guix COMMAND."
- guix-help-parse-long-option-regexp)
-
-(guix-pcomplete-define-options-finder guix-pcomplete-short-options
- "Return a string with available short options for guix COMMAND."
- guix-help-parse-short-option-regexp
- (lambda (list)
- (guix-concat-strings list "")))
-
-(guix-memoized-defun guix-pcomplete-all-packages ()
- "Return a list of all available Guix packages."
- (guix-pcomplete-run-guix-and-search
- guix-help-parse-package-regexp
- guix-help-parse-regexp-group
- "package" "--list-available"))
-
-(guix-memoized-defun guix-pcomplete-installed-packages (&optional profile)
- "Return a list of Guix packages installed in PROFILE."
- (let* ((args (and profile
- (list (concat "--profile=" profile))))
- (args (append '("package" "--list-installed") args)))
- (apply #'guix-pcomplete-run-guix-and-search
- guix-help-parse-package-regexp
- guix-help-parse-regexp-group
- args)))
-
-(guix-memoized-defun guix-pcomplete-lint-checkers ()
- "Return a list of all available lint checkers."
- (guix-pcomplete-run-guix-and-search
- guix-help-parse-list-regexp
- guix-help-parse-regexp-group
- "lint" "--list-checkers"))
-
-(guix-memoized-defun guix-pcomplete-graph-types ()
- "Return a list of all available graph types."
- (guix-pcomplete-run-guix-and-search
- guix-help-parse-list-regexp
- guix-help-parse-regexp-group
- "graph" "--list-types"))
-
-(guix-memoized-defun guix-pcomplete-refresh-updaters ()
- "Return a list of all available refresh updater types."
- (guix-pcomplete-run-guix-and-search
- guix-help-parse-list-regexp
- guix-help-parse-regexp-group
- "refresh" "--list-updaters"))
-
-
-;;; Completing
-
-(defvar guix-pcomplete-option-regexp (rx string-start "-")
- "Regexp to match an option.")
-
-(defvar guix-pcomplete-long-option-regexp (rx string-start "--")
- "Regexp to match a long option.")
-
-(defvar guix-pcomplete-long-option-with-arg-regexp
- (rx string-start
- (group "--" (one-or-more any)) "="
- (group (zero-or-more any)))
- "Regexp to match a long option with its argument.
-The first parenthesized group defines the option and the second
-group - the argument.")
-
-(defvar guix-pcomplete-short-option-with-arg-regexp
- (rx string-start
- (group "-" (not (any "-")))
- (group (zero-or-more any)))
- "Regexp to match a short option with its argument.
-The first parenthesized group defines the option and the second
-group - the argument.")
-
-(defun guix-pcomplete-match-option ()
- "Return non-nil, if the current argument is an option."
- (pcomplete-match guix-pcomplete-option-regexp 0))
-
-(defun guix-pcomplete-match-long-option ()
- "Return non-nil, if the current argument is a long option."
- (pcomplete-match guix-pcomplete-long-option-regexp 0))
-
-(defun guix-pcomplete-match-long-option-with-arg ()
- "Return non-nil, if the current argument is a long option with value."
- (pcomplete-match guix-pcomplete-long-option-with-arg-regexp 0))
-
-(defun guix-pcomplete-match-short-option-with-arg ()
- "Return non-nil, if the current argument is a short option with value."
- (pcomplete-match guix-pcomplete-short-option-with-arg-regexp 0))
-
-(defun guix-pcomplete-long-option-arg (option args)
- "Return a long OPTION's argument from a list of arguments ARGS."
- (let* ((re (concat "\\`" option "=\\(.*\\)"))
- (args (cl-member-if (lambda (arg)
- (string-match re arg))
- args))
- (cur (car args)))
- (when cur
- (match-string-no-properties 1 cur))))
-
-(defun guix-pcomplete-short-option-arg (option args)
- "Return a short OPTION's argument from a list of arguments ARGS."
- (let* ((re (concat "\\`" option "\\(.*\\)"))
- (args (cl-member-if (lambda (arg)
- (string-match re arg))
- args))
- (cur (car args)))
- (when cur
- (let ((arg (match-string-no-properties 1 cur)))
- (if (string= "" arg)
- (cadr args) ; take the next arg
- arg)))))
-
-(defun guix-pcomplete-complete-comma-args (entries)
- "Complete comma separated arguments using ENTRIES."
- (let ((index pcomplete-index))
- (while (= index pcomplete-index)
- (let* ((args (if (or (guix-pcomplete-match-long-option-with-arg)
- (guix-pcomplete-match-short-option-with-arg))
- (pcomplete-match-string 2 0)
- (pcomplete-arg 0)))
- (input (if (string-match ".*,\\(.*\\)" args)
- (match-string-no-properties 1 args)
- args)))
- (pcomplete-here* entries input)))))
-
-(defun guix-pcomplete-complete-command-arg (command)
- "Complete argument for guix COMMAND."
- (cond
- ((member command
- '("archive" "build" "challenge" "edit" "environment"
- "graph" "lint" "refresh" "size"))
- (while t
- (pcomplete-here (guix-pcomplete-all-packages))))
- (t (pcomplete-here* (pcomplete-entries)))))
-
-(defun guix-pcomplete-complete-option-arg (command option &optional input)
- "Complete argument for COMMAND's OPTION.
-INPUT is the current partially completed string."
- (cl-flet ((option? (short long)
- (or (string= option short)
- (string= option long)))
- (command? (&rest commands)
- (member command commands))
- (complete (entries)
- (pcomplete-here entries input nil t))
- (complete* (entries)
- (pcomplete-here* entries input t)))
- (cond
- ((option? "-L" "--load-path")
- (complete* (pcomplete-dirs)))
- ((string= "--key-download" option)
- (complete* guix-help-key-policies))
-
- ((command? "package")
- (cond
- ;; For '--install[=]' and '--remove[=]', try to complete a package
- ;; name (INPUT) after the "=" sign, and then the rest packages
- ;; separated with spaces.
- ((option? "-i" "--install")
- (complete (guix-pcomplete-all-packages))
- (while (not (guix-pcomplete-match-option))
- (pcomplete-here (guix-pcomplete-all-packages))))
- ((option? "-r" "--remove")
- (let* ((profile (or (guix-pcomplete-short-option-arg
- "-p" pcomplete-args)
- (guix-pcomplete-long-option-arg
- "--profile" pcomplete-args)))
- (profile (and profile (expand-file-name profile))))
- (complete (guix-pcomplete-installed-packages profile))
- (while (not (guix-pcomplete-match-option))
- (pcomplete-here (guix-pcomplete-installed-packages profile)))))
- ((string= "--show" option)
- (complete (guix-pcomplete-all-packages)))
- ((option? "-p" "--profile")
- (complete* (pcomplete-dirs)))
- ((or (option? "-f" "--install-from-file")
- (option? "-m" "--manifest"))
- (complete* (pcomplete-entries)))))
-
- ((and (command? "archive" "build" "size")
- (option? "-s" "--system"))
- (complete* guix-help-system-types))
-
- ((and (command? "build")
- (or (option? "-f" "--file")
- (option? "-r" "--root")
- (string= "--with-source" option)))
- (complete* (pcomplete-entries)))
-
- ((and (command? "graph")
- (option? "-t" "--type"))
- (complete* (guix-pcomplete-graph-types)))
-
- ((and (command? "environment")
- (option? "-l" "--load"))
- (complete* (pcomplete-entries)))
-
- ((and (command? "hash" "download")
- (option? "-f" "--format"))
- (complete* guix-help-hash-formats))
-
- ((and (command? "lint")
- (option? "-c" "--checkers"))
- (guix-pcomplete-complete-comma-args
- (guix-pcomplete-lint-checkers)))
-
- ((and (command? "publish")
- (option? "-u" "--user"))
- (complete* (pcmpl-unix-user-names)))
-
- ((command? "refresh")
- (cond
- ((option? "-s" "--select")
- (complete* guix-help-refresh-subsets))
- ((option? "-t" "--type")
- (guix-pcomplete-complete-comma-args
- (guix-pcomplete-refresh-updaters)))))
-
- ((and (command? "size")
- (option? "-m" "--map-file"))
- (complete* (pcomplete-entries))))))
-
-(defun guix-pcomplete-complete-options (command)
- "Complete options (with their arguments) for guix COMMAND."
- (while (guix-pcomplete-match-option)
- (let ((index pcomplete-index))
- (if (guix-pcomplete-match-long-option)
-
- ;; Long options.
- (if (guix-pcomplete-match-long-option-with-arg)
- (let ((option (pcomplete-match-string 1 0))
- (arg (pcomplete-match-string 2 0)))
- (guix-pcomplete-complete-option-arg
- command option arg))
-
- (pcomplete-here* (guix-pcomplete-long-options command))
- ;; We support '--opt arg' style (along with '--opt=arg'),
- ;; because 'guix package --install/--remove' may be used this
- ;; way. So try to complete an argument after the option has
- ;; been completed.
- (unless (guix-pcomplete-match-option)
- (guix-pcomplete-complete-option-arg
- command (pcomplete-arg 0 -1))))
-
- ;; Short options.
- (let ((arg (pcomplete-arg 0)))
- (if (> (length arg) 2)
- ;; Support specifying an argument after a short option without
- ;; spaces (for example, '-L/tmp/foo').
- (guix-pcomplete-complete-option-arg
- command
- (substring-no-properties arg 0 2)
- (substring-no-properties arg 2))
- (pcomplete-opt (guix-pcomplete-short-options command))
- (guix-pcomplete-complete-option-arg
- command (pcomplete-arg 0 -1)))))
-
- ;; If there were no completions, move to the next argument and get
- ;; out if the last argument is achieved.
- (when (= index pcomplete-index)
- (if (= pcomplete-index pcomplete-last)
- (throw 'pcompleted nil)
- (pcomplete-next-arg))))))
-
-;;;###autoload
-(defun pcomplete/guix ()
- "Completion for `guix'."
- (let ((commands (guix-pcomplete-commands)))
- (pcomplete-here* (cons "--help" commands))
- (let ((command (pcomplete-arg 'first 1)))
- (when (member command commands)
- (guix-pcomplete-complete-options command)
- (let ((subcommands (guix-pcomplete-commands command)))
- (when subcommands
- (pcomplete-here* subcommands)))
- (guix-pcomplete-complete-options command)
- (guix-pcomplete-complete-command-arg command)))))
-
-(provide 'guix-pcomplete)
-
-;;; guix-pcomplete.el ends here
diff --git a/emacs/guix-popup.el b/emacs/guix-popup.el
deleted file mode 100644
index 59e98a352e..0000000000
--- a/emacs/guix-popup.el
+++ /dev/null
@@ -1,48 +0,0 @@
-;;; guix-popup.el --- Popup windows library
-
-;; Copyright © 2015 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. 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/emacs/guix-prettify.el b/emacs/guix-prettify.el
deleted file mode 100644
index 38d72e860b..0000000000
--- a/emacs/guix-prettify.el
+++ /dev/null
@@ -1,210 +0,0 @@
-;;; guix-prettify.el --- Prettify Guix store file names
-
-;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This package provides minor-mode for prettifying Guix store file
-;; names — i.e., after enabling `guix-prettify-mode',
-;; '/gnu/store/72f54nfp6g1hz873w8z3gfcah0h4nl9p-foo-0.1' names will be
-;; replaced with '/gnu/store/…-foo-0.1' in the current buffer. There is
-;; also `global-guix-prettify-mode' for global prettifying.
-
-;; To install, add the following to your emacs init file:
-;;
-;; (add-to-list 'load-path "/path/to/dir-with-guix-prettify")
-;; (autoload 'guix-prettify-mode "guix-prettify" nil t)
-;; (autoload 'global-guix-prettify-mode "guix-prettify" nil t)
-
-;; If you want to enable/disable composition after "M-x font-lock-mode",
-;; use the following setting:
-;;
-;; (setq font-lock-extra-managed-props
-;; (cons 'composition font-lock-extra-managed-props))
-
-;; Credits:
-;;
-;; Thanks to Ludovic Courtès for the idea of this package.
-;;
-;; Thanks to the authors of `prettify-symbols-mode' (part of Emacs 24.4)
-;; and "pretty-symbols.el" <http://github.com/drothlis/pretty-symbols>
-;; for the code. It helped to write this package.
-
-;;; Code:
-
-(require 'guix-utils)
-
-(defgroup guix-prettify nil
- "Prettify Guix store file names."
- :prefix "guix-prettify-"
- :group 'guix
- :group 'font-lock
- :group 'convenience)
-
-(defcustom guix-prettify-char ?…
- "Character used for prettifying."
- :type 'character
- :group 'guix-prettify)
-
-(defcustom guix-prettify-decompose-force nil
- "If non-nil, remove any composition.
-
-By default, after disabling `guix-prettify-mode',
-compositions (prettifying names with `guix-prettify-char') are
-removed only from strings matching `guix-prettify-regexp', so
-that compositions created by other modes are left untouched.
-
-Set this variable to non-nil, if you want to remove any
-composition unconditionally (like `prettify-symbols-mode' does).
-Most likely it will do no harm and will make the process of
-disabling `guix-prettify-mode' a little faster."
- :type 'boolean
- :group 'guix-prettify)
-
-(defcustom guix-prettify-regexp
- ;; The following file names / URLs should be abbreviated:
-
- ;; /gnu/store/…-foo-0.1
- ;; /nix/store/…-foo-0.1
- ;; http://hydra.gnu.org/nar/…-foo-0.1
- ;; http://hydra.gnu.org/log/…-foo-0.1
-
- (rx "/" (or "store" "nar" "log") "/"
- ;; Hash-parts do not include "e", "o", "u" and "t". See base32Chars
- ;; at <https://github.com/NixOS/nix/blob/master/src/libutil/hash.cc>
- (group (= 32 (any "0-9" "a-d" "f-n" "p-s" "v-z"))))
- "Regexp matching file names for prettifying.
-
-Disable `guix-prettify-mode' before modifying this variable and
-make sure to modify `guix-prettify-regexp-group' if needed.
-
-Example of a \"deeper\" prettifying:
-
- (setq guix-prettify-regexp \"store/[[:alnum:]]\\\\\\={32\\\\}\"
- guix-prettify-regexp-group 0)
-
-This will transform
-'/gnu/store/72f54nfp6g1hz873w8z3gfcah0h4nl9p-foo-0.1' into
-'/gnu/…-foo-0.1'"
- :type 'regexp
- :group 'guix-prettify)
-
-(defcustom guix-prettify-regexp-group 1
- "Regexp group in `guix-prettify-regexp' for prettifying."
- :type 'integer
- :group 'guix-prettify)
-
-(defvar guix-prettify-special-modes
- '(guix-info-mode ibuffer-mode)
- "List of special modes that support font-locking.
-
-By default, \\[global-guix-prettify-mode] enables prettifying in
-all buffers except the ones where `font-lock-defaults' is
-nil (see Info node `(elisp) Font Lock Basics'), because it may
-break the existing highlighting.
-
-Modes from this list and all derived modes are exceptions
-\(`global-guix-prettify-mode' enables prettifying there).")
-
-(defvar guix-prettify-flush-function
- (cond ((fboundp 'font-lock-flush) #'font-lock-flush)
- ((fboundp 'jit-lock-refontify) #'jit-lock-refontify))
- "Function used to refontify buffer.
-This function is called without arguments after
-enabling/disabling `guix-prettify-mode'. If nil, do nothing.")
-
-(defun guix-prettify-compose ()
- "Compose matching region in the current buffer."
- (let ((beg (match-beginning guix-prettify-regexp-group))
- (end (match-end guix-prettify-regexp-group)))
- (compose-region beg end guix-prettify-char 'decompose-region))
- ;; Return nil because we're not adding any face property.
- nil)
-
-(defun guix-prettify-decompose-buffer ()
- "Remove file names compositions from the current buffer."
- (with-silent-modifications
- (let ((inhibit-read-only t))
- (if guix-prettify-decompose-force
- (remove-text-properties (point-min)
- (point-max)
- '(composition nil))
- (guix-while-search guix-prettify-regexp
- (remove-text-properties
- (match-beginning guix-prettify-regexp-group)
- (match-end guix-prettify-regexp-group)
- '(composition nil)))))))
-
-;;;###autoload
-(define-minor-mode guix-prettify-mode
- "Toggle Guix Prettify mode.
-
-With a prefix argument ARG, enable Guix Prettify mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
-When Guix Prettify mode is enabled, hash-parts of the Guix store
-file names (see `guix-prettify-regexp') are prettified,
-i.e. displayed as `guix-prettify-char' character. This mode can
-be enabled programmatically using hooks:
-
- (add-hook 'shell-mode-hook 'guix-prettify-mode)
-
-It is possible to enable the mode in any buffer, however not any
-buffer's highlighting may survive after adding new elements to
-`font-lock-keywords' (see `guix-prettify-special-modes' for
-details).
-
-Also you can use `global-guix-prettify-mode' to enable Guix
-Prettify mode for all modes that support font-locking."
- :init-value nil
- :lighter " …"
- (let ((keywords `((,guix-prettify-regexp
- (,guix-prettify-regexp-group
- (guix-prettify-compose))))))
- (if guix-prettify-mode
- ;; Turn on.
- (font-lock-add-keywords nil keywords)
- ;; Turn off.
- (font-lock-remove-keywords nil keywords)
- (guix-prettify-decompose-buffer))
- (and guix-prettify-flush-function
- (funcall guix-prettify-flush-function))))
-
-(defun guix-prettify-supported-p ()
- "Return non-nil, if the mode can be harmlessly enabled in current buffer."
- (or font-lock-defaults
- (apply #'derived-mode-p guix-prettify-special-modes)))
-
-(defun guix-prettify-turn-on ()
- "Enable `guix-prettify-mode' in the current buffer if needed.
-See `guix-prettify-special-modes' for details."
- (and (not guix-prettify-mode)
- (guix-prettify-supported-p)
- (guix-prettify-mode)))
-
-;;;###autoload
-(define-globalized-minor-mode global-guix-prettify-mode
- guix-prettify-mode guix-prettify-turn-on)
-
-;;;###autoload
-(defalias 'guix-prettify-global-mode 'global-guix-prettify-mode)
-
-(provide 'guix-prettify)
-
-;;; guix-prettify.el ends here
diff --git a/emacs/guix-profiles.el b/emacs/guix-profiles.el
deleted file mode 100644
index 12cf46dbf8..0000000000
--- a/emacs/guix-profiles.el
+++ /dev/null
@@ -1,77 +0,0 @@
-;;; guix-profiles.el --- Guix profiles
-
-;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
-;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'guix-config)
-
-(defvar guix-user-profile
- (expand-file-name "~/.guix-profile")
- "User profile.")
-
-(defvar guix-system-profile
- (concat guix-config-state-directory "/profiles/system")
- "System profile.")
-
-(defvar guix-default-profile
- (concat guix-config-state-directory
- "/profiles/per-user/"
- (getenv "USER")
- "/guix-profile")
- "Default Guix profile.")
-
-(defvar guix-current-profile guix-default-profile
- "Current profile.")
-
-(defvar guix-system-profile-regexp
- (concat "\\`" (regexp-quote guix-system-profile))
- "Regexp matching system profiles.")
-
-(defun guix-system-profile? (profile)
- "Return non-nil, if PROFILE is a system one."
- (string-match-p guix-system-profile-regexp profile))
-
-(defun guix-profile-prompt (&optional default)
- "Prompt for profile and return it.
-Use DEFAULT as a start directory. If it is nil, use
-`guix-current-profile'."
- (let* ((path (read-file-name "Profile: "
- (file-name-directory
- (or default guix-current-profile))))
- (path (directory-file-name (expand-file-name path))))
- (if (string= path guix-user-profile)
- guix-default-profile
- path)))
-
-(defun guix-set-current-profile (path)
- "Set `guix-current-profile' to PATH.
-Interactively, prompt for PATH. With prefix, use
-`guix-default-profile'."
- (interactive
- (list (if current-prefix-arg
- guix-default-profile
- (guix-profile-prompt))))
- (setq guix-current-profile path)
- (message "Current profile has been set to '%s'."
- guix-current-profile))
-
-(provide 'guix-profiles)
-
-;;; guix-profiles.el ends here
diff --git a/emacs/guix-read.el b/emacs/guix-read.el
deleted file mode 100644
index 5423c9bcfa..0000000000
--- a/emacs/guix-read.el
+++ /dev/null
@@ -1,147 +0,0 @@
-;;; guix-read.el --- Minibuffer readers
-
-;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides functions to prompt a user for packages, system
-;; types, hash formats and other guix related stuff.
-
-;;; Code:
-
-(require 'guix-help-vars)
-(require 'guix-utils)
-(require 'guix-backend)
-(require 'guix-guile)
-
-
-;;; Receivable lists of packages, lint checkers, etc.
-
-(guix-memoized-defun guix-graph-type-names ()
- "Return a list of names of available graph node types."
- (guix-eval-read (guix-make-guile-expression 'graph-type-names)))
-
-(guix-memoized-defun guix-refresh-updater-names ()
- "Return a list of names of available refresh updater types."
- (guix-eval-read (guix-make-guile-expression 'refresh-updater-names)))
-
-(guix-memoized-defun guix-lint-checker-names ()
- "Return a list of names of available lint checkers."
- (guix-eval-read (guix-make-guile-expression 'lint-checker-names)))
-
-(guix-memoized-defun guix-package-names ()
- "Return a list of names of available packages."
- (sort
- ;; Work around <https://github.com/jaor/geiser/issues/64>:
- ;; list of strings is parsed much slower than list of lists,
- ;; so we use 'package-names-lists' instead of 'package-names'.
-
- ;; (guix-eval-read (guix-make-guile-expression 'package-names))
-
- (mapcar #'car
- (guix-eval-read (guix-make-guile-expression
- 'package-names-lists)))
- #'string<))
-
-(guix-memoized-defun guix-license-names ()
- "Return a list of names of available licenses."
- (guix-eval-read (guix-make-guile-expression 'license-names)))
-
-(guix-memoized-defun guix-package-locations ()
- "Return a list of available package locations."
- (sort (guix-eval-read (guix-make-guile-expression
- 'package-location-files))
- #'string<))
-
-
-;;; Readers
-
-(guix-define-readers
- :completions-var guix-help-system-types
- :single-reader guix-read-system-type
- :single-prompt "System type: ")
-
-(guix-define-readers
- :completions-var guix-help-source-types
- :single-reader guix-read-source-type
- :single-prompt "Source type: ")
-
-(guix-define-readers
- :completions-var guix-help-hash-formats
- :single-reader guix-read-hash-format
- :single-prompt "Hash format: ")
-
-(guix-define-readers
- :completions-var guix-help-refresh-subsets
- :single-reader guix-read-refresh-subset
- :single-prompt "Refresh subset: ")
-
-(guix-define-readers
- :completions-getter guix-refresh-updater-names
- :multiple-reader guix-read-refresh-updater-names
- :multiple-prompt "Refresh updater,s: "
- :multiple-separator ",")
-
-(guix-define-readers
- :completions-var guix-help-key-policies
- :single-reader guix-read-key-policy
- :single-prompt "Key policy: ")
-
-(guix-define-readers
- :completions-var guix-help-elpa-archives
- :single-reader guix-read-elpa-archive
- :single-prompt "ELPA archive: ")
-
-(guix-define-readers
- :completions-var guix-help-verify-options
- :multiple-reader guix-read-verify-options
- :multiple-prompt "Verify option,s: "
- :multiple-separator ",")
-
-(guix-define-readers
- :completions-getter guix-graph-type-names
- :single-reader guix-read-graph-type
- :single-prompt "Graph node type: ")
-
-(guix-define-readers
- :completions-getter guix-lint-checker-names
- :multiple-reader guix-read-lint-checker-names
- :multiple-prompt "Linter,s: "
- :multiple-separator ",")
-
-(guix-define-readers
- :completions-getter guix-package-names
- :single-reader guix-read-package-name
- :single-prompt "Package: "
- :multiple-reader guix-read-package-names
- :multiple-prompt "Package,s: "
- :multiple-separator " ")
-
-(guix-define-readers
- :completions-getter guix-license-names
- :single-reader guix-read-license-name
- :single-prompt "License: ")
-
-(guix-define-readers
- :completions-getter guix-package-locations
- :single-reader guix-read-package-location
- :single-prompt "Location: ")
-
-(provide 'guix-read)
-
-;;; guix-read.el ends here
diff --git a/emacs/guix-ui-generation.el b/emacs/guix-ui-generation.el
deleted file mode 100644
index 67cf6294fb..0000000000
--- a/emacs/guix-ui-generation.el
+++ /dev/null
@@ -1,456 +0,0 @@
-;;; guix-ui-generation.el --- Interface for displaying generations -*- lexical-binding: t -*-
-
-;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides an interface for displaying profile generations in
-;; 'list' and 'info' buffers, and commands for working with them.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'guix-buffer)
-(require 'guix-list)
-(require 'guix-info)
-(require 'guix-ui)
-(require 'guix-ui-package)
-(require 'guix-base)
-(require 'guix-backend)
-(require 'guix-guile)
-(require 'guix-entry)
-(require 'guix-utils)
-(require 'guix-profiles)
-
-(guix-ui-define-entry-type generation)
-
-(defun guix-generation-get-display (profile search-type &rest search-values)
- "Search for generations and show results.
-
-If PROFILE is nil, use `guix-current-profile'.
-
-See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and
-SEARCH-VALUES."
- (apply #'guix-list-get-display-entries
- 'generation
- (or profile guix-current-profile)
- search-type search-values))
-
-(defun guix-delete-generations (profile generations
- &optional operation-buffer)
- "Delete GENERATIONS from PROFILE.
-Each element from GENERATIONS is a generation number."
- (when (or (not guix-operation-confirm)
- (y-or-n-p
- (let ((count (length generations)))
- (if (> count 1)
- (format "Delete %d generations from profile '%s'? "
- count profile)
- (format "Delete generation %d from profile '%s'? "
- (car generations) profile)))))
- (guix-eval-in-repl
- (guix-make-guile-expression
- 'delete-generations* profile generations)
- operation-buffer)))
-
-(defun guix-switch-to-generation (profile generation
- &optional operation-buffer)
- "Switch PROFILE to GENERATION."
- (when (or (not guix-operation-confirm)
- (y-or-n-p (format "Switch profile '%s' to generation %d? "
- profile generation)))
- (guix-eval-in-repl
- (guix-make-guile-expression
- 'switch-to-generation* profile generation)
- operation-buffer)))
-
-(defun guix-system-generation? ()
- "Return non-nil, if current generation is a system one."
- (eq (guix-buffer-current-entry-type)
- 'system-generation))
-
-(defun guix-generation-current-packages-profile (&optional generation)
- "Return a directory where packages are installed for the
-current profile's GENERATION."
- (guix-packages-profile (guix-ui-current-profile)
- generation
- (guix-system-generation?)))
-
-
-;;; Generation 'info'
-
-(guix-ui-info-define-interface generation
- :buffer-name "*Guix Generation Info*"
- :format '((number format guix-generation-info-insert-number)
- (prev-number format (format))
- (current format guix-generation-info-insert-current)
- (path simple (indent guix-file))
- (time format (time)))
- :titles '((path . "File name")
- (prev-number . "Previous number")))
-
-(defface guix-generation-info-number
- '((t :inherit font-lock-keyword-face))
- "Face used for a number of a generation."
- :group 'guix-generation-info-faces)
-
-(defface guix-generation-info-current
- '((t :inherit guix-package-info-installed-outputs))
- "Face used if a generation is the current one."
- :group 'guix-generation-info-faces)
-
-(defface guix-generation-info-not-current
- '((t nil))
- "Face used if a generation is not the current one."
- :group 'guix-generation-info-faces)
-
-(defun guix-generation-info-insert-number (number &optional _)
- "Insert generation NUMBER and action buttons."
- (guix-info-insert-value-format number 'guix-generation-info-number)
- (guix-info-insert-indent)
- (guix-info-insert-action-button
- "Packages"
- (lambda (btn)
- (guix-buffer-get-display-entries
- 'list guix-package-list-type
- (list (guix-generation-current-packages-profile
- (button-get btn 'number))
- 'installed)
- 'add))
- "Show installed packages for this generation"
- 'number number)
- (guix-info-insert-indent)
- (guix-info-insert-action-button
- "Delete"
- (lambda (btn)
- (guix-delete-generations (guix-ui-current-profile)
- (list (button-get btn 'number))
- (current-buffer)))
- "Delete this generation"
- 'number number))
-
-(defun guix-generation-info-insert-current (val entry)
- "Insert boolean value VAL showing whether this generation is current."
- (if val
- (guix-info-insert-value-format "Yes" 'guix-generation-info-current)
- (guix-info-insert-value-format "No" 'guix-generation-info-not-current)
- (guix-info-insert-indent)
- (guix-info-insert-action-button
- "Switch"
- (lambda (btn)
- (guix-switch-to-generation (guix-ui-current-profile)
- (button-get btn 'number)
- (current-buffer)))
- "Switch to this generation (make it the current one)"
- 'number (guix-entry-value entry 'number))))
-
-
-;;; Generation 'list'
-
-(guix-ui-list-define-interface generation
- :buffer-name "*Guix Generation List*"
- :format '((number nil 5 guix-list-sort-numerically-0 :right-align t)
- (current guix-generation-list-get-current 10 t)
- (time guix-list-get-time 20 t)
- (path guix-list-get-file-name 30 t))
- :titles '((number . "N."))
- :sort-key '(number . t)
- :marks '((delete . ?D)))
-
-(let ((map guix-generation-list-mode-map))
- (define-key map (kbd "RET") 'guix-generation-list-show-packages)
- (define-key map (kbd "+") 'guix-generation-list-show-added-packages)
- (define-key map (kbd "-") 'guix-generation-list-show-removed-packages)
- (define-key map (kbd "=") 'guix-generation-list-diff)
- (define-key map (kbd "D") 'guix-generation-list-diff)
- (define-key map (kbd "e") 'guix-generation-list-ediff)
- (define-key map (kbd "x") 'guix-generation-list-execute)
- (define-key map (kbd "s") 'guix-generation-list-switch)
- (define-key map (kbd "c") 'guix-generation-list-switch)
- (define-key map (kbd "d") 'guix-generation-list-mark-delete))
-
-(defun guix-generation-list-get-current (val &optional _)
- "Return string from VAL showing whether this generation is current.
-VAL is a boolean value."
- (if val "(current)" ""))
-
-(defun guix-generation-list-switch ()
- "Switch current profile to the generation at point."
- (interactive)
- (let* ((entry (guix-list-current-entry))
- (current (guix-entry-value entry 'current))
- (number (guix-entry-value entry 'number)))
- (if current
- (user-error "This generation is already the current one")
- (guix-switch-to-generation (guix-ui-current-profile)
- number (current-buffer)))))
-
-(defun guix-generation-list-show-packages ()
- "List installed packages for the generation at point."
- (interactive)
- (guix-package-get-display
- (guix-generation-current-packages-profile (guix-list-current-id))
- 'installed))
-
-(defun guix-generation-list-generations-to-compare ()
- "Return a sorted list of 2 marked generations for comparing."
- (let ((numbers (guix-list-get-marked-id-list 'general)))
- (if (/= (length numbers) 2)
- (user-error "2 generations should be marked for comparing")
- (sort numbers #'<))))
-
-(defun guix-generation-list-profiles-to-compare ()
- "Return a sorted list of 2 marked generation profiles for comparing."
- (mapcar #'guix-generation-current-packages-profile
- (guix-generation-list-generations-to-compare)))
-
-(defun guix-generation-list-show-added-packages ()
- "List package outputs added to the latest marked generation.
-If 2 generations are marked with \\[guix-list-mark], display
-outputs installed in the latest marked generation that were not
-installed in the other one."
- (interactive)
- (guix-buffer-get-display-entries
- 'list 'output
- (cl-list* (guix-ui-current-profile)
- 'profile-diff
- (reverse (guix-generation-list-profiles-to-compare)))
- 'add))
-
-(defun guix-generation-list-show-removed-packages ()
- "List package outputs removed from the latest marked generation.
-If 2 generations are marked with \\[guix-list-mark], display
-outputs not installed in the latest marked generation that were
-installed in the other one."
- (interactive)
- (guix-buffer-get-display-entries
- 'list 'output
- (cl-list* (guix-ui-current-profile)
- 'profile-diff
- (guix-generation-list-profiles-to-compare))
- 'add))
-
-(defun guix-generation-list-compare (diff-fun gen-fun)
- "Run GEN-FUN on the 2 marked generations and run DIFF-FUN on the results."
- (cl-multiple-value-bind (gen1 gen2)
- (guix-generation-list-generations-to-compare)
- (funcall diff-fun
- (funcall gen-fun gen1)
- (funcall gen-fun gen2))))
-
-(defun guix-generation-list-ediff-manifests ()
- "Run Ediff on manifests of the 2 marked generations."
- (interactive)
- (guix-generation-list-compare
- #'ediff-files
- #'guix-profile-generation-manifest-file))
-
-(defun guix-generation-list-diff-manifests ()
- "Run Diff on manifests of the 2 marked generations."
- (interactive)
- (guix-generation-list-compare
- #'guix-diff
- #'guix-profile-generation-manifest-file))
-
-(defun guix-generation-list-ediff-packages ()
- "Run Ediff on package outputs installed in the 2 marked generations."
- (interactive)
- (guix-generation-list-compare
- #'ediff-buffers
- #'guix-profile-generation-packages-buffer))
-
-(defun guix-generation-list-diff-packages ()
- "Run Diff on package outputs installed in the 2 marked generations."
- (interactive)
- (guix-generation-list-compare
- #'guix-diff
- #'guix-profile-generation-packages-buffer))
-
-(defun guix-generation-list-ediff (arg)
- "Run Ediff on package outputs installed in the 2 marked generations.
-With ARG, run Ediff on manifests of the marked generations."
- (interactive "P")
- (if arg
- (guix-generation-list-ediff-manifests)
- (guix-generation-list-ediff-packages)))
-
-(defun guix-generation-list-diff (arg)
- "Run Diff on package outputs installed in the 2 marked generations.
-With ARG, run Diff on manifests of the marked generations."
- (interactive "P")
- (if arg
- (guix-generation-list-diff-manifests)
- (guix-generation-list-diff-packages)))
-
-(defun guix-generation-list-mark-delete (&optional arg)
- "Mark the current generation for deletion and move to the next line.
-With ARG, mark all generations for deletion."
- (interactive "P")
- (if arg
- (guix-list-mark-all 'delete)
- (guix-list--mark 'delete t)))
-
-(defun guix-generation-list-execute ()
- "Delete marked generations."
- (interactive)
- (let ((marked (guix-list-get-marked-id-list 'delete)))
- (or marked
- (user-error "No generations marked for deletion"))
- (guix-delete-generations (guix-ui-current-profile)
- marked (current-buffer))))
-
-
-;;; Inserting packages to compare generations
-
-(defcustom guix-generation-packages-buffer-name-function
- #'guix-generation-packages-buffer-name-default
- "Function used to define name of a buffer with generation packages.
-This function is called with 2 arguments: PROFILE (string) and
-GENERATION (number)."
- :type '(choice (function-item guix-generation-packages-buffer-name-default)
- (function-item guix-generation-packages-buffer-name-long)
- (function :tag "Other function"))
- :group 'guix-generation)
-
-(defcustom guix-generation-packages-update-buffer t
- "If non-nil, always update list of packages during comparing generations.
-If nil, generation packages are received only once. So when you
-compare generation 1 and generation 2, the packages for both
-generations will be received. Then if you compare generation 1
-and generation 3, only the packages for generation 3 will be
-received. Thus if you use comparing of different generations a
-lot, you may set this variable to nil to improve the
-performance."
- :type 'boolean
- :group 'guix-generation)
-
-(defvar guix-generation-output-name-width 30
- "Width of an output name \"column\".
-This variable is used in auxiliary buffers for comparing generations.")
-
-(defun guix-generation-packages (profile)
- "Return a list of sorted packages installed in PROFILE.
-Each element of the list is a list of the package specification
-and its store path."
- (let ((names+paths (guix-eval-read
- (guix-make-guile-expression
- 'profile->specifications+paths profile))))
- (sort names+paths
- (lambda (a b)
- (string< (car a) (car b))))))
-
-(defun guix-generation-packages-buffer-name-default (profile generation)
- "Return name of a buffer for displaying GENERATION's package outputs.
-Use base name of PROFILE file name."
- (let ((profile-name (file-name-base (directory-file-name profile))))
- (format "*Guix %s: generation %s*"
- profile-name generation)))
-
-(defun guix-generation-packages-buffer-name-long (profile generation)
- "Return name of a buffer for displaying GENERATION's package outputs.
-Use the full PROFILE file name."
- (format "*Guix generation %s (%s)*"
- generation profile))
-
-(defun guix-generation-packages-buffer-name (profile generation)
- "Return name of a buffer for displaying GENERATION's package outputs."
- (funcall guix-generation-packages-buffer-name-function
- profile generation))
-
-(defun guix-generation-insert-package (name path)
- "Insert package output NAME and store PATH at point."
- (insert name)
- (indent-to guix-generation-output-name-width 2)
- (insert path "\n"))
-
-(defun guix-generation-insert-packages (buffer profile)
- "Insert package outputs installed in PROFILE in BUFFER."
- (with-current-buffer buffer
- (setq buffer-read-only nil
- indent-tabs-mode nil)
- (erase-buffer)
- (mapc (lambda (name+path)
- (guix-generation-insert-package
- (car name+path) (cadr name+path)))
- (guix-generation-packages profile))))
-
-(defun guix-generation-packages-buffer (profile generation &optional system?)
- "Return buffer with package outputs installed in PROFILE's GENERATION.
-Create the buffer if needed."
- (let ((buf-name (guix-generation-packages-buffer-name
- profile generation)))
- (or (and (null guix-generation-packages-update-buffer)
- (get-buffer buf-name))
- (let ((buf (get-buffer-create buf-name)))
- (guix-generation-insert-packages
- buf
- (guix-packages-profile profile generation system?))
- buf))))
-
-(defun guix-profile-generation-manifest-file (generation)
- "Return the file name of a GENERATION's manifest.
-GENERATION is a generation number of the current profile."
- (guix-manifest-file (guix-ui-current-profile)
- generation
- (guix-system-generation?)))
-
-(defun guix-profile-generation-packages-buffer (generation)
- "Insert GENERATION's package outputs in a buffer and return it.
-GENERATION is a generation number of the current profile."
- (guix-generation-packages-buffer (guix-ui-current-profile)
- generation
- (guix-system-generation?)))
-
-
-;;; Interactive commands
-
-;;;###autoload
-(defun guix-generations (&optional profile)
- "Display information about all generations.
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive (list (guix-ui-read-profile)))
- (guix-generation-get-display profile 'all))
-
-;;;###autoload
-(defun guix-last-generations (number &optional profile)
- "Display information about last NUMBER generations.
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive
- (list (read-number "The number of last generations: ")
- (guix-ui-read-profile)))
- (guix-generation-get-display profile 'last number))
-
-;;;###autoload
-(defun guix-generations-by-time (from to &optional profile)
- "Display information about generations created between FROM and TO.
-FROM and TO should be time values.
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive
- (list (guix-read-date "Find generations (from): ")
- (guix-read-date "Find generations (to): ")
- (guix-ui-read-profile)))
- (guix-generation-get-display profile 'time
- (float-time from)
- (float-time to)))
-
-(provide 'guix-ui-generation)
-
-;;; guix-ui-generation.el ends here
diff --git a/emacs/guix-ui-license.el b/emacs/guix-ui-license.el
deleted file mode 100644
index cf1b5cd357..0000000000
--- a/emacs/guix-ui-license.el
+++ /dev/null
@@ -1,150 +0,0 @@
-;;; guix-ui-license.el --- Interface for displaying licenses
-
-;; Copyright © 2016 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides 'list'/'info' interface for displaying licenses of
-;; Guix packages.
-
-;;; Code:
-
-(require 'guix-buffer)
-(require 'guix-list)
-(require 'guix-info)
-(require 'guix-backend)
-(require 'guix-guile)
-(require 'guix-license)
-
-(guix-define-entry-type license)
-
-(defun guix-license-get-entries (search-type &rest args)
- "Receive 'license' entries.
-SEARCH-TYPE may be one of the following symbols: `all', `id', `name'."
- (guix-eval-read
- (apply #'guix-make-guile-expression
- 'license-entries search-type args)))
-
-(defun guix-license-get-display (search-type &rest args)
- "Search for licenses and show results."
- (apply #'guix-list-get-display-entries
- 'license search-type args))
-
-(defun guix-license-message (entries search-type &rest args)
- "Display a message after showing license ENTRIES."
- ;; Some objects in (guix licenses) module are procedures (e.g.,
- ;; 'non-copyleft' or 'x11-style'). Such licenses cannot be "described".
- (when (null entries)
- (if (cdr args)
- (message "Unknown licenses.")
- (message "Unknown license."))))
-
-
-;;; License 'info'
-
-(guix-info-define-interface license
- :buffer-name "*Guix License Info*"
- :get-entries-function 'guix-license-get-entries
- :message-function 'guix-license-message
- :format '((name ignore (simple guix-info-heading))
- ignore
- guix-license-insert-packages-button
- (url ignore (simple guix-url))
- guix-license-insert-comment
- ignore
- guix-license-insert-file)
- :titles '((url . "URL")))
-
-(declare-function guix-packages-by-license "guix-ui-package")
-
-(defun guix-license-insert-packages-button (entry)
- "Insert button to display packages by license ENTRY."
- (let ((license (guix-entry-value entry 'name)))
- (guix-info-insert-action-button
- "Packages"
- (lambda (btn)
- (guix-packages-by-license (button-get btn 'license)))
- (format "Display packages with license '%s'" license)
- 'license license)))
-
-(defun guix-license-insert-comment (entry)
- "Insert 'comment' of a license ENTRY."
- (let ((comment (guix-entry-value entry 'comment)))
- (if (and comment
- (string-match-p "^http" comment))
- (guix-info-insert-value-simple comment 'guix-url)
- (guix-info-insert-title-simple
- (guix-info-param-title 'license 'comment))
- (guix-info-insert-value-indent comment))))
-
-(defun guix-license-insert-file (entry)
- "Insert button to open license definition."
- (let ((license (guix-entry-value entry 'name)))
- (guix-insert-button
- (guix-license-file) 'guix-file
- 'help-echo (format "Open definition of license '%s'" license)
- 'action (lambda (btn)
- (guix-find-license-definition (button-get btn 'license)))
- 'license license)))
-
-
-;;; License 'list'
-
-(guix-list-define-interface license
- :buffer-name "*Guix Licenses*"
- :get-entries-function 'guix-license-get-entries
- :describe-function 'guix-license-list-describe
- :message-function 'guix-license-message
- :format '((name nil 40 t)
- (url guix-list-get-url 50 t))
- :titles '((name . "License"))
- :sort-key '(name))
-
-(let ((map guix-license-list-mode-map))
- (define-key map (kbd "e") 'guix-license-list-edit)
- (define-key map (kbd "RET") 'guix-license-list-show-packages))
-
-(defun guix-license-list-describe (ids)
- "Describe licenses with IDS (list of identifiers)."
- (guix-buffer-display-entries
- (guix-entries-by-ids ids (guix-buffer-current-entries))
- 'info 'license (cl-list* 'id ids) 'add))
-
-(defun guix-license-list-show-packages ()
- "Display packages with the license at point."
- (interactive)
- (guix-packages-by-license (guix-list-current-id)))
-
-(defun guix-license-list-edit (&optional directory)
- "Go to the location of the current license definition.
-See `guix-license-file' for the meaning of DIRECTORY."
- (interactive (list (guix-read-directory)))
- (guix-find-license-definition (guix-list-current-id) directory))
-
-
-;;; Interactive commands
-
-;;;###autoload
-(defun guix-licenses ()
- "Display licenses of the Guix packages."
- (interactive)
- (guix-license-get-display 'all))
-
-(provide 'guix-ui-license)
-
-;;; guix-ui-license.el ends here
diff --git a/emacs/guix-ui-location.el b/emacs/guix-ui-location.el
deleted file mode 100644
index 0027c1fba8..0000000000
--- a/emacs/guix-ui-location.el
+++ /dev/null
@@ -1,83 +0,0 @@
-;;; guix-ui-location.el --- Interface for displaying package locations
-
-;; Copyright © 2016 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU Guix is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public Location as published by
-;; the Free Software Foundation, either version 3 of the Location, or
-;; (at your option) any later version.
-
-;; GNU 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 Location for more details.
-
-;; You should have received a copy of the GNU General Public Location
-;; along with this program. If not, see <http://www.gnu.org/locations/>.
-
-;;; Commentary:
-
-;; This file provides a 'list' interface for displaying locations of Guix
-;; packages.
-
-;;; Code:
-
-(require 'guix-buffer)
-(require 'guix-list)
-(require 'guix-location)
-(require 'guix-backend)
-
-(guix-define-entry-type location)
-
-(defun guix-location-get-entries ()
- "Receive 'package location' entries."
- (guix-eval-read "(package-location-entries)"))
-
-
-;;; Location 'list'
-
-(guix-list-define-interface location
- :buffer-name "*Guix Package Locations*"
- :get-entries-function 'guix-location-get-entries
- :format '((location guix-location-list-file-name-specification 50 t)
- (number-of-packages nil 10 guix-list-sort-numerically-1
- :right-align t))
- :sort-key '(location))
-
-(let ((map guix-location-list-mode-map))
- (define-key map (kbd "RET") 'guix-location-list-show-packages)
- ;; "Location Info" buffer is not defined (it would be useless), so
- ;; unbind "i" key (by default, it is used to display Info buffer).
- (define-key map (kbd "i") nil))
-
-(defun guix-location-list-file-name-specification (location &optional _)
- "Return LOCATION button specification for `tabulated-list-entries'."
- (list location
- 'face 'guix-list-file-name
- 'action (lambda (btn)
- (guix-find-location (button-get btn 'location)))
- 'follow-link t
- 'help-echo (concat "Find location: " location)
- 'location location))
-
-(declare-function guix-packages-by-location "guix-ui-package")
-
-(defun guix-location-list-show-packages ()
- "Display packages placed in the location at point."
- (interactive)
- (guix-packages-by-location (guix-list-current-id)))
-
-
-;;; Interactive commands
-
-;;;###autoload
-(defun guix-locations ()
- "Display locations of the Guix packages."
- (interactive)
- (guix-list-get-display-entries 'location))
-
-(provide 'guix-ui-location)
-
-;;; guix-ui-location.el ends here
diff --git a/emacs/guix-ui-package.el b/emacs/guix-ui-package.el
deleted file mode 100644
index 4280246bb8..0000000000
--- a/emacs/guix-ui-package.el
+++ /dev/null
@@ -1,1191 +0,0 @@
-;;; guix-ui-package.el --- Interface for displaying packages -*- lexical-binding: t -*-
-
-;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides an interface for displaying packages and outputs
-;; in 'list' and 'info' buffers, and commands for working with them.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'guix-buffer)
-(require 'guix-list)
-(require 'guix-info)
-(require 'guix-ui)
-(require 'guix-base)
-(require 'guix-backend)
-(require 'guix-guile)
-(require 'guix-entry)
-(require 'guix-utils)
-(require 'guix-hydra)
-(require 'guix-hydra-build)
-(require 'guix-read)
-(require 'guix-license)
-(require 'guix-location)
-(require 'guix-profiles)
-
-(guix-ui-define-entry-type package)
-(guix-ui-define-entry-type output)
-
-(defcustom guix-package-list-type 'output
- "Define how to display packages in 'list' buffer.
-Should be a symbol `package' or `output' (if `output', display each
-output on a separate line; if `package', display each package on
-a separate line)."
- :type '(choice (const :tag "List of packages" package)
- (const :tag "List of outputs" output))
- :group 'guix-package)
-
-(defcustom guix-package-info-type 'package
- "Define how to display packages in 'info' buffer.
-Should be a symbol `package' or `output' (if `output', display
-each output separately; if `package', display outputs inside
-package data)."
- :type '(choice (const :tag "Display packages" package)
- (const :tag "Display outputs" output))
- :group 'guix-package)
-
-(defun guix-package-get-display (profile search-type &rest search-values)
- "Search for packages/outputs and show results.
-
-If PROFILE is nil, use `guix-current-profile'.
-
-See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and
-SEARCH-VALUES.
-
-Results are displayed in the list buffer, unless a single package
-is found and `guix-package-list-single' is nil."
- (let* ((args (cl-list* (or profile guix-current-profile)
- search-type search-values))
- (entries (guix-buffer-get-entries
- 'list guix-package-list-type args)))
- (if (or guix-package-list-single
- (null entries)
- (cdr entries))
- (guix-buffer-display-entries
- entries 'list guix-package-list-type args 'add)
- (guix-buffer-get-display-entries
- 'info guix-package-info-type args 'add))))
-
-(defun guix-package-entry->name-specification (entry &optional output)
- "Return name specification of the package ENTRY and OUTPUT."
- (guix-package-name-specification
- (guix-entry-value entry 'name)
- (guix-entry-value entry 'version)
- (or output (guix-entry-value entry 'output))))
-
-(defun guix-package-entries->name-specifications (entries)
- "Return name specifications by the package or output ENTRIES."
- (cl-remove-duplicates (mapcar #'guix-package-entry->name-specification
- entries)
- :test #'string=))
-
-(defun guix-package-installed-outputs (entry)
- "Return a list of installed outputs for the package ENTRY."
- (mapcar (lambda (installed-entry)
- (guix-entry-value installed-entry 'output))
- (guix-entry-value entry 'installed)))
-
-(defun guix-package-id-and-output-by-output-id (output-id)
- "Return a list (PACKAGE-ID OUTPUT) by OUTPUT-ID."
- (cl-multiple-value-bind (package-id-str output)
- (split-string output-id ":")
- (let ((package-id (string-to-number package-id-str)))
- (list (if (= 0 package-id) package-id-str package-id)
- output))))
-
-(defun guix-package-build-log-file (id)
- "Return build log file name of a package defined by ID."
- (guix-eval-read
- (guix-make-guile-expression 'package-build-log-file id)))
-
-(defun guix-package-find-build-log (id)
- "Show build log of a package defined by ID."
- (require 'guix-build-log)
- (let ((file (guix-package-build-log-file id)))
- (if file
- (guix-build-log-find-file file)
- (message "Couldn't find the package build log."))))
-
-
-;;; Processing package actions
-
-(defun guix-process-package-actions (profile actions
- &optional operation-buffer)
- "Process package ACTIONS on PROFILE.
-Each action is a list of the form:
-
- (ACTION-TYPE PACKAGE-SPEC ...)
-
-ACTION-TYPE is one of the following symbols: `install',
-`upgrade', `remove'/`delete'.
-PACKAGE-SPEC should have the following form: (ID [OUTPUT] ...)."
- (let (install upgrade remove)
- (mapc (lambda (action)
- (let ((action-type (car action))
- (specs (cdr action)))
- (cl-case action-type
- (install (setq install (append install specs)))
- (upgrade (setq upgrade (append upgrade specs)))
- ((remove delete) (setq remove (append remove specs))))))
- actions)
- (when (guix-continue-package-operation-p
- profile
- :install install :upgrade upgrade :remove remove)
- (guix-eval-in-repl
- (guix-make-guile-expression
- 'process-package-actions profile
- :install install :upgrade upgrade :remove remove
- :use-substitutes? (or guix-use-substitutes 'f)
- :dry-run? (or guix-dry-run 'f))
- (and (not guix-dry-run) operation-buffer)))))
-
-(cl-defun guix-continue-package-operation-p (profile
- &key install upgrade remove)
- "Return non-nil if a package operation should be continued.
-Ask a user if needed (see `guix-operation-confirm').
-INSTALL, UPGRADE, REMOVE are 'package action specifications'.
-See `guix-process-package-actions' for details."
- (or (null guix-operation-confirm)
- (let* ((entries (guix-ui-get-entries
- profile 'package 'id
- (append (mapcar #'car install)
- (mapcar #'car upgrade)
- (mapcar #'car remove))
- '(id name version location)))
- (install-strings (guix-get-package-strings install entries))
- (upgrade-strings (guix-get-package-strings upgrade entries))
- (remove-strings (guix-get-package-strings remove entries)))
- (if (or install-strings upgrade-strings remove-strings)
- (let ((buf (get-buffer-create guix-temp-buffer-name)))
- (with-current-buffer buf
- (setq-local cursor-type nil)
- (setq buffer-read-only nil)
- (erase-buffer)
- (insert "Profile: " profile "\n\n")
- (guix-insert-package-strings install-strings "install")
- (guix-insert-package-strings upgrade-strings "upgrade")
- (guix-insert-package-strings remove-strings "remove")
- (let ((win (temp-buffer-window-show
- buf
- '((display-buffer-reuse-window
- display-buffer-at-bottom)
- (window-height . fit-window-to-buffer)))))
- (prog1 (guix-operation-prompt)
- (quit-window nil win)))))
- (message "Nothing to be done.
-If Guix REPL was restarted, the data is not up-to-date.")
- nil))))
-
-(defun guix-get-package-strings (specs entries)
- "Return short package descriptions for performing package actions.
-See `guix-process-package-actions' for the meaning of SPECS.
-ENTRIES is a list of package entries to get info about packages."
- (delq nil
- (mapcar
- (lambda (spec)
- (let* ((id (car spec))
- (outputs (cdr spec))
- (entry (guix-entry-by-id id entries)))
- (when entry
- (let ((location (guix-entry-value entry 'location)))
- (concat (guix-package-entry->name-specification entry)
- (when outputs
- (concat ":"
- (guix-concat-strings outputs ",")))
- (when location
- (concat "\t(" location ")")))))))
- specs)))
-
-(defun guix-insert-package-strings (strings action)
- "Insert information STRINGS at point for performing package ACTION."
- (when strings
- (insert "Package(s) to " (propertize action 'face 'bold) ":\n")
- (mapc (lambda (str)
- (insert " " str "\n"))
- strings)
- (insert "\n")))
-
-
-;;; Package 'info'
-
-(guix-ui-info-define-interface package
- :buffer-name "*Guix Package Info*"
- :format '(guix-package-info-insert-heading
- ignore
- (synopsis ignore (simple guix-package-info-synopsis))
- ignore
- (description ignore (simple guix-package-info-description))
- ignore
- (outputs simple guix-package-info-insert-outputs)
- guix-package-info-insert-misc
- (source simple guix-package-info-insert-source)
- (location simple guix-package-info-insert-location)
- (home-url format (format guix-url))
- (license format (format guix-package-license))
- (systems format guix-package-info-insert-systems)
- (inputs format (format guix-package-input))
- (native-inputs format (format guix-package-native-input))
- (propagated-inputs format
- (format guix-package-propagated-input)))
- :titles '((home-url . "Home page")
- (systems . "Supported systems"))
- :required '(id name version installed non-unique))
-
-(guix-info-define-interface installed-output
- :format '((path simple (indent guix-file))
- (dependencies simple (indent guix-file)))
- :titles '((path . "Store directory"))
- :reduced? t)
-
-(defface guix-package-info-heading
- '((t :inherit guix-info-heading))
- "Face for package name and version headings."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-name
- '((t :inherit font-lock-keyword-face))
- "Face used for a name of a package."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-name-button
- '((t :inherit button))
- "Face used for a full name that can be used to describe a package."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-version
- '((t :inherit font-lock-builtin-face))
- "Face used for a version of a package."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-synopsis
- '((((type tty pc) (class color)) :weight bold)
- (t :height 1.1 :weight bold :inherit variable-pitch))
- "Face used for a synopsis of a package."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-description
- '((t))
- "Face used for a description of a package."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-license
- '((t :inherit font-lock-string-face))
- "Face used for a license of a package."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-location
- '((t :inherit link))
- "Face used for a location of a package."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-source
- '((t :inherit link :underline nil))
- "Face used for a source URL of a package."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-installed-outputs
- '((default :weight bold)
- (((class color) (min-colors 88) (background light))
- :foreground "ForestGreen")
- (((class color) (min-colors 88) (background dark))
- :foreground "PaleGreen")
- (((class color) (min-colors 8))
- :foreground "green")
- (t :underline t))
- "Face used for installed outputs of a package."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-uninstalled-outputs
- '((t :weight bold))
- "Face used for uninstalled outputs of a package."
- :group 'guix-package-info-faces)
-
-(defface guix-package-info-obsolete
- '((t :inherit error))
- "Face used if a package is obsolete."
- :group 'guix-package-info-faces)
-
-(defcustom guix-package-info-auto-find-package t
- "If non-nil, open store directory after pressing \"Show\" package button.
-If nil, just display the store directory (or directories) without finding."
- :type 'boolean
- :group 'guix-package-info)
-
-(defcustom guix-package-info-auto-find-source nil
- "If non-nil, open source file after pressing \"Show\" source button.
-If nil, just display the source file name without finding."
- :type 'boolean
- :group 'guix-package-info)
-
-(defcustom guix-package-info-auto-download-source t
- "If nil, do not automatically download a source file if it doesn't exist.
-After pressing a \"Show\" button, a derivation of the package
-source is calculated and a store file path is displayed. If this
-variable is non-nil and the source file does not exist in the
-store, it will be automatically downloaded (with a possible
-prompt depending on `guix-operation-confirm' variable)."
- :type 'boolean
- :group 'guix-package-info)
-
-(defcustom guix-package-info-button-functions
- '(guix-package-info-insert-build-button
- guix-package-info-insert-build-log-button)
- "List of functions used to insert package buttons in Info buffer.
-Each function is called with 2 arguments: package ID and full name."
- :type '(repeat function)
- :group 'guix-package-info)
-
-(defvar guix-package-info-download-buffer nil
- "Buffer from which a current download operation was performed.")
-
-(defvar guix-package-info-output-format "%-10s"
- "String used to format output names of the packages.
-It should be a '%s'-sequence. After inserting an output name
-formatted with this string, an action button is inserted.")
-
-(defvar guix-package-info-obsolete-string "(This package is obsolete)"
- "String used if a package is obsolete.")
-
-(define-button-type 'guix-package-location
- :supertype 'guix
- 'face 'guix-package-info-location
- 'help-echo "Find location of this package"
- 'action (lambda (btn)
- (guix-find-location (button-label btn))))
-
-(define-button-type 'guix-package-license
- :supertype 'guix
- 'face 'guix-package-info-license
- 'help-echo "Display license info"
- 'action (lambda (btn)
- (require 'guix-ui-license)
- (guix-buffer-get-display-entries
- 'info 'license
- (list 'name (button-label btn))
- 'add)))
-
-(define-button-type 'guix-package-name
- :supertype 'guix
- 'face 'guix-package-info-name-button
- 'help-echo "Describe this package"
- 'action (lambda (btn)
- (guix-buffer-get-display-entries-current
- 'info guix-package-info-type
- (list (guix-ui-current-profile)
- 'name (or (button-get btn 'spec)
- (button-label btn)))
- 'add)))
-
-(define-button-type 'guix-package-heading
- :supertype 'guix-package-name
- 'face 'guix-package-info-heading)
-
-(define-button-type 'guix-package-source
- :supertype 'guix
- 'face 'guix-package-info-source
- 'help-echo ""
- 'action (lambda (_)
- ;; As a source may not be a real URL (e.g., "mirror://..."),
- ;; no action is bound to a source button.
- (message "Yes, this is the source URL. What did you expect?")))
-
-(defun guix-package-info-insert-heading (entry)
- "Insert package ENTRY heading (name and version) at point."
- (guix-insert-button
- (concat (guix-entry-value entry 'name) " "
- (guix-entry-value entry 'version))
- 'guix-package-heading
- 'spec (guix-package-entry->name-specification entry)))
-
-(defun guix-package-info-insert-location (location &optional _)
- "Insert package LOCATION at point."
- (if (null location)
- (guix-format-insert nil)
- (let ((location-file (car (split-string location ":"))))
- (guix-info-insert-value-indent location 'guix-package-location)
- ;; Do not show "Packages" button if a package 'from file' is displayed.
- (unless (eq (guix-ui-current-search-type) 'from-file)
- (guix-info-insert-indent)
- (guix-info-insert-action-button
- "Packages"
- (lambda (btn)
- (guix-package-get-display (guix-ui-current-profile)
- 'location
- (button-get btn 'location)))
- (format "Display packages from location '%s'" location-file)
- 'location location-file)))))
-
-(defun guix-package-info-insert-systems (systems entry)
- "Insert supported package SYSTEMS at point."
- (guix-info-insert-value-format
- systems 'guix-hydra-build-system
- 'action (lambda (btn)
- (let ((args (guix-hydra-build-latest-prompt-args
- :job (button-get btn 'job-name)
- :system (button-label btn))))
- (apply #'guix-hydra-build-get-display
- 'latest args)))
- 'job-name (guix-hydra-job-name-specification
- (guix-entry-value entry 'name)
- (guix-entry-value entry 'version))))
-
-(defmacro guix-package-info-define-insert-inputs (&optional type)
- "Define a face and a function for inserting package inputs.
-TYPE is a type of inputs.
-Function name is `guix-package-info-insert-TYPE-inputs'.
-Face name is `guix-package-info-TYPE-inputs'."
- (let* ((type-str (symbol-name type))
- (type-name (and type (concat type-str "-")))
- (type-desc (and type (concat type-str " ")))
- (face (intern (concat "guix-package-info-" type-name "inputs")))
- (btn (intern (concat "guix-package-" type-name "input"))))
- `(progn
- (defface ,face
- '((t :inherit guix-package-info-name-button))
- ,(concat "Face used for " type-desc "inputs of a package.")
- :group 'guix-package-info-faces)
-
- (define-button-type ',btn
- :supertype 'guix-package-name
- 'face ',face))))
-
-(guix-package-info-define-insert-inputs)
-(guix-package-info-define-insert-inputs native)
-(guix-package-info-define-insert-inputs propagated)
-
-(defun guix-package-info-insert-outputs (outputs entry)
- "Insert OUTPUTS from package ENTRY at point."
- (and (guix-entry-value entry 'obsolete)
- (guix-package-info-insert-obsolete-text))
- (and (guix-entry-value entry 'non-unique)
- (guix-entry-value entry 'installed)
- (guix-package-info-insert-non-unique-text
- (guix-package-entry->name-specification entry)))
- (insert "\n")
- (dolist (output outputs)
- (guix-package-info-insert-output output entry)))
-
-(defun guix-package-info-insert-obsolete-text ()
- "Insert a message about obsolete package at point."
- (guix-info-insert-indent)
- (guix-format-insert guix-package-info-obsolete-string
- 'guix-package-info-obsolete))
-
-(defun guix-package-info-insert-non-unique-text (full-name)
- "Insert a message about non-unique package with FULL-NAME at point."
- (insert "\n")
- (guix-info-insert-indent)
- (insert "Installed outputs are displayed for a non-unique ")
- (guix-insert-button full-name 'guix-package-name)
- (insert " package."))
-
-(defun guix-package-info-insert-output (output entry)
- "Insert OUTPUT at point.
-Make some fancy text with buttons and additional stuff if the
-current OUTPUT is installed (if there is such output in
-`installed' parameter of a package ENTRY)."
- (let* ((installed (guix-entry-value entry 'installed))
- (obsolete (guix-entry-value entry 'obsolete))
- (installed-entry (cl-find-if
- (lambda (entry)
- (string= (guix-entry-value entry 'output)
- output))
- installed))
- (action-type (if installed-entry 'delete 'install))
- (profile (guix-ui-current-profile)))
- (guix-info-insert-indent)
- (guix-format-insert output
- (if installed-entry
- 'guix-package-info-installed-outputs
- 'guix-package-info-uninstalled-outputs)
- guix-package-info-output-format)
- ;; Do not allow a user to install/delete anything to/from a system
- ;; profile, so add action buttons only for non-system profiles.
- (when (and profile
- (not (guix-system-profile? profile)))
- (guix-package-info-insert-action-button action-type entry output)
- (when obsolete
- (guix-info-insert-indent)
- (guix-package-info-insert-action-button 'upgrade entry output)))
- (insert "\n")
- (when installed-entry
- (guix-info-insert-entry installed-entry 'installed-output 2))))
-
-(defun guix-package-info-insert-action-button (type entry output)
- "Insert button to process an action on a package OUTPUT at point.
-TYPE is one of the following symbols: `install', `delete', `upgrade'.
-ENTRY is an alist with package info."
- (let ((type-str (capitalize (symbol-name type)))
- (full-name (guix-package-entry->name-specification entry output)))
- (guix-info-insert-action-button
- type-str
- (lambda (btn)
- (guix-process-package-actions
- (guix-ui-current-profile)
- `((,(button-get btn 'action-type) (,(button-get btn 'id)
- ,(button-get btn 'output))))
- (current-buffer)))
- (concat type-str " '" full-name "'")
- 'action-type type
- 'id (or (guix-entry-value entry 'package-id)
- (guix-entry-id entry))
- 'output output)))
-
-(defun guix-package-info-show-store-path (entry-id package-id)
- "Show store directories of the package outputs in the current buffer.
-ENTRY-ID is an ID of the current entry (package or output).
-PACKAGE-ID is an ID of the package which store path to show."
- (let* ((entries (guix-buffer-current-entries))
- (entry (guix-entry-by-id entry-id entries))
- (dirs (guix-package-store-path package-id)))
- (or dirs
- (error "Couldn't define store directory of the package"))
- (let* ((new-entry (cons (cons 'store-path dirs)
- entry))
- (new-entries (guix-replace-entry entry-id new-entry entries)))
- (setf (guix-buffer-item-entries guix-buffer-item)
- new-entries)
- (guix-buffer-redisplay-goto-button)
- (let ((dir (car dirs)))
- (if (file-exists-p dir)
- (if guix-package-info-auto-find-package
- (find-file dir)
- (message nil))
- (message "'%s' does not exist.\nTry to build this package."
- dir))))))
-
-(defun guix-package-info-insert-misc (entry)
- "Insert various buttons and other info for package ENTRY at point."
- (if (guix-entry-value entry 'obsolete)
- (guix-format-insert nil)
- (let* ((entry-id (guix-entry-id entry))
- (package-id (or (guix-entry-value entry 'package-id)
- entry-id))
- (full-name (guix-package-entry->name-specification entry))
- (store-path (guix-entry-value entry 'store-path)))
- (guix-info-insert-title-simple "Package")
- (if store-path
- (guix-info-insert-value-indent store-path 'guix-file)
- (guix-info-insert-action-button
- "Show"
- (lambda (btn)
- (guix-package-info-show-store-path
- (button-get btn 'entry-id)
- (button-get btn 'package-id)))
- "Show the store directory of the current package"
- 'entry-id entry-id
- 'package-id package-id))
- (when guix-package-info-button-functions
- (insert "\n")
- (guix-mapinsert (lambda (fun)
- (funcall fun package-id full-name))
- guix-package-info-button-functions
- (guix-info-get-indent)
- :indent guix-info-indent
- :column (guix-info-fill-column))))))
-
-(defun guix-package-info-insert-build-button (id full-name)
- "Insert button to build a package defined by ID."
- (guix-info-insert-action-button
- "Build"
- (lambda (btn)
- (guix-build-package (button-get btn 'id)
- (format "Build '%s' package?" full-name)))
- (format "Build the current package")
- 'id id))
-
-(defun guix-package-info-insert-build-log-button (id _name)
- "Insert button to show build log of a package defined by ID."
- (guix-info-insert-action-button
- "Build Log"
- (lambda (btn)
- (guix-package-find-build-log (button-get btn 'id)))
- "View build log of the current package"
- 'id id))
-
-(defun guix-package-info-show-source (entry-id package-id)
- "Show file name of a package source in the current info buffer.
-Find the file if needed (see `guix-package-info-auto-find-source').
-ENTRY-ID is an ID of the current entry (package or output).
-PACKAGE-ID is an ID of the package which source to show."
- (let* ((entries (guix-buffer-current-entries))
- (entry (guix-entry-by-id entry-id entries))
- (file (guix-package-source-path package-id)))
- (or file
- (error "Couldn't define file name of the package source"))
- (let* ((new-entry (cons (cons 'source-file file)
- entry))
- (new-entries (guix-replace-entry entry-id new-entry entries)))
- (setf (guix-buffer-item-entries guix-buffer-item)
- new-entries)
- (guix-buffer-redisplay-goto-button)
- (if (file-exists-p file)
- (if guix-package-info-auto-find-source
- (guix-find-file file)
- (message "The source store path is displayed."))
- (if guix-package-info-auto-download-source
- (guix-package-info-download-source package-id)
- (message "The source does not exist in the store."))))))
-
-(defun guix-package-info-download-source (package-id)
- "Download a source of the package PACKAGE-ID."
- (setq guix-package-info-download-buffer (current-buffer))
- (guix-package-source-build-derivation
- package-id
- "The source does not exist in the store. Download it?"))
-
-(defun guix-package-info-insert-source (source entry)
- "Insert SOURCE from package ENTRY at point.
-SOURCE is a list of URLs."
- (if (null source)
- (guix-format-insert nil)
- (let* ((source-file (guix-entry-value entry 'source-file))
- (entry-id (guix-entry-id entry))
- (package-id (or (guix-entry-value entry 'package-id)
- entry-id)))
- (if (null source-file)
- (guix-info-insert-action-button
- "Show"
- (lambda (btn)
- (guix-package-info-show-source (button-get btn 'entry-id)
- (button-get btn 'package-id)))
- "Show the source store directory of the current package"
- 'entry-id entry-id
- 'package-id package-id)
- (unless (file-exists-p source-file)
- (guix-info-insert-action-button
- "Download"
- (lambda (btn)
- (guix-package-info-download-source
- (button-get btn 'package-id)))
- "Download the source into the store"
- 'package-id package-id))
- (guix-info-insert-value-indent source-file 'guix-file))
- (guix-info-insert-value-indent source 'guix-package-source))))
-
-(defun guix-package-info-redisplay-after-download ()
- "Redisplay an 'info' buffer after downloading the package source.
-This function is used to hide a \"Download\" button if needed."
- (when (buffer-live-p guix-package-info-download-buffer)
- (with-current-buffer guix-package-info-download-buffer
- (guix-buffer-redisplay-goto-button))
- (setq guix-package-info-download-buffer nil)))
-
-(add-hook 'guix-after-source-download-hook
- 'guix-package-info-redisplay-after-download)
-
-
-;;; Package 'list'
-
-(guix-ui-list-define-interface package
- :buffer-name "*Guix Package List*"
- :format '((name guix-package-list-get-name 20 t)
- (version nil 10 nil)
- (outputs nil 13 t)
- (installed guix-package-list-get-installed-outputs 13 t)
- (synopsis guix-list-get-one-line 30 nil))
- :sort-key '(name)
- :marks '((install . ?I)
- (upgrade . ?U)
- (delete . ?D)))
-
-(let ((map guix-package-list-mode-map))
- (define-key map (kbd "B") 'guix-package-list-latest-builds)
- (define-key map (kbd "e") 'guix-package-list-edit)
- (define-key map (kbd "x") 'guix-package-list-execute)
- (define-key map (kbd "i") 'guix-package-list-mark-install)
- (define-key map (kbd "d") 'guix-package-list-mark-delete)
- (define-key map (kbd "U") 'guix-package-list-mark-upgrade)
- (define-key map (kbd "^") 'guix-package-list-mark-upgrades))
-
-(defface guix-package-list-installed
- '((t :inherit guix-package-info-installed-outputs))
- "Face used if there are installed outputs for the current package."
- :group 'guix-package-list-faces)
-
-(defface guix-package-list-obsolete
- '((t :inherit guix-package-info-obsolete))
- "Face used if a package is obsolete."
- :group 'guix-package-list-faces)
-
-(defcustom guix-package-list-generation-marking-enabled nil
- "If non-nil, allow putting marks in a list with 'generation packages'.
-
-By default this is disabled, because it may be confusing. For
-example, a package is installed in some generation, so a user can
-mark it for deletion in the list of packages from this
-generation, but the package may not be installed in the latest
-generation, so actually it cannot be deleted.
-
-If you managed to understand the explanation above or if you
-really know what you do or if you just don't care, you can set
-this variable to t. It should not do much harm anyway (most
-likely)."
- :type 'boolean
- :group 'guix-package-list)
-
-(defun guix-package-list-get-name (name entry)
- "Return NAME of the package ENTRY.
-Colorize it with `guix-package-list-installed' or
-`guix-package-list-obsolete' if needed."
- (guix-get-string name
- (cond ((guix-entry-value entry 'obsolete)
- 'guix-package-list-obsolete)
- ((guix-entry-value entry 'installed)
- 'guix-package-list-installed))))
-
-(defun guix-package-list-get-installed-outputs (installed &optional _)
- "Return string with outputs from INSTALLED entries."
- (guix-get-string
- (mapcar (lambda (entry)
- (guix-entry-value entry 'output))
- installed)))
-
-(defun guix-package-list-marking-check ()
- "Signal an error if marking is disabled for the current buffer."
- (when (and (not guix-package-list-generation-marking-enabled)
- (or (derived-mode-p 'guix-package-list-mode)
- (derived-mode-p 'guix-output-list-mode))
- (eq (guix-ui-current-search-type) 'generation))
- (error "Action marks are disabled for lists of 'generation packages'")))
-
-(defun guix-package-list-mark-outputs (mark default
- &optional prompt available)
- "Mark the current package with MARK and move to the next line.
-If PROMPT is non-nil, use it to ask a user for outputs from
-AVAILABLE list, otherwise mark all DEFAULT outputs."
- (let ((outputs (if prompt
- (guix-completing-read-multiple
- prompt available nil t)
- default)))
- (apply #'guix-list--mark mark t outputs)))
-
-(defun guix-package-list-mark-install (&optional arg)
- "Mark the current package for installation and move to the next line.
-With ARG, prompt for the outputs to install (several outputs may
-be separated with \",\")."
- (interactive "P")
- (guix-package-list-marking-check)
- (let* ((entry (guix-list-current-entry))
- (all (guix-entry-value entry 'outputs))
- (installed (guix-package-installed-outputs entry))
- (available (cl-set-difference all installed :test #'string=)))
- (or available
- (user-error "This package is already installed"))
- (guix-package-list-mark-outputs
- 'install '("out")
- (and arg "Output(s) to install: ")
- available)))
-
-(defun guix-package-list-mark-delete (&optional arg)
- "Mark the current package for deletion and move to the next line.
-With ARG, prompt for the outputs to delete (several outputs may
-be separated with \",\")."
- (interactive "P")
- (guix-package-list-marking-check)
- (let* ((entry (guix-list-current-entry))
- (installed (guix-package-installed-outputs entry)))
- (or installed
- (user-error "This package is not installed"))
- (guix-package-list-mark-outputs
- 'delete installed
- (and arg "Output(s) to delete: ")
- installed)))
-
-(defun guix-package-list-mark-upgrade (&optional arg)
- "Mark the current package for upgrading and move to the next line.
-With ARG, prompt for the outputs to upgrade (several outputs may
-be separated with \",\")."
- (interactive "P")
- (guix-package-list-marking-check)
- (let* ((entry (guix-list-current-entry))
- (installed (guix-package-installed-outputs entry)))
- (or installed
- (user-error "This package is not installed"))
- (when (or (guix-entry-value entry 'obsolete)
- (y-or-n-p "This package is not obsolete. Try to upgrade it anyway? "))
- (guix-package-list-mark-outputs
- 'upgrade installed
- (and arg "Output(s) to upgrade: ")
- installed))))
-
-(defun guix-package-mark-upgrades (fun)
- "Mark all obsolete packages for upgrading.
-Use FUN to perform marking of the current line. FUN should
-take an entry as argument."
- (guix-package-list-marking-check)
- (let ((obsolete (cl-remove-if-not
- (lambda (entry)
- (guix-entry-value entry 'obsolete))
- (guix-buffer-current-entries))))
- (guix-list-for-each-line
- (lambda ()
- (let* ((id (guix-list-current-id))
- (entry (cl-find-if
- (lambda (entry)
- (equal id (guix-entry-id entry)))
- obsolete)))
- (when entry
- (funcall fun entry)))))))
-
-(defun guix-package-list-mark-upgrades ()
- "Mark all obsolete packages for upgrading."
- (interactive)
- (guix-package-mark-upgrades
- (lambda (entry)
- (apply #'guix-list--mark
- 'upgrade nil
- (guix-package-installed-outputs entry)))))
-
-(defun guix-package-assert-non-system-profile ()
- "Verify that the current profile is not a system one.
-The current profile is the one used by the current buffer."
- (let ((profile (guix-ui-current-profile)))
- (and profile
- (guix-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 guix-package-execute-actions (fun)
- "Perform actions on the marked packages.
-Use FUN to define actions suitable for `guix-process-package-actions'.
-FUN should take action-type as argument."
- (guix-package-assert-non-system-profile)
- (let ((actions (delq nil
- (mapcar fun '(install delete upgrade)))))
- (if actions
- (guix-process-package-actions (guix-ui-current-profile)
- actions (current-buffer))
- (user-error "No operations specified"))))
-
-(defun guix-package-list-execute ()
- "Perform actions on the marked packages."
- (interactive)
- (guix-package-execute-actions #'guix-package-list-make-action))
-
-(defun guix-package-list-make-action (action-type)
- "Return action specification for the packages marked with ACTION-TYPE.
-Return nil, if there are no packages marked with ACTION-TYPE.
-The specification is suitable for `guix-process-package-actions'."
- (let ((specs (guix-list-get-marked-args action-type)))
- (and specs (cons action-type specs))))
-
-(defun guix-package-list-edit (&optional directory)
- "Go to the location of the current package.
-See `guix-find-location' for the meaning of DIRECTORY."
- (interactive (list (guix-read-directory)))
- (guix-edit (guix-list-current-id) directory))
-
-(defun guix-package-list-latest-builds (number &rest args)
- "Display latest NUMBER of Hydra builds of the current package.
-Interactively, prompt for NUMBER. With prefix argument, prompt
-for all ARGS."
- (interactive
- (let ((entry (guix-list-current-entry)))
- (guix-hydra-build-latest-prompt-args
- :job (guix-hydra-job-name-specification
- (guix-entry-value entry 'name)
- (guix-entry-value entry 'version)))))
- (apply #'guix-hydra-latest-builds number args))
-
-
-;;; Output 'info'
-
-(guix-ui-info-define-interface output
- :buffer-name "*Guix Package Info*"
- :format '((name format (format guix-package-info-name))
- (version format guix-output-info-insert-version)
- (output format guix-output-info-insert-output)
- (synopsis simple (indent guix-package-info-synopsis))
- guix-package-info-insert-misc
- (source simple guix-package-info-insert-source)
- (path simple (indent guix-file))
- (dependencies simple (indent guix-file))
- (location simple guix-package-info-insert-location)
- (home-url format (format guix-url))
- (license format (format guix-package-license))
- (systems format guix-package-info-insert-systems)
- (inputs format (format guix-package-input))
- (native-inputs format (format guix-package-native-input))
- (propagated-inputs format
- (format guix-package-propagated-input))
- (description simple (indent guix-package-info-description)))
- :titles guix-package-info-titles
- :required '(id package-id installed non-unique))
-
-(defun guix-output-info-insert-version (version entry)
- "Insert output VERSION and obsolete text if needed at point."
- (guix-info-insert-value-format version
- 'guix-package-info-version)
- (and (guix-entry-value entry 'obsolete)
- (guix-package-info-insert-obsolete-text)))
-
-(defun guix-output-info-insert-output (output entry)
- "Insert OUTPUT and action buttons at point."
- (let* ((installed (guix-entry-value entry 'installed))
- (obsolete (guix-entry-value entry 'obsolete))
- (action-type (if installed 'delete 'install)))
- (guix-info-insert-value-format
- output
- (if installed
- 'guix-package-info-installed-outputs
- 'guix-package-info-uninstalled-outputs))
- (guix-info-insert-indent)
- (guix-package-info-insert-action-button action-type entry output)
- (when obsolete
- (guix-info-insert-indent)
- (guix-package-info-insert-action-button 'upgrade entry output))))
-
-
-;;; Output 'list'
-
-(guix-ui-list-define-interface output
- :buffer-name "*Guix Package List*"
- :describe-function 'guix-output-list-describe
- :format '((name guix-package-list-get-name 20 t)
- (version nil 10 nil)
- (output nil 9 t)
- (installed nil 12 t)
- (synopsis guix-list-get-one-line 30 nil))
- :required '(id package-id)
- :sort-key '(name)
- :marks '((install . ?I)
- (upgrade . ?U)
- (delete . ?D)))
-
-(let ((map guix-output-list-mode-map))
- (define-key map (kbd "B") 'guix-package-list-latest-builds)
- (define-key map (kbd "e") 'guix-output-list-edit)
- (define-key map (kbd "x") 'guix-output-list-execute)
- (define-key map (kbd "i") 'guix-output-list-mark-install)
- (define-key map (kbd "d") 'guix-output-list-mark-delete)
- (define-key map (kbd "U") 'guix-output-list-mark-upgrade)
- (define-key map (kbd "^") 'guix-output-list-mark-upgrades))
-
-(defun guix-output-list-mark-install ()
- "Mark the current output for installation and move to the next line."
- (interactive)
- (guix-package-list-marking-check)
- (let* ((entry (guix-list-current-entry))
- (installed (guix-entry-value entry 'installed)))
- (if installed
- (user-error "This output is already installed")
- (guix-list--mark 'install t))))
-
-(defun guix-output-list-mark-delete ()
- "Mark the current output for deletion and move to the next line."
- (interactive)
- (guix-package-list-marking-check)
- (let* ((entry (guix-list-current-entry))
- (installed (guix-entry-value entry 'installed)))
- (if installed
- (guix-list--mark 'delete t)
- (user-error "This output is not installed"))))
-
-(defun guix-output-list-mark-upgrade ()
- "Mark the current output for upgrading and move to the next line."
- (interactive)
- (guix-package-list-marking-check)
- (let* ((entry (guix-list-current-entry))
- (installed (guix-entry-value entry 'installed)))
- (or installed
- (user-error "This output is not installed"))
- (when (or (guix-entry-value entry 'obsolete)
- (y-or-n-p "This output is not obsolete. Try to upgrade it anyway? "))
- (guix-list--mark 'upgrade t))))
-
-(defun guix-output-list-mark-upgrades ()
- "Mark all obsolete package outputs for upgrading."
- (interactive)
- (guix-package-mark-upgrades
- (lambda (_) (guix-list--mark 'upgrade))))
-
-(defun guix-output-list-execute ()
- "Perform actions on the marked outputs."
- (interactive)
- (guix-package-execute-actions #'guix-output-list-make-action))
-
-(defun guix-output-list-make-action (action-type)
- "Return action specification for the outputs marked with ACTION-TYPE.
-Return nil, if there are no outputs marked with ACTION-TYPE.
-The specification is suitable for `guix-process-output-actions'."
- (let ((ids (guix-list-get-marked-id-list action-type)))
- (and ids (cons action-type
- (mapcar #'guix-package-id-and-output-by-output-id
- ids)))))
-
-(defun guix-output-list-describe (ids)
- "Describe outputs with IDS (list of output identifiers).
-See `guix-package-info-type'."
- (if (eq guix-package-info-type 'output)
- (guix-buffer-get-display-entries
- 'info 'output
- (cl-list* (guix-ui-current-profile) 'id ids)
- 'add)
- (let ((pids (mapcar (lambda (oid)
- (car (guix-package-id-and-output-by-output-id
- oid)))
- ids)))
- (guix-buffer-get-display-entries
- 'info 'package
- (cl-list* (guix-ui-current-profile)
- 'id (cl-remove-duplicates pids))
- 'add))))
-
-(defun guix-output-list-edit (&optional directory)
- "Go to the location of the current package.
-See `guix-find-location' for the meaning of DIRECTORY."
- (interactive (list (guix-read-directory)))
- (guix-edit (guix-entry-value (guix-list-current-entry)
- 'package-id)
- directory))
-
-
-;;; Interactive commands
-
-(defvar guix-package-search-params '(name synopsis description)
- "Default list of package parameters for searching by regexp.")
-
-(defvar guix-package-search-history nil
- "A history of minibuffer prompts.")
-
-;;;###autoload
-(defun guix-packages-by-name (name &optional profile)
- "Display Guix packages with NAME.
-NAME is a string with name specification. It may optionally contain
-a version number. Examples: \"guile\", \"guile@2.0.11\".
-
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive
- (list (guix-read-package-name)
- (guix-ui-read-profile)))
- (guix-package-get-display profile 'name name))
-
-;;;###autoload
-(defun guix-packages-by-license (license &optional profile)
- "Display Guix packages with LICENSE.
-LICENSE is a license name string.
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive
- (list (guix-read-license-name)
- (guix-ui-read-profile)))
- (guix-package-get-display profile 'license license))
-
-;;;###autoload
-(defun guix-packages-by-location (location &optional profile)
- "Display Guix packages placed in LOCATION file.
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive
- (list (guix-read-package-location)
- (guix-ui-read-profile)))
- (guix-package-get-display profile 'location location))
-
-;;;###autoload
-(defun guix-package-from-file (file &optional profile)
- "Display Guix package that the code from FILE evaluates to.
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive
- (list (read-file-name "File with package: ")
- (guix-ui-read-profile)))
- (guix-buffer-get-display-entries
- 'info 'package
- (list (or profile guix-current-profile) 'from-file file)
- 'add))
-
-;;;###autoload
-(defun guix-search-by-regexp (regexp &optional params profile)
- "Search for Guix packages by REGEXP.
-PARAMS are package parameters that should be searched.
-If PARAMS are not specified, use `guix-package-search-params'.
-
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive
- (list (read-regexp "Regexp: " nil 'guix-package-search-history)
- nil (guix-ui-read-profile)))
- (guix-package-get-display profile 'regexp regexp
- (or params guix-package-search-params)))
-
-;;;###autoload
-(defun guix-search-by-name (regexp &optional profile)
- "Search for Guix packages matching REGEXP in a package name.
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive
- (list (read-string "Package name by regexp: "
- nil 'guix-package-search-history)
- (guix-ui-read-profile)))
- (guix-search-by-regexp regexp '(name) profile))
-
-;;;###autoload
-(defun guix-installed-packages (&optional profile)
- "Display information about installed Guix packages.
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive (list (guix-ui-read-profile)))
- (guix-package-get-display profile 'installed))
-
-;;;###autoload
-(defun guix-installed-user-packages ()
- "Display information about Guix packages installed in a user profile."
- (interactive)
- (guix-installed-packages guix-user-profile))
-
-;;;###autoload
-(defun guix-installed-system-packages ()
- "Display information about Guix packages installed in a system profile."
- (interactive)
- (guix-installed-packages
- (guix-packages-profile guix-system-profile nil t)))
-
-;;;###autoload
-(defun guix-obsolete-packages (&optional profile)
- "Display information about obsolete Guix packages.
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive (list (guix-ui-read-profile)))
- (guix-package-get-display profile 'obsolete))
-
-;;;###autoload
-(defun guix-all-available-packages (&optional profile)
- "Display information about all available Guix packages.
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive (list (guix-ui-read-profile)))
- (guix-package-get-display profile 'all-available))
-
-;;;###autoload
-(defun guix-newest-available-packages (&optional profile)
- "Display information about the newest available Guix packages.
-If PROFILE is nil, use `guix-current-profile'.
-Interactively with prefix, prompt for PROFILE."
- (interactive (list (guix-ui-read-profile)))
- (guix-package-get-display profile 'newest-available))
-
-(provide 'guix-ui-package)
-
-;;; guix-ui-package.el ends here
diff --git a/emacs/guix-ui-system-generation.el b/emacs/guix-ui-system-generation.el
deleted file mode 100644
index 7f4d76d489..0000000000
--- a/emacs/guix-ui-system-generation.el
+++ /dev/null
@@ -1,105 +0,0 @@
-;;; guix-ui-system-generation.el --- Interface for displaying system generations -*- lexical-binding: t -*-
-
-;; Copyright © 2016 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides an interface for displaying system generations
-;; in 'list' and 'info' buffers, and commands for working with them.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'guix-list)
-(require 'guix-ui)
-(require 'guix-ui-generation)
-(require 'guix-profiles)
-
-(guix-ui-define-entry-type system-generation)
-
-(defun guix-system-generation-get-display (search-type &rest search-values)
- "Search for system generations and show results.
-See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and
-SEARCH-VALUES."
- (apply #'guix-list-get-display-entries
- 'system-generation
- guix-system-profile
- search-type search-values))
-
-
-;;; System generation 'info'
-
-(guix-ui-info-define-interface system-generation
- :buffer-name "*Guix Generation Info*"
- :format '((number format guix-generation-info-insert-number)
- (label format (format))
- (prev-number format (format))
- (current format guix-generation-info-insert-current)
- (path format (format guix-file))
- (time format (time))
- (root-device format (format))
- (kernel format (format guix-file)))
- :titles guix-generation-info-titles)
-
-
-;;; System generation 'list'
-
-;; FIXME It is better to make `guix-generation-list-shared-map' with
-;; common keys for both usual and system generations.
-(defvar guix-system-generation-list-mode-map
- (copy-keymap guix-generation-list-mode-map)
- "Keymap for `guix-system-generation-list-mode' buffers.")
-
-(guix-ui-list-define-interface system-generation
- :buffer-name "*Guix Generation List*"
- :format '((number nil 5 guix-list-sort-numerically-0 :right-align t)
- (current guix-generation-list-get-current 10 t)
- (label nil 40 t)
- (time guix-list-get-time 20 t)
- (path guix-list-get-file-name 30 t))
- :titles guix-generation-list-titles
- :sort-key '(number . t)
- :marks '((delete . ?D)))
-
-
-;;; Interactive commands
-
-;;;###autoload
-(defun guix-system-generations ()
- "Display information about system generations."
- (interactive)
- (guix-system-generation-get-display 'all))
-
-;;;###autoload
-(defun guix-last-system-generations (number)
- "Display information about last NUMBER of system generations."
- (interactive "nThe number of last generations: ")
- (guix-system-generation-get-display 'last number))
-
-;;;###autoload
-(defun guix-system-generations-by-time (from to)
- "Display information about system generations created between FROM and TO."
- (interactive
- (list (guix-read-date "Find generations (from): ")
- (guix-read-date "Find generations (to): ")))
- (guix-system-generation-get-display
- 'time (float-time from) (float-time to)))
-
-(provide 'guix-ui-system-generation)
-
-;;; guix-ui-system-generation.el ends here
diff --git a/emacs/guix-ui.el b/emacs/guix-ui.el
deleted file mode 100644
index 1b696314cd..0000000000
--- a/emacs/guix-ui.el
+++ /dev/null
@@ -1,323 +0,0 @@
-;;; guix-ui.el --- Common code for Guix package management interface -*- lexical-binding: t -*-
-
-;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides some general code for 'list'/'info' interfaces for
-;; packages and generations.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'guix-backend)
-(require 'guix-buffer)
-(require 'guix-guile)
-(require 'guix-utils)
-(require 'guix-messages)
-(require 'guix-profiles)
-
-(guix-define-groups ui
- :group-doc "\
-Settings for 'ui' (Guix package management) buffers.
-This group includes settings for displaying packages, outputs and
-generations in 'list' and 'info' buffers.")
-
-(defvar guix-ui-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "M") 'guix-apply-manifest)
- (define-key map (kbd "C-c C-z") 'guix-switch-to-repl)
- map)
- "Parent keymap for Guix package/generation buffers.")
-
-(guix-buffer-define-current-args-accessors
- "guix-ui-current" "profile" "search-type" "search-values")
-
-(defun guix-ui-read-profile ()
- "Return `guix-current-profile' or prompt for it.
-This function is intended for using in `interactive' forms."
- (if current-prefix-arg
- (guix-profile-prompt)
- guix-current-profile))
-
-(defun guix-ui-get-entries (profile entry-type search-type search-values
- &optional params)
- "Receive ENTRY-TYPE entries for PROFILE.
-Call an appropriate scheme procedure and return a list of entries.
-
-ENTRY-TYPE should be one of the following symbols: `package',
-`output' or `generation'.
-
-SEARCH-TYPE may be one of the following symbols:
-
-- If ENTRY-TYPE is `package' or `output': `id', `name', `regexp',
- `all-available', `newest-available', `installed', `obsolete',
- `generation'.
-
-- If ENTRY-TYPE is `generation': `id', `last', `all', `time'.
-
-PARAMS is a list of parameters for receiving. If nil, get data
-with all available parameters."
- (guix-eval-read
- (guix-make-guile-expression
- 'entries
- profile params entry-type search-type search-values)))
-
-(defun guix-ui-list-describe (ids)
- "Describe 'ui' entries with IDS (list of identifiers)."
- (guix-buffer-get-display-entries
- 'info (guix-buffer-current-entry-type)
- (cl-list* (guix-ui-current-profile) 'id ids)
- 'add))
-
-
-;;; Buffers and auto updating
-
-(defcustom guix-ui-update-after-operation 'current
- "Define what kind of data to update after executing an operation.
-
-After successful executing an operation in the Guix REPL (for
-example after installing a package), the data in Guix buffers
-will or will not be automatically updated depending on a value of
-this variable.
-
-If nil, update nothing (do not revert any buffer).
-If `current', update the buffer from which an operation was performed.
-If `all', update all Guix buffers (not recommended)."
- :type '(choice (const :tag "Do nothing" nil)
- (const :tag "Update operation buffer" current)
- (const :tag "Update all Guix buffers" all))
- :group 'guix-ui)
-
-(defcustom guix-ui-buffer-name-function
- #'guix-ui-buffer-name-full
- "Function used to define a name of a Guix buffer.
-The function is called with 2 arguments: BASE-NAME and PROFILE."
- :type '(choice (function-item guix-ui-buffer-name-full)
- (function-item guix-ui-buffer-name-short)
- (function-item guix-ui-buffer-name-simple)
- (function :tag "Other function"))
- :group 'guix-ui)
-
-(defun guix-ui-buffer-name-simple (base-name &rest _)
- "Return BASE-NAME."
- base-name)
-
-(defun guix-ui-buffer-name-short (base-name profile)
- "Return buffer name by appending BASE-NAME and PROFILE's base file name."
- (guix-compose-buffer-name base-name
- (file-name-base (directory-file-name profile))))
-
-(defun guix-ui-buffer-name-full (base-name profile)
- "Return buffer name by appending BASE-NAME and PROFILE's full name."
- (guix-compose-buffer-name base-name profile))
-
-(defun guix-ui-buffer-name (base-name profile)
- "Return Guix buffer name based on BASE-NAME and profile.
-See `guix-ui-buffer-name-function' for details."
- (funcall guix-ui-buffer-name-function
- base-name profile))
-
-(defun guix-ui-buffer? (&optional buffer modes)
- "Return non-nil if BUFFER mode is derived from any of the MODES.
-If BUFFER is nil, check current buffer.
-If MODES is nil, use `guix-list-mode' and `guix-info-mode'."
- (with-current-buffer (or buffer (current-buffer))
- (apply #'derived-mode-p
- (or modes '(guix-list-mode guix-info-mode)))))
-
-(defun guix-ui-buffers (&optional modes)
- "Return a list of all buffers with major modes derived from MODES.
-If MODES is nil, return list of all Guix 'list' and 'info' buffers."
- (cl-remove-if-not (lambda (buf)
- (guix-ui-buffer? buf modes))
- (buffer-list)))
-
-(defun guix-ui-update-buffer (buffer)
- "Update data in a 'list' or 'info' BUFFER."
- (with-current-buffer buffer
- (guix-buffer-revert nil t)))
-
-(defun guix-ui-update-buffers-after-operation ()
- "Update buffers after Guix operation if needed.
-See `guix-ui-update-after-operation' for details."
- (let ((to-update
- (and guix-operation-buffer
- (cl-case guix-ui-update-after-operation
- (current (and (buffer-live-p guix-operation-buffer)
- (guix-ui-buffer? guix-operation-buffer)
- (list guix-operation-buffer)))
- (all (guix-ui-buffers))))))
- (setq guix-operation-buffer nil)
- (mapc #'guix-ui-update-buffer to-update)))
-
-(add-hook 'guix-after-repl-operation-hook
- 'guix-ui-update-buffers-after-operation)
-
-
-;;; Interface definers
-
-(defmacro guix-ui-define-entry-type (entry-type &rest args)
- "Define general code for ENTRY-TYPE.
-Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
-
-The rest keyword arguments are passed to
-`guix-define-entry-type' macro."
- (declare (indent 1))
- `(guix-define-entry-type ,entry-type
- :parent-group guix-ui
- :parent-faces-group guix-ui-faces
- ,@args))
-
-(defmacro guix-ui-define-interface (buffer-type entry-type &rest args)
- "Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries.
-Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
-In the following description TYPE means ENTRY-TYPE-BUFFER-TYPE.
-
-Required keywords:
-
- - `:buffer-name' - base part of a buffer name. It is used in a
- generated `guix-TYPE-buffer-name' function; see
- `guix-ui-buffer-name' for details.
-
-Optional keywords:
-
- - `:required' - default value of the generated
- `guix-TYPE-required-params' variable.
-
-The rest keyword arguments are passed to
-`guix-BUFFER-TYPE-define-interface' macro.
-
-Along with the mentioned definitions, this macro also defines:
-
- - `guix-TYPE-mode-map' - keymap based on `guix-ui-map' and
- `guix-BUFFER-TYPE-mode-map'.
-
- - `guix-TYPE-get-entries' - a wrapper around `guix-ui-get-entries'.
-
- - `guix-TYPE-message' - a wrapper around `guix-result-message'."
- (declare (indent 2))
- (let* ((entry-type-str (symbol-name entry-type))
- (buffer-type-str (symbol-name buffer-type))
- (prefix (concat "guix-" entry-type-str "-"
- buffer-type-str))
- (mode-str (concat prefix "-mode"))
- (mode-map (intern (concat mode-str "-map")))
- (parent-map (intern (format "guix-%s-mode-map"
- buffer-type-str)))
- (required-var (intern (concat prefix "-required-params")))
- (buffer-name-fun (intern (concat prefix "-buffer-name")))
- (get-fun (intern (concat prefix "-get-entries")))
- (message-fun (intern (concat prefix "-message")))
- (displayed-fun (intern (format "guix-%s-displayed-params"
- buffer-type-str)))
- (definer (intern (format "guix-%s-define-interface"
- buffer-type-str))))
- (guix-keyword-args-let args
- ((buffer-name-val :buffer-name)
- (required-val :required ''(id)))
- `(progn
- (defvar ,mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent
- map (make-composed-keymap ,parent-map guix-ui-map))
- map)
- ,(format "Keymap for `%s' buffers." mode-str))
-
- (defvar ,required-var ,required-val
- ,(format "\
-List of the required '%s' parameters.
-These parameters are received by `%S'
-along with the displayed parameters.
-
-Do not remove `id' from this list as it is required for
-identifying an entry."
- entry-type-str get-fun))
-
- (defun ,buffer-name-fun (profile &rest _)
- ,(format "\
-Return a name of '%s' buffer for displaying '%s' entries.
-See `guix-ui-buffer-name' for details."
- buffer-type-str entry-type-str)
- (guix-ui-buffer-name ,buffer-name-val profile))
-
- (defun ,get-fun (profile search-type &rest search-values)
- ,(format "\
-Receive '%s' entries for displaying them in '%s' buffer.
-See `guix-ui-get-entries' for details."
- entry-type-str buffer-type-str)
- (guix-ui-get-entries
- profile ',entry-type search-type search-values
- (cl-union ,required-var
- (,displayed-fun ',entry-type))))
-
- (defun ,message-fun (entries profile search-type
- &rest search-values)
- ,(format "\
-Display a message after showing '%s' entries."
- entry-type-str)
- (guix-result-message
- profile entries ',entry-type search-type search-values))
-
- (,definer ,entry-type
- :get-entries-function ',get-fun
- :message-function ',message-fun
- :buffer-name ',buffer-name-fun
- ,@%foreign-args)))))
-
-(defmacro guix-ui-info-define-interface (entry-type &rest args)
- "Define 'info' interface for displaying ENTRY-TYPE entries.
-See `guix-ui-define-interface'."
- (declare (indent 1))
- `(guix-ui-define-interface info ,entry-type
- ,@args))
-
-(defmacro guix-ui-list-define-interface (entry-type &rest args)
- "Define 'list' interface for displaying ENTRY-TYPE entries.
-Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
-
-Optional keywords:
-
- - `:describe-function' - default value of the generated
- `guix-ENTRY-TYPE-list-describe-function' variable (if not
- specified, use `guix-ui-list-describe').
-
-The rest keyword arguments are passed to
-`guix-ui-define-interface' macro."
- (declare (indent 1))
- (guix-keyword-args-let args
- ((describe-val :describe-function))
- `(guix-ui-define-interface list ,entry-type
- :describe-function ,(or describe-val ''guix-ui-list-describe)
- ,@args)))
-
-
-(defvar guix-ui-font-lock-keywords
- (eval-when-compile
- `((,(rx "(" (group (or "guix-ui-define-entry-type"
- "guix-ui-define-interface"
- "guix-ui-info-define-interface"
- "guix-ui-list-define-interface"))
- symbol-end)
- . 1))))
-
-(font-lock-add-keywords 'emacs-lisp-mode guix-ui-font-lock-keywords)
-
-(provide 'guix-ui)
-
-;;; guix-ui.el ends here
diff --git a/emacs/guix-utils.el b/emacs/guix-utils.el
deleted file mode 100644
index 3e4ecc36ab..0000000000
--- a/emacs/guix-utils.el
+++ /dev/null
@@ -1,609 +0,0 @@
-;;; guix-utils.el --- General utility functions -*- lexical-binding: t -*-
-
-;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
-
-;; This file is part of GNU Guix.
-
-;; GNU 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.
-
-;; GNU 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides auxiliary general functions for guix.el package.
-
-;;; Code:
-
-(require 'cl-lib)
-
-(defvar guix-true-string "Yes")
-(defvar guix-false-string "–")
-(defvar guix-list-separator ", ")
-
-(defvar guix-time-format "%F %T"
- "String used to format time values.
-For possible formats, see `format-time-string'.")
-
-(defun guix-get-string (val &optional face)
- "Convert VAL into a string and return it.
-
-VAL can be an expression of any type.
-If VAL is t/nil, it is replaced with
-`guix-true-string'/`guix-false-string'.
-If VAL is list, its elements are concatenated using
-`guix-list-separator'.
-
-If FACE is non-nil, propertize returned string with this FACE."
- (let ((str (cond
- ((stringp val) val)
- ((null val) guix-false-string)
- ((eq t val) guix-true-string)
- ((numberp val) (number-to-string val))
- ((listp val) (mapconcat #'guix-get-string
- val guix-list-separator))
- (t (prin1-to-string val)))))
- (if (and val face)
- (propertize str 'font-lock-face face)
- str)))
-
-(defun guix-get-time-string (seconds)
- "Return formatted time string from SECONDS.
-Use `guix-time-format'."
- (format-time-string guix-time-format (seconds-to-time seconds)))
-
-(defun guix-get-one-line (str)
- "Return one-line string from a multi-line STR."
- (replace-regexp-in-string "\n" " " str))
-
-(defmacro guix-with-indent (indent &rest body)
- "Evaluate BODY and indent inserted text by INDENT number of spaces."
- (declare (indent 1) (debug t))
- (let ((region-beg-var (make-symbol "region-beg"))
- (indent-var (make-symbol "indent")))
- `(let ((,region-beg-var (point))
- (,indent-var ,indent))
- ,@body
- (unless (zerop ,indent-var)
- (indent-rigidly ,region-beg-var (point) ,indent-var)))))
-
-(defun guix-format-insert (val &optional face format)
- "Convert VAL into a string and insert it at point.
-If FACE is non-nil, propertize VAL with FACE.
-If FORMAT is non-nil, format VAL with FORMAT."
- (let ((str (guix-get-string val face)))
- (insert (if format
- (format format str)
- str))))
-
-(cl-defun guix-mapinsert (function sequence separator &key indent column)
- "Like `mapconcat' but for inserting text.
-Apply FUNCTION to each element of SEQUENCE, and insert SEPARATOR
-at point between each FUNCTION call.
-
-If INDENT is non-nil, it should be a number of spaces used to
-indent each line of the inserted text.
-
-If COLUMN is non-nil, it should be a column number which
-shouldn't be exceeded by the inserted text."
- (pcase sequence
- (`(,first . ,rest)
- (let* ((indent (or indent 0))
- (max-column (and column (- column indent))))
- (guix-with-indent indent
- (funcall function first)
- (dolist (element rest)
- (let ((before-sep-pos (and column (point))))
- (insert separator)
- (let ((after-sep-pos (and column (point))))
- (funcall function element)
- (when (and column
- (> (current-column) max-column))
- (save-excursion
- (delete-region before-sep-pos after-sep-pos)
- (goto-char before-sep-pos)
- (insert "\n")))))))))))
-
-(defun guix-insert-button (label &optional type &rest properties)
- "Make button of TYPE with LABEL and insert it at point.
-See `insert-text-button' for the meaning of PROPERTIES."
- (if (null label)
- (guix-format-insert nil)
- (apply #'insert-text-button label
- :type (or type 'button)
- properties)))
-
-(defun guix-buttonize (value button-type separator &rest properties)
- "Make BUTTON-TYPE button(s) from VALUE.
-Return a string with button(s).
-
-VALUE should be a string or a list of strings. If it is a list
-of strings, buttons are separated with SEPARATOR string.
-
-PROPERTIES are passed to `guix-insert-button'."
- (with-temp-buffer
- (let ((labels (if (listp value) value (list value))))
- (guix-mapinsert (lambda (label)
- (apply #'guix-insert-button
- label button-type properties))
- labels
- separator))
- (buffer-substring (point-min) (point-max))))
-
-(defun guix-button-type? (symbol)
- "Return non-nil, if SYMBOL is a button type."
- (and symbol
- (get symbol 'button-category-symbol)))
-
-(defun guix-split-insert (val &optional face col separator)
- "Convert VAL into a string, split it and insert at point.
-
-If FACE is non-nil, propertize returned string with this FACE.
-
-If COL is non-nil and result string is a one-line string longer
-than COL, split it into several short lines.
-
-Separate inserted lines with SEPARATOR."
- (if (null val)
- (guix-format-insert nil)
- (let ((strings (guix-split-string (guix-get-string val) col)))
- (guix-mapinsert (lambda (str) (guix-format-insert str face))
- strings
- (or separator "")))))
-
-(defun guix-split-string (str &optional col)
- "Split string STR by lines and return list of result strings.
-If COL is non-nil, fill STR to this column."
- (let ((str (if col
- (guix-get-filled-string str col)
- str)))
- (split-string str "\n *" t)))
-
-(defun guix-get-filled-string (str col)
- "Return string by filling STR to column COL."
- (with-temp-buffer
- (insert str)
- (let ((fill-column col))
- (fill-region (point-min) (point-max)))
- (buffer-string)))
-
-(defun guix-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 guix-hexify (value)
- "Convert VALUE to string and hexify it."
- (url-hexify-string (guix-get-string value)))
-
-(defun guix-number->bool (number)
- "Convert NUMBER to boolean value.
-Return nil, if NUMBER is 0; return t otherwise."
- (not (zerop number)))
-
-(defun guix-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 guix-symbol-title (symbol)
- "Return SYMBOL's name, a string.
-This is like `symbol-name', but fancier."
- (if (eq symbol 'id)
- "ID"
- (let ((str (replace-regexp-in-string "-" " " (symbol-name symbol))))
- (concat (capitalize (substring str 0 1))
- (substring str 1)))))
-
-(defun guix-command-symbol (&optional args)
- "Return symbol by concatenating 'guix' and ARGS (strings)."
- (intern (guix-concat-strings (cons "guix" args) "-")))
-
-(defun guix-command-string (&optional args)
- "Return 'guix ARGS ...' string with quoted shell arguments."
- (let ((args (mapcar #'guix-shell-quote-argument args)))
- (guix-concat-strings (cons "guix" args) " ")))
-
-(defun guix-copy-as-kill (string &optional no-message?)
- "Put STRING into `kill-ring'.
-If NO-MESSAGE? is non-nil, do not display a message about it."
- (kill-new string)
- (unless no-message?
- (message "'%s' has been added to kill ring." string)))
-
-(defun guix-copy-command-as-kill (args &optional no-message?)
- "Put 'guix ARGS ...' string into `kill-ring'.
-See also `guix-copy-as-kill'."
- (guix-copy-as-kill (guix-command-string args) no-message?))
-
-(defun guix-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 guix-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 guix-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 guix-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))
-
-(defun guix-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 guix-find-file-function #'find-file
- "Function used to find a file.
-The function is called by `guix-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 'guix)
-
-(defun guix-find-file (file)
- "Find FILE if it exists."
- (if (file-exists-p file)
- (funcall guix-find-file-function file)
- (message "File '%s' does not exist." file)))
-
-(defvar url-handler-regexp)
-
-(defun guix-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)))
-
-(defmacro guix-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 guix-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 guix-modify (object 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
- (guix-modify (funcall (car modifiers) object)
- (cdr modifiers))))
-
-(defmacro guix-keyword-args-let (args varlist &rest body)
- "Parse ARGS, bind variables from VARLIST and eval BODY.
-
-Find keyword values in ARGS, bind them to variables according to
-VARLIST, then evaluate BODY.
-
-ARGS is a keyword/value property list.
-
-Each element of VARLIST has a form:
-
- (SYMBOL KEYWORD [DEFAULT-VALUE])
-
-SYMBOL is a varible name. KEYWORD is a symbol that will be
-searched in ARGS for an according value. If the value of KEYWORD
-does not exist, bind SYMBOL to DEFAULT-VALUE or nil.
-
-The rest arguments (that present in ARGS but not in VARLIST) will
-be bound to `%foreign-args' variable.
-
-Example:
-
- (guix-keyword-args-let '(:two 8 :great ! :guix is)
- ((one :one 1)
- (two :two 2)
- (foo :smth))
- (list one two foo %foreign-args))
-
- => (1 8 nil (:guix is :great !))"
- (declare (indent 2))
- (let ((args-var (make-symbol "args")))
- `(let (,@(mapcar (lambda (spec)
- (pcase-let ((`(,name ,_ ,val) spec))
- (list name val)))
- varlist)
- (,args-var ,args)
- %foreign-args)
- (while ,args-var
- (pcase ,args-var
- (`(,key ,val . ,rest-args)
- (cl-case key
- ,@(mapcar (lambda (spec)
- (pcase-let ((`(,name ,key ,_) spec))
- `(,key (setq ,name val))))
- varlist)
- (t (setq %foreign-args
- (cl-list* key val %foreign-args))))
- (setq ,args-var rest-args))))
- ,@body)))
-
-
-;;; Alist procedures
-
-(defmacro guix-define-alist-accessor (name assoc-fun)
- "Define NAME function to access alist values using ASSOC-FUN."
- `(defun ,name (alist &rest keys)
- ,(format "Return value from ALIST by KEYS using `%s'.
-ALIST is alist of alists of alists ... which can be consecutively
-accessed with KEYS."
- assoc-fun)
- (if (or (null alist) (null keys))
- alist
- (apply #',name
- (cdr (,assoc-fun (car keys) alist))
- (cdr keys)))))
-
-(guix-define-alist-accessor guix-assq-value assq)
-(guix-define-alist-accessor guix-assoc-value assoc)
-
-(defun guix-alist-put (value alist &rest keys)
- "Put (add or replace if exists) VALUE to ALIST using KEYS.
-Return the new alist.
-
-ALIST is alist of alists of alists ... which can be consecutively
-accessed with KEYS.
-
-Example:
-
- (guix-alist-put
- 'foo
- '((one (a . 1) (b . 2))
- (two (m . 7) (n . 8)))
- 'one 'b)
-
- => ((one (a . 1) (b . foo))
- (two (m . 7) (n . 8)))"
- (or keys (error "Keys should be specified"))
- (guix-alist-put-1 value alist keys))
-
-(defun guix-alist-put-1 (value alist keys)
- "Subroutine of `guix-alist-put'."
- (cond
- ((null keys)
- value)
- ((null alist)
- (list (cons (car keys)
- (guix-alist-put-1 value nil (cdr keys)))))
- ((eq (car keys) (caar alist))
- (cons (cons (car keys)
- (guix-alist-put-1 value (cdar alist) (cdr keys)))
- (cdr alist)))
- (t
- (cons (car alist)
- (guix-alist-put-1 value (cdr alist) keys)))))
-
-(defun guix-alist-put! (value variable &rest keys)
- "Modify alist VARIABLE (symbol) by putting VALUE using KEYS.
-See `guix-alist-put' for details."
- (set variable
- (apply #'guix-alist-put value (symbol-value variable) keys)))
-
-
-;;; Diff
-
-(defvar guix-diff-switches "-u"
- "A string or list of strings specifying switches to be passed to diff.")
-
-(defun guix-diff (old new &optional switches no-async)
- "Same as `diff', but use `guix-diff-switches' as default."
- (diff old new (or switches guix-diff-switches) no-async))
-
-
-;;; Completing readers definers
-
-(defmacro guix-define-reader (name read-fun completions prompt)
- "Define NAME function to read from minibuffer.
-READ-FUN may be `completing-read', `completing-read-multiple' or
-another function with the same arguments."
- `(defun ,name (&optional prompt initial-contents)
- (,read-fun ,(if prompt
- `(or prompt ,prompt)
- 'prompt)
- ,completions nil nil initial-contents)))
-
-(defmacro guix-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.
-
- - `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."
- (guix-keyword-args-let args
- ((completions-var :completions-var)
- (completions-getter :completions-getter)
- (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
- `(guix-define-reader ,single-reader guix-completing-read
- ,completions ,single-prompt))
-
- ,(when multiple-reader
- `(guix-define-reader ,multiple-reader completing-read-multiple
- ,completions ,multiple-prompt))
-
- ,(when (and multiple-reader multiple-separator)
- (let ((name (intern (concat (symbol-name multiple-reader)
- "-string"))))
- `(defun ,name (&optional prompt initial-contents)
- (guix-concat-strings
- (,multiple-reader prompt initial-contents)
- ,multiple-separator))))))))
-
-
-;;; Memoizing
-
-(defun guix-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 guix-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
- (guix-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 `guix-memoize' returns a lambda with '(&rest
- ;; args)').
- ,(format "(%S %s)\n\n%s"
- name
- (mapconcat #'symbol-name arglist " ")
- docstring)))
-
-(defmacro guix-memoized-defalias (symbol definition &optional docstring)
- "Set SYMBOL's function definition to memoized version of DEFINITION."
- (declare (doc-string 3) (indent 1))
- `(defalias ',symbol
- (guix-memoize #',definition)
- ,(or docstring
- (format "Memoized version of `%S'." definition))))
-
-
-(defvar guix-utils-font-lock-keywords
- (eval-when-compile
- `((,(rx "(" (group (or "guix-define-reader"
- "guix-define-readers"
- "guix-keyword-args-let"
- "guix-while-null"
- "guix-while-search"
- "guix-with-indent"))
- symbol-end)
- . 1)
- (,(rx "("
- (group "guix-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 guix-utils-font-lock-keywords)
-
-(provide 'guix-utils)
-
-;;; guix-utils.el ends here
diff --git a/emacs/local.mk b/emacs/local.mk
deleted file mode 100644
index 959ec2dd34..0000000000
--- a/emacs/local.mk
+++ /dev/null
@@ -1,77 +0,0 @@
-# GNU Guix --- Functional package management for GNU
-# Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
-# Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
-#
-# This file is part of GNU Guix.
-#
-# GNU 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.
-#
-# GNU 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
-
-AUTOLOADS = %D%/guix-autoloads.el
-
-ELFILES = \
- %D%/guix-about.el \
- %D%/guix-backend.el \
- %D%/guix-base.el \
- %D%/guix-build-log.el \
- %D%/guix-buffer.el \
- %D%/guix-command.el \
- %D%/guix-devel.el \
- %D%/guix-emacs.el \
- %D%/guix-entry.el \
- %D%/guix-external.el \
- %D%/guix-geiser.el \
- %D%/guix-guile.el \
- %D%/guix-help-vars.el \
- %D%/guix-history.el \
- %D%/guix-hydra.el \
- %D%/guix-hydra-build.el \
- %D%/guix-hydra-jobset.el \
- %D%/guix-info.el \
- %D%/guix-init.el \
- %D%/guix-license.el \
- %D%/guix-list.el \
- %D%/guix-location.el \
- %D%/guix-messages.el \
- %D%/guix-pcomplete.el \
- %D%/guix-popup.el \
- %D%/guix-prettify.el \
- %D%/guix-profiles.el \
- %D%/guix-read.el \
- %D%/guix-ui.el \
- %D%/guix-ui-license.el \
- %D%/guix-ui-location.el \
- %D%/guix-ui-package.el \
- %D%/guix-ui-generation.el \
- %D%/guix-ui-system-generation.el \
- %D%/guix-utils.el
-
-if HAVE_EMACS
-
-dist_lisp_DATA = $(ELFILES)
-
-nodist_lisp_DATA = \
- %D%/guix-config.el \
- $(AUTOLOADS)
-
-$(AUTOLOADS): $(ELFILES)
- $(AM_V_EMACS)$(EMACS) --batch --eval \
- "(let ((backup-inhibited t) \
- (generated-autoload-file \
- (expand-file-name \"$(AUTOLOADS)\" \"$(builddir)\"))) \
- (update-directory-autoloads \
- (expand-file-name \"emacs\" \"$(srcdir)\")))"
-
-CLEANFILES += $(AUTOLOADS)
-
-endif HAVE_EMACS