prolog-elisp.pl

    1:- module(elisp, [region/2, region_term/2,
    2		  overwrite/2, overwrite/3, paragraph/2,
    3		  line_get/1, global_set_kbd/1, global_unset_kbd/1, dired_mark_swipl/0,
    4		  prolog_symbol_at_point/1,
    5		  book_bibitem/2, first_token_codes/2,
    6		  find_handle_call/4,
    7		  read_term_from_lisp/1,
    8		  read_mini_buffer/2,
    9  		  send_off/1,
   10		  call_lisp/2, call_lisp/1,
   11		  call_lisp_wait/1,
   12		  call_lisp_value/2,
   13		  call_lisp_string/2,
   14		  lisp/1, lisp/2, lisp_to_list/2,
   15		  noreply/1,
   16		  get_string/2, set_string/2,
   17		  message/1,
   18		  insert_buffer/1,
   19		  insert/1,
   20		  set_mark_region/2,
   21		  neighbor_string/3, neighbor_string/5,
   22		  wait/1, wait/2,
   23		  read_codes/1, read_codes/2,
   24		  meta_handle/4, normal_keys/3
   25		  ]).   26
   27:- use_module(pac(basic)).   28:- use_module(util(file)).   29:- use_module(pac(reduce)).   30:- use_module(util(polynomial)).   31:- use_module(util(tex)).   32:- use_module(util(obj)).   33:- use_module(util(misc)).   34
   35% :- use_module(util('convert-dcg')).
   36% :- use_module(util('sed(dcg_ts')).
   37
   38term_expansion --> pac:expand_pac.
   39:- use_module(pac('expand-pac')).   40:- use_module(pac(op)).   41% :- use_module(util(xml)).
   42
   43% memo:  be careful to use sed/3   (module prefix needed) [2014/05/23]
   44%  Prolog-Emacs Interface
   45%  get buffer region
   46% :- use_module(pac('emacs-jockey')).
   47
   48% ?- qcompile(util('prolog-elisp')), module(elisp).
   49:- nb_setval(command_history, [for_ascii(elisp:wrap($))]).   50:- nb_setval(edit_command, (=)).   51% :- use_module(library(edit)).
   52
   53% help//2 is det.
   54%	list all command names.
   55help --> {shortcut_key(L)},
   56	 peek(L),
   57	 insert('\n'),
   58	 smash.
   59
   60:- meta_predicate line(2,?,?).   61:- 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.

   65tex_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.

   69tex_symbol_to_cs --> sed(dcg_st). % st.
   70
   71
   72		/************************************
   73		*     command history management    *
   74		************************************/

parse_commands(+X:codes, -Y:list) is det: Parse lines as a list of Prolog queries.

   79parse_commands --> split,
   80	remove([]),
   81	maplist(herbrand).

parse_merge_history(?X, -Y) is det: Merge command history.

   86parse_merge_history --> region,
   87	parse_commands,
   88	merge_history,
   89	clear.

merge_history(+Cs:list) is det: Merge commands into the command history.

   93merge_history(Cs):- nb_getval(command_history, L),
   94	union(Cs, L, L0),
   95	nb_setval(command_history, L0).

merge_history(+X:list, -Y:list) is det: Merge commands in X into the command history. Y = X.

  102merge_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.

  108merge_history(F) --> region,
  109	split,
  110	remove([]),
  111	maplist(phrase(F)),
  112	merge_history.

show_history(-H:list) is det: Unify H with the current history command.

  117show_history(H) :- nb_getval(command_history, L),
  118	insert('\n', L, L0),
  119	smashq(L0, H).

show_history(?_, -H:list) is det: Unify H with the current history command.

  124show_history(_, H) :- show_history(H).

reset_history is det: Reset the command history.

  128reset_history :- nb_setval(command_history, []).

reset_history(?_, ?_) is det: Reset the command history.

  132reset_history --> {reset_history}.

set_history(?_, ?_) is det: Reset the command history, parse the region as commands, and set the command history to it.

  137set_history --> reset_history, parse_merge_history.

show_command(-X:text) is det: Unify X with the edit command.

  141show_command(X) :- nb_getval(edit_command, C),
  142	smashq(C, X).

show_command(_, -X:text) is det: Unify X with the current command.

  146show_command(_, X):- show_command(X).

apply_command(X:term, Y:term) is det: Unify X with the current comand history.

  150apply_command --> { nb_getval(edit_command, C) },
  151	phrase(C).
  152
  153%
  154empty_history :- nb_getval(edit_command, []).
  155
  156%
  157pop_history(X) :-  nb_getval(edit_command, [X|R]),
  158		nb_getval(edit_command, R).
  159
  160%
  161push_history(X) :-  nb_getval(edit_command, C),
  162		    nb_setval(edit_command, [X|C]).
  163
  164%
  165save_line_number :- lisp('count-lines'(1, point()), I),
  166		     nb_setval(line_count, I).
  167
  168
  169% ?- apropos(compound_non_zero_arity).
  170% ?- compound_name_arguments(f(),  N, A).
  171%@ N = f,
  172%@ A = [].
  173% ?- compound_name_arguments(f,  N, A).
  174
  175table_index(I) :-  lisp('count-lines'(1, point()), J),
  176		   nb_getval(line_count, K),
  177		   I is J-K.

comma_left(+A, +B, -C) is det: Unify C with a comma term (A, B).

  181comma_left(A, B, (A, B)).

comma_right(+A, +B, -C) is det: Unify C with a comma term (B, A).

  185comma_right(A, B, (B, A)).
  186
  187		/*******************************
  188		*     region object manager    *
  189		*******************************/
  190
  191% [2011/06/09]
  192%  Save a phrase / a phrase with environment at  the region
  193%  to use it later.

initial_region_obj is det: Initialize state_obj.

  197initial_region_obj :- nb_setval(state_obj, []).

region_obj(C:command) is det: Update a state stored in state_obj by C.

  201region_obj(X):- nb_getval(state_obj, S),
  202	obj(X, S, S0),
  203	nb_setval(state_obj, S0).

get_phrase(?_, ?_) is det: Compile the goal at the buffer region, and save its handle to the state_obj.

  208get_phrase --> region,
  209	herbrand(_),
  210	call(pred([F, F0] :- let(F0, F))),
  211	current(G),
  212	{	region_obj( put( [command(G)] ) )  },
  213	clear.

apply_phrase(+X:term, -Y:term) is det: Apply the saved phrase to X to obtain Y, and overwrite the region with Y.

  218apply_phrase --> region,
  219	{  region_obj( get( [command(G)] ) ) },
  220	phrase(G),
  221	overwrite.

bind_phrase(+X:term, -Y:term) is det: Apply the saved bind_context command to X to unify Y with the result.

  226bind_phrase --> region,
  227	{	region_obj( get( [command(G)] ) )	},
  228		current(X),
  229	{	bind_context(G, (X, []), (X0, _))	},
  230		peek(X0).
  231
  232		/****************
  233		*     region    *
  234		****************/

