1:- module(eh, [ 2 new_file/2, new_base_name/2, counter/3, 3 assemble/2, expand_cgi_path/2, 4 boomerang/2, getstring/1, include_text/2, 5 file_string/3, 6 getinfo_codes/2, getinfo_string/2, getinfo/2, 7 sh/1, xsh/1, pshell/1, pshell/2, qshell/1, 8 vector_term/3, 9 perform/4, 10 apply3/3, 11 choose_files/1, choose_folder/1, 12 run_shell/2, run_shell/3, dir/1, dired/2 13 ]). 14% ?- xsh(open("/Users/cantor/.zshrc")). 15% ?- xsh([open, "/Users/cantor/deldel"]). 16% ?- xsh([ls, -al, "/Users/cantor/"] > "~/deldel"). 17% ?- A='/Users/cantor/Documents/Mac Fan_OCR.pdf', term_string(A, B), misc:sh(open(B)). 18 19:- use_module(pac(basic)). 20:- use_module(util(obj)). 21:- use_module(pac(reduce)). 22:- use_module(util(file)). 23:- use_module(util(misc)). 24:- use_module(util('prolog-elisp')). 25:- use_module(util('emacs-jockey')). 26:- use_module(util('emacs-jockey2')). 27% :- expects_dialect(pac). 28term_expansion --> pac:expand_pac. 29:- use_module(pac(op)). 30% 31:- set_prolog_flag(allow_variable_name_as_functor, true). 32 33% ?- run_command_to_codes([choosefolder], X, _, _), 34% atom_codes(A, X). 35%@ X = [47, 85, 115, 101, 114, 115, 47, 99, 97|...], 36%@ A = '/Users/cantor/Documents/texnotes/\n'. 37 38% ?- run_command_to_codes([choosefolder], X, _, _). 39%@ X = [47, 85, 115, 101, 114, 115, 47, 99, 97|...]. 40% ?- run_command_to_codes([echo, hello], X, _, _). 41% ?- run_command_to_codes([osascript, " -e 'return POSIX path of (choose folder)'"], X, _, _). 42 43% ?- run_command_to_codes([doscript, echo, hello], X, _, _). 44 45% ?- listing(run_command_to_codes).
51% ?- getinfo_codes("date +%Y-%m-%d", X), smash(X). 52% ?- getinfo_codes('echo $HOME', HOME), smash(HOME). 53% ?- getinfo_codes('echo Hello', X). 54getinfo_codes(P, X):- pipe_line(P, X0), string_codes(X0, X).
60% ?- getinfo_string('echo Hello', X). 61getinfo_string(P, X):- pipe_line(P, X).
68% ?- getinfo('echo Hello', X). 69% ?- getinfo("echo Hello", X). 70% ?- getinfo("osascript -e 'return POSIX path of (choose folder)'", X). 71% ?- getinfo("date +%Y-%m-%d", X). 72 73getinfo(P, X):- getinfo_string(P, X). 74 75% 76done(_, _).
82% ?- choose_folder(X). 83% by Jan. 84choose_folder(X) :- expand_file_name('~/local/bin/choose-folder.scpt', SCPT), 85 setup_call_cleanup( 86 process_create(path(osascript), [SCPT], 87 [ stdout(pipe(Out)), stderr(null) 88 ]), 89 read_lines_as_atoms(Out, X), 90 close(Out)).
96% ?- run_shell(echo, ["hello world\n"], Out). 97% ?- run_shell(echo, ["hello\n", "world\n"], Out). 98% ?- run_shell(echo, ["hello", "world\n"], Out). 99run_shell(Com, Args, Strings) :- 100 setup_call_cleanup( 101 process_create(path(Com), Args, 102 [ stdout(pipe(PipeOut)), stderr(null) 103 ]), 104 read_lines_as_atoms(PipeOut, Strings), 105 close(PipeOut)).
110% ?- run_shell(echo, ["hello world\n"]). 111 112% ?- run_shell(rmdir, ['/Users/cantor/Desktop/deldel']). 113% ?- trace. 114% ?- run_shell(mkdir, ["$HOME/Desktop/deldel"]). 115 116% ?- process_create(path(ls), ['-l'], []). 117 118 119% From manual: The following example uses grep to find all matching lines in a file. 120% ?- trace. 121% ?- ls. 122 123% ?- pwd. 124%@ % /Users/cantor/devel/zdd/prolog/ 125% ?- ls. 126 127% ?- grep("eh.pl", ".*zdd.*", Lines), length(Lines, N). 128grep(File, Pattern, Lines) :- absolute_file_name(File, AbsFile), 129 setup_call_cleanup( 130 process_create(path(grep), [ Pattern, file(AbsFile) ], 131 [ stdout(pipe(Out)) 132 ]), 133 jan_read_lines(Out, Lines), 134 close(Out)). 135% 136jan_read_lines(Out, Lines) :- 137 read_line_to_codes(Out, Line1), 138 read_lines(Line1, Out, Lines). 139 140read_lines(end_of_file, _, []) :- !. 141read_lines(Codes, Out, [Line|Lines]) :- 142 atom_codes(Line, Codes), 143 read_line_to_codes(Out, Line2), 144 read_lines(Line2, Out, Lines). 145% 146run_shell(Com, Args) :- 147 process_create(path(Com), Args, 148 [stdout(null), stderr(null)]).
154% ?- choose_files(X), maplist(writeln, X). 155choose_files(X) :- 156 expand_file_name('~/local/bin/choose-files.scpt', SCPT), 157 run_shell(osascript, [SCPT], X).
161scriptstart :- 162 prompt(_, ''), 163 current_input(In), 164 set_stream(In, encoding(utf8)), 165 current_output(Out), 166 set_stream(Out, encoding(utf8)), 167 process_loop. 168 169process_loop :- catch(process_step, E, handle_exception(E)), 170 process_loop. 171 172% 173process_step :- once(read_term_from_lisp(C)), 174 ( phrase(C, _, R) 175 -> insert_buffer(R) 176 ; insert_buffer("fail") 177 ). 178 179% 180handle_exception(E) :- smash(["exception: ", E], M), 181 message(M), 182 lisp('start-emacshandler'()).
188% ?- eh:maplist(filter(atom, atom_codes), [a,f(b), c], X). 189%@ X = [[97], f(b), [99]]. 190filter(F, A, X, Y):- call(F, X) -> call(A, X, Y); Y=X. 191 192term(F, X, Y, Z):- Z=..[F, X, Y]. 193 194% ?- qcompile(util('emacs-handler')). 195% ?- module(eh).
201% ?- eh:termrec(plus, 0, f(1,2,3,5,6,7), SumOfArgs). 202:- meta_predicate termrec(, , , ). 203termrec(F, I, X, Y) :- functor(X,_,N), 204 termrec(F, 0, N, X, I, Y). 205 206termrec(_, N, N, _, V, V) :-!. 207termrec(F, J, N, X, V, Y) :- J1 is J + 1, 208 arg(J1, X, A), 209 call(F, A, V, V1), 210 termrec(F, J1, N, X, V1,Y).
217% ?- eh:termrec(pred([I, J, X, a(X)]:- J is I + X), f(1,2,3,5,6,7), H, 0, S). 218:- meta_predicate termrec(, , , ,). 219termrec(A, T, T1, N, N1):- functor(T, Fun, Ar), 220 functor(T1, Fun, Ar), 221 termrec(A, 0, Ar, T, T1, N, N1). 222 223% 224termrec(_, M, M, _, _, N, N) :- !. 225termrec(A, J, M, T, T1, N, N1) :- J1 is J + 1, 226 arg(J1, T, B), 227 arg(J1, T1, C), 228 call(A, N, N2, B, C), 229 termrec(A, J1, M, T, T1, N2, N1). 230% 231power(P) --> maplist(phrase(P)).
237phrase_on_car(X, [Y0|Z], [Y|Z]) :- once(perform([], X, Y0, Y)). 238 239% ?- eh:perform([], (=, =, =), a, X). 240% ?- perform([], seqcal: (p2q,raster,rasterx), p(right(+),[]>>[a+ (!a)],[p(right(!),[]>>[a,!a],[p(axiom,[a]>>[a])])]), X), smash(X). 241% :- meta_predicate perform(?,:,?,?). 242perform(_, eval, X, Y):- eval(X, Y). 243perform(_, true, X, X). 244perform(Ms, M:A, X, Y):- perform([M|Ms], A, X, Y). 245perform(M, (A; _), X, Y):- perform(M, A, X, Y). 246perform(M, (_; A), X, Y):- perform(M, A, X, Y). 247perform(M, (A, B), X, Y):- perform(M, A, X, Z), perform(M, B, Z, Y). 248perform([], A, X, Y):- call(A, X, Y). 249perform([M|_], A, X, Y):- call(M:A, X, Y). 250 251% % Prolog on emacs buffer 252% /** ::prolog 253% append(X, Y,[a,b,c]), X=[_,_] 254% **/ 255 256% module_prefix_for_expand(eh). 257module_prefix_for_expand(user). 258 259prolog --> solve_bind. 260 261solve_bind_once --> solve_bind, !. 262 263solve_bind --> herbrand(Bind), 264 current(X), 265 { module_prefix_for_expand(Mod), 266 once(pac:expand_goal(X, Mod, Y, P, [])), 267 maplist(assert, P), 268 solve(Y) 269 }, 270 peek(Bind), 271 term_codes. 272 273% 274solve((X,Y)):- solve(X), solve(Y). 275solve(X):- call(X). 276 277% 278phrase(C, G, X, Y) :- call(C, call(G, X, Y)). 279 280% % 281% once(G)--> phrase(once, G). 282 283% once(G, U, L0, L) :- once(call(G, U, L0, L)). 284 285% % once(G, X, X0) --> phrase(once, call(G, X, X0)). 286% once(G, X, X0, L0, L) :- once(call(G, X, X0, L0, L)). 287 288 289% a la cd command 290% ?- eh:walk_on_tree(up, [a,b,c], X). 291% ?- eh:walk_on_tree(up_down([x,y]), [a,b,c], X). 292 293walk_on_tree(up, X, Y):- !, (append(Y, [_], X) -> true; Y=X). 294walk_on_tree(down(A), X, Y):- !, append(X, A, Y). 295walk_on_tree(up_down(A), X, Y):- walk_on_tree(up, X, X0), 296 walk_on_tree(down(A), X0, Y). 297 298% 299% ?- eh:change_unix_path(up, "/a", X). 300%@ X = "". 301 302% ?- eh:change_unix_path(up, "/ab/cd/ef", X). 303% ?- eh:change_unix_path(down("x/y"), "/ab/cd/ef", X). 304%@ X = "/ab/cd/ef/x/y/". 305% ?- eh:change_unix_path(up_down("x/y"), "/ab/cd/ef", X). 306%@ X = "/ab/cd/x/y/". 307 308change_unix_path(up, P, Q):- !, path_to_list(P, X), 309 walk_on_tree(up, X, Y), 310 path_to_list(Q, Y). 311change_unix_path(down(A), P, Q):- !, 312 path_to_list(A, Z), 313 path_to_list(P, X), 314 walk_on_tree(down(Z), X, Y), 315 path_to_list(Q, Y). 316change_unix_path(up_down(A), P, Q):- 317 path_to_list(A, Z), 318 path_to_list(P, X), 319 walk_on_tree(up_down(Z), X, Y), 320 path_to_list(Q, Y). 321 322% ?- eh:path_to_list("/", X). 323% ?- eh:path_to_list(A, []). 324% ?- eh:path_to_list(A, [a]). 325% ?- eh:path_to_list(A, [a,b]). 326 327path_to_list(A, X):- nonvar(A), !, 328 atomics_to_string(Y, (/), A), 329 remove_null(Y, X). 330path_to_list(A, X):- remove_null(X, X0), 331 list_to_unix_path(X0, A). 332 333% 334list_to_unix_path([], "/"):- !. 335list_to_unix_path(X, A):- append([[""],X,[""]], X0), 336 atomics_to_string(X0, "/", A). 337 338% 339remove_null([''|A], B):-!, remove_null(A, B). 340remove_null([""|A], B):-!, remove_null(A, B). 341remove_null([X|A], [X|B]):- remove_null(A, B). 342remove_null([], []). 343 344 345% [2015/12/28] 346file_string(File, Length, String):- open(File, read, Stream, [encoding(utf8)]), 347 read_string(Stream, Length, String), 348 close(Stream). 349% 350file_string(File, String):- file_string(File, _, String). 351 352% 353getstring(X) :- get_code(C), 354 (C == -1 -> X=[] ; X=[C|Y], eh:getstring(Y)). 355 356putstring(X) :- maplist(put_code, X). 357 358getline(X) :- get_code(C), 359 ((C == -1; C==0'\n) -> X=[] ; X=[C|Y], getline(Y)). 360 361putline(X) :- smash(X), put_code(0'\n).
text(T) -- T as text.
file(G) -- the contents of G
region -- the current buffer region
buffer -- the current whole buffer372assemble(Fs, F) :- expand_file_search_path(F, F1), 373 open(F1, write, FX, [encoding(utf8)]), 374 maplist(assemble_basic(FX), Fs), 375 close(FX). 376 377assemble_basic(FX, text(F)) :- !, clean_io(FX, write, basic:smash(F)). 378assemble_basic(FX, file(F)) :- !, expand_file_search_path(F, F1), 379 open(F1, read, FY, [encoding(utf8)]), 380 clean_io(FY, read, eh:getstring(D)), 381 maplist(put_code(FX), D). 382assemble_basic(FX, codes(Codes)) :-!, maplist(put_code(FX), Codes). 383assemble_basic(FX, region(Codes)):-!, maplist(put_code(FX), Codes). 384assemble_basic(FX, buffer) :- 385 call_lisp(list('point-min'(), 'point-max'()), string(L)), 386 list_number_list(L, [Min, Max]), 387 get_buffer_region(Min, Max, R), 388 maplist(put_code(FX), R).
391mac_open(F):- pshell(open(F)). 392 393mac_open(F, F):- mac_open(F). 394 395mac_open(P, F, F):- mac_open_prefix(P, F). 396 397mac_open_prefix(_, F):- prefix_chk(`/`, F ), !, mac_open(F). 398mac_open_prefix(_, F):- prefix_chk(`~`, F), !, mac_open(F). 399mac_open_prefix(Prefix, F):- mac_open(Prefix+ '/'+ F). 400 401prefix_chk(Prefix, String):- append(Prefix, _, String). 402 403:- meta_predicate wild_map(,). 404wild_map(M, W):- expand_file_name(W, L0), maplist(M, L0). 405 406:- meta_predicate wild_map(,,). 407wild_map(M, W, L):- expand_file_name(W, L0), maplist(M, L0, L). 408 409wild_open(Wildcard):- wild_map(pred([X] :- pshell(open(X))), Wildcard). 410 411 /****************************** 412 * counter file handler * 413 ******************************/
421:- meta_predicate counter_general(, , ). 422 423counter_general(FileProp) --> obj:obj_get([counter_name(C), directory(D)]), 424{ 425 pshell(mkdir(-p, D)), !, 426 setup_call_cleanup( working_directory(Old, D), 427 call(FileProp, C), 428 working_directory(_, Old)) 429}.
434counter(new) --> 435 counter_general(pred([C] :- file(C, write, format("~w.~n", [0])))), 436 obj_put([count(0)]). 437counter(update) --> counter_general(exists_file), !, 438 obj:obj_get([counter_name(C), directory(D)]), 439 { working_directory(Old, D), 440 file(C, read, read(V1)), 441 V is (V1 + 1) mod 100, 442 file(C, write, format("~w.~n",[V])), 443 working_directory(_, Old) 444 }, 445 obj_put([count(V)]). 446counter(update) --> counter(new).
451new_file --> obj:obj_get([ stem(R), directory(D) ] ),
452 counter(update),
453 obj:obj_get([count(N)]),
454 { atomic_list_concat([R, N], B),
455 atomic_list_concat([D, / , B], F)
456 },
457 obj_put([base(B), file(F)]).
462new_file_here --> obj_get([stem(R), count(N)]),
463 { atomic_list_concat([R, N], B) },
464 obj_put([base(B)]).
469new_base_name -->
470 counter(update),
471 obj_get([count(N), stem(R), directory(D)]),
472 { atomic_list_concat([R, N], B),
473 atomic_list_concat([D, / , B], F)
474 },
475 obj_put([base(B), file(F)]).
480dir_open --> obj_get([directory(D)]),
481 { pshell(open(D)) }.
486dir_open(D):- dir_open([directory(D)], _).
491expand_cgi_path(X, Y):-
492 getenv(http_cgi_bin, CB),
493 expand_path(CB, X, Y).
499expand_path(P, X, Y):- getenv(user, Name),
500 smash([`/~`, Name, `/`, P, `/`, X], Y).
505include_text(X,Y) :- once(filepath(X,P)), file(P, read, getstring(Y)).
510include_text(A)--> {listp(A) -> L = A; L = [A]}, peek(L),
511 maplist(include_text).516filepath(X,X) :- atomic(X), !. 517filepath(A,X) :- A=..[P|A1], 518 ( P= (/) -> Q = [ /|A1] ; dir(P, D), Q = [D, /|A1] ), 519 atomic_list_concat(Q, X). 520filepath(A,X) :- expand_file_search_path(A, X). 521 522% some handy 523singleton(X,[X]). 524comma((X, Y), X, Y). 525args(X, A, B):- arg(1, X, A), arg(2, X, B). 526image(R, S) :- maplist(snd, R, S). 527% 528vector_term(_, [X], X). 529vector_term(F, [X, Y|Z], U):- vector_term(F,[Y|Z], X0), U=..[F, X, X0]. 530 531% 532wrap(X, Y, A, [X,A,Y] ).
537boomerang(Dir, ShellCom):- sh(cd(Dir); ShellCom). 538 539same_atom(X, Y, "yes"):- atom_codes(X, Y). 540same_atom(_, _, "no"). 541 542backquote_string(X) :- string_codes(X, [96]). 543 544% 545sh(X) :- pshell(X, [c, q]). 546 547% ?- xsh(ls). 548xsh(X):- qshell_string(X, S), 549 shell(S, Ecode), 550 !, 551 ( Ecode == 0 -> true 552 ; snap(shell(S, Ecode)), 553 fail 554 ). 555 556 557% xsh(X):-shell_string(X, "", Str), 558% shell(Str, S), 559% ( S \== 0 -> throw(xsh_error(Str)) 560% ; true 561% ). 562 563% ?- pshell(ls, [c, q, path]). 564% ?- pshell(ls, [path]). 565% ?- pshell(echo("$PATH") > "~/Desktop/PATH"). 566% ?- pshell("update-all"). 567% ?- pshell("update-swipl"). 568% ?- qshell("update-all"). 569 570userp(X):- snap(X). 571userp(X,Y,Y):- snap(X). 572 573% ?- pshell(ls). 574% ?- pshell(ls, [c]). 575% ?- pshell([ls], [c]). 576% ?- pshell(ls, [q]). 577% ?- pshell(ls, [c, q]). 578% ?- pshell(ls, [c, q]). 579% ?- pshell([ls], [c, q]). 580% ?- qshell_string([a,b,c], X). 581 582pshell(X, Opts):- 583 shell_string(X, X0), 584 ( memberchk(path(V), Opts) -> 585 T0 = ( "PATH=" + V ; X0) 586 ; T0 = X0 587 ), 588 ( memberchk(c, Opts) -> 589 shell_string("( " + T0 + " )", T1), 590 term_string(T1, T2), 591 T3 = "/bin/sh -c " + T2 592 ; T3 = T0 593 ), 594 ( memberchk(q, Opts) -> 595 T4 = T3 + " > /dev/null 2>&1" 596 ; T4 = T3 597 ), 598 ( memberchk(str(Str), Opts) -> true 599 ; true 600 ), 601 shell_string(T4, Str), 602 ( memberchk(exit(R), Opts) -> true 603 ; true 604 ), 605 shell(Str, R). 606 607% Was 608% pshell(X, Opts):- 609% ( memberchk(path(V), Opts) 610% -> T0 = shell( "PATH=" + V ; X) 611% ; T0 = shell(X) 612% ), 613% ( memberchk(q, Opts) 614% -> T1 = T0 + " >> /dev/null 2>&1" 615% ; T1 = T0 616% ), 617% misc:shell_string(T1, T2), 618% ( memberchk(c, Opts) 619% -> term_string(T2, T3), 620% T4 = "/bin/sh -c " + T3 621% ; T4 = T2 622% ), 623% misc:shell_string(T4, S), 624% shell(S). 625 626% ?- pshell(ls). 627% ?- pshell(pwd). 628% pshell(T):- misc:shell_string(T, S), shell(S). 629pshell(T):- pshell(T, []). 630 631% pshell in quiet mode. 632% ?- qshell(ls). 633% ?- pshell(ls). 634% ?- qshell(pwd). 635qshell(X):- pshell(X, [q]). 636 637:-meta_predicate(directory(, )). % <= neccessary dcl. 638directory(D, A):- 639 working_directory(Old, D), 640 call(A), 641 working_directory(_, Old). 642% ?- ls_pdf_files(L). 643% ?- ls_pdf_files(_, L), smash(L). 644% ?- ls_files_suffix(['.pdf'], L).
648ls_pdf_files(_, L) :- ls_pdf_files(L0), insert("\n", L0, L).
652ls_pdf_files(L) :- ls_files(suffix([".pdf"]), L).
656ls_files_suffix(S, L) :- ls_files(suffix(S), L).
660suffix(S, X):- sub_string(X, _, _, 0, S).666% ?- eh:directory_filter(pred(([X]:- sub_string(X, _, 3, 0, ".pl"))), PDFs). 667:- meta_predicate directory_filter(, ). 668directory_filter(Filter, Fs):- ls_objects(FS0), collect(Filter, FS0, Fs).
673ls_files(Filter, L):- directory_filter(exists_file, L0),
674 collect(Filter, L0, L).
678ls_files(L):- directory_filter(exists_file, L).
683ls_dirs(Filter, L):- directory_filter(exists_directory, L0),
684 collect(Filter, L0, L).
688ls_dirs(L):- directory_filter(exists_directory, L).
693ls_files_dirs(Fs, Ds):- ls_objects(A), object_classify(A, Fs, Ds).700% ?- eh:ls(X, Y). 701% ?- working_directory(_, "/Users/cantor"), eh:ls(X, Y). 702 703ls --> ls_files_dirs.
ls_objects(A), maplist(writeln, A).708ls_objects(A):- getinfo_codes(ls, X), 709 (X==[] 710 -> A = [] 711 ; once(split(X, X0)), maplist(atom_codes, A, X0) 712 ). 713 714% 715object_classify([], [], []). 716object_classify([A|As], [A|Xs], Ys):- exists_file(A), !, 717 object_classify(As, Xs, Ys). 718object_classify([A|As], Xs, [A|Ys]):- object_classify(As, Xs, Ys). 719 720% 721set_dir(X, Y):- working_directory(X, Y). 722set_dir(X) :- working_directory(_, X). 723 724% 725get_dir(X) :- working_directory(X, X).
731excursion(A):- get_dir(D), call(A), set_dir(D).f(x) or
d(y, z), where x is a filename, y a directory name, and z
a directory structure.
?- eh:dir_tree(L), maplist(writeln, L).
742dir_tree(L):- ls(Fs, Ds), 743 maplist(unary(f), Fs, Gs), 744 maplist(excursion_dir_tree, Ds, Es), 745 append(Gs, Es, L). 746 747dir_tree(P, L):- excursion((set_dir(P), dir_tree(L))). 748 749excursion_dir_tree(N, d(P, L)):- 750 get_dir(P0), 751 atomic_list_concat([P0,N,(/)], P), 752 excursion((set_dir(P), dir_tree(L))). 753% 754unary(F, T) :- functor(T, F, 1). 755unary(F, A, T) :- T =.. [F, A].
expand_file_name('~/', [H]), eh:(working_directory(_, H), map_directory(pred([X]:- writeln(X)))).761:- meta_predicate map_directory(). 762map_directory(Act):- ls_objects(Fs), maplist(check_do(Act), Fs). 763 764check_do(true, _):- !. 765check_do(false, _):- !, fail. 766check_do((A, B), X):- !, check_do(A, X), check_do(B, X). 767check_do((A; B), X):- !, once(check_do(A, X); check_do(B, X)). 768check_do(\+ A , X):- !, \+ check_do(A, X). 769check_do(A->B , X):- !, (check_do(A, X) -> check_do(B, X)). 770check_do(A , X):- call(A, X). 771 772%! escape_posix_file_name_char(+X:text, -Y:text) is det 773% True if Y is unified with a copy of X in which 774% special characters in X are escaped so that Y is 775% safe for posix file name. 776% ?- ejockey:escape_posix_file_name_char(`a : (b)`, R), atom_codes(A, R), smash(R). 777%@ a \@ \(b\) 778%@ R = [97, 32, 92, 64, 32, 92, 40, 98, 92, 41], 779%@ A = 'a \\@ \\(b\\)' . 780escape_posix_file_name_char(X, Y):- 781 foldr(pred( [0'(, U, [0'\\, 0'( | U] ] & 782 [0'), U, [0'\\, 0') | U] ] & 783 [0'\', U, [0'\\, 0'\' | U] ] & 784 [0':, U, [0'\\, 0'@ | U] ] & 785 [0'/, U, [0'\\, 0'@ | U] ] & 786 [A, U, [A|U] ] 787 ), 788 X, [], Y). 789 790%' 791%! r_act_plus(+F:pred/3, +L:list, -Y:term) is det 792% True if 793% Y is unified with the folded L by F from the right, 794% so that Y is a right branching binary tree. 795% ?- eh:foldl(variant(term(+)), [b,c,d], a, Y). 796%@ Y = a+b+c+d. 797:- meta_predicate r_act_plus(, , ). 798r_act_plus(F, Xs, V) :- r_act_plus(F, Xs, _, V).
?- eh:r_act_plus(term(+), [a,b,c], X, Y).
@ X = c,
@ Y = a+ (b+c).
810% ?- eh:r_act_plus(term(+), [a,b,c,d], X, Y). 811% ?- eh:r_act_plus(term(+), [1, 2, 3], X). 812% ?- eh:r_act_plus(variant(term(+)), [1, 2, 3], X). 813% ?- eh:r_act_plus(cons, [1, 2, 3], X). 814:- meta_predicate r_act_plus(, , , ). 815r_act_plus(_, [X], X, X):-!. 816r_act_plus(F, [A|As], X, Y) :- call(F, A, Y0, Y), 817 r_act_plus(F, As, X, Y0).
apply(P, [A1,...,An, V]) is true.823% ?- eh:apply(append([a,b]),[[c,d]], R). 824%@ R = [a, b, c, d]. 825 826:- meta_predicate apply3(, , ). 827 828apply3(A, Xs, V):- apply_(Xs, A, V). 829 830% 831apply_([], A, V) :- !, call(A, V). 832apply_([X], A, V) :- !, call(A, X, V). 833apply_([X, Y], A, V) :- !, call(A, X, Y, V). 834apply_([X, Y, Z], A, V) :- !, call(A, X, Y, Z, V). 835apply_([X, Y, Z, U], A, V) :- !, call(A, X, Y, Z, U, V). 836apply_(Xs, A, V) :- is_list(Xs), 837 append(Xs, [V], Args), 838 apply(A, Args).
f(a1,..., an),
Y is unified with a term f(b1,...,bn) where call(F, ai, bi) is
recursively true. mapleaves/3 is a recursive version of mapterm/3.845% ?- eh:mapleaves(pred([X,[X,X]]), f(a,[u,v], b([1,2])), R). 846 847:- meta_predicate mapleaves(, , ). 848mapleaves(F, M:X, M:Y) :- !, mapleaves(F, X, Y). 849mapleaves(F, X, Y) :- ala_list(X), !, 850 maplist(mapleaves(F), X, Y). 851mapleaves(F, X, Y) :- atomic(X), !, call(F, X, Y). 852mapleaves(F, X, Y) :- functor(X, A, N), 853 functor(Y, A, N), 854 mapleaves(0, N, F, X, Y). 855 856:- meta_predicate mapleaves(,,,,). 857mapleaves(N, N, _ , _ , _) :- !. 858mapleaves(I, N, F, X, Y):- J is I + 1, 859 arg(J, X, Z), 860 arg(J, Y, U), 861 mapleaves(F, Z, U), 862 mapleaves(J, N, F, X, Y).
f(a1,..., an), call(F, ai) is true for all ai.
mapleaves/2 is a recursive version of mapterm/2.869% ?- eh:mapleaves(mapleaves(writeln), f(g(a), [c,x(j),e], h(b))). 870:- meta_predicate mapleaves(, ). 871mapleaves(F, _:X) :- !, mapleaves(F, X). 872mapleaves(F, X) :- is_list(X), !, maplist(mapleaves(F), X). 873mapleaves(F, X) :- atomic(X), !, call(F, X). 874mapleaves(F, X) :- functor(X, _, N), mapleaves(0, N, F, X). 875 876% 877mapleaves(N, N, _, _) :- !. 878mapleaves(I, N, F, X) :- J is I + 1, 879 arg(J, X, Z), 880 mapleaves(F, Z), 881 mapleaves(J, N, F, X). 882 883 884 /**************************************** 885 * accessing favorite directories * 886 ****************************************/
893:- meta_predicate setup_candidate(,). 894setup_candidate(SetVar, Pred) :- 895 setof(D, call(Pred, D), S), 896 maplist(atom_string, S, Cs), 897 call_lisp_wait(setq(SetVar, #(Cs))), 898 atom_string(SetVar, SetVarName), 899 atomics_to_string(["variable ", SetVarName, " has been set."], String), 900 call_lisp_wait(message(String)). 901 902% 903dir(X):- config:dir_data(X, _).
910dired --> { call_lisp(
911 prompt("directory name ",
912 #('dir-set')),
913 [value(D0), string(t)]),
914 term_codes(T, D0),
915 atom_string(A, T),
916 config:expand_dir_name(A, D),
917 lisp(dired(D))
918 }