steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ui: add a "system-alert" hook that can raise a system modal dialog without involving any potentially stripped gadget, io, or debugger code

db4
Joe Groff 2010-02-23 19:28:57 -08:00
parent 0975b9a268
commit f6183703b2
5 changed files with 28 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
basis/cocoa/cocoa.factor
View File

@ -39,6 +39,7 @@ SYNTAX: IMPORT: scan [ ] import-objc-class ;
[ [
{ {
"NSAlert"
"NSApplication" "NSApplication"
"NSArray" "NSArray"
"NSAutoreleasePool" "NSAutoreleasePool"

10
basis/ui/backend/cocoa/cocoa.factor
View File

@ -213,6 +213,16 @@ M: cocoa-ui-backend offscreen-pixels ( world -- alien w h )
M: cocoa-ui-backend beep ( -- ) M: cocoa-ui-backend beep ( -- )
NSBeep ; NSBeep ;
M: cocoa-ui-backend system-alert
NSAlert -> alloc -> init -> autorelease [
{
[ swap <NSString> -> setInformativeText: ]
[ swap <NSString> -> setMessageText: ]
[ "OK" <NSString> -> addButtonWithTitle: drop ]
[ -> runModal drop ]
} cleave
] [ 2drop ] if* ;
CLASS: { CLASS: {
{ +superclass+ "NSObject" } { +superclass+ "NSObject" }
{ +name+ "FactorApplicationDelegate" } { +name+ "FactorApplicationDelegate" }

3
basis/ui/backend/windows/windows.factor
View File

@ -783,6 +783,9 @@ M: windows-ui-backend (with-ui)
M: windows-ui-backend beep ( -- ) M: windows-ui-backend beep ( -- )
0 MessageBeep drop ; 0 MessageBeep drop ;
M: windows-ui-backend system-alert
[ f ] 2dip swap MB_OK MessageBox drop ;
: fullscreen-RECT ( hwnd -- RECT ) : fullscreen-RECT ( hwnd -- RECT )
MONITOR_DEFAULTTONEAREST MonitorFromWindow MONITOR_DEFAULTTONEAREST MonitorFromWindow
MONITORINFOEX <struct> MONITORINFOEX <struct>

12
basis/ui/backend/x11/x11.factor
View File

@ -8,6 +8,7 @@ strings ui ui.backend ui.clipboards ui.event-loop ui.gadgets
ui.gadgets.private ui.gadgets.worlds ui.gestures ui.pixel-formats ui.gadgets.private ui.gadgets.worlds ui.gestures ui.pixel-formats
ui.pixel-formats.private ui.private x11 x11.clipboard x11.constants ui.pixel-formats.private ui.private x11 x11.clipboard x11.constants
x11.events x11.glx x11.io x11.windows x11.xim x11.xlib ; x11.events x11.glx x11.io x11.windows x11.xim x11.xlib ;
FROM: unix.ffi => system ;
IN: ui.backend.x11 IN: ui.backend.x11
SINGLETON: x11-ui-backend SINGLETON: x11-ui-backend
@ -326,6 +327,17 @@ M: x11-ui-backend (with-ui) ( quot -- )
M: x11-ui-backend beep ( -- ) M: x11-ui-backend beep ( -- )
dpy get 100 XBell drop ; dpy get 100 XBell drop ;
<PRIVATE
: escape-' ( string -- string' )
[ dup CHAR: ' = [ drop "'\''" ] [ 1string ] if ] { } map-as concat ;
: xmessage ( string -- )
escape-' "/usr/X11R6/bin/xmessage '" "'" surround system ;
PRIVATE>
M: x11-ui-backend system-alert
"\n\n" glue xmessage ;
: black ( -- xcolor ) 0 0 0 0 0 0 XColor <struct-boa> ; inline : black ( -- xcolor ) 0 0 0 0 0 0 XColor <struct-boa> ; inline
M:: x11-ui-backend (grab-input) ( handle -- ) M:: x11-ui-backend (grab-input) ( handle -- )

2
basis/ui/ui.factor
View File

@ -243,6 +243,8 @@ M: object close-window
HOOK: beep ui-backend ( -- ) HOOK: beep ui-backend ( -- )
HOOK: system-alert ui-backend ( caption text -- )
: parse-main-window-attributes ( class -- attributes ) : parse-main-window-attributes ( class -- attributes )
"{" expect dup all-slots parse-tuple-literal-slots ; "{" expect dup all-slots parse-tuple-literal-slots ;