[bug#50960] [PATCH 04/10] DRAFT shell: By default load the local 'guix.scm' or 'manifest.scm' file.

[Maxime Devos]

Ludovic Courtès schreef op za 02-10-2021 om 12:22 [+0200]:
> DRAFT: Add doc.
> 
> * guix/scripts/shell.scm (parse-args): Add call to 'auto-detect-manifest'.
> (find-file-in-parent-directories, auto-detect-manifest): New procedures.
> * tests/guix-shell.sh: Add test.
> ---
>  guix/scripts/shell.scm | 44 ++++++++++++++++++++++++++++++++++++++++--
>  tests/guix-shell.sh    | 16 +++++++++++++++
>  2 files changed, 58 insertions(+), 2 deletions(-)
> 
> diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm
> index 6a4b7a5092..2f15befbd3 100644
> --- a/guix/scripts/shell.scm
> +++ b/guix/scripts/shell.scm
> @@ -22,6 +22,8 @@
>    #:autoload   (guix scripts build) (show-build-options-help)
>    #:autoload   (guix transformations) (show-transformation-options-help)
>    #:use-module (guix scripts)
> +  #:use-module (guix packages)
> +  #:use-module (guix profiles)
>    #:use-module (srfi srfi-1)
>    #:use-module (srfi srfi-26)
>    #:use-module (srfi srfi-37)
> @@ -121,13 +123,51 @@ interactive shell in that environment.\n"))
>    ;; The '--' token is used to separate the command to run from the rest of
>    ;; the operands.
>    (let ((args command (break (cut string=? "--" <>) args)))
> -    (let ((opts (parse-command-line args %options (list %default-options)
> -                                    #:argument-handler handle-argument)))
> +    (let ((opts (auto-detect-manifest
> +                 (parse-command-line args %options (list %default-options)
> +                                     #:argument-handler handle-argument))))
>        (match command
>          (() opts)
>          (("--") opts)
>          (("--" command ...) (alist-cons 'exec command opts))))))
>  
> +(define (find-file-in-parent-directories candidates)
> +  "Find one of CANDIDATES in the current directory or one of its ancestors."
> +  (let loop ((directory (getcwd)))
> +    (and (= (stat:uid (stat directory)) (getuid))
> +         (or (any (lambda (candidate)
> +                    (let ((candidate (string-append directory "/" 
> candidate)))
> +                      (and (file-exists? candidate) candidate)))
> +                  candidates)
> +             (loop (string-append directory "/..")))))) ;Unix ".." resolution
> +
> +(define (auto-detect-manifest opts)
> +  "If OPTS do not specify packages or a manifest, load a \"guix.scm\" or
> +\"manifest.scm\" file from the current directory or one of its ancestors.
> +Return the modified OPTS."
> +  (define (options-contain-payload? opts)
> +    (match opts
> +      (() #f)
> +      ((('package . _) . _) #t)
> +      ((('load . _) . _) #t)
> +      ((('manifest . _) . _) #t)
> +      ((('expression . _) . _) #t)
> +      ((_ . rest) (options-contain-payload? rest))))
> +
> +  (if (options-contain-payload? opts)
> +      opts
> +      (match (find-file-in-parent-directories '("guix.scm" "manifest.scm"))
> +        (#f
> +         (warning (G_ "no packages specified; creating an empty 
> environment~%"))
> +         opts)
> +        (file
> +         (info (G_ "loading environment from '~a'...~%") file)

Could we have nice ‘curly quotes’ here:

  (info (G_ "loading environment from ‘~a’...~%") file)

Greetings,
Maxime.

signature.asc
Description: This is a digitally signed message part