1:- module(dpathw,[wexplore/1,
    2               wopen/1,
    3               op(650,yfx, (:/))
    4              ]).
    5/* Module has predicates to interact with Windows file tools
    6 *
    7 *
    8*/

    9
   10:- use_module(wexplorer).
   11
   12% Dict-concept is using the dot-operator
   13:- redefine_system_predicate( dpathw:(.(_,_,_))).
   14.(Data, Func, Value):-  Value =.. ['.', Data,Func].
   15
   16
   17%this is for convenience so that
   18% wexplore(dpath:filetype(X))
   19%works, instead of removing the dpath as in
   20% wexplore(filetype(X))
   21wexplore(dpath:T):-
   22          wexplore(T).
   23
   24wexplore(dir(D)):-
   25          \+compound(D),
   26          dir(D),
   27          pathterm_atom(D,Dir),
   28          show(dir,Dir).
   29
   30wexplore(dir(D/E)):-
   31          dir(D/E),
   32          pathterm_atom(D,Dir),
   33          show(dir,Dir).
   34
   35wexplore(dir(Drive:/T)):-
   36          dir(Drive:/T),
   37          pathterm_atom(Drive:/T,D2),
   38          show(dir,D2).
   39
   40wexplore(file(D)):-
   41          \+compound(D),
   42          file(D),
   43          pathterm_atom(D,File),
   44          select(file,File).
   45
   46wexplore(file(D/E)):-
   47          file(D/E),
   48          pathterm_atom(D/E,File),
   49          select(file,File).
   50
   51wexplore(file(Drive:/T)):-
   52          file(Drive:/T),
   53          pathterm_atom(Drive:/T,File),
   54          select(file,File).
   55
   56wexplore(filetype(Drive:/T)):-
   57          filetype(Drive:/T),
   58          pathterm_atom(Drive:/T,File),
   59          select(file,File).
   60
   61wexplore(filetype(K/L)):-
   62          filetype(K/L),
   63          pathterm_atom(K/L,Path),
   64          absolute_file_name(Path,AbsPath),
   65          select(file,AbsPath).
   66
   67wexplore(filetype(K.L)):-
   68          filetype(K.L),
   69          pathterm_atom(K.L,Path),
   70          absolute_file_name(Path,AbsPath),
   71          select(file,AbsPath).
   72
   73%this is for convenience so that
   74% wopen(dpath:filetype(X))
   75%works, instead of removing the dpath as in
   76% wopen(filetype(X))
   77wopen(dpath:T):-
   78          wopen(T).
   79
   80wopen(filetype(Dr:/K/L)):-
   81          filetype(Dr:/K/L),
   82          pathterm_atom(Dr:/K/L,Path),
   83          absolute_file_name(Path,AbsPath),
   84          open(AbsPath).
   85
   86wopen(filetype(Dr:/K.L)):-
   87          filetype(Dr:/K.L),
   88          pathterm_atom(Dr:/K.L,Path),
   89          absolute_file_name(Path,AbsPath),
   90          open(AbsPath).
   91
   92wopen(filetype(K/L)):-
   93          filetype(K/L),
   94          pathterm_atom(K/L,Path),
   95          absolute_file_name(Path,AbsPath),
   96          open(AbsPath).
   97
   98wopen(filetype(K.L)):-
   99          filetype(K.L),
  100          pathterm_atom(K.L,Path),
  101          absolute_file_name(Path,AbsPath),
  102          open(AbsPath)