DrRacket: add support for icon files, etc. for created executables
This commit is contained in:
Matthew Flatt
parent
ae6fc3f47f
commit
28fbd2dde2
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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\".")
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user