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