diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 1b64e6fb92..1838e89452 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -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)))) ;;; diff --git a/guix/ui.scm b/guix/ui.scm index 4929f93590..80a4a6338a 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -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