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

cocoa tab-panel in no-border mode uses PSMTabBarControl

Browse Source
This commit is contained in:
Matthew Flatt 2010-09-04 07:23:25 -06:00
parent b3f1cc4b41
commit 15a7a2a006
8 changed files with 208 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/mred/private/mrpanel.rkt
View File

@ -131,9 +131,11 @@
(check-container-parent cwho parent)
(check-style cwho #f '(deleted no-border) style)
(check-font cwho font))
(super-init parent (if (memq 'deleted style)
'(deleted)
null))
(super-init parent (if (memq 'no-border style)
(if (eq? (car style) 'no-border)
(cdr style)
(list (car style)))
(cons 'border style)))
(send (mred->wx this) set-callback callback))
(public

4
collects/mred/private/wx/cocoa/canvas.rkt
View File

@ -47,7 +47,7 @@
(tellv ctx restoreGraphicsState)))))))
(define-objc-class MyView NSView
#:mixins (FocusResponder KeyMouseResponder CursorDisplayer)
#:mixins (FocusResponder KeyMouseTextResponder CursorDisplayer)
[wxb]
(-a _void (drawRect: [_NSRect r])
(when wxb
@ -127,7 +127,7 @@
(tellv ctx restoreGraphicsState)))))
(define-objc-class MyComboBox NSComboBox
#:mixins (FocusResponder KeyMouseResponder CursorDisplayer)
#:mixins (FocusResponder KeyMouseTextResponder CursorDisplayer)
#:protocols (NSComboBoxDelegate)
[wxb]
(-a _void (drawRect: [_NSRect r])

83
collects/mred/private/wx/cocoa/tab-panel.rkt
View File

@ -14,7 +14,11 @@
(provide tab-panel%)
(import-class NSView NSTabView NSTabViewItem)
;; Load PSMTabBarControl:
(void (ffi-lib "PSMTabBarControl.framework/PSMTabBarControl"))
(define NSNoTabsNoBorder 6)
(import-class NSView NSTabView NSTabViewItem PSMTabBarControl)
(import-protocol NSTabViewDelegate)
(define-objc-class MyTabView NSTabView
@ -24,6 +28,13 @@
(-a _void (tabView: [_id cocoa] didSelectTabViewItem: [_id item-cocoa])
(queue-window*-event wxb (lambda (wx) (send wx do-callback)))))
(define-objc-class MyPSMTabBarControl PSMTabBarControl
#:mixins (FocusResponder KeyMouseResponder CursorDisplayer)
[wxb]
(-a _void (tabView: [_id cocoa] didSelectTabViewItem: [_id item-cocoa])
(super-tell #:type _void tabView: cocoa didSelectTabViewItem: item-cocoa)
(queue-window*-event wxb (lambda (wx) (send wx do-callback)))))
(defclass tab-panel% (panel-mixin window%)
(init parent
x y w h
@ -31,38 +42,73 @@
labels)
(inherit get-cocoa)
(define cocoa (as-objc-allocation
(tell (tell MyTabView alloc) init)))
(define tabv-cocoa (as-objc-allocation
(tell (tell MyTabView alloc) init)))
(define cocoa (if (not (memq 'border style))
(tell (tell NSView alloc) init)
tabv-cocoa))
(define control-cocoa
(and (not (memq 'border style))
(let ([i (as-objc-allocation
(tell (tell MyPSMTabBarControl alloc)
initWithFrame: #:type _NSRect (make-NSRect (make-NSPoint 0 0)
(make-NSSize 200 22))))])
(tellv cocoa addSubview: i)
(tellv cocoa addSubview: tabv-cocoa)
(tellv tabv-cocoa setDelegate: i)
(tellv tabv-cocoa setTabViewType: #:type _int NSNoTabsNoBorder)
(tellv i setTabView: tabv-cocoa)
(tellv i setStyleNamed: #:type _NSString "Aqua")
;;(tellv i setSizeCellsToFit: #:type _BOOL #t)
(tellv i setDisableTabClose: #:type _BOOL #t)
i)))
(define item-cocoas
(for/list ([lbl (in-list labels)])
(let ([item (as-objc-allocation
(tell (tell NSTabViewItem alloc) initWithIdentifier: #f))])
(tellv item setLabel: #:type _NSString (label->plain-label lbl))
(tellv cocoa addTabViewItem: item)
(tellv tabv-cocoa addTabViewItem: item)
item)))
(let ([sz (tell #:type _NSSize cocoa minimumSize)])
(tellv cocoa setFrame: #:type _NSRect (make-NSRect (make-init-point x y) sz)))
(tellv cocoa setDelegate: cocoa)
(if control-cocoa
(tellv cocoa setFrame: #:type _NSRect (make-NSRect (make-init-point x y)
(make-NSSize 50 22)))
(let ([sz (tell #:type _NSSize tabv-cocoa minimumSize)])
(tellv tabv-cocoa setFrame: #:type _NSRect (make-NSRect (make-init-point x y) sz))
(tellv tabv-cocoa setDelegate: tabv-cocoa)))
(define content-cocoa
(as-objc-allocation
(tell (tell NSView alloc)
initWithFrame: #:type _NSRect (tell #:type _NSRect cocoa contentRect))))
(tell #:type _void cocoa addSubview: content-cocoa)
initWithFrame: #:type _NSRect (tell #:type _NSRect tabv-cocoa contentRect))))
(tellv tabv-cocoa addSubview: content-cocoa)
(define/override (get-cocoa-content) content-cocoa)
(define/override (get-cocoa-cursor-content) cocoa)
(define/override (get-cocoa-cursor-content) tabv-cocoa)
(define/override (set-size x y w h)
(super set-size x y w h)
(tellv content-cocoa setFrame: #:type _NSRect (tell #:type _NSRect cocoa contentRect)))
(when control-cocoa
(let ([r (tell #:type _NSRect cocoa frame)])
(tellv control-cocoa setFrame: #:type _NSRect (make-NSRect (make-NSPoint
0
(- (NSSize-height (NSRect-size r)) 22))
(make-NSSize
(NSSize-width (NSRect-size r))
22)))
(tellv tabv-cocoa setFrame: #:type _NSRect (make-NSRect (make-NSPoint 0 0)
(make-NSSize
(NSSize-width (NSRect-size r))
(- (NSSize-height (NSRect-size r)) 22))))))
(tellv content-cocoa setFrame: #:type _NSRect (tell #:type _NSRect tabv-cocoa contentRect)))
(define/public (set-label i str)
(tellv (list-ref item-cocoas i) setLabel: #:type _NSString (label->plain-label str)))
(define/public (set-selection i)
(tellv cocoa selectTabViewItem: (list-ref item-cocoas i)))
(tellv tabv-cocoa selectTabViewItem: (list-ref item-cocoas i)))
(define/public (get-selection)
(item->index (tell cocoa selectedTabViewItem)))
(item->index (tell tabv-cocoa selectedTabViewItem)))
(define (item->index tv)
(for/or ([c (in-list item-cocoas)]
@ -74,17 +120,17 @@
(let ([item (as-objc-allocation
(tell (tell NSTabViewItem alloc) initWithIdentifier: #f))])
(tellv item setLabel: #:type _NSString (label->plain-label lbl))
(tellv cocoa addTabViewItem: item)
(tellv tabv-cocoa addTabViewItem: item)
(set! item-cocoas (append item-cocoas (list item)))))
(define/public (delete i)
(let ([item-cocoa (list-ref item-cocoas i)])
(tellv cocoa removeTabViewItem: item-cocoa)
(tellv tabv-cocoa removeTabViewItem: item-cocoa)
(set! item-cocoas (remq item-cocoa item-cocoas))))
(define/public (set choices)
(for ([item-cocoa (in-list item-cocoas)])
(tellv cocoa removeTabViewItem: item-cocoa))
(tellv tabv-cocoa removeTabViewItem: item-cocoa))
(set! item-cocoas null)
(for ([lbl (in-list choices)])
(append* lbl)))
@ -98,4 +144,7 @@
(super-new [parent parent]
[cocoa cocoa]
[no-show? (memq 'deleted style)]))
[no-show? (memq 'deleted style)])
(when control-cocoa
(set-ivar! control-cocoa wxb (->wxb this))))

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

@ -58,4 +58,5 @@
(make-weak-box wx))
(define (->wx wxb)
(weak-box-value wxb))
(and wxb
(weak-box-value wxb)))

31
collects/mred/private/wx/cocoa/window.rkt
View File

@ -22,6 +22,7 @@
FocusResponder
KeyMouseResponder
KeyMouseTextResponder
CursorDisplayer
queue-window-event
@ -49,6 +50,9 @@
(when wx (send wx is-responder wx #f))
#t))])
(import-class NSArray)
(import-protocol NSTextInput)
(define-objc-mixin (KeyMouseResponder Superclass)
[wxb]
[-a _void (mouseDown: [_id event])
@ -106,9 +110,20 @@
(super-tell #:type _void keyDown: event))]
[-a _void (insertText: [_NSString str])
(let ([wx (->wx wxb)])
(post-dummy-event) ;; to wake up in case of character palette insert
(when wx
(queue-window-event wx (lambda ()
(send wx key-event-as-string str)))))])
(send wx key-event-as-string str)))))]
;; for NSTextInput, to enable character palette insert:
[-a _BOOL (hasMarkedText) #f]
[-a _id (validAttributesForMarkedText)
(tell NSArray array)])
(define-objc-mixin (KeyMouseTextResponder Superclass)
#:mixins (KeyMouseResponder)
#:protocols (NSTextInput)
[wxb])
(define-objc-mixin (CursorDisplayer Superclass)
[wxb]
@ -124,16 +139,24 @@
(let* ([modifiers (tell #:type _NSUInteger event modifierFlags)]
[bit? (lambda (m b) (positive? (bitwise-and m b)))]
[pos (tell #:type _NSPoint event locationInWindow)]
[str (tell #:type _NSString event characters)])
[str (tell #:type _NSString event characters)]
[control? (bit? modifiers NSControlKeyMask)])
(let-values ([(x y) (send wx window-point-to-view pos)])
(let ([k (new key-event%
[key-code (or
(map-key-code (tell #:type _ushort event keyCode))
(if (string=? "" str)
#\nul
(string-ref str 0)))]
(let ([c (string-ref str 0)])
(or (and control?
(char<=? #\u00 c #\u1a)
(let ([alt-str (tell #:type _NSString event charactersIgnoringModifiers)])
(and (string? alt-str)
(= 1 (string-length alt-str))
(string-ref alt-str 0))))
c))))]
[shift-down (bit? modifiers NSShiftKeyMask)]
[control-down (bit? modifiers NSControlKeyMask)]
[control-down control?]
[meta-down (bit? modifiers NSCommandKeyMask)]
[alt-down (bit? modifiers NSAlternateKeyMask)]
[x (->long x)]

11
src/gracket/Makefile.in
View File

@ -68,15 +68,18 @@ LINKRESULT_wx_xt = gracket@CGC@
LINKRESULT_wx_mac = GRacket@CGC@.app/Contents/MacOS/GRacket@CGC@
LINKRESULT = $(LINKRESULT_@WXVARIANT@)
# Incremented each time the binaries change:
DOWNLOAD_BIN_VERSION = 2
bin:
$(MAKE) @MAIN_VARIANT@
3m:
$(MAKE) libs/ready
$(MAKE) libs/ready$(DOWNLOAD_BIN_VERSION)
cd gc2; $(MAKE) 3m
cgc:
$(MAKE) libs/ready
$(MAKE) libs/ready$(DOWNLOAD_BIN_VERSION)
$(MAKE) $(LINKRESULT)
both:
@ -123,8 +126,8 @@ grmain_ee.@LTO@ : gracket.@LTO@
ee-main:
$(MAKE) grmain_ee.@LTO@
libs/ready:
$(RACKET) -c "$(srcdir)/get-libs.rkt" --ready "$(srcdir)" libs
libs/ready$(DOWNLOAD_BIN_VERSION):
$(RACKET) -c "$(srcdir)/get-libs.rkt" --ready $(DOWNLOAD_BIN_VERSION) "$(srcdir)" libs
clean:
rm -f *.@LTO@ *.d core gracket gracket3m

138
src/gracket/get-libs.rkt
View File

@ -5,7 +5,7 @@
;; it is loaded without using bytecode.
(define mode (make-parameter 'download))
(define touch-ready? (make-parameter #f))
(define touch-ready (make-parameter #f))
(define-values (src-dir dest-dir)
(command-line
@ -13,7 +13,7 @@
[("--download") "download mode (the default)" (mode 'download)]
[("--install") "install mode" (mode 'install)]
#:once-each
[("--ready") "touch `ready' on download success" (touch-ready? #t)]
[("--ready") n "touch `ready<n>' on download success" (touch-ready n)]
#:args
(src-dir dest-dir)
(values src-dir dest-dir)))
@ -22,46 +22,63 @@
(define url-path "/mflatt/gracket-libs/raw/master/")
(define url-base (string-append "http://" url-host url-path))
(define needed-files
(define needed-files+sizes
(case (system-type)
[(unix)
;; Pre-built binaries are for Windows and Mac only
null]
[(macosx)
'("libcairo.2.dylib"
"libintl.8.dylib"
"libgio-2.0.0.dylib"
"libjpeg.62.dylib"
"libglib-2.0.0.dylib"
"libpango-1.0.0.dylib"
"libgmodule-2.0.0.dylib"
"libpangocairo-1.0.0.dylib"
"libgobject-2.0.0.dylib"
"libpixman-1.0.dylib"
"libgthread-2.0.0.dylib"
"libpng14.14.dylib")]
(case (string->symbol (path->string (system-library-subpath)))
[(i386-macosx)
'(["libcairo.2.dylib" 831084]
["libintl.8.dylib" 57536]
["libgio-2.0.0.dylib" 748360]
["libjpeg.62.dylib" 412024]
["libglib-2.0.0.dylib" 1015008]
["libpango-1.0.0.dylib" 347180]
["libgmodule-2.0.0.dylib" 19016]
["libpangocairo-1.0.0.dylib" 84340]
["libgobject-2.0.0.dylib" 288252]
["libpixman-1.0.dylib" 459304]
["libgthread-2.0.0.dylib" 24592]
["libpng14.14.dylib" 182992]
["PSMTabBarControl.tgz" 91318])]
[(x86_64-macosx)
'(["libcairo.2.dylib" 927464]
["libintl.8.dylib" 61016]
["libgio-2.0.0.dylib" 897624]
["libjpeg.62.dylib" 153360]
["libglib-2.0.0.dylib" 1162256]
["libpango-1.0.0.dylib" 394768]
["libgmodule-2.0.0.dylib" 19832]
["libpangocairo-1.0.0.dylib" 94952]
["libgobject-2.0.0.dylib" 344024]
["libpixman-1.0.dylib" 499440]
["libgthread-2.0.0.dylib" 21728]
["libpng14.14.dylib" 192224]
["PSMTabBarControl.tgz" 107171])])]
[(windows)
'("freetype6.dll"
"libgobject-2.0-0.dll"
"libatk-1.0-0.dll"
"libgtk-win32-2.0-0.dll"
"libcairo-2.dll"
"libjpeg-7.dll"
"libexpat-1.dll"
"libpango-1.0-0.dll"
"libfontconfig-1.dll"
"libpangocairo-1.0-0.dll"
"libgdk-win32-2.0-0.dll"
"libpangoft2-1.0-0.dll"
"libgdk_pixbuf-2.0-0.dll"
"libpangowin32-1.0-0.dll"
"libgio-2.0-0.dll"
"libpng14-14.dll"
"libglib-2.0-0.dll"
"libwimp.dll"
"libgmodule-2.0-0.dll"
"zlib1.dll"
"gtkrc")]))
'(["freetype6.dll" 535264]
["libgobject-2.0-0.dll" 316586]
["libatk-1.0-0.dll" 153763]
["libgtk-win32-2.0-0.dll" 4813228]
["libcairo-2.dll" 921369]
["libjpeg-7.dll" 233192]
["libexpat-1.dll" 143096]
["libpango-1.0-0.dll" 337702]
["libfontconfig-1.dll" 279059]
["libpangocairo-1.0-0.dll" 95189]
["libgdk-win32-2.0-0.dll" 868712]
["libpangoft2-1.0-0.dll" 686030]
["libgdk_pixbuf-2.0-0.dll" 253834]
["libpangowin32-1.0-0.dll" 102774]
["libgio-2.0-0.dll" 669318]
["libpng14-14.dll" 219305]
["libglib-2.0-0.dll" 1110713]
["libwimp.dll" 69632]
["libgmodule-2.0-0.dll" 31692]
["zlib1.dll" 55808]
["gtkrc" 1181])]))
(define explained? #f)
@ -91,10 +108,11 @@
(string-append (unixize base) "/" (path->string name))
(path->string name))))
(define (download-if-needed dest-dir file)
(define (download-if-needed dest-dir file size)
(let ([dest (build-path dest-dir file)]
[tmp (build-path dest-dir (format "~a.download" file))])
(if (file-exists? dest)
(if (and (file-exists? dest)
(= (file-size dest) size))
(printf " ~a is ready\n" file)
(let* ([sub (unixize (system-library-subpath #f))]
[src (format "~a~a/~a"
@ -130,26 +148,42 @@
(= (file-size f1) (file-size f2))))
(define (install-file src dest)
(unless (same-content? src dest)
(printf "Updating ~a\n" dest)
(when (file-exists? dest)
(delete-file dest))
(copy-file src dest)))
(if (regexp-match? #rx"[.]tgz" (path->string src))
;; Unpack tar file:
(unpack-tgz src dest)
;; Plain copy:
(unless (same-content? src dest)
(printf "Updating ~a\n" dest)
(when (file-exists? dest)
(delete-file dest))
(copy-file src dest))))
(define (unpack-tgz src dest)
(let ([src (path->complete-path src)])
(parameterize ([current-directory (let-values ([(base name dir?) (split-path dest)])
base)])
(subprocess (current-output-port)
(current-input-port)
(current-error-port)
"/usr/bin/tar"
"zxf"
(path->string src)))))
(case (mode)
[(download)
(let ([libs dest-dir])
(unless (directory-exists? libs)
(make-directory libs))
(for-each (lambda (file)
(download-if-needed libs file))
needed-files)
(when (touch-ready?)
(let ([ok (build-path libs "ready")])
(for-each (lambda (file+size)
(download-if-needed libs (car file+size) (cadr file+size)))
needed-files+sizes)
(when (touch-ready)
(let ([ok (build-path libs (format "ready~a" (touch-ready)))])
(unless (file-exists? ok)
(with-output-to-file ok void)))))]
[(install)
(for-each (lambda (file)
(install-file (build-path src-dir "libs" file)
(build-path dest-dir file)))
needed-files)])
(for-each (lambda (file+size)
(let ([file (car file+size)])
(install-file (build-path src-dir "libs" file)
(build-path dest-dir file))))
needed-files+sizes)])

13
src/mac/README.txt
View File

@ -10,6 +10,9 @@ Get these packages (or newer, if compatible):
pango-1.28.0.tar.gz
libjpeg62 (maybe in binary form)
PSMTabBarControl, probably from "maccode.googlecode.com",
and handled differently
Patches:
cairo/src/cairo-quartz-font.c:656:
if (width < 1) width = 1;
@ -39,6 +42,10 @@ Configures (where <dest> is some temporary area):
Note: PATH above ensures that pkg-config binaries are used to find
things in <dest> rather than some other area, such as /opt/local.
XCode:
Build PSMTabBarControl. You only need the Framework target, and
in Release mode.
Install:
racket install-libs.rkt <dest>/lib
* using `racket' for the target installation
@ -46,6 +53,12 @@ Install:
* double-check installed libraries to ensure that they do not
have <dest> in their shared-library paths
Also copy "PSMTabBarControl.framework" into the installation's "lib"
directory. You can flatten all the auto-version soft links (moving
"PSMTabBarControl" and "Resources" to immediately inside
"PSMTabBarControl), and you can use `ditto' to prune the binary to
just the platform that you're using.
--------------------------------------------------
DESTDIR=