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

.

Browse Source 
original commit: e726acc8f8e0ad15e547d45c8e1aba9775cf79c3
This commit is contained in:
Matthew Flatt 2003-09-04 19:19:34 +00:00
parent 4e3910509b
commit 8b3e75b231
2 changed files with 16 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/mred/mred-sig.ss
View File

@ -78,6 +78,7 @@
get-color-from-user get-color-from-user
get-directory get-directory
get-display-depth get-display-depth
get-display-left-top-inset
get-display-size get-display-size
get-face-list get-face-list
get-family-builtin-face get-family-builtin-face

18
collects/mred/mred.ss
View File

@ -4160,8 +4160,11 @@
(let ([cwho '(constructor frame)]) (let ([cwho '(constructor frame)])
(check-label-string cwho label) (check-label-string cwho label)
(check-frame-parent/false cwho parent) (check-frame-parent/false cwho parent)
(for-each (lambda (x) (check-dimension cwho x)) (list width height x y)) (check-dimension cwho width)
(check-style cwho #f '(no-resize-border no-caption no-system-menu mdi-parent mdi-child toolbar-button) (check-dimension cwho height)
(check-init-pos-integer cwho x)
(check-init-pos-integer cwho y)
(check-style cwho #f '(no-resize-border no-caption no-system-menu mdi-parent mdi-child toolbar-button hide-menu-bar)
style) style)
(when (memq 'mdi-child style) (when (memq 'mdi-child style)
(when (memq 'mdi-parent style) (when (memq 'mdi-parent style)
@ -4210,7 +4213,7 @@
(lambda (finish) (lambda (finish)
(set! wx (finish (make-object wx-frame% this this (set! wx (finish (make-object wx-frame% this this
(and parent (mred->wx parent)) label (and parent (mred->wx parent)) label
(or x -1) (or y -1) (or x -11111) (or y -11111)
(or width -1) (or height -1) (or width -1) (or height -1)
style) style)
(memq 'mdi-parent style))) (memq 'mdi-parent style)))
@ -6828,6 +6831,12 @@
(wx:display-size xb yb (if full-screen? 1 0)) (wx:display-size xb yb (if full-screen? 1 0))
(values (unbox xb) (unbox yb))))) (values (unbox xb) (unbox yb)))))
(define (get-display-left-top-inset)
(let ([xb (box 0)]
[yb (box 0)])
(wx:display-origin xb yb)
(values (unbox xb) (unbox yb))))
;; Currently only used for PS print and preview ;; Currently only used for PS print and preview
(wx:set-executer (wx:set-executer
(let ([orig-err (current-error-port)]) (let ([orig-err (current-error-port)])
@ -7127,6 +7136,8 @@
(define check-slider-integer (check-bounded-integer -10000 10000 #f)) (define check-slider-integer (check-bounded-integer -10000 10000 #f))
(define check-init-pos-integer (check-bounded-integer -10000 10000 #t))
(define check-margin-integer (check-bounded-integer 0 1000 #f)) (define check-margin-integer (check-bounded-integer 0 1000 #f))
(define check-gauge-integer (check-bounded-integer 1 10000 #f)) (define check-gauge-integer (check-bounded-integer 1 10000 #f))
@ -7761,6 +7772,7 @@
get-ps-setup-from-user get-ps-setup-from-user
play-sound play-sound
get-display-size get-display-size
get-display-left-top-inset
get-color-from-user get-color-from-user
get-font-from-user get-font-from-user
append-editor-operation-menu-items append-editor-operation-menu-items