summaryrefslogtreecommitdiff
path: root/extra/racket
diff options
context:
space:
mode:
authorMichał Masłowski <mtjm@mtjm.eu>2013-02-10 11:32:41 +0100
committerMichał Masłowski <mtjm@mtjm.eu>2013-02-10 11:32:41 +0100
commitbdf817c3549ba377334deb1161de703579670d62 (patch)
treec1b80c05c917cda2619e267049978f971bdad169 /extra/racket
parentdf609724f30aaccfb05d9fb73f68e7a37118f2f8 (diff)
parent1bb2648cde916ac27d3dd75d7b64a4ddc89787b7 (diff)
Merge branch 'master' of ssh://parabolagnulinux.org:1863/home/parabola/abslibre-pre-mips64el
Conflicts: community/cdemu-client/PKGBUILD community/dcron/PKGBUILD community/freevo/PKGBUILD community/gmerlin-avdecoder/PKGBUILD community/hacburn/PKGBUILD community/htmldoc/PKGBUILD community/ibus-table/PKGBUILD community/iksemel/PKGBUILD community/isomaster/PKGBUILD community/libmatio/PKGBUILD community/libtlen/PKGBUILD community/luarocks/PKGBUILD community/lxde-common/PKGBUILD community/multipath-tools/PKGBUILD community/nvclock/PKGBUILD community/pam-krb5/PKGBUILD community/pidgin-musictracker/PKGBUILD community/pkgfile/PKGBUILD community/pkgtools/PKGBUILD community/print-manager/PKGBUILD community/python-pyro/PKGBUILD community/python-pyxmpp/PKGBUILD community/python2-simplejson/PKGBUILD community/rsnapshot/PKGBUILD community/setconf/PKGBUILD community/tagpy/PKGBUILD community/terminator/PKGBUILD community/udunits/PKGBUILD community/vlock/PKGBUILD community/winefish/PKGBUILD core/nss-myhostname/PKGBUILD extra/avfs/PKGBUILD extra/bmp-musepack/PKGBUILD extra/bmp-wma/PKGBUILD extra/bochs/PKGBUILD extra/botan/PKGBUILD extra/cdargs/PKGBUILD extra/cx_freeze/PKGBUILD extra/dcfldd/PKGBUILD extra/devilspie/PKGBUILD extra/emelfm2/PKGBUILD extra/evilwm/PKGBUILD extra/fssos-nsvs/PKGBUILD extra/gimp-dbp/PKGBUILD extra/gimp-gap/PKGBUILD extra/gimp-ufraw/PKGBUILD extra/gmpc/PKGBUILD extra/gtkpod/PKGBUILD extra/hercules/PKGBUILD extra/herqq/PKGBUILD extra/hydrogen/PKGBUILD extra/kdegames/PKGBUILD extra/kradio/PKGBUILD extra/kshutdown/PKGBUILD extra/libmusicbrainz4/PKGBUILD extra/mahjong/PKGBUILD extra/mcrypt/PKGBUILD extra/monica/PKGBUILD extra/mpck/PKGBUILD extra/mrtg/PKGBUILD extra/nicotine/PKGBUILD extra/normalize/PKGBUILD extra/oprofile/PKGBUILD extra/perl-event/PKGBUILD extra/perl-unicode-string/PKGBUILD extra/pidgin-encryption/PKGBUILD extra/proftpd/PKGBUILD extra/pymad/PKGBUILD extra/qiv/PKGBUILD extra/quodlibet/PKGBUILD extra/ratpoison/PKGBUILD extra/rox/PKGBUILD extra/scrot/PKGBUILD extra/stardict/PKGBUILD extra/terminal/PKGBUILD extra/usbview/PKGBUILD extra/xdelta/PKGBUILD extra/xdelta3/PKGBUILD extra/xorg-xlsfonts/PKGBUILD extra/zile/PKGBUILD mozilla-testing/iceweasel-libre/mozconfig mozilla-testing/iceweasel-libre/vendor.js social/tokyocabinet/PKGBUILD ~fauno/notmuch/PKGBUILD ~mtjm/thinkfan/PKGBUILD ~mtjm/zbar/PKGBUILD
Diffstat (limited to 'extra/racket')
-rw-r--r--extra/racket/drracket-normal.rkt199
1 files changed, 0 insertions, 199 deletions
diff --git a/extra/racket/drracket-normal.rkt b/extra/racket/drracket-normal.rkt
deleted file mode 100644
index 5ed11c21c..000000000
--- a/extra/racket/drracket-normal.rkt
+++ /dev/null
@@ -1,199 +0,0 @@
-#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)