eumandy/eugtk/examples/BEAR.ex

-------------------------------------------------------------------------------
--# BEAR (Browse, Edit And Run)
-------------------------------------------------------------------------------
-- Requires EuGTK version 4.11.10, GtkSourceView and WebKit2Gtk libraries.
-- You may have to manually change the names of the libraries in GtkSourcView.plugin
-- and/or GtkWebKit.plugin!

include GtkEngine.e
include GtkFileSelector.e
include GtkFontSelector.e

include GtkSettings.e

include GtkWebKit.plugin
include GtkSourceView.plugin
include GtkAboutDialog.e

include std/net/url.e
include std/net/http.e

------------------------------
-- Globals
------------------------------

object current_web_page = "documentation/README.html"
object current_net_page = ""
object current_edit_file = ""
object current_font = "Ubuntu mono 12"
object current_web_folder = "~/demos"
object current_edit_folder = "~/demos"
object current_style = "classic"
object uri, link, lang, tags = {}
object svbuffer, request, lm, edit_html = 0
constant cb = create(GtkClipboard) 
constant ini = canonical_path("~/.bear.ini")
atom sv, menu, m1, m2, m3, m4, m5, sep, context
atom wvsettings, svsettings, controller,sig
integer toggle = 1, show_map = 0 -- map not used

-----------------------------
-- Styling
-----------------------------
constant css = create(GtkCssProvider,`
 @define-color yellow #F5EEB5;
 @define-color blue #B5F5F4;
    GtkFrame,GtkToolbar {border-radius: 10px;  
        background-image:
        -gtk-gradient (linear, 
                left top, right bottom,
                from(@yellow), to(@blue));
	}
`)

constant mgr = create(GtkSourceStyleSchemeManager) 
constant ids = get(mgr,"scheme ids")
sequence sty = repeat(0,length(ids))
	 sty[1] = create(GtkRadioMenuItem,0,ids[1],_("SelectStyle"),ids[1])
	 for i =  2 to length(ids) do
		sty[i] = create(GtkRadioMenuItem,sty[i-1],
		    ids[i],_("SelectStyle"),ids[i])
	 end for

----------------------------
-- Interface
----------------------------

constant win = create(GtkWindow,"name=MainWindow,title=The Bear,size=1200x800,border=10,$delete-event=Bail")

add("MainWindow",create(GtkBox,"name=top,orientation=VERTICAL"))

pack("top",create(GtkButtonBox,"name=bar,layout=2,margin-bottom=5"))

add("bar",{ -- these display current file names, captions, and language type;
    create(GtkFrame,"name=frame1"),
    create(GtkFrame,"name=frame2"),
    create(GtkFrame,"name=frame3"),
    create(GtkFrame,"name=frame4")})
    
    add("frame1",create(GtkLabel,"name=label1,text=URL,font=8"))
    add("frame2",create(GtkLabel,"name=label2,text=TITLE,font=8"))
    add("frame3",create(GtkLabel,"name=label3,text=LANG,font=8"))
    add("frame4",create(GtkLabel,"name=label4,text=FILE,font=8"))
  
  