region(?A, -X) is det: Unify Unify X with the content of the buffer region when A == [], otherwise, with A.

  240region([], X) :- !, get_region(X).	% [2014/10/12], [2020/01/11]
  241region(A, A).

get_region(-R:codes) is det: Get the content of the buffer region, and Unify R with it.

  246get_region(R) :-  lisp('send-region'()),
  247	read_codes(R).

get_region(?_, -R:codes) is det: Unify R with the content of the buffer region.

  251get_region  --> {get_region(R)}, peek(R).

get_region(-X:codes, _, -X:codes) is det: Unify X with the content of the buffer region.

  255get_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.

  259region_term(X, Y) :- region(X, X0),
  260					 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).

  264get_buffer_region(X, Y) --> {get_buffer_region(X, Y, R)},
  265	peek(R).

get_buffer_region(+X:int, Y:int, R:codes) is det: Unify R with the content of the region boundary (X, Y).

  269get_buffer_region(X, Y, R) :-
  270	lisp('send-region'(X, Y)),
  271	read_codes(R).

region_bound(?_, X) is det: Unify X with the boundary information of the region.

  275region_bound(_, X) :- region_bound(X).

region_bound(X) is det: Shorthand for region_bound(_, X).

  279region_bound(X) :- call_lisp_string('region-bound'(), X0),
  280	parse_lisp_form(X0, [X]).

overwrite(+X:codes, ?_) is det: Kill the region, and insert X to the buffer.

  285overwrite --> { kill_region },	smash_buffer.
  286
  287%
  288overwrite([]) --> !, overwrite.
  289overwrite(_) --> [].

kill_region is det: Kill the region.

  293kill_region:-  call_lisp_wait('kill-region'(mark(), point())).

kill_region(B:burrer_name) is det: Kill the region of the buffer Buf.

  297kill_region(Buf):-  smash(Buf, QBuf),
  298	call_lisp_wait(progn(	'set-buffer'(QBuf),
  299			'kill-region'(mark(), point()))).

insert_buffer(+X:term) is det: Insert X into the current buffer.

  304insert_buffer([]):- !.
  305insert_buffer(X):- smash(["$TEXT$ ", X, "\000\\n"]),
  306	flush_output.
  307%
  308insert(X):- smash(X, Y), wait(insert(Y)).

send_exp(L:script) is det

  311send_exp(L):- lisp(L).

find_file(F:file) is det: Send find_file command for F0 to emacs-lisp process.

  315find_file(F) :- expand_file_search_path(F, F0),
  316	lisp('find-file'(F0)).

find_pred(X:pred, Y, Y) is det: Locate the predicate defiition of X.

  320find_pred(X)--> {find_pred(X)}.

find_pred(+I) is det: Locate the predicate indicator I = P/N.

  324find_pred(P/N):- functor(G, P, N),
  325	source_file(G, F),
  326	find_file(F).
  327find_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).

  331eval_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).

  335eval_lisp_to_atom(F, X, Y, A):-
  336	lisp_atom(["(", F, " ", X, " ", Y, ")"], A).
  337
  338% ?- 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.

  342atom_lisp_string(A, S):- atom_codes(A, C),
  343	quote(C, S).

