diff options
Diffstat (limited to 'guix/ui.scm')
| -rw-r--r-- | guix/ui.scm | 66 |
1 files changed, 42 insertions, 24 deletions
diff --git a/guix/ui.scm b/guix/ui.scm index 7920335928..069d542131 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -13,6 +13,7 @@ ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2019 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr> +;;; Copyright © 2019 Simon Tournier <zimon.toutoune@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -120,6 +121,10 @@ roll-back* switch-to-generation* delete-generation* + + %default-message-language + current-message-language + run-guix-command run-guix guix-main)) @@ -427,6 +432,20 @@ exiting. ARGS is the list of arguments received by the 'throw' handler." report them in a user-friendly way." (call-with-unbound-variable-handling (lambda () exp ...))) +(define %default-message-language + ;; Default language to use for messages. + (make-parameter "en")) + +(define (current-message-language) + "Return the language used for messages according to the current locale. +Return %DEFAULT-MESSAGE-LANGUAGE if that information could not be obtained. The +result is an ISO-639-2 language code such as \"ar\", without the territory +part." + (let ((locale (setlocale LC_MESSAGES))) + (match (string-index locale #\_) + (#f locale) + (index (string-take locale index))))) + (define (install-locale) "Install the current locale settings." (catch 'system-error @@ -1281,33 +1300,32 @@ weight of this field in the final score. A score of zero means that OBJ does not match any of REGEXPS. The higher the score, the more relevant OBJ is to REGEXPS." - (define (score str) - (define scores - (map (lambda (regexp) - (fold-matches regexp str 0 - (lambda (m score) - (+ score - (if (string=? (match:substring m) str) - 5 ;exact match - 1))))) - regexps)) - + (define (score regexp str) + (fold-matches regexp str 0 + (lambda (m score) + (+ score + (if (string=? (match:substring m) str) + 5 ;exact match + 1))))) + + (define (regexp->score regexp) + (let ((score-regexp (lambda (str) (score regexp str)))) + (fold (lambda (metric relevance) + (match metric + ((field . weight) + (match (field obj) + (#f relevance) + ((? string? str) + (+ relevance (* (score-regexp str) weight))) + ((lst ...) + (+ relevance (* weight (apply + (map score-regexp lst))))))))) + 0 metrics))) + + (let ((scores (map regexp->score regexps))) ;; Return zero if one of REGEXPS doesn't match. (if (any zero? scores) 0 - (reduce + 0 scores))) - - (fold (lambda (metric relevance) - (match metric - ((field . weight) - (match (field obj) - (#f relevance) - ((? string? str) - (+ relevance (* (score str) weight))) - ((lst ...) - (+ relevance (* weight (apply + (map score lst))))))))) - 0 - metrics)) + (reduce + 0 scores)))) (define %package-metrics ;; Metrics used to compute the "relevance score" of a package against a set |