suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add ".desktop" file support

Browse Source 
A launcher can have a ".desktop" file (found like other files: as the
same name as the main launcher file, but with a ".desktop" suffix),
where the "Exec" and "Icon" fields are added automatically. A ".png"
or ".ico" file can be supplied for the icon (where the ".ico" file
is already used for Windows launchers).

Closes PR 13953

Fix various problems with Unix-style install from an installer.

Also, add an ugly icon for the Racket Package Manager, with the hope
that it will provoke someone to create a nicer one.
This commit is contained in:
Matthew Flatt 2013-08-10 08:46:43 -06:00
parent 082f21c5f8
commit 58c0074a71
19 changed files with 373 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
pkgs/distro-build/unix-installer/installer-header
View File

@ -159,13 +159,14 @@ esac
set_dirs() {
# unixstyle: uses all of these
# wholedir: uses only bindir & mandir, no need for the others
# wholedir: uses only bindir, mandir, and appsdir, no need for the others
bindir="$1/bin"
libdir="$1/lib"
incrktdir="$1/include/$TARGET"
librktdir="$1/lib/$TARGET"
sharerktdir="$1/share/$TARGET"
configdir="$1/etc/$TARGET"
appsdir="$1/share/applications"
has_share="N"
if test -d "$1/share"; then has_share="Y"; fi
if test "$has_share" = "N" && test -d "$1/doc"; then docdir="$1/doc/$TARGET"
@ -242,10 +243,10 @@ wholedir_install() {
rm_on_abort=""
echo ""
echo "If you want to install new system links within the \"bin\" and"
echo " \"man\" subdirectories of a common directory prefix (for example,"
echo " \"/usr/local\") then enter the prefix of an existing directory"
echo " that you want to use. This might overwrite existing symlinks,"
echo "If you want to install new system links within the \"bin\", \"man\""
echo " and \"share/applications\" subdirectories of a common directory prefix"
echo " (for example, \"/usr/local\") then enter the prefix of an existing"
echo " directory that you want to use. This might overwrite existing symlinks,"
echo " but not files."
echon "(default: skip links) > "
read SYSDIR
@ -280,6 +281,7 @@ wholedir_install() {
}
install_links "$bindir" "bin"
install_links "$mandir/man1" "man/man1"
install_links "$appsdir" "share/applications"
fi
}
@ -330,11 +332,12 @@ unixstyle_install() {
show_dir_var "[e] Executables " "$bindir"
show_dir_var "[o] Libraries " "$librktdir"
show_dir_var "[s] Shared files " "$sharerktdir"
show_dir_var "[c] Configuration" "$configdir"
show_dir_var "[d] Documentation" "$docdir"
show_dir_var "[c] Configuration " "$configdir"
show_dir_var "[d] Documentation " "$docdir"
show_dir_var "[a] .desktop files" "$appsdir"
show_dir_var "[m] Man Pages " "$mandir"
show_dir_var "[l] C Libraries " "$libdir"
show_dir_var "[h] C headers " "$incrktdir"
show_dir_var "[m] Man Pages " "$mandir"
echo "Enter a letter to change an entry, or enter to continue."
fi
retry="N"
@ -355,6 +358,7 @@ unixstyle_install() {
[oO]* ) read_dir librktdir ;;
[sS]* ) read_dir sharerktdir ;;
[cC]* ) read_dir configdir ;;
[aA]* ) read_dir appsdir ;;
[mM]* ) read_dir mandir ;;
"" ) if test "$err" = "N"; then done="Y"
else echo "*** Please fix erroneous paths to proceed"; fi ;;
@ -387,7 +391,7 @@ unixstyle_install() {
cd "$where"
"$tmp/bin/racket" "$tmp/collects/setup/unixstyle-install.rkt" \
"move" "$tmp" "$bindir" "$sharerktdir/collects" "$docdir" "$libdir" \
"$incrktdir" "$librktdir" "$sharerktdir" "$configdir" "$mandir" \
"$incrktdir" "$librktdir" "$sharerktdir" "$configdir" "$appsdir" "$mandir" \
|| failwith "installation failed"
}

7
pkgs/drracket-pkgs/drracket/drracket/drracket.desktop Normal file
View File

@ -0,0 +1,7 @@
[Desktop Entry]
Name=DrRacket
GenericName=IDE for Racket
Comment=DrRacket is an interactive, integrated, graphical programming environment for the Racket programming languages.
Terminal=false
Type=Application
Categories=Development;Education;

BIN
pkgs/drracket-pkgs/drracket/drracket/drracket.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 15 KiB

7
pkgs/gui-pkg-manager-pkgs/gui-pkg-manager/pkg/gui/start.desktop Normal file
View File

@ -0,0 +1,7 @@
[Desktop Entry]
Name=Racket Package Manager
GenericName=Graphical package manager for Racket
Comment=Racket Package Manager helps users install, update, and uninstall Racket packages.
Terminal=false
Type=Application
Categories=Utility;PackageManager;

