ui: Define and honor '&error-location' and '&fix-hint' conditions.
* guix/utils.scm (&error-location, &fix-hint): New condition types. * guix/ui.scm (report-load-error): Handle them. (call-with-error-handling): Honor '&error-location'.
This commit is contained in:
parent
37eed374d9
commit
23735137eb
19
guix/ui.scm
19
guix/ui.scm
|
@ -251,10 +251,20 @@ ARGS is the list of arguments received by the 'throw' handler."
|
||||||
(location->string loc) message)))
|
(location->string loc) message)))
|
||||||
(('srfi-34 obj)
|
(('srfi-34 obj)
|
||||||
(if (message-condition? obj)
|
(if (message-condition? obj)
|
||||||
(report-error (G_ "~a~%")
|
(if (error-location? obj)
|
||||||
|
(format (current-error-port)
|
||||||
|
(G_ "~a: error: ~a~%")
|
||||||
|
(location->string (error-location obj))
|
||||||
(gettext (condition-message obj)
|
(gettext (condition-message obj)
|
||||||
%gettext-domain))
|
%gettext-domain))
|
||||||
(report-error (G_ "exception thrown: ~s~%") obj)))
|
(report-error (G_ "~a~%")
|
||||||
|
(gettext (condition-message obj)
|
||||||
|
%gettext-domain)))
|
||||||
|
(report-error (G_ "exception thrown: ~s~%") obj))
|
||||||
|
(when (fix-hint? obj)
|
||||||
|
(format (current-error-port) (G_ "hint: ~a~%")
|
||||||
|
(fill-paragraph (texi->plain-text (condition-fix-hint obj))
|
||||||
|
(terminal-columns) 8))))
|
||||||
((error args ...)
|
((error args ...)
|
||||||
(report-error (G_ "failed to load '~a':~%") file)
|
(report-error (G_ "failed to load '~a':~%") file)
|
||||||
(apply display-error frame (current-error-port) args))))
|
(apply display-error frame (current-error-port) args))))
|
||||||
|
@ -517,6 +527,11 @@ interpreted."
|
||||||
directories:~{ ~a~}~%")
|
directories:~{ ~a~}~%")
|
||||||
(file-search-error-file-name c)
|
(file-search-error-file-name c)
|
||||||
(file-search-error-search-path c)))
|
(file-search-error-search-path c)))
|
||||||
|
((and (error-location? c) (message-condition? c))
|
||||||
|
(format (current-error-port)
|
||||||
|
(G_ "~a: error: ~a~%")
|
||||||
|
(location->string (error-location c))
|
||||||
|
(gettext (condition-message c) %gettext-domain)))
|
||||||
((message-condition? c)
|
((message-condition? c)
|
||||||
;; Normally '&message' error conditions have an i18n'd message.
|
;; Normally '&message' error conditions have an i18n'd message.
|
||||||
(leave (G_ "~a~%")
|
(leave (G_ "~a~%")
|
||||||
|
|
|
@ -28,6 +28,7 @@
|
||||||
#:use-module (srfi srfi-9)
|
#:use-module (srfi srfi-9)
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
|
#:use-module (srfi srfi-35)
|
||||||
#:use-module (srfi srfi-39)
|
#:use-module (srfi srfi-39)
|
||||||
#:use-module (ice-9 binary-ports)
|
#:use-module (ice-9 binary-ports)
|
||||||
#:autoload (rnrs io ports) (make-custom-binary-input-port)
|
#:autoload (rnrs io ports) (make-custom-binary-input-port)
|
||||||
|
@ -60,6 +61,14 @@
|
||||||
source-properties->location
|
source-properties->location
|
||||||
location->source-properties
|
location->source-properties
|
||||||
|
|
||||||
|
&error-location
|
||||||
|
error-location?
|
||||||
|
error-location
|
||||||
|
|
||||||
|
&fix-hint
|
||||||
|
fix-hint?
|
||||||
|
condition-fix-hint
|
||||||
|
|
||||||
nix-system->gnu-triplet
|
nix-system->gnu-triplet
|
||||||
gnu-triplet->nix-system
|
gnu-triplet->nix-system
|
||||||
%current-system
|
%current-system
|
||||||
|
@ -750,6 +759,14 @@ a location object."
|
||||||
(column . ,(location-column loc))
|
(column . ,(location-column loc))
|
||||||
(filename . ,(location-file loc))))
|
(filename . ,(location-file loc))))
|
||||||
|
|
||||||
|
(define-condition-type &error-location &error
|
||||||
|
error-location?
|
||||||
|
(location error-location)) ;<location>
|
||||||
|
|
||||||
|
(define-condition-type &fix-hint &condition
|
||||||
|
fix-hint?
|
||||||
|
(hint condition-fix-hint)) ;string
|
||||||
|
|
||||||
;;; Local Variables:
|
;;; Local Variables:
|
||||||
;;; eval: (put 'call-with-progress-reporter 'scheme-indent-function 1)
|
;;; eval: (put 'call-with-progress-reporter 'scheme-indent-function 1)
|
||||||
;;; End:
|
;;; End:
|
||||||
|
|
Loading…
Reference in New Issue