aboutsummaryrefslogtreecommitdiff
path: root/guix-package.in
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2013-02-14 04:15:25 -0500
committerMark H Weaver <mhw@netris.org>2013-02-16 22:17:37 -0500
commite49951eb3e1e1a8e7bad6d7471483e70b0865352 (patch)
tree7924fec33724f1de6a1cdd0757c7ebe38c7bee6b /guix-package.in
parent040860152e63bbafb2eb3e93619e18d107c96b55 (diff)
downloadguix-e49951eb3e1e1a8e7bad6d7471483e70b0865352.tar
guix-e49951eb3e1e1a8e7bad6d7471483e70b0865352.tar.gz
Replace individual scripts with master 'guix' script.
* scripts/guix.in: New script. * Makefile.am (bin_SCRIPTS): Add 'scripts/guix'. Remove 'guix-build', 'guix-download', 'guix-import', 'guix-package', and 'guix-gc'. (MODULES): Add 'guix/scripts/build.scm', 'guix/scripts/download.scm', 'guix/scripts/import.scm', 'guix/scripts/package.scm', and 'guix/scripts/gc.scm'. * configure.ac (AC_CONFIG_FILES): Add 'scripts/guix'. Remove 'guix-build', 'guix-download', 'guix-import', 'guix-package', and 'guix-gc'. * guix-build.in, guix-download.in, guix-gc.in, guix-import.in, guix-package.in: Remove shell script boilerplate. Move to guix-COMMAND.in to guix/scripts/COMMAND.scm. Rename module from (guix-COMMAND) to (guix scripts COMMAND). Change "guix-COMMAND" to "guix COMMAND" in usage help string. * pre-inst-env.in: Add "@abs_top_builddir@/scripts" to the front of $PATH. Export $GUIX_UNINSTALLED. * tests/guix-build.sh, tests/guix-daemon.sh, tests/guix-download.sh, tests/guix-gc.sh, tests/guix-package.sh: Use "guix COMMAND" instead of "guix-COMMAND". * doc/guix.texi: Replace all occurrences of "guix-COMMAND" with "guix COMMAND". * po/POTFILES.in: Update.
Diffstat (limited to 'guix-package.in')
-rw-r--r--guix-package.in706
1 files changed, 0 insertions, 706 deletions
diff --git a/guix-package.in b/guix-package.in
deleted file mode 100644
index 584481acd5..0000000000
--- a/guix-package.in
+++ /dev/null
@@ -1,706 +0,0 @@
-#!/bin/sh
-# aside from this initial boilerplate, this is actually -*- scheme -*- code
-
-prefix="@prefix@"
-datarootdir="@datarootdir@"
-
-GUILE_LOAD_COMPILED_PATH="@guilemoduledir@:$GUILE_LOAD_COMPILED_PATH"
-export GUILE_LOAD_COMPILED_PATH
-
-main='(module-ref (resolve-interface '\''(guix-package)) '\'guix-package')'
-exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \
- -c "(apply $main (cdr (command-line)))" "$@"
-!#
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
-;;; Copyright © 2013 Mark H Weaver <mhw@netris.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 (guix-package)
- #:use-module (guix ui)
- #:use-module (guix store)
- #:use-module (guix derivations)
- #:use-module (guix packages)
- #:use-module (guix utils)
- #:use-module (guix config)
- #:use-module ((guix build utils) #:select (directory-exists? mkdir-p))
- #:use-module (ice-9 ftw)
- #:use-module (ice-9 format)
- #:use-module (ice-9 match)
- #:use-module (ice-9 regex)
- #:use-module (ice-9 vlist)
- #:use-module (srfi srfi-1)
- #:use-module (srfi srfi-11)
- #:use-module (srfi srfi-26)
- #:use-module (srfi srfi-34)
- #:use-module (srfi srfi-37)
- #:use-module (gnu packages)
- #:use-module ((gnu packages base) #:select (guile-final))
- #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile))
- #:export (guix-package))
-
-(define %store
- (make-parameter #f))
-
-
-;;;
-;;; User environment.
-;;;
-
-(define %user-environment-directory
- (and=> (getenv "HOME")
- (cut string-append <> "/.guix-profile")))
-
-(define %profile-directory
- (string-append (or (getenv "NIX_STATE_DIR") %state-directory) "/profiles/"
- (or (and=> (getenv "USER")
- (cut string-append "per-user/" <>))
- "default")))
-
-(define %current-profile
- ;; Call it `guix-profile', not `profile', to allow Guix profiles to
- ;; coexist with Nix profiles.
- (string-append %profile-directory "/guix-profile"))
-
-(define (profile-manifest profile)
- "Return the PROFILE's manifest."
- (let ((manifest (string-append profile "/manifest")))
- (if (file-exists? manifest)
- (call-with-input-file manifest read)
- '(manifest (version 1) (packages ())))))
-
-(define (manifest-packages manifest)
- "Return the packages listed in MANIFEST."
- (match manifest
- (('manifest ('version 0)
- ('packages ((name version output path) ...)))
- (zip name version output path
- (make-list (length name) '())))
-
- ;; Version 1 adds a list of propagated inputs to the
- ;; name/version/output/path tuples.
- (('manifest ('version 1)
- ('packages (packages ...)))
- packages)
-
- (_
- (error "unsupported manifest format" manifest))))
-
-(define (profile-regexp profile)
- "Return a regular expression that matches PROFILE's name and number."
- (make-regexp (string-append "^" (regexp-quote (basename profile))
- "-([0-9]+)")))
-
-(define (profile-numbers profile)
- "Return the list of generation numbers of PROFILE, or '(0) if no
-former profiles were found."
- (define* (scandir name #:optional (select? (const #t))
- (entry<? (@ (ice-9 i18n) string-locale<?)))
- ;; XXX: Bug-fix version introduced in Guile v2.0.6-62-g139ce19.
- (define (enter? dir stat result)
- (and stat (string=? dir name)))
-
- (define (visit basename result)
- (if (select? basename)
- (cons basename result)
- result))
-
- (define (leaf name stat result)
- (and result
- (visit (basename name) result)))
-
- (define (down name stat result)
- (visit "." '()))
-
- (define (up name stat result)
- (visit ".." result))
-
- (define (skip name stat result)
- ;; All the sub-directories are skipped.
- (visit (basename name) result))
-
- (define (error name* stat errno result)
- (if (string=? name name*) ; top-level NAME is unreadable
- result
- (visit (basename name*) result)))
-
- (and=> (file-system-fold enter? leaf down up skip error #f name lstat)
- (lambda (files)
- (sort files entry<?))))
-
- (match (scandir (dirname profile)
- (cute regexp-exec (profile-regexp profile) <>))
- (#f ; no profile directory
- '(0))
- (() ; no profiles
- '(0))
- ((profiles ...) ; former profiles around
- (map (compose string->number
- (cut match:substring <> 1)
- (cute regexp-exec (profile-regexp profile) <>))
- profiles))))
-
-(define (previous-profile-number profile number)
- "Return the number of the generation before generation NUMBER of
-PROFILE, or 0 if none exists. It could be NUMBER - 1, but it's not the
-case when generations have been deleted (there are \"holes\")."
- (fold (lambda (candidate highest)
- (if (and (< candidate number) (> candidate highest))
- candidate
- highest))
- 0
- (profile-numbers profile)))
-
-(define (profile-derivation store packages)
- "Return a derivation that builds a profile (a user environment) with
-all of PACKAGES, a list of name/version/output/path/deps tuples."
- (define builder
- `(begin
- (use-modules (ice-9 pretty-print)
- (guix build union))
-
- (setvbuf (current-output-port) _IOLBF)
- (setvbuf (current-error-port) _IOLBF)
-
- (let ((output (assoc-ref %outputs "out"))
- (inputs (map cdr %build-inputs)))
- (format #t "building user environment `~a' with ~a packages...~%"
- output (length inputs))
- (union-build output inputs)
- (call-with-output-file (string-append output "/manifest")
- (lambda (p)
- (pretty-print '(manifest (version 1)
- (packages ,packages))
- p))))))
-
- (build-expression->derivation store "user-environment"
- (%current-system)
- builder
- (append-map (match-lambda
- ((name version output path deps)
- `((,name ,path)
- ,@deps)))
- packages)
- #:modules '((guix build union))))
-
-(define (profile-number profile)
- "Return PROFILE's number or 0. An absolute file name must be used."
- (or (and=> (false-if-exception (regexp-exec (profile-regexp profile)
- (basename (readlink profile))))
- (compose string->number (cut match:substring <> 1)))
- 0))
-
-(define (switch-symlinks link target)
- "Atomically switch LINK, a symbolic link, to point to TARGET. Works
-both when LINK already exists and when it does not."
- (let ((pivot (string-append link ".new")))
- (symlink target pivot)
- (rename-file pivot link)))
-
-(define (roll-back profile)
- "Roll back to the previous generation of PROFILE."
- (let* ((number (profile-number profile))
- (previous-number (previous-profile-number profile number))
- (previous-profile (format #f "~a-~a-link"
- profile previous-number))
- (manifest (string-append previous-profile "/manifest")))
-
- (define (switch-link)
- ;; Atomically switch PROFILE to the previous profile.
- (format #t (_ "switching from generation ~a to ~a~%")
- number previous-number)
- (switch-symlinks profile previous-profile))
-
- (cond ((not (file-exists? profile)) ; invalid profile
- (format (current-error-port)
- (_ "error: profile `~a' does not exist~%")
- profile))
- ((zero? number) ; empty profile
- (format (current-error-port)
- (_ "nothing to do: already at the empty profile~%")))
- ((or (zero? previous-number) ; going to emptiness
- (not (file-exists? previous-profile)))
- (let*-values (((drv-path drv)
- (profile-derivation (%store) '()))
- ((prof)
- (derivation-output-path
- (assoc-ref (derivation-outputs drv) "out"))))
- (when (not (build-derivations (%store) (list drv-path)))
- (leave (_ "failed to build the empty profile~%")))
-
- (switch-symlinks previous-profile prof)
- (switch-link)))
- (else (switch-link))))) ; anything else
-
-(define (find-packages-by-description rx)
- "Search in SYNOPSIS and DESCRIPTION using RX. Return a list of
-matching packages."
- (define (same-location? p1 p2)
- ;; Compare locations of two packages.
- (equal? (package-location p1) (package-location p2)))
-
- (delete-duplicates
- (sort
- (fold-packages (lambda (package result)
- (define matches?
- (cut regexp-exec rx <>))
-
- (if (or (and=> (package-synopsis package)
- (compose matches? gettext))
- (and=> (package-description package)
- (compose matches? gettext)))
- (cons package result)
- result))
- '())
- (lambda (p1 p2)
- (string<? (package-name p1)
- (package-name p2))))
- same-location?))
-
-(define (input->name+path input)
- "Convert the name/package/sub-drv tuple INPUT to a name/store-path tuple."
- (let loop ((input input))
- (match input
- ((name package)
- (loop `(,name ,package "out")))
- ((name package sub-drv)
- (let*-values (((_ drv)
- (package-derivation (%store) package))
- ((out)
- (derivation-output-path
- (assoc-ref (derivation-outputs drv) sub-drv))))
- `(,name ,out))))))
-
-
-;;;
-;;; Command-line options.
-;;;
-
-(define %default-options
- ;; Alist of default option values.
- `((profile . ,%current-profile)))
-
-(define (show-help)
- (display (_ "Usage: guix-package [OPTION]... PACKAGES...
-Install, remove, or upgrade PACKAGES in a single transaction.\n"))
- (display (_ "
- -i, --install=PACKAGE install PACKAGE"))
- (display (_ "
- -r, --remove=PACKAGE remove PACKAGE"))
- (display (_ "
- -u, --upgrade=REGEXP upgrade all the installed packages matching REGEXP"))
- (display (_ "
- --roll-back roll back to the previous generation"))
- (newline)
- (display (_ "
- -p, --profile=PROFILE use PROFILE instead of the user's default profile"))
- (display (_ "
- -n, --dry-run show what would be done without actually doing it"))
- (display (_ "
- --bootstrap use the bootstrap Guile to build the profile"))
- (display (_ "
- --verbose produce verbose output"))
- (newline)
- (display (_ "
- -s, --search=REGEXP search in synopsis and description using REGEXP"))
- (display (_ "
- -I, --list-installed[=REGEXP]
- list installed packages matching REGEXP"))
- (display (_ "
- -A, --list-available[=REGEXP]
- list available packages matching REGEXP"))
- (newline)
- (display (_ "
- -h, --help display this help and exit"))
- (display (_ "
- -V, --version display version information and exit"))
- (newline)
- (show-bug-report-information))
-
-(define %options
- ;; Specification of the command-line options.
- (list (option '(#\h "help") #f #f
- (lambda args
- (show-help)
- (exit 0)))
- (option '(#\V "version") #f #f
- (lambda args
- (show-version-and-exit "guix-package")))
-
- (option '(#\i "install") #t #f
- (lambda (opt name arg result)
- (alist-cons 'install arg result)))
- (option '(#\r "remove") #t #f
- (lambda (opt name arg result)
- (alist-cons 'remove arg result)))
- (option '(#\u "upgrade") #t #f
- (lambda (opt name arg result)
- (alist-cons 'upgrade arg result)))
- (option '("roll-back") #f #f
- (lambda (opt name arg result)
- (alist-cons 'roll-back? #t result)))
- (option '(#\p "profile") #t #f
- (lambda (opt name arg result)
- (alist-cons 'profile arg
- (alist-delete 'profile result))))
- (option '(#\n "dry-run") #f #f
- (lambda (opt name arg result)
- (alist-cons 'dry-run? #t result)))
- (option '("bootstrap") #f #f
- (lambda (opt name arg result)
- (alist-cons 'bootstrap? #t result)))
- (option '("verbose") #f #f
- (lambda (opt name arg result)
- (alist-cons 'verbose? #t result)))
- (option '(#\s "search") #t #f
- (lambda (opt name arg result)
- (cons `(query search ,(or arg ""))
- result)))
- (option '(#\I "list-installed") #f #t
- (lambda (opt name arg result)
- (cons `(query list-installed ,(or arg ""))
- result)))
- (option '(#\A "list-available") #f #t
- (lambda (opt name arg result)
- (cons `(query list-available ,(or arg ""))
- result)))))
-
-
-;;;
-;;; Entry point.
-;;;
-
-(define (guix-package . args)
- (define (parse-options)
- ;; Return the alist of option values.
- (args-fold args %options
- (lambda (opt name arg result)
- (leave (_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (leave (_ "~A: extraneous argument~%") arg))
- %default-options))
-
- (define (guile-missing?)
- ;; Return #t if %GUILE-FOR-BUILD is not available yet.
- (let ((out (derivation-path->output-path (%guile-for-build))))
- (not (valid-path? (%store) out))))
-
- (define (show-what-to-build drv dry-run?)
- ;; Show what will/would be built in realizing the derivations listed
- ;; in DRV.
- (let* ((req (append-map (lambda (drv-path)
- (let ((d (call-with-input-file drv-path
- read-derivation)))
- (derivation-prerequisites-to-build
- (%store) d)))
- drv))
- (req* (delete-duplicates
- (append (remove (compose (cute valid-path? (%store) <>)
- derivation-path->output-path)
- drv)
- (map derivation-input-path req)))))
- (if dry-run?
- (format (current-error-port)
- (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]"
- "~:[the following derivations would be built:~%~{ ~a~%~}~;~]"
- (length req*))
- (null? req*) req*)
- (format (current-error-port)
- (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]"
- "~:[the following derivations will be built:~%~{ ~a~%~}~;~]"
- (length req*))
- (null? req*) req*))))
-
- (define newest-available-packages
- (memoize find-newest-available-packages))
-
- (define (find-best-packages-by-name name version)
- (if version
- (find-packages-by-name name version)
- (match (vhash-assoc name (newest-available-packages))
- ((_ version pkgs ...) pkgs)
- (#f '()))))
-
- (define (find-package name)
- ;; Find the package NAME; NAME may contain a version number and a
- ;; sub-derivation name. If the version number is not present,
- ;; return the preferred newest version.
- (define request name)
-
- (define (ensure-output p sub-drv)
- (if (member sub-drv (package-outputs p))
- p
- (leave (_ "~a: error: package `~a' lacks output `~a'~%")
- (location->string (package-location p))
- (package-full-name p)
- sub-drv)))
-
- (let*-values (((name sub-drv)
- (match (string-rindex name #\:)
- (#f (values name "out"))
- (colon (values (substring name 0 colon)
- (substring name (+ 1 colon))))))
- ((name version)
- (package-name->name+version name)))
- (match (find-best-packages-by-name name version)
- ((p)
- (list name (package-version p) sub-drv (ensure-output p sub-drv)
- (package-transitive-propagated-inputs p)))
- ((p p* ...)
- (format (current-error-port)
- (_ "warning: ambiguous package specification `~a'~%")
- request)
- (format (current-error-port)
- (_ "warning: choosing ~a from ~a~%")
- (package-full-name p)
- (location->string (package-location p)))
- (list name (package-version p) sub-drv (ensure-output p sub-drv)
- (package-transitive-propagated-inputs p)))
- (()
- (leave (_ "~a: package not found~%") request)))))
-
- (define (upgradeable? name current-version current-path)
- ;; Return #t if there's a version of package NAME newer than
- ;; CURRENT-VERSION, or if the newest available version is equal to
- ;; CURRENT-VERSION but would have an output path different than
- ;; CURRENT-PATH.
- (match (vhash-assoc name (newest-available-packages))
- ((_ candidate-version pkg . rest)
- (case (version-compare candidate-version current-version)
- ((>) #t)
- ((<) #f)
- ((=) (let ((candidate-path (derivation-path->output-path
- (package-derivation (%store) pkg))))
- (not (string=? current-path candidate-path))))))
- (#f #f)))
-
- (define (ensure-default-profile)
- ;; Ensure the default profile symlink and directory exist.
-
- ;; Create ~/.guix-profile if it doesn't exist yet.
- (when (and %user-environment-directory
- %current-profile
- (not (false-if-exception
- (lstat %user-environment-directory))))
- (symlink %current-profile %user-environment-directory))
-
- ;; Attempt to create /…/profiles/per-user/$USER if needed.
- (unless (directory-exists? %profile-directory)
- (catch 'system-error
- (lambda ()
- (mkdir-p %profile-directory))
- (lambda args
- ;; Often, we cannot create %PROFILE-DIRECTORY because its
- ;; parent directory is root-owned and we're running
- ;; unprivileged.
- (format (current-error-port)
- (_ "error: while creating directory `~a': ~a~%")
- %profile-directory
- (strerror (system-error-errno args)))
- (format (current-error-port)
- (_ "Please create the `~a' directory, with you as the owner.~%")
- %profile-directory)
- (exit 1)))))
-
- (define (process-actions opts)
- ;; Process any install/remove/upgrade action from OPTS.
-
- (define dry-run? (assoc-ref opts 'dry-run?))
- (define verbose? (assoc-ref opts 'verbose?))
- (define profile (assoc-ref opts 'profile))
-
- (define (canonicalize-deps deps)
- ;; Remove duplicate entries from DEPS, a list of propagated inputs,
- ;; where each input is a name/path tuple.
- (define (same? d1 d2)
- (match d1
- ((_ path1)
- (match d2
- ((_ path2)
- (string=? path1 path2))))))
-
- (delete-duplicates (map input->name+path deps) same?))
-
- ;; First roll back if asked to.
- (if (and (assoc-ref opts 'roll-back?) (not dry-run?))
- (begin
- (roll-back profile)
- (process-actions (alist-delete 'roll-back? opts)))
- (let* ((installed (manifest-packages (profile-manifest profile)))
- (upgrade-regexps (filter-map (match-lambda
- (('upgrade . regexp)
- (make-regexp regexp))
- (_ #f))
- opts))
- (upgrade (if (null? upgrade-regexps)
- '()
- (let ((newest (find-newest-available-packages)))
- (filter-map (match-lambda
- ((name version output path _)
- (and (any (cut regexp-exec <> name)
- upgrade-regexps)
- (upgradeable? name version path)
- (find-package name)))
- (_ #f))
- installed))))
- (install (append
- upgrade
- (filter-map (match-lambda
- (('install . (? store-path?))
- #f)
- (('install . package)
- (find-package package))
- (_ #f))
- opts)))
- (drv (filter-map (match-lambda
- ((name version sub-drv
- (? package? package)
- (deps ...))
- (package-derivation (%store) package))
- (_ #f))
- install))
- (install* (append
- (filter-map (match-lambda
- (('install . (? store-path? path))
- (let-values (((name version)
- (package-name->name+version
- (store-path-package-name
- path))))
- `(,name ,version #f ,path ())))
- (_ #f))
- opts)
- (map (lambda (tuple drv)
- (match tuple
- ((name version sub-drv _ (deps ...))
- (let ((output-path
- (derivation-path->output-path
- drv sub-drv)))
- `(,name ,version ,sub-drv ,output-path
- ,(canonicalize-deps deps))))))
- install drv)))
- (remove (filter-map (match-lambda
- (('remove . package)
- package)
- (_ #f))
- opts))
- (packages (append install*
- (fold (lambda (package result)
- (match package
- ((name _ ...)
- (alist-delete name result))))
- (fold alist-delete installed remove)
- install*))))
-
- (when (equal? profile %current-profile)
- (ensure-default-profile))
-
- (show-what-to-build drv dry-run?)
-
- (or dry-run?
- (and (build-derivations (%store) drv)
- (let* ((prof-drv (profile-derivation (%store) packages))
- (prof (derivation-path->output-path prof-drv))
- (old-drv (profile-derivation
- (%store) (manifest-packages
- (profile-manifest profile))))
- (old-prof (derivation-path->output-path old-drv))
- (number (profile-number profile))
-
- ;; Always use NUMBER + 1 for the new profile,
- ;; possibly overwriting a "previous future
- ;; generation".
- (name (format #f "~a-~a-link"
- profile (+ 1 number))))
- (if (string=? old-prof prof)
- (when (or (pair? install) (pair? remove))
- (format (current-error-port)
- (_ "nothing to be done~%")))
- (and (parameterize ((current-build-output-port
- ;; Output something when Guile
- ;; needs to be built.
- (if (or verbose? (guile-missing?))
- (current-error-port)
- (%make-void-port "w"))))
- (build-derivations (%store) (list prof-drv)))
- (begin
- (switch-symlinks name prof)
- (switch-symlinks profile name))))))))))
-
- (define (process-query opts)
- ;; Process any query specified by OPTS. Return #t when a query was
- ;; actually processed, #f otherwise.
- (let ((profile (assoc-ref opts 'profile)))
- (match (assoc-ref opts 'query)
- (('list-installed regexp)
- (let* ((regexp (and regexp (make-regexp regexp)))
- (manifest (profile-manifest profile))
- (installed (manifest-packages manifest)))
- (for-each (match-lambda
- ((name version output path _)
- (when (or (not regexp)
- (regexp-exec regexp name))
- (format #t "~a\t~a\t~a\t~a~%"
- name (or version "?") output path))))
- installed)
- #t))
-
- (('list-available regexp)
- (let* ((regexp (and regexp (make-regexp regexp)))
- (available (fold-packages
- (lambda (p r)
- (let ((n (package-name p)))
- (if regexp
- (if (regexp-exec regexp n)
- (cons p r)
- r)
- (cons p r))))
- '())))
- (for-each (lambda (p)
- (format #t "~a\t~a\t~a\t~a~%"
- (package-name p)
- (package-version p)
- (string-join (package-outputs p) ",")
- (location->string (package-location p))))
- (sort available
- (lambda (p1 p2)
- (string<? (package-name p1)
- (package-name p2)))))
- #t))
-
- (('search regexp)
- (let ((regexp (make-regexp regexp regexp/icase)))
- (for-each (cute package->recutils <> (current-output-port))
- (find-packages-by-description regexp))
- #t))
- (_ #f))))
-
- (install-locale)
- (textdomain "guix")
- (setvbuf (current-output-port) _IOLBF)
- (setvbuf (current-error-port) _IOLBF)
-
- (let ((opts (parse-options)))
- (or (process-query opts)
- (parameterize ((%store (open-connection)))
- (with-error-handling
- (parameterize ((%guile-for-build
- (package-derivation (%store)
- (if (assoc-ref opts 'bootstrap?)
- %bootstrap-guile
- guile-final))))
- (process-actions opts)))))))