1:- module(elisp, [region/2, region_term/2,
    2		  mark_whole_buffer/2,
    3		  overwrite/2, overwrite/3, paragraph/2,
    4		  line_get/1, global_set_kbd/1, global_unset_kbd/1, dired_mark_swipl/0,
    5		  prolog_symbol_at_point/1,
    6		  book_bibitem/2, first_token_codes/2,
    7		  find_handle_call/4,
    8		  read_term_from_lisp/1,
    9		  read_mini_buffer/2,
   10  		  send_off/1,
   11		  call_lisp/2, call_lisp/1,
   12		  call_lisp_wait/1,
   13		  call_lisp_value/2,
   14		  call_lisp_string/2,
   15		  lisp/1, lisp/2, lisp_to_list/2,
   16		  noreply/1,
   17		  get_string/2, set_string/2,
   18		  message/1,
   19		  insert_buffer/1,
   20		  insert/1,
   21		  set_mark_region/2,
   22		  neighbor_string/3, neighbor_string/5,
   23		  wait/1, wait/2,
   24		  read_codes/1, read_codes/2,
   25		  meta_handle/4, normal_keys/3
   26		  ]).   27
   28:- use_module(pac(basic)).   29:- use_module(util(file)).   30:- use_module(pac(reduce)).   31:- use_module(util(polynomial)).   32:- use_module(util(tex)).   33:- use_module(util(obj)).   34:- use_module(util(misc)).   35
   36% :- use_module(util('convert-dcg')).
   37% :- use_module(util('sed(dcg_ts')).
   38
   39term_expansion --> pac:expand_pac.
   40:- use_module(pac('expand-pac')).   41:- use_module(pac(op)).   42% :- use_module(util(xml)).
   43
   44% memo:  be careful to use sed/3   (module prefix needed) [2014/05/23]
   45%  Prolog-Emacs Interface
   46%  get buffer region
   47% :- use_module(pac('emacs-jockey')).
   48
   49% ?- qcompile(util('prolog-elisp')), module(elisp).
   50:- nb_setval(command_history, [for_ascii(elisp:wrap($))]).   51:- nb_setval(edit_command, (=)).   52% :- use_module(library(edit)).
   53
   54% help//2 is det.
   55%	list all command names.
   56help --> {shortcut_key(L)},
   57	 peek(L),
   58	 insert('\n'),
   59	 smash.
   60
   61:- meta_predicate line(2,?,?).   62:- meta_predicate for_ascii(2, ?, ?).
 tex_cs_to_symbol(X:codes, Y:codes) is det
Convert a tex control sequence codes to a symbol codes.
   66tex_cs_to_symbol --> sed(dcg_ts). % ts.
 tex_symbol_to_cs(X:codes, Y:codes) is det
Convert a symbol codes to a tex control sequence condes.
   70tex_symbol_to_cs --> sed(dcg_st). % st.
   71
   72
   73		/************************************
   74		*     command history management    *
   75		************************************/
 parse_commands(+X:codes, -Y:list) is det
Parse lines as a list of Prolog queries.
   80parse_commands --> split,
   81	remove([]),
   82	maplist(herbrand).
 parse_merge_history(?X, -Y) is det
Merge command history.
   87parse_merge_history --> region,
   88	parse_commands,
   89	merge_history,
   90	clear.
 merge_history(+Cs:list) is det
Merge commands into the command history.
   94merge_history(Cs):- nb_getval(command_history, L),
   95	union(Cs, L, L0),
   96	nb_setval(command_history, L0).
 merge_history(+X:list, -Y:list) is det
Merge commands in X into the command history. Y = X.
  103merge_history(X, X):- merge_history(X).
 merge_history(F:phrase, ?X, ?Y) is det
Parse region as commands, modify by F, and merge into the command history.
  109merge_history(F) --> region,
  110	split,
  111	remove([]),
  112	maplist(phrase(F)),
  113	merge_history.
 show_history(-H:list) is det
Unify H with the current history command.
  118show_history(H) :- nb_getval(command_history, L),
  119	insert('\n', L, L0),
  120	smashq(L0, H).
 show_history(?_, -H:list) is det
Unify H with the current history command.
  125show_history(_, H) :- show_history(H).
 reset_history is det
Reset the command history.
  129reset_history :- nb_setval(command_history, []).
 reset_history(?_, ?_) is det
Reset the command history.
  133reset_history --> {reset_history}.
 set_history(?_, ?_) is det
Reset the command history, parse the region as commands, and set the command history to it.
  138set_history --> reset_history, parse_merge_history.
 show_command(-X:text) is det
Unify X with the edit command.
  142show_command(X) :- nb_getval(edit_command, C),
  143	smashq(C, X).
 show_command(_, -X:text) is det
Unify X with the current command.
  147show_command(_, X):- show_command(X).
 apply_command(X:term, Y:term) is det
Unify X with the current comand history.
  151apply_command --> { nb_getval(edit_command, C) },
  152	phrase(C).
  153
  154%
  155empty_history :- nb_getval(edit_command, []).
  156
  157%
  158pop_history(X) :-  nb_getval(edit_command, [X|R]),
  159		nb_getval(edit_command, R).
  160
  161%
  162push_history(X) :-  nb_getval(edit_command, C),
  163		    nb_setval(edit_command, [X|C]).
  164
  165%
  166save_line_number :- lisp('count-lines'(1, point()), I),
  167		     nb_setval(line_count, I).
  168
  169
  170% ?- apropos(compound_non_zero_arity).
  171% ?- compound_name_arguments(f(),  N, A).
  172%@ N = f,
  173%@ A = [].
  174% ?- compound_name_arguments(f,  N, A).
  175
  176table_index(I) :-  lisp('count-lines'(1, point()), J),
  177		   nb_getval(line_count, K),
  178		   I is J-K.
 comma_left(+A, +B, -C) is det
Unify C with a comma term (A, B).
  182comma_left(A, B, (A, B)).
 comma_right(+A, +B, -C) is det
Unify C with a comma term (B, A).
  186comma_right(A, B, (B, A)).
  187
  188		/*******************************
  189		*     region object manager    *
  190		*******************************/
  191
  192% [2011/06/09]
  193%  Save a phrase / a phrase with environment at  the region
  194%  to use it later.
 initial_region_obj is det
Initialize state_obj.
  198initial_region_obj :- nb_setval(state_obj, []).
 region_obj(C:command) is det
Update a state stored in state_obj by C.
  202region_obj(X):- nb_getval(state_obj, S),
  203	obj(X, S, S0),
  204	nb_setval(state_obj, S0).
 get_phrase(?_, ?_) is det
Compile the goal at the buffer region, and save its handle to the state_obj.
  209get_phrase --> region,
  210	herbrand(_),
  211	call(pred([F, F0] :- let(F0, F))),
  212	current(G),
  213	{	region_obj( put( [command(G)] ) )  },
  214	clear.
 apply_phrase(+X:term, -Y:term) is det
Apply the saved phrase to X to obtain Y, and overwrite the region with Y.
  219apply_phrase --> region,
  220	{  region_obj( get( [command(G)] ) ) },
  221	phrase(G),
  222	overwrite.
 bind_phrase(+X:term, -Y:term) is det
Apply the saved bind_context command to X to unify Y with the result.
  227bind_phrase --> region,
  228	{	region_obj( get( [command(G)] ) )	},
  229		current(X),
  230	{	bind_context(G, (X, []), (X0, _))	},
  231		peek(X0).
  232
  233		/****************
  234		*     region    *
  235		****************/
 region(?A, -X) is det
X is unified with the content of the buffer region when A is unified with [], otherwise, so with A.
  242region([], X) :- !, get_region(X).	% [2014/10/12], [2020/01/11]
  243region(A, A).
 get_region(-R:codes) is det
Get the content of the buffer region, and Unify R with it.
  248get_region(R) :-  lisp('send-region'()),
  249	read_codes(R).
 get_region(?_, -R:codes) is det
Unify R with the content of the buffer region.
  253get_region  --> {get_region(R)}, peek(R).
 get_region(-X:codes, _, -X:codes) is det
Unify X with the content of the buffer region.
  257get_region(X, _, X) :- get_region(X).		%
 region_term(-X:codes, _, -X:codes) is det
Unify X with a term for the codes in the buffer region.
  261region_term(X, Y) :- region(X, X0),
  262					 term_codes(Y, X0).
 get_buffer_region(+X:int, Y:int, _, R:codes) is det
Unify R with the content of the region boundary (X, Y).
  266get_buffer_region(X, Y) --> {get_buffer_region(X, Y, R)},
  267	peek(R).
 get_buffer_region(+X:int, Y:int, R:codes) is det
Unify R with the content of the region boundary (X, Y).
  271get_buffer_region(X, Y, R) :-
  272	lisp('send-region'(X, Y)),
  273	read_codes(R).
 region_bound(?_, X) is det
Unify X with the boundary information of the region.
  277region_bound(_, X) :- region_bound(X).
 region_bound(X) is det
Shorthand for region_bound(_, X).
  281region_bound(X) :- call_lisp_string('region-bound'(), X0),
  282	parse_lisp_form(X0, [X]).
 overwrite(+X:codes, ?_) is det
