From e402d68efc6c199795fceee0d2f02c2ea3619056 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 7 Nov 2010 07:08:29 -0700 Subject: [PATCH] fix `find-graphical-system-path' --- collects/mred/mred.rkt | 16 ++- collects/mred/private/wx/cocoa/procs.rkt | 3 +- collects/mred/private/wx/gtk/procs.rkt | 9 +- collects/mred/private/wx/gtk/queue.rkt | 103 ++++++++++--------- collects/mred/private/wx/win32/procs.rkt | 6 +- collects/scribblings/gui/miscwin-funcs.scrbl | 6 +- src/gracket/grmain.c | 4 +- src/racket/main.c | 4 +- 8 files changed, 87 insertions(+), 64 deletions(-) diff --git a/collects/mred/mred.rkt b/collects/mred/mred.rkt index 5c10a451a5..3c9e5ed1c6 100644 --- a/collects/mred/mred.rkt +++ b/collects/mred/mred.rkt @@ -116,7 +116,6 @@ event% event-dispatch-handler eventspace? - find-graphical-system-path flush-display get-highlight-background-color get-highlight-text-color @@ -172,6 +171,18 @@ (define the-clipboard (wx:get-the-clipboard)) (define the-x-selection-clipboard (wx:get-the-x-selection)) + (define (find-graphical-system-path what) + (unless (memq what '(init-file x-display)) + (raise-type-error 'find-graphical-system-path "'init-file or 'x-display" what)) + (or (wx:find-graphical-system-path what) + (case what + [(init-file) + (build-path (find-system-path 'init-dir) + (case (system-type) + [(windows) "gracketrc.rktl"] + [else ".gracketrc"]))] + [else #f]))) + (provide (all-from racket/draw)) (provide button% @@ -282,4 +293,5 @@ hide-cursor-until-moved system-position-ok-before-cancel? label-string? - key-code-symbol?)) + key-code-symbol? + find-graphical-system-path)) diff --git a/collects/mred/private/wx/cocoa/procs.rkt b/collects/mred/private/wx/cocoa/procs.rkt index ed872b4ad4..77866d045d 100644 --- a/collects/mred/private/wx/cocoa/procs.rkt +++ b/collects/mred/private/wx/cocoa/procs.rkt @@ -65,7 +65,8 @@ (import-class NSScreen NSCursor) -(define-unimplemented find-graphical-system-path) +(define (find-graphical-system-path what) + #f) (define (color-from-user-platform-mode) "Show Picker") diff --git a/collects/mred/private/wx/gtk/procs.rkt b/collects/mred/private/wx/gtk/procs.rkt index 86e06ef1b3..1dc5c90364 100644 --- a/collects/mred/private/wx/gtk/procs.rkt +++ b/collects/mred/private/wx/gtk/procs.rkt @@ -13,6 +13,7 @@ "window.rkt" "frame.rkt" "dc.rkt" + "queue.rkt" "printer-dc.rkt" "gl-context.rkt" "../common/printer.rkt" @@ -59,8 +60,12 @@ fill-private-color get-color-from-user) -(define-unimplemented find-graphical-system-path) -(define-unimplemented cancel-quit) +(define (find-graphical-system-path what) + (case what + [(x-display) (string->path x11-display)] + [else #f])) + +(define (cancel-quit) (void)) (define-unimplemented play-sound) diff --git a/collects/mred/private/wx/gtk/queue.rkt b/collects/mred/private/wx/gtk/queue.rkt index a37d81eb44..80855f657e 100644 --- a/collects/mred/private/wx/gtk/queue.rkt +++ b/collects/mred/private/wx/gtk/queue.rkt @@ -12,7 +12,8 @@ (provide (protect-out gtk-start-event-pump try-to-sync-refresh - set-widget-hook!) + set-widget-hook! + x11-display) ;; from common/queue: current-eventspace queue-event @@ -24,55 +25,57 @@ (define-gtk gtk_init_check (_fun (_ptr io _int) (_ptr io _gcpointer) -> _gboolean)) -(let* ([argc-ptr (scheme_register_process_global "PLT_X11_ARGUMENT_COUNT" #f)] - [argc (or (and argc-ptr (cast argc-ptr _pointer _long)) 0)] - [argv (and (positive? argc) - (scheme_register_process_global "PLT_X11_ARGUMENTS" #f))] - [display (getenv "DISPLAY")]) - ;; Convert X11 arguments, if any, to Gtk form: - (let-values ([(args single-instance?) - (if (zero? argc) - (values null #f) - (let loop ([i 1][si? #f]) - (if (= i argc) - (values null si?) - (let ([s (ptr-ref argv _bytes i)]) - (cond - [(bytes=? s #"-display") - (let-values ([(args si?) (loop (+ i 2) si?)] - [(d) (ptr-ref argv _bytes (add1 i))]) - (set! display (bytes->string/utf-8 d #\?)) - (values (list* #"--display" d args) - si?))] - [(bytes=? s #"-synchronous") - (let-values ([(args si?) (loop (+ i 1) si?)]) - (values (cons #"--sync" args) - si?))] - [(bytes=? s #"-singleInstance") - (loop (add1 i) #t)] - [(or (bytes=? s #"-iconic") - (bytes=? s #"-rv") - (bytes=? s #"+rv") - (bytes=? s #"-reverse")) - ;; ignored with 0 arguments - (loop (add1 i) #t)] - [else - ;; all other ignored flags have a single argument - (loop (+ i 2) #t)])))))]) - (let-values ([(new-argc new-argv) - (if (null? args) - (values 0 #f) - (values (add1 (length args)) - (cast (cons (ptr-ref argv _bytes 0) - args) - (_list i _bytes) - _pointer)))]) - (unless (gtk_init_check new-argc new-argv) - (error (format - "Gtk initialization failed for display ~s" - (or display ":0")))) - (when single-instance? - (do-single-instance))))) +(define x11-display + (let* ([argc-ptr (scheme_register_process_global "PLT_X11_ARGUMENT_COUNT" #f)] + [argc (or (and argc-ptr (cast argc-ptr _pointer _long)) 0)] + [argv (and (positive? argc) + (scheme_register_process_global "PLT_X11_ARGUMENTS" #f))] + [display (getenv "DISPLAY")]) + ;; Convert X11 arguments, if any, to Gtk form: + (let-values ([(args single-instance?) + (if (zero? argc) + (values null #f) + (let loop ([i 1][si? #f]) + (if (= i argc) + (values null si?) + (let ([s (ptr-ref argv _bytes i)]) + (cond + [(bytes=? s #"-display") + (let-values ([(args si?) (loop (+ i 2) si?)] + [(d) (ptr-ref argv _bytes (add1 i))]) + (set! display (bytes->string/utf-8 d #\?)) + (values (list* #"--display" d args) + si?))] + [(bytes=? s #"-synchronous") + (let-values ([(args si?) (loop (+ i 1) si?)]) + (values (cons #"--sync" args) + si?))] + [(bytes=? s #"-singleInstance") + (loop (add1 i) #t)] + [(or (bytes=? s #"-iconic") + (bytes=? s #"-rv") + (bytes=? s #"+rv") + (bytes=? s #"-reverse")) + ;; ignored with 0 arguments + (loop (add1 i) #t)] + [else + ;; all other ignored flags have a single argument + (loop (+ i 2) #t)])))))]) + (let-values ([(new-argc new-argv) + (if (null? args) + (values 0 #f) + (values (add1 (length args)) + (cast (cons (ptr-ref argv _bytes 0) + args) + (_list i _bytes) + _pointer)))]) + (unless (gtk_init_check new-argc new-argv) + (error (format + "Gtk initialization failed for display ~s" + (or display ":0")))) + (when single-instance? + (do-single-instance)) + display)))) ;; ------------------------------------------------------------ ;; Gtk event pump diff --git a/collects/mred/private/wx/win32/procs.rkt b/collects/mred/private/wx/win32/procs.rkt index 8ec87a939a..c88d403c4d 100644 --- a/collects/mred/private/wx/win32/procs.rkt +++ b/collects/mred/private/wx/win32/procs.rkt @@ -60,8 +60,10 @@ get-color-from-user) -(define-unimplemented find-graphical-system-path) -(define-unimplemented cancel-quit) +(define (find-graphical-system-path what) + #f) + +(define (cancel-quit) (void)) (define (color-from-user-platform-mode) 'dialog) diff --git a/collects/scribblings/gui/miscwin-funcs.scrbl b/collects/scribblings/gui/miscwin-funcs.scrbl index 64bbb43cb3..fa69a6520a 100644 --- a/collects/scribblings/gui/miscwin-funcs.scrbl +++ b/collects/scribblings/gui/miscwin-funcs.scrbl @@ -56,8 +56,8 @@ The get operation always returns @racket[#"????"] and @racket[#"????"] for Windows. } -@defproc[(find-graphical-system-path [what (one-of/c 'init-file 'setup-file 'x-display)]) - (or/c path? false/c)]{ +@defproc[(find-graphical-system-path [what (one-of/c 'init-file 'x-display)]) + (or/c path? #f)]{ Finds a platform-specific (and possibly user- or machine-specific) standard filename or directory. See also @racket[find-system-path]. @@ -75,7 +75,7 @@ The result depends on @racket[what], and a @racket[#f] result is only @itemize[ @item{@|AllUnix|: @indexed-file{.gracketrc}} - @item{Windows: @indexed-file{racketrc.rktl}} + @item{Windows: @indexed-file{gracketrc.rktl}} ]} diff --git a/src/gracket/grmain.c b/src/gracket/grmain.c index 04fafb187c..d65a10ae3d 100644 --- a/src/gracket/grmain.c +++ b/src/gracket/grmain.c @@ -31,8 +31,8 @@ static void pre_filter_cmdline_arguments(int *argc, char ***argv); #endif #define UNIX_INIT_FILENAME "~/.gracketrc" -#define WINDOWS_INIT_FILENAME "%%HOMEDIRVE%%\\%%HOMEPATH%%\\gracketrc.rktd" -#define MACOS9_INIT_FILENAME "PREFERENCES:gracketrc.rktd" +#define WINDOWS_INIT_FILENAME "%%HOMEDIRVE%%\\%%HOMEPATH%%\\gracketrc.rktl" +#define MACOS9_INIT_FILENAME "PREFERENCES:gracketrc.rktl" #define GET_INIT_FILENAME get_gr_init_filename #if WIN32 # define NEED_CONSOLE_PRINTF diff --git a/src/racket/main.c b/src/racket/main.c index 7dca2c4e13..3c0672956f 100644 --- a/src/racket/main.c +++ b/src/racket/main.c @@ -127,8 +127,8 @@ extern Scheme_Object *scheme_initialize(Scheme_Env *env); #ifndef UNIX_INIT_FILENAME # define UNIX_INIT_FILENAME "~/.racketrc" -# define WINDOWS_INIT_FILENAME "%%HOMEDIRVE%%\\%%HOMEPATH%%\\racketrc.rktd" -# define MACOS9_INIT_FILENAME "PREFERENCES:racketrc.rktd" +# define WINDOWS_INIT_FILENAME "%%HOMEDIRVE%%\\%%HOMEPATH%%\\racketrc.rktl" +# define MACOS9_INIT_FILENAME "PREFERENCES:racketrc.rktl" # define GET_INIT_FILENAME get_init_filename # define PRINTF printf # define PROGRAM "Racket"