futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'master' into core-updates

Browse Source
This commit is contained in:
Ludovic Courtès 2016-01-03 14:53:03 +01:00
commit 53334dd6e9
128 changed files with 11960 additions and 4641 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
NEWS
View File

@ -10,6 +10,37 @@ Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
Please send Guix bug reports to bug-guix@gnu.org.
* Changes in 0.9.1 (since 0.9.0)
** Package management
*** Emacs interface for hydra.gnu.org
*** Changes in Emacs interface variables
In the following names, BUFFER-TYPE means "info" or "list";
ENTRY-TYPE means "package", "output" or "generation".
**** Removed
- guix-info-fill-column
- guix-info-insert-ENTRY-TYPE-function
**** Renamed
- guix-info-ignore-empty-vals -> guix-info-ignore-empty-values
- guix-output-name-width -> guix-generation-output-name-width
- guix-buffer-name-function -> guix-ui-buffer-name-function
- guix-update-after-operation -> guix-ui-update-after-operation
- guix-search-params -> guix-package-search-params
**** Replaced
- guix-list-column-format, guix-list-column-value-methods ->
guix-ENTRY-TYPE-list-format
- guix-info-displayed-params, guix-info-insert-methods,
guix-package-info-heading-params -> guix-ENTRY-TYPE-info-format
- guix-param-titles, guix-list-column-titles ->
guix-ENTRY-TYPE-BUFFER-TYPE-titles
- guix-list-describe-warning-count ->
guix-ENTRY-TYPE-list-describe-warning-count
- guix-package-info-fill-heading -> guix-info-fill
* Changes in 0.9.0 (since 0.8.3)
** Package management

2
daemon.am
View File

@ -85,7 +85,6 @@ libstore_a_SOURCES = \
nix/libstore/store-api.cc \
nix/libstore/optimise-store.cc \
nix/libstore/local-store.cc \
nix/libstore/remote-store.cc \
nix/libstore/build.cc \
nix/libstore/pathlocks.cc \
nix/libstore/derivations.cc
@ -95,7 +94,6 @@ libstore_headers = \
nix/libstore/pathlocks.hh \
nix/libstore/globals.hh \
nix/libstore/worker-protocol.hh \
nix/libstore/remote-store.hh \
nix/libstore/derivations.hh \
nix/libstore/misc.hh \
nix/libstore/local-store.hh \

72
doc/emacs.texi
View File

@ -14,6 +14,7 @@ Guix convenient and fun.
* Build Log Mode: Emacs Build Log. Highlighting Guix build logs.
* Completions: Emacs Completions. Completing @command{guix} shell command.
* Development: Emacs Development. Tools for Guix developers.
* Hydra: Emacs Hydra. Interface for Guix build farm.
@end menu
@ -160,7 +161,7 @@ Display package(s) with the specified name.
@item M-x guix-search-by-regexp
Search for packages by a specified regexp. By default ``name'',
``synopsis'' and ``description'' of the packages will be searched. This
can be changed by modifying @code{guix-search-params} variable.
can be changed by modifying @code{guix-package-search-params} variable.
@end table
@ -287,6 +288,8 @@ similar to @command{guix edit} command (@pxref{Invoking guix edit}), but
for opening a package recipe in the current Emacs instance.
@item x
Execute actions on the marked packages.
@item B
Display latest builds of the current package (@pxref{Emacs Hydra}).
@end table
A ``generation-list'' buffer additionally provides the following
@ -414,7 +417,7 @@ changed with the following variables:
By default, the name of a profile is also displayed in a ``list'' or
``info'' buffer name. To change this behavior, use
@code{guix-buffer-name-function} variable.
@code{guix-ui-buffer-name-function} variable.
For example, if you want to display all types of results in a single
buffer (in such case you will probably use a history (@kbd{l}/@kbd{r})
@ -428,8 +431,7 @@ extensively), you may do it like this:
guix-generation-list-buffer-name name
guix-package-info-buffer-name name
guix-output-info-buffer-name name
guix-generation-info-buffer-name name
guix-buffer-name-function #'guix-buffer-name-simple))
guix-generation-info-buffer-name name))
@end example
@node Emacs Keymaps
@ -439,8 +441,12 @@ If you want to change default key bindings, use the following keymaps
(@pxref{Init Rebinding,,, emacs, The GNU Emacs Manual}):
@table @code
@item guix-root-map
Parent keymap with general keys for all guix modes.
@item guix-buffer-map
Parent keymap with general keys for any buffer type.
@item guix-ui-map
Parent keymap with general keys for buffers used for Guix package
management (for packages, outputs and generations).
@item guix-list-mode-map
Parent keymap with general keys for ``list'' buffers.
@ -475,22 +481,22 @@ Keymap with keys available when a point is placed on a button.
@subsubsection Appearance
You can change almost any aspect of ``list'' / ``info'' buffers using
the following variables:
the following variables (@dfn{ENTRY-TYPE} means @code{package},
@code{output} or @code{generation}):
@table @code
@item guix-list-column-format
@itemx guix-list-column-titles
@itemx guix-list-column-value-methods
@item guix-ENTRY-TYPE-list-format
@itemx guix-ENTRY-TYPE-list-titles
Specify the columns, their names, what and how is displayed in ``list''
buffers.
@item guix-info-displayed-params
@itemx guix-info-insert-methods
@itemx guix-info-ignore-empty-vals
@item guix-ENTRY-TYPE-info-format
@itemx guix-ENTRY-TYPE-info-titles
@itemx guix-info-ignore-empty-values
@itemx guix-info-param-title-format
@itemx guix-info-multiline-prefix
@itemx guix-info-indent
@itemx guix-info-fill-column
@itemx guix-info-fill
@itemx guix-info-delimiter
Various settings for ``info'' buffers.
@ -738,3 +744,41 @@ evaluation will be finished in the REPL.
Alternatively, to avoid this limitation, you may just run another Geiser
REPL, and while something is being evaluated in the previous REPL, you
can continue editing a scheme file with the help of the current one.
@node Emacs Hydra
@section Hydra
The continuous integration server at @code{hydra.gnu.org} builds all
the distribution packages on the supported architectures and serves
them as substitutes (@pxref{Substitutes}). Continuous integration is
currently orchestrated by @uref{https://nixos.org/hydra/, Hydra}.
This section describes an Emacs interface to query Hydra to know the
build status of specific packages, discover recent and ongoing builds,
view build logs, and so on. This interface is mostly the same as the
``list''/``info'' interface for displaying packages and generations
(@pxref{Emacs Package Management}).
The following commands are available:
@table @kbd
@item M-x guix-hydra-latest-builds
Display latest failed or successful builds (you will be prompted for a
number of builds). With @kbd{C-u}, you will also be prompted for other
parameters (project, jobset, job and system).
@item M-x guix-hydra-queued-builds
Display scheduled or currently running builds (you will be prompted for
a number of builds).
@item M-x guix-hydra-jobsets
Display available jobsets (you will be prompted for a project).
@end table
In a list of builds you can press @kbd{L} key to display a build log of
the current build. Also both a list of builds and a list of jobsets
provide @kbd{B} key to display latest builds of the current job or
jobset (don't forget about @kbd{C-u}).

1498
doc/guix.texi
View File

File diff suppressed because it is too large Load Diff

11
emacs.am
View File

@ -22,14 +22,19 @@ ELFILES = \
emacs/guix-backend.el \
emacs/guix-base.el \
emacs/guix-build-log.el \
emacs/guix-buffer.el \
emacs/guix-command.el \
emacs/guix-devel.el \
emacs/guix-emacs.el \
emacs/guix-entry.el \
emacs/guix-external.el \
emacs/guix-geiser.el \
emacs/guix-guile.el \
emacs/guix-help-vars.el \
emacs/guix-history.el \
emacs/guix-hydra.el \
emacs/guix-hydra-build.el \
emacs/guix-hydra-jobset.el \
emacs/guix-info.el \
emacs/guix-init.el \
emacs/guix-list.el \
@ -39,8 +44,10 @@ ELFILES = \
emacs/guix-prettify.el \
emacs/guix-profiles.el \
emacs/guix-read.el \
emacs/guix-utils.el \
emacs/guix.el
emacs/guix-ui.el \
emacs/guix-ui-package.el \
emacs/guix-ui-generation.el \
emacs/guix-utils.el
if HAVE_EMACS

68
emacs/guix-backend.el
View File

@ -36,18 +36,13 @@
;; running code in the REPL (see
;; <https://github.com/jaor/geiser/issues/28>).
;;
;; If you need to use "guix.el" in another Emacs (i.e. when there is
;; a runnig "guile --listen..." REPL somewhere), you can either change
;; `guix-default-port' in that Emacs instance or set
;; `guix-use-guile-server' to t.
;;
;; 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 "M-x
;; connect-to-guile" (connect to "localhost" and `guix-default-port') to
;; 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:
@ -98,11 +93,17 @@ REPL while some packages are being installed/removed in the main REPL."
:type 'boolean
:group 'guix-repl)
(defcustom guix-default-port 37246
"Default port used if `guix-use-guile-server' is non-nil."
:type 'integer
(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)
(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
@ -139,17 +140,28 @@ See `guix-eval-in-repl' for details.")
"Message telling about successful Guix operation."
(message "Guix operation has been performed."))
(defun guix-get-guile-program (&optional internal)
(defun guix-get-guile-program (&optional socket)
"Return a value suitable for `geiser-guile-binary'."
(if (or internal
(not guix-use-guile-server))
(if (null socket)
guix-guile-program
(append (if (listp guix-guile-program)
guix-guile-program
(list guix-guile-program))
;; Guile understands "--listen=..." but not "--listen ..."
(list (concat "--listen="
(number-to-string guix-default-port))))))
(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.
@ -176,19 +188,21 @@ display messages."
(get-buffer-process repl))
(and start-msg (message start-msg))
(setq guix-repl-operation-p nil)
(let ((geiser-guile-binary (guix-get-guile-program internal))
(geiser-guile-init-file (or internal guix-helper-file))
(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))))
(condition-case err
(guix-start-repl repl
(and internal
(geiser-repl--read-address
"localhost" guix-default-port)))
(text-read-only
(error (concat "Couldn't start Guix REPL. Perhaps the port %s is busy.\n"
"See buffer '%s' for details")
guix-default-port (buffer-name repl))))
(guix-start-repl repl (and internal guix-repl-current-socket))
(set repl-var repl)
(and end-msg (message end-msg))
(unless internal

863
emacs/guix-base.el
View File

@ -22,124 +22,32 @@
;; This file provides some base and common definitions for guix.el
;; package.
;; List and info buffers have many common patterns that are defined
;; using `guix-define-buffer-type' macro from this file.
;;; Code:
(require 'cl-lib)
(require 'guix-profiles)
(require 'guix-backend)
(require 'guix-guile)
(require 'guix-read)
(require 'guix-utils)
(require 'guix-history)
(require 'guix-messages)
(require 'guix-ui)
;;; Parameters of the entries
(defgroup guix nil
"Settings for Guix package manager and friends."
:prefix "guix-"
:group 'external)
(defvar guix-param-titles
'((package
(id . "ID")
(name . "Name")
(version . "Version")
(source . "Source")
(license . "License")
(synopsis . "Synopsis")
(description . "Description")
(home-url . "Home page")
(outputs . "Outputs")
(inputs . "Inputs")
(native-inputs . "Native inputs")
(propagated-inputs . "Propagated inputs")
(location . "Location")
(installed . "Installed"))
(installed
(path . "Installed path")
(dependencies . "Dependencies")
(output . "Output"))
(output
(id . "ID")
(name . "Name")
(version . "Version")
(source . "Source")
(license . "License")
(synopsis . "Synopsis")
(description . "Description")
(home-url . "Home page")
(output . "Output")
(inputs . "Inputs")
(native-inputs . "Native inputs")
(propagated-inputs . "Propagated inputs")
(location . "Location")
(installed . "Installed")
(path . "Installed path")
(dependencies . "Dependencies"))
(generation
(id . "ID")
(number . "Number")
(prev-number . "Previous number")
(current . "Current")
(path . "Path")
(time . "Time")))
"List for defining titles of entry parameters.
Titles are used for displaying information about entries.
Each element of the list has a form:
(defgroup guix-faces nil
"Guix faces."
:group 'guix
:group 'faces)
(ENTRY-TYPE . ((PARAM . TITLE) ...))")
(defun guix-get-param-title (entry-type param)
"Return title of an ENTRY-TYPE entry parameter PARAM."
(or (guix-assq-value guix-param-titles
entry-type param)
(prog1 (symbol-name param)
(message "Couldn't find title for '%S %S'."
entry-type param))))
(defun guix-get-name-spec (name version &optional output)
(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))))
(defun guix-get-full-name (entry &optional output)
"Return name specification of the package ENTRY and OUTPUT."
(guix-get-name-spec (guix-assq-value entry 'name)
(guix-assq-value entry 'version)
output))
(defun guix-entry-to-specification (entry)
"Return name specification by the package or output ENTRY."
(guix-get-name-spec (guix-assq-value entry 'name)
(guix-assq-value entry 'version)
(guix-assq-value entry 'output)))
(defun guix-entries-to-specifications (entries)
"Return name specifications by the package or output ENTRIES."
(cl-remove-duplicates (mapcar #'guix-entry-to-specification entries)
:test #'string=))
(defun guix-get-installed-outputs (entry)
"Return list of installed outputs for the package ENTRY."
(mapcar (lambda (installed-entry)
(guix-assq-value installed-entry 'output))
(guix-assq-value entry 'installed)))
(defun guix-get-entry-by-id (id entries)
"Return entry from ENTRIES by entry ID."
(cl-find-if (lambda (entry)
(equal id (guix-assq-value entry 'id)))
entries))
(defun guix-get-package-id-and-output-by-output-id (oid)
"Return list (PACKAGE-ID OUTPUT) by output id OID."
(cl-multiple-value-bind (pid-str output)
(split-string oid ":")
(let ((pid (string-to-number pid-str)))
(list (if (= 0 pid) pid-str pid)
output))))
;;; Location of the packages
;;; Location of packages, profiles and manifests
(defvar guix-directory nil
"Default Guix directory.
@ -179,538 +87,6 @@ For the meaning of location, see `guix-find-location'."
(guix-eval-read (guix-make-guile-expression
'package-location-string id-or-name)))
;;; 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<))
;;; Buffers and auto updating.
(defcustom guix-update-after-operation 'current
"Define what information to update after executing an operation.
After successful executing an operation in the Guix REPL (for
example after installing a package), information 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)
(defcustom guix-buffer-name-function #'guix-buffer-name-default
"Function used to define name of a buffer for displaying information.
The function is called with 4 arguments: PROFILE, BUFFER-TYPE,
ENTRY-TYPE, SEARCH-TYPE. See `guix-get-entries' for the meaning
of the arguments."
:type '(choice (function-item guix-buffer-name-default)
(function-item guix-buffer-name-simple)
(function :tag "Other function"))
:group 'guix)
(defun guix-buffer-name-simple (_profile buffer-type entry-type
&optional _search-type)
"Return name of a buffer used for displaying information.
The name is defined by `guix-ENTRY-TYPE-BUFFER-TYPE-buffer-name'
variable."
(symbol-value
(guix-get-symbol "buffer-name" buffer-type entry-type)))
(defun guix-buffer-name-default (profile buffer-type entry-type
&optional _search-type)
"Return name of a buffer used for displaying information.
The name is almost the same as the one defined by
`guix-buffer-name-simple' except the PROFILE name is added to it."
(let ((simple-name (guix-buffer-name-simple
profile buffer-type entry-type))
(profile-name (file-name-base (directory-file-name profile)))
(re (rx string-start
(group (? "*"))
(group (*? any))
(group (? "*"))
string-end)))
(or (string-match re simple-name)
(error "Unexpected error in defining guix buffer name"))
(let ((first* (match-string 1 simple-name))
(name-body (match-string 2 simple-name))
(last* (match-string 3 simple-name)))
;; Handle the case when buffer name is wrapped by '*'.
(if (and (string= "*" first*)
(string= "*" last*))
(concat "*" name-body ": " profile-name "*")
(concat simple-name ": " profile-name)))))
(defun guix-buffer-name (profile buffer-type entry-type search-type)
"Return name of a buffer used for displaying information.
See `guix-buffer-name-function' for details."
(let ((fun (if (functionp guix-buffer-name-function)
guix-buffer-name-function
#'guix-buffer-name-default)))
(funcall fun profile buffer-type entry-type search-type)))
(defun guix-switch-to-buffer (buffer)
"Switch to a 'list' or 'info' BUFFER."
(pop-to-buffer buffer
'((display-buffer-reuse-window
display-buffer-same-window))))
(defun guix-buffer-p (&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-buffers (&optional modes)
"Return 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-buffer-p buf modes))
(buffer-list)))
(defun guix-update-buffer (buffer)
"Update information in a 'list' or 'info' BUFFER."
(with-current-buffer buffer
(guix-revert-buffer nil t)))
(defun guix-update-buffers-maybe-after-operation ()
"Update buffers after Guix operation if needed.
See `guix-update-after-operation' for details."
(let ((to-update
(and guix-operation-buffer
(cl-case guix-update-after-operation
(current (and (buffer-live-p guix-operation-buffer)
(guix-buffer-p guix-operation-buffer)
(list guix-operation-buffer)))
(all (guix-buffers))))))
(setq guix-operation-buffer nil)
(mapc #'guix-update-buffer to-update)))
(add-hook 'guix-after-repl-operation-hook
'guix-update-buffers-maybe-after-operation)
;;; Common definitions for buffer types
(defvar guix-root-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-redisplay-buffer)
(define-key map (kbd "M") 'guix-apply-manifest)
(define-key map (kbd "C-c C-z") 'guix-switch-to-repl)
map)
"Parent keymap for all guix modes.")
(defvar-local guix-profile nil
"Profile used for the current buffer.")
(put 'guix-profile 'permanent-local t)
(defvar-local guix-entries nil
"List of the currently displayed entries.
Each element of the list is alist with entry info of the
following form:
((PARAM . VAL) ...)
PARAM is a name of the entry parameter.
VAL is a value of this parameter.")
(put 'guix-entries 'permanent-local t)
(defvar-local guix-buffer-type nil
"Type of the current buffer.")
(put 'guix-buffer-type 'permanent-local t)
(defvar-local guix-entry-type nil
"Type of the current entry.")
(put 'guix-entry-type 'permanent-local t)
(defvar-local guix-search-type nil
"Type of the current search.")
(put 'guix-search-type 'permanent-local t)
(defvar-local guix-search-vals nil
"Values of the current search.")
(put 'guix-search-vals 'permanent-local t)
(defsubst guix-set-vars (profile entries buffer-type entry-type
search-type search-vals)
"Set local variables for the current Guix buffer."
(setq default-directory profile
guix-profile profile
guix-entries entries
guix-buffer-type buffer-type
guix-entry-type entry-type
guix-search-type search-type
guix-search-vals search-vals))
(defun guix-get-symbol (postfix buffer-type &optional entry-type)
(intern (concat "guix-"
(when entry-type
(concat (symbol-name entry-type) "-"))
(symbol-name buffer-type) "-" postfix)))
(defmacro guix-define-buffer-type (buf-type entry-type &rest args)
"Define common for BUF-TYPE buffers for displaying ENTRY-TYPE entries.
In the text below TYPE means ENTRY-TYPE-BUF-TYPE.
This macro defines `guix-TYPE-mode', a custom group and several
user variables.
The following stuff should be defined outside this macro:
- `guix-BUF-TYPE-mode' - parent mode for the defined mode.
- `guix-TYPE-mode-initialize' (optional) - function for
additional mode settings; it is called without arguments.
Remaining argument (ARGS) should have a form [KEYWORD VALUE] ... The
following keywords are available:
- `:buffer-name' - default value for the defined
`guix-TYPE-buffer-name' variable.
- `:required' - default value for the defined
`guix-TYPE-required-params' variable.
- `:history-size' - default value for the defined
`guix-TYPE-history-size' variable.
- `:revert' - default value for the defined
`guix-TYPE-revert-no-confirm' variable."
(let* ((entry-type-str (symbol-name entry-type))
(buf-type-str (symbol-name buf-type))
(Entry-type-str (capitalize entry-type-str))
(Buf-type-str (capitalize buf-type-str))
(entry-str (concat entry-type-str " entries"))
(buf-str (concat buf-type-str " buffer"))
(prefix (concat "guix-" entry-type-str "-" buf-type-str))
(group (intern prefix))
(faces-group (intern (concat prefix "-faces")))
(mode-map-str (concat prefix "-mode-map"))
(parent-mode (intern (concat "guix-" buf-type-str "-mode")))
(mode (intern (concat prefix "-mode")))
(mode-init-fun (intern (concat prefix "-mode-initialize")))
(buf-name-var (intern (concat prefix "-buffer-name")))
(revert-var (intern (concat prefix "-revert-no-confirm")))
(history-var (intern (concat prefix "-history-size")))
(params-var (intern (concat prefix "-required-params")))
(buf-name-val (format "*Guix %s %s*" Entry-type-str Buf-type-str))
(revert-val nil)
(history-val 20)
(params-val '(id)))
;; Process the keyword args.
(while (keywordp (car args))
(pcase (pop args)
(`:required (setq params-val (pop args)))
(`:history-size (setq history-val (pop args)))
(`:revert (setq revert-val (pop args)))
(`:buffer-name (setq buf-name-val (pop args)))
(_ (pop args))))
`(progn
(defgroup ,group nil
,(concat Buf-type-str " buffer with " entry-str ".")
:prefix ,(concat prefix "-")
:group ',(intern (concat "guix-" buf-type-str)))
(defgroup ,faces-group nil
,(concat "Faces for " buf-type-str " buffer with " entry-str ".")
:group ',(intern (concat "guix-" buf-type-str "-faces")))
(defcustom ,buf-name-var ,buf-name-val
,(concat "Default name of the " buf-str " for displaying " entry-str ".")
:type 'string
:group ',group)
(defcustom ,history-var ,history-val
,(concat "Maximum number of items saved in the history of the " buf-str ".\n"
"If 0, the history is disabled.")
:type 'integer
:group ',group)
(defcustom ,revert-var ,revert-val
,(concat "If non-nil, do not ask to confirm for reverting the " buf-str ".")
:type 'boolean
:group ',group)
(defvar ,params-var ',params-val
,(concat "List of required " entry-type-str " parameters.\n\n"
"Displayed parameters and parameters from this list are received\n"
"for each " entry-type-str ".\n\n"
"May be a special value `all', in which case all supported\n"
"parameters are received (this may be very slow for a big number\n"
"of entries).\n\n"
"Do not remove `id' from this list as it is required for\n"
"identifying an entry."))
(define-derived-mode ,mode ,parent-mode ,(concat "Guix-" Buf-type-str)
,(concat "Major mode for displaying information about " entry-str ".\n\n"
"\\{" mode-map-str "}")
(setq-local revert-buffer-function 'guix-revert-buffer)
(setq-local guix-history-size ,history-var)
(and (fboundp ',mode-init-fun) (,mode-init-fun))))))
(put 'guix-define-buffer-type 'lisp-indent-function 'defun)
;;; Getting and displaying info about packages and generations
(defcustom guix-package-list-type 'output
"Define how to display packages in a list buffer.
May 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)
(defcustom guix-package-info-type 'package
"Define how to display packages in an info buffer.
May be a symbol `package' or `output' (if `output', display each
output separately; if `package', display outputs inside a package
information)."
:type '(choice (const :tag "Display packages" package)
(const :tag "Display outputs" output))
:group 'guix)
(defun guix-get-entries (profile entry-type search-type search-vals
&optional params)
"Search for entries of ENTRY-TYPE.
Call an appropriate scheme function and return a list of the
form of `guix-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
information with all available parameters."
(guix-eval-read (guix-make-guile-expression
'entries
profile params entry-type search-type search-vals)))
(defun guix-get-show-entries (profile buffer-type entry-type search-type
&rest search-vals)
"Search for ENTRY-TYPE entries and show results in BUFFER-TYPE buffer.
See `guix-get-entries' for the meaning of SEARCH-TYPE and SEARCH-VALS."
(let ((entries (guix-get-entries profile entry-type search-type search-vals
(guix-get-params-for-receiving
buffer-type entry-type))))
(guix-set-buffer profile entries buffer-type entry-type
search-type search-vals)))
(defun guix-set-buffer (profile entries buffer-type entry-type search-type
search-vals &optional history-replace no-display)
"Set up BUFFER-TYPE buffer for displaying ENTRY-TYPE ENTRIES.
Insert ENTRIES in buffer, set variables and make history item.
ENTRIES should have a form of `guix-entries'.
See `guix-get-entries' for the meaning of SEARCH-TYPE and SEARCH-VALS.
If HISTORY-REPLACE is non-nil, replace current history item,
otherwise add the new one.
If NO-DISPLAY is non-nil, do not switch to the buffer."
(when entries
(let ((buf (if (and (eq major-mode
(guix-get-symbol "mode" buffer-type entry-type))
(equal guix-profile profile))
(current-buffer)
(get-buffer-create
(guix-buffer-name profile buffer-type
entry-type search-type)))))
(with-current-buffer buf
(guix-show-entries entries buffer-type entry-type)
(guix-set-vars profile entries buffer-type entry-type
search-type search-vals)
(funcall (if history-replace
#'guix-history-replace
#'guix-history-add)
(guix-make-history-item)))
(or no-display
(guix-switch-to-buffer buf))))
(guix-result-message profile entries entry-type
search-type search-vals))
(defun guix-show-entries (entries buffer-type entry-type)
"Display ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer."
(let ((inhibit-read-only t))
(erase-buffer)
(funcall (symbol-function (guix-get-symbol
"mode" buffer-type entry-type)))
(funcall (guix-get-symbol "insert-entries" buffer-type)
entries entry-type)
(goto-char (point-min))))
(defun guix-history-call (profile entries buffer-type entry-type
search-type search-vals)
"Function called for moving by history."
(guix-show-entries entries buffer-type entry-type)
(guix-set-vars profile entries buffer-type entry-type
search-type search-vals)
(guix-result-message profile entries entry-type
search-type search-vals))
(defun guix-make-history-item ()
"Make and return a history item for the current buffer."
(list #'guix-history-call
guix-profile guix-entries guix-buffer-type guix-entry-type
guix-search-type guix-search-vals))
(defun guix-get-params-for-receiving (buffer-type entry-type)
"Return parameters that should be received for BUFFER-TYPE, ENTRY-TYPE."
(let* ((required-var (guix-get-symbol "required-params"
buffer-type entry-type))
(required (symbol-value required-var)))
(unless (equal required 'all)
(cl-union required
(funcall (guix-get-symbol "get-displayed-params"
buffer-type)
entry-type)))))
(defun guix-revert-buffer (_ignore-auto noconfirm)
"Update information in the current buffer.
The function is suitable for `revert-buffer-function'.
See `revert-buffer' for the meaning of NOCONFIRM."
(when (or noconfirm
(symbol-value
(guix-get-symbol "revert-no-confirm"
guix-buffer-type guix-entry-type))
(y-or-n-p "Update current information? "))
(let* ((search-type guix-search-type)
(search-vals guix-search-vals)
(params (guix-get-params-for-receiving guix-buffer-type
guix-entry-type))
(entries (guix-get-entries
guix-profile guix-entry-type
guix-search-type guix-search-vals params))
;; If a REPL was restarted, package/output IDs are not actual
;; anymore, because 'object-address'-es died with the REPL, so if a
;; search by ID didn't give results, search again by name.
(entries (if (and (null entries)
(eq guix-search-type 'id)
(or (eq guix-entry-type 'package)
(eq guix-entry-type 'output)))
(progn
(setq search-type 'name
search-vals (guix-entries-to-specifications
guix-entries))
(guix-get-entries
guix-profile guix-entry-type
search-type search-vals params))
entries)))
(guix-set-buffer guix-profile entries guix-buffer-type guix-entry-type
search-type search-vals t t))))
(cl-defun guix-redisplay-buffer (&key buffer profile entries buffer-type
entry-type search-type search-vals)
"Redisplay a Guix BUFFER.
Restore the point and window positions after redisplaying if possible.
This function will not update the information, use
\"\\[revert-buffer]\" if you want the full update.
If BUFFER is nil, use the current buffer. For the meaning of the
rest arguments, see `guix-set-buffer'."
(interactive)
(or buffer (setq buffer (current-buffer)))
(with-current-buffer buffer
(or (derived-mode-p 'guix-info-mode 'guix-list-mode)
(error "%S is not a Guix buffer" buffer))
(let* ((point (point))
(was-at-button (button-at point))
;; For simplicity, ignore an unlikely case when multiple
;; windows display the same BUFFER.
(window (car (get-buffer-window-list buffer nil t)))
(window-start (and window (window-start window))))
(guix-set-buffer (or profile guix-profile)
(or entries guix-entries)
(or buffer-type guix-buffer-type)
(or entry-type guix-entry-type)
(or search-type guix-search-type)
(or search-vals guix-search-vals)
t t)
(goto-char point)
(and was-at-button
(not (button-at (point)))
(forward-button 1))
(when window
(set-window-point window (point))
(set-window-start window window-start)))))
;;; 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)
(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)
(defvar guix-output-name-width 30
"Width of an output name \"column\".
This variable is used in auxiliary buffers for comparing generations.")
(defun guix-generation-file (profile generation)
"Return the file name of a PROFILE's GENERATION."
(format "%s-%s-link" profile generation))
@ -724,74 +100,14 @@ this generation."
(guix-generation-file profile generation)
profile)))
(defun guix-generation-packages (profile generation)
"Return a list of sorted packages installed in PROFILE's GENERATION.
Each element of the list is a list of the package specification and its path."
(let ((names+paths (guix-eval-read
(guix-make-guile-expression
'generation-package-specifications+paths
profile generation))))
(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 path."
(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 path."
(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."
(let ((fun (if (functionp guix-generation-packages-buffer-name-function)
guix-generation-packages-buffer-name-function
#'guix-generation-packages-buffer-name-default)))
(funcall fun profile generation)))
(defun guix-generation-insert-package (name path)
"Insert package output NAME and PATH at point."
(insert name)
(indent-to guix-output-name-width 2)
(insert path "\n"))
(defun guix-generation-insert-packages (buffer profile generation)
"Insert package outputs installed in PROFILE's GENERATION 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 generation))))
(defun guix-generation-packages-buffer (profile generation)
"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 profile generation)
buf))))
(defun guix-profile-generation-manifest-file (generation)
"Return the file name of a GENERATION's manifest.
GENERATION is a generation number of `guix-profile' profile."
(guix-manifest-file guix-profile 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 `guix-profile' profile."
(guix-generation-packages-buffer guix-profile generation))
;;;###autoload
(defun guix-edit (id-or-name)
"Edit (go to location of) package with ID-OR-NAME."
(interactive (list (guix-read-package-name)))
(let ((loc (guix-package-location id-or-name)))
(if loc
(guix-find-location loc)
(message "Couldn't find package location."))))
;;; Actions on packages and generations
@ -865,101 +181,6 @@ VARIABLE is a name of an option variable.")
guix-operation-option-true-string
guix-operation-option-false-string))
(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-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 the REPL was restarted, information 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-get-entry-by-id id entries)))
(when entry
(let ((location (guix-assq-value entry 'location)))
(concat (guix-get-full-name 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")))
(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.
@ -1014,34 +235,6 @@ Ask a user with PROMPT for continuing an operation."
guix-operation-option-separator)))
(force-mode-line-update))
(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-package-source-path (package-id)
"Return a store file path to a source of a package PACKAGE-ID."
(message "Calculating the source derivation ...")
@ -1075,12 +268,12 @@ 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* ((default-profile (or guix-profile guix-current-profile))
(let* ((current-profile (guix-ui-current-profile))
(profile (if current-prefix-arg
(guix-profile-prompt)
default-profile))
(or current-profile guix-current-profile)))
(file (read-file-name "File with manifest: "))
(buffer (and guix-profile (current-buffer))))
(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'? "
@ -1174,12 +367,12 @@ The function is called with a single argument - a command line string."
(defun guix-update-buffers-maybe-after-pull ()
"Update buffers depending on `guix-update-after-pull'."
(when guix-update-after-pull
(mapc #'guix-update-buffer
(mapc #'guix-ui-update-buffer
;; No need to update "generation" buffers.
(guix-buffers '(guix-package-list-mode
guix-package-info-mode
guix-output-list-mode
guix-output-info-mode)))
(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

622
emacs/guix-buffer.el Normal file
View File

@ -0,0 +1,622 @@
;;; 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
(guix-buffer-show-entries %entries %buffer-type %entry-type)
(setq guix-buffer-item buffer-item)
(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

9
emacs/guix-command.el
View File

@ -690,7 +690,7 @@ Perform pull-specific actions after operation, see
open the log file(s)."
(let* ((args (if (member "--log-file" args)
args
(apply #'list (car args) "--log-file" (cdr args))))
(cl-list* (car args) "--log-file" (cdr args))))
(output (guix-command-output args))
(files (split-string output "\n" t)))
(dolist (file files)
@ -715,10 +715,9 @@ open the log file(s)."
(map-file (or wished-map-file (guix-png-file-name)))
(args (if wished-map-file
args
(apply #'list
(car args)
(concat "--map-file=" map-file)
(cdr args)))))
(cl-list* (car args)
(concat "--map-file=" map-file)
(cdr args)))))
(guix-command-output args)
(guix-find-file map-file)))

59
emacs/guix-entry.el Normal file
View File

@ -0,0 +1,59 @@
;;; 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

8
emacs/guix-external.el
View File

@ -23,6 +23,7 @@
;;; Code:
(require 'cl-lib)
(require 'guix-config)
(defgroup guix-external nil
@ -67,10 +68,9 @@ 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")))
(apply #'list
guix-dot-program
(concat "-o" output-file)
(or args guix-dot-default-arguments)))
(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'."

362
emacs/guix-hydra-build.el Normal file
View File

@ -0,0 +1,362 @@
;;; 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

162
emacs/guix-hydra-jobset.el Normal file
View File

@ -0,0 +1,162 @@
;;; 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

363
emacs/guix-hydra.el Normal file
View File

@ -0,0 +1,363 @@
;;; 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-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

971
emacs/guix-info.el
View File

File diff suppressed because it is too large Load Diff

934
emacs/guix-list.el
View File

File diff suppressed because it is too large Load Diff

4
emacs/guix-main.scm
View File

@ -58,7 +58,6 @@
(guix licenses)
(guix utils)
(guix ui)
(guix scripts graph)
(guix scripts lint)
(guix scripts package)
(guix scripts pull)
@ -989,7 +988,8 @@ Return #t if the shell command was executed successfully."
(define (graph-type-names)
"Return a list of names of available graph node types."
(map node-type-name %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."

26
emacs/guix-messages.el
View File

@ -31,9 +31,8 @@
(defvar guix-messages
`((package
(id
(0 "Packages not found.")
(1 "")
(many "%d packages." count))
,(lambda (_ entries ids)
(guix-message-packages-by-id entries 'package ids)))
(name
,(lambda (_ entries names)
(guix-message-packages-by-name entries 'package names)))
@ -67,9 +66,8 @@
(output
(id
(0 "Package outputs not found.")
(1 "")
(many "%d package outputs." count))
,(lambda (_ entries ids)
(guix-message-packages-by-id entries 'output ids)))
(name
,(lambda (_ entries names)
(guix-message-packages-by-name entries 'output names)))
@ -147,6 +145,22 @@
(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))

107
emacs/guix-read.el
View File

@ -26,95 +26,40 @@
(require 'guix-help-vars)
(require 'guix-utils)
(require 'guix-base)
(require 'guix-backend)
(require 'guix-guile)
(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)))
;;; Receivable lists of packages, lint checkers, etc.
(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)))
(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)))
(defmacro guix-define-readers (&rest args)
"Define reader functions.
(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)))
ARGS should have a form [KEYWORD VALUE] ... The following
keywords are available:
(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)))
- `completions-var' - variable used to get completions.
(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'.
- `completions-getter' - function used to get completions.
;; (guix-eval-read (guix-make-guile-expression 'package-names))
- `single-reader', `single-prompt' - name of a function to read
a single value, and a prompt for it.
(mapcar #'car
(guix-eval-read (guix-make-guile-expression
'package-names-lists)))
#'string<))
- `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."
(let (completions-var
completions-getter
single-reader
single-prompt
multiple-reader
multiple-prompt
multiple-separator)
;; Process the keyword args.
(while (keywordp (car args))
(pcase (pop args)
(`:completions-var (setq completions-var (pop args)))
(`:completions-getter (setq completions-getter (pop args)))
(`:single-reader (setq single-reader (pop args)))
(`:single-prompt (setq single-prompt (pop args)))
(`:multiple-reader (setq multiple-reader (pop args)))
(`:multiple-prompt (setq multiple-prompt (pop args)))
(`:multiple-separator (setq multiple-separator (pop args)))
(_ (pop args))))
(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 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))))))))
;;; Readers
(guix-define-readers
:completions-var guix-help-system-types

433
emacs/guix-ui-generation.el Normal file
View File

@ -0,0 +1,433 @@
;;; guix-ui-generation.el --- Interface for displaying generations -*- 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 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)
(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)))
;;; 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-ui-current-profile)
'generation (button-get btn 'number))
'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-path 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-ui-current-profile)
'generation (guix-list-current-id)))
(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-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)
'generation-diff
(reverse (guix-generation-list-generations-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)
'generation-diff
(guix-generation-list-generations-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 generation)
"Return a list of sorted packages installed in PROFILE's GENERATION.
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
'generation-package-specifications+paths
profile generation))))
(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 generation)
"Insert package outputs installed in PROFILE's GENERATION 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 generation))))
(defun guix-generation-packages-buffer (profile generation)
"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 profile generation)
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))
(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))
;;; 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

955
emacs/guix-ui-package.el Normal file
View File

@ -0,0 +1,955 @@
;;; guix-ui-package.el --- Interface for displaying packages -*- 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 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-build)
(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))))
;;; 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)
(source simple guix-package-info-insert-source)
(location format (format guix-package-location))
(home-url format (format guix-url))
(license format (format guix-package-info-license))
(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"))
: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-source nil
"If non-nil, find a source file after pressing a \"Show\" button.
If nil, just display the source file path 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)
(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-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 (button-label btn))
'add)))
(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 specification) at point."
(guix-insert-button
(guix-package-entry->name-specification entry)
'guix-package-name
'face 'guix-package-info-heading))
(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)))
(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)
(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-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-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."
(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 ()
"Go to the location of the current package."
(interactive)
(guix-edit (guix-list-current-id)))
(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-package-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))
(source simple guix-package-info-insert-source)
(path simple (indent guix-file))
(dependencies simple (indent guix-file))
(location format (format guix-package-location))
(home-url format (format guix-url))
(license format (format guix-package-info-license))
(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 ()
"Go to the location of the current package."
(interactive)
(guix-edit (guix-entry-value (guix-list-current-entry)
'package-id)))
;;; 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-search-by-name (name &optional profile)
"Search for Guix packages by 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 (read-string "Package name: " nil 'guix-package-search-history)
(guix-ui-read-profile)))
(guix-package-get-display profile 'name name))
;;;###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-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-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

333
emacs/guix-ui.el Normal file
View File

@ -0,0 +1,333 @@
;;; guix-ui.el --- Common code for Guix package management interface -*- 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 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)
(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-default
"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-default)
(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)
;; TODO separate '*...*' logic from the real profile appending. Also add
;; another function to return '*Guix ...: /full/path/to/profile*' name.
(defun guix-ui-buffer-name-default (base-name profile)
"Return buffer name by appending BASE-NAME and PROFILE's base file name."
(let ((profile-name (file-name-base (directory-file-name profile)))
(re (rx string-start
(group (? "*"))
(group (*? any))
(group (? "*"))
string-end)))
(or (string-match re base-name)
(error "Unexpected error in defining guix 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 ": " profile-name "*")
(concat base-name ": " profile-name)))))
(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

269
emacs/guix-utils.el
View File

@ -64,6 +64,17 @@ Use `guix-time-format'."
"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.
@ -93,6 +104,28 @@ See `insert-text-button' for the meaning of PROPERTIES."
: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.
@ -111,14 +144,11 @@ Separate inserted lines with SEPARATOR."
(defun guix-split-string (str &optional col)
"Split string STR by lines and return list of result strings.
If COL is non-nil and STR is a one-line string longer than COL,
split it into several short lines."
(let ((strings (split-string str "\n *")))
(if (and col
(null (cdr strings)) ; if not multi-line
(> (length str) col))
(split-string (guix-get-filled-string str col) "\n")
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."
@ -144,6 +174,15 @@ add both to the end and to the beginning."
(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."
@ -154,6 +193,15 @@ This function is similar to `shell-quote-argument', but less strict."
(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) "-")))
@ -175,6 +223,15 @@ If NO-MESSAGE? is non-nil, do not display a message about it."
See also `guix-copy-as-kill'."
(guix-copy-as-kill (guix-command-string args) no-message?))
(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)
@ -193,6 +250,14 @@ 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
@ -226,6 +291,15 @@ single argument."
(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
@ -237,8 +311,57 @@ modifier call."
(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 accessors
;;; Alist procedures
(defmacro guix-define-alist-accessor (name assoc-fun)
"Define NAME function to access alist values using ASSOC-FUN."
@ -256,6 +379,48 @@ accessed with 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
@ -266,6 +431,77 @@ accessed with KEYS."
"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
@ -303,9 +539,18 @@ See `defun' for the meaning of arguments."
,(or docstring
(format "Memoized version of `%S'." definition))))
(defvar guix-memoized-font-lock-keywords
(defvar guix-utils-font-lock-keywords
(eval-when-compile
`((,(rx "("
`((,(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)
@ -314,7 +559,7 @@ See `defun' for the meaning of arguments."
(1 font-lock-keyword-face)
(2 font-lock-function-name-face nil t)))))
(font-lock-add-keywords 'emacs-lisp-mode guix-memoized-font-lock-keywords)
(font-lock-add-keywords 'emacs-lisp-mode guix-utils-font-lock-keywords)
(provide 'guix-utils)

213
emacs/guix.el
View File

@ -1,213 +0,0 @@
;;; guix.el --- Interface for GNU Guix package manager
;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
;; Package-Requires: ((geiser "0.3"))
;; Keywords: tools
;; 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 an interface for searching, listing and getting
;; information about Guix packages and generations; and for
;; installing/upgrading/removing packages.
;;; Code:
(require 'guix-base)
(require 'guix-list)
(require 'guix-info)
(require 'guix-utils)
(require 'guix-read)
(defgroup guix nil
"Interface for Guix package manager."
:prefix "guix-"
:group 'external)
(defgroup guix-faces nil
"Guix faces."
:group 'guix
:group 'faces)
(defcustom guix-list-single-package nil
"If non-nil, list a package even if it is the only matching result.
If nil, show a single package in the info buffer."
:type 'boolean
:group 'guix)
(defvar guix-search-params '(name synopsis description)
"Default list of package parameters for searching by regexp.")
(defvar guix-search-history nil
"A history of minibuffer prompts.")
(defun guix-get-show-packages (profile search-type &rest search-vals)
"Search for packages and show results.
If PROFILE is nil, use `guix-current-profile'.
See `guix-get-entries' for the meaning of SEARCH-TYPE and
SEARCH-VALS.
Results are displayed in the list buffer, unless a single package
is found and `guix-list-single-package' is nil."
(or profile (setq profile guix-current-profile))
(let ((packages (guix-get-entries profile guix-package-list-type
search-type search-vals
(guix-get-params-for-receiving
'list guix-package-list-type))))
(if (or guix-list-single-package
(cdr packages))
(guix-set-buffer profile packages 'list guix-package-list-type
search-type search-vals)
(let ((packages (guix-get-entries profile guix-package-info-type
search-type search-vals
(guix-get-params-for-receiving
'info guix-package-info-type))))
(guix-set-buffer profile packages 'info guix-package-info-type
search-type search-vals)))))
(defun guix-get-show-generations (profile search-type &rest search-vals)
"Search for generations and show results.
If PROFILE is nil, use `guix-current-profile'.
See `guix-get-entries' for the meaning of SEARCH-TYPE and
SEARCH-VALS."
(apply #'guix-get-show-entries
(or profile guix-current-profile)
'list 'generation search-type search-vals))
;;;###autoload
(defun guix-search-by-name (name &optional profile)
"Search for Guix packages by 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 (read-string "Package name: " nil 'guix-search-history)
(and current-prefix-arg
(guix-profile-prompt))))
(guix-get-show-packages profile 'name name))
;;;###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-search-params'.
If PROFILE is nil, use `guix-current-profile'.
Interactively with prefix, prompt for PROFILE."
(interactive
(list (read-regexp "Regexp: " nil 'guix-search-history)
nil
(and current-prefix-arg
(guix-profile-prompt))))
(guix-get-show-packages profile 'regexp regexp
(or params guix-search-params)))
;;;###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 (and current-prefix-arg
(guix-profile-prompt))))
(guix-get-show-packages profile 'installed))
;;;###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 (and current-prefix-arg
(guix-profile-prompt))))
(guix-get-show-packages 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 (and current-prefix-arg
(guix-profile-prompt))))
(guix-get-show-packages 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 (and current-prefix-arg
(guix-profile-prompt))))
(guix-get-show-packages profile 'newest-available))
;;;###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 (and current-prefix-arg
(guix-profile-prompt))))
(guix-get-show-generations 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: ")
(and current-prefix-arg
(guix-profile-prompt))))
(guix-get-show-generations 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): ")
(and current-prefix-arg
(guix-profile-prompt))))
(guix-get-show-generations profile 'time
(float-time from)
(float-time to)))
;;;###autoload
(defun guix-edit (id-or-name)
"Edit (go to location of) package with ID-OR-NAME."
(interactive (list (guix-read-package-name)))
(let ((loc (guix-package-location id-or-name)))
(if loc
(guix-find-location loc)
(message "Couldn't find package location."))))
(provide 'guix)
;;; guix.el ends here

7
gnu-system.am
View File

@ -76,7 +76,6 @@ GNU_SYSTEM_MODULES = \
gnu/packages/cryptsetup.scm \
gnu/packages/cups.scm \
gnu/packages/curl.scm \
gnu/packages/cursynth.scm \
gnu/packages/cyrus-sasl.scm \
gnu/packages/databases.scm \
gnu/packages/datamash.scm \
@ -361,6 +360,7 @@ GNU_SYSTEM_MODULES = \
gnu/services/desktop.scm \
gnu/services/dmd.scm \
gnu/services/lirc.scm \
gnu/services/mail.scm \
gnu/services/networking.scm \
gnu/services/ssh.scm \
gnu/services/web.scm \
@ -420,7 +420,6 @@ dist_patch_DATA = \
gnu/packages/patches/binutils-ld-new-dtags.patch \
gnu/packages/patches/binutils-loongson-workaround.patch \
gnu/packages/patches/bitlbee-configure-doc-fix.patch \
gnu/packages/patches/bluez-tests.patch \
gnu/packages/patches/boost-mips-avoid-m32.patch \
gnu/packages/patches/byobu-writable-status.patch \
gnu/packages/patches/calibre-drop-unrar.patch \
@ -468,7 +467,6 @@ dist_patch_DATA = \
gnu/packages/patches/flint-ldconfig.patch \
gnu/packages/patches/fltk-shared-lib-defines.patch \
gnu/packages/patches/freeimage-CVE-2015-0852.patch \
gnu/packages/patches/fuse-CVE-2015-3202.patch \
gnu/packages/patches/gawk-shell.patch \
gnu/packages/patches/gcc-arm-link-spec-fix.patch \
gnu/packages/patches/gcc-cross-environment-variables.patch \
@ -499,6 +497,7 @@ dist_patch_DATA = \
gnu/packages/patches/gobject-introspection-cc.patch \
gnu/packages/patches/gobject-introspection-girepository.patch \
gnu/packages/patches/grep-timing-sensitive-test.patch \
gnu/packages/patches/grub-CVE-2015-8370.patch \
gnu/packages/patches/grub-gets-undeclared.patch \
gnu/packages/patches/grub-freetype.patch \
gnu/packages/patches/guile-1.8-cpp-4.5.patch \
@ -514,7 +513,6 @@ dist_patch_DATA = \
gnu/packages/patches/hydra-automake-1.15.patch \
gnu/packages/patches/hydra-disable-darcs-test.patch \
gnu/packages/patches/icecat-avoid-bundled-includes.patch \
gnu/packages/patches/icecat-freetype-2.6.patch \
gnu/packages/patches/icu4c-CVE-2014-6585.patch \
gnu/packages/patches/icu4c-CVE-2015-1270.patch \
gnu/packages/patches/icu4c-CVE-2015-4760.patch \
@ -646,6 +644,7 @@ dist_patch_DATA = \
gnu/packages/patches/python-3-search-paths.patch \
gnu/packages/patches/python-disable-ssl-test.patch \
gnu/packages/patches/python-fix-tests.patch \
gnu/packages/patches/python-ipython-inputhook-ctype.patch \
gnu/packages/patches/python2-rdflib-drop-sparqlwrapper.patch \
gnu/packages/patches/python-configobj-setuptools.patch \
gnu/packages/patches/python2-pygobject-2-gi-info-type-error-domain.patch \

61
gnu/build/file-systems.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -23,6 +23,7 @@
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 format)
#:use-module (ice-9 regex)
#:use-module (system foreign)
#:autoload (system repl repl) (start-repl)
#:use-module (srfi srfi-1)
@ -34,6 +35,9 @@
find-partition-by-uuid
canonicalize-device-spec
uuid->string
string->uuid
MS_RDONLY
MS_NOSUID
MS_NODEV
@ -213,6 +217,11 @@ or #f if none was found."
(disk-partitions))
(cut string-append "/dev/" <>)))
;;;
;;; UUIDs.
;;;
(define-syntax %network-byte-order
(identifier-syntax (endianness big)))
@ -228,6 +237,41 @@ like \"6b700d61-5550-48a1-874c-a3d86998990e\"."
(format #f "~8,'0x-~4,'0x-~4,'0x-~4,'0x-~12,'0x"
time-low time-mid time-hi clock-seq node)))
(define %uuid-rx
;; The regexp of a UUID.
(make-regexp "^([[:xdigit:]]{8})-([[:xdigit:]]{4})-([[:xdigit:]]{4})-([[:xdigit:]]{4})-([[:xdigit:]]{12})$"))
(define (string->uuid str)
"Parse STR as a DCE UUID (see <https://tools.ietf.org/html/rfc4122>) and
return its contents as a 16-byte bytevector. Return #f if STR is not a valid
UUID representation."
(and=> (regexp-exec %uuid-rx str)
(lambda (match)
(letrec-syntax ((hex->number
(syntax-rules ()
((_ index)
(string->number (match:substring match index)
16))))
(put!
(syntax-rules ()
((_ bv index (number len) rest ...)
(begin
(bytevector-uint-set! bv index number
(endianness big) len)
(put! bv (+ index len) rest ...)))
((_ bv index)
bv))))
(let ((time-low (hex->number 1))
(time-mid (hex->number 2))
(time-hi (hex->number 3))
(clock-seq (hex->number 4))
(node (hex->number 5))
(uuid (make-bytevector 16)))
(put! uuid 0
(time-low 4) (time-mid 2) (time-hi 2)
(clock-seq 2) (node 6)))))))
(define* (canonicalize-device-spec spec #:optional (title 'any))
"Return the device name corresponding to SPEC. TITLE is a symbol, one of
the following:
@ -251,9 +295,12 @@ the following:
;; The realm of canonicalization.
(if (eq? title 'any)
(if (string? spec)
(if (string-prefix? "/" spec)
'device
'label)
;; The "--root=SPEC" kernel command-line option always provides a
;; string, but the string can represent a device, a UUID, or a
;; label. So check for all three.
(cond ((string-prefix? "/" spec) 'device)
((string->uuid spec) 'uuid)
(else 'label))
'uuid)
title))
@ -279,7 +326,11 @@ the following:
;; Resolve the label.
(resolve find-partition-by-label spec identity))
((uuid)
(resolve find-partition-by-uuid spec uuid->string))
(resolve find-partition-by-uuid
(if (string? spec)
(string->uuid spec)
spec)
uuid->string))
(else
(error "unknown device title" title))))

61
gnu/packages.scm
View File

@ -46,10 +46,6 @@
find-best-packages-by-name
find-newest-available-packages
package-direct-dependents
package-transitive-dependents
package-covering-dependents
check-package-freshness
specification->package
@ -262,63 +258,6 @@ VERSION."
((_ version pkgs ...) pkgs)
(#f '()))))
(define* (vhash-refq vhash key #:optional (dflt #f))
"Look up KEY in the vhash VHASH, and return the value (if any) associated
with it. If KEY is not found, return DFLT (or `#f' if no DFLT argument is
supplied). Uses `eq?' for equality testing."
(or (and=> (vhash-assq key vhash) cdr)
dflt))
(define package-dependencies
(memoize
(lambda ()
"Return a vhash keyed by package, and with associated values that are a
list of packages that depend on that package."
(fold-packages
(lambda (package dag)
(fold
(lambda (in d)
;; Insert a graph edge from each of package's inputs to package.
(vhash-consq in
(cons package (vhash-refq d in '()))
(vhash-delq in d)))
dag
(match (package-direct-inputs package)
(((labels packages . _) ...)
packages) )))
vlist-null))))
(define (package-direct-dependents packages)
"Return a list of packages from the distribution that directly depend on the
packages in PACKAGES."
(delete-duplicates
(concatenate
(map (lambda (p)
(vhash-refq (package-dependencies) p '()))
packages))))
(define (package-transitive-dependents packages)
"Return the transitive dependent packages of the distribution packages in
PACKAGES---i.e. the dependents of those packages, plus their dependents,
recursively."
(let ((dependency-dag (package-dependencies)))
(fold-tree
cons '()
(lambda (node) (vhash-refq dependency-dag node))
;; Start with the dependents to avoid including PACKAGES in the result.
(package-direct-dependents packages))))
(define (package-covering-dependents packages)
"Return a minimal list of packages from the distribution whose dependencies
include all of PACKAGES and all packages that depend on PACKAGES."
(let ((dependency-dag (package-dependencies)))
(fold-tree-leaves
cons '()
(lambda (node) (vhash-refq dependency-dag node))
;; Start with the dependents to avoid including PACKAGES in the result.
(package-direct-dependents packages))))
(define %sigint-prompt
;; The prompt to jump to upon SIGINT.

252
gnu/packages/admin.scm
View File

@ -2,7 +2,7 @@
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2015 Alex Sassmannshausen <alex.sassmannshausen@gmail.com>
;;; Copyright © 2015 Eric Dvorsak <eric@dvorsak.fr>
@ -388,99 +388,142 @@ connection alive.")
(license license:gpl3+)))
(define-public isc-dhcp
(package
(name "isc-dhcp")
(version "4.3.1")
(source (origin
(method url-fetch)
(uri (string-append "http://ftp.isc.org/isc/dhcp/"
version "/dhcp-" version ".tar.gz"))
(sha256
(base32
"1w4s7sni1m9223ya8m2a64lr62845c6xlraprjf8zfx6lylbqv16"))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-cons-after
'configure 'post-configure
(lambda* (#:key outputs #:allow-other-keys)
;; Point to the right client script, which will be
;; installed in a later phase.
(substitute* "includes/dhcpd.h"
(("#define[[:blank:]]+_PATH_DHCLIENT_SCRIPT.*")
(let ((out (assoc-ref outputs "out")))
(string-append "#define _PATH_DHCLIENT_SCRIPT \""
out "/libexec/dhclient-script"
"\"\n"))))
(let* ((bind-major-version "9")
(bind-minor-version "9")
(bind-patch-version "8")
(bind-release-type "-P")
(bind-release-version "2")
(bind-version (string-append bind-major-version
"."
bind-minor-version
"."
bind-patch-version
bind-release-type
bind-release-version)))
(package
(name "isc-dhcp")
(version "4.3.3")
(source (origin
(method url-fetch)
(uri (string-append "http://ftp.isc.org/isc/dhcp/"
version "/dhcp-" version ".tar.gz"))
(sha256
(base32
"1pjy4lylx7dww1fp2mk5ikya5vxaf97z70279j81n74vn12ljg2m"))))
(build-system gnu-build-system)
(arguments
`(#:parallel-build? #f
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'replace-bundled-bind
(lambda* (#:key inputs #:allow-other-keys)
(delete-file "bind/bind.tar.gz")
(copy-file (assoc-ref inputs "bind-source-tarball")
"bind/bind.tar.gz")
(chmod "bind/bind.tar.gz" #o644)
(substitute* "bind/version.tmp"
(("^MAJORVER=.*")
(format #f "MAJORVER=~a\n" ,bind-major-version))
(("^MINORVER=.*")
(format #f "MINORVER=~a\n" ,bind-minor-version))
(("^PATCHVER=.*")
(format #f "PATCHVER=~a\n" ,bind-patch-version))
(("^RELEASETYPE=.*")
(format #f "RELEASETYPE=~a\n" ,bind-release-type))
(("^RELEASEVER=.*")
(format #f "RELEASEVER=~a\n" ,bind-release-version)))
#t))
(add-after 'configure 'post-configure
(lambda* (#:key outputs #:allow-other-keys)
;; Point to the right client script, which will be
;; installed in a later phase.
(substitute* "includes/dhcpd.h"
(("#define[[:blank:]]+_PATH_DHCLIENT_SCRIPT.*")
(let ((out (assoc-ref outputs "out")))
(string-append "#define _PATH_DHCLIENT_SCRIPT \""
out "/libexec/dhclient-script"
"\"\n"))))
;; During the 'build' phase, 'bind.tar.gz' is extracted, so
;; we must patch shebangs in there and make sure the right
;; shell is used.
(with-directory-excursion "bind"
(substitute* "Makefile"
(("\\./configure")
(let ((sh (which "sh")))
(string-append "./configure CONFIG_SHELL="
sh " SHELL=" sh))))
;; During the 'build' phase, 'bind.tar.gz' is extracted, so
;; we must patch shebangs in there and make sure the right
;; shell is used.
(with-directory-excursion "bind"
(substitute* "Makefile"
(("\\./configure")
(let ((sh (which "sh")))
(string-append "./configure CONFIG_SHELL="
sh " SHELL=" sh))))
(system* "tar" "xf" "bind.tar.gz")
(for-each patch-shebang
(find-files "bind-9.9.5-P1" ".*"))
(zero? (system* "tar" "cf" "bind.tar.gz"
"bind-9.9.5-P1"
;; avoid non-determinism in the archive
"--sort=name"
"--mtime=@0"
"--owner=root:0"
"--group=root:0"))))
(alist-cons-after
'install 'post-install
(lambda* (#:key inputs outputs #:allow-other-keys)
;; Install the dhclient script for GNU/Linux and make sure
;; if finds all the programs it needs.
(let* ((out (assoc-ref outputs "out"))
(libexec (string-append out "/libexec"))
(coreutils (assoc-ref inputs "coreutils"))
(inetutils (assoc-ref inputs "inetutils"))
(net-tools (assoc-ref inputs "net-tools"))
(sed (assoc-ref inputs "sed")))
(substitute* "client/scripts/linux"
(("/sbin/ip")
(string-append (assoc-ref inputs "iproute")
"/sbin/ip")))
(let ((bind-directory (string-append "bind-" ,bind-version)))
(system* "tar" "xf" "bind.tar.gz")
(for-each patch-shebang
(find-files bind-directory ".*"))
(zero? (system* "tar" "cf" "bind.tar.gz"
bind-directory
;; avoid non-determinism in the archive
"--sort=name"
"--mtime=@0"
"--owner=root:0"
"--group=root:0"))))))
(add-after 'install 'post-install
(lambda* (#:key inputs outputs #:allow-other-keys)
;; Install the dhclient script for GNU/Linux and make sure
;; if finds all the programs it needs.
(let* ((out (assoc-ref outputs "out"))
(libexec (string-append out "/libexec"))
(coreutils (assoc-ref inputs "coreutils"))
(inetutils (assoc-ref inputs "inetutils"))
(net-tools (assoc-ref inputs "net-tools"))
(sed (assoc-ref inputs "sed")))
(substitute* "client/scripts/linux"
(("/sbin/ip")
(string-append (assoc-ref inputs "iproute")
"/sbin/ip")))
(mkdir-p libexec)
(copy-file "client/scripts/linux"
(string-append libexec "/dhclient-script"))
(mkdir-p libexec)
(copy-file "client/scripts/linux"
(string-append libexec "/dhclient-script"))
(wrap-program
(string-append libexec "/dhclient-script")
`("PATH" ":" prefix
,(map (lambda (dir)
(string-append dir "/bin:"
dir "/sbin"))
(list inetutils net-tools coreutils sed))))))
%standard-phases))))
(wrap-program
(string-append libexec "/dhclient-script")
`("PATH" ":" prefix
,(map (lambda (dir)
(string-append dir "/bin:"
dir "/sbin"))
(list inetutils net-tools coreutils sed))))))))))
(native-inputs `(("perl" ,perl)))
(native-inputs `(("perl" ,perl)))
(inputs `(("inetutils" ,inetutils)
("net-tools" ,net-tools)
("iproute" ,iproute)
(inputs `(("inetutils" ,inetutils)
("net-tools" ,net-tools)
("iproute" ,iproute)
;; When cross-compiling, we need the cross Coreutils and sed.
;; Otherwise just use those from %FINAL-INPUTS.
,@(if (%current-target-system)
`(("coreutils" ,coreutils)
("sed" ,sed))
'())))
;; XXX isc-dhcp bundles a copy of bind that has security
;; flaws, so we use a newer version.
("bind-source-tarball"
,(origin
(method url-fetch)
(uri (string-append "http://ftp.isc.org/isc/bind9/"
bind-version
"/bind-" bind-version ".tar.gz"))
(sha256
(base32
"0agkpmpna7s67la13krn4xlhwhdjpazmljxlq0zbjdwnw4k1k17m"))))
(home-page "http://www.isc.org/products/DHCP/")
(synopsis "Dynamic Host Configuration Protocol (DHCP) tools")
(description
"ISC's Dynamic Host Configuration Protocol (DHCP) distribution provides a
;; When cross-compiling, we need the cross Coreutils and sed.
;; Otherwise just use those from %FINAL-INPUTS.
,@(if (%current-target-system)
`(("coreutils" ,coreutils)
("sed" ,sed))
'())))
(home-page "http://www.isc.org/products/DHCP/")
(synopsis "Dynamic Host Configuration Protocol (DHCP) tools")
(description
"ISC's Dynamic Host Configuration Protocol (DHCP) distribution provides a
reference implementation of all aspects of DHCP, through a suite of DHCP
tools: server, client, and relay agent.")
(license license:isc)))
(license license:isc))))
(define-public libpcap
(package
@ -1233,3 +1276,44 @@ handles configuration-management, application deployment, cloud provisioning,
ad-hoc task-execution, and multinode orchestration - including trivializing
things like zero downtime rolling updates with load balancers.")
(license license:gpl3+)))
(define-public cpulimit
(package
(name "cpulimit")
(version "0.2")
(source
(origin
(method url-fetch)
(uri (string-append "https://github.com/opsengine/cpulimit/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1nn2w849xd5bw4y5sqnll29nxdwl5h0cv4smc7dwmpb9qnd2ycb4"))))
(build-system gnu-build-system)
(arguments
`(#:phases (modify-phases %standard-phases
(delete 'configure)
(replace
'build
(lambda _
(zero? (system* "make" "CC=gcc" "-Csrc"))))
(replace
'check
(lambda _
(zero? (system* "make" "CC=gcc" "-Ctests"))))
(replace
'install
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin")))
(install-file "src/cpulimit" bin)))))))
(home-page "https://github.com/opsengine/cpulimit")
(synopsis "Limit CPU usage")
(description
"Cpulimit limits the CPU usage of a process. It does not change the nice
value or other scheduling priority settings, but the real CPU usage, and is
able to adapt itself dynamically to the overall system load. Children
processes and threads of the specified process may optionally share the same
limits.")
(license license:gpl2+)))

80
gnu/packages/audio.scm
View File

@ -817,15 +817,20 @@ plugin function as a JACK application.")
(package
(name "ladspa")
(version "1.13")
(source (origin
(method url-fetch)
(uri (string-append
"http://www.ladspa.org/download/ladspa_sdk_"
version
".tgz"))
(sha256
(base32
"0srh5n2l63354bc0srcrv58rzjkn4gv8qjqzg8dnq3rs4m7kzvdm"))))
(source
(origin
(method url-fetch)
;; Since the official link is dead,
;; we download the tarball from Debian or Internet Archive.
(uri (list (string-append "http://http.debian.net"
"/debian/pool/main/l/ladspa-sdk/ladspa-sdk_"
version ".orig.tar.gz")
(string-append "https://web.archive.org/web/20140717172251/"
"http://www.ladspa.org/download/ladspa_sdk_"
version ".tgz")))
(sha256
(base32
"0srh5n2l63354bc0srcrv58rzjkn4gv8qjqzg8dnq3rs4m7kzvdm"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; the "test" target is a listening test only
@ -843,7 +848,9 @@ plugin function as a JACK application.")
(("^CC.*") "CC = gcc\n")
(("^CPP.*") "CPP = g++\n"))))
(alist-delete 'build %standard-phases))))
(home-page "http://ladspa.org")
;; Since the home page is gone, we provide a link to the archived version.
(home-page
"https://web.archive.org/web/20140729190945/http://www.ladspa.org/")
(synopsis "Linux Audio Developer's Simple Plugin API (LADSPA)")
(description
"LADSPA is a standard that allows software audio processors and effects
@ -1953,3 +1960,56 @@ access to ALSA PCM devices, taking care of the many functions required to
open, initialise and use a hw: device in mmap mode, and providing floating
point audio data.")
(license license:gpl3+)))
(define-public cuetools
(package
(name "cuetools")
(version "1.4.1")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/svend/cuetools/archive/"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"01xi3rvdmil9nawsha04iagjylqr1l9v9vlzk99scs8c207l58i4"))))
(build-system gnu-build-system)
;; The source tarball is not bootstrapped.
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'bootstrap
(lambda _ (zero? (system* "autoreconf" "-vfi")))))))
;; Bootstrapping tools
(native-inputs
`(("autoconf" ,autoconf)
("automake" ,automake)
("flex" ,flex)
("bison" ,bison)))
(synopsis "Cue and toc file parsers and utilities")
(description "Cuetools is a set of programs that are useful for manipulating
and using CUE sheet (cue) files and Table of Contents (toc) files. CUE and TOC
files are a way to represent the layout of a data or audio CD in a
machine-readable ASCII format.")
(home-page "https://github.com/svend/cuetools")
(license license:gpl2+)))
(define-public shntool
(package
(name "shntool")
(version "3.0.10")
(source (origin
(method url-fetch)
(uri (string-append "http://etree.org/shnutils/shntool/dist/src/"
"shntool-" version ".tar.gz"))
(sha256
(base32
"00i1rbjaaws3drkhiczaign3lnbhr161b7rbnjr8z83w8yn2wc3l"))))
(build-system gnu-build-system)
(synopsis "WAVE audio data processing tool")
(description "shntool is a multi-purpose WAVE data processing and reporting
utility. File formats are abstracted from its core, so it can process any file
that contains WAVE data, compressed or not---provided there exists a format
module to handle that particular file type.")
(home-page "http://etree.org/shnutils/shntool/")
(license license:gpl3+)))

301
gnu/packages/bioinformatics.scm
View File

@ -40,6 +40,7 @@
#:use-module (gnu packages compression)
#:use-module (gnu packages cpio)
#:use-module (gnu packages file)
#:use-module (gnu packages gawk)
#:use-module (gnu packages java)
#:use-module (gnu packages linux)
#:use-module (gnu packages machine-learning)
@ -1354,6 +1355,87 @@ supports next-generation sequencing data in fasta/q and csfasta/q format from
Illumina, Roche 454, and the SOLiD platform.")
(license license:gpl3)))
(define-public fraggenescan
(package
(name "fraggenescan")
(version "1.20")
(source
(origin
(method url-fetch)
(uri
(string-append "mirror://sourceforge/fraggenescan/"
"FragGeneScan" version ".tar.gz"))
(sha256
(base32 "1zzigqmvqvjyqv4945kv6nc5ah2xxm1nxgrlsnbzav3f5c0n0pyj"))))
(build-system gnu-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(delete 'configure)
(add-before 'build 'patch-paths
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (string-append (assoc-ref outputs "out")))
(share (string-append out "/share/fraggenescan/")))
(substitute* "run_FragGeneScan.pl"
(("system\\(\"rm")
(string-append "system(\"" (which "rm")))
(("system\\(\"mv")
(string-append "system(\"" (which "mv")))
;; This script and other programs expect the training files
;; to be in the non-standard location bin/train/XXX. Change
;; this to be share/fraggenescan/train/XXX instead.
(("^\\$train.file = \\$dir.*")
(string-append "$train_file = \""
share
"train/\".$FGS_train_file;")))
(substitute* "run_hmm.c"
(("^ strcat\\(train_dir, \\\"train/\\\"\\);")
(string-append " strcpy(train_dir, \"" share "/train/\");")))
(substitute* "post_process.pl"
(("^my \\$dir = substr.*")
(string-append "my $dir = \"" share "\";"))))
#t))
(replace 'build
(lambda _ (and (zero? (system* "make" "clean"))
(zero? (system* "make" "fgs")))))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (string-append (assoc-ref outputs "out")))
(bin (string-append out "/bin/"))
(share (string-append out "/share/fraggenescan/train")))
(install-file "run_FragGeneScan.pl" bin)
(install-file "FragGeneScan" bin)
(install-file "FGS_gff.py" bin)
(install-file "post_process.pl" bin)
(copy-recursively "train" share))))
(delete 'check)
(add-after 'install 'post-install-check
;; In lieu of 'make check', run one of the examples and check the
;; output files gets created.
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (string-append (assoc-ref outputs "out")))
(bin (string-append out "/bin/")))
(and (zero? (system* (string-append bin "run_FragGeneScan.pl")
"-genome=./example/NC_000913.fna"
"-out=./test2"
"-complete=1"
"-train=complete"))
(file-exists? "test2.faa")
(file-exists? "test2.ffn")
(file-exists? "test2.gff")
(file-exists? "test2.out"))))))))
(inputs
`(("perl" ,perl)
("python" ,python-2))) ;not compatible with python 3.
(home-page "https://sourceforge.net/projects/fraggenescan/")
(synopsis "Finds potentially fragmented genes in short reads")
(description
"FragGeneScan is a program for predicting bacterial and archaeal genes in
short and error-prone DNA sequencing reads. It can also be applied to predict
genes in incomplete assemblies or complete genomes.")
;; GPL3+ according to private correspondense with the authors.
(license license:gpl3+)))
(define-public grit
(package
(name "grit")
@ -1690,7 +1772,7 @@ sequencing tag position and orientation.")
(define-public mafft
(package
(name "mafft")
(version "7.221")
(version "7.267")
(source (origin
(method url-fetch)
(uri (string-append
@ -1699,7 +1781,7 @@ sequencing tag position and orientation.")
(file-name (string-append name "-" version ".tgz"))
(sha256
(base32
"0xi7klbsgi049vsrk6jiwh9wfj3b770gz3c8c7zwij448v0dr73d"))))
"1xl6xq1rfxkws0svrlhyqxhhwbv6r77jwblsdpcyiwzsscw6wlk0"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; no automated tests, though there are tests in the read me
@ -1720,6 +1802,9 @@ sequencing tag position and orientation.")
;; remove mafft-homologs.rb from SCRIPTS
(("^SCRIPTS = mafft mafft-homologs.rb")
"SCRIPTS = mafft")
;; remove mafft-homologs from MANPAGES
(("^MANPAGES = mafft.1 mafft-homologs.1")
"MANPAGES = mafft.1")
;; remove mafft-distance from PROGS
(("^PROGS = dvtditr dndfast7 dndblast sextet5 mafft-distance")
"PROGS = dvtditr dndfast7 dndblast sextet5")
@ -1732,9 +1817,22 @@ sequencing tag position and orientation.")
(("^\t\\$\\(INSTALL\\) -m 644 \\$\\(MANPAGES\\) \
\\$\\(DESTDIR\\)\\$\\(LIBDIR\\)") "#"))
#t))
(add-after 'enter-dir 'patch-paths
(lambda* (#:key inputs #:allow-other-keys)
(substitute* '("pairash.c"
"mafft.tmpl")
(("perl") (which "perl"))
(("([\"`| ])awk" _ prefix)
(string-append prefix (which "awk")))
(("grep") (which "grep")))
#t))
(delete 'configure))))
(inputs
`(("perl" ,perl)))
`(("perl" ,perl)
("gawk" ,gawk)
("grep" ,grep)))
(propagated-inputs
`(("coreutils" ,coreutils)))
(home-page "http://mafft.cbrc.jp/alignment/software/")
(synopsis "Multiple sequence alignment program")
(description
@ -3123,6 +3221,203 @@ BLAST, KEGG, GenBank, MEDLINE and GO.")
;; (LGPLv2.1+) and scripts in samples (which have GPL2 and GPL2+)
(license (list license:ruby license:lgpl2.1+ license:gpl2+ ))))
(define-public r-acsnminer
(package
(name "r-acsnminer")
(version "0.15.11")
(source (origin
(method url-fetch)
(uri (cran-uri "ACSNMineR" version))
(sha256
(base32
"1dl4drhjyazwm9wxlm8yfppwvvj4h6jxwmz8kfw5bxpb3jdnsqvy"))))
(properties `((upstream-name . "ACSNMineR")))
(build-system r-build-system)
(propagated-inputs
`(("r-ggplot2" ,r-ggplot2)
("r-gridextra" ,r-gridextra)))
(home-page "http://cran.r-project.org/web/packages/ACSNMineR")
(synopsis "Gene enrichment analysis")
(description
"This package provides tools to compute and represent gene set enrichment
or depletion from your data based on pre-saved maps from the @dfn{Atlas of
Cancer Signalling Networks} (ACSN) or user imported maps. The gene set
enrichment can be run with hypergeometric test or Fisher exact test, and can
use multiple corrections. Visualization of data can be done either by
barplots or heatmaps.")
(license license:gpl2+)))
(define-public r-biocgenerics
(package
(name "r-biocgenerics")
(version "0.16.1")
(source (origin
(method url-fetch)
(uri (bioconductor-uri "BiocGenerics" version))
(sha256
(base32
"0f16ryy5f012hvksrwlmm33bcl7lw97i2jvhbnwfwl03j4w7nhc1"))))
(properties
`((upstream-name . "BiocGenerics")
(r-repository . bioconductor)))
(build-system r-build-system)
(home-page "http://bioconductor.org/packages/BiocGenerics")
(synopsis "S4 generic functions for Bioconductor")
(description
"This package provides S4 generic functions needed by many Bioconductor
packages.")
(license license:artistic2.0)))
(define-public r-s4vectors
(package
(name "r-s4vectors")
(version "0.8.5")
(source (origin
(method url-fetch)
(uri (bioconductor-uri "S4Vectors" version))
(sha256
(base32
"10f4jxwlwsiy7zhb3kgp6anid0d7wkvrrljl80r3nhx38yr24l5k"))))
(properties
`((upstream-name . "S4Vectors")
(r-repository . bioconductor)))
(build-system r-build-system)
(propagated-inputs
`(("r-biocgenerics" ,r-biocgenerics)))
(home-page "http://bioconductor.org/packages/S4Vectors")
(synopsis "S4 implementation of vectors and lists")
(description
"The S4Vectors package defines the @code{Vector} and @code{List} virtual
classes and a set of generic functions that extend the semantic of ordinary
vectors and lists in R. Package developers can easily implement vector-like
or list-like objects as concrete subclasses of @code{Vector} or @code{List}.
In addition, a few low-level concrete subclasses of general interest (e.g.
@code{DataFrame}, @code{Rle}, and @code{Hits}) are implemented in the
S4Vectors package itself.")
(license license:artistic2.0)))
(define-public r-iranges
(package
(name "r-iranges")
(version "2.4.6")
(source (origin
(method url-fetch)
(uri (bioconductor-uri "IRanges" version))
(sha256
(base32
"00x0266sys1fc5ipa639y84p6m6mgspk2xb099vcwmd3w4hypj9d"))))
(properties
`((upstream-name . "IRanges")
(r-repository . bioconductor)))
(build-system r-build-system)
(propagated-inputs
`(("r-biocgenerics" ,r-biocgenerics)
("r-s4vectors" ,r-s4vectors)))
(home-page "http://bioconductor.org/packages/IRanges")
(synopsis "Infrastructure for manipulating intervals on sequences")
(description
"This package provides efficient low-level and highly reusable S4 classes
for storing ranges of integers, RLE vectors (Run-Length Encoding), and, more
generally, data that can be organized sequentially (formally defined as
@code{Vector} objects), as well as views on these @code{Vector} objects.
Efficient list-like classes are also provided for storing big collections of
instances of the basic classes. All classes in the package use consistent
naming and share the same rich and consistent \"Vector API\" as much as
possible.")
(license license:artistic2.0)))
(define-public r-genomeinfodb
(package
(name "r-genomeinfodb")
(version "1.6.1")
(source (origin
(method url-fetch)
(uri (bioconductor-uri "GenomeInfoDb" version))
(sha256
(base32
"1j2n1v1mrw1fxn7cyffz112pm76wd6gy9q9qwlsfv3brbsqbvdbf"))))
(properties
`((upstream-name . "GenomeInfoDb")
(r-repository . bioconductor)))
(build-system r-build-system)
(propagated-inputs
`(("r-biocgenerics" ,r-biocgenerics)
("r-iranges" ,r-iranges)
("r-s4vectors" ,r-s4vectors)))
(home-page "http://bioconductor.org/packages/GenomeInfoDb")
(synopsis "Utilities for manipulating chromosome identifiers")
(description
"This package contains data and functions that define and allow
translation between different chromosome sequence naming conventions (e.g.,
\"chr1\" versus \"1\"), including a function that attempts to place sequence
names in their natural, rather than lexicographic, order.")
(license license:artistic2.0)))
(define-public r-xvector
(package
(name "r-xvector")
(version "0.10.0")
(source (origin
(method url-fetch)
(uri (bioconductor-uri "XVector" version))
(sha256
(base32
"0havwyr6xqk7w0rmbwfj9jq1djz7wzdz7w39adhklwzwz9l4ih3a"))))
(properties
`((upstream-name . "XVector")
(r-repository . bioconductor)))
(build-system r-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'use-system-zlib
(lambda _
(substitute* "DESCRIPTION"
(("zlibbioc, ") ""))
(substitute* "NAMESPACE"
(("import\\(zlibbioc\\)") ""))
#t)))))
(inputs
`(("zlib" ,zlib)))
(propagated-inputs
`(("r-biocgenerics" ,r-biocgenerics)
("r-iranges" ,r-iranges)
("r-s4vectors" ,r-s4vectors)))
(home-page "http://bioconductor.org/packages/XVector")
(synopsis "Representation and manpulation of external sequences")
(description
"This package provides memory efficient S4 classes for storing sequences
\"externally\" (behind an R external pointer, or on disk).")
(license license:artistic2.0)))
(define-public r-genomicranges
(package
(name "r-genomicranges")
(version "1.22.2")
(source (origin
(method url-fetch)
(uri (bioconductor-uri "GenomicRanges" version))
(sha256
(base32
"1jffvcs0jsi7q4l3pvjj6r73vll80csgkljvhqp0g2ixc43jjng9"))))
(properties
`((upstream-name . "GenomicRanges")
(r-repository . bioconductor)))
(build-system r-build-system)
(propagated-inputs
`(("r-biocgenerics" ,r-biocgenerics)
("r-genomeinfodb" ,r-genomeinfodb)
("r-xvector" ,r-xvector)))
(home-page "http://bioconductor.org/packages/GenomicRanges")
(synopsis "Representation and manipulation of genomic intervals")
(description
"This package provides tools to efficiently represent and manipulate
genomic annotations and alignments is playing a central role when it comes to
analyzing high-throughput sequencing data (a.k.a. NGS data). The
GenomicRanges package defines general purpose containers for storing and
manipulating genomic intervals and variables defined along a genome.")
(license license:artistic2.0)))
(define-public r-qtl
(package
(name "r-qtl")

5
gnu/packages/bittorrent.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Taylan Ulrich Bayirli/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -28,8 +28,7 @@
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages file)
#:use-module (gnu packages linux)
#:use-module ((gnu packages compression)
#:select (zlib))
#:use-module (gnu packages compression)
#:use-module (gnu packages glib)
#:use-module (gnu packages gtk)
#:use-module (gnu packages check)

5
gnu/packages/cdrom.scm
View File

@ -240,8 +240,9 @@ capacity is user-selectable.")
(version "1.4.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/libcue/libcue-"
version ".tar.bz2"))
(uri (string-append "https://github.com/lipnitsk/libcue/releases"
"/download/v" version
"/libcue-" version ".tar.bz2"))
(sha256
(base32
"17kjd7rjz1bvfn44n3n2bjb7a1ywd0yc0g4sqp5ihf9b5bn7cwlb"))))

32
gnu/packages/code.scm
View File

@ -280,3 +280,35 @@ stack traces.")
;; Sources are released under Expat license, but since BFD is licensed
;; under the GPLv3+ the combined work is GPLv3+ as well.
(license license:gpl3+)))
(define-public lcov
(package
(name "lcov")
(version "1.10")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/ltp/lcov-"
version ".tar.gz"))
(sha256
(base32
"13xq2ln4jjasslqzzhr5g11q1c19gwpng1jphzbzmylmrjz62ila"))))
(build-system gnu-build-system)
(arguments
'(#:make-flags (let ((out (assoc-ref %outputs "out")))
(list (string-append "PREFIX=" out)
(string-append "BIN_DIR=" out "/bin")
(string-append "MAN_DIR=" out "/share/man")))
#:phases (modify-phases %standard-phases
(delete 'configure))
#:tests? #f)) ;no 'check' target
(inputs `(("perl" ,perl)))
(home-page "http://ltp.sourceforge.net/coverage/lcov.php")
(synopsis "Code coverage tool that enhances GNU gcov")
(description
"LCOV is an extension of @command{gcov}, a tool part of the
GNU@tie{}Binutils, which provides information about what parts of a program
are actually executed (i.e., \"covered\") while running a particular test
case. The extension consists of a set of Perl scripts which build on the
textual @command{gcov} output to implement the following enhanced
functionality such as HTML output.")
(license license:gpl2+)))

9
gnu/packages/crypto.scm
View File

@ -30,9 +30,12 @@
(version "1.0.0")
(source (origin
(method url-fetch)
(uri (string-append
"http://download.libsodium.org/libsodium/releases/libsodium-"
version ".tar.gz"))
(uri (list (string-append
"http://download.libsodium.org/libsodium/"
"releases/libsodium-" version ".tar.gz")
(string-append
"https://download.libsodium.org/libsodium/"
"releases/old/libsodium-" version ".tar.gz")))
(sha256
(base32
"19f9vf0shfp4rc4l791r6xjg06z4i8psj1zkjkm3z5b640yzxlff"))))

5
gnu/packages/cups.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@ -37,7 +38,7 @@
(define-public cups-filters
(package
(name "cups-filters")
(version "1.0.75")
(version "1.4.0")
(source (origin
(method url-fetch)
(uri
@ -45,7 +46,7 @@
"cups-filters-" version ".tar.xz"))
(sha256
(base32
"0wrh9jmd2rm4z8c8nb50llb10shj1hik9vwqnr0djcvf63mfqsbw"))
"16jpqqlixlv2dxqv8gak5qg4qnsnw4p745xr6rhw9dgylf13z9ha"))
(modules '((guix build utils)))
(snippet
;; install backends, banners and filters to cups-filters output

53
gnu/packages/cursynth.scm
View File

@ -1,53 +0,0 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.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/>.
(define-module (gnu packages cursynth)
#:use-module (guix packages)
#:use-module (guix licenses)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages linux))
(define-public cursynth
(package
(name "cursynth")
(version "1.5")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/cursynth/cursynth-"
version ".tar.gz"))
(sha256
(base32 "1dhphsya41rv8z6yqcv9l6fwbslsds4zh1y56zizi39nd996d40v"))
(patches (list (search-patch "cursynth-wave-rand.patch")))))
(build-system gnu-build-system)
(native-inputs `(("pkg-config" ,pkg-config)))
;; TODO: See https://github.com/iyoko/cursynth/issues/4 which currently
;; prevents us from using pulseaudio
(inputs `(("ncurses" ,ncurses)
("alsa" ,alsa-lib)))
(home-page "http://www.gnu.org/software/cursynth")
(synopsis "Polyphonic and MIDI subtractive music synthesizer using curses")
(description "GNU cursynth is a polyphonic synthesizer that runs
graphically in the terminal. It is built on a full-featured subtractive
synthesis engine. Notes and parameter changes may be entered via MIDI or the
computer's keyboard.")
(license gpl3+)))

6
gnu/packages/databases.scm
View File

@ -390,14 +390,14 @@ is in the public domain.")
(define-public tdb
(package
(name "tdb")
(version "1.3.0")
(version "1.3.8")
(source (origin
(method url-fetch)
(uri (string-append "http://samba.org/ftp/tdb/tdb-"
(uri (string-append "https://www.samba.org/ftp/tdb/tdb-"
version ".tar.gz"))
(sha256
(base32
"085sd2kii72fr0c4pdc7c7m0xk34nc66wnjp21c83dss826y9gh4"))))
"1cg6gmpgn36dd4bsp3j9k3hyrm87d8hdigqyyqxw5jga4w2aq186"))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-replace

5
gnu/packages/dictionaries.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -23,8 +23,7 @@
#:use-module (guix build-system trivial)
#:use-module (gnu packages base)
#:use-module (gnu packages texinfo)
#:use-module ((gnu packages compression)
#:select (gzip)))
#:use-module (gnu packages compression))
(define-public vera
(package

3
gnu/packages/disk.scm
View File

@ -29,8 +29,7 @@
#:use-module (gnu packages python)
#:use-module (gnu packages readline)
#:use-module (gnu packages guile)
#:use-module ((gnu packages compression)
#:select (lzip)))
#:use-module (gnu packages compression))
(define-public parted
(package

6
gnu/packages/dns.scm
View File

@ -63,14 +63,14 @@ and BOOTP/TFTP for network booting of diskless machines.")
(define-public bind-utils
(package
(name "bind-utils")
(version "9.10.2-P2")
(version "9.10.3-P2")
(source (origin
(method url-fetch)
(uri (string-append "ftp://ftp.isc.org/isc/bind9/" version
(uri (string-append "http://ftp.isc.org/isc/bind9/" version
"/bind-" version ".tar.gz"))
(sha256
(base32
"0pvcnwd4rzfk3l35ys72p14ly9k857wbn1lxzd4ayjk3i2pz1rmi"))))
"1kbfzml37sx4r2xi4gq48ji8w5kckd1f6gdn6pk6njqdmh8ijv2a"))))
(build-system gnu-build-system)
(inputs
;; it would be nice to add GeoIP and gssapi once there is package

51
gnu/packages/engineering.scm
View File

@ -376,6 +376,57 @@ multipole-accelerated algorithm.")
multipole-accelerated algorithm.")
(license (license:non-copyleft #f "See induct.c."))))
(define-public fritzing
(package
(name "fritzing")
(version "0.9.2b")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/fritzing/"
"fritzing-app/archive/" version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0pvk57z2pxz89pcwwm61lkpvj4w9qxqz8mi0zkpj6pnaljabp7bf"))))
(build-system gnu-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda* (#:key inputs outputs #:allow-other-keys)
(and (zero? (system* "tar"
"-xvf" (assoc-ref inputs "fritzing-parts-db")
"-C" "parts"))
(zero? (system* "qmake"
(string-append "PREFIX="
(assoc-ref outputs "out"))
"phoenix.pro"))))))))
(inputs
`(("qt" ,qt)
("boost" ,boost)
("zlib" ,zlib)
("fritzing-parts-db"
,(origin
(method url-fetch)
(uri (string-append "https://github.com/fritzing/"
"fritzing-parts/archive/" version ".tar.gz"))
(file-name (string-append "fritzing-parts-" version ".tar.gz"))
(sha256
(base32
"0jqr8yjg7177f3pk1fcns584r0qavwpr280nggsi2ff3pwk5wpsz"))))))
(home-page "http://fritzing.org")
(synopsis "Electronic circuit design")
(description
"The Fritzing application is @dfn{Electronic Design Automation} (EDA)
software with a low entry barrier, suited for the needs of makers and
hobbyists. It offers a unique real-life \"breadboard\" view, and a parts
library with many commonly used high-level components. Fritzing makes it very
easy to communicate about circuits, as well as to turn them into PCB layouts
ready for production.")
;; Documentation and parts are released under CC-BY-SA 3.0; source code is
;; released under GPLv3+.
(license (list license:gpl3+ license:cc-by-sa3.0))))
(define-public gerbv
(package
(name "gerbv")

12
gnu/packages/enlightenment.scm
View File

@ -52,7 +52,7 @@
(define-public efl
(package
(name "efl")
(version "1.16.0")
(version "1.16.1")
(source (origin
(method url-fetch)
(uri (string-append
@ -60,7 +60,7 @@
version ".tar.xz"))
(sha256
(base32
"08w3hrjyz1yjqjq77px86fljxxi5xz5yfy79qwssypafjvcvpzky"))))
"116s4lcfj5lrfhyvvka3np9glqyrh21cyl9rhw7al0wgb60vw0gg"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))
@ -135,7 +135,7 @@ removable devices or support for multimedia.")
(define-public elementary
(package
(name "elementary")
(version "1.16.0")
(version "1.16.1")
(source (origin
(method url-fetch)
(uri
@ -143,7 +143,7 @@ removable devices or support for multimedia.")
"elementary/elementary-" version ".tar.xz"))
(sha256
(base32
"1546b7pdpw6nx1hjxy674zr8dgpzwl7lq3hvnv4axkpd4zwkqgs8"))))
"0q58imh7s35q6cq5hsa6gqj84rkckh8s61iass8zyvcw19j66f3y"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))
@ -271,7 +271,7 @@ Libraries with some extra bells and whistles.")
(define-public enlightenment
(package
(name "enlightenment")
(version "0.20.0")
(version "0.20.2")
(source (origin
(method url-fetch)
(uri
@ -279,7 +279,7 @@ Libraries with some extra bells and whistles.")
name "/" name "-" version ".tar.xz"))
(sha256
(base32
"0mwiim0nv640v3af7qxc5ajfk702qkl5c1cnqlhz6rqzr5yjapxv"))))
"0faxky7lqd133jjjkr4c40kwwjhqc51ww10l3yy63671rfjhj424"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags '("--enable-mount-eeze")))

174
gnu/packages/freedesktop.scm
View File

@ -35,6 +35,7 @@
#:use-module (gnu packages autotools)
#:use-module (gnu packages gettext)
#:use-module (gnu packages gperf)
#:use-module (gnu packages gtk)
#:use-module (gnu packages xml)
#:use-module (gnu packages docbook)
#:use-module (gnu packages glib) ;intltool
@ -47,7 +48,8 @@
#:use-module (gnu packages libffi)
#:use-module (gnu packages acl)
#:use-module (gnu packages admin)
#:use-module (gnu packages polkit))
#:use-module (gnu packages polkit)
#:use-module (gnu packages databases))
(define-public xdg-utils
(package
@ -427,3 +429,173 @@ message bus.")
and manipulating user account information and an implementation of these
interfaces, based on the useradd, usermod and userdel commands.")
(license license:gpl3+)))
(define-public libmbim
(package
(name "libmbim")
(version "1.12.2")
(source (origin
(method url-fetch)
(uri (string-append
"http://www.freedesktop.org/software/" name "/"
name "-" version ".tar.xz"))
(sha256
(base32
"0abv0h9c3kbw4bq1b9270sg189jcjj3x3wa91bj836ynwg9m34wl"))))
(build-system gnu-build-system)
(native-inputs
`(("glib:bin" ,glib "bin") ; for glib-mkenums
("pkg-config" ,pkg-config)
("python" ,python-wrapper)))
(propagated-inputs
`(("glib" ,glib))) ; required by mbim-glib.pc
(inputs
`(("libgudev" ,libgudev)))
(synopsis "Library to communicate with MBIM-powered modems")
(home-page "http://www.freedesktop.org/wiki/Software/libmbim/")
(description
"Libmbim is a GLib-based library for talking to WWAN modems and devices
which speak the Mobile Interface Broadband Model (MBIM) protocol.")
(license
;; The libmbim-glib library is released under the LGPLv2+ license.
;; The mbimcli tool is released under the GPLv2+ license.
(list license:lgpl2.0+ license:gpl2+))))
(define-public libqmi
(package
(name "libqmi")
(version "1.12.6")
(source (origin
(method url-fetch)
(uri (string-append
"http://www.freedesktop.org/software/" name "/"
name "-" version ".tar.xz"))
(sha256
(base32
"101ppan2q1h4pyp2zbn9b8sdwy2c7fk9rp91yykxz3afrvzbymq8"))))
(build-system gnu-build-system)
(native-inputs
`(("glib:bin" ,glib "bin") ; for glib-mkenums
("pkg-config" ,pkg-config)
("python" ,python-wrapper)))
(propagated-inputs
`(("glib" ,glib))) ; required by qmi-glib.pc
(synopsis "Library to communicate with QMI-powered modems")
(home-page "http://www.freedesktop.org/wiki/Software/libqmi/")
(description
"Libqmi is a GLib-based library for talking to WWAN modems and devices
which speak the Qualcomm MSM Interface (QMI) protocol.")
(license
;; The libqmi-glib library is released under the LGPLv2+ license.
;; The qmicli tool is released under the GPLv2+ license.
(list license:lgpl2.0+ license:gpl2+))))
(define-public modem-manager
(package
(name "modem-manager")
(version "1.4.12")
(source (origin
(method url-fetch)
(uri (string-append
"http://www.freedesktop.org/software/ModemManager/"
"ModemManager-" version ".tar.xz"))
(sha256
(base32
"1cvhpkbdch9a77sdir0wcks45m2zlvq1sna2ly2v4lx9fm9h7xby"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags
`(,(string-append "--with-udev-base-dir=" %output "/lib/udev"))))
(native-inputs
`(("glib:bin" ,glib "bin") ; for glib-mkenums
("gobject-introspection" ,gobject-introspection)
("intltool" ,intltool)
("pkg-config" ,pkg-config)
("vala" ,vala)
;; For testing.
("dbus" ,dbus)))
(propagated-inputs
`(("glib" ,glib))) ; required by mm-glib.pc
(inputs
`(("libgudev" ,libgudev)
("libmbim" ,libmbim)
("libqmi" ,libqmi)
("polkit" ,polkit)))
(synopsis "Mobile broadband modems manager")
(home-page "http://www.freedesktop.org/wiki/Software/ModemManager/")
(description
"ModemManager is a DBus-activated daemon which controls mobile
broadband (2G/3G/4G) devices and connections. Whether built-in devices, USB
dongles, bluetooth-paired telephones, or professional RS232/USB devices with
external power supplies, ModemManager is able to prepare and configure the
modems and setup connections with them.")
(license license:gpl2+)))
(define-public telepathy-logger
(package
(name "telepathy-logger")
(version "0.8.2")
(source (origin
(method url-fetch)
(uri (string-append "http://telepathy.freedesktop.org/releases/"
name "/" name "-" version ".tar.bz2"))
(sha256
(base32
"1bjx85k7jyfi5pvl765fzc7q2iz9va51anrc2djv7caksqsdbjlg"))))
(build-system gnu-build-system)
(arguments
'(#:phases
(modify-phases %standard-phases
(add-before 'check 'pre-check
(lambda _
(setenv "HOME" (getenv "TMPDIR"))
#t)))))
(native-inputs
`(("glib:bin" ,glib "bin") ; for glib-genmarshal, etc.
("gobject-introspection" ,gobject-introspection)
("intltool" ,intltool)
("pkg-config" ,pkg-config)
("python" ,python-2)
("xsltproc" ,libxslt)))
(propagated-inputs
;; telepathy-logger-0.2.pc refers to all these.
`(("libxml2" ,libxml2)
("sqlite" ,sqlite)
("telepathy-glib" ,telepathy-glib)))
(synopsis "Telepathy logger library")
(home-page "http://telepathy.freedesktop.org/")
(description
"Telepathy logger is a headless observer client that logs information
received by the Telepathy framework. It features pluggable backends to log
different sorts of messages in different formats.")
(license license:lgpl2.1+)))
(define-public colord-gtk
(package
(name "colord-gtk")
(version "0.1.26")
(source (origin
(method url-fetch)
(uri (string-append "http://www.freedesktop.org/software/colord"
"/releases/" name "-" version ".tar.xz"))
(sha256
(base32
"0i9y3bb5apj6a0f8cx36l6mjzs7xc0k7nf0magmf58vy2mzhpl18"))))
(build-system gnu-build-system)
(arguments '(#:tests? #f)) ; require the colord system service
(native-inputs
`(("gobject-introspection" ,gobject-introspection)
("intltool" ,intltool)
("pkg-config" ,pkg-config)
("vala" ,vala)))
(propagated-inputs
;; colord-gtk.pc refers to all these.
`(("colord" ,colord)
("gtk+" ,gtk+)))
(synopsis "GTK integration for libcolord")
(home-page "http://www.freedesktop.org/software/colord/")
(description
"This is a GTK+ convenience library for interacting with colord. It is
useful for both applications which need colour management and applications that
wish to perform colour calibration.")
(license license:lgpl2.1+)))

5
gnu/packages/game-development.scm
View File

@ -266,14 +266,14 @@ archive on a per-file basis.")
(define-public love
(package
(name "love")
(version "0.9.2")
(version "0.10.0")
(source (origin
(method url-fetch)
(uri (string-append "https://bitbucket.org/rude/love/downloads/"
"love-" version "-linux-src.tar.gz"))
(sha256
(base32
"0wn1npr5gal5b1idh4a5fwc3f5c36lsbjd4r4d699rqlviid15d9"))))
"1r2n1nrw3hcdvy14fjbwz3l9swcy65v3lqwpj2frnkkcwncdz94p"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))
@ -281,6 +281,7 @@ archive on a per-file basis.")
`(("devil" ,devil)
("freetype" ,freetype)
("libmodplug" ,libmodplug)
("libtheora" ,libtheora)
("libvorbis" ,libvorbis)
("luajit" ,luajit)
("mesa" ,mesa)

5
gnu/packages/gcc.scm
View File

@ -3,6 +3,7 @@
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014, 2015 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@ -343,14 +344,14 @@ Go. It also includes runtime support libraries for these languages.")
(define-public gcc-5
(package (inherit gcc-4.9)
(version "5.2.0")
(version "5.3.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/gcc/gcc-"
version "/gcc-" version ".tar.bz2"))
(sha256
(base32
"1bccp8a106xwz3wkixn65ngxif112vn90qf95m6lzpgpnl25p0sz"))
"1ny4smkp5bzs3cp8ss7pl6lk8yss0d9m4av1mvdp72r1x695akxq"))
(patches (list (search-patch "gcc-5.0-libvtv-runpath.patch")))))))
(define-public gcc gcc-4.9)

9
gnu/packages/gimp.scm
View File

@ -27,8 +27,7 @@
#:use-module (gnu packages gtk)
#:use-module (gnu packages gnome)
#:use-module (gnu packages image)
#:use-module ((gnu packages ghostscript)
#:select (lcms))
#:use-module (gnu packages ghostscript)
#:use-module (gnu packages compression)
#:use-module (gnu packages xml)
#:use-module (gnu packages photo)
@ -128,6 +127,12 @@ buffers.")
(base32
"0bdj0l7a94jqhjnj40m9rqaf622wj905iximivb55iy98639aanq"))))
(build-system gnu-build-system)
(outputs '("out"
"doc")) ;8 MiB of gtk-doc HTML
(arguments
'(#:configure-flags (list (string-append "--with-html-dir="
(assoc-ref %outputs "doc")
"/share/gtk-doc/html"))))
(inputs
`(("babl" ,babl)
("glib" ,glib)

391
gnu/packages/gnome.scm
View File

@ -42,6 +42,7 @@
#:use-module (gnu packages base)
#:use-module (gnu packages bison)
#:use-module (gnu packages calendar)
#:use-module (gnu packages check)
#:use-module (gnu packages cups)
#:use-module (gnu packages curl)
#:use-module (gnu packages databases)
@ -58,10 +59,12 @@
#:use-module (gnu packages gtk)
#:use-module (gnu packages gperf)
#:use-module (gnu packages guile)
#:use-module (gnu packages openldap)
#:use-module (gnu packages pdf)
#:use-module (gnu packages polkit)
#:use-module (gnu packages popt)
#:use-module (gnu packages ghostscript)
#:use-module (gnu packages ibus)
#:use-module (gnu packages iso-codes)
#:use-module (gnu packages libcanberra)
#:use-module (gnu packages linux)
@ -71,6 +74,7 @@
#:use-module (gnu packages m4)
#:use-module (gnu packages image)
#:use-module (gnu packages networking)
#:use-module (gnu packages password-utils)
#:use-module (gnu packages perl)
#:use-module (gnu packages photo)
#:use-module (gnu packages pkg-config)
@ -91,6 +95,7 @@
#:use-module (gnu packages xdisorg)
#:use-module (gnu packages freedesktop)
#:use-module (gnu packages mail)
#:use-module (gnu packages mit-krb5)
#:use-module (gnu packages backup)
#:use-module (gnu packages nettle)
#:use-module (gnu packages ncurses)
@ -152,7 +157,7 @@ features to enable users to create their discs easily and quickly.")
(define-public gnome-common
(package
(name "gnome-common")
(version "3.14.0")
(version "3.18.0")
(source
(origin
(method url-fetch)
@ -161,7 +166,7 @@ features to enable users to create their discs easily and quickly.")
name "-" version ".tar.xz"))
(sha256
(base32
"0b1676g4q44ah73c5gwl1kg88pc93pnq1pa9kwl43d0vg0pj802c"))))
"1kzqi8qvh5p1zncj8msazlmvcwsczjz2hqxp4x2y0mg718vrwmi2"))))
(build-system gnu-build-system)
(home-page "https://www.gnome.org/")
(synopsis "Bootstrap GNOME modules built from Git")
@ -328,7 +333,7 @@ GNOME Desktop.")
(define-public gnome-keyring
(package
(name "gnome-keyring")
(version "3.16.0")
(version "3.18.3")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
@ -336,7 +341,7 @@ GNOME Desktop.")
name "-" version ".tar.xz"))
(sha256
(base32
"1xg1xha3x3hzlmvdq2zm90hc61pj7pnf9yxxvgq4ynl5af6bp8qm"))))
"167dq1yvm080g5s38hqjl0xx5cgpkcl1xqy9p5sxmgc92zb0srrz"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ;48 of 603 tests fail because /var/lib/dbus/machine-id does
@ -368,6 +373,7 @@ GNOME Desktop.")
"/xml/dtd/docbook/catalog.xml")))))))
(inputs
`(("libgcrypt" ,libgcrypt)
("linux-pam" ,linux-pam)
("dbus" ,dbus)
("gcr" ,gcr)))
(native-inputs
@ -584,7 +590,7 @@ update-desktop-database: updates the database containing a cache of MIME types
(define-public adwaita-icon-theme
(package (inherit gnome-icon-theme)
(name "adwaita-icon-theme")
(version "3.16.2")
(version "3.18.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
@ -592,7 +598,7 @@ update-desktop-database: updates the database containing a cache of MIME types
name "-" version ".tar.xz"))
(sha256
(base32
"1hmlw7kvhr7c2asc5y77adpymi9ka17gaf76zz835nwwffnn4rlw"))))))
"0n0fqlg55krw8pgn4z2vxnxh65lyvcydqkrr7klqxp8z00kfg72y"))))))
(define-public shared-mime-info
(package
@ -1467,6 +1473,12 @@ Hints specification (EWMH).")
(sha256
(base32 "0nmghi26dpjcw7knkviq031crhm0zjy4k650pv1jj3hb1fmhx9yd"))))
(build-system gnu-build-system)
(outputs '("out"
"doc")) ;4.1 MiB of gtk-doc
(arguments
'(#:configure-flags (list (string-append "--with-html-dir="
(assoc-ref %outputs "doc")
"/share/gtk-doc/html"))))
(inputs
`(("gtk+" ,gtk+)
("libgsf" ,libgsf)
@ -1504,7 +1516,9 @@ Hints specification (EWMH).")
;; https://bugzilla.gnome.org/show_bug.cgi?id=670316
(substitute* "configure"
(("glib/gregex\\.h") "glib.h")) #t)
%standard-phases)))
%standard-phases)
,@(package-arguments goffice)))
(propagated-inputs
;; libgoffice-0.8.pc mentions libgsf-1
`(("libgsf" ,libgsf)))
@ -1615,7 +1629,7 @@ engineering.")
(define-public seahorse
(package
(name "seahorse")
(version "3.16.0")
(version "3.18.0")
(source
(origin
(method url-fetch)
@ -1624,15 +1638,17 @@ engineering.")
version ".tar.xz"))
(sha256
(base32
"0cg1grgpwbfkiny5148n17rzpc8kswyr5yff0kpm8l3lp01my2kp"))))
"0rxnq47xcagmpqb63g49ay3lfiyjjnmmiay9yifx5jn406d8h32k"))))
(build-system glib-or-gtk-build-system)
(inputs
`(("gtk+" ,gtk+)
("gcr" ,gcr)
("gnupg" ,gnupg-1)
("gnupg" ,gnupg)
("gpgme" ,gpgme)
("openldap" ,openldap)
("openssh" ,openssh)
("libsecret" ,libsecret)))
("libsecret" ,libsecret)
("libsoup" ,libsoup)))
(native-inputs
`(("intltool" ,intltool)
("glib:bin" ,glib "bin")
@ -1765,7 +1781,7 @@ editors, IDEs, etc.")
(define-public dconf
(package
(name "dconf")
(version "0.22.0")
(version "0.24.0")
(source (origin
(method url-fetch)
(uri (string-append
@ -1773,7 +1789,8 @@ editors, IDEs, etc.")
(version-major+minor version) "/"
name "-" version ".tar.xz"))
(sha256
(base32 "13jb49504bir814v8n8vjip5sazwfwsrnniw87cpg7phqfq7q9qa"))))
(base32
"1hpy6336f0pbkyranywm4872i5in0xn7jf40a66xdmzls77f0ws3"))))
(build-system glib-or-gtk-build-system)
(inputs
`(("gtk+" ,gtk+)
@ -2125,7 +2142,7 @@ and other secrets. It communicates with the \"Secret Service\" using DBus.")
(define-public gnome-mines
(package
(name "gnome-mines")
(version "3.16.0")
(version "3.18.2")
(source
(origin
(method url-fetch)
@ -2134,7 +2151,7 @@ and other secrets. It communicates with the \"Secret Service\" using DBus.")
name "-" version ".tar.xz"))
(sha256
(base32
"0wfvqyryc1093l4dr75zv9h0jyn28z6wirdq03lm5w24qf9lvjjx"))))
"0izkcf81rji4dj9k0k93ij4lp5iza2bh6jwlcdhbjfv2xdw0f7ky"))))
(build-system glib-or-gtk-build-system)
(arguments
'(#:phases
@ -2171,7 +2188,7 @@ floating in an ocean using only your brain and a little bit of luck.")
(define-public gnome-terminal
(package
(name "gnome-terminal")
(version "3.16.0")
(version "3.18.2")
(source
(origin
(method url-fetch)
@ -2180,7 +2197,7 @@ floating in an ocean using only your brain and a little bit of luck.")
name "-" version ".tar.xz"))
(sha256
(base32
"1s3zwqxs4crlqmh6l7s7n87pbmh2nnjdvhxlkalh58pbl0bk0qrd"))))
"1ylyv0mla2ypms7iyxndbdjvha0q9jzglb4mhfmqn9cm2gxc0day"))))
(build-system glib-or-gtk-build-system)
(arguments
'(#:configure-flags
@ -2330,7 +2347,7 @@ permission from user.")
(define-public geocode-glib
(package
(name "geocode-glib")
(version "3.16.0")
(version "3.18.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/geocode-glib/"
@ -2338,7 +2355,7 @@ permission from user.")
name "-" version ".tar.xz"))
(sha256
(base32
"1cbfv0kds6b6k0cl7q47xpj3x1scwcd7m68zl1rf7i4hmhw4hpqj"))))
"0pa9cgndycynipc6z8wzbvn2fi89ndf2gpqzm9m6krp3d7az1dwg"))))
(build-system gnu-build-system)
(arguments
`(;; The tests want to write to $HOME/.cache/geocode-glib, which doesn't
@ -2466,7 +2483,7 @@ services for numerous locations.")
(define-public gnome-settings-daemon
(package
(name "gnome-settings-daemon")
(version "3.16.0")
(version "3.18.2")
(source
(origin
(method url-fetch)
@ -2475,7 +2492,7 @@ services for numerous locations.")
name "-" version ".tar.xz"))
(sha256
(base32
"1w29x2izq59125ga5ncmmaklc8kw7x7rdn6swn26bs23mah1r1g3"))))
"0vzwf875csyqx04fnra6zicmzcjc3s13bxxpcizlys12iwjwfw9h"))))
(build-system glib-or-gtk-build-system)
(arguments
`(;; Network manager not yet packaged.
@ -2557,7 +2574,7 @@ playlists in a variety of formats.")
(define-public aisleriot
(package
(name "aisleriot")
(version "3.16.1")
(version "3.18.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
@ -2565,7 +2582,7 @@ playlists in a variety of formats.")
name "-" version ".tar.xz"))
(sha256
(base32
"19k483x9dkq8vjbq8f333pk9qil64clpsfg20q8xk9bgmk38aj8h"))))
"1qrgcj30hl0fgssspkwrad10lqy1bbsp7lfwxmxlwzp33jhqpb0b"))))
(build-system glib-or-gtk-build-system)
(arguments
'(#:configure-flags
@ -2593,7 +2610,7 @@ which are easy to play with the aid of a mouse.")
(define-public devhelp
(package
(name "devhelp")
(version "3.16.1")
(version "3.18.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
@ -2601,7 +2618,7 @@ which are easy to play with the aid of a mouse.")
name "-" version ".tar.xz"))
(sha256
(base32
"0i8kyh86hzwxs8dm047ivghl2b92vigdxa3x4pk4ha0whpk38g37"))))
"1vqsqpc51cir5qf801ibh6ljlpfw0qd513l9hjcnzp4ls8m1cfih"))))
(build-system glib-or-gtk-build-system)
(native-inputs
`(("intltool" ,intltool)
@ -2740,7 +2757,7 @@ presentations, kiosk style applications and so on.")
(define-public clutter-gtk
(package
(name "clutter-gtk")
(version "1.6.0")
(version "1.6.6")
(source
(origin
(method url-fetch)
@ -2749,12 +2766,13 @@ presentations, kiosk style applications and so on.")
name "-" version ".tar.xz"))
(sha256
(base32
"0k93hbf5d1970hs7vjddr3nnngygc7mxqbj474r3cdm0fjsm0dc8"))))
"0a2a8ci6in82l43zak3zj3cyms23i5rq6lzk1bz013gm023ach4l"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)
("gobject-introspection" ,gobject-introspection)))
(inputs
(propagated-inputs
;; clutter-gtk.pc refers to all these.
`(("clutter" ,clutter)
("gtk+" ,gtk+)))
(home-page "http://www.clutter-project.org")
@ -2768,7 +2786,7 @@ presentations, kiosk style applications and so on.")
(define-public clutter-gst
(package
(name "clutter-gst")
(version "3.0.6")
(version "3.0.14")
(source
(origin
(method url-fetch)
@ -2777,7 +2795,7 @@ presentations, kiosk style applications and so on.")
name "-" version ".tar.xz"))
(sha256
(base32
"0xnzfdzawl1kdx715gp31nwjp7a1kib094s7xvg7bhbwwlx4kmfn"))))
"1qidm0q28q6w8gjd0gpqnk8fzqxv39dcp0vlzzawlncp8zfagj7p"))))
(build-system gnu-build-system)
(native-inputs
`(("glib:bin" ,glib "bin") ; for glib-mkenums
@ -2799,7 +2817,7 @@ GL based interactive canvas library.")
(define-public libchamplain
(package
(name "libchamplain")
(version "0.12.10")
(version "0.12.12")
(source (origin
(method url-fetch)
(uri (string-append
@ -2807,7 +2825,7 @@ GL based interactive canvas library.")
version ".tar.xz"))
(sha256
(base32
"019b8scnx7d3wdylmpk9ihzh06w25b63x9cn8nhj6kjx82rcwlxz"))))
"19jlhbgfn9c9g40b3fa2x373s6rfcwx5i9lbpl3vl7d901r7kpp7"))))
(build-system gnu-build-system)
(native-inputs `(("pkg-config" ,pkg-config)))
(propagated-inputs
@ -2863,7 +2881,7 @@ queries upon that data.")
(define-public gnome-klotski
(package
(name "gnome-klotski")
(version "3.16.1")
(version "3.18.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
@ -2871,7 +2889,7 @@ queries upon that data.")
name "-" version ".tar.xz"))
(sha256
(base32
"0a64935c7pp51jhaf29q9zlx3lamj7zrhyff7clvv0w8v1w6gpax"))))
"14l1fji0860yam41x2cy72nd9bljph385ynfm6k1lsv4qhv72az2"))))
(build-system glib-or-gtk-build-system)
(native-inputs
`(("desktop-file-utils" ,desktop-file-utils)
@ -2894,7 +2912,7 @@ as possible!")
(define-public grilo
(package
(name "grilo")
(version "0.2.12")
(version "0.2.14")
(source
(origin
(method url-fetch)
@ -2903,7 +2921,7 @@ as possible!")
name "-" version ".tar.xz"))
(sha256
(base32
"11bvc7rsrjjwz8hp67p3fn8zmywrpawrcbi3vgw8b0dwa0sndd2m"))))
"1k8wj8f7xfaw5hxypnmwd34li3fq8h76dacach547rvsfjhjxj3r"))))
(build-system gnu-build-system)
(native-inputs
`(("glib:bin" ,glib "bin") ; for glib-mkenums and glib-genmarshal
@ -2945,7 +2963,7 @@ for application developers.")
(define-public grilo-plugins
(package
(name "grilo-plugins")
(version "0.2.14")
(version "0.2.16")
(source
(origin
(method url-fetch)
@ -2954,7 +2972,7 @@ for application developers.")
name "-" version ".tar.xz"))
(sha256
(base32
"1aykhc679pwn2qxsg19g8nh9hffpsqkgxcbqq7lcfn2hcwb83wfh"))))
"00sjmkzxc8w4qn4lp5yj65c4y83mwhp0zlvk11ghvpxnklgmgd40"))))
(build-system gnu-build-system)
(native-inputs
`(("glib:bin" ,glib "bin") ; for glib-mkenums and glib-genmarshal
@ -2997,7 +3015,7 @@ for application developers.")
(define-public totem
(package
(name "totem")
(version "3.16.1")
(version "3.18.1")
(source
(origin
(method url-fetch)
@ -3006,7 +3024,7 @@ for application developers.")
name "-" version ".tar.xz"))
(sha256
(base32
"1nkm2i271ivq40hryrl6px39gbbvhmlx4vmvwvw4h3z8xh3013f9"))))
"18h784c77m4h359j3xnlwqlfvnhbw7m052ahzm26r106jsp6x0fp"))))
(build-system glib-or-gtk-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)
@ -3163,7 +3181,7 @@ supports playlists, song ratings, and any codecs installed through gstreamer.")
(define-public eog
(package
(name "eog")
(version "3.16.2")
(version "3.18.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
@ -3171,7 +3189,7 @@ supports playlists, song ratings, and any codecs installed through gstreamer.")
name "-" version ".tar.xz"))
(sha256
(base32
"0frw1b5jix9pffznav5s7ajjx91a8rv5lf4sjvjv3fw65mbnhbw0"))))
"19wkawrcwjjcvlmizkj57qycnbgizhr8ck3j5qg70605d1xb8yvv"))))
(build-system glib-or-gtk-build-system)
(arguments
`(#:phases
@ -3327,7 +3345,7 @@ DAV, and others.")
(lambda _
(and (zero? (system* "gtkdocize"))
(zero? (system* "autoreconf" "-vif"))))))))
(home-page "https://github/hughsie/libgusb")
(home-page "https://github.com/hughsie/libgusb")
(synopsis "GLib binding for libusb1")
(description
"GUsb is a GObject wrapper for libusb1 that makes it easy to do
@ -3484,7 +3502,7 @@ of running programs and invoke methods on those interfaces.")
(define-public yelp-xsl
(package
(name "yelp-xsl")
(version "3.16.1")
(version "3.18.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
@ -3492,7 +3510,7 @@ of running programs and invoke methods on those interfaces.")
name "-" version ".tar.xz"))
(sha256
(base32
"0jhpni4mmfvj3xf57rjm61nc8d0x66hz9gd1ywws5lh39g6fx59j"))))
"0qmsq7qkc06gmnkvbs84qj3jjzlihriy3z45nfbpgg51b6z0z1q0"))))
(build-system gnu-build-system)
(native-inputs
`(("intltool" ,intltool)
@ -3543,7 +3561,7 @@ freedesktop.org help system specification.")
(define-public yelp-tools
(package
(name "yelp-tools")
(version "3.16.1")
(version "3.18.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
@ -3551,7 +3569,7 @@ freedesktop.org help system specification.")
name "-" version ".tar.xz"))
(sha256
(base32
"177qzvj5w019isdp41qxqcys2kc4sq2x6dqhqn6l9ipib8a6rxml"))))
"0ck9f78c1xka8a823bd7w1k0gdn4k19zvaj7viy2d5r3h1gxdhf6"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))
@ -3696,7 +3714,7 @@ share them with others via social networking and more.")
(define-public file-roller
(package
(name "file-roller")
(version "3.10.0")
(version "3.16.4")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
@ -3704,7 +3722,7 @@ share them with others via social networking and more.")
name "-" version ".tar.xz"))
(sha256
(base32
"04sg4yzz4c3hzgxhbgx2dc36lq5hjrnrmal2q0amfvhl0jcvp2fq"))))
"11a1g8f2700n2mz998wf40dz1rxjgap60mfns9iv0zlw5h5rhmal"))))
(build-system glib-or-gtk-build-system)
(native-inputs
`(("intltool" ,intltool)
@ -3738,7 +3756,7 @@ such as gzip tarballs.")
(sha256
(base32
"0icajbzqf5llvp5s8nafwkhwz6a6jmwn4hhs81bk0bpzawyq4zdk"))))
(build-system gnu-build-system)
(build-system glib-or-gtk-build-system)
(native-inputs
`(("glib:bin" ,glib "bin") ; for glib-compile-schemas, etc.
("pkg-config" ,pkg-config)
@ -3746,6 +3764,7 @@ such as gzip tarballs.")
("xsltproc" ,libxslt)))
(inputs
`(("gnome-desktop" ,gnome-desktop)
("gsettings-desktop-schemas" ,gsettings-desktop-schemas)
("gtk+" ,gtk+)
("json-glib" ,json-glib)
("libsm" ,libsm)
@ -4259,3 +4278,275 @@ the available networks and allows users to easily switch between them.")
"This package provides a C++ wrapper for the XML parser library
libxml2.")
(license license:lgpl2.1+)))
(define-public gdm
(package
(name "gdm")
(version "3.18.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
(version-major+minor version) "/"
name "-" version ".tar.xz"))
(sha256
(base32
"08pqhslwd487nh9w0jp4d0s4s2imm4ds0jjsbl6lzmqifqj3b4jl"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags
'("--without-plymouth")
#:phases
(modify-phases %standard-phases
(add-before
'configure 'pre-configure
(lambda _
;; We don't have <systemd/sd-daemon.h>.
(substitute* '("common/gdm-log.c"
"daemon/gdm-server.c"
"daemon/gdm-session-worker.c"
"daemon/gdm-session-worker-job.c")
(("#include <systemd/sd-daemon\\.h>") ""))
;; Use elogind for sd-login.
(substitute* '("common/gdm-common.c"
"daemon/gdm-manager.c"
"libgdm/gdm-user-switching.c")
(("#include <systemd/sd-login\\.h>")
"#include <elogind/sd-login.h>"))
;; Avoid checking SYSTEMD using pkg-config.
(setenv "SYSTEMD_CFLAGS" " ")
(setenv "SYSTEMD_LIBS" "-lelogind")
#t)))))
(native-inputs
`(("dconf" ,dconf)
("glib:bin" ,glib "bin") ; for glib-compile-schemas, etc.
("gobject-introspection" ,gobject-introspection)
("intltool" ,intltool)
("itstool" ,itstool)
("pkg-config" ,pkg-config)
("xmllint" ,libxml2)))
(inputs
`(("accountsservice" ,accountsservice)
("check" ,check) ; for testing
("elogind" ,elogind)
("gtk+" ,gtk+)
("iso-codes" ,iso-codes)
("libcanberra" ,libcanberra)
("linux-pam" ,linux-pam)))
(synopsis "Display manager for GNOME")
(home-page "http://wiki.gnome.org/Projects/GDM/")
(description
"GNOME Display Manager is a system service that is responsible for
providing graphical log-ins and managing local and remote displays.")
(license license:gpl2+)))
(define-public libgtop
(package
(name "libgtop")
(version "2.32.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
(version-major+minor version) "/"
name "-" version ".tar.xz"))
(sha256
(base32
"13hpml2vfm23816qggr5fvxj75ndb1dq4rgmi7ik6azj69ij8hw4"))))
(build-system gnu-build-system)
(native-inputs
`(("gobject-introspection" ,gobject-introspection)
("intltool" ,intltool)
("perl" ,perl)
("pkg-config" ,pkg-config)))
(propagated-inputs
`(("glib" ,glib))) ; required by libgtop-2.0.pc
(synopsis "Portable system access library")
(home-page "https://www.gnome.org/")
(description
"LibGTop is a library to get system specific data such as CPU and memory
usage and information about running processes.")
(license license:gpl2+)))
(define-public gnome-bluetooth
(package
(name "gnome-bluetooth")
(version "3.18.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
(version-major+minor version) "/"
name "-" version ".tar.xz"))
(sha256
(base32
"0jaa9nbygdvcqp9k4p4iy2g8x3684s4x9k5nbcmmm11jdn4mn7f5"))))
(build-system glib-or-gtk-build-system)
(native-inputs
`(("glib:bin" ,glib "bin") ; for gdbus-codegen, etc.
("gobject-introspection" ,gobject-introspection)
("intltool" ,intltool)
("pkg-config" ,pkg-config)
("xmllint" ,libxml2)))
(propagated-inputs
;; gnome-bluetooth-1.0.pc refers to all these.
`(("gtk+" ,gtk+)
("udev" ,eudev)))
(inputs
`(("libcanberra" ,libcanberra)
("libnotify" ,libnotify)))
(synopsis "GNOME Bluetooth subsystem")
(home-page "https://wiki.gnome.org/Projects/GnomeBluetooth")
(description
"This package contains tools for managing and manipulating Bluetooth
devices using the GNOME desktop.")
(license license:lgpl2.1+)))
(define-public gnome-control-center
(package
(name "gnome-control-center")
(version "3.18.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
(version-major+minor version) "/"
name "-" version ".tar.xz"))
(sha256
(base32
"1bgqg1sl3cp2azrwrjgwx3jzk9n3w76xpcyvk257qavx4ibn3zin"))))
(build-system glib-or-gtk-build-system)
(arguments
'(#:phases
(modify-phases %standard-phases
(add-before 'configure 'patch-paths
(lambda* (#:key inputs #:allow-other-keys)
(let ((libc (assoc-ref inputs "libc"))
(tzdata (assoc-ref inputs "tzdata")))
(substitute* "panels/datetime/tz.h"
(("/usr/share/zoneinfo/zone.tab")
(string-append tzdata "/share/zoneinfo/zone.tab")))
(substitute* "panels/datetime/test-endianess.c"
(("/usr/share/locale")
(string-append libc "/share/locale")))
#t))))))
(native-inputs
`(("glib:bin" ,glib "bin") ; for glib-mkenums, etc.
("intltool" ,intltool)
("pkg-config" ,pkg-config)
("xsltproc" ,libxslt)))
(inputs
`(("accountsservice" ,accountsservice)
("clutter-gtk" ,clutter-gtk)
("colord-gtk" ,colord-gtk)
("cups" ,cups)
("dconf" ,dconf)
("docbook-xsl" ,docbook-xsl)
("gnome-bluetooth" ,gnome-bluetooth)
("gnome-desktop" ,gnome-desktop)
("gnome-online-accounts" ,gnome-online-accounts)
("gnome-settings-daemon" ,gnome-settings-daemon)
("grilo" ,grilo)
("ibus" ,ibus)
("libcanberra" ,libcanberra)
("libgudev" ,libgudev)
("libgtop" ,libgtop)
("libpwquality" ,libpwquality)
("libsoup" ,libsoup)
("libxml2" ,libxml2)
("libwacom" ,libwacom)
("mesa" ,mesa)
("mit-krb5" ,mit-krb5)
("modem-manager" ,modem-manager)
("network-manager-applet" ,network-manager-applet)
("polkit" ,polkit)
("pulseaudio" ,pulseaudio)
("smbclient" ,samba)
("tzdata" ,tzdata)
("upower" ,upower)))
(synopsis "Utilities to configure the GNOME desktop")
(home-page "https://www.gnome.org/")
(description
"This package contains configuration applets for the GNOME desktop,
allowing to set accessibility configuration, desktop fonts, keyboard and mouse
properties, sound setup, desktop theme and background, user interface
properties, screen resolution, and other GNOME parameters.")
(license license:gpl2+)))
(define-public gnome-shell
(package
(name "gnome-shell")
(version "3.18.3")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
(version-major+minor version) "/"
name "-" version ".tar.xz"))
(sha256
(base32
"16sicxdp08yfaj4hiyzvbspb5jk3fpmi291272zhx5vgc3wbl5w5"))))
(build-system glib-or-gtk-build-system)
(arguments
'(#:phases
(modify-phases %standard-phases
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(keysdir (string-append
out "/share/gnome-control-center/keybindings")))
(zero? (system* "make"
(string-append "keysdir=" keysdir)
"install")))))
(add-after
'install 'wrap-programs
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(gi-typelib-path (getenv "GI_TYPELIB_PATH"))
(python-path (getenv "PYTHONPATH")))
(wrap-program (string-append out "/bin/gnome-shell")
`("GI_TYPELIB_PATH" ":" prefix (,gi-typelib-path)))
(for-each
(lambda (prog)
(wrap-program (string-append out "/bin/" prog)
`("PYTHONPATH" ":" prefix (,python-path))
`("GI_TYPELIB_PATH" ":" prefix (,gi-typelib-path))))
'("gnome-shell-extension-tool" "gnome-shell-perf-tool"))
#t))))))
(native-inputs
`(("glib:bin" ,glib "bin") ; for glib-compile-schemas, etc.
("gobject-introspection" ,gobject-introspection)
("intltool" ,intltool)
("pkg-config" ,pkg-config)
("python" ,python)
("xsltproc" ,libxslt)))
(inputs
`(("accountsservice" ,accountsservice)
("caribou" ,caribou)
("docbook-xsl" ,docbook-xsl)
("evolution-data-server" ,evolution-data-server)
("gcr" ,gcr)
("gdm" ,gdm)
("gjs" ,gjs)
("gnome-bluetooth" ,gnome-bluetooth)
("gnome-control-center" ,gnome-control-center)
("gnome-desktop" ,gnome-desktop)
("gnome-settings-daemon" ,gnome-settings-daemon)
("gst-plugins-base" ,gst-plugins-base)
("ibus" ,ibus)
("libcanberra" ,libcanberra)
("libcroco" ,libcroco)
("libgweather" ,libgweather)
("libsoup" ,libsoup)
("mesa-headers" ,mesa-headers)
("mutter" ,mutter)
("network-manager-applet" ,network-manager-applet)
("polkit" ,polkit)
("pulseaudio" ,pulseaudio)
("python-pygobject" ,python-pygobject)
("startup-notification" ,startup-notification)
("telepathy-logger" ,telepathy-logger)
("upower" ,upower)
;; XXX: required by libgjs.la.
("readline" ,readline)))
(synopsis "Desktop shell for GNOME")
(home-page "https://wiki.gnome.org/Projects/GnomeShell")
(description
"GNOME Shell provides core user interface functions for the GNOME desktop,
like switching to windows and launching applications.")
(license license:gpl2+)))

4
gnu/packages/gnunet.scm
View File

@ -114,14 +114,14 @@ tool to extract metadata from a file and print the results.")
(define-public libmicrohttpd
(package
(name "libmicrohttpd")
(version "0.9.47")
(version "0.9.48")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/libmicrohttpd/libmicrohttpd-"
version ".tar.gz"))
(sha256
(base32
"1335kznai5ih3kmavl1707sr4sakk0cc0srl5aax77x0a91spgcn"))))
"1952z36lf31jy0x19r4y389d9188wgzmdqh2l28wdy1biwapwrl7"))))
(build-system gnu-build-system)
(inputs
`(("curl" ,curl)

4
gnu/packages/gnupg.scm
View File

@ -273,14 +273,14 @@ libskba (working with X.509 certificates and CMS data).")
(define-public gnupg-1
(package (inherit gnupg)
(version "1.4.19")
(version "1.4.20")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnupg/gnupg/gnupg-" version
".tar.bz2"))
(sha256
(base32
"11pxx26sfilh0vswylh9mhiifw5yffw7nn733zknw3sb0jfk22bz"))))
"1k7d6zi0zznqsmcjic0yrgfhqklqz3qgd3yac7wxsa7s6088p604"))))
(native-inputs '())
(inputs
`(("zlib" ,zlib)

11
gnu/packages/gnuzilla.scm
View File

@ -167,7 +167,7 @@ in the Mozilla clients.")
(define-public nss
(package
(name "nss")
(version "3.20.1")
(version "3.20.2")
(source (origin
(method url-fetch)
(uri (let ((version-with-underscores
@ -178,7 +178,7 @@ in the Mozilla clients.")
"nss-" version ".tar.gz")))
(sha256
(base32
"15wcbqd2b911hxafbjfn63zd1gf2yxg0s5560hnhqmyrvw8qyg5d"))
"11pjjcp0mvcyx0ildyz20s9jlqzxsb6a9jlvcq5x1g3zsmckl6hl"))
;; Create nss.pc and nss-config.
(patches (list (search-patch "nss-pkgconfig.patch")))))
(build-system gnu-build-system)
@ -266,7 +266,7 @@ standards.")
(define-public icecat
(package
(name "icecat")
(version "38.4.0-gnu1")
(version "38.5.0-gnu1")
(source
(origin
(method url-fetch)
@ -275,9 +275,8 @@ standards.")
name "-" version ".tar.bz2"))
(sha256
(base32
"0rcaa19rfgclwd2qvcz8798m57jjzra6kaxg5dniysajvx7qndfp"))
(patches (map search-patch '("icecat-avoid-bundled-includes.patch"
"icecat-freetype-2.6.patch")))
"1bf20mpvx84jsa0dan2hhfc49f30v0wasikv7sh3cg8mwp62faj6"))
(patches (map search-patch '("icecat-avoid-bundled-includes.patch")))
(modules '((guix build utils)))
(snippet
'(begin

16
gnu/packages/graphics.scm
View File

@ -271,8 +271,16 @@ and understanding different BRDFs (and other component functions).")
(version "2.5")
(source (origin
(method url-fetch)
(uri (string-append "http://www.antigrain.com/agg-"
version ".tar.gz"))
(uri (list (string-append
"ftp://ftp.fau.de/gentoo/distfiles/agg-"
version ".tar.gz")
(string-append
"ftp://ftp.ula.ve/gentoo/distfiles/agg-"
version ".tar.gz")
;; Site was discontinued.
(string-append "http://www.antigrain.com/agg-"
version ".tar.gz")))
(sha256
(base32 "07wii4i824vy9qsvjsgqxppgqmfdxq0xa87i5yk53fijriadq7mb"))
(patches (list (search-patch "agg-am_c_prototype.patch")))))
@ -301,7 +309,9 @@ and understanding different BRDFs (and other component functions).")
`(("libx11" ,libx11)
("freetype" ,freetype)
("sdl" ,sdl)))
(home-page "http://antigrain.com")
;; Antigrain.com was discontinued.
(home-page "http://agg.sourceforge.net/antigrain.com/index.html")
(synopsis "High-quality 2D graphics rendering engine for C++")
(description
"Anti-Grain Geometry is a high quality rendering engine written in C++.

4
gnu/packages/grub.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Leo Famulari <leo@famulari.name>
;;;
;;; This file is part of GNU Guix.
;;;
@ -83,7 +84,8 @@
(base32
"0n64hpmsccvicagvr0c6v0kgp2yw0kgnd3jvsyd26cnwgs7c6kkq"))
(patches (list (search-patch "grub-gets-undeclared.patch")
(search-patch "grub-freetype.patch")))))
(search-patch "grub-freetype.patch")
(search-patch "grub-CVE-2015-8370.patch")))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags '("--disable-werror")

64
gnu/packages/gtk.scm
View File

@ -385,7 +385,7 @@ highlighting and other features typical of a source code editor.")
(define-public gdk-pixbuf
(package
(name "gdk-pixbuf")
(version "2.32.1")
(version "2.32.3")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
@ -393,7 +393,7 @@ highlighting and other features typical of a source code editor.")
name "-" version ".tar.xz"))
(sha256
(base32
"1g7kjxv67jcdasi14n7jan4icrnnppd1m99wrdmpv32k4m7vfcj4"))))
"0cfh87aqyqbfcwpbv1ihgmgfcn66il5q2n8yjyl8gxkjmkqp2rrb"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags '("--with-x11")
@ -403,9 +403,9 @@ highlighting and other features typical of a source code editor.")
'unpack 'disable-failing-tests
(lambda _
(substitute* "tests/Makefile.in"
;; XXX FIXME: This test fails on some machines with:
;; GLib-FATAL-ERROR: gmem.c:103: failed to allocate
;; 6039798016 bytes
;; XXX FIXME: This test fails on armhf machines with:
;; SKIP Not enough memory to load bitmap image
;; ERROR: cve-2015-4491 - too few tests run (expected 4, got 2)
(("cve-2015-4491\\$\\(EXEEXT\\) ") "")
;; XXX FIXME: This test fails with:
;; ERROR:pixbuf-jpeg.c:74:test_type9_rotation_exif_tag:
@ -994,6 +994,8 @@ extensive documentation, including API reference and a tutorial.")
(base32
"04k942gn8vl95kwf0qskkv6npclfm31d78ljkrkgyqxxcni1w76d"))))
(build-system gnu-build-system)
(outputs '("out"
"doc")) ;13 MiB of gtk-doc HTML
(native-inputs
`(("pkg-config" ,pkg-config)))
(inputs
@ -1005,29 +1007,35 @@ extensive documentation, including API reference and a tutorial.")
("gtk+" ,gtk+-2)))
(arguments
`(#:tests? #f
#:phases (alist-cons-after
'configure 'fix-codegen
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "pygtk-codegen-2.0"
(("^prefix=.*$")
(string-append
"prefix="
(assoc-ref inputs "python-pygobject") "\n"))))
(alist-cons-after
'install 'install-pth
(lambda* (#:key inputs outputs #:allow-other-keys)
;; pygtk's modules are stored in a subdirectory of python's
;; site-packages directory. Add a .pth file so that python
;; will add that subdirectory to its module search path.
(let* ((out (assoc-ref outputs "out"))
(site (string-append out "/lib/python"
,(version-major+minor
(package-version python-2))
"/site-packages")))
(call-with-output-file (string-append site "/pygtk.pth")
(lambda (port)
(format port "gtk-2.0~%")))))
%standard-phases))))
#:phases (modify-phases %standard-phases
(add-before 'configure 'set-gtk-doc-directory
(lambda* (#:key outputs #:allow-other-keys)
;; Install documentation to "doc".
(let ((doc (assoc-ref outputs "doc")))
(substitute* "docs/Makefile.in"
(("TARGET_DIR = \\$\\(datadir\\)")
(string-append "TARGET_DIR = " doc))))))
(add-after 'configure 'fix-codegen
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "pygtk-codegen-2.0"
(("^prefix=.*$")
(string-append
"prefix="
(assoc-ref inputs "python-pygobject") "\n")))))
(add-after 'install 'install-pth
(lambda* (#:key inputs outputs #:allow-other-keys)
;; pygtk's modules are stored in a subdirectory of
;; python's site-packages directory. Add a .pth file so
;; that python will add that subdirectory to its module
;; search path.
(let* ((out (assoc-ref outputs "out"))
(site (string-append out "/lib/python"
,(version-major+minor
(package-version python-2))
"/site-packages")))
(call-with-output-file (string-append site "/pygtk.pth")
(lambda (port)
(format port "gtk-2.0~%")))))))))
(home-page "http://www.pygtk.org/")
(synopsis "Python bindings for GTK+")
(description

28
gnu/packages/guile.scm
View File

@ -842,4 +842,32 @@ capabilities.")
(home-page "http://dthompson.us/pages/software/sly.html")
(license gpl3+)))
(define-public g-wrap
(package
(name "g-wrap")
(version "1.9.15")
(source (origin
(method url-fetch)
(uri (string-append "mirror://savannah/g-wrap/g-wrap-"
version ".tar.gz"))
(sha256
(base32
"0ak0bha37dfpj9kmyw1r8fj8nva639aw5xr66wr5gd3l1rqf5xhg"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))
(propagated-inputs
`(("guile" ,guile-2.0)
("guile-lib" ,guile-lib)))
(inputs
`(("libffi" ,libffi)))
(synopsis "Generate C bindings for Guile")
(description "G-Wrap is a tool and Guile library for generating function
wrappers for inter-language calls. It currently only supports generating Guile
wrappers for C functions. Given a definition of the types and prototypes for
a given C interface, G-Wrap will automatically generate the C code that
provides access to that interface and its types from the Scheme level.")
(home-page "http://www.nongnu.org/g-wrap/index.html")
(license lgpl2.1+)))
;;; guile.scm ends here

447
gnu/packages/haskell.scm
View File

File diff suppressed because it is too large Load Diff

4
gnu/packages/image.scm
View File

@ -50,7 +50,7 @@
(define-public libpng
(package
(name "libpng")
(version "1.5.24")
(version "1.5.26")
(source (origin
(method url-fetch)
@ -61,7 +61,7 @@
"ftp://ftp.simplesystems.org/pub/libpng/png/src"
"/libpng15/libpng-" version ".tar.xz")))
(sha256
(base32 "1qhvfk1ypsaf6q6xkspyqqzmghpbahhq54ms8fa5ssqkyds38bmr"))))
(base32 "0kbissyd7d4ahwdpm968nnzl7q15p6hadg44i9x0vrkrzdgdi93v"))))
(build-system gnu-build-system)
;; libpng.la says "-lz", so propagate it.

3
gnu/packages/irssi.scm
View File

@ -35,7 +35,8 @@
(version "0.8.17")
(source (origin
(method url-fetch)
(uri (string-append "http://www.irssi.org/files/irssi-"
(uri (string-append "https://github.com/irssi-import/irssi/"
"releases/download/0.8.17/irssi-"
version ".tar.bz2"))
(sha256
(base32

26
gnu/packages/java.scm
View File

@ -187,7 +187,7 @@ build process and its dependencies, whereas Make uses Makefile format.")
(define-public icedtea6
(package
(name "icedtea6")
(version "1.13.8")
(version "1.13.9")
(source (origin
(method url-fetch)
(uri (string-append
@ -195,7 +195,7 @@ build process and its dependencies, whereas Make uses Makefile format.")
version ".tar.xz"))
(sha256
(base32
"1nqaq2xjz88rfzm94l28c0cc48gdiwl8ijw9c46s14z3awwn5g7w"))
"0rf95gsyr849b0nxhc7i0k5pr2iz8a922kg288x7jbgws0pgpq31"))
(modules '((guix build utils)))
(snippet
'(substitute* "Makefile.in"
@ -557,10 +557,10 @@ build process and its dependencies, whereas Make uses Makefile format.")
("openjdk6-src"
,(origin
(method url-fetch)
(uri "https://java.net/downloads/openjdk6/openjdk-6-src-b36-22_jul_2015.tar.gz")
(uri "https://java.net/downloads/openjdk6/openjdk-6-src-b37-11_nov_2015.tar.gz")
(sha256
(base32
"0mdckpazjijf6ggxzah2nq99lgsi0jk9pjbxhfq39b9lawvb45ln"))))
"0iqzvx1zmrfhxrp3z9h7bh95c2rmclrhiszmsqwkjb2gngbs29j5"))))
("lcms" ,lcms)
("zlib" ,zlib)
("gtk" ,gtk+-2)
@ -576,7 +576,7 @@ build process and its dependencies, whereas Make uses Makefile format.")
(license license:gpl2+)))
(define-public icedtea7
(let* ((version "2.6.2")
(let* ((version "2.6.3")
(drop (lambda (name hash)
(origin
(method url-fetch)
@ -594,7 +594,7 @@ build process and its dependencies, whereas Make uses Makefile format.")
version ".tar.xz"))
(sha256
(base32
"0xi0w8gpxx3r68hyi7fb991hxb3rqfp7895nfsl4wj3sa1f5ds5y"))
"04n6ac7rca98q68ifja1nmf3icigqgs75k4x12p3n3yknh8alf6z"))
(modules '((guix build utils)))
(snippet
'(substitute* "Makefile.in"
@ -728,24 +728,24 @@ build process and its dependencies, whereas Make uses Makefile format.")
(native-inputs
`(("openjdk-drop"
,(drop "openjdk"
"0jabxc8iw7ciz6f2qshcpla66qniy686vnxnfx3h2yw7syvas4a9"))
"0vflz0hhq4arykvvmsv3yas4yk9i0jm57287iqvs3a4832xjcpcy"))
("corba-drop"
,(drop "corba"
"1bw22djg8mfqqn8kp8mpbj9vi4pl8dk67qwwrny67d0fvirixylj"))
"1ijy8gkvnvzjnk7x7fypggfapdswd0ha7b8q90vs72lhf0yawlhh"))
("jaxp-drop"
,(drop "jaxp"
"1h3g2dwbj8ihicl73qbr4cvvc3i5bs5ckrpja1nx6g5b56xa7kcl"))
"0sw0a49xmzqrffvlg7mvvlicn2yz5r4swv3l19b0269p0yy7isd0"))
("jaxws-drop"
,(drop "jaxws"
"1m1h7455qn4pdhb5yamdl9965iz9260lzwl3njcs35vi14v7fihl"))
"07nwmpji734fnvb4n3g2cj1fl4mskmg26ksdw3rpvb38wf97v2am"))
("jdk-drop"
,(drop "jdk"
"1wcaxf2chnlpk34q04c23im6z32dy8fr6f9giz3ih65nyvah3n3s"))
"1x89l6rj20rzkalizpy74q4nlnskrvr39nvl2i95isajkda9hf2q"))
("langtools-drop"
,(drop "langtools"
"0da3cmm8nwz7dk2sqnywvidaa0kjnyzzi33p2lkdi4415f8yhgx5"))
"0zpjkpl294aw4nai35fh4lcxyv3vx0q0hnxchjcb2iz0hkgicizi"))
("hotspot-drop"
,(drop "hotspot"
"0fn3cjhqsgbkfzychkvvw6whxil2n9dr6q0196ywxzkinny1hjcq"))
"03pggsrhkzpjnj939vhr3b7mcrhfp22b7yg3hkx52kcv8dqkg3yx"))
,@(fold alist-delete (package-native-inputs icedtea6)
'("openjdk6-src")))))))

2
gnu/packages/key-mon.scm
View File

@ -56,7 +56,7 @@
#:tests? #f)) ;no tests
(native-inputs
`(("python2-setuptools" ,python2-setuptools)))
(propagated-inputs
(inputs
`(("python2-xlib" ,python2-xlib)
("python2-pygtk" ,python2-pygtk)
("librsvg" ,librsvg)

2
gnu/packages/libevent.scm
View File

@ -68,7 +68,7 @@ loop.")
(version "4.20")
(source (origin
(method url-fetch)
(uri (string-append "http://dist.schmorp.de/libev/libev-"
(uri (string-append "http://dist.schmorp.de/libev/Attic/libev-"
version
".tar.gz"))
(sha256

174
gnu/packages/linux.scm
View File

@ -5,6 +5,7 @@
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@ -22,8 +23,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages linux)
#:use-module ((guix licenses)
#:hide (zlib openssl))
#:use-module ((guix licenses) #:prefix license:)
#:use-module (gnu packages)
#:use-module (gnu packages compression)
#:use-module (gnu packages gcc)
@ -149,7 +149,7 @@
#:tests? #f))
(synopsis "GNU Linux-Libre kernel headers")
(description "Headers of the Linux-Libre kernel.")
(license gpl2)
(license license:gpl2)
(home-page "http://www.gnu.org/software/linux-libre/"))))
(define-public module-init-tools
@ -183,7 +183,7 @@
(description
"Tools for loading and managing Linux kernel modules, such as `modprobe',
`insmod', `lsmod', and more.")
(license gpl2+)))
(license license:gpl2+)))
(define %boot-logo-patch
;; Linux-Libre boot logo featuring Freedo and a gnu.
@ -211,7 +211,7 @@ for SYSTEM, or #f if there is no configuration for SYSTEM."
#f)))
(define-public linux-libre
(let* ((version "4.3.2")
(let* ((version "4.3.3")
(build-phase
'(lambda* (#:key system inputs #:allow-other-keys #:rest args)
;; Apply the neat patch.
@ -285,7 +285,7 @@ for SYSTEM, or #f if there is no configuration for SYSTEM."
(uri (linux-libre-urls version))
(sha256
(base32
"0d87jbmplv36kxq40k44zh3sj82qp79lf8n4by7jb2wvyk06rvfg"))))
"1z43kzs1pzwq5mkyh7zk8nq38sxlswp65824v54dzwngyc252a18"))))
(build-system gnu-build-system)
(supported-systems '("x86_64-linux" "i686-linux"))
(native-inputs `(("perl" ,perl)
@ -314,7 +314,7 @@ for SYSTEM, or #f if there is no configuration for SYSTEM."
(description
"GNU Linux-Libre is a free (as in freedom) variant of the Linux kernel.
It has been modified to remove all non-free binary blobs.")
(license gpl2)
(license license:gpl2)
(home-page "http://www.gnu.org/software/linux-libre/"))))
@ -361,7 +361,7 @@ It has been modified to remove all non-free binary blobs.")
Pluggable authentication modules are small shared object files that can
be used through the PAM API to perform tasks, like authenticating a user
at login. Local and dynamic reconfiguration are its key features.")
(license bsd-3)))
(license license:bsd-3)))
;;;
@ -389,7 +389,7 @@ at login. Local and dynamic reconfiguration are its key features.")
"This PSmisc package is a set of some small useful utilities that
use the proc filesystem. We're not about changing the world, but
providing the system administrator with some help in common tasks.")
(license gpl2+)))
(license license:gpl2+)))
(define-public util-linux
(package
@ -459,8 +459,8 @@ block devices, UUIDs, TTYs, and many other tools.")
;; Note that util-linux doesn't use the same license for all the
;; code. GPLv2+ is the default license for a code without an
;; explicitly defined license.
(license (list gpl3+ gpl2+ gpl2 lgpl2.0+
bsd-4 public-domain))))
(license (list license:gpl3+ license:gpl2+ license:gpl2 license:lgpl2.0+
license:bsd-4 license:public-domain))))
(define-public procps
(package
@ -499,7 +499,7 @@ block devices, UUIDs, TTYs, and many other tools.")
that give information about processes using the Linux /proc file system.
The package includes the programs ps, top, vmstat, w, kill, free,
slabtop, and skill.")
(license gpl2)))
(license license:gpl2)))
(define-public usbutils
(package
@ -523,7 +523,7 @@ slabtop, and skill.")
"Tools for working with USB devices, such as lsusb")
(description
"Tools for working with USB devices, such as lsusb.")
(license gpl2+)))
(license license:gpl2+)))
(define-public e2fsprogs
(package
@ -599,9 +599,9 @@ slabtop, and skill.")
(synopsis "Creating and checking ext2/ext3/ext4 file systems")
(description
"This package provides tools for manipulating ext2/ext3/ext4 file systems.")
(license (list gpl2 ; programs
lgpl2.0 ; libext2fs
x11)))) ; libuuid
(license (list license:gpl2 ;programs
license:lgpl2.0 ;libext2fs
license:x11)))) ;libuuid
(define e2fsprogs/static
(static-package
@ -665,7 +665,7 @@ from the e2fsprogs package. It is meant to be used in initrds.")
(description
"Extundelete is a set of tools that can recover deleted files from an
ext3 or ext4 partition.")
(license gpl2)))
(license license:gpl2)))
(define-public zerofree
(package
@ -700,7 +700,7 @@ ext3 or ext4 partition.")
"The zerofree command scans the free blocks in an ext2 file system and
fills any non-zero blocks with zeroes. This is a useful way to make disk
images more compressible.")
(license gpl2)))
(license license:gpl2)))
(define-public strace
(package
@ -720,7 +720,7 @@ images more compressible.")
(description
"strace is a system call tracer, i.e. a debugging tool which prints out a
trace of all the system calls made by a another process/program.")
(license bsd-3)))
(license license:bsd-3)))
(define-public ltrace
(package
@ -744,7 +744,7 @@ trace of all the system calls made by a another process/program.")
"ltrace intercepts and records dynamic library calls which are called by
an executed process and the signals received by that process. It can also
intercept and print the system calls executed by the program.")
(license gpl2+)))
(license license:gpl2+)))
(define-public alsa-lib
(package
@ -765,7 +765,7 @@ intercept and print the system calls executed by the program.")
(description
"The Advanced Linux Sound Architecture (ALSA) provides audio and
MIDI functionality to the Linux-based operating system.")
(license lgpl2.1+)))
(license license:lgpl2.1+)))
(define-public alsa-utils
(package
@ -810,7 +810,7 @@ MIDI functionality to the Linux-based operating system.")
;; This is mostly GPLv2+ but a few files such as 'alsactl.c' are
;; GPLv2-only.
(license gpl2)))
(license license:gpl2)))
(define-public iptables
(package
@ -838,7 +838,7 @@ system administrators. Since Network Address Translation is also configured
from the packet filter ruleset, iptables is used for this, too. The iptables
package also includes ip6tables. ip6tables is used for configuring the IPv6
packet filter.")
(license gpl2+)))
(license license:gpl2+)))
(define-public iproute
(package
@ -899,7 +899,7 @@ consists of several tools, of which the most important are ip and tc. ip
controls IPv4 and IPv6 configuration and tc stands for traffic control. Both
tools print detailed usage messages and are accompanied by a set of
manpages.")
(license gpl2+)))
(license license:gpl2+)))
(define-public net-tools
;; XXX: This package is basically unmaintained, but it provides a few
@ -997,7 +997,7 @@ subsystem of the Linux kernel. This includes arp, hostname, ifconfig,
netstat, rarp and route. Additionally, this package contains utilities
relating to particular network hardware types (plipconfig, slattach) and
advanced aspects of IP configuration (iptunnel, ipmaddr).")
(license gpl2+)))
(license license:gpl2+)))
(define-public libcap
(package
@ -1035,7 +1035,7 @@ advanced aspects of IP configuration (iptunnel, ipmaddr).")
Linux-based operating systems.")
;; License is BSD-3 or GPLv2, at the user's choice.
(license gpl2)))
(license license:gpl2)))
(define-public bridge-utils
(package
@ -1081,7 +1081,7 @@ to connect two Ethernet segments together in a protocol independent way.
Packets are forwarded based on Ethernet address, rather than IP address (like
a router). Since forwarding is done at Layer 2, all protocols can go
transparently through a bridge.")
(license gpl2+)))
(license license:gpl2+)))
(define-public libnl
(package
@ -1108,7 +1108,7 @@ configuration and monitoring interfaces.")
;; Most files are LGPLv2.1-only, but some are GPLv2-only (like
;; 'nl-addr-add.c'), so the result is GPLv2-only.
(license gpl2)))
(license license:gpl2)))
(define-public iw
(package
@ -1134,12 +1134,12 @@ configuration and monitoring interfaces.")
(description
"iw is a new nl80211 based CLI configuration utility for wireless
devices. It replaces 'iwconfig', which is deprecated.")
(license isc)))
(license license:isc)))
(define-public powertop
(package
(name "powertop")
(version "2.7")
(version "2.8")
(source
(origin
(method url-fetch)
@ -1148,7 +1148,7 @@ devices. It replaces 'iwconfig', which is deprecated.")
version ".tar.gz"))
(sha256
(base32
"1jkqqr3l1x98m7rgin1dgfzxqwj4vciw9lyyq1kl9bdswa818jwd"))))
"0nlwazxbnn0k6q5f5b09wdhw0f194lpzkp3l7vxansqhfczmcyx8"))))
(build-system gnu-build-system)
(inputs
`(("zlib" ,zlib)
@ -1156,7 +1156,7 @@ devices. It replaces 'iwconfig', which is deprecated.")
("ncurses" ,ncurses)
("libnl" ,libnl)))
(native-inputs
`(("pkg-config" ,pkg-config)))
`(("pkg-config" ,pkg-config)))
(home-page "https://01.org/powertop/")
(synopsis "Analyze power consumption on Intel-based laptops")
(description
@ -1165,7 +1165,7 @@ power management. In addition to being a diagnostic tool, PowerTOP also has
an interactive mode where the user can experiment various power management
settings for cases where the operating system has not enabled these
settings.")
(license gpl2)))
(license license:gpl2)))
(define-public aumix
(package
@ -1186,7 +1186,7 @@ settings.")
(description
"Aumix adjusts an audio mixer from X, the console, a terminal,
the command line or a script.")
(license gpl2+)))
(license license:gpl2+)))
(define-public iotop
(package
@ -1212,20 +1212,23 @@ the command line or a script.")
(description
"Iotop is a Python program with a top like user interface to show the
processes currently causing I/O.")
(license gpl2+)))
(license license:gpl2+)))
(define-public fuse
(package
(name "fuse")
(version "2.9.3")
(version "2.9.4")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/fuse/fuse-"
version ".tar.gz"))
(uri (let ((version-with-underscores
(string-join (string-split version #\.) "_")))
(string-append
"https://github.com/libfuse/libfuse/"
"releases/download/fuse_" version-with-underscores
"/fuse-" version ".tar.gz")))
(sha256
(base32
"071r6xjgssy8vwdn6m28qq1bqxsd2bphcd2mzhq0grf5ybm87sqb"))
(patches (list (search-patch "fuse-CVE-2015-3202.patch")))))
"1qbwp63a2bp0bchabkwiyzszi9x5krlk2pwk2is6g35gyszw1sbb"))))
(build-system gnu-build-system)
(inputs `(("util-linux" ,util-linux)))
(arguments
@ -1270,8 +1273,8 @@ but also an impediment to system extensibility. FUSE, for \"file systems in
user space\", is a kernel module and user-space library that tries to address
part of this problem by allowing users to run file system implementations as
user-space processes.")
(license (list lgpl2.1 ; library
gpl2+)))) ; command-line utilities
(license (list license:lgpl2.1 ;library
license:gpl2+)))) ;command-line utilities
(define-public unionfs-fuse
(package
@ -1295,7 +1298,7 @@ user-space processes.")
space, using the FUSE library. Mounting a union file system allows you to
\"aggregate\" the contents of several directories into a single mount point.
UnionFS-FUSE additionally supports copy-on-write.")
(license bsd-3)))
(license license:bsd-3)))
(define fuse-static
(package (inherit fuse)
@ -1346,8 +1349,11 @@ UnionFS-FUSE additionally supports copy-on-write.")
(version "2.5")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/fuse/sshfs-fuse-"
version ".tar.gz"))
(uri (let ((version-with-underscores
(string-join (string-split version #\.) "_")))
(string-append "https://github.com/libfuse/sshfs/releases/"
"download/sshfs_" version-with-underscores
"/sshfs-fuse-" version ".tar.gz")))
(sha256
(base32
"0gp6qr33l2p0964j0kds0dfmvyyf5lpgsn11daf0n5fhwm9185z9"))))
@ -1364,7 +1370,7 @@ UnionFS-FUSE additionally supports copy-on-write.")
Since most SSH servers already support this protocol it is very easy to set
up: on the server side there's nothing to do; on the client side mounting the
file system is as easy as logging into the server with an SSH client.")
(license gpl2+)))
(license license:gpl2+)))
(define-public numactl
(package
@ -1397,8 +1403,8 @@ program.
The package contains other commands, such as numademo, numastat and memhog.
The numademo command provides a quick overview of NUMA performance on your
system.")
(license (list gpl2 ; programs
lgpl2.1)))) ; library
(license (list license:gpl2 ;programs
license:lgpl2.1)))) ;library
(define-public kbd
(package
@ -1456,7 +1462,7 @@ system.")
"This package contains keytable files and keyboard utilities compatible
for systems using the Linux kernel. This includes commands such as
'loadkeys', 'setfont', 'kbdinfo', and 'chvt'.")
(license gpl2+)))
(license license:gpl2+)))
(define-public inotify-tools
(package
@ -1476,7 +1482,7 @@ for systems using the Linux kernel. This includes commands such as
(description
"The inotify-tools packages provides a C library and command-line tools
to use Linux' inotify mechanism, which allows file accesses to be monitored.")
(license gpl2+)))
(license license:gpl2+)))
(define-public kmod
(package
@ -1520,7 +1526,7 @@ dependencies and aliases.
These tools are designed on top of libkmod, a library that is shipped with
kmod. The aim is to be compatible with tools, configurations and indices
from the module-init-tools project.")
(license gpl2+))) ; library under lgpl2.1+
(license license:gpl2+))) ; library under lgpl2.1+
(define-public eudev
;; The post-systemd fork, maintained by Gentoo.
@ -1543,12 +1549,12 @@ from the module-init-tools project.")
("gperf" ,gperf)))
(inputs
`(("kmod" ,kmod)))
(home-page "http://www.gentoo.org/proj/en/eudev/")
(home-page "https://wiki.gentoo.org/wiki/Project:Eudev")
(synopsis "Userspace device management")
(description "Udev is a daemon which dynamically creates and removes
device nodes from /dev/, handles hotplug events and loads drivers at boot
time.")
(license gpl2+)))
(license license:gpl2+)))
(define-public lvm2
(package
@ -1613,7 +1619,7 @@ mapper. Kernel components are part of Linux-libre.")
;; Libraries (liblvm2, libdevmapper) are LGPLv2.1.
;; Command-line tools are GPLv2.
(license (list gpl2 lgpl2.1))))
(license (list license:gpl2 license:lgpl2.1))))
(define-public wireless-tools
(package
@ -1652,7 +1658,7 @@ interface.")
(home-page "http://www.hpl.hp.com/personal/Jean_Tourrilhes/Linux/Tools.html")
;; wireless.21.h and wireless.22.h are distributed under lgpl2.1+, the
;; other files are distributed under gpl2.
(license (list gpl2 lgpl2.1+))))
(license (list license:gpl2 license:lgpl2.1+))))
(define-public crda
(package
@ -1721,7 +1727,7 @@ interface.")
"The Central Regulatory Domain Agent (CRDA) acts as the udev helper for
communication between the kernel Linux and user space for regulatory
compliance.")
(license copyleft-next)))
(license license:copyleft-next)))
(define-public wireless-regdb
(package
@ -1734,11 +1740,21 @@ compliance.")
"wireless-regdb-" version ".tar.xz"))
(sha256
(base32
"0czi83k311fp27z42hxjm8vi88fsbc23mhavv96lkb4pmari0jjc"))))
"0czi83k311fp27z42hxjm8vi88fsbc23mhavv96lkb4pmari0jjc"))
;; We're building 'regulatory.bin' by ourselves.
(snippet '(delete-file "regulatory.bin"))))
(build-system gnu-build-system)
(arguments
'(#:phases (modify-phases %standard-phases
(delete 'configure))
;; The 'all' target of the makefile depends on $(REGDB_CHANGED), which
;; is computed and can be equal to 'maintainer-clean'; when that
;; happens, we can end up deleting the 'regulatory.bin' file that we
;; just built. Thus, build things sequentially.
#:parallel-build? #f
#:tests? #f ;no tests
#:make-flags (let ((out (assoc-ref %outputs "out")))
(list (string-append "PREFIX=" out)
@ -1759,7 +1775,7 @@ compliance.")
"This package contains the wireless regulatory database Central
Regulatory Database Agent (CRDA) daemon. The database contains information on
country-specific regulations for the wireless spectrum.")
(license isc)))
(license license:isc)))
(define-public lm-sensors
(package
@ -1832,7 +1848,7 @@ country-specific regulations for the wireless spectrum.")
"Lm-sensors is a hardware health monitoring package for Linux. It allows
you to access information from temperature, voltage, and fan speed sensors.
It works with most newer systems.")
(license gpl2+)))
(license license:gpl2+)))
(define-public i2c-tools
(package
@ -1862,7 +1878,7 @@ It works with most newer systems.")
Linux: a bus probing tool, a chip dumper, register-level SMBus access helpers,
EEPROM decoding scripts, EEPROM programming tools, and a python module for
SMBus access.")
(license gpl2+)))
(license license:gpl2+)))
(define-public xsensors
(package
@ -1899,7 +1915,7 @@ SMBus access.")
"Xsensors reads data from the libsensors library regarding hardware
health such as temperature, voltage and fan speed and displays the information
in a digital read-out.")
(license gpl2+)))
(license license:gpl2+)))
(define-public perf
(package
@ -1975,7 +1991,7 @@ containers. It can be used for running a command or even booting an OS inside
an isolated container, created with the help of Linux namespaces. It is
similar in functionality to chroot, although pflask provides better isolation
thanks to the use of namespaces.")
(license bsd-2)))
(license license:bsd-2)))
(define-public hdparm
(package
@ -2001,7 +2017,7 @@ thanks to the use of namespaces.")
(description
"Get/set device parameters for Linux SATA/IDE drives. It's primary use
is for enabling irq-unmasking and IDE multiple-mode.")
(license (non-copyleft "file://LICENSE.TXT"))))
(license (license:non-copyleft "file://LICENSE.TXT"))))
(define-public rfkill
(package
@ -2027,8 +2043,8 @@ is for enabling irq-unmasking and IDE multiple-mode.")
"rfkill is a simple tool for accessing the rfkill device interface,
which is used to enable and disable wireless networking devices, typically
WLAN, Bluetooth and mobile broadband.")
(license (non-copyleft "file://COPYING"
"See COPYING in the distribution."))))
(license (license:non-copyleft "file://COPYING"
"See COPYING in the distribution."))))
(define-public acpid
(package
@ -2050,7 +2066,7 @@ Configuration and Power Interface (ACPI) events. acpid should be started
during the system boot, and will run as a background process. When an ACPI
event is received from the kernel, acpid will examine the list of rules
specified in /etc/acpi/events and execute the rules that match the event.")
(license gpl2+)))
(license license:gpl2+)))
(define-public sysfsutils
(package
@ -2074,7 +2090,7 @@ Linux kernel versions 2.5+ that exposes a system's device tree. The package
also contains the libsysfs library.")
;; The library is under lgpl2.1+ (all files say "or any later version").
;; The rest is mostly gpl2, with a few files indicating gpl2+.
(license (list gpl2 gpl2+ lgpl2.1+))))
(license (list license:gpl2 license:gpl2+ license:lgpl2.1+))))
(define-public sysfsutils-1
(package
@ -2126,7 +2142,7 @@ also contains the libsysfs library.")
"The cpufrequtils suite contains utilities to retrieve CPU frequency
information, and set the CPU frequency if supported, using the cpufreq
capabilities of the Linux kernel.")
(license gpl2)))
(license license:gpl2)))
(define-public libraw1394
(package
@ -2149,7 +2165,7 @@ the Linux IEEE-1394 subsystem, which provides direct access to the connected
1394 buses to user space. Through libraw1394/raw1394, applications can directly
send to and receive from other nodes without requiring a kernel driver for the
protocol in question.")
(license lgpl2.1+)))
(license license:lgpl2.1+)))
(define-public libavc1394
(package
@ -2172,7 +2188,7 @@ protocol in question.")
(description
"Libavc1394 is a programming interface to the AV/C specification from
the 1394 Trade Association. AV/C stands for Audio/Video Control.")
(license lgpl2.1+)))
(license license:lgpl2.1+)))
(define-public libiec61883
(package
@ -2196,7 +2212,7 @@ the 1394 Trade Association. AV/C stands for Audio/Video Control.")
(description
"The libiec61883 library provides a higher level API for streaming DV,
MPEG-2 and audio over Linux IEEE 1394.")
(license lgpl2.1+)))
(license license:lgpl2.1+)))
(define-public mdadm
(package
@ -2239,7 +2255,7 @@ MPEG-2 and audio over Linux IEEE 1394.")
"mdadm is a tool for managing Linux Software RAID arrays. It can create,
assemble, report on, and monitor arrays. It can also move spares between raid
arrays when needed.")
(license gpl2+)))
(license license:gpl2+)))
(define-public libaio
(package
@ -2268,12 +2284,12 @@ arrays when needed.")
"This library enables userspace to use Linux kernel asynchronous I/O
system calls, important for the performance of databases and other advanced
applications.")
(license lgpl2.1+)))
(license license:lgpl2.1+)))
(define-public bluez
(package
(name "bluez")
(version "5.35")
(version "5.36")
(source (origin
(method url-fetch)
(uri (string-append
@ -2281,9 +2297,7 @@ applications.")
version ".tar.xz"))
(sha256
(base32
"1qphz25hganfnd5ipfscbj7s70anv5favmwqmi9ig2saciaf1zhs"))
(patches
(list (search-patch "bluez-tests.patch")))))
"1wkqwmi5krr37mxcqqlp5m2xnw7vw70v3ww7j09vvlskxcdflhx3"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags
@ -2307,7 +2321,7 @@ applications.")
(description
"BlueZ provides support for the core Bluetooth layers and protocols. It
is flexible, efficient and uses a modular implementation.")
(license gpl2+)))
(license license:gpl2+)))
(define-public fuse-exfat
(package
@ -2365,7 +2379,7 @@ id=0B7CLI-REKbE3VTdaa0EzTkhYdU0")
(description
"This package provides a FUSE-based file system that provides read and
write access to exFAT devices.")
(license gpl2+)))
(license license:gpl2+)))
(define-public gpm
(package
@ -2408,4 +2422,4 @@ write access to exFAT devices.")
"The GPM (general-purpose mouse) daemon is a mouse server for
applications running on the Linux console. It allows users to select items
and copy/paste text in the console and in xterm.")
(license gpl2+)))
(license license:gpl2+)))

3
gnu/packages/lynx.scm
View File

@ -37,8 +37,7 @@
(source (origin
(method url-fetch)
(uri (string-append
"http://lynx.isc.org/lynx"
(substring version 0 (string-index version char-set:letter))
"http://invisible-mirror.net/archives/lynx/tarballs"
"/lynx" version ".tar.bz2"))
(sha256
(base32 "1rxysl08acqll5b87368f04kckl8sggy1qhnq59gsxyny1ffg039"))))

33
gnu/packages/machine-learning.scm
View File

@ -23,6 +23,7 @@
#:use-module (guix download)
#:use-module (guix build-system cmake)
#:use-module (guix build-system gnu)
#:use-module (guix build-system r)
#:use-module (gnu packages)
#:use-module (gnu packages boost)
#:use-module (gnu packages compression)
@ -290,3 +291,35 @@ combine multiple data representations, algorithm classes, and general purpose
tools. This enables both rapid prototyping of data pipelines and extensibility
in terms of new algorithms.")
(license license:gpl3+)))
(define-public r-adaptivesparsity
(package
(name "r-adaptivesparsity")
(version "1.4")
(source (origin
(method url-fetch)
(uri (cran-uri "AdaptiveSparsity" version))
(sha256
(base32
"1az7isvalf3kmdiycrfl6s9k9xqk22k1mc6rh8v0jmcz402qyq8z"))))
(properties
`((upstream-name . "AdaptiveSparsity")))
(build-system r-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'link-against-armadillo
(lambda _
(substitute* "src/Makevars"
(("PKG_LIBS=" prefix)
(string-append prefix "-larmadillo"))))))))
(propagated-inputs
`(("r-rcpp" ,r-rcpp)
("r-rcpparmadillo" ,r-rcpparmadillo)))
(home-page "http://cran.r-project.org/web/packages/AdaptiveSparsity")
(synopsis "Adaptive sparsity models")
(description
"This package implements the Figueiredo machine learning algorithm for
adaptive sparsity and the Wong algorithm for adaptively sparse gaussian
geometric models.")
(license license:lgpl3+)))

47
gnu/packages/mail.scm
View File

@ -285,7 +285,7 @@ and corrections. It is based on a Bayesian filter.")
(define-public offlineimap
(package
(name "offlineimap")
(version "6.5.7")
(version "6.6.1")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/OfflineIMAP/offlineimap/"
@ -293,7 +293,7 @@ and corrections. It is based on a Bayesian filter.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"18whwc4f8nk8gi3mjw9153c9cvwd3i9i7njmpdbhcplrv33m5pmp"))))
"1c2b03856a78ripkpl9jjzj6yzyfb3rlrdnjx300s647l1xx8gxg"))))
(build-system python-build-system)
(native-inputs `(("python" ,python-2)))
(arguments
@ -302,7 +302,7 @@ and corrections. It is based on a Bayesian filter.")
;; Tests require a modifiable IMAP account.
#:tests? #f))
(home-page "http://www.offlineimap.org")
(synopsis "Synch emails between two repositories")
(synopsis "Sync emails between two repositories")
(description
"OfflineImap synchronizes emails between two repositories, so that you
can read the same mailbox from multiple computers. It supports IMAP as REMOTE
@ -372,17 +372,18 @@ attachments, create new maildirs, and so on.")
(define-public notmuch
(package
(name "notmuch")
(version "0.20.2")
(version "0.21")
(source (origin
(method url-fetch)
(uri (string-append "http://notmuchmail.org/releases/notmuch-"
(uri (string-append "https://notmuchmail.org/releases/notmuch-"
version ".tar.gz"))
(sha256
(base32
"1v5dcnlg4km5hfaq0i0qywq5fn66fi0rq4aaibyqkwxz8mis4hgp"))))
"1cr53rbpkcy3pvrmhbg2gq7sjpwb0c8xd7a4zhzxbiv8s7z8yvyh"))))
(build-system gnu-build-system)
(arguments
'(#:tests? #f ;; FIXME: 637 tests; 70 fail and 98 are skipped
'(#:tests? #f ;; FIXME: 662 tests; 168 fail and 99 are skipped
;; with perl input: 50 fail and 99 are skipped
#:phases (modify-phases %standard-phases
(replace 'configure
(lambda* (#:key outputs #:allow-other-keys)
@ -449,7 +450,7 @@ and search library.")
(define-public getmail
(package
(name "getmail")
(version "4.46.0")
(version "4.48.0")
(source
(origin
(method url-fetch)
@ -457,7 +458,7 @@ and search library.")
name "-" version ".tar.gz"))
(sha256
(base32
"15rqmm25pq6ll8aaqh8h6pfdkpqs7y6yismb3h3w1bz8j292c8zl"))))
"0k5rm5kag14izng2ajcagvli9sns5mzvkyfa65ri4xymxs91wi29"))))
(build-system python-build-system)
(arguments
`(#:tests? #f ; no tests
@ -518,14 +519,15 @@ MailCore 2.")
(define-public claws-mail
(package
(name "claws-mail")
(version "3.13.0")
(version "3.13.1")
(source (origin
(method url-fetch)
(uri (string-append
"http://www.claws-mail.org/releases/" name "-" version
".tar.xz"))
(sha256
(base32 "0fpr9gdgrs5yggm61a6135ca06x0cflddsh8dwfqmpb3dj07cl1n"))))
(base32
"049av7r0xhjjjm1p93l2ns3xisvn125v3ncqar23cqjzgcichg5d"))))
(build-system gnu-build-system)
(native-inputs `(("pkg-config" ,pkg-config)))
(inputs `(("bogofilter" ,bogofilter)
@ -563,17 +565,18 @@ which can add many functionalities to the base client.")
(define-public msmtp
(package
(name "msmtp")
(version "1.6.2")
(version "1.6.3")
(source
(origin
(method url-fetch)
(uri (string-append
"mirror://sourceforge/msmtp/msmtp-" version ".tar.xz"))
(sha256 (base32
"12c7ljahb06pgn8yvvw526xvr11vnr6d4nr0apylixddpxycsvig"))))
"0mbkflxv2swjz4185inis83v6pxcblpmapwjhgpc6wh7kh3bx0pr"))))
(build-system gnu-build-system)
(inputs
`(("libidn" ,libidn)
("libsecret" ,libsecret)
("gnutls" ,gnutls)
("zlib" ,zlib)
("gsasl" ,gsasl)))
@ -595,14 +598,17 @@ delivery.")
(define-public exim
(package
(name "exim")
(version "4.85")
(version "4.86")
(source
(origin
(method url-fetch)
(uri (string-append
"ftp://ftp.exim.org/pub/exim/exim4/exim-" version ".tar.bz2"))
(uri (list (string-append "ftp://ftp.exim.org/pub/exim/exim4/exim-"
version ".tar.bz2")
(string-append "ftp://ftp.exim.org/pub/exim/exim4/old/exim-"
version ".tar.bz2")))
(sha256
(base32 "195a3ll5ck9viazf9pvgcyc0sziln5g0ggmlm6ax002lphmiy88k"))))
(base32
"0mn4bxih9slrmll5262ayhf41ji43pjf1rv0y6xpy6x55v7g5k7i"))))
(build-system gnu-build-system)
(inputs
`(("bdb" ,bdb)
@ -696,7 +702,8 @@ facilities for checking incoming mail.")
`(("openssl" ,openssl)
("zlib" ,zlib)
("bzip2" ,bzip2)
("sqlite" ,sqlite)))
("sqlite" ,sqlite)
("linux-pam" ,linux-pam)))
(arguments
`(#:configure-flags '("--sysconfdir=/etc"
"--localstatedir=/var")
@ -723,14 +730,14 @@ It supports mbox/Maildir and its own dbox/mdbox formats.")
(define-public isync
(package
(name "isync")
(version "1.1.2")
(version "1.2.1")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/isync/isync/"
version "/isync-" version ".tar.gz"))
(sha256 (base32
"1960ah3fmp75cakd06lcx50n5q0yvfsadjh3lffhyvjvj7ava9d2"))))
"1bij6nm06ghkg98n2pdyacam2fyg5y8f7ajw0d5653m0r4ldw5p7"))))
(build-system gnu-build-system)
(inputs
`(("bdb" ,bdb)

71
gnu/packages/maths.scm
View File

@ -9,6 +9,7 @@
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2015 Fabian Harfert <fhmgufs@web.de>
;;;
;;; This file is part of GNU Guix.
;;;
@ -53,6 +54,7 @@
#:use-module (gnu packages ghostscript)
#:use-module (gnu packages glib)
#:use-module (gnu packages gtk)
#:use-module (gnu packages image)
#:use-module (gnu packages less)
#:use-module (gnu packages lisp)
#:use-module (gnu packages gnome)
@ -1422,6 +1424,46 @@ output to TeX, and a browser for Maxima's manual including command index and
full text searching.")
(license license:gpl2+)))
(define-public armadillo
(package
(name "armadillo")
(version "6.400.3")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/arma/armadillo-"
version ".tar.gz"))
(sha256
(base32
"0bsgrmldlx77w5x26n3axj1hg6iw6csyw0dwl1flrbdwl51f9701"))))
(build-system cmake-build-system)
(arguments `(#:tests? #f)) ;no test target
(inputs
`(("openblas" ,openblas)
("lapack" ,lapack)
("arpack" ,arpack-ng)))
(home-page "http://arma.sourceforge.net/")
(synopsis "C++ linear algebra library")
(description
"Armadillo is a C++ linear algebra library, aiming towards a good balance
between speed and ease of use. It is useful for algorithm development
directly in C++, or quick conversion of research code into production
environments. It can be used for machine learning, pattern recognition,
signal processing, bioinformatics, statistics, econometrics, etc. The library
provides efficient classes for vectors, matrices and cubes, as well as 150+
associated functions (eg. contiguous and non-contiguous submatrix views).")
(license license:mpl2.0)))
(define-public armadillo-for-rcpparmadillo
(package (inherit armadillo)
(version "6.200.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/arma/armadillo-"
version ".tar.gz"))
(sha256
(base32
"1f69rlqhnf2wv8khyn2a8vi6gx1i72qgfy8b9b760ssk85dcl763"))))))
(define-public muparser
(package
(name "muparser")
@ -1991,3 +2033,32 @@ variables, a command history, hex/octal/binary input and output, unit
conversions, embedded comments, and an expandable expression entry field. It
evaluates expressions using the standard order of operations.")
(license license:gpl2+)))
(define-public xaos
(package
(name "xaos")
(version "3.6")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/xaos/xaos-"
version ".tar.gz"))
(sha256
(base32
"15cd1cx1dyygw6g2nhjqq3bsfdj8sj8m4va9n75i0f3ryww3x7wq"))))
(build-system gnu-build-system)
(native-inputs `(("gettext" ,gnu-gettext)))
(inputs `(("libx11" ,libx11)
("zlib" ,zlib)
("libpng" ,libpng)
("gsl" ,gsl)))
(arguments
`(#:tests? #f ;no "check" target
#:make-flags '("LOCALEDIR=$DATAROOTDIR/locale")))
(synopsis "Real-time fractal zoomer")
(description "GNU XaoS is a graphical program that generates fractal
patterns and allows you to zoom in and out of them infinitely in a fluid,
continuous manner. It also includes tutorials that help to explain how fractals
are built. It can generate many different fractal types such as the Mandelbrot
set.")
(home-page "http://www.gnu.org/software/xaos/")
(license license:gpl2+)))

6
gnu/packages/messaging.scm
View File

@ -365,14 +365,14 @@ compromised.")
(define-public znc
(package
(name "znc")
(version "1.6.1")
(version "1.6.2")
(source (origin
(method url-fetch)
(uri (string-append "http://znc.in/releases/znc-"
(uri (string-append "http://znc.in/releases/archive/znc-"
version ".tar.gz"))
(sha256
(base32
"0h61nv5kx9k8prmhsffxhlprf7gjcq8vqhjjmqr6v3glcirkjjds"))))
"14q5dyr5zg99hm6j6g1gilcn1zf7dskhxfpz3bnkyhy6q0kpgwgf"))))
(build-system gnu-build-system)
(arguments
'(#:tests? #f ; tries to download GoogleTest with wget

4
gnu/packages/moreutils.scm
View File

@ -28,7 +28,7 @@
(define-public moreutils
(package
(name "moreutils")
(version "0.55")
(version "0.57")
(source (origin
(method url-fetch)
(uri (string-append
@ -36,7 +36,7 @@
version ".orig.tar.gz"))
(sha256
(base32
"1dcah2jx8dbznn8966xl7sf1jrld2qfh6l6xcmx9dsnf8p8mr7fs"))))
"078dpkwwwrv8hxnylbc901kib2d1rr3hsja37j6dlpjfcfq58z9s"))))
(build-system gnu-build-system)
(inputs `(("perl" ,perl)
("libxml2" ,libxml2)

260
gnu/packages/music.scm
View File

@ -1,4 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org>
;;;
@ -39,6 +40,7 @@
#:use-module (gnu packages check)
#:use-module (gnu packages compression)
#:use-module (gnu packages docbook)
#:use-module (gnu packages doxygen)
#:use-module (gnu packages flex)
#:use-module (gnu packages fltk)
#:use-module (gnu packages fonts)
@ -66,6 +68,7 @@
#:use-module (gnu packages python)
#:use-module (gnu packages qt)
#:use-module (gnu packages rdf)
#:use-module (gnu packages readline)
#:use-module (gnu packages rsync)
#:use-module (gnu packages tcl)
#:use-module (gnu packages texinfo)
@ -252,7 +255,7 @@ you to define complex tempo maps for entire songs or performances.")
(define-public lilypond
(package
(name "lilypond")
(version "2.19.27")
(version "2.19.33")
(source (origin
(method url-fetch)
(uri (string-append
@ -261,32 +264,39 @@ you to define complex tempo maps for entire songs or performances.")
name "-" version ".tar.gz"))
(sha256
(base32
"11v4jr4qj1jpqvjw1ww7riv8pxfyasif8mf16l447f1xq1ifhkhs"))))
"0s4vbbfy4xwq4da4kmlnndalmcyx2jaz7y8praah2146qbnr90xh"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; out-test/collated-files.html fails
#:out-of-source? #t
#:make-flags '("conf=www") ;to generate images for info manuals
#:configure-flags
(list (string-append "--with-texgyre-dir="
(list "CONFIGURATION=www"
(string-append "--with-texgyre-dir="
(assoc-ref %build-inputs "font-tex-gyre")
"/share/fonts/opentype/"))
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'hardcode-path-to-gs
(lambda* (#:key inputs #:allow-other-keys)
(add-after 'unpack 'fix-path-references
(lambda _
(substitute* "scm/backend-library.scm"
(("\\(search-executable '\\(\"gs\"\\)\\)")
(string-append "\""
(assoc-ref inputs "ghostscript")
"/bin/gs"
"\"" )))
(string-append "\"" (which "gs") "\""))
(("\"/bin/sh\"")
(string-append "\"" (which "sh") "\"")))
#t))
(add-before 'configure 'prepare-configuration
(lambda _
(substitute* "configure"
(("SHELL=/bin/sh") "SHELL=sh"))
(setenv "out" "")
#t)))))
(setenv "out" "www")
(setenv "conf" "www")
#t))
(add-after 'install 'install-info
(lambda _
(zero? (system* "make"
"-j" (number->string (parallel-job-count))
"conf=www" "install-info")))))))
(inputs
`(("guile" ,guile-1.8)
("font-dejavu" ,font-dejavu)
@ -636,6 +646,38 @@ modification devices that brought world-wide fame to the names and products of
Laurens Hammond and Don Leslie.")
(license license:gpl2+)))
(define-public bristol
(package
(name "bristol")
(version "0.60.11")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/bristol/bristol/"
(version-major+minor version)
"/bristol-" version ".tar.gz"))
(sha256
(base32
"1fi2m4gmvxdi260821y09lxsimq82yv4k5bbgk3kyc3x1nyhn7vx"))))
(build-system gnu-build-system)
(inputs
`(("alsa-lib" ,alsa-lib)
("jack" ,jack-1)
("liblo" ,liblo)
("libx11" ,libx11)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(home-page "http://bristol.sourceforge.net/")
(synopsis "Synthesizer emulator")
(description
"Bristol is an emulation package for a number of different 'classic'
synthesizers including additive and subtractive and a few organs. The
application consists of the engine, which is called bristol, and its own GUI
library called brighton that represents all the emulations. There are
currently more than twenty different emulations; each does sound different
although the author maintains that the quality and accuracy of each emulation
is subjective.")
(license license:gpl3+)))
(define-public tuxguitar
(package
(name "tuxguitar")
@ -660,17 +702,19 @@ Laurens Hammond and Don Leslie.")
#:tests? #f ;no "check" target
#:parallel-build? #f ;not supported
#:phases
(alist-cons-before
'build 'enter-dir-set-path-and-pass-ldflags
(lambda* (#:key inputs #:allow-other-keys)
(chdir "TuxGuitar")
(substitute* "GNUmakefile"
(("PROPERTIES\\?=")
(string-append "PROPERTIES?= -Dswt.library.path="
(assoc-ref inputs "swt") "/lib"))
(("\\$\\(GCJ\\) -o") "$(GCJ) $(LDFLAGS) -o"))
#t)
(alist-delete 'configure %standard-phases))))
(modify-phases %standard-phases
(delete 'configure)
(add-before 'build 'enter-dir-and-set-flags
(lambda* (#:key inputs #:allow-other-keys)
(chdir "TuxGuitar")
(substitute* "GNUmakefile"
(("GCJFLAGS\\+=(.*)" _ rest)
(string-append "GCJFLAGS=-fsource=1.4 -fPIC " rest))
(("PROPERTIES\\?=")
(string-append "PROPERTIES?= -Dswt.library.path="
(assoc-ref inputs "swt") "/lib"))
(("\\$\\(GCJ\\) -o") "$(GCJ) $(LDFLAGS) -o"))
#t)))))
(inputs
`(("swt" ,swt)))
(native-inputs
@ -771,6 +815,95 @@ ABC files, has a MIDI player for proof-listening, and includes a documentation
browser.")
(license license:gpl2+)))
(define-public drumstick
(package
(name "drumstick")
(version "1.0.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/drumstick/"
version "/drumstick-" version ".tar.bz2"))
(sha256
(base32
"0mxgix85b2qqs859z91cxik5x0s60dykqiflbj62px9akvf91qdv"))))
(build-system cmake-build-system)
(arguments
`(#:tests? #f ; no test target
#:configure-flags '("-DLIB_SUFFIX=")
#:phases
(modify-phases %standard-phases
(add-before 'configure 'fix-docbook
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "cmake_admin/CreateManpages.cmake"
(("http://docbook.sourceforge.net/release/xsl/current/manpages/docbook.xsl")
(string-append (assoc-ref inputs "docbook-xsl")
"/xml/xsl/docbook-xsl-"
,(package-version docbook-xsl)
"/manpages/docbook.xsl")))
#t)))))
(inputs
`(("qt" ,qt)
("alsa-lib" ,alsa-lib)
("fluidsynth" ,fluidsynth)))
(native-inputs
`(("pkg-config" ,pkg-config)
("libxslt" ,libxslt) ;for xsltproc
("docbook-xsl" ,docbook-xsl)
("doxygen" ,doxygen)))
(home-page "http://drumstick.sourceforge.net/")
(synopsis "C++ MIDI library")
(description
"Drumstick is a set of MIDI libraries using C++/Qt5 idioms and style. It
includes a C++ wrapper around the ALSA library sequencer interface. A
complementary library provides classes for processing SMF (Standard MIDI
files: .MID/.KAR), Cakewalk (.WRK), and Overture (.OVE) file formats. A
multiplatform realtime MIDI I/O library is also provided with various output
backends, including ALSA, OSS, Network and FluidSynth.")
(license license:gpl2+)))
(define-public vmpk
(package
(name "vmpk")
(version "0.6.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/vmpk/vmpk/"
version "/vmpk-" version ".tar.bz2"))
(sha256
(base32
"0ranldd033bd31m9d2vkbkn9zp1k46xbaysllai2i95rf1nhirqc"))))
(build-system cmake-build-system)
(arguments
`(#:tests? #f ; no test target
#:phases
(modify-phases %standard-phases
(add-before 'configure 'fix-docbook
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "cmake_admin/CreateManpages.cmake"
(("http://docbook.sourceforge.net/release/xsl/current/manpages/docbook.xsl")
(string-append (assoc-ref inputs "docbook-xsl")
"/xml/xsl/docbook-xsl-"
,(package-version docbook-xsl)
"/manpages/docbook.xsl")))
#t)))))
(inputs
`(("drumstick" ,drumstick)
("qt" ,qt)))
(native-inputs
`(("libxslt" ,libxslt) ;for xsltproc
("docbook-xsl" ,docbook-xsl)
("pkg-config" ,pkg-config)))
(home-page "http://vmpk.sourceforge.net")
(synopsis "Virtual MIDI piano keyboard")
(description
"Virtual MIDI Piano Keyboard is a MIDI events generator and receiver. It
doesn't produce any sound by itself, but can be used to drive a MIDI
synthesizer (either hardware or software, internal or external). You can use
the computer's keyboard to play MIDI notes, and also the mouse. You can use
the Virtual MIDI Piano Keyboard to display the played MIDI notes from another
instrument or MIDI file player.")
(license license:gpl3+)))
(define-public zynaddsubfx
(package
(name "zynaddsubfx")
@ -815,3 +948,86 @@ browser.")
three synthesizer engines, multitimbral and polyphonic synths, microtonal
capabilities, custom envelopes, effects, etc.")
(license license:gpl2)))
(define-public yoshimi
(package
(name "yoshimi")
(version "1.3.7.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/yoshimi/"
(version-major+minor version)
"/yoshimi-" version ".tar.bz2"))
(sha256
(base32
"13xc1x8jrr2rn26jx4dini692ww3771d5j5xf7f56ixqr7mmdhvz"))))
(build-system cmake-build-system)
(arguments
`(#:tests? #f ; there are no tests
#:configure-flags
(list (string-append "-DCMAKE_INSTALL_DATAROOTDIR="
(assoc-ref %outputs "out") "/share"))
#:phases
(modify-phases %standard-phases
(add-before 'configure 'enter-dir
(lambda _ (chdir "src") #t))
;; Move SSE compiler optimization flags from generic target to
;; athlon64 and core2 targets, because otherwise the build would fail
;; on non-Intel machines.
(add-after 'unpack 'remove-sse-flags-from-generic-target
(lambda _
(substitute* "src/CMakeLists.txt"
(("-msse -msse2 -mfpmath=sse") "")
(("-march=(athlon64|core2)" flag)
(string-append flag " -msse -msse2 -mfpmath=sse")))
#t)))))
(inputs
`(("boost" ,boost)
("fftwf" ,fftwf)
("alsa-lib" ,alsa-lib)
("jack" ,jack-1)
("fontconfig" ,fontconfig)
("minixml" ,minixml)
("mesa" ,mesa)
("fltk" ,fltk)
("lv2" ,lv2)
("readline" ,readline)
("ncurses" ,ncurses)
("cairo" ,cairo)
("zlib" ,zlib)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(home-page "http://yoshimi.sourceforge.net/")
(synopsis "Multi-paradigm software synthesizer")
(description
"Yoshimi is a fork of ZynAddSubFX, a feature heavy realtime software
synthesizer. It offers three synthesizer engines, multitimbral and polyphonic
synths, microtonal capabilities, custom envelopes, effects, etc. Yoshimi
improves on support for JACK features, such as JACK MIDI.")
(license license:gpl2)))
(define-public cursynth
(package
(name "cursynth")
(version "1.5")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/cursynth/cursynth-"
version ".tar.gz"))
(sha256
(base32 "1dhphsya41rv8z6yqcv9l6fwbslsds4zh1y56zizi39nd996d40v"))
(patches (list (search-patch "cursynth-wave-rand.patch")))))
(build-system gnu-build-system)
(native-inputs `(("pkg-config" ,pkg-config)))
;; TODO: See https://github.com/iyoko/cursynth/issues/4 which currently
;; prevents us from using pulseaudio
(inputs `(("ncurses" ,ncurses)
("alsa" ,alsa-lib)))
(home-page "http://www.gnu.org/software/cursynth")
(synopsis "Polyphonic and MIDI subtractive music synthesizer using curses")
(description "GNU cursynth is a polyphonic synthesizer that runs
graphically in the terminal. It is built on a full-featured subtractive
synthesis engine. Notes and parameter changes may be entered via MIDI or the
computer's keyboard.")
(license license:gpl3+)))

43
gnu/packages/ntp.scm
View File

@ -2,6 +2,7 @@
;;; Copyright © 2014 John Darrington <jmd@gnu.org>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -22,6 +23,7 @@
#:use-module (gnu packages)
#:use-module (gnu packages base)
#:use-module (gnu packages linux)
#:use-module (gnu packages autotools)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages tls)
#:use-module (gnu packages libevent)
@ -29,6 +31,7 @@
#:use-module (guix packages)
#:use-module (guix utils)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix build-system gnu)
#:use-module (srfi srfi-1))
@ -108,3 +111,43 @@ secure, easy to configure, and accurate enough for most purposes, so it's more
minimalist than ntpd.")
;; A few of the source files are under bsd-3.
(license (list l:isc l:bsd-3))))
(define-public tlsdate
(package
(name "tlsdate")
(version "0.0.13")
(home-page "https://github.com/ioerror/tlsdate")
(source (origin
(method git-fetch)
(uri (git-reference
(commit (string-append "tlsdate-" version))
(url home-page)))
(sha256
(base32
"0w3v63qmbhpqlxjsvf4k3zp90k6mdzi8cdpgshan9iphy1f44xgl"))
(file-name (string-append name "-" version "-checkout"))))
(build-system gnu-build-system)
(arguments
'(#:phases (modify-phases %standard-phases
(add-after 'unpack 'autogen
(lambda _
;; The ancestor of 'SOURCE_DATE_EPOCH'; it contains the
;; date that is recorded in binaries. It must be a
;; "recent date" since it is used to detect bogus dates
;; received from servers.
(setenv "COMPILE_DATE" (number->string 1450563040))
(zero? (system* "sh" "autogen.sh")))))))
(inputs `(("openssl" ,openssl)
("libevent" ,libevent)))
(native-inputs `(("pkg-config" ,pkg-config)
("autoconf" ,autoconf)
("automake" ,automake)
("libtool" ,libtool)))
(synopsis "Extract remote time from TLS handshakes")
(description
"@command{tlsdate} sets the local clock by securely connecting with TLS
to remote servers and extracting the remote time out of the secure handshake.
Unlike ntpdate, @command{tlsdate} uses TCP, for instance connecting to a
remote HTTPS or TLS enabled service, and provides some protection against
adversaries that try to feed you malicious time information.")
(license l:bsd-3)))

2
gnu/packages/ocaml.scm
View File

@ -285,7 +285,7 @@ concrete syntax of the language (Quotations, Syntax Extensions).")
(version "2.23")
(source (origin
(method url-fetch)
(uri (string-append "http://hevea.inria.fr/distri/"
(uri (string-append "http://hevea.inria.fr/old/"
name "-" version ".tar.gz"))
(sha256
(base32

24
gnu/packages/openstack.scm
View File

@ -136,14 +136,14 @@ guidelines}.")
(define-public python-mox3
(package
(name "python-mox3")
(version "0.12.0")
(version "0.13.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "mox3" version))
(sha256
(base32
"1pwz98q098cb8xxf8yryq21nvklc7hla880bsrq4y3j6bprw3iaj"))))
"0hj57374r239cj1zbzpxw7mj0yfblz55jdfrc2p1h8j7xng0319j"))))
(build-system python-build-system)
(inputs
`(("python-fixtures" ,python-fixtures)
@ -202,14 +202,14 @@ tested on Python version 3.2, 2.7 and 2.6.")
(define-public python-os-testr
(package
(name "python-os-testr")
(version "0.4.2")
(version "0.5.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "os-testr" version))
(sha256
(base32
"0474z0mxb7y3vfk4s097wf1mzji5d135vh27cvlh9q17rq3x9r3w"))))
"0bv03wnmvxhyi8y08hjh9clxrwqc2251529v4kh5khvca0fsbqdp"))))
(build-system python-build-system)
(arguments
;; os-testr uses itself to run the tests. It seems like pbr writes the
@ -307,14 +307,14 @@ portions of your testing code.")
(define-public python-stevedore
(package
(name "python-stevedore")
(version "1.9.0")
(version "1.10.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "stevedore" version))
(sha256
(base32
"01pcrdqsb6ca7hmqwm11b3baj6ml8yz9pxawrgvxb3j9824906fc"))))
"17vpffcnk56sj86d2n3vz5bprcc9bswilgd0awnm7jp073pqkmpm"))))
(build-system python-build-system)
(propagated-inputs
`(("python-six" ,python-six)))
@ -345,14 +345,14 @@ extensions.")
(define-public python-tempest-lib
(package
(name "python-tempest-lib")
(version "0.11.0")
(version "0.12.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "tempest-lib" version))
(sha256
(base32
"1q4wpqcg0yv99mr5gc43wsfirlqdjz90npyghy3mn5f6lby2yikg"))))
"0f15wxk394cb2kw34krpxq8mvy1rxw0lnl5wfiv14cq1s1fm9cjd"))))
(build-system python-build-system)
(arguments
`(#:phases
@ -532,14 +532,14 @@ handlers and support for context specific logging (like resource id’s etc).")
(define-public python-oslo.serialization
(package
(name "python-oslo.serialization")
(version "2.0.0")
(version "2.2.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "oslo.serialization" version))
(sha256
(base32
"1hnkc69sa4r1qhx6hdwlrk2ng7wypgwr063iq5r815a0bv0qr1ad"))))
"00s03krhf833gs76aw5ns32w9m1i4hx6x6d9g82m0j5wyqk0sci4"))))
(build-system python-build-system)
(propagated-inputs
`(("python-iso8601" ,python-iso8601)
@ -569,14 +569,14 @@ in transmittable and storable formats, such as JSON and MessagePack.")
(define-public python-oslosphinx
(package
(name "python-oslosphinx")
(version "3.1.0")
(version "4.2.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "oslosphinx" version))
(sha256
(base32
"0zcshdc9s1f7hnvg0fm2ps5rak3dpnm8kqg4i21lknhmsvb7p5cb"))))
"178svff46pmynpsnw06gpxk0w13p1gwkqbsvyxphblxv9wl09ksz"))))
(build-system python-build-system)
(propagated-inputs
`(("python-requests" ,python-requests)))

8
gnu/packages/owncloud.scm
View File

@ -34,14 +34,14 @@
(define-public owncloud-client
(package
(name "owncloud-client")
(version "2.0.2")
(version "2.1.0")
(source
(origin
(method url-fetch)
(uri (string-append "https://download.owncloud.com/desktop/stable/"
"owncloudclient-" version ".tar.xz"))
(sha256
(base32 "0a42nqx0gn10n7ikhxwif0lqddmb6gbvr45bqbbl30an9gixq598"))))
(base32 "0gyhll4yfxcpyc5m73zar5f33qgnmpwiggw2adxdiqy55hc3ymbk"))))
(build-system cmake-build-system)
(arguments
`(#:phases
@ -50,9 +50,9 @@
(lambda _
(substitute* '("src/libsync/CMakeLists.txt"
"csync/src/CMakeLists.txt")
;; We store the libs in out/lib and not /usr/lib/appname, so we
;; We store the libs in out/lib and not /usr/lib/appname, so we
;; need the executable to point to the libraries in /lib and not
;; in /lib/appname.
;; in /lib/appname.
(("\\/\\$\\{APPLICATION_EXECUTABLE\\}") ""))
(substitute* '("src/cmd/CMakeLists.txt"
"src/crashreporter/CMakeLists.txt"

4
gnu/packages/parallel.scm
View File

@ -29,7 +29,7 @@
(define-public parallel
(package
(name "parallel")
(version "20151122")
(version "20151222")
(source
(origin
(method url-fetch)
@ -37,7 +37,7 @@
version ".tar.bz2"))
(sha256
(base32
"0phn9dlkqlq3cq468ypxbbn78bsjcin743pyvf8ip4qg6jz662jm"))))
"03czpnsj77xxzqxzzr1b39ym9acn94hknzbilbh28v5q1wk7r4mf"))))
(build-system gnu-build-system)
(inputs `(("perl" ,perl)))
(home-page "http://www.gnu.org/software/parallel/")

49
gnu/packages/password-utils.scm
View File

@ -135,3 +135,52 @@ session. Two companion utilities enable users to convert CSV files to YAPET
and vice versa.")
(home-page "http://www.guengel.ch/myapps/yapet/")
(license license:gpl3+)))
(define-public cracklib
(package
(name "cracklib")
(version "2.9.6")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/cracklib/cracklib/"
"releases/download/" name "-" version "/"
name "-" version ".tar.gz"))
(sha256
(base32
"0hrkb0prf7n92w6rxgq0ilzkk6rkhpys2cfqkrbzswp27na7dkqp"))))
(build-system gnu-build-system)
(synopsis "Password checking library")
(home-page "https://github.com/cracklib/cracklib")
(description
"CrackLib is a library containing a C function which may be used in a
passwd like program. The idea is simple: try to prevent users from choosing
passwords that could be guessed by crack by filtering them out, at source.")
(license license:lgpl2.1)))
(define-public libpwquality
(package
(name "libpwquality")
(version "1.3.0")
(source (origin
(method url-fetch)
(uri (list
(string-append "https://fedorahosted.org/releases/l/i/"
name "/" name "-" version ".tar.bz2")
(string-append "https://launchpad.net/libpwquality/trunk/"
version "/+download/"
name "-" version ".tar.bz2")))
(sha256
(base32
"0aidriag6h0syfm33nzdfdsqgrnsgihwjv3a5lgkqch3w68fmlkl"))))
(build-system gnu-build-system)
(arguments
;; XXX: have RUNPATH issue.
'(#:configure-flags '("--disable-python-bindings")))
(inputs
`(("cracklib" ,cracklib)))
(synopsis "Password quality checker")
(home-page "https://fedorahosted.org/libpwquality/")
(description
"Libpwquality is a library for password quality checking and generation of
random passwords that pass the checks.")
(license license:gpl2+)))

25
gnu/packages/patches/bluez-tests.patch
View File

@ -1,25 +0,0 @@
From 484ad8c9263bb524051a999ce19a994960e69572 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=E5=AE=8B=E6=96=87=E6=AD=A6?= <iyzsong@gmail.com>
Date: Fri, 23 Oct 2015 20:48:57 +0800
Subject: [PATCH] unit/test-gobex-header: Fix duplicate test names
---
unit/test-gobex-header.c | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/unit/test-gobex-header.c b/unit/test-gobex-header.c
index 6f49312..8705892 100644
--- a/unit/test-gobex-header.c
+++ b/unit/test-gobex-header.c
@@ -554,7 +554,7 @@ int main(int argc, char *argv[])
test_header_encode_name_umlaut);
g_test_add_func("/gobex/test_header_encode_body",
test_header_encode_body);
- g_test_add_func("/gobex/test_header_encode_connid",
+ g_test_add_func("/gobex/test_header_encode_actionid",
test_header_encode_actionid);
g_test_add_func("/gobex/test_header_encode_apparam",
test_header_encode_apparam);
--
2.5.0

65
gnu/packages/patches/fuse-CVE-2015-3202.patch
View File

@ -1,65 +0,0 @@
The following patch was copied from Debian.
Description: Fix CVE-2015-3202
Missing scrubbing of the environment before executing a mount or umount
of a filesystem.
Origin: upstream
Author: Miklos Szeredi <miklos@szeredi.hu>
Last-Update: 2015-05-19
---
lib/mount_util.c | 23 +++++++++++++++++------
1 file changed, 17 insertions(+), 6 deletions(-)
--- a/lib/mount_util.c
+++ b/lib/mount_util.c
@@ -95,10 +95,12 @@ static int add_mount(const char *prognam
goto out_restore;
}
if (res == 0) {
+ char *env = NULL;
+
sigprocmask(SIG_SETMASK, &oldmask, NULL);
setuid(geteuid());
- execl("/bin/mount", "/bin/mount", "--no-canonicalize", "-i",
- "-f", "-t", type, "-o", opts, fsname, mnt, NULL);
+ execle("/bin/mount", "/bin/mount", "--no-canonicalize", "-i",
+ "-f", "-t", type, "-o", opts, fsname, mnt, NULL, &env);
fprintf(stderr, "%s: failed to execute /bin/mount: %s\n",
progname, strerror(errno));
exit(1);
@@ -146,10 +148,17 @@ static int exec_umount(const char *progn
goto out_restore;
}
if (res == 0) {
+ char *env = NULL;
+
sigprocmask(SIG_SETMASK, &oldmask, NULL);
setuid(geteuid());
- execl("/bin/umount", "/bin/umount", "-i", rel_mnt,
- lazy ? "-l" : NULL, NULL);
+ if (lazy) {
+ execle("/bin/umount", "/bin/umount", "-i", rel_mnt,
+ "-l", NULL, &env);
+ } else {
+ execle("/bin/umount", "/bin/umount", "-i", rel_mnt,
+ NULL, &env);
+ }
fprintf(stderr, "%s: failed to execute /bin/umount: %s\n",
progname, strerror(errno));
exit(1);
@@ -205,10 +214,12 @@ static int remove_mount(const char *prog
goto out_restore;
}
if (res == 0) {
+ char *env = NULL;
+
sigprocmask(SIG_SETMASK, &oldmask, NULL);
setuid(geteuid());
- execl("/bin/umount", "/bin/umount", "--no-canonicalize", "-i",
- "--fake", mnt, NULL);
+ execle("/bin/umount", "/bin/umount", "--no-canonicalize", "-i",
+ "--fake", mnt, NULL, &env);
fprintf(stderr, "%s: failed to execute /bin/umount: %s\n",
progname, strerror(errno));
exit(1);

45
gnu/packages/patches/grub-CVE-2015-8370.patch Normal file
View File

@ -0,0 +1,45 @@
From 88c9657960a6c5d3673a25c266781e876c181add Mon Sep 17 00:00:00 2001
From: Hector Marco-Gisbert <hecmargi@upv.es>
Date: Fri, 13 Nov 2015 16:21:09 +0100
Subject: [PATCH] Fix security issue when reading username and password
This patch fixes two integer underflows at:
* grub-core/lib/crypto.c
* grub-core/normal/auth.c
Signed-off-by: Hector Marco-Gisbert <hecmargi@upv.es>
Signed-off-by: Ismael Ripoll-Ripoll <iripoll@disca.upv.es>
---
grub-core/lib/crypto.c | 2 +-
grub-core/normal/auth.c | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/grub-core/lib/crypto.c b/grub-core/lib/crypto.c
index 010e550..524a3d8 100644
--- a/grub-core/lib/crypto.c
+++ b/grub-core/lib/crypto.c
@@ -468,7 +468,7 @@ grub_password_get (char buf[], unsigned buf_size)
break;
}
- if (key == '\b')
+ if (key == '\b' && cur_len)
{
cur_len--;
continue;
diff --git a/grub-core/normal/auth.c b/grub-core/normal/auth.c
index c6bd96e..5782ec5 100644
--- a/grub-core/normal/auth.c
+++ b/grub-core/normal/auth.c
@@ -172,7 +172,7 @@ grub_username_get (char buf[], unsigned buf_size)
break;
}
- if (key == '\b')
+ if (key == '\b' && cur_len)
{
cur_len--;
grub_printf ("\b");
--
1.9.1

14
gnu/packages/patches/icecat-freetype-2.6.patch
View File

@ -1,14 +0,0 @@
Adapt to freetype 2.6. This patch copied from upstream, see:
https://bugzilla.mozilla.org/show_bug.cgi?id=1143411
https://hg.mozilla.org/mozilla-central/rev/afd840d66e6a
--- a/config/system-headers
+++ b/config/system-headers
@@ -415,6 +415,7 @@ freetype/ftbitmap.h
freetype/ftxf86.h
freetype.h
ftcache.h
+ftfntfmt.h
ftglyph.h
ftsynth.h
ftoutln.h

41
gnu/packages/patches/python-ipython-inputhook-ctype.patch Normal file
View File

@ -0,0 +1,41 @@
From 04c5d358c7ab74d3ddab4f7662e539393d8604c6 Mon Sep 17 00:00:00 2001
From: Lucretiel <Lucretiel@users.noreply.github.com>
Date: Wed, 13 May 2015 13:12:43 -0400
Subject: [PATCH] register now checks for missing ctypes
If ctypes is None, then no input hooks may be registered; `InputHookManager.register` skips registration of input hook classes. Also updated `__init__` to no longer skip creating the instance attributes, to prevent AttributeError exceptions at load time.
---
IPython/lib/inputhook.py | 13 +++++++------
1 file changed, 7 insertions(+), 6 deletions(-)
diff --git a/IPython/lib/inputhook.py b/IPython/lib/inputhook.py
index 4ae2cb3..6578365 100644
--- a/IPython/lib/inputhook.py
+++ b/IPython/lib/inputhook.py
@@ -107,8 +107,8 @@ class InputHookManager(object):
def __init__(self):
if ctypes is None:
warn("IPython GUI event loop requires ctypes, %gui will not be available")
- return
- self.PYFUNC = ctypes.PYFUNCTYPE(ctypes.c_int)
+ else:
+ self.PYFUNC = ctypes.PYFUNCTYPE(ctypes.c_int)
self.guihooks = {}
self.aliases = {}
self.apps = {}
@@ -197,10 +197,11 @@ def enable(self, app=None):
...
"""
def decorator(cls):
- inst = cls(self)
- self.guihooks[toolkitname] = inst
- for a in aliases:
- self.aliases[a] = toolkitname
+ if ctypes is not None:
+ inst = cls(self)
+ self.guihooks[toolkitname] = inst
+ for a in aliases:
+ self.aliases[a] = toolkitname
return cls
return decorator

14
gnu/packages/patchutils.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2015 Leo Famulari <leo@famulari.name>
;;;
;;; This file is part of GNU Guix.
;;;
@ -149,14 +150,15 @@ refreshed, and more.")
(define-public colordiff
(package
(name "colordiff")
(version "1.0.13")
(version "1.0.16")
(source
(origin
(method url-fetch)
(uri (string-append "http://www.colordiff.org/colordiff-"
version ".tar.gz"))
(origin
(method url-fetch)
(uri (list (string-append "http://www.colordiff.org/archive/colordiff-"
version ".tar.gz")))
(sha256
(base32 "0akcz1p3klsjnhwcqdfq4grs6paljc5c0jzr3mqla5f862hhaa6f"))))
(base32
"12qkkw13261dra8pg7mzx4r8p9pb0ajb090bib9j1s6hgphwzwga"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f

129
gnu/packages/perl.scm
View File

@ -2352,6 +2352,24 @@ files with a simple call. It also has a subroutine for reading the list of
file names in a directory.")
(license (package-license perl))))
(define-public perl-file-slurp-tiny
(package
(name "perl-file-slurp-tiny")
(version "0.004")
(source (origin
(method url-fetch)
(uri (string-append "mirror://cpan/authors/id/L/LE/LEONT/"
"File-Slurp-Tiny-" version ".tar.gz"))
(sha256
(base32
"07kzfmibl43dq4c803f022g2rcfv4nkjgipxclz943mzxaz9aaa5"))))
(build-system perl-build-system)
(home-page "http://search.cpan.org/dist/File-Slurp-Tiny")
(synopsis "Simple file reader and writer")
(description
"This module provides functions for fast reading and writing of files.")
(license (package-license perl))))
(define-public perl-file-temp
(package
(name "perl-file-temp")
@ -2778,6 +2796,54 @@ either uses the first module it finds or throws an error.")
versa.")
(license (package-license perl))))
(define-public perl-log-report-optional
(package
(name "perl-log-report-optional")
(version "1.01")
(source (origin
(method url-fetch)
(uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/"
"Log-Report-Optional-" version ".tar.gz"))
(sha256
(base32
"1f4yi4dgzqjc79vrh4f2phdj57xxgk8hd2psx77214i4m5av408f"))))
(build-system perl-build-system)
(propagated-inputs
`(("perl-string-print" ,perl-string-print)))
(home-page "http://search.cpan.org/dist/Log-Report-Optional")
(synopsis "Log::Report in the lightest form")
(description
"This module allows libraries to have a dependency to a small module
instead of the full Log-Report distribution. The full power of
@code{Log::Report} is only released when the main program uses that module.
In that case, the module using the 'Optional' will also use the full
@code{Log::Report}, otherwise the dressed-down @code{Log::Report::Minimal}
version.")
(license (package-license perl))))
(define-public perl-log-report
(package
(name "perl-log-report")
(version "1.10")
(source (origin
(method url-fetch)
(uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/"
"Log-Report-" version ".tar.gz"))
(sha256
(base32
"1jjx1ari3a7ixsyan91b6n7lmjq6dy5223k3x2ah18qbxvw4caap"))))
(build-system perl-build-system)
(propagated-inputs
`(("perl-devel-globaldestruction" ,perl-devel-globaldestruction)
("perl-log-report-optional" ,perl-log-report-optional)
("perl-string-print" ,perl-string-print)))
(home-page "http://search.cpan.org/dist/Log-Report")
(synopsis "Get messages to users and logs")
(description
"@code{Log::Report} combines three tasks which are closely related in
one: logging, exceptions, and translations.")
(license (package-license perl))))
(define-public perl-list-allutils
(package
(name "perl-list-allutils")
@ -2847,6 +2913,25 @@ follows LRU semantics, that is, the last n results, where n is specified as
the argument to the CACHESIZE parameter, will be cached.")
(license (package-license perl))))
(define-public perl-mime-charset
(package
(name "perl-mime-charset")
(version "1.012")
(source (origin
(method url-fetch)
(uri (string-append "mirror://cpan/authors/id/N/NE/NEZUMI/"
"MIME-Charset-" version ".tar.gz"))
(sha256
(base32
"1kfc5p4g1x9c0ffhg125wvhravcviny3alwrgnhnrm2a33ad3rff"))))
(build-system perl-build-system)
(home-page "http://search.cpan.org/dist/MIME-Charset")
(synopsis "Charset information for MIME messages")
(description
"@code{MIME::Charset} provides information about character sets used for
MIME messages on Internet.")
(license (package-license perl))))
(define-public perl-mime-types
(package
(name "perl-mime-types")
@ -4354,6 +4439,28 @@ CamelCase and back again.")
known prefixes.")
(license (package-license perl))))
(define-public perl-string-print
(package
(name "perl-string-print")
(version "0.15")
(source (origin
(method url-fetch)
(uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/"
"String-Print-" version ".tar.gz"))
(sha256
(base32
"1n9lc5dr66sg89hym47764fyfms7vrxrhwvdps2x8x8gxly7rsdl"))))
(build-system perl-build-system)
(propagated-inputs
`(("perl-unicode-linebreak" ,perl-unicode-linebreak)))
(home-page "http://search.cpan.org/dist/String-Print")
(synopsis "String printing alternatives to printf")
(description
"This module inserts values into (translated) strings. It provides
@code{printf} and @code{sprintf} alternatives via both an object-oriented and
a functional interface.")
(license (package-license perl))))
(define-public perl-sub-exporter
(package
(name "perl-sub-exporter")
@ -5827,6 +5934,28 @@ else.")
common serialisation formats such as JSON or CBOR.")
(license (package-license perl))))
(define-public perl-unicode-linebreak
(package
(name "perl-unicode-linebreak")
(version "2015.12")
(source (origin
(method url-fetch)
(uri (string-append "mirror://cpan/authors/id/N/NE/NEZUMI/"
"Unicode-LineBreak-" version ".tar.gz"))
(sha256
(base32
"1d0nnc97irfpab4d3b2lvq22hac118k7zbfrj0lnxkbfwx7122cm"))))
(build-system perl-build-system)
(propagated-inputs
`(("perl-mime-charset" ,perl-mime-charset)))
(home-page "http://search.cpan.org/dist/Unicode-LineBreak")
(synopsis "Unicode line breaking algorithm")
(description
"@code{Unicode::LineBreak} implements the line breaking algorithm
described in Unicode Standard Annex #14. The @code{East_Asian_Width} property
defined by Annex #11 is used to determine breaking positions.")
(license (package-license perl))))
(define-public perl-universal-can
(package
(name "perl-universal-can")

336
gnu/packages/python.scm
View File

@ -13,9 +13,10 @@
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2015 Leo Famulari <leo@famulari.name>
;;; Copyright © 2015 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2015 Erik Edrosa <erik.edrosa@gmail.com>
;;; Copyright © 2015, 2016 Erik Edrosa <erik.edrosa@gmail.com>
;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2015 Kyle Meyer <kyle@kyleam.com>
;;; Copyright © 2015 Chris Marusich <cmmarusich@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -342,16 +343,14 @@ instead of @command{python3}.")))
(define-public python-psutil
(package
(name "python-psutil")
(version "3.0.1")
(version "3.3.0")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/p/psutil/psutil-"
version ".tar.gz"))
(uri (pypi-uri "psutil" version))
(sha256
(base32
"00c8h1mzqysih99z8pnbmdv117d2naldf11yjy50dhykxsf3n89z"))))
"11bd1555vf2ibjnmqf64im5cp55vcqfq45ccinm9ll3bs68na6s2"))))
(build-system python-build-system)
(native-inputs
`(("python-setuptools" ,python-setuptools)))
@ -373,17 +372,14 @@ pidof, tty, taskset, pmap.")
(define-public python-passlib
(package
(name "python-passlib")
(version "1.6.2")
(version "1.6.5")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/p/passlib/passlib-"
version
".tar.gz"))
(uri (pypi-uri "passlib" version))
(sha256
(base32
"0b9rd161b3mmiwd7nx1v599yh9sp07mlfwac65sjy9qn1l0gd1z9"))))
"1z27wdxs5rj5xhhqfzvzn3yg682irkxw6dcs5jj7mcf97psk8gd8"))))
(build-system python-build-system)
(native-inputs
`(("python-nose" ,python-nose)
@ -839,34 +835,23 @@ etc.). The package is structured to make adding new modules easy.")
(define-public python-keyring
(package
(name "python-keyring")
(version "3.8")
(version "5.7.1")
(source
(origin
(method url-fetch)
(uri (string-append "https://pypi.python.org/packages/source/k/"
"keyring/keyring-" version ".zip"))
(uri (pypi-uri "keyring" version))
(sha256
(base32
"1vxazfbcwggyfyramh55shkxs08skhpqrkm6lrrjnygnm8c1l2zg"))))
"1h7a1r9ick7wdd0xb5p63413nvjadna2xawrsvmklsl5ddhm5wrx"))))
(build-system python-build-system)
(native-inputs
`(("unzip" ,unzip)
("python-setuptools" ,python-setuptools)
`(("python-setuptools" ,python-setuptools)
("python-setuptools-scm" ,python-setuptools-scm)
("python-mock" ,python-mock)))
(inputs
`(("python-pycrypto" ,python-pycrypto)))
(arguments
`(#:tests? #f ;TODO: tests require pytest
#:phases
(alist-replace
'unpack
(lambda _
(let ((unzip (string-append (assoc-ref %build-inputs "unzip")
"/bin/unzip"))
(source (assoc-ref %build-inputs "source")))
(and (zero? (system* unzip source))
(chdir (string-append "keyring-" ,version)))))
%standard-phases)))
`(#:tests? #f)) ;TODO: tests require pytest
(home-page "http://bitbucket.org/kang/python-keyring-lib")
(synopsis "Store and access your passwords safely")
(description
@ -912,7 +897,7 @@ Python file, so it can be easily copied into your project.")
(define-public python-dateutil-2
(package
(name "python-dateutil")
(version "2.2")
(version "2.4.2")
(source
(origin
(method url-fetch)
@ -920,7 +905,7 @@ Python file, so it can be easily copied into your project.")
name "/" name "-" version ".tar.gz"))
(sha256
(base32
"0s74ad6r789810s10dxgvaf48ni6adac2icrdad34zxygqq6bj7f"))))
"0ggbm2z72p0nwjqgvpw8s5bqzwayqiqv2iws0x2a605m3mf4959y"))))
(build-system python-build-system)
(inputs
`(("python-setuptools" ,python-setuptools)
@ -1507,16 +1492,14 @@ matching them against a list of media-ranges.")
(define-public python-nose
(package
(name "python-nose")
(version "1.3.4")
(version "1.3.7")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/n/nose/nose-"
version ".tar.gz"))
(uri (pypi-uri "nose" version))
(sha256
(base32
"00qymfgwg4iam4xi0w9bnv7lcb3fypq1hzfafzgs1rfmwaj67g3n"))))
"164a43k7k2wsqqk1s6vavcdamvss4mz0vd6pwzv2h9n8rgwzxgzi"))))
(build-system python-build-system)
(inputs
`(("python-setuptools" ,python-setuptools)))
@ -1576,16 +1559,14 @@ standard library.")
(define-public python-py
(package
(name "python-py")
(version "1.4.23")
(version "1.4.31")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/p/py/py-"
version ".tar.gz"))
(uri (pypi-uri "py" version))
(sha256
(base32
"1jkhffpai419v5rickm2vz86p9bkg3b3kcm2k4bi5wfajhw2m3xs"))))
"0561gz2w3i825gyl42mcq14y3dcgkapfiv5zv9a2bz15qxiijl56"))))
(build-system python-build-system)
(inputs
`(("python-setuptools" ,python-setuptools)))
@ -1912,16 +1893,14 @@ and sensible default behaviors into your setuptools run.")
(define-public python-fixtures
(package
(name "python-fixtures")
(version "1.3.1")
(version "1.4.0")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/f/fixtures/fixtures-"
version ".tar.gz"))
(uri (pypi-uri "fixtures" version))
(sha256
(base32
"1khpywdh91ijryhxjxiyyi5rmbimhl8hwbbf8lazhgzq6yxz6g5n"))))
"0djxvdwm8s60dbfn7bhf40x6g818p3b3mlwijm1c3bqg7msn271y"))))
(build-system python-build-system)
(propagated-inputs
`(("python-six" ,python-six)
@ -1977,16 +1956,14 @@ have failed since the last commit or what tests are currently failing.")
(define-public python-coverage
(package
(name "python-coverage")
(version "3.7.1")
(version "4.0.3")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/c/coverage/coverage-"
version ".tar.gz"))
(uri (pypi-uri "coverage" version))
(sha256
(base32
"0knlbq79g2ww6xzsyknj9rirrgrgc983dpa2d9nkdf31mb2a3bni"))))
"0qjlja8ny4gcfp8abqfwdrvr8qw9kr69lkja0b4cqqbsdmdjgcc5"))))
(build-system python-build-system)
(inputs
`(("python-setuptools" ,python-setuptools)))
@ -2062,16 +2039,13 @@ tests written in a natural language style, backed up by Python code.")
(define-public python-exif-read
(package
(name "python-exif-read")
(version "1.4.2")
(version "2.1.2")
(source (origin
(method url-fetch)
(uri
(string-append
"https://pypi.python.org/packages/source/E/ExifRead/ExifRead-"
version ".tar.gz"))
(uri (pypi-uri "ExifRead" version))
(sha256
(base32
"17c627gcdmyc05hz4zk8qs4pjgw6rc68qzjzgz8gh1cmpsd7acf1"))))
"1b90jf6m9vxh9nanhpyvqdq7hmfx5iggw1l8kq10jrs6xgr49qkr"))))
(build-system python-build-system)
(inputs
`(("python-setuptools" ,python-setuptools)))
@ -2089,16 +2063,13 @@ files.")
(define-public python-pyld
(package
(name "python-pyld")
(version "0.6.0")
(version "0.6.8")
(source (origin
(method url-fetch)
(uri
(string-append
"https://pypi.python.org/packages/source/P/PyLD/PyLD-"
version ".tar.gz"))
(uri (pypi-uri "PyLD" version))
(sha256
(base32
"1l9ymj85fsvayqplinzpk0kyiq6m74ps9xd3a9fhlxfn1rldf8x8"))))
"0k881ffazpf8q1z8862g4bb3pzwpnz9whrci2mf311mvn1qbyqad"))))
(build-system python-build-system)
(inputs
`(("python-setuptools" ,python-setuptools)))
@ -2139,15 +2110,13 @@ is used by the Requests library to verify HTTPS requests.")
(define-public python-click
(package
(name "python-click")
(version "4.0")
(version "6.2")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/c/click/click-"
version ".tar.gz"))
(uri (pypi-uri "click" version))
(sha256
(base32 "0294x9g28w6zgswl0rsygkwi0wf6n480gf7fiiw5f9az3xhh77pl"))))
(base32 "10kavbisnk9m93jl2wi34pw7ryr2qbxshh2cysxwxd7bymqgz87v"))))
(build-system python-build-system)
(native-inputs
`(("python-setuptools" ,python-setuptools)))
@ -2246,16 +2215,13 @@ than Python’s urllib2 library.")
(define-public python-unidecode
(package
(name "python-unidecode")
(version "0.04.16")
(version "0.04.18")
(source (origin
(method url-fetch)
(uri
(string-append
"https://pypi.python.org/packages/source/U/Unidecode/Unidecode-"
version ".tar.gz"))
(uri (pypi-uri "Unidecode" version))
(sha256
(base32
"0yv56vc49rvippyxgxvcyz7jklc07ky38rcspax7p00sgmriiljc"))))
"12hhblqy1ajvidm38im4171x4arg83pfmziyn53nizp29p3m14gi"))))
(build-system python-build-system)
(inputs
`(("python-setuptools" ,python-setuptools)))
@ -2395,21 +2361,24 @@ object.")
(define-public python-virtualenv
(package
(name "python-virtualenv")
(version "1.11.6")
(version "13.1.2")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/v/virtualenv/virtualenv-"
version ".tar.gz"))
(uri (pypi-uri "virtualenv" version))
(sha256
(base32
"1xq4prmg25n9cz5zcvbqx68lmc3kl39by582vd8pzs9f3qalqyiy"))))
"1p732accxwqfjbdna39k8w8lp9gyw91vr4kzkhm8mgfxikqqxg5a"))))
(build-system python-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(replace 'check
(lambda _ (zero? (system* "py.test")))))))
(inputs
`(("python-setuptools" ,python-setuptools)
("python-mock" ,python-mock)
("python-nose" ,python-nose)))
("python-pytest" ,python-pytest)))
(home-page "https://virtualenv.pypa.io/")
(synopsis "Virtual Python environment builder")
(description
@ -2448,16 +2417,14 @@ for Python.")
(define-public python-jinja2
(package
(name "python-jinja2")
(version "2.7.3")
(version "2.8")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/J/Jinja2/Jinja2-"
version ".tar.gz"))
(uri (pypi-uri "Jinja2" version))
(sha256
(base32
"1nwg9yfqgy421lncnm63k1zf9xkd1klc0jm0fr4p3dad01fsq91f"))))
"1x0v41lp5m1pjix3l46zx02b7lqp2hflgpnxwkywxynvi3zz47xw"))))
(build-system python-build-system)
(inputs
`(("python-setuptools" ,python-setuptools)
@ -2556,16 +2523,14 @@ reStructuredText.")
(define-public python-pygments
(package
(name "python-pygments")
(version "1.6")
(version "2.0.2")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/P/Pygments/Pygments-"
version ".tar.gz"))
(uri (pypi-uri "Pygments" version))
(sha256
(base32
"1h11r6ss8waih51vcksfvzghfxiav2f8svc0812fa5kmyz5d97kr"))))
"0lagrwifsgn0s8bzqahpr87p7gd38xja8f06akscinp6hj89283k"))))
(build-system python-build-system)
(inputs
`(("python-setuptools" ,python-setuptools)))
@ -2681,16 +2646,14 @@ which can produce feeds in RSS 2.0, RSS 0.91, and Atom formats.")
(define-public python-blinker
(package
(name "python-blinker")
(version "1.3")
(version "1.4")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/b/blinker/blinker-"
version ".tar.gz"))
(uri (pypi-uri "blinker" version))
(sha256
(base32
"0bvfxkmjx6bpa302pv7v2vw5rwr3dlzjzfdp3bj628i6144024b8"))))
"1dpq0vb01p36jjwbhhd08ylvrnyvcc82yxx3mwjx6awrycjyw6j7"))))
(build-system python-build-system)
(native-inputs
`(("python-setuptools" ,python-setuptools)))
@ -2710,16 +2673,14 @@ interested parties to subscribe to events, or \"signals\".")
(define-public pelican
(package
(name "pelican")
(version "3.6.0")
(version "3.6.3")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/p/pelican/pelican-"
version ".tar.gz"))
(uri (pypi-uri "pelican" version))
(sha256
(base32
"0lbkk902mqxpp452pp76n6qcjv6f99lq2zl204xmqyzcan9zr3ps"))))
"1hn94rb4q3zmcq16in055xikal4dba5hfx3zznq7warllcgc9f8k"))))
(build-system python-build-system)
(native-inputs
`(("python-setuptools" ,python-setuptools)))
@ -2913,15 +2874,14 @@ is designed to have a low barrier to entry.")
(define-public python-cython
(package
(name "python-cython")
(version "0.21.1")
(version "0.23.4")
(source
(origin
(method url-fetch)
(uri (string-append "http://cython.org/release/Cython-"
version ".tar.gz"))
(uri (pypi-uri "Cython" version))
(sha256
(base32
"0ddz2l2dvcy5hdkxx4xlfiwpccvwia7ixgcy4h0pdv46a4i4vxj3"))))
"13hdffhd37mx3gjby018xl179jaj957fy7kzi01crmimxvn2zi7y"))))
(build-system python-build-system)
;; we need the full python package and not just the python-wrapper
;; because we need libpython3.3m.so
@ -3418,15 +3378,14 @@ operators such as union, intersection, and difference.")
(define-public python-rpy2
(package
(name "python-rpy2")
(version "2.6.0")
(version "2.7.6")
(source
(origin
(method url-fetch)
(uri (string-append "https://pypi.python.org/packages/source/r/rpy2"
"/rpy2-" version ".tar.gz"))
(uri (pypi-uri "rpy2" version))
(sha256
(base32
"1dp4l8hpv0jpf4crz4wis6in3lvwk86cr5zvpw410y4a07rrbqjk"))))
"0nhan2qvrw7b7gg5zddwa22kybdv3x1g26vkd7q8lvnkgzrs4dga"))))
(build-system python-build-system)
(inputs
`(("python-six" ,python-six)
@ -3722,15 +3681,14 @@ a general image processing tool.")
(define-public python-pycparser
(package
(name "python-pycparser")
(version "2.10")
(version "2.14")
(source
(origin
(method url-fetch)
(uri (string-append "https://pypi.python.org/packages/source/p/"
"pycparser/pycparser-" version ".tar.gz"))
(uri (pypi-uri "pycparser" version))
(sha256
(base32
"0v5qfq03yvd1pi0dwlgfai0p3dh9bq94pydn19c4pdn0c6v9hzcm"))))
"0wvzyb6rxsfj3xcnpa4ynbh9qc7rrbk2277d5wqpphmx9akv8nbr"))))
(outputs '("out" "doc"))
(build-system python-build-system)
(native-inputs
@ -3770,14 +3728,13 @@ a front-end for C compilers or analysis tools.")
(define-public python-cffi
(package
(name "python-cffi")
(version "1.2.1")
(version "1.4.2")
(source
(origin
(method url-fetch)
(uri (string-append "https://pypi.python.org/packages/source/c/"
"cffi/cffi-" version ".tar.gz"))
(uri (pypi-uri "cffi" version))
(sha256
(base32 "0g8yfzinry1vsj6d1jlnd19338bh92lhhk207ksy4lm1n3g73dga"))))
(base32 "161rj52rzi3880lij17d6i9kvgkiwjilrqjs8405k8sf6ryif7cg"))))
(build-system python-build-system)
(outputs '("out" "doc"))
(inputs
@ -3914,15 +3871,13 @@ PNG, PostScript, PDF, and SVG file output.")
(define-public python-decorator
(package
(name "python-decorator")
(version "3.4.2")
(version "4.0.6")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/d/decorator/decorator-"
version ".tar.gz"))
(uri (pypi-uri "decorator" version))
(sha256
(base32 "0i2bnlkh0p9gs76hb28mafandcrig2fmv56w9ai6mshxwqn0083k"))))
(base32 "1710cwsbwr8fkiq59w2min7rwgdz7ly51yz8l8yh1zbpfxcm8qhw"))))
(build-system python-build-system)
(arguments '(#:tests? #f)) ; no test target
(native-inputs
@ -4208,11 +4163,12 @@ without using the configuration machinery.")
(version "3.2.1")
(source
(origin
(method url-fetch)
(uri (string-append "https://pypi.python.org/packages/source/i/"
"ipython/ipython-" version ".tar.gz"))
(sha256
(base32 "0xwin0sa9n0cabx4cq1ibf5ldsiw5dyimibla82kicz5gbpas4y9"))))
(method url-fetch)
(patches (list (search-patch "python-ipython-inputhook-ctype.patch")))
(uri (string-append "https://pypi.python.org/packages/source/i/"
"ipython/ipython-" version ".tar.gz"))
(sha256
(base32 "0xwin0sa9n0cabx4cq1ibf5ldsiw5dyimibla82kicz5gbpas4y9"))))
(build-system python-build-system)
(outputs '("out" "doc"))
(propagated-inputs
@ -4952,15 +4908,13 @@ applications.")
(define-public python-pyzmq
(package
(name "python-pyzmq")
(version "14.6.0")
(version "15.1.0")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/p/pyzmq/pyzmq-"
version ".tar.gz"))
(uri (pypi-uri "pyzmq" version))
(sha256
(base32 "1frmbjykvhmdg64g7sn20c9fpamrsfxwci1nhhg8q7jgz5pq0ikp"))))
(base32 "13fhwnlvsvxv72kfhqbpn6qi7msh8mc8377mpabv32skk2cjfnxx"))))
(build-system python-build-system)
(arguments
`(#:configure-flags
@ -5013,17 +4967,14 @@ PEP 8.")
(define-public python-pyflakes
(package
(name "python-pyflakes")
(version "0.9.2")
(version "1.0.0")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/p/pyflakes/pyflakes-"
version
".tar.gz"))
(uri (pypi-uri "pyflakes" version))
(sha256
(base32
"0pvawddspdq0y22dbraq5gld9qr6rwa7zhmpfhl2b7v9rqiiqs82"))))
"0qs2sgqszq7wcplis8509wk2ygqcrwzbs1ghfj3svvivq2j377pk"))))
(build-system python-build-system)
(inputs
`(("python-setuptools" ,python-setuptools)))
@ -5119,17 +5070,14 @@ complexity of Python source code.")
(define-public python-flake8
(package
(name "python-flake8")
(version "2.4.1")
(version "2.5.1")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/f/flake8/flake8-"
version
".tar.gz"))
(uri (pypi-uri "flake8" version))
(sha256
(base32
"0dvmrpv7x98xkzffjz1z7lqr90sp5zdz16bdwckfd1cckpjvnzif"))))
"00sn2g5ydriv5anbipcrprpv797kh4q8rfa75w3fc7v7n14fv2j4"))))
(build-system python-build-system)
(inputs
`(("python-setuptools" ,python-setuptools)
@ -5199,6 +5147,39 @@ Python.")
(define-public python2-mistune
(package-with-python2 python-mistune))
(define-public python-markdown
(package
(name "python-markdown")
(version "2.6.5")
(source
(origin
(method url-fetch)
(uri (pypi-uri "Markdown" version))
(sha256
(base32
"0q758a3fiiawr20b3hhjfs677cwj6xi284yb7xspcvv0fdicz54d"))))
(build-system python-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(replace 'check
(lambda _
(zero? (system* "python" "run-tests.py")))))))
(native-inputs
`(("python-nose" ,python-nose)
("python-pyyaml" ,python-pyyaml)))
(home-page "https://pythonhosted.org/Markdown/")
(synopsis "Python implementation of Markdown")
(description
"This package provides a Python implementation of John Gruber's
Markdown. The library features international input, various Markdown
extensions, and several HTML output formats. A command line wrapper
markdown_py is also provided to convert Markdown files to HTML.")
(license bsd-3)))
(define-public python2-markdown
(package-with-python2 python-markdown))
(define-public python-ptyprocess
(package
(name "python-ptyprocess")
@ -5528,16 +5509,14 @@ fractional seconds) of a clock which never goes backwards.")
(define-public python-webob
(package
(name "python-webob")
(version "1.5.0b0")
(version "1.5.1")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/W/WebOb/WebOb-"
version ".tar.gz"))
(uri (pypi-uri "WebOb" version))
(sha256
(base32
"140b3iczclk1j0405rvw5gxshqfkhcc8254fj520z3m23cwbql4a"))))
"02bhhzijfhv8hmi1i54d4b0v43liwhnywhflvxsv4x3zax9s3afq"))))
(build-system python-build-system)
(inputs
`(("python-nose" ,python-nose)
@ -5878,19 +5857,16 @@ Python Package Index (PyPI).")
(define-public python-tlsh
(package
(name "python-tlsh")
(version "3.4.1") ;according to CMakeLists.txt
(version "3.4.4")
(home-page "https://github.com/trendmicro/tlsh")
(source (origin
(method git-fetch)
(uri (git-reference
(url home-page)
;; This is a commit right after 3.4.1; see
;; <https://github.com/trendmicro/tlsh/issues/9>.
(commit "3ae3f1f")))
(method url-fetch)
(uri (string-append "https://github.com/trendmicro/tlsh/archive/v"
version ".tar.gz"))
(sha256
(base32
"12cvnr5ndm5cg6i7lch93id90kgwgrigjgrj8f186nh3h4bf9chj"))
(file-name (string-append name "-" version "-checkout"))))
"00bhzjqrlh7v538kbkbn8lgx976j1138al3sdhklaizqjvpwyk4r"))
(file-name (string-append name "-" version ".tar.gz"))))
(build-system cmake-build-system)
(arguments
'(#:out-of-source? #f
@ -5926,15 +5902,13 @@ a hash value.")
(define-public python-libarchive-c
(package
(name "python-libarchive-c")
(version "2.1")
(version "2.2")
(source (origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/l/libarchive-c/libarchive-c-"
version ".tar.gz"))
(uri (pypi-uri "libarchive-c" version))
(sha256
(base32
"089lrz6xyrfnk55v35vis6jyqyyl77w093057djyspnd2744wi2n"))))
"0z4r7v3dhd6b3120mav05ff08srih176r2rg5k8kn7mjd9pslm2x"))))
(build-system python-build-system)
(arguments
'(#:phases (modify-phases %standard-phases
@ -6479,15 +6453,14 @@ This allows one to make simple text-mode user interfaces on Unix-like systems")
(define-public python-pyrfc3339
(package
(name "python-pyrfc3339")
(version "0.2")
(version "1.0")
(source
(origin
(method url-fetch)
(uri (string-append "https://pypi.python.org/packages/source/p/"
"pyRFC3339/pyRFC3339-" version ".tar.gz"))
(uri (pypi-uri "pyRFC3339" version))
(sha256
(base32
"1pp648xsjaw9h1xq2mgwzda5wis2ypjmzxlksc1a8grnrdmzy155"))))
"0dgm4l9y8jiax5cp6yxjd2i27cq8h33sh81n1wfbmnmqb32cdywd"))))
(build-system python-build-system)
(propagated-inputs
`(("python-pytz" ,python-pytz)))
@ -6618,3 +6591,34 @@ of the SSL peer.")
(arguments `(#:python ,python-2))
(propagated-inputs
`(("python2-pyopenssl" ,python2-pyopenssl)))))
(define-public python-contextlib2
(package
(name "python-contextlib2")
(version "0.4.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "contextlib2" version))
(sha256
(base32
"0cmp131dlh0d0zvw0aza1zd13glvngzk8lb4avks0hm7yxwdr9am"))))
(build-system python-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(replace 'check
(lambda _ (zero?
(system*
"python" "test_contextlib2.py", "-v")))))))
(home-page "http://contextlib2.readthedocs.org/")
(synopsis "Tools for decorators and context managers")
(description "This module is primarily a backport of the Python
3.2 contextlib to earlier Python versions. Like contextlib, it
provides utilities for common tasks involving decorators and context
managers. It also contains additional features that are not part of
the standard library.")
(license psfl)))
(define-public python2-contextlib2
(package-with-python2 python-contextlib2))

684
gnu/packages/ruby.scm
View File

@ -30,6 +30,8 @@
#:use-module (gnu packages autotools)
#:use-module (gnu packages java)
#:use-module (gnu packages libffi)
#:use-module (gnu packages python)
#:use-module (gnu packages ragel)
#:use-module (gnu packages tls)
#:use-module (gnu packages version-control)
#:use-module (guix packages)
@ -38,12 +40,13 @@
#:use-module (guix utils)
#:use-module (guix build-system gnu)
#:use-module (gnu packages xml)
#:use-module (gnu packages web)
#:use-module (guix build-system ruby))
(define-public ruby
(package
(name "ruby")
(version "2.2.3")
(version "2.2.4")
(source
(origin
(method url-fetch)
@ -52,7 +55,7 @@
"/ruby-" version ".tar.xz"))
(sha256
(base32
"19x8gs67klgc3ag815jpin83jn2nv1akgjcgayd6v3h1xplr1v66"))))
"0g3ps4q3iz7wj9m45n8xyxzw8nh29ljdqb87b0f6i0p3853gz2yj"))))
(build-system gnu-build-system)
(arguments
`(#:test-target "test"
@ -571,6 +574,32 @@ format.")
(home-page "https://github.com/nicksieger/ci_reporter")
(license license:expat)))
(define-public ruby-saikuro-treemap
(package
(name "ruby-saikuro-treemap")
(version "0.2.0")
(source (origin
(method url-fetch)
(uri (rubygems-uri "saikuro_treemap" version))
(sha256
(base32
"0w70nmh43mwfbpq20iindl61siqqr8acmf7p3m7n5ipd61c24950"))))
(build-system ruby-build-system)
;; Some of the tests fail because the generated JSON has keys in a
;; different order. This is a problem with the test suite rather than any
;; of the involved libraries.
(arguments `(#:tests? #f))
(propagated-inputs
`(("ruby-json-pure" ,ruby-json-pure)
("ruby-atoulme-saikuro" ,ruby-atoulme-saikuro)))
(synopsis "Generate complexity treemap based on saikuro analysis")
(description
"This gem generates a treemap showing the complexity of Ruby code on
which it is run. It uses Saikuro under the covers to analyze Ruby code
complexity.")
(home-page "http://github.com/ThoughtWorksStudios/saikuro_treemap")
(license license:expat)))
(define-public ruby-orderedhash
(package
(name "ruby-orderedhash")
@ -1432,6 +1461,25 @@ facilities supporting TDD, BDD, mocking, and benchmarking.")
(home-page "https://github.com/seattlerb/minitest")
(license license:expat)))
;; This is the last release of Minitest 4, which is used by some packages.
(define-public ruby-minitest-4
(package (inherit ruby-minitest)
(version "4.7.5")
(source (origin
(method url-fetch)
(uri (rubygems-uri "minitest" version))
(sha256
(base32
"03p6iban9gcpcflzp4z901s1hgj9369p6515h967ny6hlqhcf2iy"))))
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'remove-unsupported-method
(lambda _
(substitute* "Rakefile"
(("self\\.rubyforge_name = .*") ""))
#t)))))))
(define-public ruby-minitest-sprint
(package
(name "ruby-minitest-sprint")
@ -1635,16 +1683,26 @@ to reproduce user environments.")
(home-page "http://github.com/flavorjones/mini_portile")
(license license:expat)))
(define-public ruby-mini-portile-2
(package (inherit ruby-mini-portile)
(version "2.0.0")
(source (origin
(method url-fetch)
(uri (rubygems-uri "mini_portile2" version))
(sha256
(base32
"056drbn5m4khdxly1asmiik14nyllswr6sh3wallvsywwdiryz8l"))))))
(define-public ruby-nokogiri
(package
(name "ruby-nokogiri")
(version "1.6.6.2")
(version "1.6.7.1")
(source (origin
(method url-fetch)
(uri (rubygems-uri "nokogiri" version))
(sha256
(base32
"1j4qv32qjh67dcrc1yy1h8sqjnny8siyy4s44awla8d6jk361h30"))))
"12nwv3lad5k2k73aa1d1xy4x577c143ixks6rs70yp78sinbglk2"))))
(build-system ruby-build-system)
(arguments
;; Tests fail because Nokogiri can only test with an installed extension,
@ -1662,7 +1720,7 @@ to reproduce user environments.")
("libxml2" ,libxml2)
("libxslt" ,libxslt)))
(propagated-inputs
`(("ruby-mini-portile" ,ruby-mini-portile)))
`(("ruby-mini-portile" ,ruby-mini-portile-2)))
(synopsis "HTML, XML, SAX, and Reader parser for Ruby")
(description "Nokogiri (鋸) parses and searches XML/HTML, and features
both CSS3 selector and XPath 1.0 support.")
@ -1736,6 +1794,54 @@ invocation, and source and documentation browsing.")
(home-page "http://pryrepl.org")
(license license:expat)))
(define-public ruby-guard
(package
(name "ruby-guard")
(version "2.13.0")
(source (origin
(method url-fetch)
;; The gem does not include a Rakefile, nor does it contain a
;; gemspec file, nor does it come with the tests. This is why
;; we fetch the tarball from Github.
(uri (string-append "https://github.com/guard/guard/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1hwj0yi17k6f5axrm0k2bb7fq71dlp0zfywmd7pij9iimbppcca0"))))
(build-system ruby-build-system)
(arguments
`(#:tests? #f ; tests require cucumber
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'remove-git-ls-files
(lambda* (#:key outputs #:allow-other-keys)
(substitute* "guard.gemspec"
(("git ls-files -z") "find . -type f -print0"))
#t))
(replace 'build
(lambda _
(zero? (system* "gem" "build" "guard.gemspec")))))))
(propagated-inputs
`(("ruby-formatador" ,ruby-formatador)
("ruby-listen" ,ruby-listen)
("ruby-lumberjack" ,ruby-lumberjack)
("ruby-nenv" ,ruby-nenv)
("ruby-notiffany" ,ruby-notiffany)
("ruby-pry" ,ruby-pry)
("ruby-shellany" ,ruby-shellany)
("ruby-thor" ,ruby-thor)))
(native-inputs
`(("bundler" ,bundler)
("ruby-rspec" ,ruby-rspec)))
(synopsis "Tool to handle events on file system modifications")
(description
"Guard is a command line tool to easily handle events on file system
modifications. Guard automates various tasks by running custom rules whenever
file or directories are modified.")
(home-page "http://guardgem.org/")
(license license:expat)))
(define-public ruby-thread-safe
(package
(name "ruby-thread-safe")
@ -1892,6 +1998,165 @@ documentation for Ruby code.")
(home-page "https://github.com/flori/tins")
(license license:expat)))
(define-public ruby-gem-hadar
(package
(name "ruby-gem-hadar")
(version "1.3.1")
(source (origin
(method url-fetch)
(uri (rubygems-uri "gem_hadar" version))
(sha256
(base32
"1j8qri4m9wf8nbfv0kakrgsv2x8vg10914xgm6f69nw8zi3i39ws"))))
(build-system ruby-build-system)
;; This gem needs itself at development time. We disable rebuilding of the
;; gemspec to avoid this loop.
(arguments
`(#:tests? #f ; there are no tests
#:phases
(modify-phases %standard-phases
(replace 'build
(lambda _
(zero? (system* "gem" "build" "gem_hadar.gemspec")))))))
(propagated-inputs
`(("git" ,git)
("ruby-tins" ,ruby-tins)
("ruby-sdoc" ,ruby-sdoc)))
(native-inputs
`(("bundler" ,bundler)))
(synopsis "Library for the development of Ruby gems")
(description
"This library contains some useful functionality to support the
development of Ruby gems.")
(home-page "https://github.com/flori/gem_hadar")
(license license:expat)))
(define-public ruby-minitest-tu-shim
(package
(name "ruby-minitest-tu-shim")
(version "1.3.3")
(source (origin
(method url-fetch)
(uri (rubygems-uri "minitest_tu_shim" version))
(sha256
(base32
"0xlyh94iirvssix157ng2akr9nqhdygdd0c6094hhv7dqcfrn9fn"))))
(build-system ruby-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'fix-test-include-path
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "Rakefile"
(("Hoe\\.add_include_dirs .*")
(string-append "Hoe.add_include_dirs \""
(assoc-ref inputs "ruby-minitest-4")
"/lib/ruby/gems/2.2.0/gems/minitest-"
,(package-version ruby-minitest-4)
"/lib" "\"")))))
(add-before 'check 'fix-test-assumptions
(lambda _
;; The test output includes the file name, so a couple of tests
;; fail. Changing the regular expressions slightly fixes this
;; problem.
(substitute* "test/test_mini_test.rb"
(("output.sub!\\(.*, 'FILE:LINE'\\)")
"output.sub!(/\\/.+-[\\w\\/\\.]+:\\d+/, 'FILE:LINE')")
(("gsub\\(/.*, 'FILE:LINE'\\)")
"gsub(/\\/.+-[\\w\\/\\.]+:\\d+/, 'FILE:LINE')"))
#t)))))
(propagated-inputs
`(("ruby-minitest-4" ,ruby-minitest-4)))
(native-inputs
`(("ruby-hoe" ,ruby-hoe)))
(synopsis "Adapter library between minitest and test/unit")
(description
"This library bridges the gap between the small and fast minitest and
Ruby's large and slower test/unit.")
(home-page "https://rubygems.org/gems/minitest_tu_shim")
(license license:expat)))
(define-public ruby-term-ansicolor
(package
(name "ruby-term-ansicolor")
(version "1.3.2")
(source (origin
(method url-fetch)
(uri (rubygems-uri "term-ansicolor" version))
(sha256
(base32
"0ydbbyjmk5p7fsi55ffnkq79jnfqx65c3nj8d9rpgl6sw85ahyys"))))
(build-system ruby-build-system)
;; Rebuilding the gemspec seems to require git, even though this is not a
;; git repository, so we just build the gem from the existing gemspec.
(arguments
`(#:phases
(modify-phases %standard-phases
(replace 'build
(lambda _
(zero? (system* "gem" "build" "term-ansicolor.gemspec")))))))
(propagated-inputs
`(("ruby-tins" ,ruby-tins)))
(native-inputs
`(("ruby-gem-hadar" ,ruby-gem-hadar)
("ruby-minitest-tu-shim" ,ruby-minitest-tu-shim)))
(synopsis "Ruby library to control the attributes of terminal output")
(description
"This Ruby library uses ANSI escape sequences to control the attributes
of terminal output.")
(home-page "http://flori.github.io/term-ansicolor/")
;; There is no mention of the "or later" clause.
(license license:gpl2)))
(define-public ruby-pstree
(package
(name "ruby-pstree")
(version "0.1.0")
(source (origin
(method url-fetch)
(uri (rubygems-uri "pstree" version))
(sha256
(base32
"1mig1sv5qx1cdyhjaipy8jlh9j8pnja04vprrzihyfr54x0215p1"))))
(build-system ruby-build-system)
(native-inputs
`(("ruby-gem-hadar" ,ruby-gem-hadar)
("bundler" ,bundler)))
(synopsis "Create a process tree data structure")
(description
"This library uses the output of the @code{ps} command to create a
process tree data structure for the current host.")
(home-page "http://flori.github.com/pstree")
;; There is no mention of the "or later" clause.
(license license:gpl2)))
(define-public ruby-utils
(package
(name "ruby-utils")
(version "0.2.4")
(source (origin
(method url-fetch)
(uri (rubygems-uri "utils" version))
(sha256
(base32
"0vycgscxf3s1xn4yyfsq54zlh082581ga8azybmqgc4pij6iz2cd"))))
(build-system ruby-build-system)
(propagated-inputs
`(("ruby-tins" ,ruby-tins)
("ruby-term-ansicolor" ,ruby-term-ansicolor)
("ruby-pstree" ,ruby-pstree)
("ruby-pry-editline" ,ruby-pry-editline)))
(native-inputs
`(("ruby-gem-hadar" ,ruby-gem-hadar)
("bundler" ,bundler)))
(synopsis "Command line tools for working with Ruby")
(description
"This package provides assorted command line tools that may be useful
when working with Ruby code.")
(home-page "https://github.com/flori/utils")
;; There is no mention of the "or later" clause.
(license license:gpl2)))
(define-public ruby-json
(package
(name "ruby-json")
@ -1911,6 +2176,75 @@ a native C extension.")
(home-page "http://json-jruby.rubyforge.org/")
(license (list license:ruby license:gpl2)))) ; GPL2 only
(define-public ruby-json-pure
(package
(name "ruby-json-pure")
(version "1.8.3")
(source (origin
(method url-fetch)
(uri (rubygems-uri "json_pure" version))
(sha256
(base32
"025aykr360x6dr1jmg8pmsrx7gr30pws4p1q686vnb48zyw1sc94"))))
(build-system ruby-build-system)
(arguments
`(#:modules ((srfi srfi-1)
(ice-9 regex)
(rnrs io ports)
(guix build ruby-build-system)
(guix build utils))
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'replace-git-ls-files
(lambda _
;; The existing gemspec file already contains a nice list of
;; files that belong to the gem. We extract the list from the
;; gemspec file and then replace the file list in the Rakefile to
;; get rid of the call to "git ls-files".
(let* ((contents (call-with-input-file "json.gemspec" get-string-all))
;; Guile is unhappy about the #\nul characters in comments.
(filtered (string-filter (lambda (char)
(not (equal? #\nul char)))
contents))
(files (match:substring
(string-match " s\\.files = ([^]]+\\])" filtered) 1)))
(substitute* "Rakefile"
(("FileList\\[`git ls-files`\\.split\\(/\\\\n/\\)\\]")
(string-append "FileList" files))))
#t)))))
(native-inputs
`(("ruby-permutation" ,ruby-permutation)
("ruby-utils" ,ruby-utils)
("ragel" ,ragel)
("bundler" ,bundler)))
(synopsis "JSON implementation in pure Ruby")
(description
"This package provides a JSON implementation written in pure Ruby.")
(home-page "http://flori.github.com/json")
(license license:ruby)))
;; Even though this package only provides bindings for a Mac OSX API it is
;; required by "ruby-listen" at runtime.
(define-public ruby-rb-fsevent
(package
(name "ruby-rb-fsevent")
(version "0.9.6")
(source (origin
(method url-fetch)
(uri (rubygems-uri "rb-fsevent" version))
(sha256
(base32
"1hq57by28iv0ijz8pk9ynih0xdg7vnl1010xjcijfklrcv89a1j2"))))
(build-system ruby-build-system)
;; Tests need "guard-rspec", which needs "guard". However, "guard" needs
;; "listen", which needs "rb-fsevent" at runtime.
(arguments `(#:tests? #f))
(synopsis "FSEvents API with signals catching")
(description
"This library provides Ruby bindings for the Mac OSX FSEvents API.")
(home-page "https://rubygems.org/gems/rb-fsevent")
(license license:expat)))
(define-public ruby-listen
(package
(name "ruby-listen")
@ -1925,8 +2259,8 @@ a native C extension.")
(build-system ruby-build-system)
(arguments '(#:tests? #f)) ; no tests
(propagated-inputs
;; FIXME: omitting "ruby-rb-fsevent" which is only for MacOS.
`(("ruby-rb-inotify" ,ruby-rb-inotify)))
`(("ruby-rb-inotify" ,ruby-rb-inotify)
("ruby-rb-fsevent" ,ruby-rb-fsevent)))
(synopsis "Listen to file modifications")
(description "The Listen gem listens to file modifications and notifies
you about the changes.")
@ -1960,6 +2294,121 @@ multibyte strings, internationalization, time zones, and testing.")
(home-page "http://www.rubyonrails.org")
(license license:expat)))
(define-public ruby-crass
(package
(name "ruby-crass")
(version "1.0.2")
(source (origin
(method url-fetch)
(uri (rubygems-uri "crass" version))
(sha256
(base32
"1c377r8g7m58y22803iyjgqkkvnnii0pymskda1pardxrzaighj9"))))
(build-system ruby-build-system)
(native-inputs
`(("bundler" ,bundler)
("ruby-minitest" ,ruby-minitest)))
(synopsis "Pure Ruby CSS parser")
(description
"Crass is a pure Ruby CSS parser based on the CSS Syntax Level 3 spec.")
(home-page "https://github.com/rgrove/crass/")
(license license:expat)))
(define-public ruby-nokogumbo
(package
(name "ruby-nokogumbo")
(version "1.4.6")
(source (origin
;; We use the git reference, because there's no Rakefile in the
;; published gem and the tarball on Github is outdated.
(method git-fetch)
(uri (git-reference
(url "https://github.com/rubys/nokogumbo.git")
(commit "d56f954d20a")))
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"0bnppjy96xiadrsrc9dp8y6wvdwnkfa930n7acrp0mqm4qywl2wl"))))
(build-system ruby-build-system)
(arguments
`(#:modules ((guix build ruby-build-system)
(guix build utils)
(ice-9 rdelim))
#:phases
(modify-phases %standard-phases
(add-before 'build 'build-gemspec
(lambda _
(substitute* "Rakefile"
;; Build Makefile even without a copy of gumbo-parser sources
(("'gumbo-parser/src',") "")
;; We don't bundle gumbo-parser sources
(("'gumbo-parser/src/\\*',") "")
(("'gumbo-parser/visualc/include/\\*',") "")
;; The definition of SOURCES will be cut in gemspec, and
;; "FileList" will be undefined.
(("SOURCES \\+ FileList\\[")
"['ext/nokogumboc/extconf.rb', 'ext/nokogumboc/nokogumbo.c', "))
;; Copy the Rakefile and cut out the gemspec.
(copy-file "Rakefile" ".gemspec")
(with-atomic-file-replacement ".gemspec"
(lambda (in out)
(let loop ((line (read-line in 'concat))
(skipping? #t))
(if (eof-object? line)
#t
(let ((skip-next? (if skipping?
(not (string-prefix? "SPEC =" line))
(string-prefix? "end" line))))
(when (or (not skipping?)
(and skipping? (not skip-next?)))
(format #t "~a" line)
(display line out))
(loop (read-line in 'concat) skip-next?))))))
#t)))))
(inputs
`(("gumbo-parser" ,gumbo-parser)))
(propagated-inputs
`(("ruby-nokogiri" ,ruby-nokogiri)))
(synopsis "Ruby bindings to the Gumbo HTML5 parser")
(description
"Nokogumbo allows a Ruby program to invoke the Gumbo HTML5 parser and
access the result as a Nokogiri parsed document.")
(home-page "https://github.com/rubys/nokogumbo/")
(license license:asl2.0)))
(define-public ruby-sanitize
(package
(name "ruby-sanitize")
(version "4.0.0")
(source (origin
(method url-fetch)
;; The gem does not include the Rakefile, so we download the
;; release tarball from Github.
(uri (string-append "https://github.com/rgrove/"
"sanitize/archive/v" version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"055xnj38l60gxnnng76kpy2l2jbrp0byjdyq17jw79w7l4b40znr"))))
(build-system ruby-build-system)
(propagated-inputs
`(("ruby-crass" ,ruby-crass)
("ruby-nokogiri" ,ruby-nokogiri)
("ruby-nokogumbo" ,ruby-nokogumbo)))
(native-inputs
`(("bundler" ,bundler)
("ruby-minitest" ,ruby-minitest)
("ruby-redcarpet" ,ruby-redcarpet)
("ruby-yard" ,ruby-yard)))
(synopsis "Whitelist-based HTML and CSS sanitizer")
(description
"Sanitize is a whitelist-based HTML and CSS sanitizer. Given a list of
acceptable elements, attributes, and CSS properties, Sanitize will remove all
unacceptable HTML and/or CSS from a string.")
(home-page "https://github.com/rgrove/sanitize/")
(license license:expat)))
(define-public ruby-ox
(package
(name "ruby-ox")
@ -1983,6 +2432,45 @@ alternative to Marshal for Object serialization. ")
(home-page "http://www.ohler.com/ox")
(license license:expat)))
(define-public ruby-redcloth
(package
(name "ruby-redcloth")
(version "4.2.9")
(source (origin
(method url-fetch)
(uri (rubygems-uri "RedCloth" version))
(sha256
(base32
"06pahxyrckhgb7alsxwhhlx1ib2xsx33793finj01jk8i054bkxl"))))
(build-system ruby-build-system)
(arguments
`(#:tests? #f ; no tests
#:phases
(modify-phases %standard-phases
;; Redcloth has complicated rake tasks to build various versions for
;; multiple targets using RVM. We don't want this so we just use the
;; existing gemspec.
(replace 'build
(lambda _
(zero? (system* "gem" "build" "redcloth.gemspec"))))
;; Make sure that the "redcloth" executable finds required Ruby
;; libraries.
(add-after 'install 'wrap-bin-redcloth
(lambda* (#:key outputs #:allow-other-keys)
(wrap-program (string-append (assoc-ref outputs "out")
"/bin/redcloth")
`("GEM_HOME" ":" prefix (,(getenv "GEM_HOME"))))
#t)))))
(native-inputs
`(("bundler" ,bundler)
("ruby-diff-lcs" ,ruby-diff-lcs)
("ruby-rspec-2" ,ruby-rspec-2)))
(synopsis "Textile markup language parser for Ruby")
(description
"RedCloth is a Ruby parser for the Textile markup language.")
(home-page "http://redcloth.org")
(license license:expat)))
(define-public ruby-pg
(package
(name "ruby-pg")
@ -2032,6 +2520,109 @@ other things and it comes with a command line interface.")
(home-page "http://github.com/deivid-rodriguez/byebug")
(license license:bsd-2)))
(define-public ruby-netrc
(package
(name "ruby-netrc")
(version "0.11.0")
(source (origin
(method url-fetch)
(uri (rubygems-uri "netrc" version))
(sha256
(base32
"0gzfmcywp1da8nzfqsql2zqi648mfnx6qwkig3cv36n9m0yy676y"))))
(build-system ruby-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(replace 'check
;; There is no Rakefile and minitest can only run one file at once,
;; so we have to iterate over all test files.
(lambda _
(and (map (lambda (file)
(zero? (system* "ruby" "-Itest" file)))
(find-files "./test" "test_.*\\.rb"))))))))
(native-inputs
`(("ruby-minitest" ,ruby-minitest)))
(synopsis "Library to read and update netrc files")
(description
"This library can read and update netrc files, preserving formatting
including comments and whitespace.")
(home-page "https://github.com/geemus/netrc")
(license license:expat)))
(define-public ruby-unf-ext
(package
(name "ruby-unf-ext")
(version "0.0.7.1")
(source (origin
(method url-fetch)
(uri (rubygems-uri "unf_ext" version))
(sha256
(base32
"0ly2ms6c3irmbr1575ldyh52bz2v0lzzr2gagf0p526k12ld2n5b"))))
(build-system ruby-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'build 'build-ext
(lambda _ (zero? (system* "rake" "compile:unf_ext")))))))
(native-inputs
`(("bundler" ,bundler)
("ruby-rake-compiler" ,ruby-rake-compiler)
("ruby-test-unit" ,ruby-test-unit)))
(synopsis "Unicode normalization form support library")
(description
"This package provides unicode normalization form support for Ruby.")
(home-page "https://github.com/knu/ruby-unf_ext")
(license license:expat)))
(define-public ruby-tdiff
(package
(name "ruby-tdiff")
(version "0.3.3")
(source (origin
(method url-fetch)
(uri (rubygems-uri "tdiff" version))
(sha256
(base32
"0k41jbvn8qq4mgrixnhlk742b971d136i8wpbcv2cczvi22xpc86"))))
(build-system ruby-build-system)
(native-inputs
`(("ruby-rspec-2" ,ruby-rspec-2)
("ruby-yard" ,ruby-yard)
("ruby-rubygems-tasks" ,ruby-rubygems-tasks)))
(synopsis "Calculate the differences between two tree-like structures")
(description
"This library provides functions to calculate the differences between two
tree-like structures. It is similar to Ruby's built-in @code{TSort} module.")
(home-page "https://github.com/postmodern/tdiff")
(license license:expat)))
(define-public ruby-nokogiri-diff
(package
(name "ruby-nokogiri-diff")
(version "0.2.0")
(source (origin
(method url-fetch)
(uri (rubygems-uri "nokogiri-diff" version))
(sha256
(base32
"0njr1s42war0bj1axb2psjvk49l74a8wzr799wckqqdcb6n51lc1"))))
(build-system ruby-build-system)
(propagated-inputs
`(("ruby-tdiff" ,ruby-tdiff)
("ruby-nokogiri" ,ruby-nokogiri)))
(native-inputs
`(("ruby-rspec-2" ,ruby-rspec-2)
("ruby-yard" ,ruby-yard)
("ruby-rubygems-tasks" ,ruby-rubygems-tasks)))
(synopsis "Calculate the differences between two XML/HTML documents")
(description
"@code{Nokogiri::Diff} adds the ability to calculate the
differences (added or removed nodes) between two XML/HTML documents.")
(home-page "https://github.com/postmodern/nokogiri-diff")
(license license:expat)))
(define-public ruby-rack
(package
(name "ruby-rack")
@ -2200,6 +2791,85 @@ extending for custom Ruby constructs such as custom class level definitions.")
(home-page "http://yardoc.org")
(license license:expat)))
(define-public ruby-clap
(package
(name "ruby-clap")
(version "1.0.0")
(source (origin
(method url-fetch)
(uri (rubygems-uri "clap" version))
(sha256
(base32
"190m05k3pca72c1h8k0fnvby15m303zi0lpb9c478ad19wqawa5q"))))
(build-system ruby-build-system)
;; Clap needs cutest for running tests, but cutest needs clap.
(arguments `(#:tests? #f))
(synopsis "Command line argument parsing for simple applications")
(description
"Clap provides command line argument parsing features. It covers the
simple case of executing code based on the flags or parameters passed.")
(home-page "https://github.com/djanowski/cutest")
(license license:expat)))
(define-public ruby-cutest
(package
(name "ruby-cutest")
(version "1.2.2")
(source (origin
(method url-fetch)
(uri (rubygems-uri "cutest" version))
(sha256
(base32
"1mldhjn62g53vx4gq2qdqg2lgjvyrqxa8d0khf8347bbfgi16d32"))))
(build-system ruby-build-system)
(propagated-inputs
`(("ruby-clap" ,ruby-clap)))
(synopsis "Run tests in separate processes")
(description
"Cutest runs tests in separate processes to avoid shared state.")
(home-page "https://github.com/djanowski/cutest")
(license license:expat)))
(define-public ruby-pygmentize
(package
(name "ruby-pygmentize")
(version "0.0.3")
(source (origin
(method url-fetch)
(uri (rubygems-uri "pygmentize" version))
(sha256
(base32
"1pxryhkiwvsz6xzda3bvqwz5z8ggzl1cdglf8qbcf4bb7akirdpb"))))
(build-system ruby-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'fix-pygmentize-path
(lambda _
(substitute* "lib/pygmentize.rb"
(("\"/usr/bin/env python.*")
(string-append "\"" (which "pygmentize") "\"\n")))
#t))
(add-after 'build 'do-not-use-vendor-directory
(lambda _
;; Remove bundled pygments sources
;; FIXME: ruby-build-system does not support snippets.
(delete-file-recursively "vendor")
(substitute* "pygmentize.gemspec"
(("\"vendor/\\*\\*/\\*\",") ""))
#t)))))
(inputs
`(("pygments" ,python-pygments)))
(native-inputs
`(("ruby-cutest" ,ruby-cutest)
("ruby-nokogiri" ,ruby-nokogiri)))
(synopsis "Thin Ruby wrapper around pygmentize")
(description
"Pygmentize provides a simple way to call pygmentize from within a Ruby
application.")
(home-page "https://github.com/djanowski/pygmentize")
(license license:expat)))
(define-public ruby-eventmachine
(package
(name "ruby-eventmachine")

184
gnu/packages/samba.scm
View File

@ -24,12 +24,14 @@
#:use-module (guix licenses)
#:use-module (gnu packages acl)
#:use-module (gnu packages admin)
#:use-module (gnu packages cups)
#:use-module (gnu packages databases)
#:use-module (gnu packages tls)
#:use-module (gnu packages popt)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages openldap)
#:use-module (gnu packages readline)
#:use-module (gnu packages libunwind)
#:use-module (gnu packages linux)
#:use-module (gnu packages elf)
#:use-module (gnu packages perl)
#:use-module (gnu packages python))
@ -96,64 +98,57 @@ anywhere.")
(define-public samba
(package
(name "samba")
(version "3.6.25")
(version "4.3.2")
(source (origin
(method url-fetch)
(uri (string-append "https://www.samba.org/samba/ftp/stable/samba-"
version ".tar.gz"))
(sha256
(base32
"0l9pz2m67vf398q3c2dwn8jwdxsjb20igncf4byhv6yq5dzqlb4g"))))
"0xcs2bcim421mlk6l9rcrkx4cq9y41gfssyfa7xzdw5draar3631"))))
(build-system gnu-build-system)
(arguments
`(#:phases (alist-cons-before
'configure 'chdir
(lambda _
(chdir "source3"))
(alist-cons-after
'strip 'add-lib-to-runpath
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(lib (string-append out "/lib")))
;; Add LIB to the RUNPATH of all the executables and
;; dynamic libraries.
(with-directory-excursion out
(for-each (cut augment-rpath <> lib)
(append (find-files "bin" ".*")
(find-files "sbin" ".*")
(find-files "lib" ".*"))))))
%standard-phases))
#:modules ((guix build gnu-build-system)
(guix build utils)
(guix build rpath)
(srfi srfi-26))
#:imported-modules (,@%gnu-build-system-modules
(guix build rpath))
;; This flag is required to allow for "make test".
#:configure-flags '("--enable-socket-wrapper")
#:test-target "test"
'(#:phases
(modify-phases %standard-phases
(replace 'configure
;; samba uses a custom configuration script that runs waf.
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(libdir (string-append out "/lib")))
(zero? (system*
"./configure"
"--enable-fhs"
;; XXX: heimdal not packaged.
"--bundled-libraries=com_err"
(string-append "--prefix=" out)
;; Install public and private libraries into
;; a single directory to avoid RPATH issues.
(string-append "--libdir=" libdir)
(string-append "--with-privatelibdir=" libdir)))))))
;; XXX: The test infrastructure attempts to set password with
;; smbpasswd, which fails with "smbpasswd -L can only be used by root."
;; So disable tests until there's a workaround.
#:tests? #f))
(inputs ; TODO: Add missing dependencies
`(;; ("cups" ,cups)
("acl" ,acl)
`(("acl" ,acl)
("cups" ,cups)
;; ("gamin" ,gamin)
("libunwind" ,libunwind)
("gnutls" ,gnutls)
("iniparser" ,iniparser)
("popt" ,popt)
("openldap" ,openldap)
("libaio" ,libaio)
("ldb" ,ldb)
("linux-pam" ,linux-pam)
("openldap" ,openldap)
("popt" ,popt)
("readline" ,readline)
("patchelf" ,patchelf))) ; for (guix build rpath)
(native-inputs ; for the test suite
("talloc" ,talloc)
("tevent" ,tevent)
("tdb" ,tdb)))
(native-inputs
`(("perl" ,perl)
("python" ,python-wrapper)))
("pkg-config" ,pkg-config)
("python" ,python-2))) ; incompatible with Python 3
(home-page "http://www.samba.org/")
(synopsis
"The standard Windows interoperability suite of programs for GNU and Unix")
@ -169,26 +164,31 @@ Desktops into Active Directory environments using the winbind daemon.")
(define-public talloc
(package
(name "talloc")
(version "2.1.2")
(version "2.1.5")
(source (origin
(method url-fetch)
(uri (string-append "https://www.samba.org/ftp/talloc/talloc-"
version ".tar.gz"))
(sha256
(base32
"13c365f7y8idjf2v1jxdjpkc3lxdmsxxfxjx1ymianm7zjiph393"))))
"1pfx3kmj973hpacfw46fzfnjd7ms1j03ifkc30wk930brx8ffcrq"))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-replace
'configure
(lambda* (#:key outputs #:allow-other-keys)
;; talloc uses a custom configuration script that runs a
;; python script called 'waf'.
(setenv "CONFIG_SHELL" (which "sh"))
(let ((out (assoc-ref outputs "out")))
(zero? (system* "./configure"
(string-append "--prefix=" out)))))
%standard-phases)))
'(#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda* (#:key outputs #:allow-other-keys)
;; test_magic_differs.sh has syntax error, and is not in the right
;; place where wscript expected.
;; Skip the test.
(substitute* "wscript"
(("magic_ret = .*") "magic_ret = 0\n"))
;; talloc uses a custom configuration script that runs a
;; python script called 'waf'.
(setenv "CONFIG_SHELL" (which "sh"))
(let ((out (assoc-ref outputs "out")))
(zero? (system* "./configure"
(string-append "--prefix=" out)))))))))
(inputs
`(("python" ,python-2)))
(home-page "http://talloc.samba.org")
@ -198,6 +198,84 @@ Desktops into Active Directory environments using the winbind daemon.")
destructors. It is the core memory allocator used in Samba.")
(license gpl3+))) ;; The bundled "replace" library uses LGPL3.
(define-public tevent
(package
(name "tevent")
(version "0.9.26")
(source (origin
(method url-fetch)
(uri (string-append "https://www.samba.org/ftp/tevent/tevent-"
version ".tar.gz"))
(sha256
(base32
"1gbh6d2m49j1v2hkaiyrh8bj02i5wxd4hqayzk2g44yyivbi8b16"))))
(build-system gnu-build-system)
(arguments
'(#:phases
(modify-phases %standard-phases
(replace 'configure
;; tevent uses a custom configuration script that runs waf.
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(zero? (system* "./configure"
(string-append "--prefix=" out)
"--bundled-libraries=NONE"))))))))
(native-inputs
`(("pkg-config" ,pkg-config)
("python" ,python-2)))
(propagated-inputs
`(("talloc" ,talloc))) ; required by tevent.pc
(synopsis "Event system library")
(home-page "https://tevent.samba.org/")
(description
"Tevent is an event system based on the talloc memory management library.
It is the core event system used in Samba. The low level tevent has support for
many event types, including timers, signals, and the classic file descriptor events.")
(license lgpl3+)))
(define-public ldb
(package
(name "ldb")
(version "1.1.23")
(source (origin
(method url-fetch)
(uri (string-append "https://www.samba.org/ftp/ldb/ldb-"
version ".tar.gz"))
(sha256
(base32
"0ncmwgga6q9v7maiywgw21w6rb3149m1w2ca11yq8k5j0izjz2wg"))))
(build-system gnu-build-system)
(arguments
'(#:phases
(modify-phases %standard-phases
(replace 'configure
;; ldb use a custom configuration script that runs waf.
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(zero? (system* "./configure"
(string-append "--prefix=" out)
(string-append "--with-modulesdir=" out
"/lib/ldb/modules")
"--bundled-libraries=NONE"))))))))
(native-inputs
`(("pkg-config" ,pkg-config)
("python" ,python-2)))
(propagated-inputs
;; ldb.pc refers to all these.
`(("talloc" ,talloc)
("tdb" ,tdb)))
(inputs
`(("popt" ,popt)
("tevent" ,tevent)))
(synopsis "LDAP-like embedded database")
(home-page "https://ldb.samba.org/")
(description
"Ldb is a LDAP-like embedded database built on top of TDB. What ldb does
is provide a fast database with an LDAP-like API designed to be used within an
application. In some ways it can be seen as a intermediate solution between
key-value pair databases and a real LDAP database.")
(license lgpl3+)))
(define-public ppp
(package
(name "ppp")

61
gnu/packages/sdl.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 David Thompson <dthompson2@worcester.edu>
;;; Copyright © 2013, 2015 David Thompson <dthompson2@worcester.edu>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
@ -20,6 +20,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages sdl)
#:use-module (ice-9 match)
#:use-module (gnu packages)
#:use-module ((guix licenses) #:hide (freetype))
#:use-module (guix packages)
@ -173,8 +174,6 @@ other supporting functions for SDL.")
"--disable-tif-shared"
"--disable-webp-shared")))
(native-inputs `(("pkg-config" ,pkg-config)))
;; FIXME: Add webp
;;
;; libjpeg, libpng, and libtiff are propagated inputs because the
;; SDL_image headers include the headers of these libraries. SDL is a
;; propagated input because the pkg-config file refers to SDL's pkg-config
@ -182,7 +181,8 @@ other supporting functions for SDL.")
(propagated-inputs `(("sdl" ,sdl)
("libjpeg" ,libjpeg)
("libpng" ,libpng)
("libtiff" ,libtiff)))
("libtiff" ,libtiff)
("libwebp" ,libwebp)))
(synopsis "SDL image loading library")
(description "SDL_image is an image file loading library for SDL that
supports the following formats: BMP, GIF, JPEG, LBM, PCX, PNG, PNM, TGA, TIFF,
@ -299,6 +299,59 @@ directory.")
(home-page (package-home-page sdl))
(license (package-license sdl))))
(define (propagated-inputs-with-sdl2 package)
"Replace the \"sdl\" propagated input of PACKAGE with SDL2."
(map (match-lambda
(("sdl" _)
`("sdl2" ,sdl2))
(other other))
(package-propagated-inputs package)))
(define-public sdl2-image
(package (inherit sdl-image)
(name "sdl2-image")
(version "2.0.0")
(source (origin
(method url-fetch)
(uri
(string-append "http://www.libsdl.org/projects/SDL_image/release/SDL2_image-"
version ".tar.gz"))
(sha256
(base32
"0d3jlhkmr0j5a2dd5h6y29jfcsj7mkl16wghm6n3nqqp7g3ib65j"))))
(propagated-inputs
(propagated-inputs-with-sdl2 sdl-image))))
(define-public sdl2-mixer
(package (inherit sdl-mixer)
(name "sdl2-mixer")
(version "2.0.0")
(source (origin
(method url-fetch)
(uri
(string-append "http://www.libsdl.org/projects/SDL_mixer/release/SDL2_mixer-"
version ".tar.gz"))
(sha256
(base32
"0nvjdxjchrajrn0jag877hdx9zb788hsd315zzg1lyck2wb0xkm8"))))
(propagated-inputs
(propagated-inputs-with-sdl2 sdl-mixer))))
(define-public sdl2-ttf
(package (inherit sdl-ttf)
(name "sdl2-ttf")
(version "2.0.12")
(source (origin
(method url-fetch)
(uri
(string-append "http://www.libsdl.org/projects/SDL_ttf/release/SDL2_ttf-"
version ".tar.gz"))
(sha256
(base32
"0vkg6lyj278mdpd52map3rfi65fbq16w67ahmmfcl77a8da60a47"))))
(propagated-inputs
(propagated-inputs-with-sdl2 sdl-ttf))))
(define-public guile-sdl
(package
(name "guile-sdl")

4
gnu/packages/ssh.scm
View File

@ -186,7 +186,7 @@ Additionally, various channel-specific options can be negotiated.")
(define-public guile-ssh
(package
(name "guile-ssh")
(version "0.8.0")
(version "0.9.0")
(source (origin
;; ftp://memory-heap.org/software/guile-ssh/guile-ssh-VERSION.tar.gz
;; exists, but the server appears to be too slow and unreliable.
@ -197,7 +197,7 @@ Additionally, various channel-specific options can be negotiated.")
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"1ld2khzylaylhqfsfcvbxs95frvm8pkr7dq40ia1wwn9c349fcdv"))))
"04zs1cykwdyj51ag62ymrkgsja9dbhbaaglkvbfbac0bkxl2ir6d"))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-cons-after

155
gnu/packages/statistics.scm
View File

@ -29,6 +29,7 @@
#:use-module (gnu packages compression)
#:use-module (gnu packages gcc)
#:use-module (gnu packages gtk)
#:use-module (gnu packages haskell)
#:use-module (gnu packages icu4c)
#:use-module (gnu packages image)
#:use-module (gnu packages java)
@ -1342,3 +1343,157 @@ visualization system inspired by Trellis graphics, with an emphasis on
multivariate data. Lattice is sufficient for typical graphics needs, and is
also flexible enough to handle most nonstandard requirements.")
(license license:gpl2+)))
(define-public r-rcpparmadillo
(package
(name "r-rcpparmadillo")
(version "0.6.200.2.0")
(source (origin
(method url-fetch)
(uri (cran-uri "RcppArmadillo" version))
(sha256
(base32
"137wqqga776yj6synx5awhrzgkz7mmqnvgmggh9l4k6d99vwp9gj"))
(modules '((guix build utils)))
;; Remove bundled armadillo sources
(snippet
'(begin
(delete-file-recursively "inst/include/armadillo_bits")
(delete-file "inst/include/armadillo")))))
(properties `((upstream-name . "RcppArmadillo")))
(build-system r-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'link-against-armadillo
(lambda _
(substitute* "src/Makevars"
(("PKG_LIBS=" prefix)
(string-append prefix "-larmadillo"))))))))
(propagated-inputs
`(("r-rcpp" ,r-rcpp)
("armadillo" ,armadillo-for-rcpparmadillo)))
(home-page "https://github.com/RcppCore/RcppArmadillo")
(synopsis "Rcpp integration for the Armadillo linear algebra library")
(description
"Armadillo is a templated C++ linear algebra library that aims towards a
good balance between speed and ease of use. Integer, floating point and
complex numbers are supported, as well as a subset of trigonometric and
statistics functions. Various matrix decompositions are provided through
optional integration with LAPACK and ATLAS libraries. This package includes
the header files from the templated Armadillo library.")
;; Armadillo is licensed under the MPL 2.0, while RcppArmadillo (the Rcpp
;; bindings to Armadillo) is licensed under the GNU GPL version 2 or
;; later, as is the rest of 'Rcpp'.
(license license:gpl2+)))
(define-public r-bitops
(package
(name "r-bitops")
(version "1.0-6")
(source (origin
(method url-fetch)
(uri (cran-uri "bitops" version))
(sha256
(base32
"176nr5wpnkavn5z0yy9f7d47l37ndnn2w3gv854xav8nnybi6wwv"))))
(build-system r-build-system)
(home-page "http://cran.r-project.org/web/packages/bitops")
(synopsis "Bitwise operations")
(description
"This package provides functions for bitwise operations on integer
vectors.")
(license license:gpl2+)))
(define-public r-catools
(package
(name "r-catools")
(version "1.17.1")
(source (origin
(method url-fetch)
(uri (cran-uri "caTools" version))
(sha256
(base32
"1x4szsn2qmbzpyjfdaiz2q7jwhap2gky9wq0riah74q0pzz76ank"))))
(properties `((upstream-name . "caTools")))
(build-system r-build-system)
(propagated-inputs
`(("r-bitops" ,r-bitops)))
(home-page "http://cran.r-project.org/web/packages/caTools")
(synopsis "Various tools including functions for moving window statistics")
(description
"This package contains several basic utility functions including:
moving (rolling, running) window statistic functions, read/write for GIF and
ENVI binary files, fast calculation of AUC, LogitBoost classifier, base64
encoder/decoder, round-off-error-free sum and cumsum, etc.")
(license license:gpl3+)))
(define-public r-rmarkdown
(package
(name "r-rmarkdown")
(version "0.8.1")
(source
(origin
(method url-fetch)
(uri (cran-uri "rmarkdown" version))
(sha256
(base32
"07q5g9dvac5j3vnf4sjc60mnkij1k6y7vnzjz6anf499rwdwbxza"))))
(properties `((upstream-name . "rmarkdown")))
(build-system r-build-system)
(propagated-inputs
`(("r-catools" ,r-catools)
("r-htmltools" ,r-htmltools)
("r-knitr" ,r-knitr)
("r-yaml" ,r-yaml)
("ghc-pandoc" ,ghc-pandoc)))
(home-page "http://rmarkdown.rstudio.com")
(synopsis "Convert R Markdown documents into a variety of formats")
(description
"This package provides tools to convert R Markdown documents into a
variety of formats.")
(license license:gpl3+)))
(define-public r-gtable
(package
(name "r-gtable")
(version "0.1.2")
(source (origin
(method url-fetch)
(uri (cran-uri "gtable" version))
(sha256
(base32
"0k9hfj6r5y238gqh92s3cbdn34biczx3zfh79ix5xq0c5vkai2xh"))))
(properties `((upstream-name . "gtable")))
(build-system r-build-system)
(home-page "http://cran.r-project.org/web/packages/gtable")
(synopsis "Arrange grobs in tables")
(description
"This package provides tools to make it easier to work with tables of
grobs.")
(license license:gpl2+)))
(define-public r-gridextra
(package
(name "r-gridextra")
(version "2.0.0")
(source (origin
(method url-fetch)
(uri (cran-uri "gridExtra" version))
(sha256
(base32
"19yyrfd37c5hxlavb9lca9l26wjhc80rlqhgmfj9k3xhbvvpdp17"))))
(properties `((upstream-name . "gridExtra")))
(build-system r-build-system)
(propagated-inputs
`(("r-gtable" ,r-gtable)))
(native-inputs
`(("r-knitr" ,r-knitr))) ;for building vignettes
(home-page "https://github.com/baptiste/gridextra")
(synopsis "Miscellaneous functions for \"Grid\" graphics")
(description
"This package provides a number of user-level functions to work with
@code{grid} graphics, notably to arrange multiple grid-based plots on a page,
and draw tables.")
(license license:gpl2+)))

10
gnu/packages/telephony.scm
View File

@ -24,6 +24,7 @@
#:use-module (gnu packages gnupg)
#:use-module (gnu packages linux)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages tls)
#:use-module (guix licenses)
#:use-module (guix packages)
#:use-module (guix download)
@ -60,14 +61,15 @@ reimplementation.")
(define-public ucommon
(package
(name "ucommon")
(version "6.6.2")
(version "7.0.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/commoncpp/" name "-"
version ".tar.gz"))
(sha256 (base32
"16haqzq97axiyhgpca95rhr5y5s7fl8b65if5vil7v4lcqxp3hqn"))))
"1mv080rvrhyxyhgqiqr8r9jdqhg3xhfawjvfj5zgj47h59nggjba"))))
(build-system gnu-build-system)
(inputs `(("gnutls" ,gnutls)))
(synopsis "Common C++ framework for threaded applications")
(description "GNU uCommon C++ is meant as a very light-weight C++ library
to facilitate using C++ design patterns even for very deeply embedded
@ -146,13 +148,13 @@ multiplayer games.")
(define-public sipwitch
(package
(name "sipwitch")
(version "1.9.14")
(version "1.9.15")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/sipwitch/sipwitch-"
version ".tar.gz"))
(sha256 (base32
"1mrzl5nakiz613v3ch27k5dj2ykm88dlcr22lqny6dnjyfa9n2ki"))))
"10lli9c703d7qbarzc0lgmz963ppncvnrklwrnri0s1zcmmahyia"))))
(build-system gnu-build-system)
;; The configure.ac uses pkg-config but in a kludgy way which breaks when
;; cross-compiling. Among other issues there the program name "pkg-config"

4
gnu/packages/terminals.scm
View File

@ -33,14 +33,14 @@
(define-public tilda
(package
(name "tilda")
(version "1.3.0")
(version "1.3.1")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/lanoxx/tilda/archive/"
"tilda-" version ".tar.gz"))
(sha256
(base32
"1bbn2fflngx0g18ssvnzgzprvn1w6wc2y03sqzjwvxds488lhndx"))))
"1nh0kw8f6srriglj55gmir1hvakcwrak1wcydz3vpnmwipgy6jib"))))
(build-system gnu-build-system)
(arguments
`(#:phases (modify-phases %standard-phases

7
gnu/packages/texlive.scm
View File

@ -191,7 +191,8 @@ This package contains the binaries.")
(alist-cons-after
'patch-source-shebangs 'texmf-config
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((share (string-append (assoc-ref outputs "out") "/share"))
(let* ((out (assoc-ref outputs "out"))
(share (string-append out "/share"))
(texmfroot (string-append share "/texmf-dist/web2c"))
(texmfcnf (string-append texmfroot "/texmf.cnf"))
(texlive-bin (assoc-ref inputs "texlive-bin"))
@ -201,6 +202,10 @@ This package contains the binaries.")
(substitute* texmfcnf
(("TEXMFROOT = \\$SELFAUTOPARENT")
(string-append "TEXMFROOT = " share)))
;; Register paths in texmfcnf.lua, needed for context.
(substitute* (string-append texmfroot "/texmfcnf.lua")
(("selfautodir:") out)
(("selfautoparent:") (string-append share "/")))
;; Set path to TeXLive Perl modules
(setenv "PERL5LIB"
(string-append (getenv "PERL5LIB") ":" tlpkg))

14
gnu/packages/tls.scm
View File

@ -351,14 +351,13 @@ security, and applying best practice development processes.")
(define-public acme
(package
(name "acme")
(version "0.1.0")
(version "0.1.1")
(source (origin
(method url-fetch)
(uri (string-append "https://pypi.python.org/packages/source/a/acme/acme-"
version ".tar.gz"))
(uri (pypi-uri "acme" version))
(sha256
(base32
"0fj0m04zzdxx23vazl00ilqyl3jxqq9c9p4x61pfz1zps7nbzsy3"))))
"1yv0gy8akaqp5p2wjpfj8r5i0da04a9qdmlh06rczdkrmk6q680w"))))
(build-system python-build-system)
(arguments
`(#:python ,python-2))
@ -384,14 +383,13 @@ security, and applying best practice development processes.")
(define-public letsencrypt
(package
(name "letsencrypt")
(version "0.1.0")
(version "0.1.1")
(source (origin
(method url-fetch)
(uri (string-append "https://pypi.python.org/packages/source/l/"
"letsencrypt/letsencrypt-" version ".tar.gz"))
(uri (pypi-uri "letsencrypt" version))
(sha256
(base32
"1zb96xz32k6ai41h5m1l22qi47y71dq69dcmbz7vfm6jfrhjgxl1"))))
"1kia3wk66lxyi2fghp9sd7cqgr5qiwdfayz153hi4wpa3q1q8rwf"))))
(build-system python-build-system)
(arguments
`(#:python ,python-2))

4
gnu/packages/tmux.scm
View File

@ -28,7 +28,7 @@
(define-public tmux
(package
(name "tmux")
(version "2.0")
(version "2.1")
(source (origin
(method url-fetch)
(uri (string-append
@ -36,7 +36,7 @@
version "/tmux-" version ".tar.gz"))
(sha256
(base32
"0qnkda8kb747vmbldjpb23ksv9pq3s65xhh1ja5rdsmh8r24npvr"))))
"0xk1mylsb08sf0w597mdgj9s6hxxjvjvjd6bngpjvvxwyixlwmii"))))
(build-system gnu-build-system)
(inputs
`(("libevent" ,libevent)

49
gnu/packages/version-control.scm
View File

@ -8,6 +8,7 @@
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2015 Kyle Meyer <kyle@kyleam.com>
;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
@ -32,6 +33,7 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix build-system cmake)
#:use-module (guix build-system gnu)
#:use-module (guix build-system python)
#:use-module (guix build-system trivial)
@ -311,6 +313,49 @@ everything from small to very large projects with speed and efficiency.")
This is the documentation displayed when using the '--help' option of a 'git'
command.")))
(define-public libgit2
(package
(name "libgit2")
(version "0.23.3")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/libgit2/libgit2/"
"archive/v" version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1bhyzw9b7xr1vj24hgbwbfjw2wiaigiklccsdvd8r4kmcr180p1d"))))
(build-system cmake-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'fix-hardcoded-paths
(lambda _
(substitute* "tests/repo/init.c"
(("#!/bin/sh") (string-append "#!" (which "sh"))))
(substitute* "tests/clar/fs.h"
(("/bin/cp") (which "cp"))
(("/bin/rm") (which "rm")))
#t))
;; Run checks more verbosely.
(replace 'check
(lambda _ (zero? (system* "./libgit2_clar" "-v" "-Q")))))))
(inputs
`(("libssh2" ,libssh2)
("libcurl" ,curl)
("python" ,python)
("openssl" ,openssl)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(home-page "http://libgit2.github.com/")
(synopsis "Library providing Git core methods")
(description
"Libgit2 is a portable, pure C implementation of the Git core methods
provided as a re-entrant linkable library with a solid API, allowing you to
write native speed custom Git applications in any language with bindings.")
;; GPLv2 with linking exception
(license gpl2)))
(define-public shflags
(package
(name "shflags")
@ -570,14 +615,14 @@ property manipulation.")
(define-public subversion
(package
(name "subversion")
(version "1.8.14")
(version "1.8.15")
(source (origin
(method url-fetch)
(uri (string-append "http://archive.apache.org/dist/subversion/"
"subversion-" version ".tar.bz2"))
(sha256
(base32
"07ws4bspdgi4r5hbxvk86a15c669iqz6wkfrdph78hddzk6q6f3z"))))
"0b68rjy1sjd66nqcswrm1bhda3vk2ngkgs6drcanmzbcd3vs366g"))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-cons-after

81
gnu/packages/video.scm
View File

@ -6,6 +6,7 @@
;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2015 Andy Patterson <ajpatter@uwaterloo.ca>
;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015 Alex Vong <alexvong1995@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -41,6 +42,7 @@
#:use-module (gnu packages base)
#:use-module (gnu packages cdrom)
#:use-module (gnu packages compression)
#:use-module (gnu packages curl)
#:use-module (gnu packages databases)
#:use-module (gnu packages doxygen)
#:use-module (gnu packages elf)
@ -373,14 +375,14 @@ standards (MPEG-2, MPEG-4 ASP/H.263, MPEG-4 AVC/H.264, and VC-1/VMW3).")
(define-public ffmpeg
(package
(name "ffmpeg")
(version "2.8.3")
(version "2.8.4")
(source (origin
(method url-fetch)
(uri (string-append "https://ffmpeg.org/releases/ffmpeg-"
version ".tar.xz"))
(sha256
(base32
"0jkhyv68aa7h3hf905ganwqbrflams3hs74in7ygxdfkcqw2xqhq"))))
"07wmvp05zanmg3rm539dd0j7h1fi2fk0mcvmv01hjbpy92kq0qwb"))))
(build-system gnu-build-system)
(inputs
`(("fontconfig" ,fontconfig)
@ -691,7 +693,7 @@ SVCD, DVD, 3ivx, DivX 3/4/5, WMV and H.264 movies.")
(define-public mpv
(package
(name "mpv")
(version "0.13.0")
(version "0.14.0")
(source (origin
(method url-fetch)
(uri (string-append
@ -699,7 +701,7 @@ SVCD, DVD, 3ivx, DivX 3/4/5, WMV and H.264 movies.")
".tar.gz"))
(sha256
(base32
"1nqjd64p4pj1lks9n9s8y4zf4dp5bz8pyd0gsvviww7mv17p0whk"))
"0cqjwl0xyg0sv1jflipfkvqjg32y0kqfh4gc3lyhqgv0hgs3fa84"))
(file-name (string-append name "-" version ".tar.gz"))))
(build-system waf-build-system)
(native-inputs
@ -753,14 +755,7 @@ SVCD, DVD, 3ivx, DivX 3/4/5, WMV and H.264 movies.")
'configure 'setup-waf
(lambda* (#:key inputs #:allow-other-keys)
(copy-file (assoc-ref inputs "waf") "waf")
(setenv "CC" "gcc")))
(add-before
'configure 'patch-wscript
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "wscript"
;; XXX Remove this when our Samba package provides a .pc file.
(("check_pkg_config\\('smbclient'\\)")
"check_cc(lib='smbclient')")))))
(setenv "CC" "gcc"))))
;; No check function defined.
#:tests? #f))
(home-page "http://mpv.io/")
@ -810,7 +805,7 @@ projects while introducing many more.")
(define-public youtube-dl
(package
(name "youtube-dl")
(version "2015.12.09")
(version "2015.12.29")
(source (origin
(method url-fetch)
(uri (string-append "http://youtube-dl.org/downloads/"
@ -818,10 +813,31 @@ projects while introducing many more.")
version ".tar.gz"))
(sha256
(base32
"11rzb30ik4all43r7bnsnm35mvs37y7xj3g9r7ig9jr7qlbhllwk"))))
"0232wiq8mjs5ngmlcvf0292icrhvzr9mkwy2km0g0djznsf7rxjg"))))
(build-system python-build-system)
(native-inputs `(("python-setuptools" ,python-setuptools)))
(home-page "http://youtube-dl.org")
(arguments
;; The problem here is that the directory for the man page and completion
;; files is relative, and for some reason, setup.py uses the
;; auto-detected sys.prefix instead of the user-defined "--prefix=FOO".
;; So, we need pass the prefix directly. In addition, make sure the Bash
;; completion file is called 'youtube-dl' rather than
;; 'youtube-dl.bash-completion'.
`(#:phases (modify-phases %standard-phases
(add-before 'install 'fix-the-data-directories
(lambda* (#:key outputs #:allow-other-keys)
(let ((prefix (assoc-ref outputs "out")))
(mkdir "bash-completion")
(rename-file "youtube-dl.bash-completion"
"bash-completion/youtube-dl")
(substitute* "setup.py"
(("youtube-dl\\.bash-completion")
"bash-completion/youtube-dl")
(("'etc/")
(string-append "'" prefix "/etc/"))
(("'share/")
(string-append "'" prefix "/share/")))))))))
(synopsis "Download videos from YouTube.com and other sites")
(description
"Youtube-dl is a small command-line program to download videos from
@ -1248,3 +1264,40 @@ players, transcoders, web streamers and many more types of applications. The
functionality of the system is provided via an assortment of ready to use
tools, XML authoring components, and an extensible plug-in based API.")
(license license:lgpl2.1+)))
(define-public obs
(package
(name "obs")
(version "0.12.4")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/jp9000/obs-studio"
"/archive/" version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0b1xb5vd3g4h7m1hsjzsq3bbbnqb2n6mpmq6ix4yyy72g087rjk1"))))
(build-system cmake-build-system)
(arguments '(#:tests? #f)) ; no tests
(native-inputs
`(("pkg-config" ,pkg-config)))
(inputs
`(("curl" ,curl)
("eudev" ,eudev)
("ffmpeg" ,ffmpeg)
("freetype" ,freetype)
("jack" ,jack-1)
("jansson" ,jansson)
("libx264" ,libx264)
("libxcomposite" ,libxcomposite)
("mesa" ,mesa)
("pulseaudio" ,pulseaudio)
("qt" ,qt)
("zlib" ,zlib)))
(synopsis "Live streaming software")
(description "Open Broadcaster Software provides a graphical interface for
video recording and live streaming. OBS supports capturing audio and video
from many input sources such as webcams, X11 (for screencasting), PulseAudio,
and JACK.")
(home-page "https://obsproject.com")
(license license:gpl2+)))

63
gnu/packages/web.scm
View File

@ -30,6 +30,7 @@
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix cvs-download)
#:use-module (guix utils)
#:use-module (guix build-system gnu)
#:use-module (guix build-system perl)
#:use-module (guix build-system cmake)
@ -435,11 +436,12 @@ used to validate and fix HTML data.")
(source (origin
(method url-fetch)
(uri (string-append
"http://www.samba.org/~obnox/" name "/download/"
name "-" version ".tar.bz2"))
"https://download.banu.com/tinyproxy/"
(version-major+minor version)
"/tinyproxy-" version ".tar.gz"))
(sha256
(base32
"0vl9igw7vm924rs6d6bkib7zfclxnlf9s8rmml1sfwj7xda9nmdy"))))
"05y0y2q9j10x72y1fipya6bmc8hjcdf3kfw7dh8ahczpy341c938"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags
@ -1894,6 +1896,30 @@ are invoked.")
kinds of HTML parsing operations.")
(home-page "http://search.cpan.org/dist/HTML-Tagset/")))
(define-public perl-html-template
(package
(name "perl-html-template")
(version "2.95")
(source (origin
(method url-fetch)
(uri (string-append "mirror://cpan/authors/id/W/WO/WONKO/"
"HTML-Template-" version ".tar.gz"))
(sha256
(base32
"07ahpfgidxsw2yb7y8i7bbr8s64aq6qgq832h9jswmksxbd0l43q"))))
(build-system perl-build-system)
(home-page "http://search.cpan.org/dist/HTML-Template")
(synopsis "HTML-like templates")
(description
"This module attempts to make using HTML templates simple and natural.
It extends standard HTML with a few new HTML-esque tags: @code{<TMPL_VAR>},
@code{<TMPL_LOOP>}, @code{<TMPL_INCLUDE>}, @code{<TMPL_IF>},
@code{<TMPL_ELSE>} and @code{<TMPL_UNLESS>}. The file written with HTML and
these new tags is called a template. Using this module you fill in the values
for the variables, loops and branches declared in the template. This allows
you to separate design from the data.")
(license (package-license perl))))
(define-public perl-http-body
(package
(name "perl-http-body")
@ -3003,3 +3029,34 @@ the package implements a framework for performing fully customized requests
where data can be processed either in memory, on disk, or streaming via the
callback or connection interfaces.")
(license l:expat)))
(define-public gumbo-parser
(package
(name "gumbo-parser")
(version "0.10.1")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/google/"
"gumbo-parser/archive/v" version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1bgg2kbj311pqdzw2v33za7k66g1rv44kkvvnz2gnpaasi9k0ii8"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; tests require bundling googletest sources
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'bootstrap
(lambda _ (zero? (system* "sh" "autogen.sh")))))))
;; The release tarball lacks the generated files.
(native-inputs
`(("autoconf" ,autoconf)
("automake" ,automake)
("libtool" ,libtool)))
(home-page "https://github.com/google/gumbo-parser")
(synopsis "HTML5 parsing library")
(description
"Gumbo is an implementation of the HTML5 parsing algorithm implemented as
a pure C99 library.")
(license l:asl2.0)))

85
gnu/packages/xdisorg.scm
View File

@ -8,6 +8,7 @@
;;; Copyright © 2015 Alexander I.Grafov <grafov@gmail.com>
;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
;;; Copyright © 2015 xd1le <elisp.vim@gmail.com>
;;; Copyright © 2015 Florian Paul Schmidt <mista.tapas@gmx.net>
;;;
;;; This file is part of GNU Guix.
;;;
@ -40,6 +41,7 @@
#:use-module (gnu packages gettext)
#:use-module (gnu packages glib)
#:use-module (gnu packages gnome) ;for libgudev
#:use-module (gnu packages ncurses)
#:use-module (gnu packages perl)
#:use-module (gnu packages python)
#:use-module (gnu packages linux)
@ -288,7 +290,7 @@ System style license, and has no special dependencies.")
(source (origin
(method url-fetch)
(uri (string-append
"http://tomas.styblo.name/wmctrl/dist/wmctrl-"
"https://sites.google.com/site/tstyblo/wmctrl/wmctrl-"
version ".tar.gz"))
(sha256
(base32
@ -406,14 +408,19 @@ things less distracting.")
(define-public xlockmore
(package
(name "xlockmore")
(version "5.45")
(version "5.46")
(source (origin
(method url-fetch)
(uri (string-append "http://www.tux.org/~bagleyd/xlock/xlockmore-"
version "/xlockmore-" version ".tar.bz2"))
(uri (list (string-append
"http://www.tux.org/~bagleyd/xlock/xlockmore-"
version ".tar.xz")
(string-append
"http://www.tux.org/~bagleyd/xlock/xlockmore-old"
"/xlockmore-" version
"/xlockmore-" version ".tar.bz2")))
(sha256
(base32
"1xqm61bbfn5q056w57vp16gvai8nqpcw570ysxlm5h46nh6ai0bz"))))
"1ps0dmnh912x8mwns94y2607xk90rjxrjn5s1pkmmpjg5h9bxcrj"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags (list (string-append "--enable-appdefaultdir="
@ -529,24 +536,34 @@ compact configuration syntax.")
(package
(name "rxvt-unicode")
(version "9.21")
(source
(origin
(method url-fetch)
(uri (string-append
"http://dist.schmorp.de/rxvt-unicode/"
name "-"
version
".tar.bz2"))
(sha256
(base32
"0swmi308v5yxsddrdhvi4cch88k2bbs2nffpl5j5m2f55gbhw9vm"))))
(source (origin
(method url-fetch)
(uri (string-append "http://dist.schmorp.de/rxvt-unicode/"
name "-" version ".tar.bz2"))
(sha256
(base32
"0swmi308v5yxsddrdhvi4cch88k2bbs2nffpl5j5m2f55gbhw9vm"))))
(build-system gnu-build-system)
(arguments
;; This sets the destination when installing the necessary terminal
;; capability data, which are not provided by 'ncurses'. See
;; https://lists.gnu.org/archive/html/bug-ncurses/2009-10/msg00031.html
'(#:make-flags (list (string-append "TERMINFO="
(assoc-ref %outputs "out")
"/share/terminfo"))))
(inputs
`(("libXft" ,libxft)
("libX11" ,libx11)))
(native-inputs
`(("perl" ,perl)
`(("ncurses" ,ncurses) ;trigger the installation of terminfo data
("perl" ,perl)
("pkg-config" ,pkg-config)))
;; FIXME: This should only be located in 'ncurses'. Nonetheless it is
;; provided for usability reasons. See <https://bugs.gnu.org/22138>.
(native-search-paths
(list (search-path-specification
(variable "TERMINFO_DIRS")
(files '("share/terminfo")))))
(home-page "http://software.schmorp.de/pkg/rxvt-unicode.html")
(synopsis "Rxvt clone with XFT and unicode support")
(description "Rxvt-unicode (urxvt) is a colour vt102 terminal emulator
@ -655,3 +672,37 @@ use it as well.")
"The xf86-input-wacom driver is the wacom-specific X11 input driver for
the X.Org X Server version 1.7 and later (X11R7.5 or later).")
(license license:x11)))
(define-public redshift
(package
(name "redshift")
(version "1.10")
(source
(origin
(method url-fetch)
(uri
(string-append "https://github.com/jonls/redshift/"
"releases/download/v" version
"/redshift-" version ".tar.xz"))
(sha256
(base32
"19pfk9il5x2g2ivqix4a555psz8mj3m0cvjwnjpjvx0llh5fghjv"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)
("intltool" ,intltool)))
(inputs
`(("libdrm" ,libdrm)
("libx11" ,libx11)
("libxcb" ,libxcb)
("libxxf86vm", libxxf86vm)
("glib" ,glib))) ;for Geoclue2 support
(home-page "https://github.com/jonls/redshift")
(synopsis "Adjust the color temperature of your screen")
(description
"Redshift adjusts the color temperature according to the position of the
sun. A different color temperature is set during night and daytime. During
twilight and early morning, the color temperature transitions smoothly from
night to daytime temperature to allow your eyes to slowly adapt. At night the
color temperature should be set to match the lamps in your room.")
(license license:gpl3+)))

2
gnu/packages/xiph.scm
View File

@ -320,7 +320,7 @@ incorporated technology from Skype's SILK codec and Xiph.Org's CELT codec.")
(source (origin
(method url-fetch)
(uri (string-append
"ftp://ftp.mozilla.org/pub/mozilla.org/opus/opus-tools-"
"http://downloads.xiph.org/releases/opus/opus-tools-"
version ".tar.gz"))
(sha256
(base32

147
gnu/packages/xml.scm
View File

@ -223,6 +223,28 @@ module allows Perl programmers to make use of the highly capable validating
XML parser and the high performance DOM implementation.")
(license (package-license perl))))
(define-public perl-xml-libxml-simple
(package
(name "perl-xml-libxml-simple")
(version "0.95")
(source (origin
(method url-fetch)
(uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/"
"XML-LibXML-Simple-" version ".tar.gz"))
(sha256
(base32
"0qqfqj5bgqmh1j4iv8dwl3g00nsmcvf2b7w1d09k9d77rrb249xi"))))
(build-system perl-build-system)
(propagated-inputs
`(("perl-file-slurp-tiny" ,perl-file-slurp-tiny)
("perl-xml-libxml" ,perl-xml-libxml)))
(home-page "http://search.cpan.org/dist/XML-LibXML-Simple")
(synopsis "XML::LibXML based XML::Simple clone")
(description
"This package provides the same API as @code{XML::Simple} but is based on
@code{XML::LibXML}.")
(license (package-license perl))))
(define-public perl-xml-namespacesupport
(package
(name "perl-xml-namespacesupport")
@ -374,6 +396,131 @@ from XML::Parser. It parses XML strings or files and builds a data structure
that conforms to the API of the Document Object Model.")
(home-page "http://search.cpan.org/~tjmather/XML-DOM-1.44/lib/XML/DOM.pm")))
(define-public perl-xml-compile-tester
(package
(name "perl-xml-compile-tester")
(version "0.90")
(source (origin
(method url-fetch)
(uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/"
"XML-Compile-Tester-" version ".tar.gz"))
(sha256
(base32
"1bcl8x8cyacqv9yjp97aq9qq85sy8wv78kd8c16yd9yw3by4cpp1"))))
(build-system perl-build-system)
(propagated-inputs
`(("perl-log-report" ,perl-log-report)
("perl-test-deep" ,perl-test-deep)))
(home-page "http://search.cpan.org/dist/XML-Compile-Tester")
(synopsis "XML::Compile related regression testing")
(description
"The @code{XML::Compile} module suite has extensive regression testing.
This module provide functions which simplify writing tests for
@code{XML::Compile} related distributions.")
(license (package-license perl))))
(define-public perl-xml-compile
(package
(name "perl-xml-compile")
(version "1.51")
(source (origin
(method url-fetch)
(uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/"
"XML-Compile-" version ".tar.gz"))
(sha256
(base32
"06fj4zf0yh4kf3kx4bhwrmrjr6al40nasasbgfhn8f1zxwkmm8f2"))))
(build-system perl-build-system)
(propagated-inputs
`(("perl-log-report" ,perl-log-report)
("perl-xml-compile-tester" ,perl-xml-compile-tester)
("perl-xml-libxml" ,perl-xml-libxml)
("perl-test-deep" ,perl-test-deep)))
(home-page "http://search.cpan.org/dist/XML-Compile")
(synopsis "Compilation-based XML processing")
(description
"@code{XML::Compile} can be used to translate a Perl data-structure into
XML or XML into a Perl data-structure, both directions under rigid control by
a schema.")
(license (package-license perl))))
(define-public perl-xml-compile-cache
(package
(name "perl-xml-compile-cache")
(version "1.04")
(source (origin
(method url-fetch)
(uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/"
"XML-Compile-Cache-" version ".tar.gz"))
(sha256
(base32
"1689dm54n7wb0n0cl9n77vk0kvg0mcckn2hz9ahigjhvazah8740"))))
(build-system perl-build-system)
(propagated-inputs
`(("perl-log-report" ,perl-log-report)
("perl-xml-compile" ,perl-xml-compile)
("perl-xml-compile-tester" ,perl-xml-compile-tester)
("perl-xml-libxml-simple" ,perl-xml-libxml-simple)))
(home-page "http://search.cpan.org/dist/XML-Compile-Cache")
(synopsis "Cache compiled XML translators")
(description
"This package provides methods to cache compiled XML translators.")
(license (package-license perl))))
(define-public perl-xml-compile-soap
(package
(name "perl-xml-compile-soap")
(version "3.13")
(source (origin
(method url-fetch)
(uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/"
"XML-Compile-SOAP-" version ".tar.gz"))
(sha256
(base32
"08qw63l78040nh37xzapbqp43g6s5l67bvskf3dyyizlarjx5mi4"))))
(build-system perl-build-system)
(propagated-inputs
`(("perl-file-slurp-tiny" ,perl-file-slurp-tiny)
("perl-libwww" ,perl-libwww)
("perl-log-report" ,perl-log-report)
("perl-xml-compile" ,perl-xml-compile)
("perl-xml-compile-cache" ,perl-xml-compile-cache)
("perl-xml-compile-tester" ,perl-xml-compile-tester)))
(home-page "http://search.cpan.org/dist/XML-Compile-SOAP")
(synopsis "Base-class for SOAP implementations")
(description
"This module provides a class to handle the SOAP protocol. The first
implementation is @url{SOAP1.1,
http://www.w3.org/TR/2000/NOTE-SOAP-20000508/}, which is still most often
used.")
(license (package-license perl))))
(define-public perl-xml-compile-wsdl11
(package
(name "perl-xml-compile-wsdl11")
(version "3.04")
(source (origin
(method url-fetch)
(uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/"
"XML-Compile-WSDL11-" version ".tar.gz"))
(sha256
(base32
"0pyikwnfwpangvnkf5dbdagy4z93ag9824f1ax5qaibc3ghca8kv"))))
(build-system perl-build-system)
(propagated-inputs
`(("perl-log-report" ,perl-log-report)
("perl-xml-compile" ,perl-xml-compile)
("perl-xml-compile-cache" ,perl-xml-compile-cache)
("perl-xml-compile-soap" ,perl-xml-compile-soap)))
(home-page "http://search.cpan.org/dist/XML-Compile-WSDL11")
(synopsis "Create SOAP messages defined by WSDL 1.1")
(description
"This module understands WSDL version 1.1. A WSDL file defines a set of
messages to be send and received over SOAP connections. This involves
encoding of the message to be send into XML, sending the message to the
server, collect the answer, and finally decoding the XML to Perl.")
(license (package-license perl))))
(define-public pugixml
(package
(name "pugixml")

8
gnu/packages/zsh.scm
View File

@ -32,8 +32,12 @@
(version "5.1.1")
(source (origin
(method url-fetch)
(uri (string-append "http://www.zsh.org/pub/zsh-" version
".tar.gz"))
(uri (list (string-append
"http://www.zsh.org/pub/zsh-" version
".tar.gz")
(string-append
"http://www.zsh.org/pub/old/zsh-" version
".tar.gz")))
(sha256
(base32
"11shllzhq53fg8ngy3bgbmpf09fn2czifg7hsb41nxi3410mpvcl"))))

178
gnu/services/base.scm
View File

@ -43,7 +43,8 @@
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:export (root-file-system-service
#:export (fstab-service-type
root-file-system-service
file-system-service
user-unmount-service
device-mapping-service
@ -105,6 +106,48 @@
;;; File systems.
;;;
(define (file-system->fstab-entry file-system)
"Return a @file{/etc/fstab} entry for @var{file-system}."
(string-append (case (file-system-title file-system)
((label)
(string-append "LABEL=" (file-system-device file-system)))
((uuid)
(string-append
"UUID="
(uuid->string (file-system-device file-system))))
(else
(file-system-device file-system)))
"\t"
(file-system-mount-point file-system) "\t"
(file-system-type file-system) "\t"
(or (file-system-options file-system) "defaults") "\t"
;; XXX: Omit the 'fs_freq' and 'fs_passno' fields because we
;; don't have anything sensible to put in there.
))
(define (file-systems->fstab file-systems)
"Return a @file{/etc} entry for an @file{fstab} describing
@var{file-systems}."
`(("fstab" ,(plain-file "fstab"
(string-append
"\
# This file was generated from your GuixSD configuration. Any changes
# will be lost upon reboot or reconfiguration.\n\n"
(string-join (map file-system->fstab-entry
file-systems)
"\n")
"\n")))))
(define fstab-service-type
;; The /etc/fstab service.
(service-type (name 'fstab)
(extensions
(list (service-extension etc-service-type
file-systems->fstab)))
(compose identity)
(extend append)))
(define %root-file-system-dmd-service
(dmd-service
(documentation "Take care of the root file system.")
@ -170,70 +213,79 @@ FILE-SYSTEM."
((? file-system? fs)
(file-system->dmd-service-name fs))))
(define (file-system-dmd-service file-system)
"Return a list containing the dmd service for @var{file-system}."
(let ((target (file-system-mount-point file-system))
(device (file-system-device file-system))
(type (file-system-type file-system))
(title (file-system-title file-system))
(check? (file-system-check? file-system))
(create? (file-system-create-mount-point? file-system))
(dependencies (file-system-dependencies file-system)))
(if (file-system-mount? file-system)
(list
(dmd-service
(provision (list (file-system->dmd-service-name file-system)))
(requirement `(root-file-system
,@(map dependency->dmd-service-name dependencies)))
(documentation "Check, mount, and unmount the given file system.")
(start #~(lambda args
;; FIXME: Use or factorize with 'mount-file-system'.
(let ((device (canonicalize-device-spec #$device '#$title))
(flags #$(mount-flags->bit-mask
(file-system-flags file-system))))
#$(if create?
#~(mkdir-p #$target)
#~#t)
#$(if check?
#~(begin
;; Make sure fsck.ext2 & co. can be found.
(setenv "PATH"
(string-append
#$e2fsprogs "/sbin:"
"/run/current-system/profile/sbin:"
(getenv "PATH")))
(check-file-system device #$type))
#~#t)
(mount device #$target #$type flags
#$(file-system-options file-system))
;; For read-only bind mounts, an extra remount is
;; needed, as per <http://lwn.net/Articles/281157/>,
;; which still applies to Linux 4.0.
(when (and (= MS_BIND (logand flags MS_BIND))
(= MS_RDONLY (logand flags MS_RDONLY)))
(mount device #$target #$type
(logior MS_BIND MS_REMOUNT MS_RDONLY))))
#t))
(stop #~(lambda args
;; Normally there are no processes left at this point, so
;; TARGET can be safely unmounted.
;; Make sure PID 1 doesn't keep TARGET busy.
(chdir "/")
(umount #$target)
#f))
;; We need an additional module.
(modules `(((gnu build file-systems)
#:select (check-file-system canonicalize-device-spec))
,@%default-modules))
(imported-modules `((gnu build file-systems)
,@%default-imported-modules))))
'())))
(define file-system-service-type
;; TODO(?): Make this an extensible service that takes <file-system> objects
;; and returns a list of <dmd-service>.
(dmd-service-type
'file-system
(lambda (file-system)
(let ((target (file-system-mount-point file-system))
(device (file-system-device file-system))
(type (file-system-type file-system))
(title (file-system-title file-system))
(check? (file-system-check? file-system))
(create? (file-system-create-mount-point? file-system))
(dependencies (file-system-dependencies file-system)))
(dmd-service
(provision (list (file-system->dmd-service-name file-system)))
(requirement `(root-file-system
,@(map dependency->dmd-service-name dependencies)))
(documentation "Check, mount, and unmount the given file system.")
(start #~(lambda args
;; FIXME: Use or factorize with 'mount-file-system'.
(let ((device (canonicalize-device-spec #$device '#$title))
(flags #$(mount-flags->bit-mask
(file-system-flags file-system))))
#$(if create?
#~(mkdir-p #$target)
#~#t)
#$(if check?
#~(begin
;; Make sure fsck.ext2 & co. can be found.
(setenv "PATH"
(string-append
#$e2fsprogs "/sbin:"
"/run/current-system/profile/sbin:"
(getenv "PATH")))
(check-file-system device #$type))
#~#t)
(mount device #$target #$type flags
#$(file-system-options file-system))
;; For read-only bind mounts, an extra remount is needed,
;; as per <http://lwn.net/Articles/281157/>, which still
;; applies to Linux 4.0.
(when (and (= MS_BIND (logand flags MS_BIND))
(= MS_RDONLY (logand flags MS_RDONLY)))
(mount device #$target #$type
(logior MS_BIND MS_REMOUNT MS_RDONLY))))
#t))
(stop #~(lambda args
;; Normally there are no processes left at this point, so
;; TARGET can be safely unmounted.
;; Make sure PID 1 doesn't keep TARGET busy.
(chdir "/")
(umount #$target)
#f))
;; We need an additional module.
(modules `(((gnu build file-systems)
#:select (check-file-system canonicalize-device-spec))
,@%default-modules))
(imported-modules `((gnu build file-systems)
,@%default-imported-modules)))))))
(service-type (name 'file-system)
(extensions
(list (service-extension dmd-root-service-type
file-system-dmd-service)
(service-extension fstab-service-type
identity)))))
(define* (file-system-service file-system)
"Return a service that mounts @var{file-system}, a @code{<file-system>}
@ -367,7 +419,7 @@ services corresponding to FILE-SYSTEMS.
All the services that spawn processes must depend on this one so that they are
stopped before 'kill' is called."
(service user-processes-service-type
(list file-systems grace-delay)))
(list (filter file-system-mount? file-systems) grace-delay)))
;;;

Some files were not shown because too many files have changed in this diff Show More