OPTION GUI TRUE
PRAGMA GUI Xaw3d
'PRAGMA GUI 3dXft OPTIONS -I/usr/local/include/X11/Xaw3dxft LDFLAGS -lXaw3dxft

' Needed globally for list
GLOBAL dict$ ARRAY 1

FUNCTION Get_Data$(server$, request$)

	LOCAL total$, line$
	LOCAL mynet

	OPEN server$ & ":2628" FOR NETWORK AS mynet
	SEND request$ TO mynet

	REPEAT
		RECEIVE line$ FROM mynet
		total$ = total$ & line$
		IF INSTR(line$, "250 ok") THEN BREAK
	UNTIL NOT(WAIT(mynet, 1000))

	SEND "QUIT" TO mynet
	CLOSE NETWORK mynet

	RETURN total$

ENDFUNCTION

SUB Get_Dicts(gid)

	LOCAL resp$, item$
	LOCAL server TYPE char*
	LOCAL nr

	CALL GUIGET(gid, "server", XtNstring, &server)

	resp$ = Get_Data$(CHOP$(server), "SHOW DB" & CR$ & NL$)

	FOR item$ IN resp$ STEP CR$ & NL$
		IF REGEX(LEFT$(item$, 1), "[[:alpha:]]") THEN
			dict$[nr] = item$
			INCR nr
			REDIM dict$ TO nr+1
		ENDIF
	NEXT
	dict$[nr] = NULL

	CALL GUISET(gid, "dicts", XtNlist, dict$, XtNnumberStrings, 0)
	CALL GUISET(gid, "term", XtNstring, "")

ENDSUB

SUB Lookup_Term(gid, database$)

	LOCAL resp$
	LOCAL server, term TYPE char*

	CALL GUIGET(gid, "server", XtNstring, &server)
	IF LEN(server) = 0 THEN EXIT SUB

	CALL GUIGET(gid, "term", XtNstring, &term)
	IF LEN(term) = 0 THEN EXIT SUB

	IF LEN(database$) = 0 THEN EXIT SUB

	resp$ = Get_Data$(CHOP$(server), "DEFINE " & database$ & " " & CHOP$(term) & CR$ & NL$)

	CALL GUISET(gid, "translation", XtNstring, EXTRACT$(resp$, CHR$(13)))

ENDSUB

SUB Clear_Dicts(gid)

	LOCAL empty$[] = { "", NULL }
	CALL GUISET(gid, "dicts", XtNlist, empty$, XtNnumberStrings, 0)

ENDSUB

