diff --git a/gnu.scm b/gnu.scm index 913ce6160..6dde968f1 100644 --- a/gnu.scm +++ b/gnu.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès ;;; Copyright © 2015 Joshua S. Grant ;;; Copyright © 2017 Mathieu Othacehe ;;; @@ -19,6 +19,10 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu) + #:use-module (guix utils) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (ice-9 match) #:export (use-package-modules use-service-modules use-system-modules)) @@ -52,13 +56,46 @@ (module-use! i (resolve-interface m)))) %public-modules))) +(define (%try-use-modules modules location) + "Attempt to load all of MODULES. Report errors as coming from LOCATION, a +source property alist." + (define (location->string loc) + (match loc + (#f "") + (($ file line column) + (format #f "~a:~a:~a: " file line column)))) + + (for-each (lambda (module) + (catch 'misc-error + (lambda () + (process-use-modules `((,module)))) + (lambda _ + (raise (condition + (&message + ;; TODO: Suggest a module with a similar name. + (message + (let-syntax ((G_ (syntax-rules () + ((_ str) str)))) + (format #f + (G_ "module ~a could not be found~%") + module)))) + (&error-location + (location location))))))) + modules)) + +(define-syntax-rule (try-use-modules modules ...) + (eval-when (expand load eval) + (%try-use-modules '(modules ...) + (source-properties->location + (current-source-location))))) + (define-syntax-rule (use-package-modules module ...) - (use-modules (gnu packages module) ...)) + (try-use-modules (gnu packages module) ...)) (define-syntax-rule (use-service-modules module ...) - (use-modules (gnu services module) ...)) + (try-use-modules (gnu services module) ...)) (define-syntax-rule (use-system-modules module ...) - (use-modules (gnu system module) ...)) + (try-use-modules (gnu system module) ...)) ;;; gnu.scm ends here diff --git a/guix/ui.scm b/guix/ui.scm index 3c8734a7d..cd3a44fb4 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -272,9 +272,15 @@ ARGS is the list of arguments received by the 'throw' handler." (location->string loc) message))) (('srfi-34 obj) (if (message-condition? obj) - (report-error (G_ "~a~%") - (gettext (condition-message obj) - %gettext-domain)) + (if (error-location? obj) + (format (current-error-port) + (G_ "~a: ~a~%") + (location->string (error-location obj)) + (gettext (condition-message obj) + %gettext-domain)) + (report-error (G_ "~a~%") + (gettext (condition-message obj) + %gettext-domain))) (report-error (G_ "exception thrown: ~s~%") obj))) ((error args ...) (report-error (G_ "failed to load '~a':~%") file) @@ -538,6 +544,11 @@ interpreted." directories:~{ ~a~}~%") (file-search-error-file-name c) (file-search-error-search-path c))) + ((and (error-location? c) (message-condition? c)) + (format (current-error-port) + (G_ "~a: ~a~%") + (location->string (error-location c)) + (gettext (condition-message c) %gettext-domain))) ((message-condition? c) ;; Normally '&message' error conditions have an i18n'd message. (leave (G_ "~a~%") diff --git a/guix/utils.scm b/guix/utils.scm index eb1ec29b3..e25e2299e 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -28,6 +28,7 @@ #:use-module (srfi srfi-9) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-35) #:use-module (srfi srfi-39) #:use-module (ice-9 binary-ports) #:autoload (rnrs io ports) (make-custom-binary-input-port) @@ -60,6 +61,10 @@ source-properties->location location->source-properties + &error-location + error-location? + error-location + nix-system->gnu-triplet gnu-triplet->nix-system %current-system @@ -750,6 +755,10 @@ a location object." (column . ,(location-column loc)) (filename . ,(location-file loc)))) +(define-condition-type &error-location &error + error-location? + (location error-location)) ; + ;;; Local Variables: ;;; eval: (put 'call-with-progress-reporter 'scheme-indent-function 1) ;;; End: diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index e3f767cc6..6510b99e8 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -1,5 +1,6 @@ # List of source files which contain translatable strings. # This should be source files of the various tools, and not package modules. +gnu.scm gnu/packages.scm gnu/services.scm gnu/system.scm