diff options
author | Michał Masłowski <mtjm@mtjm.eu> | 2013-02-10 11:32:41 +0100 |
---|---|---|
committer | Michał Masłowski <mtjm@mtjm.eu> | 2013-02-10 11:32:41 +0100 |
commit | bdf817c3549ba377334deb1161de703579670d62 (patch) | |
tree | c1b80c05c917cda2619e267049978f971bdad169 /extra/racket | |
parent | df609724f30aaccfb05d9fb73f68e7a37118f2f8 (diff) | |
parent | 1bb2648cde916ac27d3dd75d7b64a4ddc89787b7 (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.rkt | 199 |
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) |