mirror of
https://gitlab.com/nonguix/nonguix.git
synced 2024-12-23 15:24:52 +01:00
utils: Remove 'make-desktop-entry-file' function now that it's upstream.
* nonguix/build/utils.scm (make-desktop-entry-file): Remove function.
This commit is contained in:
parent
702ab8c308
commit
12210f2393
1 changed files with 0 additions and 100 deletions
|
@ -23,7 +23,6 @@
|
||||||
#:use-module (guix build utils)
|
#:use-module (guix build utils)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:export (64-bit?
|
#:export (64-bit?
|
||||||
make-desktop-entry-file
|
|
||||||
make-wrapper
|
make-wrapper
|
||||||
concatenate-files))
|
concatenate-files))
|
||||||
|
|
||||||
|
@ -36,105 +35,6 @@ See https://en.wikipedia.org/wiki/Executable_and_Linkable_Format#File_header."
|
||||||
(array-ref (get-bytevector-n (current-input-port) 5) 4)))
|
(array-ref (get-bytevector-n (current-input-port) 5) 4)))
|
||||||
#:binary #t))
|
#:binary #t))
|
||||||
|
|
||||||
(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))))))))
|
|
||||||
|
|
||||||
(define* (make-wrapper wrapper real-file #:rest vars)
|
(define* (make-wrapper wrapper real-file #:rest vars)
|
||||||
"Like `wrap-program' but create WRAPPER around REAL-FILE.
|
"Like `wrap-program' but create WRAPPER around REAL-FILE.
|
||||||
The wrapper automatically changes directory to that of REAL-FILE.
|
The wrapper automatically changes directory to that of REAL-FILE.
|
||||||
|
|
Loading…
Reference in a new issue