[arch-commits] Commit in racket/repos (14 files)
Eric Bélanger
eric at archlinux.org
Sun Jun 17 01:21:58 UTC 2012
Date: Saturday, June 16, 2012 @ 21:21:57
Author: eric
Revision: 161957
archrelease: copy trunk to extra-i686, extra-x86_64
Added:
racket/repos/extra-i686/PKGBUILD
(from rev 161956, racket/trunk/PKGBUILD)
racket/repos/extra-i686/drracket-normal.rkt
(from rev 161956, racket/trunk/drracket-normal.rkt)
racket/repos/extra-i686/drracket.desktop
(from rev 161956, racket/trunk/drracket.desktop)
racket/repos/extra-i686/racket.install
(from rev 161956, racket/trunk/racket.install)
racket/repos/extra-x86_64/PKGBUILD
(from rev 161956, racket/trunk/PKGBUILD)
racket/repos/extra-x86_64/drracket-normal.rkt
(from rev 161956, racket/trunk/drracket-normal.rkt)
racket/repos/extra-x86_64/drracket.desktop
(from rev 161956, racket/trunk/drracket.desktop)
racket/repos/extra-x86_64/racket.install
(from rev 161956, racket/trunk/racket.install)
Deleted:
racket/repos/extra-i686/PKGBUILD
racket/repos/extra-i686/drracket.desktop
racket/repos/extra-i686/racket.install
racket/repos/extra-x86_64/PKGBUILD
racket/repos/extra-x86_64/drracket.desktop
racket/repos/extra-x86_64/racket.install
----------------------------------+
extra-i686/PKGBUILD | 69 ++++++------
extra-i686/drracket-normal.rkt | 199 +++++++++++++++++++++++++++++++++++++
extra-i686/drracket.desktop | 18 +--
extra-i686/racket.install | 22 ++--
extra-x86_64/PKGBUILD | 69 ++++++------
extra-x86_64/drracket-normal.rkt | 199 +++++++++++++++++++++++++++++++++++++
extra-x86_64/drracket.desktop | 18 +--
extra-x86_64/racket.install | 22 ++--
8 files changed, 512 insertions(+), 104 deletions(-)
Deleted: extra-i686/PKGBUILD
===================================================================
--- extra-i686/PKGBUILD 2012-06-17 01:21:29 UTC (rev 161956)
+++ extra-i686/PKGBUILD 2012-06-17 01:21:57 UTC (rev 161957)
@@ -1,32 +0,0 @@
-# $Id$
-# Maintainer: Eric Bélanger <eric at archlinux.org>
-
-pkgname=racket
-pkgver=5.2.1
-pkgrel=2
-pkgdesc="A programming language environment (formerly known as PLT Scheme) suitable for tasks ranging from scripting to application development"
-arch=('i686' 'x86_64')
-url="http://racket-lang.org/"
-license=('LGPL')
-depends=('gtk2' 'desktop-file-utils')
-makedepends=('gsfonts')
-options=('!libtool' '!strip')
-install=racket.install
-source=(http://download.racket-lang.org/installers/${pkgver}/racket/${pkgname}-${pkgver}-src-unix.tgz \
- drracket.desktop)
-sha1sums=('b51cdd8b9825edb60e5c2c80472cec8220918cd1'
- 'a20808f6b250225704856f82a544681a962a299d')
-
-build() {
- cd "${srcdir}/${pkgname}-${pkgver}/src"
- [ "$CARCH" == "x86_64" ] && export CFLAGS+="-fPIC"
- ./configure --prefix=/usr --enable-shared
- make
-}
-
-package() {
- cd "${srcdir}/${pkgname}-${pkgver}/src"
- make DESTDIR="${pkgdir}" install
- install -D -m644 ../collects/icons/plt.xpm "${pkgdir}/usr/share/pixmaps/drracket.xpm"
- install -D -m644 "${srcdir}/drracket.desktop" "${pkgdir}/usr/share/applications/drracket.desktop"
-}
Copied: racket/repos/extra-i686/PKGBUILD (from rev 161956, racket/trunk/PKGBUILD)
===================================================================
--- extra-i686/PKGBUILD (rev 0)
+++ extra-i686/PKGBUILD 2012-06-17 01:21:57 UTC (rev 161957)
@@ -0,0 +1,37 @@
+# $Id$
+# Maintainer: Eric Bélanger <eric at archlinux.org>
+
+pkgname=racket
+pkgver=5.2.1
+pkgrel=3
+pkgdesc="A programming language environment (formerly known as PLT Scheme) suitable for tasks ranging from scripting to application development"
+arch=('i686' 'x86_64')
+url="http://racket-lang.org/"
+license=('LGPL')
+depends=('gtk2' 'desktop-file-utils')
+makedepends=('gsfonts')
+options=('!libtool' '!strip')
+install=racket.install
+source=(http://download.racket-lang.org/installers/${pkgver}/racket/${pkgname}-${pkgver}-src-unix.tgz \
+ drracket.desktop drracket-normal.rkt)
+sha1sums=('b51cdd8b9825edb60e5c2c80472cec8220918cd1'
+ 'a20808f6b250225704856f82a544681a962a299d'
+ '6699e80e424479d45f427ba341003235e0d475cf')
+
+build() {
+ cd "${srcdir}/${pkgname}-${pkgver}/src"
+ [ "$CARCH" == "x86_64" ] && export CFLAGS+="-fPIC"
+ ./configure --prefix=/usr --enable-shared
+ make
+}
+
+package() {
+ cd "${srcdir}/${pkgname}-${pkgver}/src"
+ make DESTDIR="${pkgdir}" install
+
+ # FS#30245
+ install -D -m644 "${srcdir}/drracket-normal.rkt" "${pkgdir}/usr/lib/racket/collects/drracket/private/drracket-normal.rkt"
+
+ install -D -m644 ../collects/icons/plt.xpm "${pkgdir}/usr/share/pixmaps/drracket.xpm"
+ install -D -m644 "${srcdir}/drracket.desktop" "${pkgdir}/usr/share/applications/drracket.desktop"
+}
Copied: racket/repos/extra-i686/drracket-normal.rkt (from rev 161956, racket/trunk/drracket-normal.rkt)
===================================================================
--- extra-i686/drracket-normal.rkt (rev 0)
+++ extra-i686/drracket-normal.rkt 2012-06-17 01:21:57 UTC (rev 161957)
@@ -0,0 +1,199 @@
+#lang racket/base
+
+(require mred
+ racket/class
+ racket/cmdline
+ racket/list
+ framework/private/bday
+ framework/splash
+ racket/runtime-path
+ racket/file
+ "frame-icon.rkt"
+ "eb.rkt")
+
+(define-runtime-path doc-icon.rkt "dock-icon.rkt")
+
+(define files-to-open (command-line #:args filenames filenames))
+
+;; updates the command-line-arguments with only the files
+;; to open. See also main.rkt.
+(current-command-line-arguments (apply vector files-to-open))
+
+(define (currently-the-weekend?)
+ (define date (seconds->date (current-seconds)))
+ (define dow (date-week-day date))
+ (or (= dow 6) (= dow 0)))
+
+(define (valentines-day?)
+ (define date (seconds->date (current-seconds)))
+ (and (= 2 (date-month date))
+ (= 14 (date-day date))))
+
+(define (current-icon-state)
+ (cond
+ [(valentines-day?) 'valentines]
+ [(currently-the-weekend?) 'weekend]
+ [else 'normal]))
+
+(define-values (texas-independence-day? prince-kuhio-day? kamehameha-day? halloween?)
+ (let* ([date (seconds->date (current-seconds))]
+ [month (date-month date)]
+ [day (date-day date)]
+ [dow (date-week-day date)])
+ (values (and (= 3 month) (= 2 day))
+ #f
+ (and (= 6 month) (= 11 day))
+ (and (= 10 month) (= 31 day)))))
+
+
+(define special-state #f)
+
+(define (icons-bitmap name)
+ (make-object bitmap% (collection-file-path name "icons")))
+
+(define-struct magic-image (chars filename [bitmap #:mutable]))
+
+(define (magic-img str img)
+ (make-magic-image (reverse (string->list str)) img #f))
+
+;; magic strings and their associated images. There should not be a string
+;; in this list that is a prefix of another.
+(define magic-images
+ (list #;(magic-img "larval" "PLT-206-larval.png")
+ (magic-img "mars" "PLT-206-mars.jpg")))
+
+(define (load-magic-images)
+ (set! load-magic-images void) ; run only once
+ (for-each (λ (magic-image)
+ (unless (magic-image-bitmap magic-image)
+ (set-magic-image-bitmap!
+ magic-image
+ (icons-bitmap (magic-image-filename magic-image)))))
+ magic-images))
+
+(define longest-magic-string
+ (apply max (map (λ (s) (length (magic-image-chars s))) magic-images)))
+
+(define key-codes null)
+
+(define (find-magic-image)
+ (define (prefix? l1 l2)
+ (or (null? l1)
+ (and (pair? l2)
+ (eq? (car l1) (car l2))
+ (prefix? (cdr l1) (cdr l2)))))
+ (ormap (λ (i) (and (prefix? (magic-image-chars i) key-codes) i))
+ magic-images))
+
+(define (add-key-code new-code)
+ (set! key-codes (cons new-code key-codes))
+ (when ((length key-codes) . > . longest-magic-string)
+ (set! key-codes (take key-codes longest-magic-string))))
+
+(define (drracket-splash-char-observer evt)
+ (let ([ch (send evt get-key-code)])
+ (when (and (eq? ch #\q)
+ (send evt get-control-down))
+ (exit))
+ (when (char? ch)
+ ;; as soon as something is typed, load the bitmaps
+ (load-magic-images)
+ (add-key-code ch)
+ (let ([match (find-magic-image)])
+ (when match
+ (set! key-codes null)
+ (set-splash-bitmap
+ (if (eq? special-state match)
+ (begin (set! special-state #f) the-splash-bitmap)
+ (begin (set! special-state match)
+ (magic-image-bitmap match))))
+ (refresh-splash))))))
+
+(when (eb-bday?) (install-eb))
+
+(define weekend-bitmap-spec (collection-file-path "plt-logo-red-shiny.png" "icons"))
+(define normal-bitmap-spec (collection-file-path "plt-logo-red-diffuse.png" "icons"))
+(define valentines-days-spec (collection-file-path "heart.png" "icons"))
+
+(define the-bitmap-spec
+ (cond
+ [(valentines-day?)
+ valentines-days-spec]
+ [(or prince-kuhio-day? kamehameha-day?)
+ (set-splash-progress-bar?! #f)
+ (let ([size ((dynamic-require 'drracket/private/palaka 'palaka-pattern-size) 4)])
+ (vector (dynamic-require 'drracket/private/honu-logo 'draw-honu)
+ size
+ size))]
+ [texas-independence-day?
+ (collection-file-path "texas-plt-bw.gif" "icons")]
+ [halloween?
+ (collection-file-path "PLT-pumpkin.png" "icons")]
+ [(currently-the-weekend?)
+ weekend-bitmap-spec]
+ [else normal-bitmap-spec]))
+(define the-splash-bitmap (read-bitmap the-bitmap-spec))
+(set-splash-char-observer drracket-splash-char-observer)
+
+(when (eq? (system-type) 'macosx)
+ (define initial-state (current-icon-state))
+ (define weekend-bitmap (if (equal? the-bitmap-spec weekend-bitmap-spec)
+ the-splash-bitmap
+ #f))
+ (define weekday-bitmap (if (equal? the-bitmap-spec normal-bitmap-spec)
+ the-splash-bitmap
+ #f))
+ (define valentines-bitmap (if (equal? the-bitmap-spec valentines-days-spec)
+ the-splash-bitmap
+ #f))
+ (define set-doc-tile-bitmap (dynamic-require doc-icon.rkt 'set-dock-tile-bitmap))
+ (define (set-icon state)
+ (case state
+ [(valentines)
+ (unless valentines-bitmap (set! valentines-bitmap (read-bitmap valentines-days-spec)))
+ (set-doc-tile-bitmap valentines-bitmap)]
+ [(weekend)
+ (unless weekend-bitmap (set! weekend-bitmap (read-bitmap weekend-bitmap-spec)))
+ (set-doc-tile-bitmap weekend-bitmap)]
+ [(normal)
+ (unless weekday-bitmap (set! weekday-bitmap (read-bitmap normal-bitmap-spec)))
+ (set-doc-tile-bitmap weekday-bitmap)]))
+ (set-icon initial-state)
+ (void
+ (thread
+ (λ ()
+ (let loop ([last-state initial-state])
+ (sleep 10)
+ (define next-state (current-icon-state))
+ (unless (equal? last-state next-state)
+ (set-icon next-state))
+ (loop next-state))))))
+
+(start-splash the-splash-bitmap
+ "DrRacket"
+ 700
+ #:allow-funny? #t
+ #:frame-icon todays-icon)
+
+(when (getenv "PLTDRBREAK")
+ (printf "PLTDRBREAK: creating break frame\n") (flush-output)
+ (let ([to-break (eventspace-handler-thread (current-eventspace))])
+ (parameterize ([current-eventspace (make-eventspace)])
+ (let* ([f (new frame% (label "Break DrRacket"))]
+ [b (new button%
+ (label "Break Main Thread")
+ (callback
+ (λ (x y)
+ (break-thread to-break)))
+ (parent f))]
+ [b (new button%
+ (label "Break All Threads")
+ (callback
+ (λ (x y)
+ ((dynamic-require 'drracket/private/key 'break-threads))))
+ (parent f))])
+ (send f show #t)))))
+
+(dynamic-require 'drracket/tool-lib #f)
+(shutdown-splash)
+(close-splash)
Deleted: extra-i686/drracket.desktop
===================================================================
--- extra-i686/drracket.desktop 2012-06-17 01:21:29 UTC (rev 161956)
+++ extra-i686/drracket.desktop 2012-06-17 01:21:57 UTC (rev 161957)
@@ -1,9 +0,0 @@
-[Desktop Entry]
-Name=DrRacket
-GenericName=IDE for Racket
-Comment=DrRacket is an interactive, integrated, graphical programming environment for the Racket programming languages.
-Exec=drracket
-Terminal=false
-Type=Application
-Categories=Education;Development;
-Icon=drracket
Copied: racket/repos/extra-i686/drracket.desktop (from rev 161956, racket/trunk/drracket.desktop)
===================================================================
--- extra-i686/drracket.desktop (rev 0)
+++ extra-i686/drracket.desktop 2012-06-17 01:21:57 UTC (rev 161957)
@@ -0,0 +1,9 @@
+[Desktop Entry]
+Name=DrRacket
+GenericName=IDE for Racket
+Comment=DrRacket is an interactive, integrated, graphical programming environment for the Racket programming languages.
+Exec=drracket
+Terminal=false
+Type=Application
+Categories=Education;Development;
+Icon=drracket
Deleted: extra-i686/racket.install
===================================================================
--- extra-i686/racket.install 2012-06-17 01:21:29 UTC (rev 161956)
+++ extra-i686/racket.install 2012-06-17 01:21:57 UTC (rev 161957)
@@ -1,11 +0,0 @@
-post_install() {
- update-desktop-database -q
-}
-
-post_upgrade() {
- post_install
-}
-
-post_remove() {
- post_install
-}
Copied: racket/repos/extra-i686/racket.install (from rev 161956, racket/trunk/racket.install)
===================================================================
--- extra-i686/racket.install (rev 0)
+++ extra-i686/racket.install 2012-06-17 01:21:57 UTC (rev 161957)
@@ -0,0 +1,11 @@
+post_install() {
+ update-desktop-database -q
+}
+
+post_upgrade() {
+ post_install
+}
+
+post_remove() {
+ post_install
+}
Deleted: extra-x86_64/PKGBUILD
===================================================================
--- extra-x86_64/PKGBUILD 2012-06-17 01:21:29 UTC (rev 161956)
+++ extra-x86_64/PKGBUILD 2012-06-17 01:21:57 UTC (rev 161957)
@@ -1,32 +0,0 @@
-# $Id$
-# Maintainer: Eric Bélanger <eric at archlinux.org>
-
-pkgname=racket
-pkgver=5.2.1
-pkgrel=2
-pkgdesc="A programming language environment (formerly known as PLT Scheme) suitable for tasks ranging from scripting to application development"
-arch=('i686' 'x86_64')
-url="http://racket-lang.org/"
-license=('LGPL')
-depends=('gtk2' 'desktop-file-utils')
-makedepends=('gsfonts')
-options=('!libtool' '!strip')
-install=racket.install
-source=(http://download.racket-lang.org/installers/${pkgver}/racket/${pkgname}-${pkgver}-src-unix.tgz \
- drracket.desktop)
-sha1sums=('b51cdd8b9825edb60e5c2c80472cec8220918cd1'
- 'a20808f6b250225704856f82a544681a962a299d')
-
-build() {
- cd "${srcdir}/${pkgname}-${pkgver}/src"
- [ "$CARCH" == "x86_64" ] && export CFLAGS+="-fPIC"
- ./configure --prefix=/usr --enable-shared
- make
-}
-
-package() {
- cd "${srcdir}/${pkgname}-${pkgver}/src"
- make DESTDIR="${pkgdir}" install
- install -D -m644 ../collects/icons/plt.xpm "${pkgdir}/usr/share/pixmaps/drracket.xpm"
- install -D -m644 "${srcdir}/drracket.desktop" "${pkgdir}/usr/share/applications/drracket.desktop"
-}
Copied: racket/repos/extra-x86_64/PKGBUILD (from rev 161956, racket/trunk/PKGBUILD)
===================================================================
--- extra-x86_64/PKGBUILD (rev 0)
+++ extra-x86_64/PKGBUILD 2012-06-17 01:21:57 UTC (rev 161957)
@@ -0,0 +1,37 @@
+# $Id$
+# Maintainer: Eric Bélanger <eric at archlinux.org>
+
+pkgname=racket
+pkgver=5.2.1
+pkgrel=3
+pkgdesc="A programming language environment (formerly known as PLT Scheme) suitable for tasks ranging from scripting to application development"
+arch=('i686' 'x86_64')
+url="http://racket-lang.org/"
+license=('LGPL')
+depends=('gtk2' 'desktop-file-utils')
+makedepends=('gsfonts')
+options=('!libtool' '!strip')
+install=racket.install
+source=(http://download.racket-lang.org/installers/${pkgver}/racket/${pkgname}-${pkgver}-src-unix.tgz \
+ drracket.desktop drracket-normal.rkt)
+sha1sums=('b51cdd8b9825edb60e5c2c80472cec8220918cd1'
+ 'a20808f6b250225704856f82a544681a962a299d'
+ '6699e80e424479d45f427ba341003235e0d475cf')
+
+build() {
+ cd "${srcdir}/${pkgname}-${pkgver}/src"
+ [ "$CARCH" == "x86_64" ] && export CFLAGS+="-fPIC"
+ ./configure --prefix=/usr --enable-shared
+ make
+}
+
+package() {
+ cd "${srcdir}/${pkgname}-${pkgver}/src"
+ make DESTDIR="${pkgdir}" install
+
+ # FS#30245
+ install -D -m644 "${srcdir}/drracket-normal.rkt" "${pkgdir}/usr/lib/racket/collects/drracket/private/drracket-normal.rkt"
+
+ install -D -m644 ../collects/icons/plt.xpm "${pkgdir}/usr/share/pixmaps/drracket.xpm"
+ install -D -m644 "${srcdir}/drracket.desktop" "${pkgdir}/usr/share/applications/drracket.desktop"
+}
Copied: racket/repos/extra-x86_64/drracket-normal.rkt (from rev 161956, racket/trunk/drracket-normal.rkt)
===================================================================
--- extra-x86_64/drracket-normal.rkt (rev 0)
+++ extra-x86_64/drracket-normal.rkt 2012-06-17 01:21:57 UTC (rev 161957)
@@ -0,0 +1,199 @@
+#lang racket/base
+
+(require mred
+ racket/class
+ racket/cmdline
+ racket/list
+ framework/private/bday
+ framework/splash
+ racket/runtime-path
+ racket/file
+ "frame-icon.rkt"
+ "eb.rkt")
+
+(define-runtime-path doc-icon.rkt "dock-icon.rkt")
+
+(define files-to-open (command-line #:args filenames filenames))
+
+;; updates the command-line-arguments with only the files
+;; to open. See also main.rkt.
+(current-command-line-arguments (apply vector files-to-open))
+
+(define (currently-the-weekend?)
+ (define date (seconds->date (current-seconds)))
+ (define dow (date-week-day date))
+ (or (= dow 6) (= dow 0)))
+
+(define (valentines-day?)
+ (define date (seconds->date (current-seconds)))
+ (and (= 2 (date-month date))
+ (= 14 (date-day date))))
+
+(define (current-icon-state)
+ (cond
+ [(valentines-day?) 'valentines]
+ [(currently-the-weekend?) 'weekend]
+ [else 'normal]))
+
+(define-values (texas-independence-day? prince-kuhio-day? kamehameha-day? halloween?)
+ (let* ([date (seconds->date (current-seconds))]
+ [month (date-month date)]
+ [day (date-day date)]
+ [dow (date-week-day date)])
+ (values (and (= 3 month) (= 2 day))
+ #f
+ (and (= 6 month) (= 11 day))
+ (and (= 10 month) (= 31 day)))))
+
+
+(define special-state #f)
+
+(define (icons-bitmap name)
+ (make-object bitmap% (collection-file-path name "icons")))
+
+(define-struct magic-image (chars filename [bitmap #:mutable]))
+
+(define (magic-img str img)
+ (make-magic-image (reverse (string->list str)) img #f))
+
+;; magic strings and their associated images. There should not be a string
+;; in this list that is a prefix of another.
+(define magic-images
+ (list #;(magic-img "larval" "PLT-206-larval.png")
+ (magic-img "mars" "PLT-206-mars.jpg")))
+
+(define (load-magic-images)
+ (set! load-magic-images void) ; run only once
+ (for-each (λ (magic-image)
+ (unless (magic-image-bitmap magic-image)
+ (set-magic-image-bitmap!
+ magic-image
+ (icons-bitmap (magic-image-filename magic-image)))))
+ magic-images))
+
+(define longest-magic-string
+ (apply max (map (λ (s) (length (magic-image-chars s))) magic-images)))
+
+(define key-codes null)
+
+(define (find-magic-image)
+ (define (prefix? l1 l2)
+ (or (null? l1)
+ (and (pair? l2)
+ (eq? (car l1) (car l2))
+ (prefix? (cdr l1) (cdr l2)))))
+ (ormap (λ (i) (and (prefix? (magic-image-chars i) key-codes) i))
+ magic-images))
+
+(define (add-key-code new-code)
+ (set! key-codes (cons new-code key-codes))
+ (when ((length key-codes) . > . longest-magic-string)
+ (set! key-codes (take key-codes longest-magic-string))))
+
+(define (drracket-splash-char-observer evt)
+ (let ([ch (send evt get-key-code)])
+ (when (and (eq? ch #\q)
+ (send evt get-control-down))
+ (exit))
+ (when (char? ch)
+ ;; as soon as something is typed, load the bitmaps
+ (load-magic-images)
+ (add-key-code ch)
+ (let ([match (find-magic-image)])
+ (when match
+ (set! key-codes null)
+ (set-splash-bitmap
+ (if (eq? special-state match)
+ (begin (set! special-state #f) the-splash-bitmap)
+ (begin (set! special-state match)
+ (magic-image-bitmap match))))
+ (refresh-splash))))))
+
+(when (eb-bday?) (install-eb))
+
+(define weekend-bitmap-spec (collection-file-path "plt-logo-red-shiny.png" "icons"))
+(define normal-bitmap-spec (collection-file-path "plt-logo-red-diffuse.png" "icons"))
+(define valentines-days-spec (collection-file-path "heart.png" "icons"))
+
+(define the-bitmap-spec
+ (cond
+ [(valentines-day?)
+ valentines-days-spec]
+ [(or prince-kuhio-day? kamehameha-day?)
+ (set-splash-progress-bar?! #f)
+ (let ([size ((dynamic-require 'drracket/private/palaka 'palaka-pattern-size) 4)])
+ (vector (dynamic-require 'drracket/private/honu-logo 'draw-honu)
+ size
+ size))]
+ [texas-independence-day?
+ (collection-file-path "texas-plt-bw.gif" "icons")]
+ [halloween?
+ (collection-file-path "PLT-pumpkin.png" "icons")]
+ [(currently-the-weekend?)
+ weekend-bitmap-spec]
+ [else normal-bitmap-spec]))
+(define the-splash-bitmap (read-bitmap the-bitmap-spec))
+(set-splash-char-observer drracket-splash-char-observer)
+
+(when (eq? (system-type) 'macosx)
+ (define initial-state (current-icon-state))
+ (define weekend-bitmap (if (equal? the-bitmap-spec weekend-bitmap-spec)
+ the-splash-bitmap
+ #f))
+ (define weekday-bitmap (if (equal? the-bitmap-spec normal-bitmap-spec)
+ the-splash-bitmap
+ #f))
+ (define valentines-bitmap (if (equal? the-bitmap-spec valentines-days-spec)
+ the-splash-bitmap
+ #f))
+ (define set-doc-tile-bitmap (dynamic-require doc-icon.rkt 'set-dock-tile-bitmap))
+ (define (set-icon state)
+ (case state
+ [(valentines)
+ (unless valentines-bitmap (set! valentines-bitmap (read-bitmap valentines-days-spec)))
+ (set-doc-tile-bitmap valentines-bitmap)]
+ [(weekend)
+ (unless weekend-bitmap (set! weekend-bitmap (read-bitmap weekend-bitmap-spec)))
+ (set-doc-tile-bitmap weekend-bitmap)]
+ [(normal)
+ (unless weekday-bitmap (set! weekday-bitmap (read-bitmap normal-bitmap-spec)))
+ (set-doc-tile-bitmap weekday-bitmap)]))
+ (set-icon initial-state)
+ (void
+ (thread
+ (λ ()
+ (let loop ([last-state initial-state])
+ (sleep 10)
+ (define next-state (current-icon-state))
+ (unless (equal? last-state next-state)
+ (set-icon next-state))
+ (loop next-state))))))
+
+(start-splash the-splash-bitmap
+ "DrRacket"
+ 700
+ #:allow-funny? #t
+ #:frame-icon todays-icon)
+
+(when (getenv "PLTDRBREAK")
+ (printf "PLTDRBREAK: creating break frame\n") (flush-output)
+ (let ([to-break (eventspace-handler-thread (current-eventspace))])
+ (parameterize ([current-eventspace (make-eventspace)])
+ (let* ([f (new frame% (label "Break DrRacket"))]
+ [b (new button%
+ (label "Break Main Thread")
+ (callback
+ (λ (x y)
+ (break-thread to-break)))
+ (parent f))]
+ [b (new button%
+ (label "Break All Threads")
+ (callback
+ (λ (x y)
+ ((dynamic-require 'drracket/private/key 'break-threads))))
+ (parent f))])
+ (send f show #t)))))
+
+(dynamic-require 'drracket/tool-lib #f)
+(shutdown-splash)
+(close-splash)
Deleted: extra-x86_64/drracket.desktop
===================================================================
--- extra-x86_64/drracket.desktop 2012-06-17 01:21:29 UTC (rev 161956)
+++ extra-x86_64/drracket.desktop 2012-06-17 01:21:57 UTC (rev 161957)
@@ -1,9 +0,0 @@
-[Desktop Entry]
-Name=DrRacket
-GenericName=IDE for Racket
-Comment=DrRacket is an interactive, integrated, graphical programming environment for the Racket programming languages.
-Exec=drracket
-Terminal=false
-Type=Application
-Categories=Education;Development;
-Icon=drracket
Copied: racket/repos/extra-x86_64/drracket.desktop (from rev 161956, racket/trunk/drracket.desktop)
===================================================================
--- extra-x86_64/drracket.desktop (rev 0)
+++ extra-x86_64/drracket.desktop 2012-06-17 01:21:57 UTC (rev 161957)
@@ -0,0 +1,9 @@
+[Desktop Entry]
+Name=DrRacket
+GenericName=IDE for Racket
+Comment=DrRacket is an interactive, integrated, graphical programming environment for the Racket programming languages.
+Exec=drracket
+Terminal=false
+Type=Application
+Categories=Education;Development;
+Icon=drracket
Deleted: extra-x86_64/racket.install
===================================================================
--- extra-x86_64/racket.install 2012-06-17 01:21:29 UTC (rev 161956)
+++ extra-x86_64/racket.install 2012-06-17 01:21:57 UTC (rev 161957)
@@ -1,11 +0,0 @@
-post_install() {
- update-desktop-database -q
-}
-
-post_upgrade() {
- post_install
-}
-
-post_remove() {
- post_install
-}
Copied: racket/repos/extra-x86_64/racket.install (from rev 161956, racket/trunk/racket.install)
===================================================================
--- extra-x86_64/racket.install (rev 0)
+++ extra-x86_64/racket.install 2012-06-17 01:21:57 UTC (rev 161957)
@@ -0,0 +1,11 @@
+post_install() {
+ update-desktop-database -q
+}
+
+post_upgrade() {
+ post_install
+}
+
+post_remove() {
+ post_install
+}
More information about the arch-commits
mailing list