From: Pierre Neidhardt <mail@ambrevar.xyz>
To: 36000@debbugs.gnu.org
Subject: [bug#36000] [PATCH 1/4] guix: Add helper for generating desktop entry files.
Date: Thu, 30 May 2019 09:11:38 +0200 [thread overview]
Message-ID: <20190530071138.31690-1-mail@ambrevar.xyz> (raw)
* guix/build/utils.scm (make-desktop-entry-file): New procedure.
---
guix/build/utils.scm | 99 ++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 99 insertions(+)
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 5fe3286843..21bdc42719 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -1100,6 +1100,105 @@ with definitions for VARS."
(chmod prog-tmp #o755)
(rename-file prog-tmp prog))))
+(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))))))))
+
\f
;;;
;;; Locales.
--
2.21.0
next reply other threads:[~2019-05-30 7:46 UTC|newest]
Thread overview: 15+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-05-30 7:11 Pierre Neidhardt [this message]
2019-05-30 8:17 ` [bug#36000] [PATCH 2/4] gnu: emacs-exwm: Use make-desktop-entry-file Pierre Neidhardt
2019-05-30 8:17 ` [bug#36000] [PATCH 3/4] gnu: tome4: " Pierre Neidhardt
2019-05-30 8:17 ` [bug#36000] [PATCH 4/4] gnu: drascula: " Pierre Neidhardt
[not found] ` <handler.36000.B.155920231822519.ack@debbugs.gnu.org>
2019-10-12 8:43 ` [bug#36000] Acknowledgement ([PATCH 1/4] guix: Add helper for generating desktop entry files.) Pierre Neidhardt
2019-10-12 18:44 ` Efraim Flashner
2019-10-12 19:05 ` Pierre Neidhardt
2019-10-12 19:12 ` Efraim Flashner
2019-10-18 8:43 ` Pierre Neidhardt
2019-10-18 14:40 ` Ludovic Courtès
2019-10-18 15:10 ` Marius Bakke
2019-10-18 15:13 ` Marius Bakke
2019-10-18 15:22 ` Pierre Neidhardt
2019-10-18 15:24 ` Marius Bakke
2019-10-19 10:46 ` Pierre Neidhardt
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20190530071138.31690-1-mail@ambrevar.xyz \
--to=mail@ambrevar.xyz \
--cc=36000@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).