pack("top",create(GtkPaned,"name=paned,orientation=HORIZONTAL,position=600"),TRUE,TRUE)
    set("paned","pack1",create_webview(),1,1) -- left side contains web view;
    
    set("paned","pack2",create(GtkBox,"name=pane2,orientation=VERTICAL"),TRUE,TRUE)
    pack("pane2",create_sourceview(),1,1) -- right side contains source view;
    
    pack_end("top",create(GtkBox,"name=control_box,orientation=HORIZONTAL,spacing=5"))
    pack("control_box",{ -- container for controls at bottom of screen;
	create(GtkFrame,"name=frame5,label=Web Page"),
	create(GtkFrame,"name=frame6,label=Source")},TRUE,TRUE)
    
    add("frame5",create(GtkToolbar,"name=bar1,style=2,icon size=1,font=8"))
    add("bar1",{ -- buttons for web page navigation;
	create(GtkToolButton,"name=netOpen,icon_name=www,label=Network",,_("OpenNetPage")),
	create(GtkToolButton,"name=htmlOpen,stock-id=gtk-open,label=Local",,_("OpenWebPage")),
	create(GtkToolButton,"name=htmlEdit,stock-id=gtk-edit",,_("EditHtml")),
	create(GtkToolButton,"name=htmlBack,stock-id=gtk-go-back",,_("Back")),
	create(GtkToolButton,"name=htmlFwd,stock-id=gtk-go-forward",,_("Fwd")),
	create(GtkToolButton,"name=htmlFind,stock-id=gtk-find",,_("Find")),
	create(GtkToolButton,"name=zoomOut,stock-id=gtk-zoom-out",,_("ZoomOut")),
	create(GtkToolButton,"name=zoomIn,stock-id=gtk-zoom-in",,_("ZoomIn")),
	create(GtkToolButton,"name=htmlHelp,stock-id=gtk-help",,_("Help"))})

   add("frame6",create(GtkToolbar,"name=bar2,style=2,icon size=1,font=8"))
   add("bar2",{ -- buttons for source view navigation;
	create(GtkToolButton,"name=srcNew,stock-id=gtk-new",,_("fileNew")),
	create(GtkToolButton,"name=srcOpen,stock-id=gtk-open",,_("fileOpen")),
	create(GtkToolButton,"name=srcSave,stock-id=gtk-save",,_("fileSave")),
	create(GtkToolButton,"name=srcSaveAs,stock-id=gtk-save-as",,_("fileSaveAs")),
	create(GtkToolButton,"name=srcRun,stock-id=gtk-execute",,_("fileRun")),
	create(GtkSeparatorToolItem,"draw=TRUE,expand=TRUE"), 
	create(GtkMenuToolButton,"name=srcMenu,stock-id=gtk-preferences"),
	create(GtkToolButton,"name=srcAbout,stock-id=gtk-about",,_("About"))})
	connect("srcMenu","clicked",_("Preferences"))

	set("srcMenu","menu",build_prefs_menu()) 
	connect("srcMenu","clicked",_("PopupSrcMenu"))
	connect("MainWindow","realize",_("on_startup"))
		
show_all("MainWindow")
--set("MainWindow","interactive debugging",1)
main()

------------------
function fileNew()
------------------
fileselector:do_overwrite_confirmation = TRUE
fileselector:filters = {"euphoria","html","text"}
object f  = fileselector:New()
    if not atom(f) then
	create_file(f)
    end if
return 1
end function

--------------------
function fileOpen()
--------------------
fileselector:filters = {"euphoria","html","css","text"}
object f = fileselector:Open(current_edit_folder & "/*")
if not atom(f) then
	load_file(f)
	current_edit_folder = pathname(f)
end if
return 1
end function

--------------------
function fileSave()
--------------------
object f
atom fn

fileselector:do_overwrite_confirmation = FALSE

if match("http://",current_edit_file) = 1 then
	f = fileselector:Save(canonical_path(filename(fix(decode(current_edit_file)))))

else
	f = canonical_path(get("label4","text"))
	fileselector:filters = {fileext(f)} & {"text"}
	chdir(pathname(f))
	f = fileselector:Save(f)
end if

if string(f) then

	fn = open(f,"w")
	write_file(fn,get(svbuffer,"text"),TEXT_MODE)
	flush(fn)
	close(fn)
	
	if match("htm",fileext(f)) = 1 then
		set("WebView","reload bypass cache")
		current_web_folder = pathname(f)
	else
		current_edit_folder = pathname(f)
	end if
end if
return 1
end function

-----------------------
function fileSaveAs()
-----------------------
fileselector:do_overwrite_confirmation = TRUE

object f = filename(current_edit_file)
fileselector:filters = {fileext(f)} & {"text"}

f = fileselector:SaveAs(f & ".backup")
if string(f) then
	write_file(f,get(svbuffer,"text"),TEXT_MODE)
	if match("htm",fileext(f)) = 1 then
		current_web_folder = pathname(f)
	else
		current_edit_folder = pathname(f)
	end if
end if
return 1
end function

