diff options
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/build-system/cmake.scm | 9 | ||||
| -rw-r--r-- | guix/build/utils.scm | 99 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 15 | ||||
| -rw-r--r-- | guix/utils.scm | 8 |
4 files changed, 125 insertions, 6 deletions
diff --git a/guix/build-system/cmake.scm b/guix/build-system/cmake.scm index ca88fadddf..aa0f4187ec 100644 --- a/guix/build-system/cmake.scm +++ b/guix/build-system/cmake.scm @@ -43,16 +43,19 @@ `((guix build cmake-build-system) ,@%gnu-build-system-modules)) -(define (default-cmake) +(define (default-cmake target) "Return the default CMake package." ;; Do not use `@' to avoid introducing circular dependencies. (let ((module (resolve-interface '(gnu packages cmake)))) - (module-ref module 'cmake-minimal))) + (module-ref module + (if target + 'cmake-minimal-cross + 'cmake-minimal)))) (define* (lower name #:key source inputs native-inputs outputs system target - (cmake (default-cmake)) + (cmake (default-cmake target)) #:allow-other-keys #:rest arguments) "Return a bag for NAME." diff --git a/guix/build/utils.scm b/guix/build/utils.scm index b8be73ead4..cee4e8aaa2 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -1324,6 +1324,105 @@ not supported." (&wrap-error (program prog) (type 'no-interpreter-found))))))))) +(define* (make-desktop-entry-file destination #:key + (type "Application") ; One of "Application", "Link" or "Directory". + (version "1.1") + name + (generic-name name) + (no-display #f) + comment + icon + (hidden #f) + only-show-in + not-show-in + (d-bus-activatable #f) + try-exec + exec + path + (terminal #f) + actions + mime-type + (categories "Application") + implements + keywords + (startup-notify #t) + startup-w-m-class + #:rest all-args) + "Create a desktop entry file at DESTINATION. +You must specify NAME. + +Values can be booleans, numbers, strings or list of strings. + +Additionally, locales can be specified with an alist where the key is the +locale. The #f key specifies the default. Example: + + #:name '((#f \"I love Guix\") (\"fr\" \"J'aime Guix\")) + +produces + + Name=I love Guix + Name[fr]=J'aime Guix + +For a complete description of the format, see the specifications at +https://specifications.freedesktop.org/desktop-entry-spec/desktop-entry-spec-latest.html." + (define (escape-semicolon s) + (string-join (string-split s #\;) "\\;")) + (define* (parse key value #:optional locale) + (set! value (match value + (#t "true") + (#f "false") + ((? number? n) n) + ((? string? s) (escape-semicolon s)) + ((? list? value) + (catch 'wrong-type-arg + (lambda () (string-join (map escape-semicolon value) ";")) + (lambda args (error "List arguments can only contain strings: ~a" args)))) + (_ (error "Value must be a boolean, number, string or list of strings")))) + (format #t "~a=~a~%" + (if locale + (format #f "~a[~a]" key locale) + key) + value)) + + (define key-error-message "This procedure only takes key arguments beside DESTINATION") + + (unless name + (error "Missing NAME key argument")) + (unless (member #:type all-args) + (set! all-args (append (list #:type type) all-args))) + (mkdir-p (dirname destination)) + + (with-output-to-file destination + (lambda () + (format #t "[Desktop Entry]~%") + (let loop ((args all-args)) + (match args + (() #t) + ((_) (error key-error-message)) + ((key value . ...) + (unless (keyword? key) + (error key-error-message)) + (set! key + (string-join (map string-titlecase + (string-split (symbol->string + (keyword->symbol key)) + #\-)) + "")) + (match value + (((_ . _) . _) + (for-each (lambda (locale-subvalue) + (parse key + (if (and (list? (cdr locale-subvalue)) + (= 1 (length (cdr locale-subvalue)))) + ;; Support both proper and improper lists for convenience. + (cadr locale-subvalue) + (cdr locale-subvalue)) + (car locale-subvalue))) + value)) + (_ + (parse key value))) + (loop (cddr args)))))))) + ;;; ;;; Locales. diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 27b014db68..d3e10b6dc7 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016, 2017, 2018 Chris Marusich <cmmarusich@gmail.com> -;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2017, 2019 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2019 Christopher Baines <mail@cbaines.net> ;;; @@ -932,6 +932,8 @@ Some ACTIONS support additional ARGS.\n")) (display (G_ " --skip-checks skip file system and initrd module safety checks")) (display (G_ " + --target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\"")) + (display (G_ " -v, --verbosity=LEVEL use the given verbosity LEVEL")) (newline) (display (G_ " @@ -1004,6 +1006,10 @@ Some ACTIONS support additional ARGS.\n")) (lambda (opt name arg result) (alist-cons 'system arg (alist-delete 'system result eq?)))) + (option '("target") #t #f + (lambda (opt name arg result) + (alist-cons 'target arg + (alist-delete 'target result eq?)))) (option '(#\r "root") #t #f (lambda (opt name arg result) (alist-cons 'gc-root arg result))) @@ -1012,6 +1018,7 @@ Some ACTIONS support additional ARGS.\n")) (define %default-options ;; Alist of default option values. `((system . ,(%current-system)) + (target . #f) (substitutes? . #t) (build-hook? . #t) (print-build-trace? . #t) @@ -1045,6 +1052,7 @@ resulting from command-line parsing." ((x . _) x))) (expr (assoc-ref opts 'expression)) (system (assoc-ref opts 'system)) + (target (assoc-ref opts 'target)) (os (ensure-operating-system (or file expr) (cond @@ -1061,7 +1069,7 @@ resulting from command-line parsing." (dry? (assoc-ref opts 'dry-run?)) (bootloader? (assoc-ref opts 'install-bootloader?)) - (target (match args + (target-file (match args ((first second) second) (_ #f))) (bootloader-target @@ -1103,9 +1111,10 @@ resulting from command-line parsing." (_ #f)) opts) #:install-bootloader? bootloader? - #:target target + #:target target-file #:bootloader-target bootloader-target #:gc-root (assoc-ref opts 'gc-root))))) + #:target target #:system system)) (warn-about-disk-space))) diff --git a/guix/utils.scm b/guix/utils.scm index 1f99c5b3f5..c9236ad165 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -78,6 +78,8 @@ package-name->name+version target-mingw? target-arm32? + target-aarch64? + target-arm? target-64bit? version-compare version>? @@ -494,6 +496,12 @@ a character other than '@'." (define (target-arm32?) (string-prefix? "arm" (or (%current-target-system) (%current-system)))) +(define (target-aarch64?) + (string-prefix? "aarch64" (or (%current-target-system) (%current-system)))) + +(define (target-arm?) + (or (target-arm32?) (target-aarch64?))) + (define (target-64bit?) (let ((system (or (%current-target-system) (%current-system)))) (any (cut string-prefix? <> system) '("x86_64" "aarch64" "mips64" "ppc64")))) |