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
Unify Unify X with the content of the buffer region when A == [], otherwise, with A.
  241region([], X) :- !, get_region(X).	% [2014/10/12], [2020/01/11]
  242region(A, A).
 get_region(-R:codes) is det
Get the content of the buffer region, and Unify R with it.
  247get_region(R) :-  lisp('send-region'()),
  248	read_codes(R).
 get_region(?_, -R:codes) is det
Unify R with the content of the buffer region.
  252get_region  --> {get_region(R)}, peek(R).
 get_region(-X:codes, _, -X:codes) is det
Unify X with the content of the buffer region.
  256get_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.
  260region_term(X, Y) :- region(X, X0),
  261					 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).
  265get_buffer_region(X, Y) --> {get_buffer_region(X, Y, R)},
  266	peek(R).
 get_buffer_region(+X:int, Y:int, R:codes) is det
Unify R with the content of the region boundary (X, Y).
  270get_buffer_region(X, Y, R) :-
  271	lisp('send-region'(X, Y)),
  272	read_codes(R).
 region_bound(?_, X) is det
Unify X with the boundary information of the region.
  276region_bound(_, X) :- region_bound(X).
 region_bound(X) is det
Shorthand for region_bound(_, X).
  280region_bound(X) :- call_lisp_string('region-bound'(), X0),
  281	parse_lisp_form(X0, [X]).
 overwrite(+X:codes, ?_) is det
Kill the region, and insert X to the buffer.
  286overwrite --> { kill_region },	smash_buffer.
  287
  288%
  289overwrite([]) --> !, overwrite.
  290overwrite(_) --> [].
 kill_region is det
Kill the region.
  294kill_region:-  call_lisp_wait('kill-region'(mark(), point())).
 kill_region(B:burrer_name) is det
Kill the region of the buffer Buf.
  298kill_region(Buf):-  smash(Buf, QBuf),
  299	call_lisp_wait(progn(	'set-buffer'(QBuf),
  300			'kill-region'(mark(), point()))).
 insert_buffer(+X:term) is det
Insert X into the current buffer.
  305insert_buffer([]):- !.
  306insert_buffer(X):- smash(["$TEXT$ ", X, "\000\\n"]),
  307	flush_output.
  308%
  309insert(X):- smash(X, Y), wait(insert(Y)).
 send_exp(L:script) is det
  312send_exp(L):- lisp(L).
 find_file(F:file) is det
Send find_file command for F0 to emacs-lisp process.
  316find_file(F) :- expand_file_search_path(F, F0),
  317	lisp('find-file'(F0)).
 find_pred(X:pred, Y, Y) is det
Locate the predicate defiition of X.
  321find_pred(X)--> {find_pred(X)}.
 find_pred(+I) is det
Locate the predicate indicator I = P/N.
  325find_pred(P/N):- functor(G, P, N),
  326	source_file(G, F),
  327	find_file(F).
  328find_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).
  332eval_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).
  336eval_lisp_to_atom(F, X, Y, A):-
  337	lisp_atom(["(", F, " ", X, " ", Y, ")"], A).
  338
  339% ?- 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.
  343atom_lisp_string(A, S):- atom_codes(A, C),
  344	quote(C, S).
 read_file_name(+P:string, -F:string) is det