Kill the region, and insert X to the buffer.
  287overwrite --> { kill_region },	smash_buffer.
  288
  289%
  290overwrite([]) --> !, overwrite.
  291overwrite(_) --> [].
 kill_region is det
Kill the region.
  295kill_region:-  call_lisp_wait('kill-region'(mark(), point())).
 kill_region(B:burrer_name) is det
Kill the region of the buffer Buf.
  299kill_region(Buf):-  smash(Buf, QBuf),
  300	call_lisp_wait(progn(	'set-buffer'(QBuf),
  301			'kill-region'(mark(), point()))).
 insert_buffer(+X:term) is det
Insert X into the current buffer.
  306insert_buffer([]):- !.
  307insert_buffer(X):- smash(["$TEXT$ ", X, "\000\\n"]),
  308	flush_output.
  309%
  310insert(X):- smash(X, Y), wait(insert(Y)).
 send_exp(L:script) is det
  313send_exp(L):- lisp(L).
 find_file(F:file) is det
Send find_file command for F0 to emacs-lisp process.
  317find_file(F) :- expand_file_search_path(F, F0),
  318	lisp('find-file'(F0)).
 find_pred(X:pred, Y, Y) is det
Locate the predicate defiition of X.
  322find_pred(X)--> {find_pred(X)}.
 find_pred(+I) is det
Locate the predicate indicator I = P/N.
  326find_pred(P/N):- functor(G, P, N),
  327	source_file(G, F),
  328	find_file(F).
  329find_pred(P):- find_pred(P/0).
 eval_lisp_to_atom(+F:text, +S:text, -A:atom) is det
Unify the value of evaluation of S-expression (F S).
  333eval_lisp_to_atom(F, S, A):- lisp_atom(["(", F, " ", S, ")"], A).
 eval_lisp_to_atom(+F:text, +X:text, +Y:text, -A:atom) is det
Unify the value of evaluation of S-expression (F X Y).
  337eval_lisp_to_atom(F, X, Y, A):-
  338	lisp_atom(["(", F, " ", X, " ", Y, ")"], A).
  339
  340% ?- atom_lisp_string(abc, X).
 atom_lisp_string(+A:atom, -S:string) is det
convert the atom A to a lisp, and unify S with it.
  344atom_lisp_string(A, S):- atom_codes(A, C),
  345	quote(C, S).
 read_file_name(+P:string, -F:string) is det
Read a file name with prompt P, and unify F with it.
  349read_file_name(P, F):- atom_lisp_string(P, P0),
  350	eval_lisp_to_atom('read-file-name', P0, F).
 read_file_name(-F:string) is det
Read a file name, and unify F with it.
  354read_file_name(F):- read_file_name('file name: ', F).
 completing_read(+P:string, +A:atoms, -R:term) is det