read_file_name(+P:string, -F:string) is det: Read a file name with prompt P, and unify F with it.

  347read_file_name(P, F):- atom_lisp_string(P, P0),
  348	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.

  352read_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.

  357completing_read(Prompt, Atoms, R):-
  358	atom_lisp_string(Prompt, P0),
  359	maplist(atom_lisp_string, Atoms, As),
  360	call_lisp_value('completing-read'(P0, #(As)), R).
  361
  362
  363% ?- elisp:read_codes_from_minibuffer("Hi :", R).
  364read_codes_from_minibuffer(Prompt,  Codes):-
  365	call_lisp_value('read-from-minibuffer'(Prompt), Codes).
  366
  367% ?- elisp:read_term_from_minibuffer("Hi :", Term).
  368read_string_from_minibuffer(Prompt,  String):-
  369	read_codes_from_minibuffer(Prompt,  Codes),
  370	string_codes(String, Codes).
  371
  372% ?- elisp:read_term_from_minibuffer("Hi :", Term, [variable_names(V)]).
  373read_term_from_minibuffer(Prompt,  Term, Options):-
  374	read_string_from_minibuffer(Prompt,  String),
  375	term_string(Term, String, Options).
  376
  377% ?- elisp:read_term_from_minibuffer("Hi :", Term).
  378read_term_from_minibuffer(Prompt,  Term):-
  379	read_term_from_minibuffer(Prompt, Term, []).

search_pred(P:pred) is det: Search predicate P.

  383search_pred(Pred):- search_swipl(["^", Pred]).

search_swipl(X:text) is det: Search X in dired mode.

  387search_swipl(X):- smash(X, C),
  388	dired_mark_swipl,
  389	lisp('dired-do-search'(C)).

dired_mark_swipl is det: Mark Prolog files in the pacpl7 directory in dired mode.

  394dired_mark_swipl :- getenv(home, Home),
  395    string_concat(Home,"/local/lib/pacpl7", PAC_dir),
  396	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.

  403dired_mark_regex(Dir, Regex) :-
  404	lisp([progn, 'find-file'(Dir),
  405		     'dired-mark-files-regexp'(Regex)]).
  406%	True if J, Len, and X are unified so that X is a symbol of length Len,
  407%	of the category "prolog_symbol_continue", and  at J of the current line,
  408list_at_point(X):- line_get(Obj),
  409	obj_get([line(Line), begin(B), point(P)], Obj, _),
  410	string_codes(Y, Line),
  411	I is P - B,
  412	scan_string_at_point(Y, 0'[, 0'], I, S),
  413	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.

  421% ?- elisp:neighbor_string("abd", "a", "d", 1, S).
  422% ?- elisp:neighbor_string("abd", "a", "bd", 1, S).
  423
  424neighbor_string(X, Open, Close, I, S):- neighbor_string(X, Open, Close, I, J, K),
  425				   N is K - J,
  426				   N >= 0,
  427				   sub_string(X, J,  N, _, S).
  428
  429% ?- elisp:neighbor_string("abcd", "a", "d", 2, J, K).
  430% ?- elisp:neighbor_string("abd", "a", "d", 2, J, K).
  431%
  432neighbor_string(X, Open, Close, I, J, K):- string_length(X, LX),
  433	string_length(Open, LO),
  434	string_length(Close, LC),
  435	I0 is I - LO,
  436	I0 >= 0,
  437	neighbor_string_left(X, Open, LO, I0, J),
  438	neighbor_string_right(X, Close, LC, I, K0, LX),
  439	K is K0 + LC.
  440
  441%
  442neighbor_string_left(X, S, N, I, I) :- sub_string(X, I, N, _, S), !.
  443neighbor_string_left(X, S, N, I, K) :- I> 0,
  444				  I0 is I-1,
  445				  neighbor_string_left(X, S, N, I0, K).
  446
  447neighbor_string_right(X, S, N, I, I, _):-  sub_string(X, I, N, _, S), !.
  448neighbor_string_right(X, S, N, I, K, L):- I  < L,
  449				     I0 is I + 1,
  450				     neighbor_string_right(X, S, N, I0, K, L).
  451
  452%
  453neighbor_string(B, E, X) :- line_at_point(L, I),
  454			  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.

  461		/*****************************
  462		*     Control Emacs-buffer   *
  463		*****************************/

stream_start is det: Send 'start prolog process' to emacs.

  467stream_start :- wait('stream-start'()).

wait(P:list_command, P) is det: Send a lisp Command P, and wait a response.

  471wait(P, P) :- wait(P).
  472
  473% ?- elisp:message("hello").
  474message(M):-  smash(M, M0), lisp(message(M0)).

prolog(F:phrase) is det: Apply F to the buffer region.

  478:- meta_predicate prolog(:, ?, ?).  479prolog(F) --> region, herbrand, phrase(F).

line_exec is det: Get the current line, and exec it as a prolog query.

  484line_exec :- line_get(I),
  485	obj_get([line(Line)], I, _),
  486	herbrand(_, Line, G),
  487	!,
  488	catch(G, _, fail).

smash(F:phrase, X, Y) is det: apply F to the current region, and smash it to Y.

  492smash(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.

  497herb(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.

  502solve(F) --> herbrand(_),
  503	phrase(F),
  504	herbrand_opp.

line(F:phrase, X, Y): Split the region into lines, and apply F to each of them.

  508line(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.

  513line(A, Ins) --> split,
  514	remove([]),
  515	maplist(phrase(A)),
  516	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.

  522paragraph(A) --> paragraph,
  523	remove([]),
  524	maplist(phrase(A)).

lines(X:codes, Y:list) is det: Split the region into a list of lines, and unify Y with it.

  529lines --> 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.

  540line_edit(Ps):- obj_get([line_get(G), scan(S), do(D), line_put(P)], Ps),
  541	call(G, I),
  542	obj_get([line(L)], I),
  543	call(S, X, A, Y, L, _),
  544	% act(D, A, A0),
  545	phrase(D, A, A0),
  546	obj_put([left([X, A0]), right(Y)], I, I0),
  547	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.

  553for_ascii(Act) --> { line_edit([line_get(line_get_forward),
  554				scan(find_next_ascii_codes),
  555				do(Act),
  556				line_put(line_overwrite)
  557			       ])
  558		   }.

open_at_point is det: Open the file whose name is at the cursor. [2013/09/08]

  563open_at_point:-  line_get(Obj),
  564	obj_get([line(File)], Obj),
  565	sh(open(File)).

open_at_point(X, X) is det: Open the file whose name is at the cursor.

  569open_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.

  575line_at_point(X, I, P):- line_get(Obj),
  576	obj_get([point(Q), line(Line), begin(P)], Obj),
  577	string_codes(X, Line),
  578	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.

  583line_at_point(X, I):- line_at_point(X, I, _).
  584
  585		/******************************
  586		*     basic line operation    *
  587		******************************/

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.

  593line_get([point(P), begin(B), end(E), line(R)]):-
  594	lisp(list('line-beginning-position'(),
  595			   'line-end-position'(),
  596			   point()),
  597			[B,E,P]),
  598	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.

  605line_get_forward([point(P), begin(P), end(E), line(R)]):-
  606	lisp(list(point(), 'line-end-position'()),  [P, E]),
  607	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.

  613line_get_backward([point(P), begin(B), end(P), line(R)]):-
  614	lisp(list(point(), 'line-beginning-position'()),
  615			   [P, B]),
  616	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.

  622line_overwrite(I):- obj_get([left(L), right(R)], I),
  623	line_overwrite(I, L, R).

line_overwrite(+I:obj, L:text) is det: Replace the line with L.

  627line_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.

  632line_overwrite(I, L0, L1) :- line_kill(I),
  633	smash_buffer(L0),
  634	lisp(point(), P),
  635	smash_buffer(L1),
  636	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.

  641smash_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 [].

  646smash_buffer(X, []) :- smash_buffer(X).

line_kill(+I:obj) is det: Kill the region I,

  651line_kill(I) :- obj_get([begin(B), end(E)],  I),
  652	lisp('kill_region'(B, E)),
  653	lisp('goto-char'(B)).

line_kill(X, X) is det: Kill the current line.

  657line_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.

  661line_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.

  665line_wrap(L, R):- line_get(I),
  666	obj_get([line(Line)], I),
  667	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.

  672%?- sub_string("abc", X, Y, Z, U).
  673% [2014/03/16]
  674% ?-  elisp:prolog_symbol_at_point(X).
  675prolog_symbol_at_point(X):- line_at_point(Y, I),
  676	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,

  681prolog_symbol_at_point(J, Len, X):- line_get(Obj),
  682	obj_get([line(Line), begin(B), point(P)], Obj, _),
  683	string_codes(Y, Line),
  684	I is P - B,
  685	symbol_at_index(Y, I, J, K, X, prolog_symbol_continue_chk),
  686	Len is K - J.

apply_symbol_at_point(+F:pred/2) is det: Convert and replace the current prolog symbol by applying F.

  690:- meta_predicate apply_symbol_at_point(2).  691apply_symbol_at_point(F):- prolog_symbol_at_point(J, Len, X),
  692	call(F, X, Y),
  693	number_string(J, J0),
  694	number_string(Len, Len0),
  695	with_output_to(string(Y0), writeq(Y)),
  696	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.

  700symbol_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.

  705symbol_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.

  712% ?- elisp:symbol_at_index("+abc-", 2, J, K, Y, prolog_symbol_continue_chk).
  713:- meta_predicate symbol_at_index(?,?,?,?,?,1).  714symbol_at_index(X, I, J, K, Y, F):- symbol_at_index(X, I, J, K, F),
  715	L is K - J,
  716	sub_string(X, J, L, _, Y).
  717
  718% ?- 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.

  724:- meta_predicate symbol_at_index(?,?,?,?,1).  725symbol_at_index(X, I, J, K, F):-
  726	symbol_string_before(X, I, J, F),
  727	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".

  731prolog_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.

  737:- meta_predicate symbol_string_after(?,?,?,1).  738symbol_string_after(S, I, K, F):-  succ(I, J),
  739	string_code(J, S, C),
  740	call(F, C),
  741	!,
  742	symbol_string_after(S, J, K, F).
  743symbol_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.

  749:- meta_predicate symbol_string_before(?,?,?,1).  750symbol_string_before(S, I, K, F):-
  751	string_code(I, S, C),
  752	call(F, C),
  753	!,
  754	succ(J, I),
  755	symbol_string_before(S, J, K, F).
  756symbol_string_before(_, I, I, _).
  757
  758		/***********************************************
  759		*	   lisp list vs. prolog list         *
  760		***********************************************/

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.

  767% ?- elisp:term_to_lisp_text(X, "(ab)"), elisp:term_to_lisp_text(X, Y).
  768%@ X = [[ab]],
  769term_to_lisp_text(X, Y):- nonvar(Y), !,
  770	( string(Y)
  771	->	string_codes(Y, Y0)
  772	;	 Y0 = Y
  773	),
  774	parse_lisp_form(Y0, X).
  775term_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.

  781parse_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.

  788% ?- elisp:lisp_list(X, `()`, []).
  789% ?- elisp:lisp_list(X, `(a)`, []).
  790% ?- elisp:lisp_list(X, `a`, []).
  791% ?- elisp:lisp_list(X, `a b c`, []).
  792% ?- elisp:lisp_list(X, `"a" "b" "c"`, []).
  793% ?- elisp:lisp_list(X, `"a" "b" c`, []).
  794% ?- elisp:lisp_list(X, `(ab)`, []).
  795% ?- elisp:lisp_list(X, `(a b)`, []).
  796% ?- elisp:lisp_list(X, `(a(c)b"de")`, []).
  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)\\`, []).
  801
  802lisp_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.

  809lisp_list(X, Y) --> lisp_element(A),
  810	{X=[A|X0]},
  811	skip_lisp_filler,
  812	lisp_list(X0, Y).
  813lisp_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.

  820lisp_list_rest(X, X)     --> ")".
  821lisp_list_rest([A|X], Y) --> lisp_element(A),
  822	skip_lisp_filler,
  823	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.

  829lisp_element(A) --> "(",  !,  skip_lisp_filler,
  830	lisp_list_rest(A, []).
  831lisp_element(A) --> lisp_string(A0), !, { herbrand(A0, A) }.
  832lisp_element(A) --> non_string_atom(A0, []), { A0 \== [] }, !,
  833	{ 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.

  839skip_lisp_filler --> [A], { memberchk(A, `\s\t\r\n`) },
  840	skip_lisp_filler.
  841skip_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.

  846lisp_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.

  852% ?- elisp:lisp_string_rest(X, [], `abcd"`, Y).
  853lisp_string_rest([0'\"|X], X)	--> "\"".				% '
  854lisp_string_rest([0'\\, X|Y], Z) --> "\\", [X], !,		% '
  855	lisp_string_rest(Y, Z).
  856lisp_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.

  861non_string_atom([X|Y], Z) -->[X], {\+ memberchk(X, `()\"\s\t\r\n`)},
  862	non_string_atom(Y, Z).
  863non_string_atom(X, X) --> [].

quit(X, X) is det: Send to quit the "(start-process)" process.

  867quit --> {lisp(print("PAC process has been quitted by user")),
  868	  lisp('stop-pac'())
  869	  }.

edit_emacs_P(?X, ?Y) is det

  873%	Ask emacs an edit command in codes,
  874%	If the codes form a prolog phrase H,
  875%	run H on (X, Y).
  876%	Otherwise, split the codes by spaces into a list H of atoms,
  877%	find an handle that H matches its argument, and
  878%	finally run the body of the handle as a phrase on (X, Y).
  879
  880edit_emacs_P --> {ask_command(Codes),
  881		catch(	herbrand(_, Codes, H),
  882			_ ,
  883			split_codes_atoms(Codes, H)
  884		     )
  885	       },
  886		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).

  894run_command([X|Y]) --> !, ejockey:handle([X|Y]).
  895run_command(-(X)) --> !, ejockey:handle([X]).
  896run_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.

  902split_codes_atoms(X, Y):- split(` `, X, S),
  903	remove([], S, S0),
  904	maplist(atom_codes, Y, S0).
  905
  906%
  907skip_rest(X, X, []).
  908
  909% ?- elisp:leading_atoms(`   aab bbb ccc & ddd eee`, A).
  910% ?- elisp:leading_atoms([], X).
  911
  912leading_atoms(X, A):- tex:filler(X, Y),
  913					  once(leading_atoms(A, Y, [])).
  914
  915% ?- elisp:leading_atoms(X, [], R).
  916% ?- elisp:leading_atoms(X, ` aab bbb ccc & ddd eee`, R).
  917% ?- elisp:leading_atoms(X, `aab bbb ccc  ddd eee`, R).
  918% ?- elisp:handle_atom(X, `a`, R).
  919
  920leading_atoms(X) --> "&", skip_rest(X).
  921
  922leading_atoms([A|Y]) --> handle_atom(X), !,
  923		{ atom_codes(A, X) },
  924		tex:filler,
  925		leading_atoms(Y).
  926leading_atoms([]) --> at_end.
  927
  928at_end([], []).
  929
  930% ?- elisp:handle_atom(X, `abc def`, R).
  931handle_atom(X)  --> w("[a-z]", X, Y), wl("[a-zA-Z0-9]*", Y).
  932handle_atom(X)	--> w("[*/=?#.<>\\^\\-\\!]", X).
  933
  934% ?- elisp:make_splitter(`[ab]+`, S), call(S, `abcab`, R).
  935make_splitter(Codes, S) :- string_codes(Regex, Codes),
  936						   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).

  946edit_emacs_L(Ask, X, Y):-
  947	call(Ask, Codes),
  948	leading_atoms(Codes, Com),
  949	once(find_handle_call(Com, Codes, X, Y)).
  950
  951% ?- edit_emacs_L('ask-handle'(), Codes).
  952% ?- 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].

  961% ?- elisp:find_handle_call([f, c], `a`, Y), smash(Y).
  962
  963find_handle_call(Com, _Codes, X, Y):- is_list(Com),
  964	member(Module,   [ejockey,  ejockey2]),
  965	clause(Module:handle(H, X, Y), Body),
  966	match_args(Com, H),
  967	!,
  968	once(Module:Body).
  969%  [2020/05/14] The following does not work.
  970%	Module:call(Body), !.
  971%	Module:onde(Body), !.
  972find_handle_call(_, Codes, X, Y):-  % for other type of handles
  973	herbrand(_, Codes, C),
  974	callable(C),
  975	C =.. A,
  976	append(A, [X, Y], B),
  977	D =.. B,
  978	(	clause(snippets:D, Body)
  979	->	G = snippets:Body
  980	;	G = phrase(C, X, Y)
  981	),
  982	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].

  996% ?- elisp:match_args([f, c], [frame, center]).
  997% ?- elisp:match_args([sol, go, reg], [solve, goal|X]).
  998% ?- elisp:match_args([mv, (.)], [mv, (.)]).
  999% ?- elisp:match_args([f, 'c/d'], [frame, File]).
 1000% ?- elisp:match_args([f, b], [frame, File]).
 1001% ?- elisp:match_args([f, b], [frame|File]).
 1002
 1003match_args([], []):-!.
 1004match_args([A|B], [C|D]):- match_arg_one(A, C), !,
 1005						   match_args(B, D).
 1006%
 1007match_arg_one(A, B) :- var(B), A = B.
 1008match_arg_one(A, B) :- atom(B), sub_atom(B, 0, _, _, A).
 1009match_arg_one(A, B) :- number(B), number_atom(B, A).
 1010match_arg_one(A, B) :- string(B), atom_string(A, B).
 1011
 1012%
 1013normal_keys([], _, []).
 1014normal_keys([X|Xs], Ys, [Y|Zs]):- select(Y, Ys, Y0s),
 1015	match_arg_one(X, Y),
 1016	!,
 1017	normal_keys(Xs, Y0s, Zs).
 1018
 1019% ?- elisp:apropos_chk([a,b,c], axy).
 1020apropos_chk([Y|_], X):- match_arg_one(Y, X), !.
 1021apropos_chk([_|Ys], X):- apropos_chk(Ys, X).

ask_handle(-C:codes) is det: Ask emacs for a handle codes, and unify C with it.

 1025ask_handle(Codes) :- call_lisp_value('ask-handle'(), Codes).
 1026
 1027% [2020/05/14]
 1028% request from emacs as (prolog-query G).
 1029%	shortcut "s-l" (Command + L )
 1030user:prolog_call(G, _, [G, " done.\n"]):- once(G).
 1031
 1032% ?- elisp:call_lisp_value(list("1","2","3"),  R), elisp:lisp_to_list(R, List).
 1033% ?- elisp:call_lisp_value(+(1,2,3),  R).
 1034% ?- elisp:call_lisp_value(list(1,2),  R). % NOT work.
 1035% ?- elisp:lisp_to_list(list(1,2),  R).  % OK.
 1036% ?- 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.

 1040ask_command(Codes) :- call_lisp_value('ask-command'(), Codes).
 1041
 1042%
 1043qval(E, V):- call_lisp(E, string(S)), basic:smash(S, V).
 1044%
 1045elisp(E, V):- call_lisp(E, term(W)), string_codes(V, W).
 1046
 1047% ?- elisp:qval(cons(1, 2),V).
 1048% ?- elisp:qval(cons(1, []),V).
 1049% ?- elisp:qval(setq(w, 2),V).
 1050% ?- elisp:qval(w, V).
 1051% ?- elisp:qval(append(list(1,2,3), list(4, 5, 6)), V).
 1052% ?- elisp:qval(setq(uu, #(hello)), V).
 1053% ?- elisp:qval(setq(uu, "hello"), V).
 1054% ?- elisp:qval(setq(uu, +(1,2,3)), 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(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

 1063lisp_to_list(M, L):- call_lisp(M, string(V)),
 1064	term_to_lisp_text(L, V).
 1065
 1066% ?- elisp:lisp(+(1, 2, 3), Y).
 1067% ?- elisp:lisp(sort(list(4, 8, 21, 17, 33,  7,  21, 7), #(>)), V).
 1068% ?- elisp:lisp(sort(list(4, 8, 21, 17, 33,  7,  21, 7), #(<)), V).
 1069lisp(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.

 1075lisp_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."

 1080no_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.

 1086unquote(X, Y):- append([[0'\"], Y0, [0'\"]], X), !,
 1087	unbackquote(Y0, Y).
 1088unquote(X, X).

unbackquote(+X:codes, -Y:codes) is det: Remove backquote codes used for escape character from X, and unify Y with the remainder.

 1094unbackquote([], []).
 1095unbackquote([0'\\, 0'\\|X], [0'\\|Y]):-	!, unbackquote(X, Y). %'
 1096unbackquote([0'\\, C|X], [0'\\, C|Y]):-	!, unbackquote(X, Y).
 1097unbackquote([C|X], [C|Y]):- unbackquote(X, Y).

list(?X:list) is nondet: Unify X with most general lists in the 'shortest one first' order.

 1103list([]).
 1104list([_|L]) :- list(L).

escapeoff(+X:codes, -Y:codes) is det: Remove all escape character code from X, and unify Y with the remainder.

 1110escapeoff --> eh:sed(elisp:escapeoff), flatten.
 1111
 1112escapeoff([X])--> "\\",[X].
 1113
 1114		/********************
 1115		*     read_codes    *
 1116		********************/
 1117% ?- read_codes(X, `yz`).
 1118% |:abcyz
 1119read_codes(X, End):- get_code(C), C \== (-1), !,
 1120	read_codes(C, End, End, [], X, []).
 1121read_codes(_, _):- throw(unexpected_end_of_file(read_codes)).
 1122%
 1123read_codes(X):- read_codes(X, `\000\\n`).
 1124%
 1125read_codes(C, [C|R], End, Q, X, Y):- !, read_codes(R, End, [C|Q], X, Y).
 1126read_codes(C, _, End, [], [C|X], Y):- !, read_codes(End, End, [], X, Y).
 1127read_codes(C, _, End, Q, X, Y):- reverse(Q, Z, X),
 1128	read_codes(C, End, End, [], Z, Y).
 1129
 1130% [2016/07/11]
 1131% Knowing end-of-message by use of read_pending_codes/3.
 1132% ?- elisp:lisp("\000\\n\n", R).
 1133
 1134read_codes([], End, Q, X, Y):- !,
 1135	read_pending_codes(user_input, P, []),
 1136	( P==[] -> X = Y
 1137	;	reverse(Q, Z, X),
 1138		read_codes_suspended(P, End, Z, Y)
 1139	).
 1140read_codes(R, End, Q, X, Y):- get_code(C),
 1141	read_codes(C, R, End, Q, X, Y).
 1142%
 1143read_codes_suspended(S, End, X, Y):-
 1144	( append(A, End, S) -> append(A, Y, X)
 1145	 ; append(S, Z, X),
 1146	   read_pending_codes(user_input, P, []),
 1147	   read_codes_suspended(P, End, Z, Y)
 1148	).
 1149
 1150reverse([A|B], X, Y):- reverse(B, [A|X], Y).
 1151reverse([], X, X).
 1152
 1153		/***************************************************
 1154		*           call_lisp/read_mini_buffer             *
 1155		***************************************************/

read_term_from_lisp(-X:term) is det: Read a term converted from emacs-lisp text with nullstop.

 1160read_term_from_lisp(X) :-
 1161	read_codes(Codes),
 1162	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.

 1171% ?- elisp:call_lisp([], string(V)).
 1172call_lisp(X, Option):-
 1173	(	noreply = Option
 1174	->	term_to_lisp_string(X, X0),	% just send without waiting.
 1175		send_off(X0)
 1176	;	wait = Option
 1177	-> 	P = progn(X, 'send-done'()),
 1178		term_to_lisp_string(P, X0),
 1179		send_off(X0),
 1180		read_codes(_)
 1181	;	term(V) = Option  -> % was value(V)
 1182		term_to_lisp_string(respond(X, nil), X0),
 1183		send_off(X0),
 1184		read_codes(V)
 1185	;	string(V) = Option ->
 1186		term_to_lisp_string(respond(X, t),  X0),
 1187		send_off(X0),
 1188		read_codes(V)
 1189	;	throw(call_lisp(X, Option))
 1190	).
 1191%
 1192send_off(X):- smash(["$SCRIPT$ ", X, "\000\\n"]),
 1193			 flush_output.

call_lisp(+X:term) is det: Shorthand for call_lisp(X, wait).

 1197call_lisp(X):- call_lisp(X, wait).

lisp(X) is det: Shorthand for call_lisp(X, noreply).

 1201lisp(X)		:- call_lisp(X, noreply).
 1202%
 1203noreply(X)	:- call_lisp(X, noreply).

wait(X) is det: Shorthand for call_lisp_wait(X).

 1207wait(X)		:- call_lisp_wait(X).

call_lisp_wait(X) is det: Shorthand for call_lisp(X, wait).

 1211call_lisp_wait(X) :- call_lisp(X, wait).

call_lisp_value(X, Y) is det: Shorthand for call_lisp(X, term(Y)).

 1215call_lisp_value(X, Y) :- call_lisp(X, term(Y)).

call_lisp_string(X, Y) is det: Shorthand for call_lisp(X, string(Y)]).

 1220call_lisp_string(X, Y) :- call_lisp(X, string(Y)).
 1221
 1222% ?- elisp:lisp(sort(list(4, 8, 21, 17, 33,  7,  21, 7), #(>)), V).
 1223% ?- elisp:lisp(+(1, 2, 3), Y).
 1224% ?- elisp:lisp(setq(uuu, +(1,2,3)), V).
 1225% ?- elisp:lisp(progn(setq(uuu, +(1,2,3)), *(uuu, uuu)), V).
 1226% ?- 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.

 1231% ?- elisp:term_to_lisp_string(f(), X).
 1232%@ X = "(f )" .
 1233% ?- elisp:term_to_lisp_string(list(1,2,3), X).
 1234%@ X = "(list 1 2 3 )" .
 1235% ?- elisp:term_to_lisp_string(prog(a, b, c), X).
 1236%@ X = "(prog a b c )" .
 1237% ?- elisp:term_to_lisp_string(cond([a,b],[b,c]),  X).
 1238%@ X = "(cond (a b )(b c ))" .
 1239% ?- elisp:term_to_lisp_string(defun(f, [a,b], +(a, b)),  X).
 1240%@ X = "(defun f (a b )(+ a b ))" .
 1241
 1242
 1243term_to_lisp_string(X, Y):- term_to_tokens(X, Y0, []),
 1244	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.

 1251% ?- elisp:term_to_tokens(f(a), R, []).
 1252% ?- elisp:term_to_tokens(#(a), R, []).
 1253% ?- elisp:term_to_tokens([f(a)], R, []).
 1254% ?- elisp:term_to_tokens(f([a]), R, []).
 1255% ?- elisp:term_to_tokens(f(123), R, []).
 1256% ?- elisp:term_to_tokens(list(1,2,3), R, []).
 1257% ?- elisp:term_to_tokens(#(#(1)), R, []).
 1258% ?- elisp:term_to_tokens(#(list([1,2,3])), R, []).
 1259% ?- elisp:term_to_tokens([a,b], R, []).
 1260% ?- elisp:term_to_tokens([[a,b], [c,d]], R, []), tokens_to_string(R, R0).
 1261
 1262% # is reserved for quote.
 1263term_to_tokens(X, ['('|Y], Z):- is_list(X), !,
 1264		  term_to_tokens_with_closing(X, Y, Z).
 1265term_to_tokens(X, [X0|Y], Y):- atom(X), !, atom_string(X, X0).
 1266term_to_tokens(X, [X0|Y], Y):- atomic(X), !, term_string(X, X0).
 1267term_to_tokens(#(X), Y, Z) :- term_to_tokens([quote, X], Y, Z).
 1268term_to_tokens(X, Y, Z) :-
 1269	compound_name_arguments(X, F, Args),
 1270	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.

 1277term_to_tokens_with_closing([], [')'|Y], Y).
 1278term_to_tokens_with_closing([A|B],  X, Y):- term_to_tokens(A, X, Z),
 1279	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).

 1288tokens_to_string(X, Y):-
 1289	tokens_to_string(X, Y0, []),
 1290	atomics_to_string(Y0, Y).
 1291%
 1292tokens_to_string([], X, X).
 1293tokens_to_string([T|R], X, Y):- tokens_to_string(T, X, Z),
 1294	tokens_to_string(R, Z, Y).
 1295tokens_to_string('(', ["("|X], X).
 1296tokens_to_string(')', [")"|X], X).
 1297tokens_to_string(A,   [A, " "|X], X).

read_mini_buffer(+P:sring, -S:string) is det: Read a string from the emacs mini-buffer.

 1302% ?- elisp:read_mini_buffer("hello", X).
 1303
 1304read_mini_buffer(Prompt, Str):-
 1305	call_lisp('read-string'(Prompt), term(StrCodes)),
 1306	string_codes(Str, StrCodes).

read_number(Max:int, X:number) is det: Read a number from the emacs mini-buffer.

 1310read_number(Max,  X):- read_mini_buffer("number : ", S),
 1311	number_string(X, S),
 1312	between(1, Max, X).
 1313
 1314		/********************************
 1315		*     set/get string globally   *
 1316		********************************/

setq(+X:atom, +Y:term) is det: Shorthand for lisp(setq(X, Y)). ?- elisp:setq(working_directory, "/Users/cantor/file.pdf").

 1321setq(X, Y):-lisp(setq(X, Y)).

set_string(+X:atom, +Y:text) is det: Ask emacs lisp to eval S-expression "(setq X Y)".

 1326set_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.

 1330get_string(Atom, String):-
 1331	call_lisp(Atom, string(V)),
 1332	string_codes(V0, V),
 1333	term_string(String, V0).
 1334
 1335line(X) :- elisp:call_lisp(
 1336	'buffer-substring'(	'line-beginning-position'(),
 1337				'line-end-position'()),
 1338	term(X)).

mark_whole_buffer(X, X) is det: Mark whole buffer.

 1342mark_whole_buffer --> {lisp('mark-whole-buffer'())}.

set_mark_region is det: Mark paragraph region.

 1346set_mark_region	:- lisp('mark-paragraph-region'()).

set_mark_region(X, X) is det: Mark paragraph region.

 1350set_mark_region --> {set_mark_region}.

line_region(?X, L:codes) is det: Unify the content of the current line.

 1355line_region(_, Line) :- line_get(Obj), obj_get([line(Line)], Obj).

cur_dir(-D:atom) is det: Unify D with the current directory name.

 1360% ?- elisp:cur_dir(D).
 1361cur_dir(D) :- lisp_atom('default-directory', D).

cur_buf(-B:atom) is det: Unify B with the current buffer name.

 1366% ?- elisp:cur_buf(X).
 1367cur_buf(B) :- current_buffer_name(B).

current_buffer_name(-X:atom) is det: Unify X with current buffer name.

 1371current_buffer_name(X) :- current_buffer_name([], X).

current_buffer_name(_, -A:atom) is det: Unify A with the current buffer name.

 1376% ?- elisp:current_buffer_name(_, Y).
 1377current_buffer_name -->
 1378	{	call_lisp('buffer-name'('current-buffer'()), term(E)),
 1379		atom_codes(A, E)
 1380	},
 1381	peek(A).

default_directory(-D:text) is det: D is unified with the codes of emacs default-directory.

 1384default_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.

 1390%	?- elisp:mark(X).
 1391mark(X):- lisp(if(integerp(mark(t)), mark(), point()), X).

point(-X:int) is det: Unify X with the current point.

 1395point(X) :- lisp(point(), X).

goto_char(P:int) is det: 'Goto-char' to P.

 1399goto_char(P) :- lisp('goto-char'(P)).

goto_char(P:int, X, X) is det: 'Goto-char' to P.

 1403goto_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.

 1409goto_char(Key, String) :- sub_string(String, I, _, _, Key),
 1410	mark(P),
 1411	P0 is P + I,
 1412	goto_char(P0).

goto_line(P:int) is det: 'Goto-line' to line P.

 1417goto_line(P) :- lisp( 'goto-line'(P)).

point_max(-X:int) is det: Unify X with the point-max.

 1422point_max(X):- lisp('point-max'(), X).

point_min(-X:int) is det: Unify X with the point-min.

 1427point_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.

 1432% ?- elisp:buffer_substring(20, 30, X).
 1433buffer_substring(P, Q, S):- call_lisp('buffer-substring'(P, Q), term(S)).

edit_command_set(X, X) is det: Set edit-command-set.

 1438% edit_command_set --> {edit_command_set}.

edit_command_set is det: Set edit-command-set.

#([set_dired, dired, prolog, lisp, prooftree] ))).

 1446edit_command_set:- lisp(setq('edit-command-set',
 1447     #(["set_dired", "dired",  "prolog", "lisp", "prooftree"] ))).
 1448
 1449% ?- listing(quote).

edit(X, X) is det: Ask a predicate name, and Go to its definition.

 1454edit --> {	lisp_atom('read-string'("predicate[/N] : "), P),
 1455		setof(X-Y, find_pred:locate(P, X, Y), Pairs),
 1456		show_select_location(Pairs),
 1457		length(Pairs, N),
 1458		N > 0,
 1459		(	N  == 1
 1460		->	J  = 1
 1461		;	call_lisp('ask-term'("number ? "), term(J0)),
 1462			number_codes(J, J0)
 1463		),
 1464		nth1(J, Pairs, _ - [file(F), line(G)]),
 1465		atom_string(F, F0),
 1466		lisp(progn('find-file'(F0), 'goto-line'(G)))
 1467	 }.
 1468edit --> { lisp(message("No requested predicate found.")) }.
 1469
 1470%
 1471show_select_location(Pairs) :-
 1472	wait('switch-to-buffer'("*scratch*")),
 1473	insert_buffer("** select number **\n"),
 1474	length(Pairs, N),
 1475	numlist(1, N, Ns),
 1476	maplist(pred(([I,  Spec - _, [I0, ".\t- ", Spec0, "\n"]]:-
 1477		     number_string(I, I0),
 1478		     term_string(Spec, Spec0))),
 1479		Ns, Pairs, Specs),
 1480	insert_buffer(Specs).

zip_minus(?X:list, ?Y:list, ?Z:list) is det: Zip lists with '-'.

 1485zip_minus([], [], []).
 1486zip_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.

 1491% ?- elisp:visit_file_line("/Users/cantor/tmp/deldel.pl", 3).
 1492visit_file_line(File, Line):-
 1493	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.

 1498ask_number(P, X):- atomics_to_string(P, P0),
 1499	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.

 1507ask_which([_], 1).
 1508ask_which(Xs, J):- maplist([N-I, [N,-,I]], Xs, Ys),
 1509	insert("\n\t", Ys, Zs),
 1510	ask_number(["Select number:\n\t"|Zs], J).
 1511
 1512		/*****************
 1513		*     for tex    *
 1514		*****************/

wdf(X:codes, Y:codes) is det: Put a dollor code at both ends.

 1519wdf --> wrap_dollar_forwarding.
 1520
 1521%
 1522wrap_dollar_forwarding	--> for_ascii(X\[$, X, $]).
 1523wrap_Red_forwarding		--> for_ascii(X\['\\Red{', X, '}']).
 1524wrap_Green_forwarding	--> for_ascii(X\['\\Green{', X, '}']).
 1525wrap_Blue_forwarding	--> for_ascii(X\['\\Blue{', X, '}']).
 1526wrap_with_single_quote	--> region,
 1527	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.

 1533% ?- elisp:find_next_ascii_codes(X, A, R, ` å® å® a b c  `, Y).
 1534find_next_ascii_codes(X, A, Y) --> skip_to_ascii_codes(X),
 1535	ascii_codes(A),
 1536	current(Y).

ascii_codes(-X:codes, +Y:codes, -Z:codes) is det: True if X is unified with the maximum ascii codes prefix of Y, Z with the remainder of Y.

 1543% ?- elisp:ascii_codes(X, `ab cd  `, R).
 1544%@ X = [97, 98, 32, 99, 100],
 1545%@ R = [32, 32] .
 1546ascii_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.

 1553% ?- elisp:skip_to_ascii_codes(X, `abc`, Y).
 1554
 1555% ?- elisp:skip_to_ascii_codes(X, `åäº å½æ abc`, Y).
 1556skip_to_ascii_codes(X) --> wl( *(char(\+ascii|space)) | char(space)^(>=(2)), X).
 1557
 1558$([],[]). % end_of_codes([], []).
 1559
 1560first_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.

 1569%	?-  elisp:global_set_kbd("ejockey:handle([eit])").
 1570global_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.

 1575global_set_kbd(Key, A) :-
 1576	lisp('global-set-key'(kbd(Key),
 1577			#(lambda(nil, interactive(), 'prolog-query'(A))))).

global_unset_kbd(K:string) is det: global-unset key in kbd form.

 1582global_unset_kbd(K):- lisp('global-unset-key'(kbd(K))).
 1583
 1584		/******************************************
 1585		*     Convert xml to quasi bibtex form    *
 1586		******************************************/
 1587
 1588% ?- scm(elisp).
 1589% ?- abbreviation('ab cd', X).
 1590
 1591abbreviation(A, B):- string_code(I, A, 0'\s), !,    % '
 1592					 succ(J, I),
 1593					 sub_string(A, 0, J, _, B0),
 1594					 atom_string(B, B0).
 1595abbreviation(A, A).
 1596
 1597% ?- make_key([published='2014', author='Obama'], Key).
 1598
 1599make_key(L, Key):- memberchk(published=Year, L),
 1600	memberchk(author=Author, L),
 1601	!,
 1602	abbreviation(Author, Abbr),
 1603	atom_concat(Abbr, Year, Key).
 1604make_key(L, Key):- memberchk(published=Year, L),
 1605	memberchk(publisher=Pub, L),
 1606	!,
 1607	abbreviation(Pub, Abbr),
 1608	atom_concat(Abbr, Year, Key).
 1609make_key(L, Key):- memberchk(published=Year, L),
 1610	memberchk(publisher=Pub, L),
 1611	!,
 1612	abbreviation(Pub, Abbr),
 1613	atom_concat(Abbr, Year, Key).
 1614make_key(_, '??????').
 1615
 1616% Use this predicate after exporting onto the Desktop directory.
 1617% run unix command delicious-export  [2016/12/16]
 1618% ?- parse_xml_for_bibtex(Bib), maplist(writeln, Bib), length(Bib, Length).
 1619% ?- parse_xml_for_bibtex(Bib), open('/Users/cantor/Desktop/test', write, X),maplist(writeqln(X),  Bib), close(X).
 1620
 1621% Delicious Library 3; incremental export to bibtex
 1622% revised Workflow:
 1623%	(0) => (1) =>(2) => (3)
 1624%
 1625% (0)  initialize
 1626% %  touch ~/TeXLive/texmf-var/bibtex/bib/delicious-db.pl
 1627%
 1628% (1) run unix script [2016/12/16]:
 1629% %  delicious-export
 1630%
 1631% (2) run prolog query:
 1632% ?- elisp:delicious_update.
 1633%@ true .
 1634
 1635%
 1636% (3) Open the output at the Desktop, and  edit .bib files manually.
 1637
 1638% ?- elisp:delicious_bibtex_terms("~/TeXLive/texmf-var/bibtex/bib/deldelbooks1.pl").
 1639% ?- elisp:delicious_bibtex_terms("~/Desktop/test.pl", "~/Desktop/test.bib").
 1640
 1641% ?- trace, elisp:delicious_update.
 1642
 1643delicious_update:-
 1644	delicious_bibtex_terms("~/TeXLive/texmf-var/bibtex/bib/delicious-db.pl",
 1645						   "~/Desktop/new-delicious", ".bib").
 1646
 1647delicious_bibtex_terms(DB, Bib_basic, Ext) :- parse_xml_for_bibtex(Bib), !,
 1648	   sort(Bib, Bib0),
 1649	   expand_file_name(DB, [DB0|_]),
 1650	   pshell(touch(DB0)),
 1651	   read_file_to_terms(DB0, Old_bib, []),
 1652	   subtract(Bib0, Old_bib, NewBooks),
 1653	   open(DB0, write, Y),
 1654	   maplist(writeq_book_term(Y),  Bib0),
 1655	   close(Y),
 1656	   sort(NewBooks, NewBooks0),
 1657	   maplist(book_bibitem, NewBooks0, Bib1),
 1658	   atomics_to_string([Bib_basic, Ext],Bib_file),
 1659	   expand_file_name(Bib_file, [Out0|_]),
 1660	   string_length(Ext, N),
 1661	   sub_string(Out0, 0, _, N, Out_basic),
 1662	   ejockey:modify_file_name(Out_basic, 0, Ext, NewOut),
 1663	   open(NewOut, write, Z),
 1664	   maplist(writeln(Z),  Bib1),
 1665	   close(Z).
 1666
 1667writeq_book_term(X, Book):-
 1668	writeq(X, Book),
 1669	write(X, ".\n").
 1670
 1671%
 1672delicious_bibtex(Out) :- parse_xml_for_bibtex(Bib), !,
 1673	   sort(Bib, Bib0),
 1674	   maplist(book_bibitem, Bib0, Bib1),
 1675	   expand_file_name(Out, [Out0|_]),
 1676	   open(Out0, write, X),
 1677	   maplist(writeln(X),  Bib1),
 1678	   close(X).
 1679
 1680writeqln(S, X):- writeq(S, X), write(S, '.\n').
 1681
 1682% parse_xml_for_bibtex(Bib):-
 1683% 	expand_file_name("~/Desktop/Delicious Library/Library Media Data.xml", [File]),
 1684% 	parse_xml_for_bibtex(File, Dom),
 1685% 	maplist(pred(([book(L), book([key=Key|L])]:- make_key(L, Key))),
 1686% 			Dom, Bib).
 1687
 1688% % ?- parse_xml_for_bibtex("/path/to/xml-file", Dom).
 1689% parse_xml_for_bibtex(File, Books):-
 1690% 	Keys = [
 1691% 			published,
 1692% 			publisher,
 1693% 			title,
 1694% 			upc,
 1695% 			author],
 1696% 	parse_xml_to_books(File, Books, Keys).
 1697% %
 1698% parse_xml_to_books(File, Books, Keys):-
 1699% 	load_xml(File, Dom, [encoding('utf-8')]),
 1700% 	flatten_element_list(Dom, Books, [], Keys).
 1701
 1702%
 1703flatten_element_list([A|B], X, Y, Keys):-
 1704	once(flatten_element(A, X, X0, Keys)),
 1705	flatten_element_list(B, X0, Y, Keys).
 1706flatten_element_list([], X, X, _).
 1707
 1708%
 1709flatten_element(element(library, _, L), X, Y, Keys):-
 1710	flatten_element_list(L, X, Y, Keys).
 1711flatten_element(element(items, _, L), X, Y, Keys):-
 1712	flatten_element_list(L, X, Y, Keys).
 1713flatten_element(element(book, L, _), [book(L0)|X], X, Keys):-
 1714	projection(L, Keys, L0).
 1715flatten_element(_, X, X, _).
 1716
 1717%
 1718projection([], _, []).
 1719projection([Eq|L], Keys, [Eq0|L0]):- modify_value(Eq, Eq0), !,
 1720	projection(L, Keys, L0).
 1721projection([Eq|L], Keys, [Eq|L0]):- Eq = (K = _), memberchk(K, Keys), !,
 1722	projection(L, Keys, L0).
 1723projection([_|L], Keys, L0):- projection(L, Keys, L0).
 1724
 1725%
 1726modify_value(published = V, published = V0):-
 1727	sub_atom(V, 0, 4, _, V0).
 1728modify_value(K = 'ï¼',  K = void).
 1729modify_value('aspect=ï¼',  aspect = undefined).
 1730
 1731% Target sample.
 1732% @book{Noro-2003,
 1733% 	author = {éå æ£è¡ and æ¨ªå±± åå¼},
 1734% 	publisher = {æ±äº¬å¤§å¦åºçä¼},
 1735% 	pages = {288},
 1736% 	title = {ã°ã¬ããã¼åºåºã®è¨ç®åºç¤ç¯ï¼è¨ç®ä»£æ°å¥é},
 1737% 	keywords = {ç§å¦ã»ãã¯ããã¸ã¼},
 1738% 	ISBN = {4130614045},
 1739% 	language = {æ¥æ¬èª (Published)},
 1740% 	price = {ï¿¥ 4,536},
 1741% 	year = {2003}
 1742% }
 1743
 1744book_bibitem(book(L), BB):-
 1745	select(key=Keyval, L, L0),
 1746	maplist(pred( [published=V, [year, " = ", "{", V, "}"]]
 1747				& [K=V, [K, " = ", "{", V, "}"]]),			L0, Items),	insert(",\n", Items, Items0),	smash(["@book{", Keyval, ",\n", Items0, "\n}\n"], BB).

meta_handle(+G, +M, +Sp, +P)

+G : goal,
+M : module prefix
+Sp : a predicate with arity 4.
+P : a list, [] or [_,_]

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.

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