View source with formatted 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) 2010-2013, University of Amsterdam,
    7                             VU University
    8    Amsterdam 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(git,
   37          [ git/2,                      % +Argv, +Options
   38            git_process_output/3,       % +Argv, :OnOutput, +Options
   39            git_open_file/4,            % +Dir, +File, +Branch, -Stream
   40            is_git_directory/1,         % +Dir
   41            git_describe/2,             % -Version, +Options
   42            git_hash/2,                 % -Hash, +Options
   43            git_ls_tree/2,              % -Content, +Options
   44            git_remote_url/3,           % +Remote, -URL, +Options
   45            git_ls_remote/3,            % +GitURL, -Refs, +Options
   46            git_branches/2,             % -Branches, +Options
   47            git_remote_branches/2,      % +GitURL, -Branches
   48            git_default_branch/2,       % -DefaultBranch, +Options
   49            git_tags_on_branch/3,       % +Dir, +Branch, -Tags
   50            git_shortlog/3,             % +Dir, -Shortlog, +Options
   51            git_log_data/3,             % +Field, +Record, -Value
   52            git_show/4,                 % +Dir, +Hash, -Commit, +Options
   53            git_commit_data/3           % +Field, +Record, -Value
   54          ]).   55:- use_module(library(process)).   56:- use_module(library(readutil)).   57:- use_module(library(option)).   58:- use_module(library(dcg/basics)).   59:- use_module(library(record)).   60:- use_module(library(lists)).   61:- use_module(library(error)).   62
   63:- meta_predicate
   64    git_process_output(+, 1, +).   65
   66/** <module> Run GIT commands
   67
   68This module performs common GIT tasks by calling git as a remote process
   69through process_create/3. It requires that the =git= executable is in the
   70current PATH.
   71
   72This module started life in ClioPatria and   has been used by the Prolog
   73web-server to provide information on git   repositories. It is now moved
   74into the core Prolog library to support the Prolog package manager.
   75*/
   76
   77:- predicate_options(git/2, 2,
   78                     [ directory(atom),
   79                       error(-codes),
   80                       output(-codes),
   81                       status(-any),
   82                       askpass(any)
   83                     ]).   84:- predicate_options(git_default_branch/2, 2,
   85                     [ pass_to(git_process_output/3, 3)
   86                     ] ).   87:- predicate_options(git_describe/2, 2,
   88                     [ commit(atom),
   89                       directory(atom),
   90                       match(atom)
   91                     ]).   92:- predicate_options(git_hash/2, 2,
   93                     [ commit(atom),
   94                       directory(atom)
   95                     ]).   96:- predicate_options(git_ls_tree/2, 2,
   97                     [ commit(atom),
   98                       directory(atom)
   99                     ]).  100:- predicate_options(git_process_output/3, 3,
  101                     [ directory(atom),
  102                       askpass(any),
  103                       error(-codes)
  104                     ]).  105:- predicate_options(git_remote_url/3, 3,
  106                     [ pass_to(git_process_output/3, 3)
  107                     ]).  108:- predicate_options(git_shortlog/3, 3,
  109                     [ limit(nonneg),
  110                       path(atom)
  111                     ]).  112:- predicate_options(git_show/4, 4,
  113                     [ diff(oneof([patch,stat]))
  114                     ]).  115
  116
  117%!  git(+Argv, +Options) is det.
  118%
  119%   Run a GIT command.  Defined options:
  120%
  121%     * directory(+Dir)
  122%     Execute in the given directory
  123%     * output(-Out)
  124%     Unify Out with a list of codes representing stdout of the
  125%     command.  Otherwise the output is handed to print_message/2
  126%     with level =informational=.
  127%     * error(-Error)
  128%     As output(Out), but messages are printed at level =error=.
  129%     * askpass(+Program)
  130%     Export GIT_ASKPASS=Program
  131
  132git(Argv, Options) :-
  133    option(directory(Dir), Options, .),
  134    env_options(Extra, Options),
  135    setup_call_cleanup(
  136        process_create(path(git), Argv,
  137                       [ stdout(pipe(Out)),
  138                         stderr(pipe(Error)),
  139                         process(PID),
  140                         cwd(Dir)
  141                       | Extra
  142                       ]),
  143        call_cleanup(
  144            ( read_stream_to_codes(Out, OutCodes, []),
  145              read_stream_to_codes(Error, ErrorCodes, [])
  146            ),
  147            process_wait(PID, Status)),
  148        close_streams([Out,Error])),
  149    print_error(ErrorCodes, Options),
  150    print_output(OutCodes, Options),
  151    (   option(status(Status0), Options)
  152    ->  Status = Status0
  153    ;   Status == exit(0)
  154    ->  true
  155    ;   throw(error(process_error(git(Argv), Status), _))
  156    ).
  157
  158env_options([env(['GIT_ASKPASS'=Program])], Options) :-
  159    option(askpass(Exe), Options),
  160    !,
  161    exe_options(ExeOptions),
  162    absolute_file_name(Exe, PlProg, ExeOptions),
  163    prolog_to_os_filename(PlProg, Program).
  164env_options([], _).
  165
  166exe_options(Options) :-
  167    current_prolog_flag(windows, true),
  168    !,
  169    Options = [ extensions(['',exe,com]), access(read) ].
  170exe_options(Options) :-
  171    Options = [ access(execute) ].
  172
  173print_output(OutCodes, Options) :-
  174    option(output(Codes), Options),
  175    !,
  176    Codes = OutCodes.
  177print_output([], _) :- !.
  178print_output(OutCodes, _) :-
  179    print_message(informational, git(output(OutCodes))).
  180
  181print_error(OutCodes, Options) :-
  182    option(error(Codes), Options),
  183    !,
  184    Codes = OutCodes.
  185print_error([], _) :- !.
  186print_error(OutCodes, _) :-
  187    phrase(classify_message(Level), OutCodes, _),
  188    print_message(Level, git(output(OutCodes))).
  189
  190classify_message(error) -->
  191    string(_), "fatal:",
  192    !.
  193classify_message(error) -->
  194    string(_), "error:",
  195    !.
  196classify_message(warning) -->
  197    string(_), "warning:",
  198    !.
  199classify_message(informational) -->
  200    [].
  201
  202%!  close_streams(+Streams:list) is det.
  203%
  204%   Close a list of streams, throwing the first error if some stream
  205%   failed to close.
  206
  207close_streams(List) :-
  208    phrase(close_streams(List), Errors),
  209    (   Errors = [Error|_]
  210    ->  throw(Error)
  211    ;   true
  212    ).
  213
  214close_streams([H|T]) -->
  215    { catch(close(H), E, true) },
  216    (   { var(E) }
  217    ->  []
  218    ;   [E]
  219    ),
  220    close_streams(T).
  221
  222
  223%!  git_process_output(+Argv, :OnOutput, +Options) is det.
  224%
  225%   Run a git-command and process the output with OnOutput, which is
  226%   called as call(OnOutput, Stream).
  227
  228git_process_output(Argv, OnOutput, Options) :-
  229    option(directory(Dir), Options, .),
  230    env_options(Extra, Options),
  231    setup_call_cleanup(
  232        process_create(path(git), Argv,
  233                       [ stdout(pipe(Out)),
  234                         stderr(pipe(Error)),
  235                         process(PID),
  236                         cwd(Dir)
  237                       | Extra
  238                       ]),
  239        call_cleanup(
  240            ( call(OnOutput, Out),
  241              read_stream_to_codes(Error, ErrorCodes, [])
  242            ),
  243            git_wait(PID, Out, Status)),
  244        close_streams([Out,Error])),
  245    print_error(ErrorCodes, Options),
  246    (   Status = exit(0)
  247    ->  true
  248    ;   throw(error(process_error(git, Status)))
  249    ).
  250
  251
  252git_wait(PID, Out, Status) :-
  253    at_end_of_stream(Out),
  254    !,
  255    process_wait(PID, Status).
  256git_wait(PID, Out, Status) :-
  257    setup_call_cleanup(
  258        open_null_stream(Null),
  259        copy_stream_data(Out, Null),
  260        close(Null)),
  261    process_wait(PID, Status).
  262
  263
  264%!  git_open_file(+GitRepoDir, +File, +Branch, -Stream) is det.
  265%
  266%   Open the file File in the given bare GIT repository on the given
  267%   branch (treeisch).
  268%
  269%   @bug    We cannot tell whether opening failed for some reason.
  270
  271git_open_file(Dir, File, Branch, In) :-
  272    atomic_list_concat([Branch, :, File], Ref),
  273    process_create(path(git),
  274                   [ show, Ref ],
  275                   [ stdout(pipe(In)),
  276                     cwd(Dir)
  277                   ]),
  278    set_stream(In, file_name(File)).
  279
  280
  281%!  is_git_directory(+Directory) is semidet.
  282%
  283%   True if Directory is a  git   directory  (Either  checked out or
  284%   bare).
  285
  286is_git_directory(Directory) :-
  287    directory_file_path(Directory, '.git', GitDir),
  288    exists_directory(GitDir),
  289    !.
  290is_git_directory(Directory) :-
  291    exists_directory(Directory),
  292    git(['rev-parse', '--git-dir'],
  293        [ output(Codes),
  294          error(_),
  295          status(Status),
  296          directory(Directory)
  297        ]),
  298    Status == exit(0),
  299    string_codes(".\n", Codes).
  300
  301%!  git_describe(-Version, +Options) is semidet.
  302%
  303%   Describe the running version  based  on   GIT  tags  and hashes.
  304%   Options:
  305%
  306%       * match(+Pattern)
  307%       Only use tags that match Pattern (a Unix glob-pattern; e.g.
  308%       =|V*|=)
  309%       * directory(Dir)
  310%       Provide the version-info for a directory that is part of
  311%       a GIT-repository.
  312%       * commit(+Commit)
  313%       Describe Commit rather than =HEAD=
  314%
  315%   @see git describe
  316
  317git_describe(Version, Options) :-
  318    (   option(match(Pattern), Options)
  319    ->  true
  320    ;   git_version_pattern(Pattern)
  321    ),
  322    (   option(commit(Commit), Options)
  323    ->  Extra = [Commit]
  324    ;   Extra = []
  325    ),
  326    option(directory(Dir), Options, .),
  327    setup_call_cleanup(
  328        process_create(path(git),
  329                       [ 'describe',
  330                         '--match', Pattern
  331                       | Extra
  332                       ],
  333                       [ stdout(pipe(Out)),
  334                         stderr(null),
  335                         process(PID),
  336                         cwd(Dir)
  337                       ]),
  338        call_cleanup(
  339            read_stream_to_codes(Out, V0, []),
  340            git_wait(PID, Out, Status)),
  341        close(Out)),
  342    Status = exit(0),
  343    !,
  344    atom_codes(V1, V0),
  345    normalize_space(atom(Plain), V1),
  346    (   git_is_clean(Dir)
  347    ->  Version = Plain
  348    ;   atom_concat(Plain, '-DIRTY', Version)
  349    ).
  350git_describe(Version, Options) :-
  351    option(directory(Dir), Options, .),
  352    option(commit(Commit), Options, 'HEAD'),
  353    setup_call_cleanup(
  354        process_create(path(git),
  355                       [ 'rev-parse', '--short',
  356                         Commit
  357                       ],
  358                       [ stdout(pipe(Out)),
  359                         stderr(null),
  360                         process(PID),
  361                         cwd(Dir)
  362                       ]),
  363        call_cleanup(
  364            read_stream_to_codes(Out, V0, []),
  365            git_wait(PID, Out, Status)),
  366        close(Out)),
  367    Status = exit(0),
  368    atom_codes(V1, V0),
  369    normalize_space(atom(Plain), V1),
  370    (   git_is_clean(Dir)
  371    ->  Version = Plain
  372    ;   atom_concat(Plain, '-DIRTY', Version)
  373    ).
  374
  375
  376:- multifile
  377    git_version_pattern/1.  378
  379git_version_pattern('V*').
  380git_version_pattern('*').
  381
  382
  383%!  git_is_clean(+Dir) is semidet.
  384%
  385%   True if the given directory is in   a git module and this module
  386%   is clean. To us, clean only   implies that =|git diff|= produces
  387%   no output.
  388
  389git_is_clean(Dir) :-
  390    setup_call_cleanup(process_create(path(git), ['diff', '--stat'],
  391                                      [ stdout(pipe(Out)),
  392                                        stderr(null),
  393                                        cwd(Dir)
  394                                      ]),
  395                       stream_char_count(Out, Count),
  396                       close(Out)),
  397    Count == 0.
  398
  399stream_char_count(Out, Count) :-
  400    setup_call_cleanup(open_null_stream(Null),
  401                       (   copy_stream_data(Out, Null),
  402                           character_count(Null, Count)
  403                       ),
  404                       close(Null)).
  405
  406
  407%!  git_hash(-Hash, +Options) is det.
  408%
  409%   Return the hash of the indicated object.
  410
  411git_hash(Hash, Options) :-
  412    option(commit(Commit), Options, 'HEAD'),
  413    git_process_output(['rev-parse', '--verify', Commit],
  414                       read_hash(Hash),
  415                       Options).
  416
  417read_hash(Hash, Stream) :-
  418    read_line_to_codes(Stream, Line),
  419    atom_codes(Hash, Line).
  420
  421
  422%!  git_ls_tree(-Entries, +Options) is det.
  423%
  424%   True  when  Entries  is  a  list  of  entries  in  the  the  GIT
  425%   repository, Each entry is a term:
  426%
  427%     ==
  428%     object(Mode, Type, Hash, Size, Name)
  429%     ==
  430
  431git_ls_tree(Entries, Options) :-
  432    option(commit(Commit), Options, 'HEAD'),
  433    git_process_output(['ls-tree', '-z', '-r', '-l', Commit],
  434                       read_tree(Entries),
  435                       Options).
  436
  437read_tree(Entries, Stream) :-
  438    read_stream_to_codes(Stream, Codes),
  439    phrase(ls_tree(Entries), Codes).
  440
  441ls_tree([H|T]) -->
  442    ls_entry(H),
  443    !,
  444    ls_tree(T).
  445ls_tree([]) --> [].
  446
  447ls_entry(object(Mode, Type, Hash, Size, Name)) -->
  448    string(MS), " ",
  449    string(TS), " ",
  450    string(HS), " ",
  451    string(SS), "\t",
  452    string(NS), [0],
  453    !,
  454    { number_codes(Mode, [0'0,0'o|MS]),
  455      atom_codes(Type, TS),
  456      atom_codes(Hash, HS),
  457      (   Type == blob
  458      ->  number_codes(Size, SS)
  459      ;   Size = 0          % actually '-', but 0 sums easier
  460      ),
  461      atom_codes(Name, NS)
  462    }.
  463
  464
  465%!  git_remote_url(+Remote, -URL, +Options) is det.
  466%
  467%   URL is the remote (fetch) URL for the given Remote.
  468
  469git_remote_url(Remote, URL, Options) :-
  470    git_process_output([remote, show, Remote],
  471                       read_url("Fetch URL:", URL),
  472                       Options).
  473
  474read_url(Tag, URL, In) :-
  475    repeat,
  476        read_line_to_codes(In, Line),
  477        (   Line == end_of_file
  478        ->  !, fail
  479        ;   phrase(url_codes(Tag, Codes), Line)
  480        ->  !, atom_codes(URL, Codes)
  481        ).
  482
  483url_codes(Tag, Rest) -->
  484    { string_codes(Tag, TagCodes) },
  485    whites, string(TagCodes), whites, string(Rest).
  486
  487
  488%!  git_ls_remote(+GitURL, -Refs, +Options) is det.
  489%
  490%   Execute =|git ls-remote|= against the remote repository to fetch
  491%   references from the remote.  Options processed:
  492%
  493%     * heads(Boolean)
  494%     * tags(Boolean)
  495%     * refs(List)
  496%
  497%   For example, to find the hash of the remote =HEAD=, one can use
  498%
  499%     ==
  500%     ?- git_ls_remote('git://www.swi-prolog.org/home/pl/git/pl-devel.git',
  501%                      Refs, [refs(['HEAD'])]).
  502%     Refs = ['5d596c52aa969d88e7959f86327f5c7ff23695f3'-'HEAD'].
  503%     ==
  504%
  505%   @param Refs is a list of pairs hash-name.
  506
  507git_ls_remote(GitURL, Refs, Options) :-
  508    findall(O, ls_remote_option(Options, O), RemoteOptions),
  509    option(refs(LimitRefs), Options, []),
  510    must_be(list(atom), LimitRefs),
  511    append([ 'ls-remote' | RemoteOptions], [GitURL|LimitRefs], Argv),
  512    git_process_output(Argv, remote_refs(Refs), []).
  513
  514ls_remote_option(Options, '--heads') :-
  515    option(heads(true), Options).
  516ls_remote_option(Options, '--tags') :-
  517    option(tags(true), Options).
  518
  519remote_refs(Refs, Out) :-
  520    read_line_to_codes(Out, Line0),
  521    remote_refs(Line0, Out, Refs).
  522
  523remote_refs(end_of_file, _, []) :- !.
  524remote_refs(Line, Out, [Hash-Ref|Tail]) :-
  525    phrase(remote_ref(Hash,Ref), Line),
  526    read_line_to_codes(Out, Line1),
  527    remote_refs(Line1, Out, Tail).
  528
  529remote_ref(Hash, Ref) -->
  530    string_without("\t ", HashCodes),
  531    whites,
  532    string_without("\t ", RefCodes),
  533    { atom_codes(Hash, HashCodes),
  534      atom_codes(Ref, RefCodes)
  535    }.
  536
  537
  538%!  git_remote_branches(+GitURL, -Branches) is det.
  539%
  540%   Exploit git_ls_remote/3 to fetch  the   branches  from  a remote
  541%   repository without downloading it.
  542
  543git_remote_branches(GitURL, Branches) :-
  544    git_ls_remote(GitURL, Refs, [heads(true)]),
  545    findall(B, (member(_-Head, Refs),
  546                atom_concat('refs/heads/', B, Head)),
  547            Branches).
  548
  549
  550%!  git_default_branch(-BranchName, +Options) is det.
  551%
  552%   True when BranchName is the default branch of a repository.
  553
  554git_default_branch(BranchName, Options) :-
  555    git_process_output([branch],
  556                       read_default_branch(BranchName),
  557                       Options).
  558
  559read_default_branch(BranchName, In) :-
  560    repeat,
  561        read_line_to_codes(In, Line),
  562        (   Line == end_of_file
  563        ->  !, fail
  564        ;   phrase(default_branch(Codes), Line)
  565        ->  !, atom_codes(BranchName, Codes)
  566        ).
  567
  568default_branch(Rest) -->
  569    "*", whites, string(Rest).
  570
  571%!  git_branches(-Branches, +Options) is det.
  572%
  573%   True when Branches is the list of branches in the repository.
  574%   In addition to the usual options, this processes:
  575%
  576%     - contains(Commit)
  577%     Return only branches that contain Commit.
  578
  579git_branches(Branches, Options) :-
  580    (   select_option(commit(Commit), Options, GitOptions)
  581    ->  Extra = ['--contains', Commit]
  582    ;   Extra = [],
  583        GitOptions = Options
  584    ),
  585    git_process_output([branch|Extra],
  586                       read_branches(Branches),
  587                       GitOptions).
  588
  589read_branches(Branches, In) :-
  590    read_line_to_codes(In, Line),
  591    (   Line == end_of_file
  592    ->  Branches = []
  593    ;   Line = [_,_|Codes],
  594        atom_codes(H, Codes),
  595        Branches = [H|T],
  596        read_branches(T, In)
  597    ).
  598
  599
  600%!  git_tags_on_branch(+Dir, +Branch, -Tags) is det.
  601%
  602%   Tags is a list of tags in Branch on the GIT repository Dir, most
  603%   recent tag first.
  604%
  605%   @see Git tricks at http://mislav.uniqpath.com/2010/07/git-tips/
  606
  607git_tags_on_branch(Dir, Branch, Tags) :-
  608    git_process_output([ log, '--oneline', '--decorate', Branch ],
  609                       log_to_tags(Tags),
  610                       [ directory(Dir) ]).
  611
  612log_to_tags(Tags, Out) :-
  613    read_line_to_codes(Out, Line0),
  614    log_to_tags(Line0, Out, Tags, []).
  615
  616log_to_tags(end_of_file, _, Tags, Tags) :- !.
  617log_to_tags(Line, Out, Tags, Tail) :-
  618    phrase(tags_on_line(Tags, Tail1), Line),
  619    read_line_to_codes(Out, Line1),
  620    log_to_tags(Line1, Out, Tail1, Tail).
  621
  622tags_on_line(Tags, Tail) -->
  623    string_without(" ", _Hash),
  624    tags(Tags, Tail),
  625    skip_rest.
  626
  627tags(Tags, Tail) -->
  628    whites,
  629    "(",
  630    tag_list(Tags, Rest),
  631    !,
  632    tags(Rest, Tail).
  633tags(Tags, Tags) -->
  634    skip_rest.
  635
  636tag_list([H|T], Rest) -->
  637    "tag:", !, whites,
  638    string(Codes),
  639    (   ")"
  640    ->  { atom_codes(H, Codes),
  641          T = Rest
  642        }
  643    ;   ","
  644    ->  { atom_codes(H, Codes)
  645        },
  646        whites,
  647        tag_list(T, Rest)
  648    ).
  649tag_list(List, Rest) -->
  650    string(_),
  651    (   ")"
  652    ->  { List = Rest }
  653    ;   ","
  654    ->  whites,
  655        tag_list(List, Rest)
  656    ).
  657
  658skip_rest(_,_).
  659
  660
  661                 /*******************************
  662                 *        READ GIT HISTORY      *
  663                 *******************************/
  664
  665%!  git_shortlog(+Dir, -ShortLog, +Options) is det.
  666%
  667%   Fetch information like the  GitWeb   change  overview. Processed
  668%   options:
  669%
  670%       * limit(+Count)
  671%       Maximum number of commits to show (default is 10)
  672%       * path(+Path)
  673%       Only show commits that affect Path.  Path is the path of
  674%       a checked out file.
  675%       * git_path(+Path)
  676%       Similar to =path=, but Path is relative to the repository.
  677%
  678%   @param ShortLog is a list of =git_log= records.
  679
  680:- record
  681    git_log(commit_hash:atom,
  682            author_name:atom,
  683            author_date_relative:atom,
  684            committer_name:atom,
  685            committer_date_relative:atom,
  686            committer_date_unix,
  687            subject:atom,
  688            ref_names:list).  689
  690git_shortlog(Dir, ShortLog, Options) :-
  691    option(limit(Limit), Options, 10),
  692    (   option(git_path(Path), Options)
  693    ->  Extra = ['--', Path]
  694    ;   option(path(Path), Options)
  695    ->  relative_file_name(Path, Dir, RelPath),
  696        Extra = ['--', RelPath]
  697    ;   Extra = []
  698    ),
  699    git_format_string(git_log, Fields, Format),
  700    git_process_output([ log, '-n', Limit, Format
  701                       | Extra
  702                       ],
  703                       read_git_formatted(git_log, Fields, ShortLog),
  704                       [directory(Dir)]).
  705
  706
  707read_git_formatted(Record, Fields, ShortLog, In) :-
  708    read_line_to_codes(In, Line0),
  709    read_git_formatted(Line0, In, Record, Fields, ShortLog).
  710
  711read_git_formatted(end_of_file, _, _, _, []) :- !.
  712read_git_formatted(Line, In, Record, Fields, [H|T]) :-
  713    record_from_line(Record, Fields, Line, H),
  714    read_line_to_codes(In, Line1),
  715    read_git_formatted(Line1, In, Record, Fields, T).
  716
  717record_from_line(RecordName, Fields, Line, Record) :-
  718    phrase(fields_from_line(Fields, Values), Line),
  719    Record =.. [RecordName|Values].
  720
  721fields_from_line([], []) --> [].
  722fields_from_line([F|FT], [V|VT]) -->
  723    to_nul_s(Codes),
  724    { field_to_prolog(F, Codes, V) },
  725    fields_from_line(FT, VT).
  726
  727to_nul_s([]) --> [0], !.
  728to_nul_s([H|T]) --> [H], to_nul_s(T).
  729
  730field_to_prolog(ref_names, Line, List) :-
  731    phrase(ref_names(List), Line),
  732    !.
  733field_to_prolog(_, Line, Atom) :-
  734    atom_codes(Atom, Line).
  735
  736ref_names([]) --> [].
  737ref_names(List) -->
  738    blanks, "(", ref_name_list(List), ")".
  739
  740ref_name_list([H|T]) -->
  741    string_without(",)", Codes),
  742    { atom_codes(H, Codes) },
  743    (   ",", blanks
  744    ->  ref_name_list(T)
  745    ;   {T=[]}
  746    ).
  747
  748
  749%!  git_show(+Dir, +Hash, -Commit, +Options) is det.
  750%
  751%   Fetch info from a GIT commit.  Options processed:
  752%
  753%     * diff(Diff)
  754%     GIT option on how to format diffs.  E.g. =stat=
  755%     * max_lines(Count)
  756%     Truncate the body at Count lines.
  757%
  758%   @param  Commit is a term git_commit(...)-Body.  Body is currently
  759%           a list of lines, each line represented as a list of
  760%           codes.
  761
  762:- record
  763    git_commit(tree_hash:atom,
  764               parent_hashes:list,
  765               author_name:atom,
  766               author_date:atom,
  767               committer_name:atom,
  768               committer_date:atom,
  769               subject:atom).  770
  771git_show(Dir, Hash, Commit, Options) :-
  772    git_format_string(git_commit, Fields, Format),
  773    option(diff(Diff), Options, patch),
  774    diff_arg(Diff, DiffArg),
  775    git_process_output([ show, DiffArg, Hash, Format ],
  776                       read_commit(Fields, Commit, Options),
  777                       [directory(Dir)]).
  778
  779diff_arg(patch, '-p').
  780diff_arg(stat, '--stat').
  781
  782read_commit(Fields, Data-Body, Options, In) :-
  783    read_line_to_codes(In, Line1),
  784    record_from_line(git_commit, Fields, Line1, Data),
  785    read_line_to_codes(In, Line2),
  786    (   Line2 == []
  787    ->  option(max_lines(Max), Options, -1),
  788        read_n_lines(In, Max, Body)
  789    ;   Line2 == end_of_file
  790    ->  Body = []
  791    ).
  792
  793read_n_lines(In, Max, Lines) :-
  794    read_line_to_codes(In, Line1),
  795    read_n_lines(Line1, Max, In, Lines).
  796
  797read_n_lines(end_of_file, _, _, []) :- !.
  798read_n_lines(_, 0, In, []) :-
  799    !,
  800    setup_call_cleanup(open_null_stream(Out),
  801                       copy_stream_data(In, Out),
  802                       close(Out)).
  803read_n_lines(Line, Max0, In, [Line|More]) :-
  804    read_line_to_codes(In, Line2),
  805    Max is Max0-1,
  806    read_n_lines(Line2, Max, In, More).
  807
  808
  809%!  git_format_string(:Record, -FieldNames, -Format)
  810%
  811%   If Record is a record with  fields   whose  names  match the GIT
  812%   format field-names, Format is a  git =|--format=|= argument with
  813%   the appropriate format-specifiers,  terminated   by  %x00, which
  814%   causes the actual field to be 0-terminated.
  815
  816:- meta_predicate
  817    git_format_string(:, -, -).  818
  819git_format_string(M:RecordName, Fields, Format) :-
  820    current_record(RecordName, M:Term),
  821    findall(F, record_field(Term, F), Fields),
  822    maplist(git_field_format, Fields, Formats),
  823    atomic_list_concat(['--format='|Formats], Format).
  824
  825record_field(Term, Name) :-
  826    arg(_, Term, Field),
  827    field_name(Field, Name).
  828
  829field_name(Name:_Type=_Default, Name) :- !.
  830field_name(Name:_Type, Name) :- !.
  831field_name(Name=_Default, Name) :- !.
  832field_name(Name, Name).
  833
  834git_field_format(Field, Fmt) :-
  835    (   git_format(NoPercent, Field)
  836    ->  atomic_list_concat(['%', NoPercent, '%x00'], Fmt)
  837    ;   existence_error(git_format, Field)
  838    ).
  839
  840git_format('H', commit_hash).
  841git_format('h', abbreviated_commit_hash).
  842git_format('T', tree_hash).
  843git_format('t', abbreviated_tree_hash).
  844git_format('P', parent_hashes).
  845git_format('p', abbreviated_parent_hashes).
  846
  847git_format('an', author_name).
  848git_format('aN', author_name_mailcap).
  849git_format('ae', author_email).
  850git_format('aE', author_email_mailcap).
  851git_format('ad', author_date).
  852git_format('aD', author_date_rfc2822).
  853git_format('ar', author_date_relative).
  854git_format('at', author_date_unix).
  855git_format('ai', author_date_iso8601).
  856
  857git_format('cn', committer_name).
  858git_format('cN', committer_name_mailcap).
  859git_format('ce', committer_email).
  860git_format('cE', committer_email_mailcap).
  861git_format('cd', committer_date).
  862git_format('cD', committer_date_rfc2822).
  863git_format('cr', committer_date_relative).
  864git_format('ct', committer_date_unix).
  865git_format('ci', committer_date_iso8601).
  866
  867git_format('d', ref_names).             % git log?
  868git_format('e', encoding).              % git log?
  869
  870git_format('s', subject).
  871git_format('f', subject_sanitized).
  872git_format('b', body).
  873git_format('N', notes).
  874
  875git_format('gD', reflog_selector).
  876git_format('gd', shortened_reflog_selector).
  877git_format('gs', reflog_subject).
  878
  879
  880                 /*******************************
  881                 *            MESSAGES          *
  882                 *******************************/
  883
  884:- multifile
  885    prolog:message//1.  886
  887prolog:message(git(output(Codes))) -->
  888    { split_lines(Codes, Lines) },
  889    git_lines(Lines).
  890
  891git_lines([]) --> [].
  892git_lines([H|T]) -->
  893    [ '~s'-[H] ],
  894    (   {T==[]}
  895    ->  []
  896    ;   [nl], git_lines(T)
  897    ).
  898
  899split_lines([], []) :- !.
  900split_lines(All, [Line1|More]) :-
  901    append(Line1, [0'\n|Rest], All),
  902    !,
  903    split_lines(Rest, More).
  904split_lines(Line, [Line])