1:- module(texparse, []).    2
    3% Obsolete.
    4
    5:- style_check(-singleton).    6:- use_module(pac(op)).    7term_expansion --> pac:expand_pac.
    8
    9:- meta_predicate once(2, ?, ?).   10once(P, X, Y):- once(phrase(P, X, Y)).
   11
   12			/****************************************
   13			*     listing tex command sequences.    *
   14			****************************************/
   15
   16list_texcs_file(File, R):- read_file_to_codes(File, R0, []),
   17	tex_parse(R0, R1),
   18	list_texcs(R2, [], R1, []),
   19	sort(R2, R).
   20
   21%
   22list_texcs(X, Y):-  list_texcs(Y, [], X, []).
   23
   24%
   25list_texcs([A|X], Y)	--> [cs(A)], !, list_texcs(X, Y).
   26list_texcs([F|X], Y)	--> [env(F, B)], !,
   27	{ list_texcs(X, X0, B, []) },
   28	 list_texcs(X0, Y).
   29list_texcs(X, Y)	--> [L], { listp(L) } , !,
   30	{ list_texcs(X, X0, L, []) },
   31	list_texcs(X0, Y).
   32list_texcs(X, Y)	--> [_], !, list_texcs(X, Y).
   33list_texcs(X, X)	--> [].
   34
   35% some tiny
   36rest_of_line(X)		-->  prefix(X),	end_of_line(_).
   37rest_of_line(X, Y)	-->  prefix(X, Y), end_of_line(_).
   38
   39% ?- tex: filler(X, `   aaa `, R).
   40
   41filler(X) --> wl(*char(white), X).
   42
   43%
   44prefix(X, Y, Z) :-  append(X, Z, Y).
   45prefix(P, P,  U, U).
   46prefix([X|P], Q,  [X|U], V):- prefix(P, Q, U, V).
   47
   48% ?-tex: end_of_line(X, `\nabc`, R).
   49% ?-tex: end_of_line(X, [], Y).
   50%@ X = Y, Y = [].
   51
   52end_of_line(`\n`) --> "\n".
   53end_of_line([], [], []).
   54
   55% ?- tex:tex_parse(`$$\\abc + u + \n/* comment */ \n\\xyz$$`, R), tex:flat_tex(R, S), smash(S).
   56% ?- tex:tex_cs(X, Y, `\\+abc`, R).
   57
   58
   59			/*****************************
   60			*     parse text in latex    *
   61			*****************************/
   62
   63tex_parse --> tex_tokens, tex_env.
   64
   65tex_tokens(X, Y) :- once(tex_tokens(Y, [], X,[])).
   66
   67tex_env(X, Y) :- once(tex_env(Y, [], X, [])).
   68
   69%
   70tex_tokens(X, X) --> [].
   71tex_tokens(X, Y)  --> tex_token(X, X0), !, tex_tokens(X0, Y).
   72
   73%
   74tex_token(X, Y)	   --> tex_cs(X, Y).
   75tex_token(X, Y)	   --> tex_group(X, Y).
   76tex_token(X, Y)	   --> tex_math(X, Y).
   77tex_token([comment(C)|X], X) --> comment(C).
   78tex_token([C|X], X) --> [C].
   79
   80%
   81tex_cs([cs(Name)|X],X) --> "\\", wl(+(char(alpha)), Y),
   82	{atom_codes(Name, Y)}.
   83tex_cs([cs(C)|X],X)    --> "\\" , w(char(\(alnum)), [C0]), {char_code(C, C0)}.
   84
   85%
   86tex_group([group(X)|Y],Y) --> "{", tex_tokens(X), "}".
   87
   88%
   89tex_math([dmath(X)|Y], Y) --> "$$", tex_tokens(X), "$$".
   90tex_math([math(X)|Y], Y)  --> "$", tex_tokens(X), "$".
   91
   92
   93			/***********************
   94			*     parse comment    *
   95			***********************/
   96
   97%%% Comment and Quotation
   98% ?-  tex: comment(X, `%comment\nabc`, R), smash(X).
   99%@ %comment
  100% ?-  tex: comment(X, `//%comment\nabc`, R), smash(X).
  101%@ //%comment
  102% ?-  tex: comment(X, `/********\n  comment  \n********/\nabc`, R), smash(X).
  103%@ /********
  104%@   comment
  105%@ ********/
  106
  107% [2014/08/29]
  108% ?- X = (("/\\*" + *(\("\\*/")) + "\\*/") | (("//" | "%") +  "[^\n]*" + "\n")), coalgebra:show_am(X).
  109% ?- X = (("/\\*" + *(.) + "\\*/") | (("//" | "%") +  "[^\n]*" + "\n")), coalgebra:show_am(X).
  110%@ X = ("/\\*"+ * ('.')+"\\*/"| ("//"| "%")+"[^\n]*"+"\n")
  111%
  112% (("/\\*" + *(.) + "\\*/") | (("//" | "%") +  "[^\n]*" + "\n" )) :   (("/\\*" +  *(\ ("\\*/")) + "\\*/") | (("//" | "%") +  "[^\n]*" + "\n"))
  113
  114%uncommetn !!!! [2014/09/26]
  115%%%%% comment(X) --> 	 w( ("/\\*" + *(.) + "\\*/") | (("//" | "%") +  "[^\n]*" + "\n"),    X).
  116
  117% comment(X) --> w( (("/\\*" +  *(\ ("\\*/")) + "\\*/")
  118%  		| (("//" | "%") +  "[^\n]*" + "\n")), X).
  119
  120			/**************************
  121			*     TeX environments    *
  122			**************************/
  123tex_env(X, X) --> [].
  124tex_env([group(X)|Y],Z)   --> [group(G)], {tex_env(G,X)},  tex_env(Y,Z).
  125tex_env([env(Name,X)|Y],Z) --> [cs(begin)],
  126	[group(T)],
  127	tex_env(X,[]),
  128	[cs(end)],
  129	[group(T)],
  130	{atom_codes(Name,T)},
  131	tex_env(Y,Z).
  132tex_env([dmath(X)|Y], Z)   --> [dmath(M)], {tex_env(M, X)}, tex_env(Y, Z).
  133tex_env([math(X)|Y], Z)	   --> [math(M)],  {tex_env(M, X)}, tex_env(Y, Z).
  134tex_env([X|Y], Z)	   --> [X], tex_env(Y,Z).
  135
  136
  137			/*************************************
  138			*     structured tex to  flat tex    *
  139			*************************************/
  140
  141flat_tex(X, Y):- flat_tex(X, Y0, []), flatten(Y0, Y).
  142
  143%
  144flat_tex([], X, X).
  145flat_tex([A|B], X, Y):- flat_tex(A, X, X0), flat_tex(B, X0, Y).
  146flat_tex(env(Name, A), ["\\being{", Name, "}"|X],  Y):- flat_tex(A, X, X0),
  147	X0 = ["\n\\end{", Name, "}"|Y].
  148flat_tex(group(A), ["{"|X],  Y):- flat_tex(A, X, X0), X0 = ["}"|Y].
  149flat_tex(cs(A), ["\\", A, " "|X],  X).
  150flat_tex(math(E), ["$"|X], Y):- flat_tex(E, X, X0), X0 = ["$"|Y].
  151flat_tex(dmath(E), ["$$"|X], Y):- flat_tex(E, X, X0), X0 = ["$$"|Y].
  152flat_tex(comment(A), [A|X], X).
  153flat_tex(A, [A|X], X).
  154
  155
  156% ?- libsort:detex_rule(math([math(a), dmath([b, env(frame, [c]),c])]), R).
  157% R = [a,[b,[c],c]]
  158
  159
  160detex_rule(cs(A1),[]):-! .
  161detex_rule(group(X),A1):-!,detex_rule(X,A1) .
  162detex_rule(env(A1,X),A2):-!,detex_rule(X,A2) .
  163detex_rule(math(X),A1):-!,detex_rule(X,A1) .
  164detex_rule(dmath(X),A1):-!,detex_rule(X,A1) .
  165detex_rule(X,A1):-listp(X),!,maplist(detex_rule,X,A1) .
  166detex_rule(X,X):-! .
  167tex_kanji_rule(cs(X),A1):-!,ts_atom(X,A1) .
  168tex_kanji_rule(A1,[]):-!