eumandy/eugtk/examples/test53.ex
2016-11-25 00:33:18 -07:00

83 lines
2.2 KiB
Elixir

--------------------------------------------------------------------------------
--# GtkLinkButton
-- a button which opens a web page when clicked.
--------------------------------------------------------------------------------
include GtkEngine.e
include GtkEvents.e
include std/net/http.e
constant docs = `
<b><u>GtkLinkButton</u></b>
Clicking the link should open
a browser and load the URL, if
you are connected to the WWW.
`
constant win = create(GtkWindow,"border_width=10,position=1,$destroy=Quit")
constant panel = create(GtkBox,"orientation=VERTICAL")
add(win,panel)
constant lbl = create(GtkLabel)
set(lbl,"markup",docs)
add(panel,lbl)
constant btnbox = create(GtkButtonBox)
add(panel,btnbox)
constant btn1 = create(GtkButton,"gtk-quit","Quit")
constant spin1 = create(GtkSpinner)
constant btn2 = create(GtkButton) add(btn2,spin1)
object url = "http://openeuphoria.org"
constant btn3 = create(GtkLinkButton,url,"OpenEu")
connect(btn3,"activate-link",_("TryToConnect"),url)
add(btnbox,{btn1,btn2,btn3})
set(btn2,"relief",GTK_RELIEF_NONE)
set(btn2,"sensitive",FALSE)
set(btn3,"relief",GTK_RELIEF_NORMAL)
show_all(win)
set(btn2,"hide")
main()
-----------------------------------------------------------------
function TryToConnect(object ctl, object data)
-----------------------------------------------------------------
ifdef UNIX then
object net = "network-offline", web = "www"
end ifdef
ifdef WINDOWS then
object net = "./thumbnails/net0.png", web = "./thumbnails/face-cry.png"
end ifdef
if not networked() then
Warn(win,,"Sorry","This computer is not on a network",
GTK_BUTTONS_CLOSE,net)
return 1
end if
show_all(btn2) -- show some activity while checking;
set(btn2,"sensitive",TRUE)
set(spin1,"start")
if not inet_connected() then
Error(win,,"Sorry","Internet not accessible!",GTK_BUTTONS_CLOSE,web)
set(spin1,"stop")
set(btn2,"sensitive",FALSE)
set(btn2,"hide")
return 1
end if
set(spin1,"stop")
set(btn2,"sensitive",FALSE)
set(btn2,"hide")
return 0 -- returning 0 will allow the link button to complete the connection;
end function