From mboxrd@z Thu Jan 1 00:00:00 1970 From: Nikita Karetnikov Subject: [PATCH] ui: Add a 'define-diagnostic' macro. (was: Enhanced 'warning') Date: Sat, 20 Apr 2013 00:16:32 +0400 Message-ID: <8761zie0nz.fsf_-_@karetnikov.org> References: <87li92alhe.fsf@karetnikov.org> <874nforp12.fsf@gnu.org> <8762015b0w.fsf@karetnikov.org> <874nflx8e3.fsf@gnu.org> <871ua85t4w.fsf@karetnikov.org> <87sj2o59zy.fsf@gnu.org> <877gjzd4gb.fsf@karetnikov.org> <87r4i7wo53.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/signed; boundary="==-=-="; micalg=pgp-sha1; protocol="application/pgp-signature" Return-path: Received: from eggs.gnu.org ([208.118.235.92]:49956) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UTHh8-0002Y8-K9 for bug-guix@gnu.org; Fri, 19 Apr 2013 16:14:10 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UTHh5-0001uK-3j for bug-guix@gnu.org; Fri, 19 Apr 2013 16:14:06 -0400 In-Reply-To: <87r4i7wo53.fsf@gnu.org> ("Ludovic =?utf-8?Q?Court=C3=A8s=22'?= =?utf-8?Q?s?= message of "Thu, 18 Apr 2013 22:59:52 +0200") List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org Sender: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org To: Ludovic =?utf-8?Q?Court=C3=A8s?= Cc: bug-guix@gnu.org --==-=-= Content-Type: multipart/mixed; boundary="=-=-=" --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable > This is a macro-generating macro. In the body of the generated macro, > above, there are 4 occurrences of =E2=80=98...=E2=80=99. But these ellip= ses have no > meaning in the outer macro; they are just meaningful in the context of > the generated macro, hence the error. > Instead, you should replace all 4 occurrences with (... ...). > Yes, it=E2=80=99s always surprising at first. ;-) Yep, could you add it to the manual? There is only a reference to this book [1] which briefly discusses the topic. I'm attaching the patch that adds a 'define-diagnostic' macro. Can I push it to 'master'? I ran 'grep' to find things which use "warning" or "leave." I guess it's possible to change other functions (the ones that use 'error' and 'format'). But it will probably trigger a rebuild. So what should I do? Also, is it possible to move 'report-error' inside 'leave'? Finally, I haven't tested each change. All tests pass and there are no warnings. Is it good enough? [1] http://scheme.com/tspl4/ --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: attachment; filename=0001-ui-Add-a-define-diagnostic-macro.patch Content-Transfer-Encoding: quoted-printable From=209f5d9501a270bd64c563e41f57278aba42266364 Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Fri, 19 Apr 2013 19:17:41 +0000 Subject: [PATCH] ui: Add a 'define-diagnostic' macro. * guix/ui.scm (define-diagnostic): New macro, which is based on the previous version of 'warning'. (warning, leave): Redefine using 'define-diagnostic'. (report-error): New macro. (install-locale): Use 'warning' instead of 'format'. (call-with-error-handling): Adjust 'leave'. * gnu/packages.scm (package-files): Use 'warning' instead of 'format'. * guix/gnu-maintenance.scm (http-fetch): Use 'warning' and 'leave'. * guix/scripts/build.scm (derivations-from-package-expressions, guix-build): Adjust 'leave'. * guix/scripts/download.scm (guix-download): Adjust 'leave'. * guix/scripts/gc.scm (size->number, %options): Adjust 'leave'. * guix/scripts/package.scm (roll-back, guix-package): Adjust 'leave'. =2D-- gnu/packages.scm | 6 ++-- guix/gnu-maintenance.scm | 12 +++--- guix/scripts/build.scm | 14 ++++---- guix/scripts/download.scm | 4 +- guix/scripts/gc.scm | 7 ++-- guix/scripts/package.scm | 5 +-- guix/ui.scm | 82 ++++++++++++++++++++++-------------------= --- 7 files changed, 64 insertions(+), 66 deletions(-) diff --git a/gnu/packages.scm b/gnu/packages.scm index f4d93a7..e9f2540 100644 =2D-- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -19,6 +19,7 @@ =20 (define-module (gnu packages) #:use-module (guix packages) + #:use-module (guix ui) #:use-module (guix utils) #:use-module (ice-9 ftw) #:use-module (ice-9 vlist) @@ -90,9 +91,8 @@ result) (const #f) ; skip (lambda (path stat errno result) =2D (format (current-error-port) =2D (_ "warning: cannot access `~a': ~a~%") =2D path (strerror errno)) + (warning (_ "cannot access `~a': ~a~%") + path (strerror errno)) result) '() %distro-module-directory diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 89e7f25..5df9c6f 100644 =2D-- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -29,6 +29,7 @@ #:use-module (srfi srfi-26) #:use-module (system foreign) #:use-module (guix ftp-client) + #:use-module (guix ui) #:use-module (guix utils) #:use-module (guix packages) #:export (gnu-package-name @@ -84,12 +85,11 @@ ;; (see ). ;; Since users may still be using these versions, warn the= m and ;; bail out. =2D (format (current-error-port) =2D "warning: using Guile ~a, ~a ~s encoding~%" =2D (version) =2D "which does not support HTTP" =2D (response-transfer-encoding resp)) =2D (error "download failed; use a newer Guile" + (warning (_ "using Guile ~a, ~a ~s encoding~%") + (version) + "which does not support HTTP" + (response-transfer-encoding resp)) + (leave (_ "download failed; use a newer Guile") uri resp))) ((string? data) ; old `http-get' returns a st= ring (open-input-string data)) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index f296f30..0bf154d 100644 =2D-- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -43,12 +43,11 @@ When SOURCE? is true, return the derivations of the package sources." (let ((p (read/eval-package-expression str))) (if source? =2D (let ((source (package-source p)) =2D (loc (package-location p))) + (let ((source (package-source p))) (if source (package-source-derivation (%store) source) =2D (leave (_ "~a: error: package `~a' has no source~%") =2D (location->string loc) (package-name p)))) + (leave (_ "package `~a' has no source~%") + (package-name p)))) (package-derivation (%store) p system)))) =20 @@ -169,7 +168,9 @@ Build the given PACKAGE-OR-DERIVATION and return their = output paths.\n")) (add-indirect-root (%store) root)) ((paths ...) (fold (lambda (path count) =2D (let ((root (string-append root "-" (number->string = count)))) + (let ((root (string-append root + "-" + (number->string count)))) (symlink path root) (add-indirect-root (%store) root)) (+ 1 count)) @@ -177,8 +178,7 @@ Build the given PACKAGE-OR-DERIVATION and return their = output paths.\n")) paths)))) (lambda args (leave (_ "failed to create GC root `~a': ~a~%") =2D root (strerror (system-error-errno args))) =2D (exit 1))))) + root (strerror (system-error-errno args))))))) =20 (define newest-available-packages (memoize find-newest-available-packages)) diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm index 7c00312..c5c56c5 100644 =2D-- a/guix/scripts/download.scm +++ b/guix/scripts/download.scm @@ -114,7 +114,7 @@ and the hash of its contents.\n")) (store (open-connection)) (arg (assq-ref opts 'argument)) (uri (or (string->uri arg) =2D (leave (_ "guix-download: ~a: failed to parse URI~= %") + (leave (_ "~a: failed to parse URI~%") arg))) (path (case (uri-scheme uri) ((file) @@ -127,7 +127,7 @@ and the hash of its contents.\n")) (basename (uri-path uri)))))) (hash (call-with-input-file (or path =2D (leave (_ "guix-download: ~a: download failed~= %") + (leave (_ "~a: download failed~%") arg)) (compose sha256 get-bytevector-all))) (fmt (assq-ref opts 'format))) diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm index 3d91892..f464579 100644 =2D-- a/guix/scripts/gc.scm +++ b/guix/scripts/gc.scm @@ -87,9 +87,8 @@ interpreted." ("TB" (expt 10 12)) ("" 1) (_ =2D (leave (_ "error: unknown unit: ~a~%") unit) =2D (exit 1)))) =2D (leave (_ "error: invalid number: ~a") numstr)))) + (leave (_ "unknown unit: ~a~%") unit)))) + (leave (_ "invalid number: ~a") numstr)))) =20 (define %options ;; Specification of the command-line options. @@ -110,7 +109,7 @@ interpreted." (let ((amount (size->number arg))) (if arg (alist-cons 'min-freed amount result) =2D (leave (_ "error: invalid amount of storage:= ~a~%") + (leave (_ "invalid amount of storage: ~a~%") arg)))) (#f result))))) (option '(#\d "delete") #f #f diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 4295aba..c5656ef 100644 =2D-- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -208,7 +208,7 @@ all of PACKAGES, a list of name/version/output/path/dep= s tuples." (switch-symlinks profile previous-profile)) =20 (cond ((not (file-exists? profile)) ; invalid profile =2D (leave (_ "error: profile `~a' does not exist~%") + (leave (_ "profile `~a' does not exist~%") profile)) ((zero? number) ; empty profile (format (current-error-port) @@ -477,8 +477,7 @@ Install, remove, or upgrade PACKAGES in a single transa= ction.\n")) (define (ensure-output p sub-drv) (if (member sub-drv (package-outputs p)) p =2D (leave (_ "~a: error: package `~a' lacks output `~a'~%") =2D (location->string (package-location p)) + (leave (_ "package `~a' lacks output `~a'~%") (package-full-name p) sub-drv))) =20 diff --git a/guix/ui.scm b/guix/ui.scm index 938b5d2..e42c331 100644 =2D-- a/guix/ui.scm +++ b/guix/ui.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright =C2=A9 2012, 2013 Ludovic Court=C3=A8s ;;; Copyright =C2=A9 2013 Mark H Weaver +;;; Copyright =C2=A9 2013 Nikita Karetnikov ;;; ;;; This file is part of GNU Guix. ;;; @@ -70,9 +71,8 @@ (lambda _ (setlocale LC_ALL "")) (lambda args =2D (format (current-error-port) =2D (_ "warning: failed to install locale: ~a~%") =2D (strerror (system-error-errno args)))))) + (warning (_ "failed to install locale: ~a~%") + (strerror (system-error-errno args)))))) =20 (define (initialize-guix) "Perform the usual initialization for stand-alone Guix commands." @@ -81,12 +81,6 @@ (setvbuf (current-output-port) _IOLBF) (setvbuf (current-error-port) _IOLBF)) =20 =2D(define-syntax-rule (leave fmt args ...) =2D "Format FMT and ARGS to the error port and exit." =2D (begin =2D (format (current-error-port) fmt args ...) =2D (exit 1))) =2D (define* (show-version-and-exit #:optional (command (car (command-line)))) "Display version information for COMMAND and `(exit 0)'." (simple-format #t "~a (~a) ~a~%" @@ -111,16 +105,16 @@ General help using GNU software: ")) (file (location-file location)) (line (location-line location)) (column (location-column location))) =2D (leave (_ "~a:~a:~a: error: package `~a' has an invalid i= nput: ~s~%") + (leave (_ "~a:~a:~a: package `~a' has an invalid input: ~s~= %") file line column (package-full-name package) input))) ((nix-connection-error? c) =2D (leave (_ "error: failed to connect to `~a': ~a~%") + (leave (_ "failed to connect to `~a': ~a~%") (nix-connection-error-file c) (strerror (nix-connection-error-code c)))) ((nix-protocol-error? c) ;; FIXME: Server-provided error messages aren't i18n'd. =2D (leave (_ "error: build failed: ~a~%") + (leave (_ "build failed: ~a~%") (nix-protocol-error-message c)))) (thunk))) =20 @@ -375,35 +369,41 @@ WIDTH columns." (define guix-warning-port (make-parameter (current-warning-port))) =20 =2D(define-syntax warning =2D (lambda (s) =2D "Emit a warming. The macro assumes that `_' is bound to `gettext'." =2D ;; All this just to preserve `-Wformat' warnings. Too much? =2D =2D (define (augmented-format-string fmt) =2D (string-append "~:[~*~;guix ~a: ~]~a" (syntax->datum fmt))) =2D =2D (define prefix =2D #'(_ "warning: ")) =2D =2D (syntax-case s (N_ _) ; these are literals, y= eah... =2D ((warning (_ fmt) args ...) =2D (string? (syntax->datum #'fmt)) =2D (with-syntax ((fmt* (augmented-format-string #'fmt)) =2D (prefix prefix)) =2D #'(format (guix-warning-port) (gettext fmt*) =2D (program-name) (program-name) prefix =2D args ...))) =2D ((warning (N_ singular plural n) args ...) =2D (and (string? (syntax->datum #'singular)) =2D (string? (syntax->datum #'plural))) =2D (with-syntax ((s (augmented-format-string #'singular)) =2D (p (augmented-format-string #'plural)) =2D (b prefix)) =2D #'(format (guix-warning-port) =2D (ngettext s p n %gettext-domain) =2D (program-name) (program-name) b =2D args ...)))))) +(define-syntax-rule (define-diagnostic name prefix) + "Create a diagnostic macro (i.e., NAME), which will prepend PREFIX to all +messages." + (define-syntax name + (lambda (x) + (define (augmented-format-string fmt) + (string-append "~:[~*~;guix ~a: ~]~a" (syntax->datum fmt))) + + (syntax-case x (N_ _) ; these are literals, yeah.= .. + ((name (_ fmt) args (... ...)) + (string? (syntax->datum #'fmt)) + (with-syntax ((fmt* (augmented-format-string #'fmt)) + (prefix (datum->syntax x prefix))) + #'(format (guix-warning-port) (gettext fmt*) + (program-name) (program-name) prefix + args (... ...)))) + ((name (N_ singular plural n) args (... ...)) + (and (string? (syntax->datum #'singular)) + (string? (syntax->datum #'plural))) + (with-syntax ((s (augmented-format-string #'singular)) + (p (augmented-format-string #'plural)) + (prefix (datum->syntax x prefix))) + #'(format (guix-warning-port) + (ngettext s p n %gettext-domain) + (program-name) (program-name) prefix + args (... ...)))))))) + +(define-diagnostic warning "warning: ") ; emit a warning + +(define-diagnostic report-error "error: ") +(define-syntax-rule (leave args ...) + "Emit an error message and exit." + (begin + (report-error args ...) + (exit 1))) =20 (define (guix-main arg0 . args) (initialize-guix) =2D-=20 1.7.5.4 --=-=-=-- --==-=-= Content-Type: application/pgp-signature -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.10 (GNU/Linux) iQIcBAEBAgAGBQJRcaYnAAoJEM+IQzI9IQ38MGUP/RLwUaUogs7k4m/EnhgBoxPa xh7nppiO2LnDf36f3WT/5G9GJm+OrPSdeAi3Vas8Z7bRc5DUU7MghkqQE9YiLe48 20Vs3nbg5FCRD3G9OCHk63fyr/X96auKHJGZpk+ERKf+OH2OTzkMoeZ7seDOdPim K23CiozOLqQVDwrhGTEQ5GhAqlM9Tz+A8Ojej0VEm7UTcNQ7xABkwtHJ2guTYZde voL6J+7Iu+85+iw8fyhg4OfTM/V383UmZJvJxVMXHQSwEfckyrEfgRhh62SmNUP1 duV3VWP/ha1KsbDLFD9z2ivUdUiGo02LYgLK+5uRTW3sMbjxESsqhgiQ0fW9OAwz tHcQmdZmmFl4To6z6CVaD1PhIPnBF7dRV71jEWFtXV7zZZIc0B0jK8EyjRlqJ6vX BFjVmyKLCpacFDSNyM2CI9kP4rst4l8DMXToH7/eYrQB5VzB/5wlqTdCsTBNFSB7 K6uy/Mr1tqeDWQ6CBC5WTCvhKbiIT3b8Ys05PIBk0UH0RAHuZ432MtlHxYdkhsIR sCPa5lCfFRn0W/5ZGG5QrUamioGpFgExT2FSXxQfeZox+n2JdtoLhGdPhY/dOR5h Yob02lsqZ4D1UaV6B9Syj4cEj0GKuXk1JizfNyEE+WGHqu7QHH0v/AKjtfAfPKRC T9fNK7vpFWWkRQg/50aI =akrB -----END PGP SIGNATURE----- --==-=-=--