Unify R with the result of completing-read with prompt P and a candidate list A.
  359completing_read(Prompt, Atoms, R):-
  360	atom_lisp_string(Prompt, P0),
  361	maplist(atom_lisp_string, Atoms, As),
  362	call_lisp_value('completing-read'(P0, #(As)), R).
  363
  364
  365% ?- elisp:read_codes_from_minibuffer("Hi :", R).
  366read_codes_from_minibuffer(Prompt,  Codes):-
  367	call_lisp_value('read-from-minibuffer'(Prompt), Codes).
  368
  369% ?- elisp:read_term_from_minibuffer("Hi :", Term).
  370read_string_from_minibuffer(Prompt,  String):-
  371	read_codes_from_minibuffer(Prompt,  Codes),
  372	string_codes(String, Codes).
  373
  374% ?- elisp:read_term_from_minibuffer("Hi :", Term, [variable_names(V)]).
  375read_term_from_minibuffer(Prompt,  Term, Options):-
  376	read_string_from_minibuffer(Prompt,  String),
  377	term_string(Term, String, Options).
  378
  379% ?- elisp:read_term_from_minibuffer("Hi :", Term).
  380read_term_from_minibuffer(Prompt,  Term):-
  381	read_term_from_minibuffer(Prompt, Term, []).
 search_pred(P:pred) is det
Search predicate P.
  385search_pred(Pred):- search_swipl(["^", Pred]).
 search_swipl(X:text) is det
Search X in dired mode.
  389search_swipl(X):- smash(X, C),
  390	dired_mark_swipl,
  391	lisp('dired-do-search'(C)).
 dired_mark_swipl is det
Mark Prolog files in the pacpl7 directory in dired mode.
  396dired_mark_swipl :- getenv(home, Home),
  397    string_concat(Home,"/local/lib/pacpl7", PAC_dir),
  398	dired_mark_regex(PAC_dir, ".*\\.pl$").
 dired_mark_regex(+Dir:string, +Regex:string) is det
visit the directory Dir in Emacs dired mode, and mark all files whose name matches the regex Regex.
  405dired_mark_regex(Dir, Regex) :-
  406	lisp([progn, 'find-file'(Dir),
  407		     'dired-mark-files-regexp'(Regex)]).
  408%	True if J, Len, and X are unified so that X is a symbol of length Len,
  409%	of the category "prolog_symbol_continue", and  at J of the current line,
  410list_at_point(X):- line_get(Obj),
  411	obj_get([line(Line), begin(B), point(P)], Obj, _),
  412	string_codes(Y, Line),
  413	I is P - B,
  414	scan_string_at_point(Y, 0'[, 0'], I, S),
  415	term_string(X, S).
 neighbor_string(+X:string, +B:string, +E:string, +I:integer, -S:string) is det
True if S is the minimum substring of X such that sub_string(X, J, K, _, S), J + length(B) =< I =< K - length(E), and that S has B as a prefix, and E as a suffix.
  423% ?- elisp:neighbor_string("abd", "a", "d", 1, S).
  424% ?- elisp:neighbor_string("abd", "a", "bd", 1, S).
  425
  426neighbor_string(X, Open, Close, I, S):- neighbor_string(X, Open, Close, I, J, K),
  427				   N is K - J,
  428				   N >= 0,
  429				   sub_string(X, J,  N, _, S).
  430
  431% ?- elisp:neighbor_string("abcd", "a", "d", 2, J, K).
  432% ?- elisp:neighbor_string("abd", "a", "d", 2, J, K).
  433%
  434neighbor_string(X, Open, Close, I, J, K):- string_length(X, LX),
  435	string_length(Open, LO),
  436	string_length(Close, LC),
  437	I0 is I - LO,
  438	I0 >= 0,
  439	neighbor_string_left(X, Open, LO, I0, J),
  440	neighbor_string_right(X, Close, LC, I, K0, LX),
  441	K is K0 + LC.
  442
  443%
  444neighbor_string_left(X, S, N, I, I) :- sub_string(X, I, N, _, S), !.
  445neighbor_string_left(X, S, N, I, K) :- I> 0,
  446				  I0 is I-1,
  447				  neighbor_string_left(X, S, N, I0, K).
  448
  449neighbor_string_right(X, S, N, I, I, _):-  sub_string(X, I, N, _, S), !.
  450neighbor_string_right(X, S, N, I, K, L):- I  < L,
  451				     I0 is I + 1,
  452				     neighbor_string_right(X, S, N, I0, K, L).
  453
  454%
  455neighbor_string(B, E, X) :- line_at_point(L, I),
  456			  neighbor_string(L, B, E, I, X).
 line_at_point(-X:string, -I:int, P:int) is det
True if X is the content of the current line, I is the relative position of the cursor.
  463		/*****************************
  464		*     Control Emacs-buffer   *
  465		*****************************/
 stream_start is det
Send 'start prolog process' to emacs.
  469stream_start :- wait('stream-start'()).
 wait(P:list_command, P) is det
Send a lisp Command P, and wait a response.
  473wait(P, P) :- wait(P).
  474
  475% ?- elisp:message("hello").
  476message(M):-  smash(M, M0), lisp(message(M0)).
 prolog(F:phrase) is det
Apply F to the buffer region.
  480:- meta_predicate prolog(:, ?, ?).  481prolog(F) --> region, herbrand, phrase(F).
 line_exec is det
Get the current line, and exec it as a prolog query.
  486line_exec :- line_get(I),
  487	obj_get([line(Line)], I, _),
  488	herbrand(_, Line, G),
  489	!,
  490	catch(G, _, fail).
 smash(F:phrase, X, Y) is det
apply F to the current region, and smash it to Y.
  494smash(F) --> prolog((F, smash)).
 herb(F:phrase, X, Y) is det
apply F to X, smash, convert to a term, and unify Y with it.
  499herb(F) --> prolog((F, herbrand_opp)).
 solve(F:phrase, X, Y) is det
Convert X to a term with prolog variables, and apply F to X, convert the result to a term, and unify Y with it.
  504solve(F) --> herbrand(_),
  505	phrase(F),
  506	herbrand_opp.
 line(F:phrase, X, Y)
Split the region into lines, and apply F to each of them.
  510line(F) --> line(F, "\n").
 line(F:phrase, I:term, X, Y)
Split the region into lines, apply F to each of them, and insert I among lines.
  515line(A, Ins) --> split,
  516	remove([]),
  517	maplist(phrase(A)),
  518	insert(Ins).
 paragraph(F:phrase, +X:codes, -Y)
Split the region X into paragraphs, and apply F to each of them, and unify Y with the result.
  524paragraph(A) --> paragraph,
  525	remove([]),
  526	maplist(phrase(A)).
 lines(X:codes, Y:list) is det
Split the region into a list of lines, and unify Y with it.
  531lines --> split, remove([]).
 line_edit(+Ps:obj) is det
Assuming Ps = [line_get(G), scan(S), do(D), line_put(P)], the current line L = X + A + Y ('+' means codes concatenaton) is rewritten to X + A0 + Y, by applying G to get the line L, applying S to L to get X, A, and Y, as above, and applying D to A to get A0.
  542line_edit(Ps):- obj_get([line_get(G), scan(S), do(D), line_put(P)], Ps),
  543	call(G, I),
  544	obj_get([line(L)], I),
  545	call(S, X, A, Y, L, _),
  546	% act(D, A, A0),
  547	phrase(D, A, A0),
  548	obj_put([left([X, A0]), right(Y)], I, I0),
  549	call(P, I0).
 for_ascii(Act:phrase, X, Y) is det
Apply Act to an ascii codes block in the the currrent line and rewrite the block with the result.
  555for_ascii(Act) --> { line_edit([line_get(line_get_forward),
  556				scan(find_next_ascii_codes),
  557				do(Act),
  558				line_put(line_overwrite)
  559			       ])
  560		   }.
 open_at_point is det
Open the file whose name is at the cursor. [2013/09/08]
  565open_at_point:-  line_get(Obj),
  566	obj_get([line(File)], Obj),
  567	sh(open(File)).
 open_at_point(X, X) is det
Open the file whose name is at the cursor.
  571open_at_point --> {open_at_point}.
 line_at_point(-X:string, -I:int, P:int) is det
True if X is the content of the current line, P is the starting point, I is the relative position of the cursor.
  577line_at_point(X, I, P):- line_get(Obj),
  578	obj_get([point(Q), line(Line), begin(P)], Obj),
  579	string_codes(X, Line),
  580	I is Q - P.
 line_at_point(-X:string, -I:int, P:int) is det
True if X is the content of the current line, I is the relative position of the cursor.
  585line_at_point(X, I):- line_at_point(X, I, _).
  586
  587		/******************************
  588		*     basic line operation    *
  589		******************************/
 line_get(-X:obj) is det
Unify X with [point(P), begin(B), end(E), line(R)], where P is the current point, B the beginning point, E the end point R the content of the line.
  595line_get([point(P), begin(B), end(E), line(R)]):-
  596	lisp(list('line-beginning-position'(),
  597			   'line-end-position'(),
  598			   point()),
  599			[B,E,P]),
  600	get_buffer_region(B, E, R).
 line_get_forward(-X:obj) is det
Unify X with [point(P), begin(P), end(E), line(R)], where P is the current point, E the end point, R the content of the line from P to E.
  607line_get_forward([point(P), begin(P), end(E), line(R)]):-
  608	lisp(list(point(), 'line-end-position'()),  [P, E]),
  609	get_buffer_region(P, E, R).
 line_get_backward(-X:obj) is det
Unify X with [point(P), begin(B), end(P), line(R)], where P is the current point, B the beginning point, R the content of the line from B to P.
  615line_get_backward([point(P), begin(B), end(P), line(R)]):-
  616	lisp(list(point(), 'line-beginning-position'()),
  617			   [P, B]),
  618	get_buffer_region(B, P, R).
 line_overwrite(+I:obj) is det
Provided that L and R are the text in the line informaton I, replace the line I with L plus R, making the point after L a new current point.
  624line_overwrite(I):- obj_get([left(L), right(R)], I),
  625	line_overwrite(I, L, R).
 line_overwrite(+I:obj, L:text) is det
Replace the line with L.
  629line_overwrite(I, L) :- line_kill(I), smash_buffer(L).
 line_overwrite(+I:obj, +L0:text, +L1:text) is det
Replace the line I with L0 plus L1. The point after L0 is the current point.
  634line_overwrite(I, L0, L1) :- line_kill(I),
  635	smash_buffer(L0),
  636	lisp(point(), P),
  637	smash_buffer(L1),
  638	lisp( 'goto-char'(P)).
 smash_buffer(+X:list-(as)-quasi-text) is det
True if all elements in X are written to the standard output in order.
  643smash_buffer(X) :- smash(X, Y), elisp:insert_buffer(Y).
 smash_buffer(+X:text, -Y:list) is det
True if all texts in X are written to the standard output in order, and Y is unfied with [].
  648smash_buffer(X, []) :- smash_buffer(X).
 line_kill(+I:obj) is det
Kill the region I,
  653line_kill(I) :- obj_get([begin(B), end(E)],  I),
  654	lisp('kill_region'(B, E)),
  655	lisp('goto-char'(B)).
 line_kill(X, X) is det
Kill the current line.
  659line_kill --> {line_get(I), line_kill(I)}.
 line_wrap(+L:text, +R:text, X, X) is det
Put L and R before and after, respectively, the current line.
  663line_wrap(L, R) --> {line_wrap(L, R)}.
 line_wrap(+L:text, +R:text) is det
Put L and R before and after, respectively, the current line.
  667line_wrap(L, R):- line_get(I),
  668	obj_get([line(Line)], I),
  669	line_overwrite(I, [L, Line, R]).
 prolog_symbol_at_point(-X:string) is det
True if X is unified with a symbol at the current line.
  674%?- sub_string("abc", X, Y, Z, U).
  675% [2014/03/16]
  676% ?-  elisp:prolog_symbol_at_point(X).
  677prolog_symbol_at_point(X):- line_at_point(Y, I),
  678	symbol_at_index(Y, I, X).
 prolog_symbol_at_point(-J:int, -Len:int, -X:string) is det
True if J, Len, and X are unified so that X is a symbol of length Len, of the category "prolog_symbol_continue", and at J of the current line,
  683prolog_symbol_at_point(J, Len, X):- line_get(Obj),
  684	obj_get([line(Line), begin(B), point(P)], Obj, _),
  685	string_codes(Y, Line),
  686	I is P - B,
  687	symbol_at_index(Y, I, J, K, X, prolog_symbol_continue_chk),
  688	Len is K - J.
 apply_symbol_at_point(+F:pred/2) is det
Convert and replace the current prolog symbol by applying F.
  692:- meta_predicate apply_symbol_at_point(2).  693apply_symbol_at_point(F):- prolog_symbol_at_point(J, Len, X),
  694	call(F, X, Y),
  695	number_string(J, J0),
  696	number_string(Len, Len0),
  697	with_output_to(string(Y0), writeq(Y)),
  698	lisp('replace-in-line'(J0, Len0, Y0)).
 prolog_symbol_at_point(X:string, -I:Int, -Y:string) is det
True if Y is unified with a prolog symbol as a substring of X at I.
  702symbol_at_index(X, I, Y):- symbol_at_index(X, I, Y, prolog_symbol_continue_chk).
 symbol_at_index(+X:string, +I:int, -Y:string, +F:pred/1) is det
True if Y is unified with the longest substring of X at I so that every code of Y satisfies F.
  707symbol_at_index(X, I, Y, F):- symbol_at_index(X, I, _, _, Y, F).
 symbol_at_index(+X:string, +I:int, -J:int, -K:int, -Y:string, +F:pred/1) is det
True if Y, J, and K are unified so that every code of X between point J and K satisfies F, and Y is unified with the substring between J and K.
  714% ?- elisp:symbol_at_index("+abc-", 2, J, K, Y, prolog_symbol_continue_chk).
  715:- meta_predicate symbol_at_index(?,?,?,?,?,1).  716symbol_at_index(X, I, J, K, Y, F):- symbol_at_index(X, I, J, K, F),
  717	L is K - J,
  718	sub_string(X, J, L, _, Y).
  719
  720% ?- X=1.
 symbol_at_index(+X:string, +I:int, -J:int, -K:int, +F:pred/1) is det
True if J and K are unified so that there is a longest substring of X at I that starts at J and ends at K, and that every code of the substring between point J and K satisfies F.
  726:- meta_predicate symbol_at_index(?,?,?,?,1).  727symbol_at_index(X, I, J, K, F):-
  728	symbol_string_before(X, I, J, F),
  729	symbol_string_after(X, I, K, F).
 prolog_symbol_continue_chk(C:code) is det
True if C is of code_type "prolog_identifier_continue".
  733prolog_symbol_continue_chk(C):- code_type(C, prolog_identifier_continue).
 symbol_string_after(+X:string, +I:int, -K:int, +F:pred/1) is det
True if K is unified so that there is a longest substring of X that starts at I and ends at K, and that every code of the substring between point I and K satisfies F.
  739:- meta_predicate symbol_string_after(?,?,?,1).  740symbol_string_after(S, I, K, F):-  succ(I, J),
  741	string_code(J, S, C),
  742	call(F, C),
  743	!,
  744	symbol_string_after(S, J, K, F).
  745symbol_string_after(_, I, I, _).
 symbol_string_after(+X:string, +I:int, -K:int, +F:pred/1) is det
True if K is unified so that there is a longest substring of X that starts at K and ends at I, and that every code between point K and I on the substring satisfies F.
  751:- meta_predicate symbol_string_before(?,?,?,1).  752symbol_string_before(S, I, K, F):-
  753	string_code(I, S, C),
  754	call(F, C),
  755	!,
  756	succ(J, I),
  757	symbol_string_before(S, J, K, F).
  758symbol_string_before(_, I, I, _).
  759
  760		/***********************************************
  761		*	   lisp list vs. prolog list         *
  762		***********************************************/
 term_to_lisp_text(?X:term, ?Y:string) is det
When Y is instantiated, unify X with a prolog term so that X is a translation of a S-exression in the string Y. Otherwise, unify Y with a string so that X is a prolog term translation of Y as an S-expression in string.
  769% ?- elisp:term_to_lisp_text(X, "(ab)"), elisp:term_to_lisp_text(X, Y).
  770%@ X = [[ab]],
  771term_to_lisp_text(X, Y):- nonvar(Y), !,
  772	( string(Y)
  773	->	string_codes(Y, Y0)
  774	;	 Y0 = Y
  775	),
  776	parse_lisp_form(Y0, X).
  777term_to_lisp_text(X, Y):- once(term_to_lisp_string(X, Y)).
 parse_lisp_form(+X:codes, -Y:list) is det
True if Y is unified with a list translation of X as an S-expression in string.
  783parse_lisp_form(X, Y):- once(lisp_list(Y, X, [])).
 lisp_list(-X:codes, +Y:list, -Z:list) is det
True if X is unified with a list which is a translation of a prefix of Y as an S-expression in string, and Z is unified with the remainder.
  790% ?- elisp:lisp_list(X, `()`, []).
  791% ?- elisp:lisp_list(X, `(a)`, []).
  792% ?- elisp:lisp_list(X, `a`, []).
  793% ?- elisp:lisp_list(X, `a b c`, []).
  794% ?- elisp:lisp_list(X, `"a" "b" "c"`, []).
  795% ?- elisp:lisp_list(X, `"a" "b" c`, []).
  796% ?- elisp:lisp_list(X, `(ab)`, []).
  797% ?- elisp:lisp_list(X, `(a b)`, []).
  798% ?- elisp:lisp_list(X, `(a(c)b"de")`, []).
  799% ?- elisp:lisp_list(X, `(a(c)()b"de")`, []).
  800% ?- elisp:lisp_list(X, `(a(c)()b"de""")`, []).
  801% ?- elisp:lisp_list(X, `\\((a(c)()b"de""")`, []).
  802% ?- elisp:lisp_list(X, `\\(a)\\`, []).
  803
  804lisp_list(X) --> skip_lisp_filler, lisp_list(X, []).
 lisp_list(-X:list, -X0:list, +Y:codes, -Z:codes) is det
True if X, X0, and Z are unified with lists so that the difference between X and X0 is a prolog list translation of that of Y and Z as S-expressions in string codes.
  811lisp_list(X, Y) --> lisp_element(A),
  812	{X=[A|X0]},
  813	skip_lisp_filler,
  814	lisp_list(X0, Y).
  815lisp_list(X, X) --> [].
 lisp_list_rest(-X:list, -Y:list, +Z:codes, -U:codes) is det
Unfify X, Y, U, and Z so that the difference between X and Y is a prolog list translation of the difference between Z and U as a tail of a lisp list in string codes.
  822lisp_list_rest(X, X)     --> ")".
  823lisp_list_rest([A|X], Y) --> lisp_element(A),
  824	skip_lisp_filler,
  825	lisp_list_rest(X, Y).
 lisp_element(A:term, +X:codes, -Y:codes) is det
Unify A and Y with a list so that A is an element translation of the difference between X and Y as an S-expression in string codes.
  831lisp_element(A) --> "(",  !,  skip_lisp_filler,
  832	lisp_list_rest(A, []).
  833lisp_element(A) --> lisp_string(A0), !, { herbrand(A0, A) }.
  834lisp_element(A) --> non_string_atom(A0, []), { A0 \== [] }, !,
  835	{ herbrand(A0, A) }.
 skip_lisp_filler(+X:codes, -Y:codes) is det
Skip longest filler block prefix of Y, and unify Y with the remainder.
  841skip_lisp_filler --> [A], { memberchk(A, `\s\t\r\n`) },
  842	skip_lisp_filler.
  843skip_lisp_filler --> [].
 lisp_string(-X:codes, +Y:codes, -Z:codes) is det
True if X is unified a lisp string codes at a prefix of Y, and Z the remainder.
  848lisp_string([0'\"|X]) --> "\"", lisp_string_rest(X, []).  % '
 lisp_string_rest(-X:codes, X0:codes, +Y:codes, -Z:codes) is det
True if X and X0 are unified so that the difference between X and X0 is a lisp string codes at a prefix of Y, and then Z with the remainder.
  854% ?- elisp:lisp_string_rest(X, [], `abcd"`, Y).
  855lisp_string_rest([0'\"|X], X)	--> "\"".				% '
  856lisp_string_rest([0'\\, X|Y], Z) --> "\\", [X], !,		% '
  857	lisp_string_rest(Y, Z).
  858lisp_string_rest([X|Y], Z)	--> [X], lisp_string_rest(Y, Z).
 non_string_atom(-X:codes, -Y:codes, +Z:codes, -U:codes) is det
Unify X, Y, and U so that the difference of X and Y is a non string atom translation of the difference between Z and U.
  863non_string_atom([X|Y], Z) -->[X], {\+ memberchk(X, `()\"\s\t\r\n`)},
  864	non_string_atom(Y, Z).
  865non_string_atom(X, X) --> [].
 quit(X, X) is det
Send to quit the "(start-process)" process.
  869quit --> {lisp(print("PAC process has been quitted by user")),
  870	  lisp('stop-pac'())
  871	  }.
 edit_emacs_P(?X, ?Y) is det
  875%	Ask emacs an edit command in codes,
  876%	If the codes form a prolog phrase H,
  877%	run H on (X, Y).
  878%	Otherwise, split the codes by spaces into a list H of atoms,
  879%	find an handle that H matches its argument, and
  880%	finally run the body of the handle as a phrase on (X, Y).
  881
  882edit_emacs_P --> {ask_command(Codes),
  883		catch(	herbrand(_, Codes, H),
  884			_ ,
  885			split_codes_atoms(Codes, H)
  886		     )
  887	       },
  888		run_command(H).
 run_command(+A:term, ?X:codes, ?Y:codes) is det
Findd a handle that has A as its argument when A is a list, that has [X] when A = -(X), respectively, and apply the body phrase of the handle to (X, Y). Otherwise, apply A itself as a phrase to (X, Y).
  896run_command([X|Y]) --> !, ejockey:handle([X|Y]).
  897run_command(-(X)) --> !, ejockey:handle([X]).
  898run_command(X) --> phrase(X).
 split_codes_atoms(+X:codes, -Y:list) is det
Split X with spaces into a list X0 of blocks of codes, ane unify Y with a list of atoms for the blocks in X0.
  904split_codes_atoms(X, Y):- split(` `, X, S),
  905	remove([], S, S0),
  906	maplist(atom_codes, Y, S0).
  907
  908%
  909skip_rest(X, X, []).
  910
  911% ?- elisp:leading_atoms(`   aab bbb ccc & ddd eee`, A).
  912% ?- elisp:leading_atoms([], X).
  913
  914leading_atoms(X, A):- tex:filler(X, Y),
  915					  once(leading_atoms(A, Y, [])).
  916
  917% ?- elisp:leading_atoms(X, [], R).
  918% ?- elisp:leading_atoms(X, ` aab bbb ccc & ddd eee`, R).
  919% ?- elisp:leading_atoms(X, `aab bbb ccc  ddd eee`, R).
  920% ?- elisp:handle_atom(X, `a`, R).
  921
  922leading_atoms(X) --> "&", skip_rest(X).
  923
  924leading_atoms([A|Y]) --> handle_atom(X), !,
  925		{ atom_codes(A, X) },
  926		tex:filler,
  927		leading_atoms(Y).
  928leading_atoms([]) --> at_end.
  929
  930at_end([], []).
  931
  932% ?- elisp:handle_atom(X, `abc def`, R).
  933handle_atom(X)  --> w("[a-z]", X, Y), wl("[a-zA-Z0-9]*", Y).
  934handle_atom(X)	--> w("[*/=?#.<>\\^\\-\\!]", X).
  935
  936% ?- elisp:make_splitter(`[ab]+`, S), call(S, `abcab`, R).
  937make_splitter(Codes, S) :- string_codes(Regex, Codes),
  938						   let(S, phrase(wl(Regex))).
 edit_emacs_L(+A:pred, ?X, ?Y) is det
Ask emacs for an edit command in codes by calling A Split the codes by spaces into a list H of atoms, find an handle that H matches its argument, and finally run the body of the handle as a phrase on (X, Y). If no handle is found, the codes is parsed as a phrase and the phrase is applied to (X, Y).
  948edit_emacs_L(Ask, X, Y):-
  949	call(Ask, Codes),
  950	leading_atoms(Codes, Com),
  951	once(find_handle_call(Com, Codes, X, Y)).
  952
  953% ?- edit_emacs_L('ask-handle'(), Codes).
  954% ?- elisp:find_handle_call([split, a, b], _,  X, Y).
 find_handle_call(H:list, C:codes, ?X, ?Y) is det
Find an handle such that H matches the argument of the head of the handle, and let P be the body phrase of the handle. In case no handle being found, let P be the phrase term whose codes is C. Then, in any case, apply the phrase P to [X, Y].
  963% ?- elisp:find_handle_call([f, c], `a`, Y), smash(Y).
  964
  965find_handle_call(Com, _Codes, X, Y):- is_list(Com),
  966	member(Module,   [ejockey,  ejockey2]),
  967	clause(Module:handle(H, X, Y), Body),
  968	match_args(Com, H),
  969	!,
  970	once(Module:Body).
  971%  [2020/05/14] The following does not work.
  972%	Module:call(Body), !.
  973%	Module:onde(Body), !.
  974find_handle_call(_, Codes, X, Y):-  % for other type of handles
  975	herbrand(_, Codes, C),
  976	callable(C),
  977	C =.. A,
  978	append(A, [X, Y], B),
  979	D =.. B,
  980	(	clause(snippets:D, Body)
  981	->	G = snippets:Body
  982	;	G = phrase(C, X, Y)
  983	),
  984	once(G).  % was	"call(G), !."
 match_args(+X:list_of_atoms, +Y:list) is det
True if for each pair of elements A and B in order in X and Y, respectively, the following condition is true: If B is a variable then B is unified with A. If B is an atom then A is a prefix of B. If B is a number then B is the atom_number of A, If B is a string then B is the atom_string of A.

If the tail Z of Y=[...|Z] is a variable the Z is unified with the corresponding tail U of X=[...|U].

  998% ?- elisp:match_args([f, c], [frame, center]).
  999% ?- elisp:match_args([sol, go, reg], [solve, goal|X]).
 1000% ?- elisp:match_args([mv, (.)], [mv, (.)]).
 1001% ?- elisp:match_args([f, 'c/d'], [frame, File]).
 1002% ?- elisp:match_args([f, b], [frame, File]).
 1003% ?- elisp:match_args([f, b], [frame|File]).
 1004
 1005match_args([], []):-!.
 1006match_args([A|B], [C|D]):- match_arg_one(A, C), !,
 1007						   match_args(B, D).
 1008%
 1009match_arg_one(A, B) :- var(B), A = B.
 1010match_arg_one(A, B) :- atom(B), sub_atom(B, 0, _, _, A).
 1011match_arg_one(A, B) :- number(B), number_atom(B, A).
 1012match_arg_one(A, B) :- string(B), atom_string(A, B).
 1013
 1014%
 1015normal_keys([], _, []).
 1016normal_keys([X|Xs], Ys, [Y|Zs]):- select(Y, Ys, Y0s),
 1017	match_arg_one(X, Y),
 1018	!,
 1019	normal_keys(Xs, Y0s, Zs).
 1020
 1021% ?- elisp:apropos_chk([a,b,c], axy).
 1022apropos_chk([Y|_], X):- match_arg_one(Y, X), !.
 1023apropos_chk([_|Ys], X):- apropos_chk(Ys, X).
 ask_handle(-C:codes) is det
Ask emacs for a handle codes, and unify C with it.
 1027ask_handle(Codes) :- call_lisp_value('ask-handle'(), Codes).
 1028
 1029% [2020/05/14]
 1030% request from emacs as (prolog-query G).
 1031%	shortcut "s-l" (Command + L )
 1032user:prolog_call(G, _, [G, " done.\n"]):- once(G).
 1033
 1034% ?- elisp:call_lisp_value(list("1","2","3"),  R), elisp:lisp_to_list(R, List).
 1035% ?- elisp:call_lisp_value(+(1,2,3),  R).
 1036% ?- elisp:call_lisp_value(list(1,2),  R). % NOT work.
 1037% ?- elisp:lisp_to_list(list(1,2),  R).  % OK.
 1038% ?- elisp:call_lisp_string(list("1","2","3"),  R).
 ask_command(-C:codes) is det
Ask emacs for a command codes, and unify C with it.
 1042ask_command(Codes) :- call_lisp_value('ask-command'(), Codes).
 1043
 1044%
 1045qval(E, V):- call_lisp(E, string(S)), basic:smash(S, V).
 1046%
 1047elisp(E, V):- call_lisp(E, term(W)), string_codes(V, W).
 1048
 1049% ?- elisp:qval(cons(1, 2),V).
 1050% ?- elisp:qval(cons(1, []),V).
 1051% ?- elisp:qval(setq(w, 2),V).
 1052% ?- elisp:qval(w, V).
 1053% ?- elisp:qval(append(list(1,2,3), list(4, 5, 6)), V).
 1054% ?- elisp:qval(setq(uu, #(hello)), V).
 1055% ?- elisp:qval(setq(uu, "hello"), V).
 1056% ?- elisp:qval(setq(uu, +(1,2,3)), V).
 1057% ?- elisp:qval(setq(uu, #(+(1,2,3))), V).
 1058% ?- elisp:qval(setq(uu, #(#(#(+(1,2,3))))), V).
 1059% ?- elisp:qval(setq(uu, #(#(#(#(+(1,2,3)))))), V).
 1060% ?- elisp:qval(uu, V).
 lisp_to_list(+X:term, -Y:list) is det
Ask emacs to eval an meta-exression X, and unify Y with a list returned from emacs.y
 1065lisp_to_list(M, L):- call_lisp(M, string(V)),
 1066	term_to_lisp_text(L, V).
 1067
 1068% ?- elisp:lisp(+(1, 2, 3), Y).
 1069% ?- elisp:lisp(sort(list(4, 8, 21, 17, 33,  7,  21, 7), #(>)), V).
 1070% ?- elisp:lisp(sort(list(4, 8, 21, 17, 33,  7,  21, 7), #(<)), V).
 1071lisp(X, Y) :- lisp_to_list(X, Y0), Y0 = [Y|_].
 lisp_atom(+X:codes, -Y:atom) is det
Ask emacs to eval an S-exression codes X, and unify Y with an atom for the returned value text codes from emacs.
 1077lisp_atom(X, Y) :- call_lisp(X, term(Z)),  atom_codes(Y, Z).
 no_reply_progn(E:codes) is det
Ask emacs to eval in progn mode for E and wait for "done."
 1082no_reply_progn(E) :- wait(E).
 unquote(+X:codes, -Y:codes) is det
Remove double quote codes if exists at both ends of X, and unify Y with the body of the codes. Otherwise, unify Y with X.
 1088unquote(X, Y):- append([[0'\"], Y0, [0'\"]], X), !,
 1089	unbackquote(Y0, Y).
 1090unquote(X, X).
 unbackquote(+X:codes, -Y:codes) is det
Remove backquote codes used for escape character from X, and unify Y with the remainder.
 1096unbackquote([], []).
 1097unbackquote([0'\\, 0'\\|X], [0'\\|Y]):-	!, unbackquote(X, Y). %'
 1098unbackquote([0'\\, C|X], [0'\\, C|Y]):-	!, unbackquote(X, Y).
 1099unbackquote([C|X], [C|Y]):- unbackquote(X, Y).
 list(?X:list) is nondet
Unify X with most general lists in the 'shortest one first' order.
 1105list([]).
 1106list([_|L]) :- list(L).
 escapeoff(+X:codes, -Y:codes) is det
Remove all escape character code from X, and unify Y with the remainder.
 1112escapeoff --> eh:sed(elisp:escapeoff), flatten.
 1113
 1114escapeoff([X])--> "\\",[X].
 1115
 1116		/********************
 1117		*     read_codes    *
 1118		********************/
 1119% ?- read_codes(X, `yz`).
 1120% |:abcyz
 1121read_codes(X, End):- get_code(C), C \== (-1), !,
 1122	read_codes(C, End, End, [], X, []).
 1123read_codes(_, _):- throw(unexpected_end_of_file(read_codes)).
 1124%
 1125read_codes(X):- read_codes(X, `\000\\n`).
 1126%
 1127read_codes(C, [C|R], End, Q, X, Y):- !, read_codes(R, End, [C|Q], X, Y).
 1128read_codes(C, _, End, [], [C|X], Y):- !, read_codes(End, End, [], X, Y).
 1129read_codes(C, _, End, Q, X, Y):- reverse(Q, Z, X),
 1130	read_codes(C, End, End, [], Z, Y).
 1131
 1132% [2016/07/11]
 1133% Knowing end-of-message by use of read_pending_codes/3.
 1134% ?- elisp:lisp("\000\\n\n", R).
 1135
 1136read_codes([], End, Q, X, Y):- !,
 1137	read_pending_codes(user_input, P, []),
 1138	( P==[] -> X = Y
 1139	;	reverse(Q, Z, X),
 1140		read_codes_suspended(P, End, Z, Y)
 1141	).
 1142read_codes(R, End, Q, X, Y):- get_code(C),
 1143	read_codes(C, R, End, Q, X, Y).
 1144%
 1145read_codes_suspended(S, End, X, Y):-
 1146	( append(A, End, S) -> append(A, Y, X)
 1147	 ; append(S, Z, X),
 1148	   read_pending_codes(user_input, P, []),
 1149	   read_codes_suspended(P, End, Z, Y)
 1150	).
 1151
 1152reverse([A|B], X, Y):- reverse(B, [A|X], Y).
 1153reverse([], X, X).
 1154
 1155		/***************************************************
 1156		*           call_lisp/read_mini_buffer             *
 1157		***************************************************/
 read_term_from_lisp(-X:term) is det
Read a term converted from emacs-lisp text with nullstop.
 1162read_term_from_lisp(X) :-
 1163	read_codes(Codes),
 1164	term_codes(X, Codes).
 call_lisp(+X:term, Option) is det
Ask lisp to eval X as an S expression, with options term(V) : V is unified with a return term codes string(V) : ask emacs-lisp to use 'prin1_to_string' wait : ask emacs-lisp to send 'done' when done. lisp : ask emacs-lisp not to reply.
 1173% ?- elisp:call_lisp([], string(V)).
 1174call_lisp(X, Option):-
 1175	(	noreply = Option
 1176	->	term_to_lisp_string(X, X0),	% just send without waiting.
 1177		send_off(X0)
 1178	;	wait = Option
 1179	-> 	P = progn(X, 'send-done'()),
 1180		term_to_lisp_string(P, X0),
 1181		send_off(X0),
 1182		read_codes(_)
 1183	;	term(V) = Option  -> % was value(V)
 1184		term_to_lisp_string(respond(X, nil), X0),
 1185		send_off(X0),
 1186		read_codes(V)
 1187	;	string(V) = Option ->
 1188		term_to_lisp_string(respond(X, t),  X0),
 1189		send_off(X0),
 1190		read_codes(V)
 1191	;	throw(call_lisp(X, Option))
 1192	).
 1193%
 1194send_off(X):- smash(["$SCRIPT$ ", X, "\000\\n"]),
 1195			 flush_output.
 call_lisp(+X:term) is det
Shorthand for call_lisp(X, wait).
 1199call_lisp(X):- call_lisp(X, wait).
 lisp(X) is det
Shorthand for call_lisp(X, noreply).
 1203lisp(X)		:- call_lisp(X, noreply).
 1204%
 1205noreply(X)	:- call_lisp(X, noreply).
 wait(X) is det
Shorthand for call_lisp_wait(X).
 1209wait(X)		:- call_lisp_wait(X).
 call_lisp_wait(X) is det
Shorthand for call_lisp(X, wait).
 1213call_lisp_wait(X) :- call_lisp(X, wait).
 call_lisp_value(X, Y) is det
Shorthand for call_lisp(X, term(Y)).
 1217call_lisp_value(X, Y) :- call_lisp(X, term(Y)).
 call_lisp_string(X, Y) is det
Shorthand for call_lisp(X, string(Y)]).
 1222call_lisp_string(X, Y) :- call_lisp(X, string(Y)).
 1223
 1224% ?- elisp:lisp(sort(list(4, 8, 21, 17, 33,  7,  21, 7), #(>)), V).
 1225% ?- elisp:lisp(+(1, 2, 3), Y).
 1226% ?- elisp:lisp(setq(uuu, +(1,2,3)), V).
 1227% ?- elisp:lisp(progn(setq(uuu, +(1,2,3)), *(uuu, uuu)), V).
 1228% ?- elisp:lisp(append(cons(#(x),#([a,b])), #([u,v])), R).
 term_to_lisp_string(+X:term-Y:string) is det
Unify Y with a string for X as an S-expression.
 1233% ?- elisp:term_to_lisp_string(f(), X).
 1234%@ X = "(f )" .
 1235% ?- elisp:term_to_lisp_string(list(1,2,3), X).
 1236%@ X = "(list 1 2 3 )" .
 1237% ?- elisp:term_to_lisp_string(prog(a, b, c), X).
 1238%@ X = "(prog a b c )" .
 1239% ?- elisp:term_to_lisp_string(cond([a,b],[b,c]),  X).
 1240%@ X = "(cond (a b )(b c ))" .
 1241% ?- elisp:term_to_lisp_string(defun(f, [a,b], +(a, b)),  X).
 1242%@ X = "(defun f (a b )(+ a b ))" .
 1243
 1244
 1245term_to_lisp_string(X, Y):- term_to_tokens(X, Y0, []),
 1246	tokens_to_string(Y0, Y).
 term_to_tokens(+X:term, -Y:list, -Z:list) is det
Convert a term X into an S-expression so that the diffirence between Y and Z is a flat list of tokens for the S-expression.
 1253% ?- elisp:term_to_tokens(f(a), R, []).
 1254% ?- elisp:term_to_tokens(#(a), R, []).
 1255% ?- elisp:term_to_tokens([f(a)], R, []).
 1256% ?- elisp:term_to_tokens(f([a]), R, []).
 1257% ?- elisp:term_to_tokens(f(123), R, []).
 1258% ?- elisp:term_to_tokens(list(1,2,3), R, []).
 1259% ?- elisp:term_to_tokens(#(#(1)), R, []).
 1260% ?- elisp:term_to_tokens(#(list([1,2,3])), R, []).
 1261% ?- elisp:term_to_tokens([a,b], R, []).
 1262% ?- elisp:term_to_tokens([[a,b], [c,d]], R, []), tokens_to_string(R, R0).
 1263
 1264% # is reserved for quote.
 1265term_to_tokens(X, ['('|Y], Z):- is_list(X), !,
 1266		  term_to_tokens_with_closing(X, Y, Z).
 1267term_to_tokens(X, [X0|Y], Y):- atom(X), !, atom_string(X, X0).
 1268term_to_tokens(X, [X0|Y], Y):- atomic(X), !, term_string(X, X0).
 1269term_to_tokens(#(X), Y, Z) :- term_to_tokens([quote, X], Y, Z).
 1270term_to_tokens(X, Y, Z) :-
 1271	compound_name_arguments(X, F, Args),
 1272	term_to_tokens([F|Args], Y, Z).
 term_to_tokens_with_closing(+X:list, -Y:list, -Z:list) is det
Convert each element of X into an S-expression so that the diffirence between Y and Z is a flat list of tokens for the list of S-expression.
 1279term_to_tokens_with_closing([], [')'|Y], Y).
 1280term_to_tokens_with_closing([A|B],  X, Y):- term_to_tokens(A, X, Z),
 1281	term_to_tokens_with_closing(B, Z, Y).
 tokens_to_string(+X:list, -Y:list) is det
Convert a list X of tokens into a string Y by concatenation so that Y is a string form of an S-expression that X represents ?- elisp:tokens_to_string([a], X). ?- elisp:tokens_to_string(['(', '(', a, b, ')', ')'], X).
 1290tokens_to_string(X, Y):-
 1291	tokens_to_string(X, Y0, []),
 1292	atomics_to_string(Y0, Y).
 1293%
 1294tokens_to_string([], X, X).
 1295tokens_to_string([T|R], X, Y):- tokens_to_string(T, X, Z),
 1296	tokens_to_string(R, Z, Y).
 1297tokens_to_string('(', ["("|X], X).
 1298tokens_to_string(')', [")"|X], X).
 1299tokens_to_string(A,   [A, " "|X], X).
 read_mini_buffer(+P:sring, -S:string) is det
Read a string from the emacs mini-buffer.
 1304% ?- elisp:read_mini_buffer("hello", X).
 1305
 1306read_mini_buffer(Prompt, Str):-
 1307	call_lisp('read-string'(Prompt), term(StrCodes)),
 1308	string_codes(Str, StrCodes).
 read_number(Max:int, X:number) is det
Read a number from the emacs mini-buffer.
 1312read_number(Max,  X):- read_mini_buffer("number : ", S),
 1313	number_string(X, S),
 1314	between(1, Max, X).
 1315
 1316		/********************************
 1317		*     set/get string globally   *
 1318		********************************/
 setq(+X:atom, +Y:term) is det
Shorthand for lisp(setq(X, Y)). ?- elisp:setq(working_directory, "/Users/cantor/file.pdf").
 1323setq(X, Y):-lisp(setq(X, Y)).
 set_string(+X:atom, +Y:text) is det
Ask emacs lisp to eval S-expression "(setq X Y)".
 1328set_string(X, Y):-  smash(Y, Y0), setq(X, Y0).
 get_string(X:atom, -V:string) is det
Unify V with the string that is bound to a lisp atom X.
 1332get_string(Atom, String):-
 1333	call_lisp(Atom, string(V)),
 1334	string_codes(V0, V),
 1335	term_string(String, V0).
 1336
 1337line(X) :- elisp:call_lisp(
 1338	'buffer-substring'(	'line-beginning-position'(),
 1339				'line-end-position'()),
 1340	term(X)).
 mark_whole_buffer(X, X) is det
Mark whole buffer.
 1344mark_whole_buffer --> {lisp('mark-whole-buffer'())}.
 set_mark_region is det
Mark paragraph region.
 1348set_mark_region	:- lisp('mark-paragraph-region'()).
 set_mark_region(X, X) is det
Mark paragraph region.
 1352set_mark_region --> {set_mark_region}.
 line_region(?X, L:codes) is det
Unify the content of the current line.
 1357line_region(_, Line) :- line_get(Obj), obj_get([line(Line)], Obj).
 cur_dir(-D:atom) is det
Unify D with the current directory name.
 1362% ?- elisp:cur_dir(D).
 1363cur_dir(D) :- lisp_atom('default-directory', D).
 cur_buf(-B:atom) is det
Unify B with the current buffer name.
 1368% ?- elisp:cur_buf(X).
 1369cur_buf(B) :- current_buffer_name(B).
 current_buffer_name(-X:atom) is det
Unify X with current buffer name.
 1373current_buffer_name(X) :- current_buffer_name([], X).
 current_buffer_name(_, -A:atom) is det
Unify A with the current buffer name.
 1378% ?- elisp:current_buffer_name(_, Y).
 1379current_buffer_name -->
 1380	{	call_lisp('buffer-name'('current-buffer'()), term(E)),
 1381		atom_codes(A, E)
 1382	},
 1383	peek(A).
 default_directory(-D:text) is det
D is unified with the codes of emacs default-directory.
 1386default_directory(D) :- call_lisp_value('default-directory', D).
 mark(-X:int) is det
Unify X with the marked point if exists, otherwise with the current point.
 1392%	?- elisp:mark(X).
 1393mark(X):- lisp(if(integerp(mark(t)), mark(), point()), X).
 point(-X:int) is det
Unify X with the current point.
 1397point(X) :- lisp(point(), X).
 goto_char(P:int) is det
'Goto-char' to P.
 1401goto_char(P) :- lisp('goto-char'(P)).
 goto_char(P:int, X, X) is det
'Goto-char' to P.
 1405goto_char(P) --> {goto_char(P)}.
 goto_char(K:string, S:string) is det
'Goto-char' to the marked point plus I in the buffer, where I is a relative position of K in S.
 1411goto_char(Key, String) :- sub_string(String, I, _, _, Key),
 1412	mark(P),
 1413	P0 is P + I,
 1414	goto_char(P0).
 goto_line(P:int) is det
'Goto-line' to line P.
 1419goto_line(P) :- lisp( 'goto-line'(P)).
 point_max(-X:int) is det
Unify X with the point-max.
 1424point_max(X):- lisp('point-max'(), X).
 point_min(-X:int) is det
Unify X with the point-min.
 1429point_min(X):- lisp('point-min'(), X).
 buffer_substring(+P:int, +Q:int, -S:codes) is det
Unify S with the content of the buffer between P and Q.
 1434% ?- elisp:buffer_substring(20, 30, X).
 1435buffer_substring(P, Q, S):- call_lisp('buffer-substring'(P, Q), term(S)).
 edit_command_set(X, X) is det
Set edit-command-set.
 1440% edit_command_set --> {edit_command_set}.
 edit_command_set is det
Set edit-command-set.
#([set_dired, dired, prolog, lisp, prooftree] ))).
 1448edit_command_set:- lisp(setq('edit-command-set',
 1449     #(["set_dired", "dired",  "prolog", "lisp", "prooftree"] ))).
 1450
 1451% ?- listing(quote).
 edit(X, X) is det
Ask a predicate name, and Go to its definition.
 1456edit --> {	lisp_atom('read-string'("predicate[/N] : "), P),
 1457		setof(X-Y, find_pred:locate(P, X, Y), Pairs),
 1458		show_select_location(Pairs),
 1459		length(Pairs, N),
 1460		N > 0,
 1461		(	N  == 1
 1462		->	J  = 1
 1463		;	call_lisp('ask-term'("number ? "), term(J0)),
 1464			number_codes(J, J0)
 1465		),
 1466		nth1(J, Pairs, _ - [file(F), line(G)]),
 1467		atom_string(F, F0),
 1468		lisp(progn('find-file'(F0), 'goto-line'(G)))
 1469	 }.
 1470edit --> { lisp(message("No requested predicate found.")) }.
 1471
 1472%
 1473show_select_location(Pairs) :-
 1474	wait('switch-to-buffer'("*scratch*")),
 1475	insert_buffer("** select number **\n"),
 1476	length(Pairs, N),
 1477	numlist(1, N, Ns),
 1478	maplist(pred(([I,  Spec - _, [I0, ".\t- ", Spec0, "\n"]]:-
 1479		     number_string(I, I0),
 1480		     term_string(Spec, Spec0))),
 1481		Ns, Pairs, Specs),
 1482	insert_buffer(Specs).
 zip_minus(?X:list, ?Y:list, ?Z:list) is det
Zip lists with '-'.
 1487zip_minus([], [], []).
 1488zip_minus([A|X], [B|Y], [A-B|R]):- zip_minus(X, Y, R).
 visit_file_line(File:file, N:int) is det
Send "find-file and goto-char" command to emacs.
 1493% ?- elisp:visit_file_line("/Users/cantor/tmp/deldel.pl", 3).
 1494visit_file_line(File, Line):-
 1495	lisp(progn('find-file'(#(File)), 'goto-line'(Line))).
 ask_number(P:string, X) is det
Ask via emacs with prompt P, and Unify X with the input value.
 1500ask_number(P, X):- atomics_to_string(P, P0),
 1501	lisp('ask-term'(P0), X).
 ask_which(+Xs:list, -N:int) is det
Display elements of Xs with a number, ask a number, and unify N with the number input. When Xs is a singleton list, N is unified with 1 without asking.
 1509ask_which([_], 1).
 1510ask_which(Xs, J):- maplist([N-I, [N,-,I]], Xs, Ys),
 1511	insert("\n\t", Ys, Zs),
 1512	ask_number(["Select number:\n\t"|Zs], J).
 1513
 1514		/*****************
 1515		*     for tex    *
 1516		*****************/
 wdf(X:codes, Y:codes) is det
Put a dollor code at both ends.
 1521wdf --> wrap_dollar_forwarding.
 1522
 1523%
 1524wrap_dollar_forwarding	--> for_ascii(X\[$, X, $]).
 1525wrap_Red_forwarding		--> for_ascii(X\['\\Red{', X, '}']).
 1526wrap_Green_forwarding	--> for_ascii(X\['\\Green{', X, '}']).
 1527wrap_Blue_forwarding	--> for_ascii(X\['\\Blue{', X, '}']).
 1528wrap_with_single_quote	--> region,
 1529	line(X\['''', X, ''''], ',\n'), smash, overwrite.
 find_next_ascii_codes(X, A, Y, L, L0) is det
True if A is an ascii code block, X is non ascii code block, and X + A + Y is the difference of L from L0.
 1535% ?- elisp:find_next_ascii_codes(X, A, R, ` 宇 宙 a b c  `, Y).
 1536find_next_ascii_codes(X, A, Y) --> skip_to_ascii_codes(X),
 1537	ascii_codes(A),
 1538	current(Y).
 1539
 1540%!  ascii_codes(-X:codes, +Y:codes, -Z:codes) is det.
 1541%	True if
 1542%	X is unified with the maximum ascii codes prefix of Y,
 1543%	Z with the remainder of Y.
 1544
 1545% ?- elisp:ascii_codes(X, `ab cd  `, R).
 1546%@ X = [97, 98, 32, 99, 100],
 1547%@ R = [32, 32] .
 1548ascii_codes(X) --> wl(+(?(char(space)) + char(ascii\space)),  X).
 skip_to_ascii_codes(-X:codes, +Y:codes, -Z:codes) is det
True if X is unfied with the maximum non-ascii codes prefix of Y, Z with the remainder of Y.
 1555% ?- elisp:skip_to_ascii_codes(X, `abc`, Y).
 1556
 1557% ?- elisp:skip_to_ascii_codes(X, `向井 国昭 abc`, Y).
 1558skip_to_ascii_codes(X) --> wl( *(char(\+ascii|space)) | char(space)^(>=(2)), X).
 1559
 1560$([],[]). % end_of_codes([], []).
 1561
 1562first_token_codes --> wl(*char(white)),					  w(*(.), X),					  wl(*char(white)),					  $,  % end of codes					  peek(X).
 global_set_kbd(A:string) is det
Set a global default short cut for a rolog script A.
 1571%	?-  elisp:global_set_kbd("ejockey:handle([eit])").
 1572global_set_kbd(A) :- global_set_kbd("C-c C-u", A).
 global_set_kbd(Key:string, A:string) is det
Set a global short cut for a prolog script A.
 1577global_set_kbd(Key, A) :-
 1578	lisp('global-set-key'(kbd(Key),
 1579			#(lambda(nil, interactive(), 'prolog-query'(A))))).
 global_unset_kbd(K:string) is det
global-unset key in kbd form.
 1584global_unset_kbd(K):- lisp('global-unset-key'(kbd(K))).
 1585
 1586		/******************************************
 1587		*     Convert xml to quasi bibtex form    *
 1588		******************************************/
 1589
 1590% ?- scm(elisp).
 1591% ?- abbreviation('ab cd', X).
 1592
 1593abbreviation(A, B):- string_code(I, A, 0'\s), !,    % '
 1594					 succ(J, I),
 1595					 sub_string(A, 0, J, _, B0),
 1596					 atom_string(B, B0).
 1597abbreviation(A, A).
 1598
 1599% ?- make_key([published='2014', author='Obama'], Key).
 1600
 1601make_key(L, Key):- memberchk(published=Year, L),
 1602	memberchk(author=Author, L),
 1603	!,
 1604	abbreviation(Author, Abbr),
 1605	atom_concat(Abbr, Year, Key).
 1606make_key(L, Key):- memberchk(published=Year, L),
 1607	memberchk(publisher=Pub, L),
 1608	!,
 1609	abbreviation(Pub, Abbr),
 1610	atom_concat(Abbr, Year, Key).
 1611make_key(L, Key):- memberchk(published=Year, L),
 1612	memberchk(publisher=Pub, L),
 1613	!,
 1614	abbreviation(Pub, Abbr),
 1615	atom_concat(Abbr, Year, Key).
 1616make_key(_, '??????').
 1617
 1618% Use this predicate after exporting onto the Desktop directory.
 1619% run unix command delicious-export  [2016/12/16]
 1620% ?- parse_xml_for_bibtex(Bib), maplist(writeln, Bib), length(Bib, Length).
 1621% ?- parse_xml_for_bibtex(Bib), open('/Users/cantor/Desktop/test', write, X),maplist(writeqln(X),  Bib), close(X).
 1622
 1623% Delicious Library 3; incremental export to bibtex
 1624% revised Workflow:
 1625%	(0) => (1) =>(2) => (3)
 1626%
 1627% (0)  initialize
 1628% %  touch ~/TeXLive/texmf-var/bibtex/bib/delicious-db.pl
 1629%
 1630% (1) run unix script [2016/12/16]:
 1631% %  delicious-export
 1632%
 1633% (2) run prolog query:
 1634% ?- elisp:delicious_update.
 1635%@ true .
 1636
 1637%
 1638% (3) Open the output at the Desktop, and  edit .bib files manually.
 1639
 1640% ?- elisp:delicious_bibtex_terms("~/TeXLive/texmf-var/bibtex/bib/deldelbooks1.pl").
 1641% ?- elisp:delicious_bibtex_terms("~/Desktop/test.pl", "~/Desktop/test.bib").
 1642
 1643% ?- trace, elisp:delicious_update.
 1644
 1645delicious_update:-
 1646	delicious_bibtex_terms("~/TeXLive/texmf-var/bibtex/bib/delicious-db.pl",
 1647						   "~/Desktop/new-delicious", ".bib").
 1648
 1649delicious_bibtex_terms(DB, Bib_basic, Ext) :- parse_xml_for_bibtex(Bib), !,
 1650	   sort(Bib, Bib0),
 1651	   expand_file_name(DB, [DB0|_]),
 1652	   pshell(touch(DB0)),
 1653	   read_file_to_terms(DB0, Old_bib, []),
 1654	   subtract(Bib0, Old_bib, NewBooks),
 1655	   open(DB0, write, Y),
 1656	   maplist(writeq_book_term(Y),  Bib0),
 1657	   close(Y),
 1658	   sort(NewBooks, NewBooks0),
 1659	   maplist(book_bibitem, NewBooks0, Bib1),
 1660	   atomics_to_string([Bib_basic, Ext],Bib_file),
 1661	   expand_file_name(Bib_file, [Out0|_]),
 1662	   string_length(Ext, N),
 1663	   sub_string(Out0, 0, _, N, Out_basic),
 1664	   ejockey:modify_file_name(Out_basic, 0, Ext, NewOut),
 1665	   open(NewOut, write, Z),
 1666	   maplist(writeln(Z),  Bib1),
 1667	   close(Z).
 1668
 1669writeq_book_term(X, Book):-
 1670	writeq(X, Book),
 1671	write(X, ".\n").
 1672
 1673%
 1674delicious_bibtex(Out) :- parse_xml_for_bibtex(Bib), !,
 1675	   sort(Bib, Bib0),
 1676	   maplist(book_bibitem, Bib0, Bib1),
 1677	   expand_file_name(Out, [Out0|_]),
 1678	   open(Out0, write, X),
 1679	   maplist(writeln(X),  Bib1),
 1680	   close(X).
 1681
 1682writeqln(S, X):- writeq(S, X), write(S, '.\n').
 1683
 1684% parse_xml_for_bibtex(Bib):-
 1685% 	expand_file_name("~/Desktop/Delicious Library/Library Media Data.xml", [File]),
 1686% 	parse_xml_for_bibtex(File, Dom),
 1687% 	maplist(pred(([book(L), book([key=Key|L])]:- make_key(L, Key))),
 1688% 			Dom, Bib).
 1689
 1690% % ?- parse_xml_for_bibtex("/path/to/xml-file", Dom).
 1691% parse_xml_for_bibtex(File, Books):-
 1692% 	Keys = [
 1693% 			published,
 1694% 			publisher,
 1695% 			title,
 1696% 			upc,
 1697% 			author],
 1698% 	parse_xml_to_books(File, Books, Keys).
 1699% %
 1700% parse_xml_to_books(File, Books, Keys):-
 1701% 	load_xml(File, Dom, [encoding('utf-8')]),
 1702% 	flatten_element_list(Dom, Books, [], Keys).
 1703
 1704%
 1705flatten_element_list([A|B], X, Y, Keys):-
 1706	once(flatten_element(A, X, X0, Keys)),
 1707	flatten_element_list(B, X0, Y, Keys).
 1708flatten_element_list([], X, X, _).
 1709
 1710%
 1711flatten_element(element(library, _, L), X, Y, Keys):-
 1712	flatten_element_list(L, X, Y, Keys).
 1713flatten_element(element(items, _, L), X, Y, Keys):-
 1714	flatten_element_list(L, X, Y, Keys).
 1715flatten_element(element(book, L, _), [book(L0)|X], X, Keys):-
 1716	projection(L, Keys, L0).
 1717flatten_element(_, X, X, _).
 1718
 1719%
 1720projection([], _, []).
 1721projection([Eq|L], Keys, [Eq0|L0]):- modify_value(Eq, Eq0), !,
 1722	projection(L, Keys, L0).
 1723projection([Eq|L], Keys, [Eq|L0]):- Eq = (K = _), memberchk(K, Keys), !,
 1724	projection(L, Keys, L0).
 1725projection([_|L], Keys, L0):- projection(L, Keys, L0).
 1726
 1727%
 1728modify_value(published = V, published = V0):-
 1729	sub_atom(V, 0, 4, _, V0).
 1730modify_value(K = '-',  K = void).
 1731modify_value('aspect=-',  aspect = undefined).
 1732
 1733% Target sample.
 1734% @book{Noro-2003,
 1735% 	author = {野呂 正行 and 横山 和弘},
 1736% 	publisher = {東京大学出版会},
 1737% 	pages = {288},
 1738% 	title = {グレブナー基底の計算基礎篇-計算代数入門},
 1739% 	keywords = {科学・テクノロジー},
 1740% 	ISBN = {4130614045},
 1741% 	language = {日本語 (Published)},
 1742% 	price = {ï¿¥ 4,536},
 1743% 	year = {2003}
 1744% }
 1745
 1746book_bibitem(book(L), BB):-
 1747	select(key=Keyval, L, L0),
 1748	maplist(pred( [published=V, [year, " = ", "{", V, "}"]]
 1749				& [K=V, [K, " = ", "{", V, "}"]]),
 1750			L0, Items),
 1751	insert(",\n", Items, Items0),
 1752	smash(["@book{", Keyval, ",\n", Items0, "\n}\n"], BB).
 meta_handle(+G, +M, +Sp, +P)

Execute G almost in the same way as for phrase(G, X, Y) when P = [X,Y], or call(G) when P=[]. For each atomic pharse P of G

meta_handle(B, M, Sp, [])

is executed when call(Sp, M, P, B) is true.

This predicate is convenient to test

handles, which may have handle calls in the body, and see their outputs on emacs buffer window.

 1773% helpers.
 1774
 1775id([X,X]).
 1776id([]).
 1777
 1778transitive([], [], []).
 1779transitive([X, Y], [X, Z], [Z, Y]).
 1780
 1781:- meta_predicate meta_handle(:,+,4,+). 1782
 1783%
 1784meta_handle(X,Y,Z,U):- meta_handle_plain(X,Y,Z,U).
 1785
 1786%
 1787meta_handle_plain((A,B), M, Sp, P):- transitive(P, Q, R),
 1788     meta_handle_plain(A, M, Sp, Q),
 1789	 meta_handle_plain(B, M, Sp, R).
 1790meta_handle_plain(M:A, _, Sp, P):-  meta_handle_plain(A, M, Sp, P).
 1791meta_handle_plain(A;B, M, Sp, P):-
 1792	 (meta_handle_plain(A, M, Sp, P)
 1793	 ; meta_handle_plain(B, M, Sp, P)).
 1794meta_handle_plain(A->B, M, Sp, P):- transitive(P, Q, R),
 1795	 meta_handle_plain(A, M, Sp, Q), !,
 1796	 meta_handle_plain(B, M, Sp, R).
 1797meta_handle_plain((A->B; C), M, Sp, P):- transitive(P, Q, R),
 1798	(meta_handle_plain(A, M, Sp, Q), !, meta_handle_plain(B, M, Sp, R)
 1799	; meta_handle_plain(C, M, Sp, P)).
 1800meta_handle_plain(nopac({A}), M, _, P):- id(P),
 1801	( M==[], !, call(A)
 1802	; call(M:A) ).
 1803meta_handle_plain(A, M, Sp, P)	:- Sp\==[], Sp\= _:[],
 1804	call(Sp, A, M, P, G),
 1805	!,
 1806	meta_handle_plain(G, M, Sp, []).
 1807meta_handle_plain(A, [], _, P):- apply(A, P).
 1808meta_handle_plain(A, M, _, P):- apply(M:A, P).
 1809
 1810:- initial_region_obj.