------------------
function fileRun()
------------------
object f = current_edit_file
object cmd = command_line() 
atom fn
	cmd = pathname(get("label4","text"))
	f = filebase(f)
	object tmp = temp_file(canonical_path("~/"),sprintf("tmp/%s_",{f}),"ex",1) 
	if not file_exists(canonical_path("~/tmp")) then
		create_directory(canonical_path("~/tmp"),448,1)
	end if
	fn = open(tmp,"w") 
	write_file(fn,get(svbuffer,"text"),TEXT_MODE)
	flush(fn)
	close(fn)
	setenv("EUINC",canonical_path("~/demos"))
	system(text:format("eui [] & ",{tmp}),0)
return 1
end function

-------------------------------
function create_file(object f)
-------------------------------
object hdr
	lang = get(lm,"guess language",f) 
	set(svbuffer,"language",lang)
	name = get(lang,"name")
	switch name do
		case "Euphoria" then hdr = euhdr
		case "Python" then hdr = pyhdr
		case ".ini" then hdr = inihdr
		case "C","CSS","C++","C/C++/ObjC Header" then hdr = chdr
		case else hdr = "-- []\n\n"
	end switch
	set(svbuffer,"text",format(hdr,{f}))
	set("label3","text",get(lang,"name"))
	set("label4","text",f)
	write_file(f,get(svbuffer,"text"))
	current_edit_file = f
	current_edit_folder = pathname(f)
return update_buttons()
end function

-------------------------------------------
function load_file(object f, integer web=0)
-------------------------------------------
object txt
	if match("file://",lower(f)) then
		f = f[8..$]
	end if
	
	if file_exists(canonical_path(f)) then
		txt = read_file(canonical_path(f))
		
	else
	
		if not networked() then return Warn(,,"Network down") end if

		if not match("http://",f) = 1 then f = "http://" & f end if
	
		txt = http_get(f) 
		if atom(txt) then
			Error(,,"Error %d loading %s ",{txt,f})
			return -1
		else 
			txt = txt[2]
		end if
	
	end if
	
	lang = get(lm,"guess language",f) 
	set(svbuffer,"language",lang)
	set(svbuffer,"text",txt)
	set("label3","text",get(lang,"name"))
	set("label4","text",f)
	current_edit_file = f
	current_edit_folder = pathname(f)

return update_buttons()
end function

----------------------
function fix(object x)
----------------------
	if match("#",x) then
		x = split(x,'#')
		x = x[1]
	end if
	if match("file:",x) = 1 then
		return x[8..$]
	end if
	if match("http:",x) = 1 then
		return x[8..$]
	end if
	if match("https:",x) = 1 then
		return x[9..$]
	end if
return x
end function

-----------------------
function Back(atom ctl)
-----------------------
	set("WebView","go back")
return update_buttons()
end function

----------------------
function Fwd(atom ctl)
----------------------
	set("WebView","go forward")
return update_buttons()
end function

---------------
function Undo()
---------------
	set(svbuffer,"undo")
return update_buttons()
end function

---------------
function Redo()
---------------
	set(svbuffer,"redo")
return update_buttons()
end function

------------------
function ZoomIn()
------------------
	set("WebView","zoom level",get("WebView","zoom level") + .1)
return 1
end function

------------------
function ZoomOut()
------------------
	set("WebView","zoom level",get("WebView","zoom level") - .1)
return 1
end function

-------------------------
function update_buttons()
-------------------------
integer x = get(svbuffer,"char count") 
	set("netOpen","sensitive",networked())
	set("srcSave","sensitive",x)
	set("srcSaveAs","sensitive",x)
	set("srcRun","sensitive",x)
	if string(current_edit_file) 
	and equal("ex",fileext(current_edit_file)) then
		set("srcRun","sensitive",equal("ex",fileext(current_edit_file)))
	else
		set("srcRun","sensitive",FALSE)
	end if
object uri = get("WebView","uri")
	if sequence(uri) and match("htm",uri) then
		set("htmlEdit","tooltip text",uri)
		set("label1","text",uri)
		set("label2","text",get("WebView","title"))
	end if
return 1
end function

-----------------------
function OpenNetPage()
-----------------------
atom dlg = create(GtkDialog)
set(dlg,"add button","gtk-cancel",MB_CANCEL)
set(dlg,"add button","gtk-ok",MB_OK)
atom ca = get(dlg,"content area")
atom lbl = create(GtkLabel,"                                   Enter a web address beginning with http://                           ")
atom input = create(GtkEntry)
add(ca,{lbl,input})
show_all(dlg)

