Subject: [PATCH] gnu: racket: Backport fix for .desktop files.
From: Philip McGrath <[email-masked]>
To: [email-masked]
Cc: Philip McGrath <[email-masked]>
Date: Wed, 5 Jan 2022 01:06:31 -0500
List-Id: <debbugs-submit.debbugs.gnu.org>

This commit backports a repair by Matthew Flatt for Racket's
creation and installation of '.desktop' files in tethered Racket
installations. Guix's 'racket' package is structured as a tethered
installation, so the Guix package now installs 'drracket.desktop'
and 'slideshow.desktop' properly, for example. For further upstream
discussion, see: <https://github.com/racket/racket/issues/4079>.

* gnu/packages/patches/racket-minimal-backport-4079-fix.patch: New
patch.
* gnu/local.mk (dist_patch_DATA): Add it.
* gnu/packages/racket.scm (racket-minimal)[source]: Use it.
(extend-layer): Set config-tethered-apps-dir.
---

Guix is a significant use-case for this functionality in Racket, so it would
be great to have more Guix users confirm that these repairs fully solve the
problem before the upcoming Racket 8.4 release.

 gnu/local.mk                                  |   1 +
 .../racket-minimal-backport-4079-fix.patch    | 318 ++++++++++++++++++
 gnu/packages/racket.scm                       |  15 +-
 3 files changed, 330 insertions(+), 4 deletions(-)
 create mode 100644 gnu/packages/patches/racket-minimal-backport-4079-fix.patch

diff --git a/gnu/local.mk b/gnu/local.mk
index c8ec622aa1..008583d0f5 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1748,6 +1748,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/ripperx-missing-file.patch		\
   %D%/packages/patches/rpcbind-CVE-2017-8779.patch		\
   %D%/packages/patches/rtags-separate-rct.patch			\
+  %D%/packages/patches/racket-minimal-backport-4079-fix.patch	\
   %D%/packages/patches/racket-minimal-sh-via-rktio.patch	\
   %D%/packages/patches/remake-impure-dirs.patch			\
   %D%/packages/patches/restic-0.9.6-fix-tests-for-go1.15.patch	\
