diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/language.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/language.rkt index 30822c63db..604f64d446 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/language.rkt +++ b/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 diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/module-language.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/module-language.rkt index 4d4776cebe..b563e7cb74 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/module-language.rkt +++ b/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 diff --git a/pkgs/drracket-pkgs/drracket/scribblings/drracket/interface-essentials.scrbl b/pkgs/drracket-pkgs/drracket/scribblings/drracket/interface-essentials.scrbl index 5800dee9a0..42539c9647 100644 --- a/pkgs/drracket-pkgs/drracket/scribblings/drracket/interface-essentials.scrbl +++ b/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 diff --git a/pkgs/string-constants-pkgs/string-constants-lib/string-constants/private/english-string-constants.rkt b/pkgs/string-constants-pkgs/string-constants-lib/string-constants/private/english-string-constants.rkt index 0e12b205c2..76ffc7d0a1 100644 --- a/pkgs/string-constants-pkgs/string-constants-lib/string-constants/private/english-string-constants.rkt +++ b/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\".")