if match("file://",current_net_page) = 1 then
	set(input,"text","")
elsif match("http://",current_net_page) = 1 then 
	set(input,"text",current_net_page)
else 
	set(input,"text","http://" & current_net_page)
end if

object uri, request
if run(dlg) = MB_OK then
	uri = get(input,"text")
	if length(uri) > 0 then 
		request = create(WebkitUriRequest,decode(uri))
		set("WebView","load request",request)
	end if
end if

destroy(dlg)
return 0
end function

-----------------------
function OpenWebPage()
-----------------------
fileselector:filters = {"html","css"} 
object f = fileselector:Open(current_web_folder & "/*")
	if not atom(f) then
		load_html(f)
		current_web_folder = pathname(f)
	end if
return 1
end function

----------------------------
function load_html(object x)
----------------------------
x = canonical_path(x) 
if file_type(x) = 1 then
	set(svsettings,"search text",0)
	request = create(WebkitUriRequest,"file://" & x)
	set("WebView","load request",request)
	set("label1","text",x)
end if
return 1
end function

--------------------------------------------------
function on_load_changed(atom view, integer event)
-------------------------------------------------- 
object uri, ext = "?", x = 0
object editables = {"e","ex","txt","text","ini","css","xml","glade","c","cpp","h"}
	
	set(svsettings,"search text","")

	switch event do
	case WEBKIT_LOAD_STARTED then 
		uri = decode(get("WebView","uri")) 
		ext = fileext(filename(uri))
		if  find(ext,editables) then
			set("WebView","stop loading")
			load_file(uri,0)
		end if

	case WEBKIT_LOAD_REDIRECTED then 

	case WEBKIT_LOAD_COMMITTED then 

	case WEBKIT_LOAD_FINISHED then
		uri = decode(get("WebView","uri"))
		if find(ext,editables) = 0 then
			current_web_page = uri
		end if
		current_net_page = uri 

	end switch	
	edit_html = 0

return update_buttons()
end function

--------------------------
function EditHtml()
--------------------------
object f = canonical_path(fix(get("label1","text")))
edit_html = 1
if file_exists(f) then
	object txt = read_file(f)
	if not atom(txt) then
		load_file(f,1)
	end if
else
	f = get("WebView","uri") 
	if match("#",f) then
		f = split(f,'#')
		f = f[1]
	end if
	object content = http_get(f)
	if atom(content) then
		Error(,,"Cannot load web page",f)
	else
		lang = get(lm,"guess language",f) 
		set(svbuffer,"language",lang)
		set("label3","text",get(lang,"name"))
		set("label4","text",f)
		set(svbuffer,"text",content[2])
		current_edit_file = f
		update_buttons()
	end if
end if
return 1
end function

--------------------------
function create_webview()
--------------------------
atom webview = create(WebkitWebView,"name=WebView")
atom vset = get(webview,"settings")
	set(vset,{
		{"enable tabs to links",TRUE},
		{"zoom text only",FALSE},
		{"enable developer extras",TRUE},
		{"enable smooth scrolling",TRUE},
		{"enable_caret_browsing",TRUE},
		{"draw_compositing_indicators",TRUE},
	$})

 connect(webview,"load-changed",_("on_load_changed"))

 wvsettings = get(webview,"settings") 
	set(wvsettings,"enable plugins",1)
	set(wvsettings,"zoom text only",1)
	set(wvsettings,"enable smooth scrolling",1)
	--set(wvsettings,"auto load images",0)
	--set(wvsettings,"enable write console messages to stdout",1)
	--set(wvsettings,"enable spatial navigation",1)
	--set(wvsettings,"enable tabs to links",1)
	--set(wvsettings,"enable xss auditor",1)
	--set(wvsettings,"minimum font size",12)
	--set(wvsettings,"draw compositing indicators",1)
	set(wvsettings,"enable html5 database",1)
	set(wvsettings,"enable html5 local storage",1)
	set(wvsettings,"enable hyperlink auditing",1)
	
 controller = get(webview,"find controller")

-- following are not implemented by webview yet;	
 --context = get(webview,"context")
 --set(context,"preferred languages",{"en_US"})
 --set(context,"spell checking languages",{"en_US"})
 --set(context,"spell checking enabled",TRUE)
 