BIN
pkgs/gui-pkg-manager-pkgs/gui-pkg-manager/pkg/gui/start.icns Normal file
View File

Binary file not shown.

BIN
pkgs/gui-pkg-manager-pkgs/gui-pkg-manager/pkg/gui/start.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 47 KiB

15
pkgs/racket-pkgs/racket-doc/scribblings/raco/config.scrbl
View File

@ -66,10 +66,23 @@ directory:
but for packages in installation scope.}
@item{@indexed-racket['bin-dir] --- a path, string, or byte string for the
main directory containing executables; it defaults to a
installion's directory containing executables; it defaults to a
@filepath{bin} sibling directory of the main collection
directory.}
@item{@indexed-racket['apps-dir] --- a path, string, or byte string
for the installation's directory for @filepath{.desktop} files;
it defaults to a @filepath{applications} subdirectory of the
@racket['share-dir] directory.}
@item{@indexed-racket['man-dir] --- a path, string, or byte string for the
installation's man-page directory; it defaults to a @filepath{man}
sibling directory of the main collection directory.}
@item{@indexed-racket['man-dir] --- a path, string, or byte string for the
main man-page directory; it defaults to a @filepath{man}
sibling directory of the main collection directory.}
@item{@indexed-racket['doc-search-dirs] --- like @racket['lib-search-dirs],
but for directories containing documentation.}

63
pkgs/racket-pkgs/racket-doc/scribblings/raco/launcher.scrbl
View File

@ -68,6 +68,13 @@ the following additional associations apply to launchers:
@racket[#t] means that the generated launcher should find the
base GRacket executable through a relative path.}
@item{@racket['install-mode] (Windows, Unix) --- either
@racket['user] or @racket['main], indicates that the launcher
is being installed to a user-specific place or to an
installation-wide place, which in turn determines where to
record @racket['start-menu], @racket['extension-registry],
and/or @racket['desktop] information.}
@item{@racket['start-menu] (Windows) --- a boolean or real number;
@racket[#t] indicates that the launcher should be in the
@onscreen{Start} menu by an installer that includes the
@ -108,12 +115,24 @@ the following additional associations apply to launchers:
An @racket['extension-registry] value is used only when
@racket['install-mode] is also specified.}
@item{@racket['install-mode] (Windows) --- either @racket['user] or
@racket['main], indicates whether the launcher is being
installed to a user-specific place or an installation-wide
place, which in turn determines where to record
@racket['start-menu] and @racket['extension-registry]
information.}
@item{@racket['desktop] (Unix) --- a string containing the content of
a @filepath{.desktop} file for the launcher, where @tt{Exec}
and @tt{Icon} items should be omitted, because they will be
added automatically. The file is written to the directory
produced by @racket[(find-apps-dir)] or
@racket[(find-user-apps-dir)]. A @racket['desktop] value is
used only when @racket['install-mode] is also specified.}
@item{@racket['png] (Unix) : An icon file path (suffix
@filepath{.png}) to be referenced by a @filepath{.desktop}
file (if any); a @racket['png] value takes precedence over a
@racket['ico] value, but neither is used unless a
@racket['desktop] value is also present.}
@item{@racket['ico] (Unix, in addition to more general Windows use)
: An icon file path (suffix @filepath{.ico}) that is used in
the same way as @racket['png] if no @racket['png] value is
available.}
]
@ -339,6 +358,30 @@ Backward-compatible aliases for
Backward-compatible aliases for
@racket[racket-program-launcher-path], etc.}
@defproc[(installed-executable-path->desktop-path [exec-path path-string?] [user? any/c])
(and/c path? complete-path?)]{
Returns a path for a @filepath{.desktop} file to describe the
installed executable at @racket[exec-path]. Only the filename part of
@racket[exec-path] is used. The @racket[user?] argument should be true
if @racket[exec-path] is installed in a user-specific location (in
which case the result path will also be user-specific).}
@defproc[(installed-desktop-path->icon-path [desktop-path path-string?]
[user? any/c]
[suffix bytes?])
(and/c path? complete-path?)]{
Returns a path for an icon file to be referenced by the
@filepath{desktop} file at @racket[desktop-path]. Only the filename
part of @racket[desktop-path] is used. The @racket[user?] argument
should be true if @racket[desktop-path] is installed in a
user-specific location (in which case the result path will also be
user-specific). The @racket[suffix] argument provides the icon-file
suffix, normally either @racket[#"png"] or @racket[#"ico"].}
@; ----------------------------------------------------------------------
@section{Launcher Configuration}
@ -385,7 +428,10 @@ are as follows:
OS X}
@item{@filepath{.ico} @'rarr @racket['ico] file for use on
Windows}
Windows or Unix}
@item{@filepath{.png} @'rarr @racket['png] file for use on
Unix}
@item{@filepath{.lch} @'rarr @racket['independent?] as @racket[#t]
(the file content is ignored) for use on Windows}
@ -406,6 +452,9 @@ are as follows:
@item{@filepath{.wmclass} @'rarr @racket['wm-class] as the literal
content, removing a trailing newline if any; for use on Unix}
@item{@filepath{.desktop} @'rarr @racket['desktop] as the literal
content; for use on Unix}
@item{@filepath{.startmenu} @'rarr @racket['start-menu] as the file
content if it @racket[read]s as a real number, @racket[#t]
otherwise, for use on Windows}

17
pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl
View File

@ -1091,6 +1091,16 @@ v
programs; the directory indicated by the returned path may or may
not exist.}
@defproc[(find-apps-dir) (or/c path? #f)]{
Returns a path to the installation's directory @filepath{.desktop}
files (for Unix). The result is @racket[#f] if no such directory
exists.}
@defproc[(find-user-apps-dir) path?]{
Returns a path to the user's directory for @filepath{.desktop} files
(for Unix); the directory indicated by the returned path may or may
not exist.}
@defproc[(find-man-dir) (or/c path? #f)]{
Returns a path to the installation's man-page directory. The result is
@racket[#f] if no such directory exists.}
@ -1114,9 +1124,10 @@ v
build. An empty string is normally produced for a release build.
The result is @racket[#f] if no build stamp is available.}
@defthing[absolute-installation? boolean?]{
A binary boolean flag that is true if this installation is using
absolute path names.}
@defproc[(get-absolute-installation?) boolean?]{
Returns @racket[#t] if this installation uses
absolute path names for executable and library references,
@racket[#f] otherwise.}
@; ------------------------------------------------------------------------

7
pkgs/slideshow-pkgs/slideshow-exe/slideshow/start.desktop Normal file
View File

@ -0,0 +1,7 @@
[Desktop Entry]
Name=Slideshow
GenericName=Slide-presentation tool
Comment=Slideshow is a Racket-based tool for writing slide presentations as programs
Terminal=false
Type=Application
Categories=Graphics;Presentation;

3
racket/collects/launcher/launcher-sig.rkt
View File

@ -52,3 +52,6 @@ available-mred-variants
available-mzscheme-variants
available-gracket-variants
available-racket-variants
installed-executable-path->desktop-path
installed-desktop-path->icon-path

111
racket/collects/launcher/launcher-unit.rkt
View File

@ -238,7 +238,7 @@
(let ([p (append (map (lambda (x) 'up) (cdr d)) b)])
(if (null? p) #f (apply build-path p))))))
(define (make-relative-path-header dest bindir)
(define (make-relative-path-header dest bindir use-librktdir?)
;; rely only on binaries in /usr/bin:/bin
(define (has-exe? exe)
(or (file-exists? (build-path "/usr/bin" exe))
@ -290,8 +290,10 @@
"cd \"$saveD\"\n"
"\n"
"bindir=\"$D"
(if use-librktdir?
""
(let ([s (relativize bindir-explode dest-explode)])
(if s (string-append "/" (protect-shell-string s)) ""))
(if s (string-append "/" (protect-shell-string s)) "")))
"\"\n"
"PATH=\"$saveP\"\n")
;; fallback to absolute path header
@ -333,6 +335,10 @@
"#!/bin/sh\n"
"# This script was created by make-"
(symbol->string kind)"-launcher\n")]
[use-librktdir? (if alt-exe
(let ([m (assq 'exe-is-gracket aux)])
(and m (cdr m)))
(eq? kind 'mred))]
[dir-finder
(let ([bindir (if alt-exe
(let ([m (assq 'exe-is-gracket aux)])
@ -345,15 +351,18 @@
(find-console-bin-dir))])
(if (let ([a (assq 'relative? aux)])
(and a (cdr a)))
(make-relative-path-header dest bindir)
(make-relative-path-header dest bindir use-librktdir?)
(make-absolute-path-header bindir)))]
[exec (format
"exec \"${bindir}/~a~a\" ~a"
"exec \"${~a}/~a~a\" ~a"
(if use-librktdir?
"librktdir"
"bindir")
(or alt-exe (case kind
[(mred) (if (eq? 'macosx (system-type))
(format "../lib/GRacket~a.app/Contents/MacOS/Gracket"
(format "GRacket~a.app/Contents/MacOS/Gracket"
(variant-suffix variant #t))
"../lib/gracket")]
"gracket")]
[(mzscheme) "racket"]))
(if alt-exe
""
@ -381,8 +390,13 @@
(display "# {{{ bindir\n")
(display dir-finder)
(display "# }}} bindir\n")
(when use-librktdir?
(display "# {{{ librktdir\n")
(display "librktdir=\"$bindir/../lib\"\n")
(display "# }}} librktdir\n"))
(newline)
(display (assemble-exec exec args))))))
(display (assemble-exec exec args)))))
(check-desktop aux dest))
(define (check-registry aux dest)
(let ([im (assoc 'install-mode aux)])
@ -415,6 +429,77 @@
(file-name-from-path dest))
(cdr m)))))))
(define (installed-executable-path->desktop-path dest user?)
(unless (path-string? dest)
(raise-argument-error 'installed-executable-path->desktop-path
"path-string?"
dest))
(define dir (if user?
(find-user-apps-dir)
(find-apps-dir)))
(path-replace-suffix (build-path dir (file-name-from-path dest))
#".desktop"))
(define (installed-desktop-path->icon-path dest user? extension)
;; We put icons files in "share" so that `setup/unixstyle-install'
;; knows how to fix up the "Icon" path in a ".desktop" file.
(unless (path-string? dest)
(raise-argument-error 'installed-desktop-path->icon-path
"path-string?"
dest))
(unless (bytes? extension)
(raise-argument-error 'installed-desktop-path->icon-path
"bytes?"
extension))
(build-path (if user?
(find-user-share-dir)
(find-share-dir))
(path-replace-suffix
(file-name-from-path dest)
(bytes-append
#"-exe-icon."
extension))))
(define (check-desktop aux dest)
(when (eq? 'unix (system-type))
(let ([im (assoc 'install-mode aux)])
(when (and im (member (cdr im) '(main user)))
(define user? (eq? (cdr im) 'user))
;; create Unix ".desktop" files, if any
(let ([m (assoc 'desktop aux)])
(when (and m (cdr m))
(define file (installed-executable-path->desktop-path dest
user?))
(make-directory* (path-only file))
(define (adjust-path p)
;; A ".desktop" file is supposed to have absolute paths
;; for the executable and icon, but we don't want absolute
;; paths in an in-place build. So, the ".desktop" files
;; in an in-place build won't be usable directly, but they
;; adn be patched up by `setup/unixstyle-install'.
(let ([p (simple-form-path (path->complete-path p))])
(if (or user?
(get-absolute-installation?))
p
(find-relative-path (simple-form-path (path-only file)) p))))
(install-template file 'mzscheme "starter-sh" "starter-sh") ; for something that's executable
(call-with-output-file*
file
#:exists 'truncate
(lambda (o)
(displayln (regexp-replace #rx"\n+$" (cdr m) "") o)
(fprintf o "Exec=~a\n" (adjust-path dest))
(let ([m (or (assq 'png aux)
(assq 'ico aux))])
(when m
(define copy-dest
(installed-desktop-path->icon-path file
user?
(filename-extension (cdr m))))
(unless (file-exists? copy-dest)
(copy-file (cdr m) copy-dest))
(fprintf o "Icon=~a\n" (adjust-path copy-dest))))))))))))
(define (update-register mode filename key val)
(define dir (if (eq? mode 'main)
(find-lib-dir)
@ -597,6 +682,7 @@
(append
(try 'icns #".icns")
(try 'ico #".ico")
(try 'png #".png")
(try 'independent? #".lch")
(let ([l (try 'creator #".creator")])
(if (null? l)
@ -674,7 +760,12 @@
(list (cons 'wm-class
(regexp-replace #rx"(?:\r\n|\r|\n)$"
(file->string (cdar l))
""))))))))
""))))))
(let ([l (try 'desktop #".desktop")])
(if (null? l)
l
(with-handlers ([exn:fail:filesystem? (lambda (x) (log-fail l x) null)])
(list (cons 'desktop (file->string (cdar l)))))))))
(define (build-aux-from-path aux-root)
(let ([aux-root (if (string? aux-root) (string->path aux-root) aux-root)])
@ -686,13 +777,15 @@
(append
(try #".icns")
(try #".ico")
(try #".png")
(try #".lch")
(try #".creator")
(try #".filetypes")
(try #".utiexports")
(try #".extreg")
(try #".startmenu")
(try #".wmclass"))))
(try #".wmclass")
(try #".desktop"))))
(define (make-gracket-program-launcher file collection dest)
(make-mred-launcher (list "-l-" (string-append collection "/" file))

26
racket/collects/setup/dirs.rkt
View File

@ -72,6 +72,7 @@
(define-config config:lib-dir 'lib-dir to-path)
(define-config config:lib-search-dirs 'lib-search-dirs to-path)
(define-config config:share-dir 'share-dir to-path)
(define-config config:apps-dir 'apps-dir to-path)
(define-config config:include-dir 'include-dir to-path)
(define-config config:include-search-dirs 'include-search-dirs to-path)
(define-config config:bin-dir 'bin-dir to-path)
@ -148,6 +149,14 @@
(define-syntax define-finder
(syntax-rules (get-false chain-to)
[(_ provide config:id id user-id #:default user-default default)
(begin
(define-finder provide config:id id get-false default)
(provide user-id)
(define user-dir
(delay (build-path (system-path* 'addon-dir) (get-installation-name) user-default)))
(define (user-id)
(force user-dir)))]
[(_ provide config:id id user-id config:search-id search-id default)
(begin
(define-finder provide config:id id user-id default)
@ -183,13 +192,7 @@
(define (id)
(force dir)))]
[(_ provide config:id id user-id default)
(begin
(define-finder provide config:id id get-false default)
(provide user-id)
(define user-dir
(delay (build-path (system-path* 'addon-dir) (get-installation-name) default)))
(define (user-id)
(force user-dir)))]))
(define-finder provide config:id id user-id #:default default default)]))
(define-syntax no-provide (syntax-rules () [(_ . rest) (begin)]))
@ -246,6 +249,15 @@
find-user-share-dir
"share")
;; ----------------------------------------
;; "apps"
(define-finder provide
config:share-dir
find-apps-dir
find-user-apps-dir #:default (build-path "share" "applications")
(chain-to (lambda () (build-path (find-share-dir) "applications"))))
;; ----------------------------------------
;; "man"

19
racket/collects/setup/setup-unit.rkt
View File

@ -1432,7 +1432,24 @@
(delete-file exe-path)]
[(and is-dir? (directory-exists? exe-path))
(setup-printf "deleting" "launcher ~a" rel-exe-path)
(delete-directory/files exe-path)]))
(delete-directory/files exe-path)])
;; Clean up any associated .desktop file and icon file:
(when (eq? 'unix (system-type))
(let ([desktop (installed-executable-path->desktop-path
exe-path
user?)])
(when (file-exists? desktop)
(setup-printf "deleting" "desktop file ~a"
(path->relative-string/share desktop))
(delete-file desktop))
(for ([ext (in-list '(#"ico" #"png"))])
(define icon (installed-desktop-path->icon-path desktop
user?
ext))
(when (file-exists? icon)
(setup-printf "deleting" "icon file ~a"
(path->relative-string/share icon))
(delete-file icon))))))
ht])))
(unless (equal? ht ht2)
(setup-printf "updating" "launcher list")

72
racket/collects/setup/unixstyle-install.rkt
View File

@ -51,12 +51,13 @@
[(sharerkt) "share"]
[(config) "etc"]
[(collects) "collects"]
[(apps) "share/applications"]
[else (symbol->string name)])))
(define dirs (map (lambda (name) (list name
(if base-destdir
(build-dest-arg name)
(get-arg))))
'(bin collects doc lib includerkt librkt sharerkt config man #|src|#)))
'(bin collects doc lib includerkt librkt sharerkt config apps man #|src|#)))
(define (dir: name)
(cadr (or (assq name dirs) (error 'getdir "unknown dir name: ~e" name))))
@ -83,6 +84,7 @@
[(share) 1]
[(etc) 1]
[(man) #f]
[(applications) #f]
[(src) 1]
[(README) #f] ; moved last
[else (error 'level-of "internal-error -- unknown dir: ~e" dir)])))
@ -134,11 +136,18 @@
(for-each loop (ls))))
;; used for filtering files when copying (and moving toplevels)
(define skip-filter (lambda (p) #f))
(define current-skip-filter (make-parameter (lambda (p) #f)))
(define (make-apps-skip)
(let ([skip-filter (current-skip-filter)])
(lambda (f)
(or (equal? f "share/applications")
(skip-filter f)))))
;; copy a file or a directory (recursively), preserving time stamps
;; (racket's copy-file preservs permission bits)
(define (cp src dst)
(define skip-filter (current-skip-filter))
(let loop ([src src] [dst dst])
(let ([time! (lambda ()
(file-or-directory-modify-seconds
@ -209,14 +218,20 @@
[m (or (regexp-match-positions
#rx#"\n# {{{ bindir\n(.*?\n)# }}} bindir\n" buf)
(error (format "could not find binpath block in script: ~a"
file)))])
file)))]
[m2 (regexp-match-positions
#rx#"\n# {{{ librktdir\n(.*?\n)# }}} librktdir\n" buf)])
;; 'truncate file to keep it executable
(with-output-to-file file #:exists 'truncate
(lambda ()
(write-bytes buf (current-output-port) 0 (caadr m))
(printf "bindir=\"~a\"\n"
(regexp-replace* #rx"[\"`'$\\]" (dir: 'bin) "\\\\&"))
(write-bytes buf (current-output-port) (cdadr m))))))
(define (escaped-dir: sym)
(regexp-replace* #rx"[\"`'$\\]" (dir: sym) "\\\\&"))
(printf "bindir=\"~a\"\n" (escaped-dir: 'bin))
(when m2
(write-bytes buf (current-output-port) (cdadr m) (caadr m2))
(printf "librktdir=\"~a\"\n" (escaped-dir: 'librkt)))
(write-bytes buf (current-output-port) (cdadr (or m2 m)))))))
(let ([magic (with-input-from-file file (lambda () (read-bytes 10)))])
(cond [(or (regexp-match #rx#"^\177ELF" magic)
(regexp-match #rx#"^\316\372\355\376" magic)
@ -238,10 +253,35 @@
(parameterize ([current-directory bindir])
(for ([f (in-list (or binfiles (ls)))] #:when (file-exists? f))
(fix-executable f)))
;; fix the starter executable too
;; fix the gracket & starter executables too
(parameterize ([current-directory librktdir])
(when (file-exists? "gracket") (fix-executable "gracket"))
(when (file-exists? "starter") (fix-executable "starter"))))
(define (fix-desktop-files appsdir bindir sharerktdir)
;; For absolute mode, change `Exec' and `Icon' lines to
;; have absolute paths:
(define (fixup-path at-dir orig-path)
(build-path at-dir (let-values ([(base name dir?) (split-path orig-path)])
name)))
(for ([d (in-list (directory-list appsdir))])
(when (regexp-match? #rx"[.]desktop$" d)
(define ls (call-with-input-file (build-path appsdir d)
(lambda (i)
(for/list ([l (in-lines i)]) l))))
(define new-ls (for/list ([l (in-list ls)])
(cond
[(regexp-match? #rx"^Exec=" l)
(format "Exec=~a" (fixup-path bindir (substring l 5)))]
[(regexp-match? #rx"^Icon=" l)
(format "Icon=~a" (fixup-path sharerktdir (substring l 5)))]
[else l])))
(unless (equal? ls new-ls)
(call-with-output-file (build-path appsdir d)
#:exists 'truncate/replace
(lambda (o)
(map (lambda (s) (displayln s o)) new-ls)))))))
;; remove and record all empty dirs
(define (remove-empty-dirs dir)
(let loop ([dir dir] [recurse? #t])
@ -327,15 +367,16 @@
(lambda ()
(printf ";; automatically generated by unixstyle-install\n")
(printf "#hash(")
(printf "(doc-dir . ~s)\n" (dir: 'doc))
(preserve 'catalogs)
(preserve 'doc-search-url)
(printf "(doc-dir . ~s)\n" (dir: 'doc))
(when (eq? 'shared (system-type 'link)) ; never true for now
(printf " (dll-dir . ~s)\n" (dir: 'lib)))
(printf " (lib-dir . ~s)\n" (dir: 'librkt))
(printf " (share-dir . ~s)\n" (dir: 'sharerkt))
(printf " (include-dir . ~s)\n" (dir: 'includerkt))
(printf " (bin-dir . ~s)\n" (dir: 'bin))
(printf " (apps-dir . ~s)\n" (dir: 'apps))
(printf " (man-dir . ~s)\n" (dir: 'man))
(printf " (absolute-installation? . #t))\n"))))]))
@ -364,6 +405,7 @@
[else (loop)]))))))
(define ((move/copy-tree move?) src dst* #:missing [missing 'error])
(define skip-filter (current-skip-filter))
(define dst (if (symbol? dst*) (dir: dst*) dst*))
(define src-exists?
(or (directory-exists? src) (file-exists? src) (link-exists? src)))
@ -420,10 +462,13 @@
(cp* f (build-path base-destdir f))))
;; All other platforms use "bin":
(do-tree "bin" 'bin))
(do-tree "collects" 'collects)
(do-tree "doc" 'doc #:missing 'skip) ; not included in text distros
(do-tree "lib" 'librkt)
(do-tree "include" 'includerkt)
(do-tree "share" 'sharerkt)
(do-tree "share/applications" 'apps #:missing 'skip) ; Unix only
(parameterize ([current-skip-filter (make-apps-skip)])
(do-tree "share" 'sharerkt))
(do-tree "etc" 'config)
(do-tree "man" 'man #:missing 'skip) ; not included for Windows
;; (when (and (not (equal? (dir: 'src) "")) (directory-exists? "src"))
@ -440,6 +485,7 @@
;; we need to know which files need fixing
(unless bundle?
(fix-executables (dir: 'bin) (dir: 'librkt) binfiles)
(fix-desktop-files (dir: 'apps) (dir: 'bin) (dir: 'sharerkt))
(write-uninstaller)
(write-config)))
(when move?
@ -450,7 +496,7 @@
(define copytree (move/copy-tree #f))
(define origtree? (equal? "yes" (get-arg)))
(current-directory rktdir)
(set! skip-filter ; skip all dot-names
(current-skip-filter ; skip all dot-names
(lambda (p) (regexp-match? #rx"^(?:[.].*)$" (basename p))))
(with-handlers ([exn? (lambda (e) (undo-changes) (raise e))])
(set! yes-to-all? #t) ; non-interactive
@ -469,7 +515,9 @@
;; grab paths before we change them
(define bindir (dir: 'bin))
(define librktdir (dir: 'librkt))
(define sharerktdir (dir: 'sharerkt))
(define configdir (dir: 'config))
(define appsdir (dir: 'apps))
(define (remove-dest p)
(let ([pfx (and (< destdirlen (string-length p))
(substring p 0 destdirlen))])
@ -481,6 +529,7 @@
;; only when DESTDIR is present, so we're installing to a directory that
;; has only our binaries
(fix-executables bindir librktdir)
(fix-desktop-files appsdir bindir sharerktdir)
(unless origtree? (write-config configdir)))
(define (post-adjust)
@ -488,13 +537,14 @@
(define do-tree (move/copy-tree #f))
(current-directory rktdir)
;; Copy source into place:
(set! skip-filter ; skip src/build
(current-skip-filter ; skip src/build
(lambda (p) (regexp-match? #rx"^build$" p)))
(do-tree "src" (build-path base-destdir "src"))
;; Remove directories that get re-created:
(define (remove! dst*) (rm (dir: dst*)))
(remove! 'bin)
(remove! 'lib)
(remove! 'apps)
(remove! 'man)
(remove! 'config) ; may be recreated by a later bundle step
(remove! 'includerkt)

2
racket/src/Makefile.in
View File

@ -15,6 +15,7 @@ libpltdir = @libpltdir@
sharepltdir = @sharepltdir@
configdir = @etcpltdir@
collectsdir = @collectsdir@
appsdir = @appsdir@
mandir = @mandir@
docdir = @docdir@
builddir = @builddir@
@ -39,6 +40,7 @@ ALLDIRINFO = "$(DESTDIR)$(bindir)" \
"$(DESTDIR)$(libpltdir)" \
"$(DESTDIR)$(sharepltdir)" \
"$(DESTDIR)$(configdir)" \
"$(DESTDIR)$(appsdir)" \
"$(DESTDIR)$(mandir)"
COPYING = "$(srcdir)/COPYING-libscheme.txt" \

31
racket/src/configure vendored
View File

@ -638,7 +638,7 @@ docdir
infodir
htmldir
collectsdir
pdfdir
appsdir
psdir
libdir
localedir
@ -748,6 +748,7 @@ LIBRACKET_DEP
LTO
LTA
collectsdir
appsdir
libpltdir
sharepltdir
etcpltdir
@ -822,7 +823,7 @@ docdir='${datarootdir}/doc/${PACKAGE}'
infodir='${datarootdir}/info'
htmldir='${docdir}'
collectsdir='${exec_prefix}/share/${PACKAGE}/collects'
pdfdir='${docdir}'
appsdir='${exec_prefix}/share/applications'
psdir='${docdir}'
libdir='${exec_prefix}/lib'
localedir='${datarootdir}/locale'
@ -1039,10 +1040,10 @@ do
| --progr-tra=* | --program-tr=* | --program-t=*)
program_transform_name=$ac_optarg ;;
-pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)
ac_prev=pdfdir ;;
-pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)
pdfdir=$ac_optarg ;;
-appsdir | --appsdir | --appsdi | --appsd | --apps | --pd)
ac_prev=appsdir ;;
-appsdir=* | --appsdir=* | --appsdi=* | --appsd=* | --apps=* | --pd=*)
appsdir=$ac_optarg ;;
-psdir | --psdir | --psdi | --psd | --ps)
ac_prev=psdir ;;
@ -1168,7 +1169,7 @@ fi
# Be sure to have absolute directory names.
for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \
datadir sysconfdir sharedstatedir localstatedir includedir \
oldincludedir docdir infodir htmldir collectsdir pdfdir psdir \
oldincludedir docdir infodir htmldir collectsdir appsdir psdir \
libdir localedir mandir
do
eval ac_val=\$$ac_var
@ -1324,7 +1325,8 @@ Fine tuning of the installation directories:
--datadir=DIR read-only architecture-independent data [DATAROOTDIR]
--mandir=DIR man documentation [DATAROOTDIR/man]
--docdir=DIR documentation root [DATAROOTDIR/doc/PACKAGE]
--collectsdir=DIR collects documentation [EPREFIX/share/PACKAGE/collects]
--collectsdir=DIR base collections [EPREFIX/share/PACKAGE/collects]
--appsdir=DIR .desktop files [EPREFIX/share/applications]
_ACEOF
cat <<\_ACEOF
@ -2307,6 +2309,9 @@ fi
if test "${collectsdir}" != '${exec_prefix}/share/${PACKAGE}/collects' ; then
unixstyle=yes
fi
if test "${appsdir}" != '${exec_prefix}/share/applications' ; then
unixstyle=yes
fi
MAKE_COPYTREE=no
@ -2325,6 +2330,7 @@ if test "${unixstyle}" = "no" ; then
docdir='${prefix}/doc'
mandir='${prefix}/man'
collectsdir='${prefix}/collects'
appsdir='${prefix}/share/applications'
COLLECTS_PATH="../collects"
CONFIG_PATH="../etc"
INSTALL_ORIG_TREE=yes
@ -9259,6 +9265,7 @@ LIBS="$LIBS $EXTRALIBS"
mk_needed_dir()
@ -9993,7 +10000,7 @@ docdir!$docdir$ac_delim
infodir!$infodir$ac_delim
htmldir!$htmldir$ac_delim
collectsdir!$collectsdir$ac_delim
pdfdir!$pdfdir$ac_delim
appsdir!$appsdir$ac_delim
psdir!$psdir$ac_delim
libdir!$libdir$ac_delim
localedir!$localedir$ac_delim
@ -10144,6 +10151,7 @@ LIBRACKET_DEP!$LIBRACKET_DEP$ac_delim
LTO!$LTO$ac_delim
LTA!$LTA$ac_delim
collectsdir!$collectsdir$ac_delim
appsdir!$appsdir$ac_delim
libpltdir!$libpltdir$ac_delim
sharepltdir!$sharepltdir$ac_delim
etcpltdir!$etcpltdir$ac_delim
@ -10168,7 +10176,7 @@ LIBOBJS!$LIBOBJS$ac_delim
LTLIBOBJS!$LTLIBOBJS$ac_delim
_ACEOF
if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 59; then
if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 60; then
break
elif $ac_last_try; then
{ { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5
@ -10794,8 +10802,9 @@ else
echo " C headers : ${includepltdir}/..."
echo " platform libraries : ${libpltdir}/..."
echo " common libraries : ${sharepltdir}/..."
echo " core collections : ${collectsdir}/..."
echo " base collections : ${collectsdir}/..."
echo " configuration : ${etcpltdir}/..."
echo " .desktop files : ${appsdir}/..."
echo " man pages : ${mandir}/..."
echo " where prefix = ${prefix}"
echo " and datarootdir = ${datarootdir}"

8
racket/src/racket/configure.ac
View File

@ -203,6 +203,9 @@ fi
if test "${collectsdir}" != '${exec_prefix}/share/${PACKAGE}/collects' ; then
unixstyle=yes
fi
if test "${appsdir}" != '${exec_prefix}/share/applications' ; then
unixstyle=yes
fi
MAKE_COPYTREE=no
@ -221,6 +224,7 @@ if test "${unixstyle}" = "no" ; then
docdir='${prefix}/doc'
mandir='${prefix}/man'
collectsdir='${prefix}/collects'
appsdir='${prefix}/share/applications'
COLLECTS_PATH="../collects"
CONFIG_PATH="../etc"
INSTALL_ORIG_TREE=yes
@ -1526,6 +1530,7 @@ AC_SUBST(LTO)
AC_SUBST(LTA)
AC_SUBST(collectsdir)
AC_SUBST(appsdir)
AC_SUBST(libpltdir)
AC_SUBST(sharepltdir)
AC_SUBST(etcpltdir)
@ -1634,8 +1639,9 @@ else
echo " C headers : ${includepltdir}/..."
echo " platform libraries : ${libpltdir}/..."
echo " common libraries : ${sharepltdir}/..."
echo " core collections : ${collectsdir}/..."
echo " base collections : ${collectsdir}/..."
echo " configuration : ${etcpltdir}/..."
echo " .desktop files : ${appsdir}/..."
echo " man pages : ${mandir}/..."
echo " where prefix = ${prefix}"
echo " and datarootdir = ${datarootdir}"

16
racket/src/racket/make-configure
View File

@ -33,7 +33,7 @@ exit 0
infodir
htmldir
;; dvidir - converted to "collectsdir"
pdfdir
;; pdfdir - converted to "appsdir"
psdir
localedir)))
@ -52,9 +52,19 @@ exit 0
[(equal? l "dvidir='${docdir}'")
(displayln "collectsdir='${exec_prefix}/share/${PACKAGE}/collects'")]
[(equal? l " --dvidir=DIR dvi documentation [DOCDIR]")
(displayln " --collectsdir=DIR collects documentation [EPREFIX/share/PACKAGE/collects]")]
(displayln " --collectsdir=DIR base collections [EPREFIX/share/PACKAGE/collects]")]
[else
(displayln (regexp-replace* #rx"dvi" l "collects"))])
(displayln (regexp-replace* "pdf" (regexp-replace* #rx"dvi" l "collects") "apps"))])
(loop)]
[(regexp-match #rx"pdfdir" l)
;; Hack: take over "pdfdir" for "appsdir":
(cond
[(equal? l "pdfdir='${docdir}'")
(displayln "appsdir='${exec_prefix}/share/applications'")]
[(equal? l " --pdfdir=DIR pdf documentation [DOCDIR]")
(displayln " --appsdir=DIR .desktop files [EPREFIX/share/applications]")]
[else
(displayln (regexp-replace* #rx"pdf" l "apps"))])
(loop)]
[else
;; Copy