From b26365186045530eadb5027087a37ca1a440aee9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 29 Aug 2015 23:37:33 +0200 Subject: doc: Mention the "normalized codeset" used in locale names. * doc/guix.texi (Locales): Introduce "codeset". <%default-locale-definitions>: Mention the "normalized codeset", with an xref to libc's manual. * gnu/system/locale.scm (%default-locale-definitions)[utf8-locale]: Mention the "normalized codeset" in a comment. --- doc/guix.texi | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index f69440c325..5a9ebc93f8 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5477,7 +5477,7 @@ special-case and is automatically added whether or not it is specified. A @dfn{locale} defines cultural conventions for a particular language and region of the world (@pxref{Locales,,, libc, The GNU C Library Reference Manual}). Each locale has a name that typically has the form -@code{@var{language}_@var{territory}.@var{charset}}---e.g., +@code{@var{language}_@var{territory}.@var{codeset}}---e.g., @code{fr_LU.utf8} designates the locale for the French language, with cultural conventions from Luxembourg, and using the UTF-8 encoding. @@ -5538,9 +5538,17 @@ IANA}. @end deftp @defvr {Scheme Variable} %default-locale-definitions -An arbitrary list of commonly used locales, used as the default value of -the @code{locale-definitions} field of @code{operating-system} +An arbitrary list of commonly used UTF-8 locales, used as the default +value of the @code{locale-definitions} field of @code{operating-system} declarations. + +@cindex locale name +@cindex normalized codeset in locale names +These locale definitions use the @dfn{normalized codeset} for the part +that follows the dot in the name (@pxref{Using gettextized software, +normalized codeset,, libc, The GNU C Library Reference Manual}). So for +instance it has @code{uk_UA.utf8} but @emph{not}, say, +@code{uk_UA.UTF-8}. @end defvr @node Services -- cgit 1.4.1 From c554de892901e1375d55fa953855a01c32154189 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Thu, 13 Aug 2015 20:16:29 +0300 Subject: doc: Reorganize "Emacs Interface" node. * doc/guix.texi (Package Management): Move "Emacs Interface" node to ... (Top): ...here, since it is not just about package management. * doc/emacs.texi: Shift all nodes one level up (@section -> @chapter, etc.). Rename "Emacs Usage" node into "Emacs Package Management". Move "Emacs Configuration" node here. --- doc/emacs.texi | 58 ++++++++++++++++++++++++++++++---------------------------- doc/guix.texi | 20 +++++++++++++------- 2 files changed, 43 insertions(+), 35 deletions(-) (limited to 'doc') diff --git a/doc/emacs.texi b/doc/emacs.texi index 180037a88f..5fa15d7783 100644 --- a/doc/emacs.texi +++ b/doc/emacs.texi @@ -1,29 +1,21 @@ @node Emacs Interface -@section Emacs Interface +@chapter Emacs Interface @cindex Emacs -GNU Guix comes with a visual user interface for GNU@tie{}Emacs, known -as ``guix.el''. It can be used for routine package management tasks, -pretty much like the @command{guix package} command (@pxref{Invoking -guix package}). Specifically, ``guix.el'' makes it easy to: - -@itemize -@item browse and display packages and generations; -@item search, install, upgrade and remove packages; -@item display packages from previous generations; -@item do some other useful things. -@end itemize +GNU Guix comes with several useful modules (known as ``guix.el'') for +GNU@tie{}Emacs which are intended to make an Emacs user interaction with +Guix convenient and fun. @menu * Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}. -* Usage: Emacs Usage. Using the interface. -* Configuration: Emacs Configuration. Configuring the interface. +* Package Management: Emacs Package Management. Managing packages and generations. * Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names. * Completions: Emacs Completions. Completing @command{guix} shell command. @end menu + @node Emacs Initial Setup -@subsection Initial Setup +@section Initial Setup On the Guix System Distribution (@pxref{GNU Distribution}), ``guix.el'' is ready to use, provided Guix is installed system-wide, which is the @@ -105,22 +97,32 @@ emacs, The GNU Emacs Manual}). You can activate Emacs packages installed in your profile whenever you want using @kbd{M-x@tie{}guix-emacs-load-autoloads}. -@node Emacs Usage -@subsection Usage + +@node Emacs Package Management +@section Package Management Once ``guix.el'' has been successfully configured, you should be able to -use commands for displaying packages and generations. This information -can be displayed in a ``list'' or ``info'' buffer. +use a visual interface for routine package management tasks, pretty much +like the @command{guix package} command (@pxref{Invoking guix package}). +Specifically, it makes it easy to: + +@itemize +@item browse and display packages and generations; +@item search, install, upgrade and remove packages; +@item display packages from previous generations; +@item do some other useful things. +@end itemize @menu * Commands: Emacs Commands. @kbd{M-x guix-@dots{}} * General information: Emacs General info. Common for both interfaces. * ``List'' buffer: Emacs List buffer. List-like interface. * ``Info'' buffer: Emacs Info buffer. Help-like interface. +* Configuration: Emacs Configuration. Configuring the interface. @end menu @node Emacs Commands -@subsubsection Commands +@subsection Commands All commands for displaying packages and generations use the current profile, which can be changed with @@ -191,7 +193,7 @@ Once @command{guix pull} has succeeded, the Guix REPL is restared. This allows you to keep using the Emacs interface with the updated Guix. @node Emacs General info -@subsubsection General information +@subsection General information The following keys are available for both ``list'' and ``info'' types of buffers: @@ -235,7 +237,7 @@ was restarted, you may want to revert ``list'' buffer (by pressing @kbd{g}). @node Emacs List buffer -@subsubsection ``List'' buffer +@subsection ``List'' buffer An interface of a ``list'' buffer is similar to the interface provided by ``package.el'' (@pxref{Package Menu,,, emacs, The GNU Emacs Manual}). @@ -310,7 +312,7 @@ with another marked generation. @end table @node Emacs Info buffer -@subsubsection ``Info'' buffer +@subsection ``Info'' buffer The interface of an ``info'' buffer is similar to the interface of @code{help-mode} (@pxref{Help Mode,,, emacs, The GNU Emacs Manual}). @@ -485,11 +487,11 @@ Various settings for ``info'' buffers. @node Emacs Prettify -@subsection Guix Prettify Mode +@section Guix Prettify Mode -Along with ``guix.el'', GNU@tie{}Guix comes with ``guix-prettify.el''. -It provides a minor mode for abbreviating store file names by replacing -hash sequences of symbols with ``@dots{}'': +GNU@tie{}Guix also comes with ``guix-prettify.el''. It provides a minor +mode for abbreviating store file names by replacing hash sequences of +symbols with ``@dots{}'': @example /gnu/store/72f54nfp6g1hz873w8z3gfcah0h4nl9p-foo-0.1 @@ -526,7 +528,7 @@ mode hooks (@pxref{Hooks,,, emacs, The GNU Emacs Manual}), for example: @node Emacs Completions -@subsection Shell Completions +@section Shell Completions Another feature that becomes available after configuring Emacs interface (@pxref{Emacs Initial Setup}) is completing of @command{guix} diff --git a/doc/guix.texi b/doc/guix.texi index 5a9ebc93f8..cb5bbab2a0 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -70,6 +70,7 @@ package management tool written for the GNU system. * Introduction:: What is Guix about? * Installation:: Installing Guix. * Package Management:: Package installation, upgrade, etc. +* Emacs Interface:: Using Guix from Emacs. * Programming Interface:: Using Guix in Scheme. * Utilities:: Package management commands. * GNU Distribution:: Software for your friendly GNU system. @@ -101,13 +102,19 @@ Package Management * Features:: How Guix will make your life brighter. * Invoking guix package:: Package installation, removal, etc. -* Emacs Interface:: Package management from Emacs. * Substitutes:: Downloading pre-built binaries. * Packages with Multiple Outputs:: Single source package, multiple outputs. * Invoking guix gc:: Running the garbage collector. * Invoking guix pull:: Fetching the latest Guix and distribution. * Invoking guix archive:: Exporting and importing store files. +Emacs Interface + +* Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}. +* Package Management: Emacs Package Management. Managing packages and generations. +* Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names. +* Completions: Emacs Completions. Completing @command{guix} shell command. + Programming Interface * Defining Packages:: Defining new packages. @@ -964,14 +971,13 @@ features. This chapter describes the main features of Guix, as well as the package management tools it provides. Two user interfaces are provided for -routine package management tasks: a command-line interface -(@pxref{Invoking guix package, @code{guix package}}), and a visual user -interface in Emacs (@pxref{Emacs Interface}). +routine package management tasks: A command-line interface described below +(@pxref{Invoking guix package, @code{guix package}}), as well as a visual user +interface in Emacs described in a subsequent chapter (@pxref{Emacs Interface}). @menu * Features:: How Guix will make your life brighter. * Invoking guix package:: Package installation, removal, etc. -* Emacs Interface:: Package management from Emacs. * Substitutes:: Downloading pre-built binaries. * Packages with Multiple Outputs:: Single source package, multiple outputs. * Invoking guix gc:: Running the garbage collector. @@ -1455,8 +1461,6 @@ Finally, since @command{guix package} may actually start build processes, it supports all the common build options that @command{guix build} supports (@pxref{Invoking guix build, common build options}). -@include emacs.texi - @node Substitutes @section Substitutes @@ -1898,6 +1902,8 @@ automatically builds them. The build process may be controlled with the same options that can be passed to the @command{guix build} command (@pxref{Invoking guix build, common build options}). +@c ********************************************************************* +@include emacs.texi @c ********************************************************************* @node Programming Interface -- cgit 1.4.1 From 9b0afb0d289c58233bbc1764097b88e7fab3724f Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Fri, 14 Aug 2015 10:47:10 +0300 Subject: emacs: Add popup interface for guix commands. * emacs/guix-command.el: New file. * emacs.am (ELFILES): Add it. * doc/emacs.texi (Emacs Initial Setup): Mention 'magit-popup' library. (Emacs Popup Interface): New node. (Emacs Interface): Add it. * doc/guix.texi (Top): Likewise. --- doc/emacs.texi | 44 ++++ doc/guix.texi | 1 + emacs.am | 1 + emacs/guix-command.el | 649 ++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 695 insertions(+) create mode 100644 emacs/guix-command.el (limited to 'doc') diff --git a/doc/emacs.texi b/doc/emacs.texi index 5fa15d7783..db2e657d27 100644 --- a/doc/emacs.texi +++ b/doc/emacs.texi @@ -9,6 +9,7 @@ Guix convenient and fun. @menu * Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}. * Package Management: Emacs Package Management. Managing packages and generations. +* Popup Interface: Emacs Popup Interface. Magit-like interface for guix commands. * Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names. * Completions: Emacs Completions. Completing @command{guix} shell command. @end menu @@ -35,6 +36,12 @@ later; @uref{http://nongnu.org/geiser/, Geiser}, version 0.3 or later: it is used for interacting with the Guile process. +@item +@uref{https://github.com/magit/magit/, magit-popup library}. You +already have this library if you use Magit 2.1.0 or later. This library +is an optional dependency---it is required only for @kbd{M-x@tie{}guix} +command (@pxref{Emacs Popup Interface}). + @end itemize When it is done ``guix.el'' may be configured by requiring a special @@ -486,6 +493,43 @@ Various settings for ``info'' buffers. @end table +@node Emacs Popup Interface +@section Popup Interface + +If you ever used Magit, you know what ``popup interface'' is +(@pxref{Top,,, magit-popup, Magit-Popup User Manual}). Even if you are +not acquainted with Magit, there should be no worries as it is very +intuitive. + +So @kbd{M-x@tie{}guix} command provides a top-level popup interface for +all available guix commands. When you select an option, you'll be +prompted for a value in the minibuffer. Many values have completions, +so don't hesitate to press @key{TAB} key. Multiple values (for example, +packages or lint checkers) should be separated by commas. + +After specifying all options and switches for a command, you may choose +one of the available actions. The following default actions are +available for all commands: + +@itemize + +@item +Run the command in the Guix REPL. It is faster than running +@code{guix@tie{}@dots{}} command directly in shell, as there is no +need to run another guile process and to load required modules there. + +@item +Run the command in a shell buffer. You can set +@code{guix-run-in-shell-function} variable to fine tune the shell buffer +you want to use. + +@item +Add the command line to the kill ring (@pxref{Kill Ring,,, emacs, The +GNU Emacs Manual}). + +@end itemize + + @node Emacs Prettify @section Guix Prettify Mode diff --git a/doc/guix.texi b/doc/guix.texi index cb5bbab2a0..89291273c4 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -112,6 +112,7 @@ Emacs Interface * Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}. * Package Management: Emacs Package Management. Managing packages and generations. +* Popup Interface: Emacs Popup Interface. Magit-like interface for guix commands. * Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names. * Completions: Emacs Completions. Completing @command{guix} shell command. diff --git a/emacs.am b/emacs.am index e3f2001e8f..bf91cca0bb 100644 --- a/emacs.am +++ b/emacs.am @@ -21,6 +21,7 @@ AUTOLOADS = emacs/guix-autoloads.el ELFILES = \ emacs/guix-backend.el \ emacs/guix-base.el \ + emacs/guix-command.el \ emacs/guix-emacs.el \ emacs/guix-help-vars.el \ emacs/guix-history.el \ diff --git a/emacs/guix-command.el b/emacs/guix-command.el new file mode 100644 index 0000000000..97a88726df --- /dev/null +++ b/emacs/guix-command.el @@ -0,0 +1,649 @@ +;;; guix-command.el --- Popup interface for guix commands -*- lexical-binding: t -*- + +;; Copyright © 2015 Alex Kost + +;; 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 . + +;;; 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) + +(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 + '(("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))) + +(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) + ("--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 + '(("--exec" :fun read-shell-command) + ("--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-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) + ("--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) + ("--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 + '(("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" "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 (guix-any (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" "graph" "edit" + "environment" "lint" "refresh")) + (argument :doc "Packages" :fun 'guix-read-package-names-string)) + ((string= command "download") + (argument :doc "URL")) + ((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")))))) + +(defun guix-command-additional-arguments (&optional commands) + "Return additional arguments for COMMANDS." + (let ((rest-arg (guix-command-rest-argument 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)) + +(defun guix-command-post-process-args (args) + "Adjust appropriately command line ARGS returned from popup command." + ;; XXX We need to split "--install foo bar" and similar strings into + ;; lists of strings. But some commands (e.g., 'guix hash') accept a + ;; file name as the 'rest' argument, and as file names may contain + ;; spaces, splitting by spaces will break such names. For example, the + ;; following argument: "-- /tmp/file with spaces" will be transformed + ;; into the following list: ("--" "/tmp/file" "with" "spaces") instead + ;; of the wished ("--" "/tmp/file with spaces"). + (let* (rest + (rx (rx string-start + (or "-- " "--install " "--remove "))) + (args (mapcar (lambda (arg) + (if (string-match-p rx arg) + (progn (push (split-string arg) rest) + nil) + arg)) + args))) + (if rest + (apply #'append (delq nil args) rest) + args))) + + +;;; '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 + nil + "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))) + "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)) + + +;;; 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 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) + + +(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 -- cgit 1.4.1 From e1248602f92c45a731e47e74d3612bee03eaa0da Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Fri, 24 Jul 2015 16:49:57 +0200 Subject: import: Add 'cran' importer. * guix/import/cran.scm: New file. * guix/scripts/import.scm: Add "cran" to 'importers'. * guix/scripts/import/cran.scm: New file. * tests/cran.scm: New file. * Makefile.am (MODULES): Add 'guix/import/cran.scm' and 'guix/scripts/import/cran.scm'. (SCM_TESTS): Add 'tests/cran.scm'. * doc/guix.texi (Invoking guix import): Document it. * po/guix/POTFILES.in: Add 'guix/scripts/import/cran.scm'. --- Makefile.am | 3 + doc/guix.texi | 15 ++++ guix/import/cran.scm | 188 +++++++++++++++++++++++++++++++++++++++++++ guix/scripts/import.scm | 2 +- guix/scripts/import/cran.scm | 92 +++++++++++++++++++++ tests/cran.scm | 178 ++++++++++++++++++++++++++++++++++++++++ 6 files changed, 477 insertions(+), 1 deletion(-) create mode 100644 guix/import/cran.scm create mode 100644 guix/scripts/import/cran.scm create mode 100644 tests/cran.scm (limited to 'doc') diff --git a/Makefile.am b/Makefile.am index 85cc7bd50f..af41ea57c8 100644 --- a/Makefile.am +++ b/Makefile.am @@ -97,6 +97,7 @@ MODULES = \ guix/import/gnu.scm \ guix/import/snix.scm \ guix/import/cabal.scm \ + guix/import/cran.scm \ guix/import/hackage.scm \ guix/import/elpa.scm \ guix/scripts/download.scm \ @@ -112,6 +113,7 @@ MODULES = \ guix/scripts/refresh.scm \ guix/scripts/system.scm \ guix/scripts/lint.scm \ + guix/scripts/import/cran.scm \ guix/scripts/import/gnu.scm \ guix/scripts/import/nix.scm \ guix/scripts/import/hackage.scm \ @@ -198,6 +200,7 @@ SCM_TESTS = \ tests/packages.scm \ tests/snix.scm \ tests/hackage.scm \ + tests/cran.scm \ tests/elpa.scm \ tests/store.scm \ tests/monads.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 89291273c4..4dbedb15ec 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3939,6 +3939,21 @@ Perl module: guix import cpan Acme::Boolean @end example +@item cran +@cindex CRAN +Import meta-data from @uref{http://cran.r-project.org/, CRAN}, the +central repository for the @uref{http://r-project.org, GNU@tie{}R +statistical and graphical environment}. + +Information is extracted from the HTML package description. + +The command command below imports meta-data for the @code{Cairo} +R package: + +@example +guix import cran Cairo +@end example + @item nix Import meta-data from a local copy of the source of the @uref{http://nixos.org/nixpkgs/, Nixpkgs distribution}@footnote{This diff --git a/guix/import/cran.scm b/guix/import/cran.scm new file mode 100644 index 0000000000..8ed5e5407f --- /dev/null +++ b/guix/import/cran.scm @@ -0,0 +1,188 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Ricardo Wurmus +;;; +;;; 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 . + +(define-module (guix import cran) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (srfi srfi-1) + #:use-module (sxml simple) + #:use-module (sxml match) + #:use-module (sxml xpath) + #:use-module (guix http-client) + #:use-module (guix hash) + #:use-module (guix store) + #:use-module (guix base32) + #:use-module ((guix download) #:select (download-to-store)) + #:use-module (guix import utils) + #:export (cran->guix-package)) + +;;; Commentary: +;;; +;;; Generate a package declaration template for the latest version of an R +;;; package on CRAN, using the HTML description downloaded from +;;; cran.r-project.org. +;;; +;;; Code: + +(define string->license + (match-lambda + ("AGPL-3" 'agpl3+) + ("Artistic-2.0" 'artistic2.0) + ("Apache License 2.0" 'asl2.0) + ("BSD_2_clause" 'bsd-2) + ("BSD_3_clause" 'bsd-3) + ("GPL-2" 'gpl2+) + ("GPL-3" 'gpl3+) + ("LGPL-2" 'lgpl2.0+) + ("LGPL-2.1" 'lgpl2.1+) + ("LGPL-3" 'lgpl3+) + ("MIT" 'x11) + ((x) (string->license x)) + ((lst ...) `(list ,@(map string->license lst))) + (_ #f))) + +(define (format-inputs names) + "Generate a sorted list of package inputs from a list of package NAMES." + (map (lambda (name) + (list name (list 'unquote (string->symbol name)))) + (sort names string-cisxml (http-fetch cran-url) + #:trim-whitespace? #t + #:namespaces '((xhtml . "http://www.w3.org/1999/xhtml")) + #:default-entity-handler + (lambda (port name) + (case name + ((nbsp) " ") + ((ge) ">=") + ((gt) ">") + ((lt) "<") + (else + (format (current-warning-port) + "~a:~a:~a: undefined entitity: ~a\n" + cran-url (port-line port) (port-column port) + name) + (symbol->string name)))))))) + +(define (cran-sxml->sexp sxml) + "Return the `package' s-expression for a CRAN package from the SXML +representation of the package page." + (define (nodes->text nodeset) + (string-join ((sxpath '(// *text*)) nodeset) " ")) + + (define (guix-name name) + (if (string-prefix? "r-" name) + (string-downcase name) + (string-append "r-" (string-downcase name)))) + + (sxml-match-let* + (((*TOP* (xhtml:html + ,head + (xhtml:body + (xhtml:h2 ,name-and-synopsis) + (xhtml:p ,description) + ,summary + (xhtml:h4 "Downloads:") ,downloads + . ,rest))) + sxml)) + (let* ((name (match:prefix (string-match ": " name-and-synopsis))) + (synopsis (match:suffix (string-match ": " name-and-synopsis))) + (version (nodes->text (table-datum summary "Version:"))) + (license ((compose string->license nodes->text) + (table-datum summary "License:"))) + (home-page (nodes->text ((sxpath '((xhtml:a 1))) + (table-datum summary "URL:")))) + (source-url (string-append "mirror://cran/" + ;; Remove double dots, because we want an + ;; absolute path. + (regexp-substitute/global + #f "\\.\\./" + (string-join + ((sxpath '((xhtml:a 1) @ href *text*)) + (table-datum downloads + " Package source: "))) + 'pre 'post))) + (tarball (with-store store (download-to-store store source-url))) + (sysdepends (map match:substring + (list-matches + "[^ ]+" + ;; Strip off comma and parenthetical + ;; expressions. + (regexp-substitute/global + #f "(,|\\([^\\)]+\\))" + (nodes->text (table-datum summary + "SystemRequirements:")) + 'pre 'post)))) + (imports (map guix-name + ((sxpath '(// xhtml:a *text*)) + (table-datum summary "Imports:"))))) + `(package + (name ,(guix-name name)) + (version ,version) + (source (origin + (method url-fetch) + (uri (string-append ,@(factorize-uri source-url version))) + (sha256 + (base32 + ,(bytevector->nix-base32-string (file-sha256 tarball)))))) + (build-system r-build-system) + ,@(maybe-inputs sysdepends) + ,@(maybe-inputs imports 'propagated-inputs) + (home-page ,(if (string-null? home-page) + (string-append %cran-url name) + home-page)) + (synopsis ,synopsis) + ;; Use double spacing + (description ,(regexp-substitute/global #f "\\. \\b" description + 'pre ". " 'post)) + (license ,license))))) + +(define (cran->guix-package package-name) + "Fetch the metadata for PACKAGE-NAME from cran.r-project.org, and return the +`package' s-expression corresponding to that package, or #f on failure." + (let ((module-meta (cran-fetch package-name))) + (and=> module-meta cran-sxml->sexp))) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 6cd762a537..7b29794e8f 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -73,7 +73,7 @@ rather than \\n." ;;; Entry point. ;;; -(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "elpa" "gem")) +(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "elpa" "gem" "cran")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm new file mode 100644 index 0000000000..f11fa1004f --- /dev/null +++ b/guix/scripts/import/cran.scm @@ -0,0 +1,92 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Eric Bavier +;;; Copyright © 2015 Ricardo Wurmus +;;; +;;; 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 . + +(define-module (guix scripts import cran) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix import cran) + #:use-module (guix scripts import) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-37) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:export (guix-import-cran)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + '()) + +(define (show-help) + (display (_ "Usage: guix import cran PACKAGE-NAME +Import and convert the CRAN package for PACKAGE-NAME.\n")) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specification of the command-line options. + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix import cran"))) + %standard-import-options)) + + +;;; +;;; Entry point. +;;; + +(define (guix-import-cran . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((package-name) + (let ((sexp (cran->guix-package package-name))) + (unless sexp + (leave (_ "failed to download description for package '~a'~%") + package-name)) + sexp)) + (() + (leave (_ "too few arguments~%"))) + ((many ...) + (leave (_ "too many arguments~%")))))) diff --git a/tests/cran.scm b/tests/cran.scm new file mode 100644 index 0000000000..c9cb5f69d0 --- /dev/null +++ b/tests/cran.scm @@ -0,0 +1,178 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Ricardo Wurmus +;;; +;;; 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 . + +(define-module (test-cran) + #:use-module (guix import cran) + #:use-module (guix tests) + #:use-module (srfi srfi-64) + #:use-module (ice-9 match)) + +(define sxml + '(*TOP* (xhtml:html + (xhtml:head + (xhtml:title "CRAN - Package my-example-sxml")) + (xhtml:body + (xhtml:h2 "my-example-sxml: Short description") + (xhtml:p "Long description") + (xhtml:table + (@ (summary "Package my-example-sxml summary")) + (xhtml:tr + (xhtml:td "Version:") + (xhtml:td "1.2.3")) + (xhtml:tr + (xhtml:td "Depends:") + (xhtml:td "R (>= 3.1.0)")) + (xhtml:tr + (xhtml:td "SystemRequirements:") + (xhtml:td "cairo (>= 1.2 http://www.cairographics.org/)")) + (xhtml:tr + (xhtml:td "Imports:") + (xhtml:td + (xhtml:a (@ (href "../scales/index.html")) + "scales") + " (>= 0.2.3), " + (xhtml:a (@ (href "../proto/index.html")) + "proto") + ", " + (xhtml:a (@ (href "../Rcpp/index.html")) "Rcpp") + " (>= 0.11.0)")) + (xhtml:tr + (xhtml:td "Suggests:") + (xhtml:td + (xhtml:a (@ (href "../some/index.html")) + "some") + ", " + (xhtml:a (@ (href "../suggestions/index.html")) + "suggestions"))) + (xhtml:tr + (xhtml:td "License:") + (xhtml:td + (xhtml:a (@ (href "../../licenses/MIT")) "MIT"))) + (xhtml:tr + (xhtml:td "URL:") + (xhtml:td + (xhtml:a (@ (href "http://gnu.org/s/my-example-sxml")) + "http://gnu.org/s/my-example-sxml") + ", " + (xhtml:a (@ (href "http://alternative/home/page")) + "http://alternative/home/page")))) + (xhtml:h4 "Downloads:") + (xhtml:table + (@ (summary "Package my-example-sxml downloads")) + (xhtml:tr + (xhtml:td " Reference manual: ") + (xhtml:td + (xhtml:a (@ (href "my-example-sxml.pdf")) + " my-example-sxml.pdf "))) + (xhtml:tr + (xhtml:td " Package source: ") + (xhtml:td + (xhtml:a + (@ (href "../../../src/contrib/my-example-sxml_1.2.3.tar.gz")) + " my-example-sxml_1.2.3.tar.gz ")))) + (xhtml:h4 "Reverse dependencies:") + (xhtml:table + (@ (summary "Package my-example-sxml reverse dependencies")) + (xhtml:tr + (xhtml:td "Reverse depends:") + (xhtml:td "Too many.")) + (xhtml:tr + (xhtml:td "Reverse imports:") + (xhtml:td "Likewise.")) + (xhtml:tr + (xhtml:td "Reverse suggests:") + (xhtml:td "Uncountable."))))))) + +(define simple-table + '(xhtml:table + (xhtml:tr + (xhtml:td "Numbers") + (xhtml:td "123")) + (xhtml:tr + (@ (class "whatever")) + (xhtml:td (@ (class "unimportant")) "Letters") + (xhtml:td "abc")) + (xhtml:tr + (xhtml:td "Letters") + (xhtml:td "xyz")) + (xhtml:tr + (xhtml:td "Single")) + (xhtml:tr + (xhtml:td "not a value") + (xhtml:td "not a label") + (xhtml:td "also not a label")))) + +(test-begin "cran") + +(test-equal "table-datum: return list of first table cell matching label" + '((xhtml:td "abc")) + ((@@ (guix import cran) table-datum) simple-table "Letters")) + +(test-equal "table-datum: return empty list if no match" + '() + ((@@ (guix import cran) table-datum) simple-table "Astronauts")) + +(test-equal "table-datum: only consider the first cell as a label cell" + '() + ((@@ (guix import cran) table-datum) simple-table "not a label")) + + +(test-assert "cran-sxml->sexp" + ;; Replace network resources with sample data. + (mock ((guix build download) url-fetch + (lambda* (url file-name #:key (mirrors '())) + (with-output-to-file file-name + (lambda () + (display + (match url + ("mirror://cran/src/contrib/my-example-sxml_1.2.3.tar.gz" + "source") + (_ (error "Unexpected URL: " url)))))))) + (match ((@@ (guix import cran) cran-sxml->sexp) sxml) + (('package + ('name "r-my-example-sxml") + ('version "1.2.3") + ('source ('origin + ('method 'url-fetch) + ('uri ('string-append "mirror://cran/src/contrib/my-example-sxml_" + 'version ".tar.gz")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'r-build-system) + ('inputs + ('quasiquote + (("cairo" ('unquote 'cairo))))) + ('propagated-inputs + ('quasiquote + (("r-proto" ('unquote 'r-proto)) + ("r-rcpp" ('unquote 'r-rcpp)) + ("r-scales" ('unquote 'r-scales))))) + ('home-page "http://gnu.org/s/my-example-sxml") + ('synopsis "Short description") + ('description "Long description") + ('license 'x11))) + (x + (begin + (format #t "~s\n" x) + (pk 'fail x #f)))))) + +(test-end "cran") + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) -- cgit 1.4.1 From f8f3bef6aac4ed96bfd236567536c4b039b7bd31 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Fri, 31 Jul 2015 14:47:34 +0200 Subject: build: Add R build system. * guix/build-system/r.scm: New file. * guix/build/r-build-system: New file. * Makefile.am (MODULES): Add new files. * doc/guix.texi (Build Systems): Document r-build-system. --- Makefile.am | 2 + doc/guix.texi | 10 ++++ guix/build-system/r.scm | 134 ++++++++++++++++++++++++++++++++++++++++++ guix/build/r-build-system.scm | 112 +++++++++++++++++++++++++++++++++++ 4 files changed, 258 insertions(+) create mode 100644 guix/build-system/r.scm create mode 100644 guix/build/r-build-system.scm (limited to 'doc') diff --git a/Makefile.am b/Makefile.am index af41ea57c8..711181b7cf 100644 --- a/Makefile.am +++ b/Makefile.am @@ -58,6 +58,7 @@ MODULES = \ guix/build-system/perl.scm \ guix/build-system/python.scm \ guix/build-system/waf.scm \ + guix/build-system/r.scm \ guix/build-system/ruby.scm \ guix/build-system/trivial.scm \ guix/ftp-client.scm \ @@ -77,6 +78,7 @@ MODULES = \ guix/build/gnu-dist.scm \ guix/build/perl-build-system.scm \ guix/build/python-build-system.scm \ + guix/build/r-build-system.scm \ guix/build/ruby-build-system.scm \ guix/build/waf-build-system.scm \ guix/build/haskell-build-system.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 4dbedb15ec..c42aedbbb0 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2491,6 +2491,16 @@ passes flags specified by the @code{#:make-maker-flags} or Which Perl package is used can be specified with @code{#:perl}. @end defvr +@defvr {Scheme Variable} r-build-system +This variable is exported by @code{(guix build-system r)}. It +implements the build procedure used by @uref{http://r-project.org, R} +packages, which essentially is little more than running @code{R CMD +INSTALL --library=/gnu/store/@dots{}} in an environment where +@code{R_LIBS_SITE} contains the paths to all R package inputs. Tests +are run after installation using the R function +@code{tools::testInstalledPackage}. +@end defvr + @defvr {Scheme Variable} ruby-build-system This variable is exported by @code{(guix build-system ruby)}. It implements the RubyGems build procedure used by Ruby packages, which diff --git a/guix/build-system/r.scm b/guix/build-system/r.scm new file mode 100644 index 0000000000..4daec5eb66 --- /dev/null +++ b/guix/build-system/r.scm @@ -0,0 +1,134 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Ricardo Wurmus +;;; +;;; 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 . + +(define-module (guix build-system r) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix packages) + #:use-module (guix derivations) + #:use-module (guix search-paths) + #:use-module (guix build-system) + #:use-module (guix build-system gnu) + #:use-module (ice-9 match) + #:use-module (srfi srfi-26) + #:export (%r-build-system-modules + r-build + r-build-system)) + +;; Commentary: +;; +;; Standard build procedure for R packages. +;; +;; Code: + +(define %r-build-system-modules + ;; Build-side modules imported by default. + `((guix build r-build-system) + ,@%gnu-build-system-modules)) + +(define (default-r) + "Return the default R package." + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((r-mod (resolve-interface '(gnu packages statistics)))) + (module-ref r-mod 'r))) + +(define* (lower name + #:key source inputs native-inputs outputs system target + (r (default-r)) + #:allow-other-keys + #:rest arguments) + "Return a bag for NAME." + (define private-keywords + '(#:source #:target #:inputs #:native-inputs)) + + (and (not target) ;XXX: no cross-compilation + (bag + (name name) + (system system) + (host-inputs `(,@(if source + `(("source" ,source)) + '()) + ,@inputs + + ;; Keep the standard inputs of 'gnu-build-system'. + ,@(standard-packages))) + (build-inputs `(("r" ,r) + ,@native-inputs)) + (outputs outputs) + (build r-build) + (arguments (strip-keyword-arguments private-keywords arguments))))) + +(define* (r-build store name inputs + #:key + (tests? #t) + (test-target "tests") + (configure-flags ''()) + (phases '(@ (guix build r-build-system) + %standard-phases)) + (outputs '("out")) + (search-paths '()) + (system (%current-system)) + (guile #f) + (imported-modules %r-build-system-modules) + (modules '((guix build r-build-system) + (guix build utils)))) + "Build SOURCE with INPUTS." + (define builder + `(begin + (use-modules ,@modules) + (r-build #:name ,name + #:source ,(match (assoc-ref inputs "source") + (((? derivation? source)) + (derivation->output-path source)) + ((source) + source) + (source + source)) + #:configure-flags ,configure-flags + #:system ,system + #:tests? ,tests? + #:test-target ,test-target + #:phases ,phases + #:outputs %outputs + #:search-paths ',(map search-path-specification->sexp + search-paths) + #:inputs %build-inputs))) + + (define guile-for-build + (match guile + ((? package?) + (package-derivation store guile system #:graft? #f)) + (#f ; the default + (let* ((distro (resolve-interface '(gnu packages commencement))) + (guile (module-ref distro 'guile-final))) + (package-derivation store guile system #:graft? #f))))) + + (build-expression->derivation store name builder + #:inputs inputs + #:system system + #:modules imported-modules + #:outputs outputs + #:guile-for-build guile-for-build)) + +(define r-build-system + (build-system + (name 'r) + (description "The standard R build system") + (lower lower))) + +;;; r.scm ends here diff --git a/guix/build/r-build-system.scm b/guix/build/r-build-system.scm new file mode 100644 index 0000000000..3fc13eb835 --- /dev/null +++ b/guix/build/r-build-system.scm @@ -0,0 +1,112 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Ricardo Wurmus +;;; +;;; 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 . + +(define-module (guix build r-build-system) + #:use-module ((guix build gnu-build-system) #:prefix gnu:) + #:use-module (guix build utils) + #:use-module (ice-9 match) + #:use-module (ice-9 ftw) + #:use-module (ice-9 popen) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:export (%standard-phases + r-build)) + +;; Commentary: +;; +;; Builder-side code of the standard build procedure for R packages. +;; +;; Code: + +(define (invoke-r command params) + (zero? (apply system* "R" "CMD" command params))) + +(define (pipe-to-r command params) + (let ((port (apply open-pipe* OPEN_WRITE "R" params))) + (display command port) + (zero? (status:exit-val (close-pipe port))))) + +(define (generate-site-path inputs) + (string-join (map (match-lambda + ((_ . path) + (string-append path "/site-library"))) + ;; Restrict to inputs beginning with "r-". + (filter (match-lambda + ((name . _) + (string-prefix? "r-" name))) + inputs)) + ":")) + +(define* (check #:key test-target inputs outputs tests? #:allow-other-keys) + "Run the test suite of a given R package." + (let* ((libdir (string-append (assoc-ref outputs "out") "/site-library/")) + + ;; R package names are case-sensitive and cannot be derived from the + ;; Guix package name. The exact package name is required as an + ;; argument to ‘tools::testInstalledPackage’, which runs the tests + ;; for a package given its name and the path to the “library” (a + ;; location for a collection of R packages) containing it. + + ;; Since there can only be one R package in any collection (= + ;; “library”), the name of the only directory in the collection path + ;; is the original name of the R package. + (pkg-name (car (scandir libdir (negate (cut member <> '("." "..")))))) + (testdir (string-append libdir pkg-name "/" test-target)) + (site-path (string-append libdir ":" (generate-site-path inputs)))) + (if (and tests? (file-exists? testdir)) + (begin + (setenv "R_LIBS_SITE" site-path) + (pipe-to-r (string-append "tools::testInstalledPackage(\"" pkg-name "\", " + "lib.loc = \"" libdir "\")") + '("--no-save" "--slave"))) + #t))) + +(define* (install #:key outputs inputs (configure-flags '()) + #:allow-other-keys) + "Install a given R package." + (let* ((out (assoc-ref outputs "out")) + (site-library (string-append out "/site-library/")) + (params (append configure-flags + (list "--install-tests" + (string-append "--library=" site-library) + "."))) + (site-path (string-append site-library ":" + (generate-site-path inputs)))) + ;; If dependencies cannot be found at install time, R will refuse to + ;; install the package. + (setenv "R_LIBS_SITE" site-path) + ;; Some R packages contain a configure script for which the CONFIG_SHELL + ;; variable should be set. + (setenv "CONFIG_SHELL" (which "bash")) + (mkdir-p site-library) + (invoke-r "INSTALL" params))) + +(define %standard-phases + (modify-phases gnu:%standard-phases + (delete 'configure) + (delete 'build) + (delete 'check) ; tests must be run after installation + (replace 'install install) + (add-after 'install 'check check))) + +(define* (r-build #:key inputs (phases %standard-phases) + #:allow-other-keys #:rest args) + "Build the given R package, applying all of PHASES in order." + (apply gnu:gnu-build #:inputs inputs #:phases phases args)) + +;;; r-build-system.scm ends here -- cgit 1.4.1 From 4650a77ea8b3ada17f94a4a3b2004f172d0a1498 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Wed, 2 Sep 2015 22:53:09 +0200 Subject: doc: Document polkit and elogind services. * doc/guix.texi (Desktop Services): Add polkit-service and elogind-service documentation. --- doc/guix.texi | 82 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 82 insertions(+) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index c42aedbbb0..6defb0bda7 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6049,6 +6049,7 @@ adds or adjust services for a typical ``desktop'' setup. In particular, it adds a graphical login manager (@pxref{X Window, @code{slim-service}}), a network management tool (@pxref{Networking Services, @code{wicd-service}}), energy and color management services, +the @code{elogind} login and seat manager, the Polkit privilege service, the GeoClue location service, an NTP client (@pxref{Networking Services}), the Avahi daemon, and has the name service switch service configured to be able to use @code{nss-mdns} (@pxref{Name Service @@ -6077,6 +6078,87 @@ and policy files. For example, to allow avahi-daemon to use the system bus, @var{services} must be equal to @code{(list avahi)}. @end deffn +@deffn {Monadic Procedure} elogind-service @ + [#:elogind @var{elogind}] [#:config @var{config}] +Return a service that runs the @code{elogind} login and +seat management daemon. @uref{https://github.com/andywingo/elogind, +Elogind} exposes a D-Bus interface that can be used to know which users +are logged in, know what kind of sessions they have open, suspend the +system, inhibit system suspend, reboot the system, and other tasks. + +Elogind handles most system-level power events for a computer, for +example suspending the system when a lid is closed, or shutting it down +when the power button is pressed. + +The @var{config} keyword argument specifies the configuration for +elogind, and should be the result of a @code{(elogind-configuration +(@var{parameter} @var{value})...)} invocation. Available parameters and +their default values are: + +@table @code +@item kill-user-processes? +@code{#f} +@item kill-only-users +@code{()} +@item kill-exclude-users +@code{("root")} +@item inhibit-delay-max-seconds +@code{5} +@item handle-power-key +@code{poweroff} +@item handle-suspend-key +@code{suspend} +@item handle-hibernate-key +@code{hibernate} +@item handle-lid-switch +@code{suspend} +@item handle-lid-switch-docked +@code{ignore} +@item power-key-ignore-inhibited? +@code{#f} +@item suspend-key-ignore-inhibited? +@code{#f} +@item hibernate-key-ignore-inhibited? +@code{#f} +@item lid-switch-ignore-inhibited? +@code{#t} +@item holdoff-timeout-seconds +@code{30} +@item idle-action +@code{ignore} +@item idle-action-seconds +@code{(* 30 60)} +@item runtime-directory-size-percent +@code{10} +@item runtime-directory-size +@code{#f} +@item remove-ipc? +@code{#t} +@item suspend-state +@code{("mem" "standby" "freeze")} +@item suspend-mode +@code{()} +@item hibernate-state +@code{("disk")} +@item hibernate-mode +@code{("platform" "shutdown")} +@item hybrid-sleep-state +@code{("disk")} +@item hybrid-sleep-mode +@code{("suspend" "platform" "shutdown")} +@end table +@end deffn + +@deffn {Monadic Procedure} polkit-service @ + [#:polkit @var{polkit}] +Return a service that runs the Polkit privilege manager. +@uref{http://www.freedesktop.org/wiki/Software/polkit/, Polkit} allows +system administrators to grant access to privileged operations in a +structured way. For example, polkit rules can allow a logged-in user +whose session is active to shut down the machine, if there are no other +users active. +@end deffn + @deffn {Monadic Procedure} upower-service [#:upower @var{upower}] @ [#:watts-up-pro? #f] @ [#:poll-batteries? #t] @ -- cgit 1.4.1 From 4c8f997a7d6f4c9d7eae73804e9784b4562eb213 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 2 Sep 2015 15:23:52 +0200 Subject: graph: Add '--expression'. * guix/scripts/graph.scm (%options, show-help): Add '--expression'. (guix-graph): Call 'read/eval-package-expression' for 'expression' pairs in OPTS. * tests/guix-graph.sh: Add tests. * doc/guix.texi (Invoking guix graph): Document it. --- doc/guix.texi | 10 ++++++++++ guix/scripts/graph.scm | 17 ++++++++++++----- tests/guix-graph.sh | 5 +++++ 3 files changed, 27 insertions(+), 5 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 6defb0bda7..f943540ac8 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4417,6 +4417,16 @@ the values listed above. @item --list-types List the supported graph types. + +@item --expression=@var{expr} +@itemx -e @var{expr} +Consider the package @var{expr} evaluates to. + +This is useful to precisely refer to a package, as in this example: + +@example +guix graph -e '(@@@@ (gnu packages commencement) gnu-make-final)' +@end example @end table diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 1719ffce68..2b671be131 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -380,6 +380,9 @@ given BACKEND. Use NODE-TYPE to traverse the DAG." (lambda (opt name arg result) (list-node-types) (exit 0))) + (option '(#\e "expression") #t #f + (lambda (opt name arg result) + (alist-cons 'expression arg result))) (option '(#\h "help") #f #f (lambda args (show-help) @@ -397,6 +400,8 @@ Emit a Graphviz (dot) representation of the dependencies of PACKAGE...\n")) -t, --type=TYPE represent nodes of the given TYPE")) (display (_ " --list-types list the available graph types")) + (display (_ " + -e, --expression=EXPR consider the package EXPR evaluates to")) (newline) (display (_ " -h, --help display this help and exit")) @@ -417,12 +422,14 @@ Emit a Graphviz (dot) representation of the dependencies of PACKAGE...\n")) (with-error-handling (let* ((opts (parse-command-line args %options (list %default-options))) - (specs (filter-map (match-lambda - (('argument . spec) spec) - (_ #f)) - opts)) (type (assoc-ref opts 'node-type)) - (packages (map specification->package specs))) + (packages (filter-map (match-lambda + (('argument . spec) + (specification->package spec)) + (('expression . exp) + (read/eval-package-expression exp)) + (_ #f)) + opts))) (with-store store (run-with-store store (mlet %store-monad ((nodes (mapm %store-monad diff --git a/tests/guix-graph.sh b/tests/guix-graph.sh index 199258a9b8..e0cbebb753 100644 --- a/tests/guix-graph.sh +++ b/tests/guix-graph.sh @@ -32,3 +32,8 @@ done guix build guile-bootstrap guix graph -t references guile-bootstrap | grep guile-bootstrap + +guix graph -e '(@ (gnu packages bootstrap) %bootstrap-guile)' \ + | grep guile-bootstrap + +if guix graph -e +; then false; else true; fi -- cgit 1.4.1 From 3f208ad7585583bf897999ef4038a803c529d7f8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 10 Sep 2015 23:10:50 +0200 Subject: guix build: '--log-file' can return URLs. * guix/scripts/build.scm (%default-log-urls): New variable. (log-url): New procedure. (guix-build): Use it. * doc/guix.texi (Invoking guix build): Document it. --- doc/guix.texi | 14 +++++++++++++- guix/scripts/build.scm | 49 ++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 61 insertions(+), 2 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index f943540ac8..9ae91a8d1e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3629,7 +3629,7 @@ Make @var{file} a symlink to the result, and register it as a garbage collector root. @item --log-file -Return the build log file names for the given +Return the build log file names or URLs for the given @var{package-or-derivation}s, or raise an error if build logs are missing. @@ -3643,7 +3643,19 @@ guix build --log-file guile guix build --log-file -e '(@@ (gnu packages guile) guile-2.0)' @end example +If a log is unavailable locally, and unless @code{--no-substitutes} is +passed, the command looks for a corresponding log on one of the +substitute servers (as specified with @code{--substitute-urls}.) +So for instance, let's say you want to see the build log of GDB on MIPS +but you're actually on an @code{x86_64} machine: + +@example +$ guix build --log-file gdb -s mips64el-linux +http://hydra.gnu.org/log/@dots{}-gdb-7.10 +@end example + +You can freely access a huge library of build logs! @end table @cindex common build options diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index d593b5a8a7..ab2a39b1f8 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -25,6 +25,7 @@ #:use-module (guix utils) #:use-module (guix monads) #:use-module (guix gexp) + #:autoload (guix http-client) (http-fetch http-get-error?) #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (ice-9 vlist) @@ -42,6 +43,45 @@ guix-build)) +(define %default-log-urls + ;; Default base URLs for build logs. + '("http://hydra.gnu.org/log")) + +;; XXX: The following procedure cannot be in (guix store) because of the +;; dependency on (guix derivations). +(define* (log-url store file #:key (base-urls %default-log-urls)) + "Return a URL under one of the BASE-URLS where a build log for FILE can be +found. Return #f if no build log was found." + (define (valid-url? url) + ;; Probe URL and return #t if it is accessible. + (guard (c ((http-get-error? c) #f)) + (close-port (http-fetch url #:buffered? #f)) + #t)) + + (define (find-url file) + (let ((base (basename file))) + (any (lambda (base-url) + (let ((url (string-append base-url "/" base))) + (and (valid-url? url) url))) + base-urls))) + + (cond ((derivation-path? file) + (catch 'system-error + (lambda () + ;; Usually we'll have more luck with the output file name since + ;; the deriver that was used by the server could be different, so + ;; try one of the output file names. + (let ((drv (call-with-input-file file read-derivation))) + (or (find-url (derivation->output-path drv)) + (find-url file)))) + (lambda args + ;; As a last resort, try the .drv. + (if (= ENOENT (system-error-errno args)) + (find-url file) + (apply throw args))))) + (else + (find-url file)))) + (define (register-root store paths root) "Register ROOT as an indirect GC root for all of PATHS." (let* ((root (string-append (canonicalize-path (dirname root)) @@ -457,6 +497,11 @@ arguments with packages that use the specified source." (list %default-options))) (store (open-connection)) (drv (options->derivations store opts)) + (urls (map (cut string-append <> "/log") + (if (assoc-ref opts 'substitutes?) + (or (assoc-ref opts 'substitute-urls) + %default-substitute-urls) + '()))) (roots (filter-map (match-lambda (('gc-root . root) root) (_ #f)) @@ -470,7 +515,9 @@ arguments with packages that use the specified source." (cond ((assoc-ref opts 'log-file?) (for-each (lambda (file) - (let ((log (log-file store file))) + (let ((log (or (log-file store file) + (log-url store file + #:base-urls urls)))) (if log (format #t "~a~%" log) (leave (_ "no build log for '~a'~%") -- cgit 1.4.1 From daa48c31797b27e3a0991d0db7406c951ebc86df Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 7 Sep 2015 22:44:26 +0200 Subject: services: 'mingetty-service' no longer takes monadic values. * gnu/services/base.scm (mingetty-service): Change default value of #:motd from a monadic value to a . Assume MOTD to be a file-like object. Assume LOGIN-PROGRAM is a gexp or #f. (%base-services): Use 'plain-file' instead of 'text-file' for motd. * gnu/system/linux.scm (unix-pam-service): Update docstring to mention that MOTD is a file-like object. * doc/guix.texi (Base Services): Adjust 'mingetty-service' documentation accordingly. --- doc/guix.texi | 2 +- gnu/services/base.scm | 17 +++++------------ gnu/system/linux.scm | 4 ++-- 3 files changed, 8 insertions(+), 15 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 9ae91a8d1e..59d60bc263 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5699,7 +5699,7 @@ automatically. @var{login-pause?} can be set to @code{#t} in conjunction with @var{auto-login}, in which case the user will have to press a key before the login shell is launched. -When true, @var{login-program} is a gexp or a monadic gexp denoting the name +When true, @var{login-program} is a gexp denoting the name of the log-in program (the default is the @code{login} program from the Shadow tool suite.) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 7f37b3da00..865d461a1e 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -357,7 +357,7 @@ stopped before 'kill' is called." (define* (mingetty-service tty #:key - (motd (text-file "motd" "Welcome.\n")) + (motd (plain-file "motd" "Welcome.\n")) auto-login login-program login-pause? @@ -374,19 +374,12 @@ automatically. @var{login-pause?} can be set to @code{#t} in conjunction with @var{auto-login}, in which case the user will have to press a key before the login shell is launched. -When true, @var{login-program} is a gexp or a monadic gexp denoting the name +When true, @var{login-program} is a gexp denoting the name of the log-in program (the default is the @code{login} program from the Shadow tool suite.) -@var{motd} is a monadic value containing a text file to use as -the ``message of the day''." - (mlet %store-monad ((motd motd) - (login-program (cond ((gexp? login-program) - (return login-program)) - ((not login-program) - (return #f)) - (else - login-program)))) +@var{motd} is a file-like object to use as the ``message of the day''." + (with-monad %store-monad (return (service (documentation (string-append "Run mingetty on " tty ".")) @@ -861,7 +854,7 @@ gexp, to open it, and evaluate @var{close} to close it." (define %base-services ;; Convenience variable holding the basic services. - (let ((motd (text-file "motd" " + (let ((motd (plain-file "motd" " This is the GNU operating system, welcome!\n\n"))) (list (console-font-service "tty1") (console-font-service "tty2") diff --git a/gnu/system/linux.scm b/gnu/system/linux.scm index 7461a4a61f..ac5005ebd1 100644 --- a/gnu/system/linux.scm +++ b/gnu/system/linux.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -136,7 +136,7 @@ dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE." (lambda* (name #:key allow-empty-passwords? motd) "Return a standard Unix-style PAM service for NAME. When ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords. When MOTD is true, it -should be the name of a file used as the message-of-the-day." +should be a file-like object used as the message-of-the-day." ;; See . (let ((name* name)) (pam-service -- cgit 1.4.1 From 0081410da011228ce0eef83f50b13bf70932fd3f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 13 Sep 2015 12:04:55 +0200 Subject: Revert "services: 'mingetty-service' no longer takes monadic values." This reverts commit daa48c31797b27e3a0991d0db7406c951ebc86df. --- doc/guix.texi | 2 +- gnu/services/base.scm | 17 ++++++++++++----- gnu/system/linux.scm | 4 ++-- 3 files changed, 15 insertions(+), 8 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 59d60bc263..9ae91a8d1e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5699,7 +5699,7 @@ automatically. @var{login-pause?} can be set to @code{#t} in conjunction with @var{auto-login}, in which case the user will have to press a key before the login shell is launched. -When true, @var{login-program} is a gexp denoting the name +When true, @var{login-program} is a gexp or a monadic gexp denoting the name of the log-in program (the default is the @code{login} program from the Shadow tool suite.) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 865d461a1e..7f37b3da00 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -357,7 +357,7 @@ stopped before 'kill' is called." (define* (mingetty-service tty #:key - (motd (plain-file "motd" "Welcome.\n")) + (motd (text-file "motd" "Welcome.\n")) auto-login login-program login-pause? @@ -374,12 +374,19 @@ automatically. @var{login-pause?} can be set to @code{#t} in conjunction with @var{auto-login}, in which case the user will have to press a key before the login shell is launched. -When true, @var{login-program} is a gexp denoting the name +When true, @var{login-program} is a gexp or a monadic gexp denoting the name of the log-in program (the default is the @code{login} program from the Shadow tool suite.) -@var{motd} is a file-like object to use as the ``message of the day''." - (with-monad %store-monad +@var{motd} is a monadic value containing a text file to use as +the ``message of the day''." + (mlet %store-monad ((motd motd) + (login-program (cond ((gexp? login-program) + (return login-program)) + ((not login-program) + (return #f)) + (else + login-program)))) (return (service (documentation (string-append "Run mingetty on " tty ".")) @@ -854,7 +861,7 @@ gexp, to open it, and evaluate @var{close} to close it." (define %base-services ;; Convenience variable holding the basic services. - (let ((motd (plain-file "motd" " + (let ((motd (text-file "motd" " This is the GNU operating system, welcome!\n\n"))) (list (console-font-service "tty1") (console-font-service "tty2") diff --git a/gnu/system/linux.scm b/gnu/system/linux.scm index ac5005ebd1..7461a4a61f 100644 --- a/gnu/system/linux.scm +++ b/gnu/system/linux.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -136,7 +136,7 @@ dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE." (lambda* (name #:key allow-empty-passwords? motd) "Return a standard Unix-style PAM service for NAME. When ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords. When MOTD is true, it -should be a file-like object used as the message-of-the-day." +should be the name of a file used as the message-of-the-day." ;; See . (let ((name* name)) (pam-service -- cgit 1.4.1