DrRacket: add support for icon files, etc. for created executables

pkgs/drracket-pkgs/drracket/drracket/private/language.rkt

@@ -694,6 +694,7 @@
         (let* ([type (car executable-specs)]
                [base (cadr executable-specs)]
                [executable-filename (caddr executable-specs)]
+               [aux (cadddr executable-specs)]
                [create-executable
                 (case type
                   [(launcher) create-module-based-launcher]
@@ -729,7 +730,8 @@
   ;;                         (union #t 'mzscheme 'mred)
   ;;                      -> (union #f (list (union 'no-show 'launcher 'stand-alone 'distribution)
   ;;                                         (union 'no-show 'mzscheme 'mred)
-  ;;                                         string[filename]))
+  ;;                                         string[filename]
+  ;;                                         (listof (cons/c symbol? any/c))))
   (define (create-executable-gui parent program-filename show-type show-base)
     (define dlg (make-object dialog% (string-constant create-executable-title) parent))
     (define filename-panel (make-object horizontal-panel% dlg))
@@ -779,6 +781,53 @@
                                                           [(1) 'gracket]))
                                        (reset-filename-suffix))))))
     
+    (define aux-panel (new group-box-panel%
+                           [label ""]
+                           [parent type/base-panel]))
+    (define aux-paths (new (class list-box%
+                             (inherit append)
+                             (super-new)
+                             (define/override (on-drop-file p)
+                               (add-aux p)))
+                           [parent aux-panel]
+                           [label (string-constant files-for-icons-etc)]
+                           [choices '()]
+                           [style '(vertical-label multiple)]
+                           [min-height 80]
+                           [callback (lambda (p e) (enable-minus))]))
+    (send aux-paths accept-drop-files #t)
+    (define aux-button-panel (new horizontal-pane%
+                                  [parent aux-panel]
+                                  [alignment '(center center)]
+                                  [stretchable-height #f]))
+    (new button%
+         [parent aux-button-panel]
+         [label "+"]
+         [callback (lambda (b e)
+                     (define p (get-file-list #f dlg))
+                     (when p
+                       (for-each add-aux p)))])
+    (define (add-aux p)
+      (define v (extract-aux-from-path p))
+      (send aux-paths append 
+            (format "~a: ~a"
+                    (if (null? v)
+                        "???"
+                        (caar v))
+                    p)
+            p))
+    (define minus-button
+      (new button%
+           [parent aux-button-panel]
+           [label "-"]
+           [callback (lambda (b e)
+                       (for ([i (in-list (sort (send aux-paths get-selections) >))])
+                         (send aux-paths delete i))
+                       (enable-minus))]))
+    (define (enable-minus)
+      (send minus-button enable (pair? (send aux-paths get-selections))))
+    (enable-minus)
+    
     (define (reset-filename-suffix)
       (let ([s (send filename-text-field get-value)])
         (unless (string=? s "")
@@ -905,7 +954,10 @@
               [(0) 'mzscheme]
               [(1) 'mred])
             'no-show)
-        (send filename-text-field get-value))]))
+        (send filename-text-field get-value)
+        (apply append
+               (for/list ([i (in-range (send aux-paths get-number))])
+                 (extract-aux-from-path (send aux-paths get-data i)))))]))
   
   (define (normalize-mode mode)
     (case mode

pkgs/drracket-pkgs/drracket/drracket/private/module-language.rkt

@@ -527,7 +527,8 @@
           (when executable-specs
             (let ([executable-type (list-ref executable-specs 0)]
                   [gui? (eq? 'mred (list-ref executable-specs 1))]
-                  [executable-filename (list-ref executable-specs 2)])
+                  [executable-filename (list-ref executable-specs 2)]
+                  [aux (list-ref executable-specs 3)])
               (with-handlers ([(λ (x) #f) ;exn:fail?
                                (λ (x)
                                  (message-box
@@ -543,6 +544,7 @@
                            (create-embedding-executable
                             exe-name
                             #:gracket? gui?
+                            #:aux aux
                             #:verbose? #f
                             #:modules (list (list #f program-filename))
                             #:configure-via-first-module? #t

pkgs/drracket-pkgs/drracket/scribblings/drracket/interface-essentials.scrbl

@@ -1,7 +1,7 @@
 #lang scribble/doc
 @(require "common.rkt"
           scribble/decode scribble/eval scribble/struct scribble/racket
-          (for-label racket/gui/base framework)
+          (for-label racket/gui/base framework compiler/embed)
           setup/getinfo racket/pretty string-constants)
 
 @(define (ioinputfont . s)
@@ -902,6 +902,29 @@ disable debugging, open the language dialog, click the @onscreen{Show
 Details} button, and select @onscreen{No debugging or profiling}, if
 it is available.
 
+When you create an executable in some languages, you can supply
+additional files to determine the executable's icon and similar
+properties, depending on the platform. The file's purpose is
+determined by its suffix:
+
+@itemlist[
+
+ @item{On Windows, supply an @filepath{.ico} file for an icon. Only
+       16x16, 32x32, or 48x48 images from the @filepath{.ico} file are
+       used.}
+
+ @item{On Mac OS X, supply an @filepath{.icns} file for an icon.  You
+       can set the application's creator with an @filepath{.creator}
+       file (whose first four bytes are used), and you can set
+       documents for the application through a @filepath{.utiexports}
+       file (see @racket['uti-exports] in
+       @racket[create-embedding-executable] for more information).}
+
+ @item{On Unix, supply a @filepath{.png} or @filepath{.ico} file for
+       an icon.}
+
+]
+
 @section[#:tag "follow-log"]{Following Log Messages}
 
 The @onscreen{Show Log} menu item in the @onscreen{View} menu opens

pkgs/string-constants-pkgs/string-constants-lib/string-constants/private/english-string-constants.rkt

@@ -1076,6 +1076,7 @@ please adhere to these guidelines:
  (executable-base "Base")
  (filename "Filename: ")
  (create "Create")
+ (files-for-icons-etc "Files for icons, etc.")
  (please-specify-a-filename "Please specify a filename to create.")
  (~a-must-end-with-~a
   "The ~a filename\n\n  ~a\n\nis illegal. The filename must end with \".~a\".")