/* $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
     AZEDIT.PL Copyright (C) 1983,85,86,89,90 by KABA/SOFNEC

   *******************************************************************
	Used: e_register	0,1,2
	      a_register	0-7,9,10
   $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ */

:- s_mode(_,on).
:- public edit/0.
:- public editall/0.
:- public edit/1.
:- bltin e_new/0.
:- bltin true/0.
:- extern det:b_load/1.

%%%%%%%%%%%%%%%%%%%%%%%%
:- mode e_code1(+).
:- mode e_code2(+).

e_code1(17).   /* ^q  */
e_code2(19).   /* ^s  */

%%%%%%%%%%%%%%%%%%%%%%%%%
%% INTERFACE PREDICATE %%
%%%%%%%%%%%%%%%%%%%%%%%%%

edit :- 
	e_cr_buf,kanji_mode(OM,on),edit_body(OM).

editall :- edit(_).
edit(X) :- e_cr_buf,kanji_mode(OM,on),e_change(_,off),e_new,tell(edit),
	   (var(X) -> listing;listing(X)),told,e_jump(0),edit_body(OM).

%%%%%%%%%%%%%%%%%%%%%%%%%

edit_body(OM) :-

	d_keys(21,32,Key),
	d_setkeys(21,[ ["V"-"@"],["Z"-"@"],[27,32],["D"-"@"],["P"-"@"],["B"-"@"],
                   ["F"-"@"],["N"-"@"],["L"-"@"],"",[27,"<"] ]),
	unknown(U,fail),e_cua,e_dline(D),
	e_init(D),fileerrors(FE,fail),errormode(ER,0),s_verbos(V,off),
	a_register(9,_,OM),e_register(0,_,0),a_register(10,_,[]),
	e_command,e_end,s_verbos(_,V),unknown(_,U),
	fileerrors(_,FE),errormode(_,ER),e_cue,kanji_mode(_,OM),
	d_setkeys(21,Key).

d_setkeys(_,[]):-!.
d_setkeys(No,[A|L]):- d_setkey(No,A),!,NNo is No+1,d_setkeys(NNo,L).
d_setkeys(_,_).

d_keys(No,No,[]):-!.
d_keys(No,End,[A|L]):- d_key(No,A),!,NNo is No+1,d_keys(NNo,End,L).
d_keys(_,_,_).

e_cua :- d_pos(X,Y),asserta(e_cupos(X,Y)).

e_cue :- e_dline(D),e_cupos(X,Y),retract(e_cupos,2,1),!,e_cue(X,Y,D).
e_cue(X,Y,D) :- Y=<D+1,!,d_cursor(1,D+2).
e_cue(X,Y,_) :- d_cursor(X,Y).

%%% CREATE EDITOR BUFFER %%%

e_cr_buf :- d_clear,e_edit,!.
e_cr_buf :- e_cr_buf(I),e_create(I),e_edit(R,R),a_register(R,_,[]),!.
e_cr_buf(I) :-  
	repeat,
	e_mess('Edit Buffer size:'),e_getln(13,[],L),e_cr_buf(L,I),
	!,
	nonvar(I).

e_cr_buf([],_) :- !.
e_cr_buf(L,I) :- name(I,L),integer(I),!.
e_cr_buf(_,_) :- e_fail.


e_auto_set(N):- (e_edit,!;e_create(N),e_edit(X,X),a_register(X,_,[])).

%%%%%%%%%%%%%%%%%%%%%%%
%%  EDITOR MAIN LOOP %%
%%%%%%%%%%%%%%%%%%%%%%%

e_command :- repeat,e_disp,d_keyin(X),e_register(0,P,X),e_register(1,_,P),
	     e_echo,e_command(X),!.

e_command(X) :- errorset(e_do(X),E),!,e_do0(E).

:- mode e_do0(+).

e_do0(succ) :- !,fail.
e_do0(fail) :- !,e_echo,fail.
e_do0(255)  :- !,e_echo.
e_do0(X):- e_do00(X,XX),e_mess(XX),!,e_fail.

