Windows installer: offer to auto-launch DrRacket
The 'start-menu? aux key for launcher creation changed to 'start-menu, with a real-number value indicating a request and precedence for auto-launching (where a precedence is needed because only one application can be auto-launched).
This commit is contained in:
parent
82fc9622ee
commit
81079b3a02
|
@ -29,6 +29,15 @@
|
||||||
(get-exe-actions src-dir "startmenu.rktd"
|
(get-exe-actions src-dir "startmenu.rktd"
|
||||||
(lambda (k v) k)))
|
(lambda (k v) k)))
|
||||||
|
|
||||||
|
(define (get-auto-launch src-dir)
|
||||||
|
(define l
|
||||||
|
(filter (lambda (p) (real? (cdr p)))
|
||||||
|
(get-exe-actions src-dir "startmenu.rktd"
|
||||||
|
cons)))
|
||||||
|
(if (null? l)
|
||||||
|
#f
|
||||||
|
(path-replace-suffix (caar (sort l < #:key cdr)) #"")))
|
||||||
|
|
||||||
(define (try-exe f)
|
(define (try-exe f)
|
||||||
(and (file-exists? f) f))
|
(and (file-exists? f) f))
|
||||||
|
|
||||||
|
@ -419,5 +428,6 @@ SectionEnd
|
||||||
makensis
|
makensis
|
||||||
#:release release?
|
#:release release?
|
||||||
#:extension-registers (get-extreg "bundle/racket")
|
#:extension-registers (get-extreg "bundle/racket")
|
||||||
#:start-menus (get-startmenu "bundle/racket"))
|
#:start-menus (get-startmenu "bundle/racket")
|
||||||
|
#:auto-launch (get-auto-launch "bundle/racket"))
|
||||||
exe-path)
|
exe-path)
|
||||||
|
|
|
@ -1 +1,6 @@
|
||||||
|
10
|
||||||
Existence of this file puts DrRacket in the Windows Start menu.
|
Existence of this file puts DrRacket in the Windows Start menu.
|
||||||
|
The fact that it starts with a number requests that the
|
||||||
|
installer offers to run DrRacket as its final action, and the
|
||||||
|
value of the number is a predence for that request relative
|
||||||
|
to other requests.
|
||||||
|
|
|
@ -68,10 +68,14 @@ the following additional associations apply to launchers:
|
||||||
@racket[#t] means that the generated launcher should find the
|
@racket[#t] means that the generated launcher should find the
|
||||||
base GRacket executable through a relative path.}
|
base GRacket executable through a relative path.}
|
||||||
|
|
||||||
@item{@racket['start-menu?] (Windows) --- a boolean; @racket[#t]
|
@item{@racket['start-menu] (Windows) --- a boolean or real number;
|
||||||
indicates that the launcher should be in the @onscreen{Start}
|
@racket[#t] indicates that the launcher should be in the
|
||||||
menu by an installer that includes the launcher. A
|
@onscreen{Start} menu by an installer that includes the
|
||||||
@racket['start-menu?] value is used only when
|
launcher. A number value is treated like @racket[#t], but also
|
||||||
|
requests that the installer automatically start the
|
||||||
|
application, where the number determines a precedence relative
|
||||||
|
to other launchers that may request starting. A
|
||||||
|
@racket['start-menu] value is used only when
|
||||||
@racket['install-mode] is also specified.}
|
@racket['install-mode] is also specified.}
|
||||||
|
|
||||||
@item{@racket['extension-register] (Windows) --- a list of document
|
@item{@racket['extension-register] (Windows) --- a list of document
|
||||||
|
@ -108,7 +112,7 @@ the following additional associations apply to launchers:
|
||||||
@racket['main], indicates whether the launcher is being
|
@racket['main], indicates whether the launcher is being
|
||||||
installed to a user-specific place or an installation-wide
|
installed to a user-specific place or an installation-wide
|
||||||
place, which in turn determines where to record
|
place, which in turn determines where to record
|
||||||
@racket['start-menu?] and @racket['extension-registry]
|
@racket['start-menu] and @racket['extension-registry]
|
||||||
information.}
|
information.}
|
||||||
|
|
||||||
]
|
]
|
||||||
|
@ -402,8 +406,9 @@ are as follows:
|
||||||
@item{@filepath{.wmclass} @'rarr @racket['wm-class] as the literal
|
@item{@filepath{.wmclass} @'rarr @racket['wm-class] as the literal
|
||||||
content, removing a trailing newline if any; for use on Unix}
|
content, removing a trailing newline if any; for use on Unix}
|
||||||
|
|
||||||
@item{@filepath{.startmenu} @'rarr @racket['start-menu?] as @racket[#t]
|
@item{@filepath{.startmenu} @'rarr @racket['start-menu] as the file
|
||||||
(the file content is ignored) for use on Windows}
|
content if it @racket[read]s as a real number, @racket[#t]
|
||||||
|
otherwise, for use on Windows}
|
||||||
|
|
||||||
@item{@filepath{.extreg} @'rarr @racket['extension-register] as
|
@item{@filepath{.extreg} @'rarr @racket['extension-register] as
|
||||||
@racket[read] content (a single S-expression), but with
|
@racket[read] content (a single S-expression), but with
|
||||||
|
|
|
@ -407,13 +407,13 @@
|
||||||
e)))
|
e)))
|
||||||
(cdr m)))))
|
(cdr m)))))
|
||||||
;; record Windows start-menu requests, if any
|
;; record Windows start-menu requests, if any
|
||||||
(let ([m (assoc 'start-menu? aux)])
|
(let ([m (assoc 'start-menu aux)])
|
||||||
(when (and m (cdr m))
|
(when (and m (cdr m))
|
||||||
(update-register (cdr im)
|
(update-register (cdr im)
|
||||||
"startmenu.rktd"
|
"startmenu.rktd"
|
||||||
(path-element->string
|
(path-element->string
|
||||||
(file-name-from-path dest))
|
(file-name-from-path dest))
|
||||||
#t))))))
|
(cdr m)))))))
|
||||||
|
|
||||||
(define (update-register mode filename key val)
|
(define (update-register mode filename key val)
|
||||||
(define dir (if (eq? mode 'main)
|
(define dir (if (eq? mode 'main)
|
||||||
|
@ -655,7 +655,18 @@
|
||||||
(path-only
|
(path-only
|
||||||
(path->complete-path path)))
|
(path->complete-path path)))
|
||||||
e)))))))))))
|
e)))))))))))
|
||||||
(try 'start-menu? #".startmenu")
|
(let ([l (try 'start-menu #".startmenu")])
|
||||||
|
(if (null? l)
|
||||||
|
l
|
||||||
|
(with-handlers ([exn:fail:filesystem? (lambda (x) (log-fail l x) null)])
|
||||||
|
(with-input-from-file (cdar l)
|
||||||
|
(lambda ()
|
||||||
|
(list
|
||||||
|
(cons 'start-menu
|
||||||
|
(let ([d (read)])
|
||||||
|
(if (real? d)
|
||||||
|
d
|
||||||
|
#t)))))))))
|
||||||
(let ([l (try 'wm-class #".wmclass")])
|
(let ([l (try 'wm-class #".wmclass")])
|
||||||
(if (null? l)
|
(if (null? l)
|
||||||
l
|
l
|
||||||
|
|
Loading…
Reference in New Issue
Block a user