From c34dff12472d371a7a54d414195eef84fdc413a4 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 26 Sep 2011 18:06:03 -0600
Subject: [PATCH] add 'wmclass/".wmclass" aux executable/launcher configuration

---
 collects/launcher/launcher-unit.rkt      | 17 +++++++++++++++--
 collects/scribblings/raco/exe-api.scrbl  |  5 ++++-
 collects/scribblings/raco/launcher.scrbl |  3 +++
 3 files changed, 22 insertions(+), 3 deletions(-)

diff --git a/collects/launcher/launcher-unit.rkt b/collects/launcher/launcher-unit.rkt
index 2f15c0f350..57964541d7 100644
--- a/collects/launcher/launcher-unit.rkt
+++ b/collects/launcher/launcher-unit.rkt
@@ -310,6 +310,10 @@
          [x-flags? (and (eq? kind 'mred)
                         (eq? (system-type) 'unix)
                         (not (script-variant? variant)))]
+         [flags (let ([m (assq 'wm-class aux)])
+                  (if m
+                      (list* "-J" (cdr m) flags)
+                      flags))]
          [post-flags (cond
                       [x-flags? (skip-x-flags flags)]
                       [alt-exe null]
@@ -556,7 +560,15 @@
            (with-input-from-file (cdar l)
              (lambda ()
                (let ([d (read)])
-                 (list (cons 'uti-exports d))))))))))
+                 (list (cons 'uti-exports d))))))))
+   (let ([l (try 'wm-class #".wmclass")])
+     (if (null? l)
+         l
+         (with-handlers ([exn:fail:filesystem? (lambda (x) null)])
+           (list (cons 'wm-class 
+                       (regexp-replace #rx"(?:\r\n|\r|\n)$"
+                                       (file->string (cdar l))
+                                       ""))))))))
 
 (define (build-aux-from-path aux-root)
   (let ([aux-root (if (string? aux-root) (string->path aux-root) aux-root)])
@@ -571,7 +583,8 @@
      (try #".lch")
      (try #".creator")
      (try #".filetypes")
-     (try #".utiexports"))))
+     (try #".utiexports")
+     (try #".wmclass"))))
 
 (define (make-gracket-program-launcher file collection dest)
   (make-mred-launcher (list "-l-" (string-append collection "/" file))
diff --git a/collects/scribblings/raco/exe-api.scrbl b/collects/scribblings/raco/exe-api.scrbl
index c7404342e3..13184f47bf 100644
--- a/collects/scribblings/raco/exe-api.scrbl
+++ b/collects/scribblings/raco/exe-api.scrbl
@@ -252,7 +252,7 @@ currently supported keys are as follows:
         executable, instead of a wrapper binary that execs the
         original; the default is @racket[#f].}
 
-  @item{@racket['relative?] (Unix, Windows, Mac OS X): A boolean;
+  @item{@racket['relative?] (Unix, Windows, Mac OS X) : A boolean;
         @racket[#t] means that, to the degree that the generated
         executable must refer to another, it can use a relative path
         (so the executables can be moved together, but not
@@ -260,6 +260,9 @@ currently supported keys are as follows:
         absolute paths should be used (so the generated executable can
         be moved).}
 
+  @item{@racket['wm-class] (Unix) : A string; used as the default
+        @tt{WM_CLASS} program class for the program's windows.}
+
 ]
 
 If the @racket[#:collects-path] argument is @racket[#f], then the
diff --git a/collects/scribblings/raco/launcher.scrbl b/collects/scribblings/raco/launcher.scrbl
index bd89a3cef0..226679d767 100644
--- a/collects/scribblings/raco/launcher.scrbl
+++ b/collects/scribblings/raco/launcher.scrbl
@@ -340,6 +340,9 @@ are as follows:
        @racket[read] content (a single S-expression); for use on
        Mac OS X}
 
+ @item{@filepath{.wmclass} @'rarr @racket['wm-class] as the literal
+       content, removing a trailing newline if any; for use on Unix}
+
 ]}
 
 @defparam[current-launcher-variant variant symbol?]{