return webview
end function

---------------
function Find()
---------------
atom buffer = get(context,"buffer")
object a = allocate(100) 
object b = allocate(100) 
object c = allocate(100)
object x, count
integer try = 1
atom fn = define_c_func(LIBSV,"gtk_source_search_context_forward",{P,P,P,P},I)
object txt = get(cb,"wait for text") 
label "retry"
c_proc(fnBufStart,{buffer,a})
c_proc(fnBufEnd,{buffer,b})
 if string(txt) then 
    txt = transmute(txt,
	{{},"<",">","&"},
	{{},"&lt;","&gt;","&amp;"}) 
    txt = join(split(txt),"\\s+")  
    set(svsettings,"regex enabled",1)
    set(svsettings,"search text",txt)

  count = get(context,"occurrences count") 
  if count  = -1 then
	try += 1
	if try > 20 then
	    return 0
	end if
	goto "retry"
  else
  
--   if count > 1 then
--	if show_map then
--		set("map","deiconify")
--		set("map","present")
--	end if
--   else 
--	if show_map then
--		set("map","iconify")
--	end if
--   end if
   
   x = c_func(fn,{context,a,b,c})
   set(sv,"scroll to iter",b,.25,1,0,0)

  end if
end if
return 1
end function

-----------------------------
function create_sourceview()
-----------------------------
 atom scroller = create(GtkScrolledWindow) 
 sv = create(GtkSourceView,{
	{"name","SrcView"},
	{"show line numbers",TRUE},
	{"tab width",4},
	{"indent width",4},
	{"indent on tab",TRUE},
	{"auto indent",TRUE},
	{"font","Ubuntu mono bold 12"},
	{"show right margin",TRUE},
	{"show line marks",TRUE},
	{"draw spaces",FALSE},
	{"insert spaces instead of tabs",FALSE},    
	{"right margin position",90},
	{"highlight current line",TRUE},
	{"wrap mode",GTK_WRAP_NONE}})
 add(scroller,sv)

 set(sv,"font",current_font)
 
-- map is commented out since only the latest WebView supports maps;

-- atom win2 = create(GtkWindow,"name=map,border=10,size=80x800")
-- atom smap = create(GtkSourceMap,"font=Ubuntu mono 4")
--
-- set(smap,"view",sv)
-- add(win2,smap)
-- set(win2,"deletable",0)
-- set(win2,"move",0,0)
-- set(win2,"decorated",0)
-- show_all(win2)
-- set(win2,"visible",show_map)
-- 
 svbuffer = get(sv,"buffer")

 lm = create(GtkSourceLanguageManager)
 svsettings = create(GtkSourceSearchSettings) 
 context = create(GtkSourceSearchContext,svbuffer,svsettings) 

 set(svsettings,"at word boundaries",0)
 set(svsettings,"case sensitive",1)

 atom tt = get(svbuffer,"tag table") 
 set(tt,"foreach",_("get_tags"))
 set(tags[1],"background","red")
 set(tags[1],"foreground","white")
 set(tags[1],"font","bold")
return scroller
end function

function get_tags(atom tt)
 register(tt,GtkTextTag)
 tags = append(tags,tt)	
return 1        
end function

------------------------------------
function ToggleMap()
------------------------------------
-- show_map = not(show_map)
-- if show_map then set("map","deiconify")
-- else set("map","iconify")
-- end if
return 1
end function

------------------------------------
function ToggleLineNumbers(atom ctl)
------------------------------------
 set("SrcView","show line numbers",get(ctl,"active"))
return 1
end function

------------------------------------
function ToggleSpaces(atom ctl)
------------------------------------
  if get(ctl,"active") then
	set("SrcView","draw spaces",GTK_SOURCE_DRAW_SPACES_ALL)
  else
	set("SrcView","draw spaces",FALSE)
  end if
return 1
end function

------------------------------------
function ChooseFont(atom ctl)
------------------------------------
fontselector:mono_filter = TRUE
object x = fontselector:Select(current_font)
	if not atom(x) then
		set("SrcView","font",x)
		current_font = x
	end if
return 1
end function

