rekahsoft
/
guix
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ui: Move macro definitions before any use. 

* guix/ui.scm (define-diagnostic, warning, report-error, leave): Move
  definitions before any use.  Reported by Nikita Karetnikov.
  (install-locale): Move back close to `initialize-guix'.
This commit is contained in:
Ludovic Courtès 2013-04-22 13:24:16 +02:00
parent 19c9664d93
commit b2a886f6c7
1 changed files with 45 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

90
guix/ui.scm
View File

@ -64,6 +64,51 @@
(define _ (cut gettext <> %gettext-domain))
(define N_ (cut ngettext <> <> <> %gettext-domain))
(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)))
(define (install-locale)
"Install the current locale settings."
(catch 'system-error
(lambda _
(setlocale LC_ALL ""))
(lambda args
(warning (_ "failed to install locale: ~a~%")
(strerror (system-error-errno args))))))
(define (initialize-guix)
"Perform the usual initialization for stand-alone Guix commands."
(install-locale)
@ -344,51 +389,6 @@ WIDTH columns."
(define guix-warning-port
(make-parameter (current-warning-port)))
(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)))
(define (install-locale)
"Install the current locale settings."
(catch 'system-error
(lambda _
(setlocale LC_ALL ""))
(lambda args
(warning (_ "failed to install locale: ~a~%")
(strerror (system-error-errno args))))))
(define (guix-main arg0 . args)
(initialize-guix)
(let ()