FUNCTION Create_Gui

	LOCAL id

	id = GUIDEFINE( " \
		{ type=window name=window XtNtitle=\"Thesaurus\" XtNwidth=550 XtNheight=500 } \
		{ type=formWidgetClass name=form parent=window } \
		{ type=labelWidgetClass name=label1 parent=form XtNwidth=100 XtNheight=30 XtNlabel=\"Server:\" XtNjustify=XtJustifyLeft XtNleft=XawChainLeft XtNright=XawChainLeft XtNtop=XawChainTop XtNbottom=XawChainTop } \
		{ type=asciiTextWidgetClass name=server parent=form XtNfromVert=label1 XtNeditType=XawtextEdit XtNwidth=300 XtNheight=30 XtNleft=XawChainLeft XtNright=XawChainRight XtNtop=XawChainTop XtNbottom=XawChainTop } \
		{ type=commandWidgetClass name=fetch parent=form callback=XtNcallback XtNfromVert=label1 XtNfromHoriz=server XtNwidth=95 XtNheight=30 XtNlabel=\"Fetch\" XtNleft=XawChainRight XtNright=XawChainRight XtNtop=XawChainTop XtNbottom=XawChainTop } \
		{ type=labelWidgetClass name=label2 parent=form XtNfromVert=server XtNwidth=100 XtNheight=30 XtNlabel=\"Dictionaries:\" XtNjustify=XtJustifyLeft XtNleft=XawChainLeft XtNright=XawChainLeft XtNtop=XawChainTop XtNbottom=XawChainTop } \
		{ type=viewportWidgetClass name=view parent=form XtNallowVert=1 XtNheight=100 XtNfromVert=label2 XtNleft=XawChainLeft XtNright=XawChainRight XtNtop=XawChainTop XtNbottom=XawChainTop } \
		{ type=listWidgetClass name=dicts parent=view callback=XtNcallback XtNresize=1 XtNverticalList=1 XtNwidth=300 XtNleft=XawChainLeft XtNright=XawChainRight XtNtop=XawChainTop XtNbottom=XawChainTop } \
		{ type=commandWidgetClass name=clear parent=form callback=XtNcallback XtNfromVert=label2 XtNfromHoriz=view XtNwidth=95 XtNheight=30 XtNlabel=\"Clear\" XtNleft=XawChainRight XtNright=XawChainRight XtNtop=XawChainTop XtNbottom=XawChainTop } \
		{ type=labelWidgetClass name=label3 parent=form XtNfromVert=view XtNwidth=100 XtNheight=30 XtNlabel=\"Lookup:\" XtNjustify=XtJustifyLeft XtNleft=XawChainLeft XtNright=XawChainLeft XtNtop=XawChainTop XtNbottom=XawChainTop } \
		{ type=asciiTextWidgetClass name=term parent=form XtNfromVert=label3 XtNeditType=XawtextEdit XtNwidth=300 XtNheight=30 XtNleft=XawChainLeft XtNright=XawChainRight XtNtop=XawChainTop XtNbottom=XawChainTop } \
		{ type=commandWidgetClass name=action parent=form callback=XtNcallback XtNfromVert=label3 XtNfromHoriz=term XtNwidth=95 XtNheight=30 XtNlabel=\"Lookup\" XtNleft=XawChainRight XtNright=XawChainRight XtNtop=XawChainTop XtNbottom=XawChainTop } \
		{ type=labelWidgetClass name=label4 parent=form XtNfromVert=term XtNwidth=100 XtNheight=30 XtNlabel=\"Translation:\" XtNjustify=XtJustifyLeft XtNleft=XawChainLeft XtNright=XawChainLeft XtNtop=XawChainTop XtNbottom=XawChainTop } \
		{ type=asciiTextWidgetClass name=translation parent=form XtNfromVert=label4 XtNeditType=XawtextRead XtNscrollVertical=XawtextScrollWhenNeeded XtNwidth=400 XtNheight=180 XtNleft=XawChainLeft XtNright=XawChainRight XtNtop=XawChainTop XtNbottom=XawChainBottom } \
		{ type=commandWidgetClass name=exit parent=form callback=XtNcallback XtNfromVert=translation XtNhorizDistance=310 XtNwidth=95 XtNheight=30 XtNlabel=\"Exit\" XtNleft=XawChainRight XtNright=XawChainRight XtNtop=XawChainBottom XtNbottom=XawChainBottom } \
	")

	CALL GUISET(id, "server", XtNstring, "dict.org")

	trans$ = "<FocusIn>: display-caret(on)\n<FocusOut>: display-caret(off)\n<Key>BackSpace: delete-previous-character()\n<Key>Return: end-of-line()\n<Key>: insert-char()\n<Btn1Down>: select-end()"
	CALL GUISET(id, "server", XtNtranslations, XtParseTranslationTable(trans$))
	CALL GUISET(id, "term", XtNtranslations, XtParseTranslationTable(trans$))

	CALL Clear_Dicts(id)

	RETURN id

ENDFUNCTION

SUB Main_Function(id)

	LOCAL info TYPE XawListReturnStruct*
	LOCAL db$

	WHILE TRUE
		event$ = GUIEVENT$(id, TRUE)
		SELECT TOKEN$(event$, 1)
			CASE "fetch"
				CALL Get_Dicts(id)
			CASE "clear"
				CALL Clear_Dicts(id)
			CASE "action"
				CALL Lookup_Term(id, db$)
			CASE "dicts"
				info = (XawListReturnStruct*)DEC(TOKEN$(event$, 2))
				db$ = TOKEN$(info->string, 1)
			CASE "exit"
				END
		ENDSELECT
	WEND

ENDSUB

Main_Function(Create_Gui())