~ruther/guix-local

1151f6aeae281ae391f925f5cee086f1c2a0728a — Ludovic Courtès 11 years ago c8bfa5b
ui: Add 'report-load-error'.

* guix/scripts/system.scm (read-operating-system): Replace error
  handling code by a call to 'report-load-error'.
* guix/ui.scm (report-load-error): New procedure.
2 files changed, 19 insertions(+), 15 deletions(-)

M guix/scripts/system.scm
M guix/ui.scm
M guix/scripts/system.scm => guix/scripts/system.scm +1 -15
@@ 69,21 69,7 @@
         (set-current-module %user-module)
         (primitive-load file))))
    (lambda args
      (match args
        (('system-error . _)
         (let ((err (system-error-errno args)))
           (leave (_ "failed to open operating system file '~a': ~a~%")
                  file (strerror err))))
        (('syntax-error proc message properties form . rest)
         (let ((loc (source-properties->location properties)))
           (format (current-error-port) (_ "~a: error: ~a~%")
                   (location->string loc) message)
           (exit 1)))
        ((error args ...)
         (report-error (_ "failed to load operating system file '~a':~%")
                       file)
         (apply display-error #f (current-error-port) args)
         (exit 1))))))
      (report-load-error file args))))


;;;

M guix/ui.scm => guix/ui.scm +18 -0
@@ 47,6 47,7 @@
            P_
            report-error
            leave
            report-load-error
            show-version-and-exit
            show-bug-report-information
            string->number*


@@ 130,6 131,23 @@ messages."
    (report-error args ...)
    (exit 1)))

(define (report-load-error file args)
  "Report the failure to load FILE, a user-provided Scheme file, and exit.
ARGS is the list of arguments received by the 'throw' handler."
  (match args
    (('system-error . _)
     (let ((err (system-error-errno args)))
       (leave (_ "failed to load '~a': ~a~%") file (strerror err))))
    (('syntax-error proc message properties form . rest)
     (let ((loc (source-properties->location properties)))
       (format (current-error-port) (_ "~a: error: ~a~%")
               (location->string loc) message)
       (exit 1)))
    ((error args ...)
     (report-error (_ "failed to load '~a':~%") file)
     (apply display-error #f (current-error-port) args)
     (exit 1))))

(define (install-locale)
  "Install the current locale settings."
  (catch 'system-error