diff --git a/gnu/packages/patches/racket-minimal-backport-4079-fix.patch b/gnu/packages/patches/racket-minimal-backport-4079-fix.patch
new file mode 100644
index 0000000000..8af48476e0
--- /dev/null
+++ b/gnu/packages/patches/racket-minimal-backport-4079-fix.patch
@@ -0,0 +1,318 @@
+From 05263c7b306e156f256942bd5a099d17846b5d30 Mon Sep 17 00:00:00 2001
+From: Matthew Flatt <[email-masked]>
+Date: Mon, 3 Jan 2022 13:53:30 -0700
+Subject: [PATCH 1/2] config: add '{config,addon}-tethered-apps-dir
+
+Support ".desktop" files in a tethered layer.
+
+Addresses #4079
+
+(cherry picked from commit 11ccee31d6c0903720250655fda3f7ed879769e8)
+---
+ .../scribblings/raco/launcher.scrbl           | 13 ++++--
+ pkgs/racket-doc/scribblings/raco/setup.scrbl  | 43 ++++++++++++-------
+ racket/collects/launcher/launcher.rkt         | 39 ++++++++++-------
+ racket/collects/setup/dirs.rkt                | 13 +++++-
+ racket/collects/setup/private/dirs.rkt        |  2 +
+ 5 files changed, 75 insertions(+), 35 deletions(-)
+
+diff --git a/pkgs/racket-doc/scribblings/raco/launcher.scrbl b/pkgs/racket-doc/scribblings/raco/launcher.scrbl
+index daece40c57..9a94a624b5 100644
+--- a/pkgs/racket-doc/scribblings/raco/launcher.scrbl
++++ b/pkgs/racket-doc/scribblings/raco/launcher.scrbl
+@@ -415,14 +415,21 @@ Backward-compatible aliases for
+ @history[#:changed "6.5.0.2" @elem{Added the @racket[#:tethered?] argument.}]}
+ 
+ 
+-@defproc[(installed-executable-path->desktop-path [exec-path path-string?] [user? any/c])
+-         (and/c path? complete-path?)]{
++@defproc[(installed-executable-path->desktop-path [exec-path path-string?] [user? any/c] [tethered? any/c])
++         (or/c (and/c path? complete-path?) #f)]{
+ 
+ Returns a path for a @filepath{.desktop} file to describe the
+ installed executable at @racket[exec-path]. Only the filename part of
+ @racket[exec-path] is used. The @racket[user?] argument should be true
+ if @racket[exec-path] is installed in a user-specific location (in
+-which case the result path will also be user-specific).}
++which case the result path will also be user-specific). The
++@racket[tethered?] argument should be true for a @tech{tethered}
++install. The result can be @racket[#f] only when @racket[tethered?] is
++true and @racket[find-addon-tethered-apps-dir] (when @racket[user?] is
++true) or @racket[find-config-tethered-apps-dir] (when @racket[user?] is
++@racket[#f]) returns @racket[#f].
++
++@history[#:changed "8.3.0.11" @elem{Added the @racket[tethered?] argument.}]}
+ 
+ 
+ @defproc[(installed-desktop-path->icon-path [desktop-path path-string?]
+diff --git a/pkgs/racket-doc/scribblings/raco/setup.scrbl b/pkgs/racket-doc/scribblings/raco/setup.scrbl
+index f1d2b99c52..f7d1051419 100644
+--- a/pkgs/racket-doc/scribblings/raco/setup.scrbl
++++ b/pkgs/racket-doc/scribblings/raco/setup.scrbl
+@@ -1775,9 +1775,11 @@ current-system paths while @racket[get-cross-lib-search-dirs] and
+ @deftogether[(
+ @defproc[(find-addon-tethered-console-bin-dir) (or/c #f path?)]
+ @defproc[(find-addon-tethered-gui-bin-dir) (or/c #f path?)]
++@defproc[(find-addon-tethered-apps-dir) (or/c #f path?)]
+ )]{
+   Returns a path to a user-specific directory to hold an extra copy of
+-  each installed executable, where the extra copy is created by
++  each installed executable and @filepath{.desktop}
++  file (for Unix), where the extra copy is created by
+   @exec{raco setup} and tethered to a particular result for
+   @racket[(find-system-path 'addon-dir)] and
+   @racket[(find-config-dir)].
+@@ -1785,33 +1787,39 @@ current-system paths while @racket[get-cross-lib-search-dirs] and
+   Unlike other directories, which are configured via
+   @filepath{config.rktd} in the @racket[(find-config-dir)] directory
+   (see @secref["config-file"]), these paths are configured via
+-  @racket['addon-tethered-console-bin-dir] and
+-  @racket['addon-tethered-gui-bin-dir] entries in
++  @racket['addon-tethered-console-bin-dir],
++  @racket['addon-tethered-gui-bin-dir], and
++  @racket['addon-tethered-apps-dir] entries in
+   @filepath{config.rktd} in @racket[(build-path (find-system-path
+   'addon-dir) "etc")]. If no configuration is present, the result from
+   the corresponding function,
+-  @racket[find-addon-tethered-console-bin-dir] or
+-  @racket[find-addon-tethered-gui-bin-dir], is @racket[#f] instead of
++  @racket[find-addon-tethered-console-bin-dir],
++  @racket[find-addon-tethered-gui-bin-dir], or
++  @racket[find-addon-tethered-apps-dir], is @racket[#f] instead of
+   a path.
+ 
+   See @secref["tethered-install"] for more information.
+ 
+-  @history[#:added "6.5.0.2"]}
++  @history[#:added "6.5.0.2"
++           #:changed "8.3.0.11" @elem{Added @racket[find-addon-tethered-apps-dir].}]]}
+ 
+ 
+ @deftogether[(
+ @defproc[(find-config-tethered-console-bin-dir) (or/c #f path?)]
+ @defproc[(find-config-tethered-gui-bin-dir) (or/c #f path?)]
++@defproc[(find-config-tethered-apps-dir) (or/c #f path?)]
+ )]{
+-  Similar to @racket[find-addon-tethered-console-bin-dir] and
+-  @racket[find-addon-tethered-gui-bin-dir], but configured via
++  Similar to @racket[find-addon-tethered-console-bin-dir],
++  @racket[find-addon-tethered-gui-bin-dir], and
++  @racket[find-addon-tethered-apps-dir], but configured via
+   @filepath{config.rktd} in the @racket[(find-config-dir)] directory
+   (see @secref["config-file"]) and triggers executables that are
+   tethered only to a particular value of @racket[(find-config-dir)].
+ 
+   See @secref["tethered-install"] for more information.
+ 
+-  @history[#:added "6.5.0.2"]}
++  @history[#:added "6.5.0.2"
++           #:changed "8.3.0.11" @elem{Added @racket[find-addon-tethered-apps-dir].}]}
+  
+ @; ------------------------------------------------------------------------
+ 
+@@ -2578,9 +2586,11 @@ layer:
+        directory @nonterm{addon-dir} and a
+        @filepath{@nonterm{addon-dir}/etc/config.rktd} file that maps
+        @racket['addon-tethered-console-bin-dir] to
+-       @nonterm{tethered-bin-dir} and
++       @nonterm{tethered-bin-dir},
+        @racket['addon-tethered-gui-bin-dir] to
+-       @nonterm{tethered-gui-bin-dir}. Initialize the tethered layer
++       @nonterm{tethered-gui-bin-dir}, and (optionally)
++       @racket['addon-tethered-apps-dir] to
++       @nonterm{tethered-apps-dir}. Initialize the tethered layer
+        with
+ 
+        @commandline{racket -A @nonterm{addon-dir} -l- raco setup --avoid-main}}
+@@ -2588,10 +2598,12 @@ layer:
+  @item{An @defterm{installation} layer with tethering is like a one
+        without tethering (see @secref["layered-install"]), but where
+        the layer's @filepath{@nonterm{layer-dir}/etc/config.rktd} file
+-       that maps @racket['config-tethered-console-bin-dir] to
+-       @nonterm{tethered-bin-dir} and
++       maps @racket['config-tethered-console-bin-dir] to
++       @nonterm{tethered-bin-dir},
+        @racket['config-tethered-gui-bin-dir] to
+-       @nonterm{tethered-gui-bin-dir}. The @racket['bin-dir] and
++       @nonterm{tethered-gui-bin-dir}, and (optionally)
++       @racket['config-tethered-apps-dir] to
++       @nonterm{tethered-apps-dir}. The @racket['bin-dir] and
+        @racket['gui-bin-dir] configurations can point to the same
+        directories, but executables are not specifically created there by
+        @exec{raco setup}. Initialize the tethered layer with
+@@ -2602,7 +2614,8 @@ layer:
+ 
+ In either case, initialization creates tethered executables in the
+ directories @nonterm{tethered-bin-dir} and
+-@nonterm{tethered-gui-bin-dir}. Thereafter, tethered executables like
++@nonterm{tethered-gui-bin-dir}, writing @filepath{.desktop} files
++(for Unix) in @nonterm{tethered-apps-dir} (if specified). Thereafter, tethered executables like
+ @exec{@nonterm{tethered-bin-dir}/racket} and
+ @exec{@nonterm{tethered-bin-dir}/raco} can be used to work with the
+ tethered layer.
+diff --git a/racket/collects/launcher/launcher.rkt b/racket/collects/launcher/launcher.rkt
+index e48cd623cc..ca8d64745d 100644
+--- a/racket/collects/launcher/launcher.rkt
++++ b/racket/collects/launcher/launcher.rkt
+@@ -530,18 +530,23 @@
+                             (file-name-from-path dest))
+                            (cdr m)))))))
+ 
+-(define (installed-executable-path->desktop-path dest user?)
++(define (installed-executable-path->desktop-path dest user? tethered?)
+   (unless (path-string? dest)
+     (raise-argument-error 'installed-executable-path->desktop-path
+                           "path-string?"
+                           dest))
+-  (define dir (if user?
+-                  (find-user-apps-dir)
+-                  (or (find-apps-dir)
+-                      (error 'installed-executable-path->desktop-path
+-                             "no installation directory is available"))))
+-  (path-replace-extension (build-path dir (file-name-from-path dest))
+-                          #".desktop"))
++  (define dir (if tethered?
++                  (if user?
++                      (find-addon-tethered-apps-dir)
++                      (find-config-tethered-apps-dir))
++                  (if user?
++                      (find-user-apps-dir)
++                      (or (find-apps-dir)
++                          (error 'installed-executable-path->desktop-path
++                                 "no installation directory is available")))))
++  (and dir
++       (path-replace-extension (build-path dir (file-name-from-path dest))
++                               #".desktop")))
+ 
+ (define (installed-desktop-path->icon-path dest user? extension)
+   ;; We put icons files in "share" so that `setup/unixstyle-install'
+@@ -566,13 +571,16 @@
+ (define (check-desktop aux dest)
+   (when (eq? 'unix (cross-system-type))
+     (let ([im (assoc 'install-mode aux)])
+-      (when (and im (member (cdr im) '(main user)))
+-        (define user? (eq? (cdr im) 'user))
+-        ;; create Unix ".desktop" files, if any
+-        (let ([m (assoc 'desktop aux)])
+-          (when (and m (cdr m))
+-            (define file (installed-executable-path->desktop-path dest
+-                                                                  user?))
++      (define addon? (and im (eq? (cdr im) 'addon-tethered)))
++      (define config? (and im (eq? (cdr im) 'config-tethered)))
++      (define user? (or addon? (and im (eq? (cdr im) 'user))))
++      ;; create Unix ".desktop" files, if any
++      (let ([m (assoc 'desktop aux)])
++        (when (and m (cdr m))
++          (define file (installed-executable-path->desktop-path dest
++                                                                user?
++                                                                (or addon? config?)))
++          (when file
+             (make-directory* (path-only file))
+             (define (adjust-path p)
+               ;; A ".desktop" file is supposed to have absolute paths
+@@ -582,6 +590,7 @@
+               ;; and be patched up by `setup/unixstyle-install'.
+               (let ([p (simple-form-path (path->complete-path p))])
+                 (if (or user?
++                        config?
+                         (get-absolute-installation?))
+                     p
+                     (find-relative-path (simple-form-path (path-only file)) p))))
+diff --git a/racket/collects/setup/dirs.rkt b/racket/collects/setup/dirs.rkt
+index 3721a8fabe..0a6469f1e7 100644
+--- a/racket/collects/setup/dirs.rkt
++++ b/racket/collects/setup/dirs.rkt
+@@ -14,6 +14,7 @@
+                      config:gui-bin-search-dirs
+                      config:config-tethered-console-bin-dir
+                      config:config-tethered-gui-bin-dir
++                     config:config-tethered-apps-dir
+                      config:lib-search-dirs
+                      config:share-search-dirs
+                      config:man-search-dirs
+@@ -45,7 +46,8 @@
+     [(unix) "bin"]))
+ 
+ (provide find-config-tethered-console-bin-dir
+-         find-config-tethered-gui-bin-dir)
++         find-config-tethered-gui-bin-dir
++         find-config-tethered-apps-dir)
+ 
+ (define (find-config-tethered-console-bin-dir)
+   (force config:config-tethered-console-bin-dir))
+@@ -53,8 +55,12 @@
+ (define (find-config-tethered-gui-bin-dir)
+   (force config:config-tethered-gui-bin-dir))
+ 
++(define (find-config-tethered-apps-dir)
++  (force config:config-tethered-apps-dir))
++
+ (provide find-addon-tethered-console-bin-dir
+-         find-addon-tethered-gui-bin-dir)
++         find-addon-tethered-gui-bin-dir
++         find-addon-tethered-apps-dir)
+ 
+ (define addon-bin-table
+   (delay/sync
+@@ -87,6 +93,9 @@
+ (define (find-addon-tethered-gui-bin-dir)
+   (find-addon-bin-dir 'addon-tethered-gui-bin-dir))
+ 
++(define (find-addon-tethered-apps-dir)
++  (find-addon-bin-dir 'addon-tethered-apps-dir))
++
+ ;; ----------------------------------------
+ ;; Extra search paths
+ 
+diff --git a/racket/collects/setup/private/dirs.rkt b/racket/collects/setup/private/dirs.rkt
+index 745e9c0f59..fa1477d627 100644
+--- a/racket/collects/setup/private/dirs.rkt
++++ b/racket/collects/setup/private/dirs.rkt
+@@ -73,6 +73,7 @@
+ (define config:gui-bin-search-dirs (delay/sync (or (force config:gui-bin-search-dirs/raw) (force config:bin-search-dirs))))
+ (define-config config:config-tethered-console-bin-dir 'config-tethered-console-bin-dir to-path)
+ (define-config config:config-tethered-gui-bin-dir 'config-tethered-gui-bin-dir to-path)
++(define-config config:config-tethered-apps-dir 'config-tethered-apps-dir to-path)
+ (define-config config:man-dir 'man-dir to-path)
+ (define-config config:man-search-dirs 'man-search-dirs to-path)
+ (define-config config:links-file 'links-file to-path)
+@@ -289,6 +290,7 @@
+          config:gui-bin-dir
+          config:config-tethered-console-bin-dir
+          config:config-tethered-gui-bin-dir
++         config:config-tethered-apps-dir
+          config:bin-search-dirs
+          config:gui-bin-search-dirs)
+ 
+-- 
+2.32.0
+
+
+From 61d31acc4f5a12b648dd1d4bba4811ccd95d7568 Mon Sep 17 00:00:00 2001
+From: Matthew Flatt <[email-masked]>
+Date: Tue, 4 Jan 2022 10:52:42 -0700
+Subject: [PATCH 2/2] launcher: fix new argument that is meant to be optional
+
+Repairs a problem with 11ccee31d6.
+
+(cherry picked from commit ece8b17fd6ea05268a647ff8810d0acee1f3b5e3)
+---
+ racket/collects/launcher/launcher.rkt | 2 +-
+ 1 file changed, 1 insertion(+), 1 deletion(-)
+
+diff --git a/racket/collects/launcher/launcher.rkt b/racket/collects/launcher/launcher.rkt
+index ca8d64745d..e2b03c6b0b 100644
+--- a/racket/collects/launcher/launcher.rkt
++++ b/racket/collects/launcher/launcher.rkt
+@@ -530,7 +530,7 @@
+                             (file-name-from-path dest))
+                            (cdr m)))))))
+ 
+-(define (installed-executable-path->desktop-path dest user? tethered?)
++(define (installed-executable-path->desktop-path dest user? [tethered? #f])
+   (unless (path-string? dest)
+     (raise-argument-error 'installed-executable-path->desktop-path
+                           "path-string?"
+-- 
+2.32.0
+
diff --git a/gnu/packages/racket.scm b/gnu/packages/racket.scm
index d0a5ca494b..1d834e5a39 100644
--- a/gnu/packages/racket.scm
+++ b/gnu/packages/racket.scm
@@ -139,7 +139,13 @@ (define-public racket-minimal
        (sha256
         "1i1jnv1wb0kanfg47hniafx2vhwjc33qqx66lq7wkf5hbmgsyws3")
        (file-name (git-file-name name version))
-       (patches (search-patches "racket-minimal-sh-via-rktio.patch"))
+       (patches (search-patches "racket-minimal-sh-via-rktio.patch"
+                                ;; The following patch backports a repair
+                                ;; for generating .desktop files, motivated in
+                                ;; part by Guix: it should no longer be needed
+                                ;; by Racket 8.4. See upstream discussion at:
+                                ;; https://github.com/racket/racket/issues/4079
+                                "racket-minimal-backport-4079-fix.patch"))
        (modules '((guix build utils)))
        (snippet
         (with-imported-modules '((guix build utils))
@@ -589,9 +595,10 @@ (define rx:racket
                                  (build-path-string parent-layer pth))
                        (filter values (hash-ref config search-key null)))))]
              [config
-              (hash-set config
-                        'apps-dir
-                        (build-path-string prefix "share/applications"))]
+              (let ([apps-dir (build-path-string prefix "share/applications")])
+                (hash-set* config
+                           'apps-dir apps-dir
+                           'config-tethered-apps-dir apps-dir))]
              [config
               ;; place new foreign lib-search-dirs before old
               ;; foreign dirs, but after Racket layers
-- 
2.32.0