cocoa tab-panel in no-border mode uses PSMTabBarControl

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

View File

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

View File

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

View File

@ -14,7 +14,11 @@
(provide tab-panel%) (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) (import-protocol NSTabViewDelegate)
(define-objc-class MyTabView NSTabView (define-objc-class MyTabView NSTabView
@ -24,6 +28,13 @@
(-a _void (tabView: [_id cocoa] didSelectTabViewItem: [_id item-cocoa]) (-a _void (tabView: [_id cocoa] didSelectTabViewItem: [_id item-cocoa])
(queue-window*-event wxb (lambda (wx) (send wx do-callback))))) (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%) (defclass tab-panel% (panel-mixin window%)
(init parent (init parent
x y w h x y w h
@ -31,38 +42,73 @@
labels) labels)
(inherit get-cocoa) (inherit get-cocoa)
(define cocoa (as-objc-allocation (define tabv-cocoa (as-objc-allocation
(tell (tell MyTabView alloc) init))) (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 (define item-cocoas
(for/list ([lbl (in-list labels)]) (for/list ([lbl (in-list labels)])
(let ([item (as-objc-allocation (let ([item (as-objc-allocation
(tell (tell NSTabViewItem alloc) initWithIdentifier: #f))]) (tell (tell NSTabViewItem alloc) initWithIdentifier: #f))])
(tellv item setLabel: #:type _NSString (label->plain-label lbl)) (tellv item setLabel: #:type _NSString (label->plain-label lbl))
(tellv cocoa addTabViewItem: item) (tellv tabv-cocoa addTabViewItem: item)
item))) item)))
(let ([sz (tell #:type _NSSize cocoa minimumSize)]) (if control-cocoa
(tellv cocoa setFrame: #:type _NSRect (make-NSRect (make-init-point x y) sz))) (tellv cocoa setFrame: #:type _NSRect (make-NSRect (make-init-point x y)
(tellv cocoa setDelegate: cocoa) (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 (define content-cocoa
(as-objc-allocation (as-objc-allocation
(tell (tell NSView alloc) (tell (tell NSView alloc)
initWithFrame: #:type _NSRect (tell #:type _NSRect cocoa contentRect)))) initWithFrame: #:type _NSRect (tell #:type _NSRect tabv-cocoa contentRect))))
(tell #:type _void cocoa addSubview: content-cocoa) (tellv tabv-cocoa addSubview: content-cocoa)
(define/override (get-cocoa-content) 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) (define/override (set-size x y w h)
(super 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) (define/public (set-label i str)
(tellv (list-ref item-cocoas i) setLabel: #:type _NSString (label->plain-label str))) (tellv (list-ref item-cocoas i) setLabel: #:type _NSString (label->plain-label str)))
(define/public (set-selection i) (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) (define/public (get-selection)
(item->index (tell cocoa selectedTabViewItem))) (item->index (tell tabv-cocoa selectedTabViewItem)))
(define (item->index tv) (define (item->index tv)
(for/or ([c (in-list item-cocoas)] (for/or ([c (in-list item-cocoas)]
@ -74,17 +120,17 @@
(let ([item (as-objc-allocation (let ([item (as-objc-allocation
(tell (tell NSTabViewItem alloc) initWithIdentifier: #f))]) (tell (tell NSTabViewItem alloc) initWithIdentifier: #f))])
(tellv item setLabel: #:type _NSString (label->plain-label lbl)) (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))))) (set! item-cocoas (append item-cocoas (list item)))))
(define/public (delete i) (define/public (delete i)
(let ([item-cocoa (list-ref item-cocoas 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)))) (set! item-cocoas (remq item-cocoa item-cocoas))))
(define/public (set choices) (define/public (set choices)
(for ([item-cocoa (in-list item-cocoas)]) (for ([item-cocoa (in-list item-cocoas)])
(tellv cocoa removeTabViewItem: item-cocoa)) (tellv tabv-cocoa removeTabViewItem: item-cocoa))
(set! item-cocoas null) (set! item-cocoas null)
(for ([lbl (in-list choices)]) (for ([lbl (in-list choices)])
(append* lbl))) (append* lbl)))
@ -98,4 +144,7 @@
(super-new [parent parent] (super-new [parent parent]
[cocoa cocoa] [cocoa cocoa]
[no-show? (memq 'deleted style)])) [no-show? (memq 'deleted style)])
(when control-cocoa
(set-ivar! control-cocoa wxb (->wxb this))))

View File

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

View File

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

View File

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

View File

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

View File

@ -10,6 +10,9 @@ Get these packages (or newer, if compatible):
pango-1.28.0.tar.gz pango-1.28.0.tar.gz
libjpeg62 (maybe in binary form) libjpeg62 (maybe in binary form)
PSMTabBarControl, probably from "maccode.googlecode.com",
and handled differently
Patches: Patches:
cairo/src/cairo-quartz-font.c:656: cairo/src/cairo-quartz-font.c:656:
if (width < 1) width = 1; 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 Note: PATH above ensures that pkg-config binaries are used to find
things in <dest> rather than some other area, such as /opt/local. 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: Install:
racket install-libs.rkt <dest>/lib racket install-libs.rkt <dest>/lib
* using `racket' for the target installation * using `racket' for the target installation
@ -46,6 +53,12 @@ Install:
* double-check installed libraries to ensure that they do not * double-check installed libraries to ensure that they do not
have <dest> in their shared-library paths 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= DESTDIR=