View source with raw comments or as raw
   1/*  Part of SWI-Prolog
   2
   3    Author:        Jan Wielemaker
   4    E-mail:        J.Wielemaker@vu.nl
   5    WWW:           http://www.swi-prolog.org
   6    Copyright (c)  1985-2014, University of Amsterdam
   7                              VU University Amsterdam
   8    All rights reserved.
   9
  10    Redistribution and use in source and binary forms, with or without
  11    modification, are permitted provided that the following conditions
  12    are met:
  13
  14    1. Redistributions of source code must retain the above copyright
  15       notice, this list of conditions and the following disclaimer.
  16
  17    2. Redistributions in binary form must reproduce the above copyright
  18       notice, this list of conditions and the following disclaimer in
  19       the documentation and/or other materials provided with the
  20       distribution.
  21
  22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
  28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
  32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  33    POSSIBILITY OF SUCH DAMAGE.
  34*/
  35
  36:- module(shell,
  37          [ shell/0,
  38            ls/0,
  39            ls/1,                               % +Pattern
  40            cd/0,
  41            cd/1,                               % +Dir
  42            pushd/0,
  43            pushd/1,                            % +Dir
  44            dirs/0,
  45            pwd/0,
  46            popd/0,
  47            mv/2,                               % +File1, +File2
  48            rm/1                                % +File1
  49          ]).
  50:- use_module(library(lists), [nth1/3]).
  51:- use_module(library(error)).
  52:- use_module(library(apply)).
  53:- set_prolog_flag(generate_debug_info, false).
  54
  55/** <module>  Elementary shell commands
  56
  57This library provides some basic  shell   commands  from Prolog, such as
  58=pwd=, =ls= for situations where there  is   no  shell  available or the
  59shell output cannot be captured.
  60
  61It is developed on the ST-MINIX version.   MINIX  did not have a vfork()
  62call, and thus only allows shell/[0,1,2] if   Prolog uses less than half
  63the amount of available memory.
  64*/
  65
  66%!  shell
  67%
  68%   Execute an interactive shell. The executed   shell is defined by
  69%   the environment =SHELL= or =comspec=   (Windows).  If neither is
  70%   defined, =|/bin/sh|= is used.
  71
  72shell :-
  73    getenv('SHELL', Shell),        % Unix, also Cygwin
  74    !,
  75    shell(Shell).
  76shell :-
  77    getenv(comspec, ComSpec),      % Windows
  78    !,
  79    shell(ComSpec).
  80shell :-
  81    shell('/bin/sh').
  82
  83%!  cd.
  84%!  cd(Dir).
  85%
  86%   Change working directory
  87
  88cd :-
  89    cd(~).
  90
  91cd(Dir) :-
  92    name_to_file(Dir, Name),
  93    working_directory(_, Name).
  94
  95%!  pushd.
  96%!  pushd(+Dir).
  97%!  popd.
  98%!  dirs.
  99%
 100%   Manage the _directory stack_:
 101%
 102%     - pushd/1 is as cd/1, pushing th old directory on a stack
 103%     - pushd/0 swaps the current directory with the top of the
 104%       stack
 105%     - popd/0 pops to the top of the stack
 106%     - dirs/0 lists the current directory and the stack.
 107
 108:- dynamic
 109    stack/1.
 110
 111pushd :-
 112    pushd(+1).
 113
 114pushd(N) :-
 115    integer(N),
 116    !,
 117    findall(D, stack(D), Ds),
 118    (   nth1(N, Ds, Go),
 119        retract(stack(Go))
 120    ->  pushd(Go),
 121        print_message(information, shell(directory(Go)))
 122    ;   warning('Directory stack not that deep', []),
 123        fail
 124    ).
 125pushd(Dir) :-
 126    name_to_file(Dir, Name),
 127    working_directory(Old, Name),
 128    asserta(stack(Old)).
 129
 130popd :-
 131    retract(stack(Dir)),
 132    !,
 133    working_directory(_, Dir),
 134    print_message(information, shell(directory(Dir))).
 135popd :-
 136    warning('Directory stack empty', []),
 137    fail.
 138
 139dirs :-
 140    working_directory(WD, WD),
 141    findall(D, stack(D), Dirs),
 142    maplist(dir_name, [WD|Dirs], Results),
 143    print_message(information, shell(file_set(Results))).
 144
 145%!  pwd
 146%
 147%   Print current working directory
 148
 149pwd :-
 150    working_directory(WD, WD),
 151    print_message(information, format('~w', [WD])).
 152
 153dir_name('/', '/') :- !.
 154dir_name(Path, Name) :-
 155    atom_concat(P, /, Path),
 156    !,
 157    dir_name(P, Name).
 158dir_name(Path, Name) :-
 159    current_prolog_flag(unix, true),
 160    expand_file_name('~', [Home0]),
 161    (   atom_concat(Home, /, Home0)
 162    ->  true
 163    ;   Home = Home0
 164    ),
 165    atom_concat(Home, FromHome, Path),
 166    !,
 167    atom_concat('~', FromHome, Name).
 168dir_name(Path, Path).
 169
 170%!  ls.
 171%!  ls(+Pattern).
 172%
 173%   Listing similar to Unix =ls -F=, flagging directories with =/=.
 174
 175ls :-
 176    ls('.').
 177
 178ls(Spec) :-
 179    name_to_files(Spec, Matches),
 180    ls_(Matches).
 181
 182ls_([]) :-
 183    !,
 184    warning('No Match', []).
 185ls_([Dir]) :-
 186    exists_directory(Dir),
 187    !,
 188    atom_concat(Dir, '/*', Pattern),
 189    expand_file_name(Pattern, Files),
 190    maplist(tagged_file_in_dir, Files, Results),
 191    print_message(information, shell(file_set(Results))).
 192ls_(Files) :-
 193    maplist(tag_file, Files, Results),
 194    print_message(information, shell(file_set(Results))).
 195
 196tagged_file_in_dir(File, Result) :-
 197    file_base_name(File, Base),
 198    (   exists_directory(File)
 199    ->  atom_concat(Base, /, Result)
 200    ;   Result = Base
 201    ).
 202
 203tag_file(File, Dir) :-
 204    exists_directory(File),
 205    !,
 206    atom_concat(File, /, Dir).
 207tag_file(File, File).
 208
 209%!  mv(+From, +To) is det.
 210%
 211%   Move (Rename) a file. If To is   a directory, From is moved into
 212%   the directory.
 213
 214mv(From, To) :-
 215    name_to_files(From, Src),
 216    name_to_file(To, Dest),
 217    mv_(Src, Dest).
 218
 219mv_([One], Dest) :-
 220    \+ exists_directory(Dest),
 221    !,
 222    rename_file(One, Dest).
 223mv_(Multi, Dest) :-
 224    (   exists_directory(Dest)
 225    ->  maplist(mv_to_dir(Dest), Multi)
 226    ;   print_message(warning, format('Not a directory: ~w', [Dest])),
 227        fail
 228    ).
 229
 230mv_to_dir(Dest, Src) :-
 231    file_base_name(Src, Name),
 232    atomic_list_concat([Dest, Name], /, Target),
 233    rename_file(Src, Target).
 234
 235%!  rm(+File) is det.
 236%
 237%   Remove (unlink) a file
 238
 239rm(File) :-
 240    name_to_file(File, A),
 241    delete_file(A).
 242
 243
 244%!  name_to_file(+Name, -File)
 245%
 246%   Convert Name into a single file.
 247
 248name_to_file(Spec, File) :-
 249    name_to_files(Spec, Files),
 250    (   Files = [File]
 251    ->  true
 252    ;   print_message(warning, format('Ambiguous: ~w', [Spec])),
 253        fail
 254    ).
 255
 256name_to_files(Spec, Files) :-
 257    name_to_files_(Spec, Files),
 258    (   Files == []
 259    ->  print_message(warning, format('No match: ~w', [Spec])),
 260        fail
 261    ;   true
 262    ).
 263
 264name_to_files_(Spec, Files) :-
 265    compound(Spec),
 266    compound_name_arity(Spec, _Alias, 1),
 267    !,
 268    findall(File,
 269            (   absolute_file_name(Spec, File,
 270                                   [ access(exist),
 271                                     file_type(directory),
 272                                     file_errors(fail),
 273                                     solutions(all)
 274                                   ])
 275            ;   absolute_file_name(Spec, File,
 276                                   [ access(exist),
 277                                     file_errors(fail),
 278                                     solutions(all)
 279                                   ])
 280            ),
 281            Files).
 282name_to_files_(Spec, Files) :-
 283    (   atomic(Spec)
 284    ->  S1 = Spec
 285    ;   phrase(segments(Spec), L),
 286        atomic_list_concat(L, /, S1)
 287    ),
 288    expand_file_name(S1, Files0),
 289    (   Files0 == [S1],
 290        \+ access_file(S1, exist)
 291    ->  warning('"~w" does not exist', [S1]),
 292        fail
 293    ;   Files = Files0
 294    ).
 295
 296segments(Var) -->
 297    { var(Var),
 298      !,
 299      instantiation_error(Var)
 300    }.
 301segments(A/B) -->
 302    !,
 303    segments(A),
 304    segments(B).
 305segments(A) -->
 306    { must_be(atomic, A) },
 307    [ A ].
 308
 309%!  warning(+Fmt, +Args:list) is det.
 310
 311warning(Fmt, Args) :-
 312    print_message(warning, format(Fmt, Args)).
 313
 314:- multifile prolog:message//1.
 315
 316prolog:message(shell(file_set(Files))) -->
 317    { catch(tty_size(_, Width), _, Width = 80)
 318    },
 319    table(Files, Width).
 320prolog:message(shell(directory(Path))) -->
 321    { dir_name(Path, Name) },
 322    [ '~w'-[Name] ].
 323
 324%!  table(+List, +Width)//
 325%
 326%   Produce a tabular layout to list all   elements of List on lines
 327%   with a maximum width of Width. Elements are placed as =ls= does:
 328%
 329%      ==
 330%      1  4  7
 331%      2  5  8
 332%      3  6
 333%      ==
 334
 335table(List, Width) -->
 336    { table_layout(List, Width, Layout),
 337      compound_name_arguments(Array, a, List)
 338    },
 339    table(0, Array, Layout).
 340
 341table(I, Array, Layout) -->
 342    { Cols = Layout.cols,
 343      Index is I // Cols + (I mod Cols) * Layout.rows + 1,
 344      (   (I+1) mod Cols =:= 0
 345      ->  NL = true
 346      ;   NL = false
 347      )
 348    },
 349    (   { arg(Index, Array, Atom) }
 350    ->  (   { NL == false }
 351        ->  [ '~|~w~t~*+'-[Atom, Layout.col_width] ]
 352        ;   [ '~w'-[Atom] ]
 353        )
 354    ;   []
 355    ),
 356    (   { I2 is I+1,
 357          I2 < Cols*Layout.rows
 358        }
 359    ->  (   { NL == true }
 360        ->  [ nl ]
 361        ;   []
 362        ),
 363        table(I2, Array, Layout)
 364    ;   []
 365    ).
 366
 367table_layout(Atoms, Width, _{cols:Cols, rows:Rows, col_width:ColWidth}) :-
 368    length(Atoms, L),
 369    longest(Atoms, Longest),
 370    Cols is max(1, Width // (Longest + 3)),
 371    Rows is integer(L / Cols + 0.49999),    % should be ceil/1
 372    ColWidth is Width // Cols.
 373
 374longest(List, Longest) :-
 375    longest(List, 0, Longest).
 376
 377longest([], M, M) :- !.
 378longest([H|T], Sofar, M) :-
 379    atom_length(H, L),
 380    L >= Sofar,
 381    !,
 382    longest(T, L, M).
 383longest([_|T], S, M) :-
 384    longest(T, S, M).