-----------------------------
function build_prefs_menu()
-----------------------------
	menu = create(GtkMenu)
	m1 = create(GtkMenuItem,"Editor font",_("ChooseFont"))
	m2 = create(GtkCheckMenuItem,"Line numbers",_("ToggleLineNumbers"))
	m3 = create(GtkCheckMenuItem,"Draw spaces+tabs",_("ToggleSpaces"))
	m4 = create(GtkCheckMenuItem,"Show Map",_("ToggleMap"))

	atom sep1 = create(GtkSeparatorMenuItem)
	atom sep2 = create(GtkSeparatorMenuItem)

	set(menu,"append",{m1,sep1,m2,m3,sep2,sty})
	set(m2,"name","ShowLineNumbers")
	set(m2,"active",get("SrcView","show line numbers"))
	set(m3,"name","DrawSpaces")
	set(m3,"active",get("SrcView","draw spaces"))
	set(m4,"name","ShowMap")
	set(m4,"active",show_map)
	set(menu,"name","popup_menu")
	show_all(menu)
return menu
end function

--------------------------------------------
function SelectStyle(atom ctl, object name)
--------------------------------------------
if atom(name) then name = unpack(name) end if
atom scheme  = get(mgr,"scheme",name)
set(svbuffer,"style scheme",scheme)
set(mgr,"force rescan")
current_style = name
return 1
end function

-----------------------------
function Help()
-----------------------------
object uri = "file://" & canonical_path("~/demos/documentation/bear.html")
	set("WebView","load uri",uri)
return 1
end function

-----------------------------
function About()
-----------------------------
atom dlg = about:Dialog
	set(dlg,"program name","The Bear")
	set(dlg,"version","Version 1.3")
	set(dlg,"logo","thumbnails/mongoose.png")	
	set(dlg,"add credit section","Using:",
		{"Euphoria " & version_string_short(),filename(svdll),filename(wkdll)})
	run(dlg)
	hide(dlg)
return 1
end function

-----------------------------
function PopupSrcMenu()
-------------------------------
	set("popup_menu","popup")
return 1
end function

-------------------------------
function on_startup()
-------------------------------
settings:Load(ini)

object x = get("MainWindow","data","edit_file") 
if sequence(x) and length(x) > 0 and  file_exists(canonical_path(x)) then 
	load_file(canonical_path(x),1) 
end if

x = get("MainWindow","data","current_web_folder")
if sequence(x) and length(x) > 0 then
	current_web_folder = x
end if

x = get("MainWindow","data","current_net_page")
if sequence(x) and length(x) > 0 then
	current_net_page = fix(x)
	load_html(current_net_page)
end if

x = get("MainWindow","data","current_edit-folder")
if sequence(x) and length(x) > 0 then
	current_edit_folder = x
end if

x = get("MainWindow","data","current_style")
if sequence(x) and length(x) > 0 then
	current_style = x
	x = find(current_style,ids) 
	if x > 0 and x <= length(sty) then
		set(sty[x],"active",1)
	end if
end if


set("netOpen","tooltip text","Open a web page on the WWW")
set("htmlOpen","tooltip text","Open a local html file")
set("srcOpen","tooltip text","Open a local text file")

return 1
end function

-------------------------------
global function Bail()
-------------------------------
	settings:Save(ini,{"MainWindow","paned","ShowLineNumbers","DrawSpaces","FontSelector"})
	settings:Add(ini,"MainWindow","data.edit_file",fix(current_edit_file))
	settings:Add(ini,"MainWindow","data.current_web_folder",current_web_folder)
	settings:Add(ini,"MainWindow","data.current_net_page",fix(get("label1","text")))
	settings:Add(ini,"MainWindow","data.current_edit_folder",current_edit_folder)
	settings:Add(ini,"MainWindow","data.current_style",current_style)
	settings:Add(ini,"SrcView","font",get("FontSelector","font"))
	
	-- line above sets the sv font on loading, but there's no direct way to 
	-- save the sv font on exit, so we save the FontSelector current font instead,
	-- and use that value to restore the sv font.
	
return Quit()
end function


-- Boilerplate for new files;

constant euhdr = `
----------------------------
-- []
----------------------------


`
constant inihdr = `
;---------------------------
; []
;---------------------------


`
constant pyhdr = `
#-----------------------------
# []
#-----------------------------


`
constant chdr = `
/*
 []
*/

`
--========================================================================--