/* ERROR MESSAGE TABLE */
:- mode e_do00(+,-).

e_do00(1,  'Syntax error').
e_do00(6,  'Too many variables').
e_do00(11, 'Illegal clause').
e_do00(27, 'Illegal Character code').
e_do00(28, 'Edit Buffer no space').
e_do00(29, 'Kill Buffer no space').
e_do00(30, 'Out of buffer').
e_do00(31, '^G interrupt').
e_do00(199,'Undefined command').
e_do00(255,'end').
e_do00(_,  'Unexpected error occurs').

/* *********** */
/* ONE CHAR DO */
/* *********** */
:- mode e_do(+).

e_do(X) :- e_getbs(X),!,e_backward(1),e_delete(1).
e_do(X) :- 32=<X,!,e_insert(X).
e_do(1) :- !,e_bol(P),e_jump(P).
e_do(2) :- !,e_backward(1).
e_do(3) :- e_edit(O,O),repeat,e_edit(X,(X+1) and 0'7),
	   e_edit,( e_edit(O,O) ;e_dline(L),e_init(L) ),!.
e_do(4) :- !,e_delete(1).
e_do(5) :- !,e_eol(P),e_jump(P).
e_do(6) :- !,e_forward(1).
e_do(9) :- !,e_insert(9).
e_do(11) :- e_register(1,11,11),!,e_dok.
e_do(11) :- !,e_kill,e_dok.
e_do(12) :- !,e_dline(D),D2 is D/2,e_repos(D2),e_refresh.
e_do(13) :- !,e_insert(31).
e_do(14) :- e_register(1,14,14),!,e_register(2,P,P),e_down(P).
e_do(14) :- !,e_pos(P,_),e_register(2,_,P),e_down(P).
e_do(15) :- !,e_insert(31),e_backward(1).
e_do(16) :- e_register(0,_,14),e_register(1,14,14),!,e_register(2,P,P),e_up(P).
e_do(16) :- !,e_pos(P,_),e_register(2,_,P),e_up(P).
e_do(18) :- !,e_search('Reverse Search:',18).
e_do(22) :- !,e_next.
e_do(23) :- e_register(0,_,11),e_register(1,C,C),C=\=11,e_kill,fail.
e_do(23) :- e_mark(P),e_pos(X),X=<P,!,e_kill(P-X),e_delete(P-X).
e_do(23) :- !,e_mark(P),e_pos(X),e_jump(P),e_kill(X-P),e_delete(X-P).
e_do(24) :- !,e_echos('C-X '),d_keyin(X),e_upper(X,X1),e_pch(X1),e_dox(X1),e_echo.
e_do(25) :- !,e_yank.
e_do(26) :- !,e_previous.
e_do(27) :- !,e_echos('M-'),d_keyin(X),e_pch(X),e_upper(X,Y),e_dom(Y),e_echo.
e_do(28) :- !,e_forward(1).
e_do(29) :- !,e_backward(1).
e_do(30) :- !,e_do(16).
e_do(31) :- !,e_do(14).
e_do(X)  :- e_code1(X),!,e_bell(_,off),d_keyin(Y),e_bell(_,on),e_insert(Y).
e_do(X)  :- e_code2(X),!,e_search('Search:',X).
e_do(X)  :- error(199).

/* SEARCH */

e_search(Mess,C):-
	e_mess(Mess),e_strings(C,X),e_echo("$"),e_pos(P),e_dos(C,Mess,X,P).

e_strings(C,X) :- 
	d_keypeek(C),!,d_keyin(_),a_register(10,AX,AX),name(AX,X),e_pchs(X).
e_strings(_,X) :- 
	e_getln(27,[],X),name(AX,X),
	(number(AX)->term_atom(AX,AX1);AX1 = AX),a_register(10,_,AX1).

e_dos(18,_,X,_):- e_bsearch(X),!.
e_dos(C,_,X,_):-  e_code2(C),e_fsearch(X),!.
e_dos(_,M,X,P) :- e_mess('Fail '),e_echos(M),e_echos(X),e_echo("$"),e_jump(P).

/* KILL 1 LINE */

e_dok :- e_eol,!,e_kill(1),e_delete(1).
e_dok :- e_eol(P),e_pos(X),e_kill(P-X),e_delete(P-X).

/* *********** */
/*   ^X ^?     */
/* *********** */
:- mode e_dox(+).

e_dox(2):- !,e_edit(O,(O+1)mod 8),e_cr_check(O).
e_dox(3):- !,e_edit(O,(O+1)mod 8),e_cl_check(O),e_cl_buf.
e_dox(83) :- !,e_mark(Mk),e_pos(P),(P=<Mk;e_mark,e_jump(Mk)),!,
	     e_cue,a_register(9,M,M),kanji_mode(_,M),errorset(e_reconsult,E),
	     kanji_mode(_,on),e_cua,e_error_check(E),e_mess('Reconsulted').
e_dox(8) :-  !, e_jump(0),e_markend.
e_dox(9) :-  !, e_pos(P),e_read('Insert file:',_,true,P).
e_dox(12):-  !, e_pos(P),e_mark(M),e_jump(0),e_markend,e_dox(108),e_jump(M),e_mark,e_jump(P).
e_dox(108):-  !, e_pos(P),e_writeck('tmp0000.00'),e_jump(P),
				e_echo,e_echos(' Compile....'),
				errorset(system('azpc -p tmp0000.00 /byte /no_module /NOM'),_),
				e_refresh,
				e_echo,e_echos(' Loading....'),b_load('tmp0000.b'),
				e_echos('done'),rename('tmp0000.00',[]),rename('tmp0000.b',[]).
e_dox(22) :- !, e_read('Visit file:',N,e_new,0),e_edit(R,R),a_register(R,_,N).
e_dox(23) :- !,e_eob(B),B=\=0,e_mess('Write file:'),
		e_edit(R,R),a_register(R,N,N),
		( N == [],F2 = [] ; name(N,F1),e_rev(F1,[],F2),e_echos(F1) ),
		!,e_getln(13,F2,F),F \==[],name(N1,F),
		e_pos(P),e_jump(0),e_writeck(N1),e_jump(P).
e_dox(24) :- !,e_mark(P),e_mark,e_jump(P).
e_dox(26) :- !,e_dox_end(1),abort.			/* END  */
e_dox(90) :- !,e_dline(X),e_dox_end(X+2),abort. 	/* END  */
e_dox(X) :- e_code2(X),!,e_pos(P),e_jump(0),e_markend,e_dox(83),e_jump(P).
e_dox(_) :- error(199).

/* WRITE File  */

e_writeck(N) :- see(N),seen,e_qwrite,!.
e_writeck(N) :- e_echos(' WRITE....'),tell(N),e_bell(_,off),e_jump(0),
		e_markend,see(edit),errorset(copy0,E),seen,e_bell(_,on),told,
		e_error_check(E),!.
e_writeck(_) :- e_echos(' ? cannot write').

e_qwrite :- 
	e_echos(' Overwrite OK?(y/n):'),
	repeat,
	d_keyin(X),e_upper(X,X1),e_qwrite(X1),!,X1==0'4e.

e_qwrite(0'59) :- e_echo("Y"),repeat(N),e_echo(8),N==20,!.
e_qwrite(0'4e) :- e_echo("N").

/* ******** */
e_dox_end(X) :- d_scroll(_,X),!.
e_dox_end(_).

e_pch(X) :- 32=<X,!,e_echo(X).
e_pch(X) :- e_echo("^"),e_echo(X+"@").

e_pchs([]):-!.
e_pchs([C|L]) :- e_pch(C),e_pchs(L).

/*  NEW EDITOR BUFFA  */
e_cr_check(O) :- e_edit(O,O),!,e_mess('used all buffer !!'),e_fail.
e_cr_check(O) :- e_edit,!,e_edit(N,(N+1)mod 8),e_cr_check(O).
e_cr_check(O) :- e_edit(O1,O),e_cr_buf(I),e_edbuf(O,O1,I).

e_edbuf(_,O,I) :- e_edit(_,O),e_create(I),!,a_register(O,_,[]),
		e_dline(A),e_init(A).
e_edbuf(O,_,_) :- e_edit(_,O),e_mess('can''t allocate buffer'),e_fail.

/* X-C */
e_cl_check(O) :- e_edit(O,O),!,	e_mess('now buffer only !!'),e_fail.
e_cl_check(O) :- e_edit,!,e_edit(_,O).
e_cl_check(O) :- e_edit(N,(N+1)mod 8),e_cl_check(O).
e_cl_buf :- e_mess('now buffer free ok?(y/n):'),d_keyin(X),e_echo(X),
	    e_upper(X,0'59),e_free,repeat,e_edit(O,(O-1) and 0'7),e_edit,!,
	    e_dline(L),e_init(L).
e_cl_buf.

/*  X-V */
e_read(Mess,N,Goal,P) :- 
	e_mess(Mess),e_getln(13,[],F),F\==[],name(N,F),
	(see(N) ; e_echos(' ? not found'),e_fail ),!,call(Goal),
	e_bell(_,off),tell(edit),errorset(copy0,E),told,e_bell(_,on),seen,
	e_error_check(E),e_jump(P).

e_error_check(succ):-!.
e_error_check(A):- integer(A),!,error(A).
e_error_check(A):- error(199).

/* ************* */
/*      ESC-?    */
/* ************* */

:- mode e_dom(+).

e_dom(0'4d) :- !,e_pos(PP),e_mark(P),e_jump(P),e_disp,e_mess('Hit Any key'),
		e_disp,d_keyin(_),e_jump(PP).
e_dom(0'57) :- !,d_screen(_,H),e_init(H-2).
e_dom(0'41) :- !,e_doma1,e_bsearch([46,31]),e_forward(2),e_doma2.
e_dom(0'45) :- !,e_fsearch([46,31]).
e_dom(0'46) :- !,e_nword(P),e_jump(P).
e_dom(0'42) :- !,e_pword(P),e_jump(P).
e_dom(0'43) :- !,e_nword(P),e_pos(X),D is P-X,e_domc(D).
e_dom(0'44) :- e_register(0,_,11),e_register(1,11,11),!,
		e_nword(P),e_pos(X),e_kill(P-X),e_delete(P-X).
e_dom(0'44) :- !,e_kill,e_nword(P),e_pos(X),e_kill(P-X),e_delete(P-X).
e_dom(0'4c) :- !,e_nword(P),e_pos(X),D is P-X,e_doml(D).
e_dom(0'51) :- !,e_domr('Query replace$',yes).
e_dom(0'52) :- !,e_domr('Replace$',no).
e_dom(0'4e) :- !,e_next,e_mess('Next').
e_dom(0'54) :- !,e_previous,e_mess('Previous').
e_dom(0'55) :- !,e_nword(P),e_pos(X),D is P-X,e_domu(D).
e_dom(0'56) :- !,e_delete(1).
e_dom(8) :- !,e_pword(P),e_pos(X),D is X-P,e_backward(D),e_delete(D).
e_dom(0'3e) :- !,e_mark,e_eob(P),e_jump(P).
e_dom(0'3c) :- !,e_mark,e_jump(0).
e_dom(0'20) :- !,e_mark.
e_dom(0'2b) :- !,e_dline(D),e_init(D+1).
e_dom(0'2d) :- !,e_dline(D),e_init(D-1),
		d_cursor(1,D+1),d_cleol,d_cursor(1,D+2),d_cleol.
e_dom(_) :- error(199).
/* **** */
e_doma1 :- e_backward(1),e_char(C),e_space(C),!,e_doma1.
e_doma1 .

e_doma2 :- e_char(C),e_space(C),e_forward(1),!,e_doma2.
e_doma2 .

/* **** */
e_domc(0) :- !.
e_domc(N) :- e_char(C),e_alpha(C),!,e_upper(C,C1),e_delete(1),
		e_insert(C1),N1 is N-1,e_doml(N1).
e_domc(N) :- e_forward(1),N1 is N-1,e_domc(N1).

/* **** */
e_doml(0) :- !.
e_doml(N) :- M is N-1,e_char(C),e_lower(C,D),e_delete(1),e_insert(D),e_doml(M).

/* REPLACE */

e_domr(Mess,Query) :- e_mess(Mess),e_getln(27,[],X),e_echo("$"),
		e_getln(27,[],Y),e_echo("$"),!,e_pos(P),e_domqr(X,Y,Query,P).

e_domqr(X,Y,Query,P) :- e_fsearch(X),length(X,L),
		e_domq(Query,L,Y,Nquery),e_pos(P1),!,e_domqr(X,Y,Nquery,P1).
e_domqr(_,_,_,P) :- e_jump(P),e_echo.

e_domq(no,L,Y,no) :- !,e_backward(L),e_delete(L),e_insert(Y).
e_domq(yes,L,Y,yes) :-
	e_disp,ttyput(7),d_keypeek(32),!,d_keyin(_),e_domq(no,L,Y,no).
e_domq(yes,L,Y,yes) :- d_keypeek(8),!,d_keyin(_).
e_domq(yes,L,Y,no) :- d_keypeek(33),!,d_keyin(_),e_domq(no,L,Y,no).

/* ***** */
e_domu(0) :- !.
e_domu(N) :- M is N-1,e_char(C),e_upper(C,D),e_delete(1),e_insert(D),e_domu(M).

/* ECHO LINE INPUT */

e_getln(X,Y,Z) :- d_keyin(C), e_getln1(X,Y,Z,C).

e_getln1(X,Y,Z,X) :- !,e_rev(Y,[],Z).
e_getln1(X,[C|Y],Z,BS) :- e_getbs(BS),!,e_bs(C),d_keyin(N),e_getln1(X,Y,Z,N).
e_getln1(X,[],Z,BS) :- e_getbs(BS),!,ttyput(7),d_keyin(N),e_getln1(X,[],Z,N).
e_getln1(_,_,_,7) :- !,e_fail.
e_getln1(X,Y,Z,C) :- 32=<C,!,e_pch(C),d_keyin(N),e_getln1(X,[C|Y],Z,N).
e_getln1(X,Y,Z,C1) :- e_code1(C1),!,d_keyin(C),e_pch(C),d_keyin(N),e_getln1(X,[C|Y],Z,N).
e_getln1(X,Y,Z,_) :- ttyput(7),d_keyin(N),e_getln1(X,Y,Z,N).

e_bs(C) :- e_echo(8),e_space(C),!,e_echo(8).
e_bs(C) :- e_kanji(C),!,e_echo(8).
e_bs(C).

e_rev([],X,X) :- !.
e_rev([A|X],Y,Z) :- e_rev(X,[A|Y],Z).

/* ECHO LINE OUTPUT */
e_mess(X):- e_echo,e_echos(X).

e_echos([]) :- !.
e_echos([A|X]) :- !,e_echo(A),e_echos(X).
e_echos(X) :- name(X,L),e_echos(L).

e_fail:- ttyput(7),fail.

/*
  %% ヒストリを番号で取り出す %%
  %  ?- !10.
  %  ?- !!.

  %% この機能を追加するとカットオペレータがシンタックスエラーを発生する場合が
  %% ありますのでご注意ください

   %% example)
   %	a :- (b,!;c).	---> syntax error
   %	a :- ((b,!);c)  ---> OK

:- run:op(100,fx,!).
:- op(100,fx,!).
:- public (!)/1.

!(!) :- !,!(1).
!(0):- !,d_keyback(21).
!(N):- N>0,d_keyback(21),M is N-1,!(M).
*/
:- s_mode(_,off).

