TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2015-04-07 22:07:25 +02:00
parent c8bfa5b425
commit 1151f6aeae
2 changed files with 19 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
guix/scripts/system.scm
View File

@ -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))))
;;;

18
guix/ui.scm
View File

@ -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