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

cocoa: add app badge to caution & stop icons

Browse Source
This commit is contained in:
Matthew Flatt 2010-12-11 20:38:38 -07:00
parent acdd76b17e
commit 953dd78d76
1 changed files with 40 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
collects/mred/private/wx/cocoa/message.rkt
View File

@ -4,6 +4,7 @@
ffi/unsafe/objc ffi/unsafe/objc
racket/draw/private/bitmap racket/draw/private/bitmap
"../../syntax.rkt" "../../syntax.rkt"
"../../lock.rkt"
"window.rkt" "window.rkt"
"item.rkt" "item.rkt"
"utils.rkt" "utils.rkt"
@ -30,6 +31,43 @@
#:type _NSString #:type _NSString
"NSApplicationPath"))) "NSApplicationPath")))
(define (make-icon label)
(let ([icon
(if (eq? label 'app)
(get-app-icon)
(let ([id (integer-bytes->integer
(case label
[(caution) #"caut"]
[(stop) #"stop"])
#f
#t)])
(tell (tell NSWorkspace sharedWorkspace)
iconForFileType:
(NSFileTypeForHFSTypeCode id))))])
(tellv icon retain)
(tellv icon setSize: #:type _NSSize (make-NSSize 64 64))
(unless (eq? label 'app)
;; Add badge:
(let ([app-icon (get-icon 'app)])
(tellv icon lockFocus)
(tellv app-icon drawInRect: #:type _NSRect (make-NSRect (make-NSPoint 32 0)
(make-NSSize 32 32))
fromRect: #:type _NSRect (make-NSRect (make-NSPoint 0 0)
(make-NSSize 64 64))
operation: #:type _int 2 ; NSCompositeSourceOver
fraction: #:type _CGFloat 1.0)
(tellv icon unlockFocus)))
icon))
(define icons (make-hash))
(define (get-icon label)
(or (hash-ref icons label #f)
(let ([icon (atomically (make-icon label))])
(hash-set! icons label icon)
icon)))
;; ----------------------------------------
(define-objc-class MyTextField NSTextField (define-objc-class MyTextField NSTextField
#:mixins (KeyMouseResponder CursorDisplayer) #:mixins (KeyMouseResponder CursorDisplayer)
[wxb]) [wxb])
@ -47,21 +85,7 @@
(super-new [parent parent] (super-new [parent parent]
[cocoa (let* ([label (cond [cocoa (let* ([label (cond
[(string? label) label] [(string? label) label]
[(symbol? label) [(symbol? label) (get-icon label)]
(let ([icon
(if (eq? label 'app)
(get-app-icon)
(let ([id (integer-bytes->integer
(case label
[(caution) #"caut"]
[(stop) #"stop"])
#f
#t)])
(tell (tell NSWorkspace sharedWorkspace)
iconForFileType:
(NSFileTypeForHFSTypeCode id))))])
(tellv icon setSize: #:type _NSSize (make-NSSize 64 64))
icon)]
[(send label ok?) label] [(send label ok?) label]
[else "<bad>"])] [else "<bad>"])]
[cocoa [cocoa
@ -103,3 +127,4 @@
(define/override (gets-focus?) #f) (define/override (gets-focus?) #f)
(def/public-unimplemented get-font)) (def/public-unimplemented get-font))