1:- module(power_shell_get_content, []).    2
    3:- use_module(library(os/apps), []).    4
    5:- multifile os:property_for_app/2.    6
    7os:property_for_app(path(path(powershell)), App) :-
    8    path_options(App, _, _).
    9
   10path_options(power_shell:get_content(Spec, Options), Path, Options) :-
   11    ground(Spec),
   12    absolute_file_name(Spec, Path, [access(read), file_errors(fail)]).
   13
   14os:property_for_app(argument('Get-Content'), App) :-
   15    path_options(App, _, _).
   16
   17%   Important to wrap the Path argument in double quotes for PowerShell,
   18%   even though passed through process_create/3 as a distinct argument.
   19%   Fails without double quotes if the path includes spaces.
   20
   21os:property_for_app(argument(Argument), App) :-
   22    path_options(App, Path0, _),
   23    prolog_to_os_filename(Path0, Path_),
   24    format(atom(Path), '"~s"', [Path_]),
   25    member(Argument, ['-Path', Path]).
   26
   27os:property_for_app(argument(Argument), App) :-
   28    path_options(App, _, Options),
   29    member(Option, Options),
   30    option_argument(Option, Argument).
   31
   32option_argument(tail(_), '-Tail').
   33option_argument(tail(Lines), Lines).
   34option_argument(encoding(_), '-Encoding').
   35option_argument(encoding(Encoding0), Encoding) :-
   36    encoding_argument(Encoding0, Encoding).
   37option_argument(wait, '-Wait').
   38
   39os:property_for_app(option(encoding(Encoding0)), App) :-
   40    path_options(App, _, Options),
   41    member(encoding(Encoding0), Options),
   42    encoding_argument(Encoding0, _).
   43
   44encoding_argument(utf8, 'UTF8')