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

fix `find-graphical-system-path'

Browse Source
This commit is contained in:
Matthew Flatt 2010-11-07 07:08:29 -07:00
parent ba2ea79f12
commit e402d68efc
8 changed files with 87 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/mred/mred.rkt
View File

@ -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))

3
collects/mred/private/wx/cocoa/procs.rkt
View File

@ -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")

9
collects/mred/private/wx/gtk/procs.rkt
View File

@ -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)

103
collects/mred/private/wx/gtk/queue.rkt
View File

@ -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

6
collects/mred/private/wx/win32/procs.rkt
View File

@ -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)

6
collects/scribblings/gui/miscwin-funcs.scrbl
View File

@ -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}}
]}

4
src/gracket/grmain.c
View File

@ -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

4
src/racket/main.c
View File

@ -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"