1:- module(wexplorer,[show/2,select/2,open/1]).
    2
    3show(dir,DirText):-
    4    atom(DirText),
    5    text_has_path(DirText,DirPath),
    6    exists_directory(DirPath),
    7    !,
    8    cmd_open_file(DirPath).
    9
   10show(dir,SpecDir):-
   11    absolute_file_name(SpecDir,DirText),
   12    text_has_path(DirText,DirPath),
   13    exists_directory(DirPath),
   14    !,
   15    cmd_open_file(DirPath).
   16
   17select(file,SpecDir):-
   18    absolute_file_name(SpecDir,FileText),
   19    exists_file(FileText),
   20
   21    cmd_select_file(FileText).
   22
   23:- if(current_prolog_flag(unix,true)).
   24open(File):-
   25    atomic_list_concat(['xdg-open ','\"',File,'\"'],Atom),
   26    shell(Atom).
   27
   28cmd_open_file(File):-
   29    current_prolog_flag(unix,true),!,
   30    atomic_list_concat(['xdg-open',File],' ',Atom),
   31    shell(Atom).
   32
   33cmd_select_file(File):-
   34    current_prolog_flag(unix,true),!,
   35    unix_select_file(File).
   36
   37unix_select_file(File):-
   38    absolute_file_name(File,AbsFile),
   39A='dbus-send --session --type=method_call    --dest="org.freedesktop.FileManager1"     "/org/freedesktop/FileManager1"     "org.freedesktop.FileManager1.ShowItems" array:string:"file:////',B=AbsFile,C='" string:""',
   40
   41    atomic_list_concat([A,B,C],Comm),
   42    shell(Comm).
   43
   44
   45:- endif.
   46
   47:- if(current_prolog_flag(windows,true)).
   48
   49open(File):-
   50    win_shell(open,File).
   51
   52cmd_open_file(FilePath):-
   53    prolog_to_os_filename(FilePath,OS),
   54    atomic_list_concat(['explorer','/e',',',OS],' ',Comm),
   55    win_exec(Comm,show).
   56
   57cmd_select_file(FilePath):-
   58    current_prolog_flag(windows,true),!,
   59    prolog_to_os_filename(FilePath,OS),
   60    atomic_list_concat(['explorer','/select',',',OS],' ',Comm),
   61    win_exec(Comm,show).
   62
   63
   64:- endif.
   65
   66
   67text_has_path(A,B):-
   68    atom_concat(A,'/',B),!.
   69
   70text_has_path(A,B):-
   71    atomic_concat(A,'/',B)