Read a file name with prompt P, and unify F with it.
  348read_file_name(P, F):- atom_lisp_string(P, P0),
  349	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.
  353read_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.
  358completing_read(Prompt, Atoms, R):-
  359	atom_lisp_string(Prompt, P0),
  360	maplist(atom_lisp_string, Atoms, As),
  361	call_lisp_value('completing-read'(P0, #(As)), R).
  362
  363
  364% ?- elisp:read_codes_from_minibuffer("Hi :", R).
  365read_codes_from_minibuffer(Prompt,  Codes):-
  366	call_lisp_value('read-from-minibuffer'(Prompt), Codes).
  367
  368% ?- elisp:read_term_from_minibuffer("Hi :", Term).
  369read_string_from_minibuffer(Prompt,  String):-
  370	read_codes_from_minibuffer(Prompt,  Codes),
  371	string_codes(String, Codes).
  372
  373% ?- elisp:read_term_from_minibuffer("Hi :", Term, [variable_names(V)]).
  374read_term_from_minibuffer(Prompt,  Term, Options):-
  375	read_string_from_minibuffer(Prompt,  String),
  376	term_string(Term, String, Options).
  377
  378% ?- elisp:read_term_from_minibuffer("Hi :", Term).
  379read_term_from_minibuffer(Prompt,  Term):-
  380	read_term_from_minibuffer(Prompt, Term, []).
 search_pred(P:pred) is det
Search predicate P.
  384search_pred(Pred):- search_swipl(["^", Pred]).
 search_swipl(X:text) is det
Search X in dired mode.
  388search_swipl(X):- smash(X, C),
  389	dired_mark_swipl,
  390	lisp('dired-do-search'(C)).
 dired_mark_swipl is det
Mark Prolog files in the pacpl7 directory in dired mode.
  395dired_mark_swipl :- getenv(home, Home),
  396    string_concat(Home,"/local/lib/pacpl7", PAC_dir),
  397	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.
  404dired_mark_regex(Dir, Regex) :-
  405	lisp([progn, 'find-file'(Dir),
  406		     'dired-mark-files-regexp'(Regex)]).
  407%	True if J, Len, and X are unified so that X is a symbol of length Len,
  408%	of the category "prolog_symbol_continue", and  at J of the current line,
  409list_at_point(X):- line_get(Obj),
  410	obj_get([line(Line), begin(B), point(P)], Obj, _),
  411	string_codes(Y, Line),
  412	I is P - B,
  413	scan_string_at_point(Y, 0'[, 0'], I, S),
  414	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.
  422% ?- elisp:neighbor_string("abd", "a", "d", 1, S).
  423% ?- elisp:neighbor_string("abd", "a", "bd", 1, S).
  424
  425neighbor_string(X, Open, Close, I, S):- neighbor_string(X, Open, Close, I, J, K),
  426				   N is K - J,
  427				   N >= 0,
  428				   sub_string(X, J,  N, _, S).
  429
  430% ?- elisp:neighbor_string("abcd", "a", "d", 2, J, K).
  431% ?- elisp:neighbor_string("abd", "a", "d", 2, J, K).
  432%
  433neighbor_string(X, Open, Close, I, J, K):- string_length(X, LX),
  434	string_length(Open, LO),
  435	string_length(Close, LC),
  436	I0 is I - LO,
  437	I0 >= 0,
  438	neighbor_string_left(X, Open, LO, I0, J),
  439	neighbor_string_right(X, Close, LC, I, K0, LX),
  440	K is K0 + LC.
  441
  442%
  443neighbor_string_left(X, S, N, I, I) :- sub_string(X, I, N, _, S), !.
  444neighbor_string_left(X, S, N, I, K) :- I> 0,
  445				  I0 is I-1,
  446				  neighbor_string_left(X, S, N, I0, K).
  447
  448neighbor_string_right(X, S, N, I, I, _):-  sub_string(X, I, N, _, S), !.
  449neighbor_string_right(X, S, N, I, K, L):- I  < L,
  450				     I0 is I + 1,
  451				     neighbor_string_right(X, S, N, I0, K, L).
  452
  453%
  454neighbor_string(B, E, X) :- line_at_point(L, I),
  455			  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.
  462		/*****************************
  463		*     Control Emacs-buffer   *
  464		*****************************/
 stream_start is det
Send 'start prolog process' to emacs.
  468stream_start :- wait('stream-start'()).
 wait(P:list_command, P) is det
Send a lisp Command P, and wait a response.
  472wait(P, P) :- wait(P).
  473
  474% ?- elisp:message("hello").
  475message(M):-  smash(M, M0), lisp(message(M0)).
 prolog(F:phrase) is det
Apply F to the buffer region.
  479:- meta_predicate prolog(:, ?, ?).  480prolog(F) --> region, herbrand, phrase(F).
 line_exec is det
Get the current line, and exec it as a prolog query.
  485line_exec :- line_get(I),
  486	obj_get([line(Line)], I, _),
  487	herbrand(_, Line, G),
  488	!,
  489	catch(G, _, fail).
 smash(F:phrase, X, Y) is det
apply F to the current region, and smash it to Y.
  493smash(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.
  498herb(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.
  503solve(F) --> herbrand(_),
  504	phrase(F),
  505	herbrand_opp.
 line(F:phrase, X, Y)
Split the region into lines, and apply F to each of them.
  509line(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.
  514line(A, Ins) --> split,
  515	remove([]),
  516	maplist(phrase(A)),
  517	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.
  523paragraph(A) --> paragraph,
  524	remove([]),
  525	maplist(phrase(A)).
 lines(X:codes, Y:list) is det
Split the region into a list of lines, and unify Y with it.
  530lines --> 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.
  541line_edit(Ps):- obj_get([line_get(G), scan(S), do(D), line_put(P)], Ps),
  542	call(G, I),
  543	obj_get([line(L)], I),
  544	call(S, X, A, Y, L, _),
  545	% act(D, A, A0),
  546	phrase(D, A, A0),
  547	obj_put([left([X, A0]), right(Y)], I, I0),
  548	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.
  554for_ascii(Act) --> { line_edit([line_get(line_get_forward),
  555				scan(find_next_ascii_codes),
  556				do(Act),
  557				line_put(line_overwrite)
  558			       ])
  559		   }.
 open_at_point is det
Open the file whose name is at the cursor. [2013/09/08]
  564open_at_point:-  line_get(Obj),
  565	obj_get([line(File)], Obj),
  566	sh(open(File)).
 open_at_point(X, X) is det
Open the file whose name is at the cursor.
  570open_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.
  576line_at_point(X, I, P):- line_get(Obj),
  577	obj_get([point(Q), line(Line), begin(P)], Obj),
  578	string_codes(X, Line),
  579	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.
  584line_at_point(X, I):- line_at_point(X, I, _).
  585
  586		/******************************
  587		*     basic line operation    *
  588		******************************/
 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.
  594line_get([point(P), begin(B), end(E), line(R)]):-
  595	lisp(list('line-beginning-position'(),
  596			   'line-end-position'(),
  597			   point()),
  598			[B,E,P]),
  599	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.
  606line_get_forward([point(P), begin(P), end(E), line(R)]):-
  607	lisp(list(point(), 'line-end-position'()),  [P, E]),
  608	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.
  614line_get_backward([point(P), begin(B), end(P), line(R)]):-
  615	lisp(list(point(), 'line-beginning-position'()),
  616			   [P, B]),
  617	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.
  623line_overwrite(I):- obj_get([left(L), right(R)], I),
  624	line_overwrite(I, L, R).
 line_overwrite(+I:obj, L:text) is det
Replace the line with L.
  628line_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.
  633line_overwrite(I, L0, L1) :- line_kill(I),
  634	smash_buffer(L0),
  635	lisp(point(), P),
  636	smash_buffer(L1),
  637	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.
  642smash_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 [].
  647smash_buffer(X, []) :- smash_buffer(X).
 line_kill(+I:obj) is det
Kill the region I,
  652line_kill(I) :- obj_get([begin(B), end(E)],  I),
  653	lisp('kill_region'(B, E)),
  654	lisp('goto-char'(B)).
 line_kill(X, X) is det
Kill the current line.
  658line_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.
  662line_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.
  666line_wrap(L, R):- line_get(I),
  667	obj_get([line(Line)], I),
  668	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.
  673%?- sub_string("abc", X, Y, Z, U).
  674% [2014/03/16]
  675% ?-  elisp:prolog_symbol_at_point(X).
  676prolog_symbol_at_point(X):- line_at_point(Y, I),
  677	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,
  682prolog_symbol_at_point(J, Len, X):- line_get(Obj),
  683	obj_get([line(Line), begin(B), point(P)], Obj, _),
  684	string_codes(Y, Line),
  685	I is P - B,
  686	symbol_at_index(Y, I, J, K, X, prolog_symbol_continue_chk),
  687	Len is K - J.
 apply_symbol_at_point(+F:pred/2) is det
Convert and replace the current prolog symbol by applying F.
  691:- meta_predicate apply_symbol_at_point(2).  692apply_symbol_at_point(F):- prolog_symbol_at_point(J, Len, X),
  693	call(F, X, Y),
  694	number_string(J, J0),
  695	number_string(Len, Len0),
  696	with_output_to(string(Y0), writeq(Y)),
  697	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.
  701symbol_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.
  706symbol_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.
  713% ?- elisp:symbol_at_index("+abc-", 2, J, K, Y, prolog_symbol_continue_chk).
  714:- meta_predicate symbol_at_index(?,?,?,?,?,1).  715symbol_at_index(X, I, J, K, Y, F):- symbol_at_index(X, I, J, K, F),
  716	L is K - J,
  717	sub_string(X, J, L, _, Y).
  718
  719% ?- 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.
  725:- meta_predicate symbol_at_index(?,?,?,?,1).  726symbol_at_index(X, I, J, K, F):-
  727	symbol_string_before(X, I, J, F),
  728	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".
  732prolog_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.
  738:- meta_predicate symbol_string_after(?,?,?,1).  739symbol_string_after(S, I, K, F):-  succ(I, J),
  740	string_code(J, S, C),
  741	call(F, C),
  742	!,
  743	symbol_string_after(S, J, K, F).
  744symbol_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.
  750:- meta_predicate symbol_string_before(?,?,?,1).  751symbol_string_before(S, I, K, F):-
  752	string_code(I, S, C),
  753	call(F, C),
  754	!,
  755	succ(J, I),
  756	symbol_string_before(S, J, K, F).
  757symbol_string_before(_, I, I, _).
  758
  759		/***********************************************
  760		*	   lisp list vs. prolog list         *
  761		***********************************************/
 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.
  768% ?- elisp:term_to_lisp_text(X, "(ab)"), elisp:term_to_lisp_text(X, Y).
  769%@ X = [[ab]],
  770term_to_lisp_text(X, Y):- nonvar(Y), !,
  771	( string(Y)
  772	->	string_codes(Y, Y0)
  773	;	 Y0 = Y
  774	),
  775	parse_lisp_form(Y0, X).
  776term_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.
  782parse_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.
  789% ?- elisp:lisp_list(X, `()`, []).
  790% ?- elisp:lisp_list(X, `(a)`, []).
  791% ?- elisp:lisp_list(X, `a`, []).
  792% ?- elisp:lisp_list(X, `a b c`, []).
  793% ?- elisp:lisp_list(X, `"a" "b" "c"`, []).
  794% ?- elisp:lisp_list(X, `"a" "b" c`, []).
  795% ?- elisp:lisp_list(X, `(ab)`, []).
  796% ?- elisp:lisp_list(X, `(a b)`, []).
  797% ?- elisp:lisp_list(X, `(a(c)b"de")`, []).
  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)\\`, []).
  802
  803lisp_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.
  810lisp_list(X, Y) --> lisp_element(A),
  811	{X=[A|X0]},
  812	skip_lisp_filler,
  813	lisp_list(X0, Y).
  814lisp_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.
  821lisp_list_rest(X, X)     --> ")".
  822lisp_list_rest([A|X], Y) --> lisp_element(A),
  823	skip_lisp_filler,
  824	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.
  830lisp_element(A) --> "(",  !,  skip_lisp_filler,
  831	lisp_list_rest(A, []).
  832lisp_element(A) --> lisp_string(A0), !, { herbrand(A0, A) }.
  833lisp_element(A) --> non_string_atom(A0, []), { A0 \== [] }, !,
  834	{ 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.
  840skip_lisp_filler --> [A], { memberchk(A, `\s\t\r\n`) },
  841	skip_lisp_filler.
  842skip_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.
  847lisp_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.
  853% ?- elisp:lisp_string_rest(X, [], `abcd"`, Y).
  854lisp_string_rest([0'\"|X], X)	--> "\"".				% '
  855lisp_string_rest([0'\\, X|Y], Z) --> "\\", [X], !,		% '
  856	lisp_string_rest(Y, Z).
  857lisp_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.
  862non_string_atom([X|Y], Z) -->[X], {\+ memberchk(X, `()\"\s\t\r\n`)},
  863	non_string_atom(Y, Z).
  864non_string_atom(X, X) --> [].
 quit(X, X) is det
Send to quit the "(start-process)" process.
  868quit --> {lisp(print("PAC process has been quitted by user")),
  869	  lisp('stop-pac'())
  870	  }.
 edit_emacs_P(?X, ?Y) is det
  874%	Ask emacs an edit command in codes,
  875%	If the codes form a prolog phrase H,
  876%	run H on (X, Y).
  877%	Otherwise, split the codes by spaces into a list H of atoms,
  878%	find an handle that H matches its argument, and
  879%	finally run the body of the handle as a phrase on (X, Y).
  880
  881edit_emacs_P --> {ask_command(Codes),
  882		catch(	herbrand(_, Codes, H),
  883			_ ,
  884			split_codes_atoms(Codes, H)
  885		     )
  886	       },
  887		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).
  895run_command([X|Y]) --> !, ejockey:handle([X|Y]).
  896run_command(-(X)) --> !, ejockey:handle([X]).
  897run_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.
  903split_codes_atoms(X, Y):- split(` `, X, S),
  904	remove([], S, S0),
  905	maplist(atom_codes, Y, S0).
  906
  907%
  908skip_rest(X, X, []).
  909
  910% ?- elisp:leading_atoms(`   aab bbb ccc & ddd eee`, A).
  911% ?- elisp:leading_atoms([], X).
  912
  913leading_atoms(X, A):- tex:filler(X, Y),
  914					  once(leading_atoms(A, Y, [])).
  915
  916% ?- elisp:leading_atoms(X, [], R).
  917% ?- elisp:leading_atoms(X, ` aab bbb ccc & ddd eee`, R).
  918% ?- elisp:leading_atoms(X, `aab bbb ccc  ddd eee`, R).
  919% ?- elisp:handle_atom(X, `a`, R).
  920
  921leading_atoms(X) --> "&", skip_rest(X).
  922
  923leading_atoms([A|Y]) --> handle_atom(X), !,
  924		{ atom_codes(A, X) },
  925		tex:filler,
  926		leading_atoms(Y).
  927leading_atoms([]) --> at_end.
  928
  929at_end([], []).
  930
  931% ?- elisp:handle_atom(X, `abc def`, R).
  932handle_atom(X)  --> w("[a-z]", X, Y), wl("[a-zA-Z0-9]*", Y).
  933handle_atom(X)	--> w("[*/=?#.<>\\^\\-\\!]", X).
  934
  935% ?- elisp:make_splitter(`[ab]+`, S), call(S, `abcab`, R).
  936make_splitter(Codes, S) :- string_codes(Regex, Codes),
  937						   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).
  947edit_emacs_L(Ask, X, Y):-
  948	call(Ask, Codes),
  949	leading_atoms(Codes, Com),
  950	once(find_handle_call(Com, Codes, X, Y)).
  951
  952% ?- edit_emacs_L('ask-handle'(), Codes).
  953% ?- 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].
  962% ?- elisp:find_handle_call([f, c], `a`, Y), smash(Y).
  963
  964find_handle_call(Com, _Codes, X, Y):- is_list(Com),
  965	member(Module,   [ejockey,  ejockey2]),
  966	clause(Module:handle(H, X, Y), Body),
  967	match_args(Com, H),
  968	!,
  969	once(Module:Body).
  970%  [2020/05/14] The following does not work.
  971%	Module:call(Body), !.
  972%	Module:onde(Body), !.
  973find_handle_call(_, Codes, X, Y):-  % for other type of handles
  974	herbrand(_, Codes, C),
  975	callable(C),
  976	C =.. A,
  977	append(A, [X, Y], B),
  978	D =.. B,
  979	(	clause(snippets:D, Body)
  980	->	G = snippets:Body
  981	;	G = phrase(C, X, Y)
  982	),
  983	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].

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

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