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) 2010-2023, University of Amsterdam,
    7                             VU University
    8                             SWI-Prolog Solutions b.v.
    9    Amsterdam All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(git,
   38          [ git/2,                      % +Argv, +Options
   39            git_process_output/3,       % +Argv, :OnOutput, +Options
   40            git_open_file/4,            % +Dir, +File, +Branch, -Stream
   41            is_git_directory/1,         % +Dir
   42            git_describe/2,             % -Version, +Options
   43            git_hash/2,                 % -Hash, +Options
   44            git_ls_tree/2,              % -Content, +Options
   45            git_remote_url/3,           % +Remote, -URL, +Options
   46            git_ls_remote/3,            % +GitURL, -Refs, +Options
   47            git_branches/2,             % -Branches, +Options
   48            git_remote_branches/2,      % +GitURL, -Branches
   49            git_default_branch/2,       % -DefaultBranch, +Options
   50            git_current_branch/2,       % -CurrentBranch, +Options
   51            git_tags/2,                 % -Tags, +Options
   52            git_tags_on_branch/3,       % +Dir, +Branch, -Tags
   53            git_shortlog/3,             % +Dir, -Shortlog, +Options
   54            git_log_data/3,             % +Field, +Record, -Value
   55            git_show/4,                 % +Dir, +Hash, -Commit, +Options
   56            git_commit_data/3,          % +Field, +Record, -Value
   57            is_git_hash/1               % +Atom
   58          ]).   59:- use_module(library(record),[(record)/1,current_record/2, op(_,_,record)]).   60
   61:- autoload(library(apply),[maplist/3]).   62:- autoload(library(error),[must_be/2,existence_error/2]).   63:- autoload(library(filesex),
   64	    [directory_file_path/3,relative_file_name/3]).   65:- autoload(library(lists),[append/3,member/2,append/2]).   66:- autoload(library(option),[option/2,option/3,select_option/3]).   67:- autoload(library(process),[process_create/3,process_wait/2]).   68:- autoload(library(readutil),
   69	    [ read_stream_to_codes/3,
   70	      read_line_to_codes/2,
   71	      read_stream_to_codes/2
   72	    ]).   73:- autoload(library(dcg/basics),
   74	    [string//1,whites//0,string_without//2,blanks//0]).   75
   76
   77:- meta_predicate
   78    git_process_output(+, 1, +).

Run GIT commands

This module performs common GIT tasks by calling git as a remote process through process_create/3. It requires that the git executable is in the current PATH.

This module started life in ClioPatria and has been used by the Prolog web-server to provide information on git repositories. It is now moved into the core Prolog library to support the Prolog package manager. */

   91:- predicate_options(git/2, 2,
   92                     [ directory(atom),
   93                       error(-codes),
   94                       output(-codes),
   95                       status(-any),
   96                       askpass(any)
   97                     ]).   98:- predicate_options(git_default_branch/2, 2,
   99                     [ pass_to(git_process_output/3, 3)
  100                     ] ).  101:- predicate_options(git_describe/2, 2,
  102                     [ commit(atom),
  103                       directory(atom),
  104                       match(atom)
  105                     ]).  106:- predicate_options(git_hash/2, 2,
  107                     [ commit(atom),
  108                       directory(atom),
  109                       pass_to(git_process_output/3, 3)
  110                     ]).  111:- predicate_options(git_ls_tree/2, 2,
  112                     [ commit(atom),
  113                       directory(atom)
  114                     ]).  115:- predicate_options(git_process_output/3, 3,
  116                     [ directory(atom),
  117                       askpass(any),
  118                       error(-codes),
  119                       status(-integer)
  120                     ]).  121:- predicate_options(git_remote_url/3, 3,
  122                     [ pass_to(git_process_output/3, 3)
  123                     ]).  124:- predicate_options(git_shortlog/3, 3,
  125                     [ revisions(atom),
  126                       limit(nonneg),
  127                       path(atom)
  128                     ]).  129:- predicate_options(git_show/4, 4,
  130                     [ diff(oneof([patch,stat]))
  131                     ]).
 git(+Argv, +Options) is det
Run a GIT command. Defined options:
directory(+Dir)
Execute in the given directory
output(-Out)
Unify Out with a list of codes representing stdout of the command. Otherwise the output is handed to print_message/2 with level informational.
error(-Error)
As output(Out), but messages are printed at level error.
askpass(+Program)
Export GIT_ASKPASS=Program
  149git(Argv, Options) :-
  150    git_cwd_options(Argv, Argv1, Options),
  151    env_options(Extra, Options),
  152    setup_call_cleanup(
  153        process_create(path(git), Argv1,
  154                       [ stdout(pipe(Out)),
  155                         stderr(pipe(Error)),
  156                         process(PID)
  157                       | Extra
  158                       ]),
  159        call_cleanup(
  160            ( read_stream_to_codes(Out, OutCodes, []),
  161              read_stream_to_codes(Error, ErrorCodes, [])
  162            ),
  163            process_wait(PID, Status)),
  164        close_streams([Out,Error])),
  165    print_error(ErrorCodes, Options),
  166    print_output(OutCodes, Options),
  167    (   option(status(Status0), Options)
  168    ->  Status = Status0
  169    ;   Status == exit(0)
  170    ->  true
  171    ;   throw(error(process_error(git(Argv), Status), _))
  172    ).
  173
  174git_cwd_options(Argv0, Argv, Options) :-
  175    option(directory(Dir), Options),
  176    !,
  177    Argv = ['-C', file(Dir) | Argv0 ].
  178git_cwd_options(Argv, Argv, _).
  179
  180env_options([env(['GIT_ASKPASS'=Program])], Options) :-
  181    option(askpass(Exe), Options),
  182    !,
  183    exe_options(ExeOptions),
  184    absolute_file_name(Exe, PlProg, ExeOptions),
  185    prolog_to_os_filename(PlProg, Program).
  186env_options([], _).
  187
  188exe_options(Options) :-
  189    current_prolog_flag(windows, true),
  190    !,
  191    Options = [ extensions(['',exe,com]), access(read) ].
  192exe_options(Options) :-
  193    Options = [ access(execute) ].
  194
  195print_output(OutCodes, Options) :-
  196    option(output(Codes), Options),
  197    !,
  198    Codes = OutCodes.
  199print_output([], _) :- !.
  200print_output(OutCodes, _) :-
  201    print_message(informational, git(output(OutCodes))).
  202
  203print_error(OutCodes, Options) :-
  204    option(error(Codes), Options),
  205    !,
  206    Codes = OutCodes.
  207print_error([], _) :- !.
  208print_error(OutCodes, _) :-
  209    phrase(classify_message(Level), OutCodes, _),
  210    print_message(Level, git(output(OutCodes))).
  211
  212classify_message(error) -->
  213    string(_), "fatal:",
  214    !.
  215classify_message(error) -->
  216    string(_), "error:",
  217    !.
  218classify_message(warning) -->
  219    string(_), "warning:",
  220    !.
  221classify_message(informational) -->
  222    [].
 close_streams(+Streams:list) is det
Close a list of streams, throwing the first error if some stream failed to close.
  229close_streams(List) :-
  230    phrase(close_streams(List), Errors),
  231    (   Errors = [Error|_]
  232    ->  throw(Error)
  233    ;   true
  234    ).
  235
  236close_streams([H|T]) -->
  237    { catch(close(H), E, true) },
  238    (   { var(E) }
  239    ->  []
  240    ;   [E]
  241    ),
  242    close_streams(T).
 git_process_output(+Argv, :OnOutput, +Options) is det
Run a git-command and process the output with OnOutput, which is called as call(OnOutput, Stream).
  250git_process_output(Argv, OnOutput, Options) :-
  251    git_cwd_options(Argv, Argv1, Options),
  252    env_options(Extra, Options),
  253    setup_call_cleanup(
  254        process_create(path(git), Argv1,
  255                       [ stdout(pipe(Out)),
  256                         stderr(pipe(Error)),
  257                         process(PID)
  258                       | Extra
  259                       ]),
  260        call_cleanup(
  261            ( call(OnOutput, Out),
  262              read_stream_to_codes(Error, ErrorCodes, [])
  263            ),
  264            git_wait(PID, Out, Status)),
  265        close_streams([Out,Error])),
  266    print_error(ErrorCodes, Options),
  267    (   option(status(Status), Options)
  268    ->  true
  269    ;   Status = exit(0)
  270    ->  true
  271    ;   throw(error(process_error(git, Status)))
  272    ).
  273
  274git_wait(PID, Out, Status) :-
  275    at_end_of_stream(Out),
  276    !,
  277    process_wait(PID, Status).
  278git_wait(PID, Out, Status) :-
  279    setup_call_cleanup(
  280        open_null_stream(Null),
  281        copy_stream_data(Out, Null),
  282        close(Null)),
  283    process_wait(PID, Status).
 git_open_file(+GitRepoDir, +File, +Branch, -Stream) is det
Open the file File in the given bare GIT repository on the given branch (treeisch).
bug
- We cannot tell whether opening failed for some reason.
  293git_open_file(Dir, File, Branch, In) :-
  294    atomic_list_concat([Branch, :, File], Ref),
  295    process_create(path(git),
  296                   [ '-C', file(Dir), show, Ref ],
  297                   [ stdout(pipe(In))
  298                   ]),
  299    set_stream(In, file_name(File)).
 is_git_directory(+Directory) is semidet
True if Directory is a git directory (Either checked out or bare).
  307is_git_directory(Directory) :-
  308    directory_file_path(Directory, '.git', GitDir),
  309    exists_directory(GitDir),
  310    !.
  311is_git_directory(Directory) :-
  312    exists_directory(Directory),
  313    git(['rev-parse', '--git-dir'],
  314        [ output(Codes),
  315          error(_),
  316          status(Status),
  317          directory(Directory)
  318        ]),
  319    Status == exit(0),
  320    string_codes(GitDir0, Codes),
  321    split_string(GitDir0, "", " \n", [GitDir]),
  322    sub_string(GitDir, B, _, A, "/.git/modules/"),
  323    !,
  324    sub_string(GitDir, 0, B, _, Main),
  325    sub_string(GitDir, _, A, 0, Below),
  326    directory_file_path(Main, Below, Dir),
  327    same_file(Dir, Directory).
 git_describe(-Version, +Options) is semidet
Describe the running version based on GIT tags and hashes. Options:
match(+Pattern)
Only use tags that match Pattern (a Unix glob-pattern; e.g. V*)
directory(Dir)
Provide the version-info for a directory that is part of a GIT-repository.
commit(+Commit)
Describe Commit rather than HEAD
See also
- git describe
  345git_describe(Version, Options) :-
  346    (   option(match(Pattern), Options)
  347    ->  true
  348    ;   git_version_pattern(Pattern)
  349    ),
  350    (   option(commit(Commit), Options)
  351    ->  Extra = [Commit]
  352    ;   Extra = []
  353    ),
  354    option(directory(Dir), Options, .),
  355    setup_call_cleanup(
  356        process_create(path(git),
  357                       [ 'describe',
  358                         '--match', Pattern
  359                       | Extra
  360                       ],
  361                       [ stdout(pipe(Out)),
  362                         stderr(null),
  363                         process(PID),
  364                         cwd(Dir)
  365                       ]),
  366        call_cleanup(
  367            read_stream_to_codes(Out, V0, []),
  368            git_wait(PID, Out, Status)),
  369        close(Out)),
  370    Status = exit(0),
  371    !,
  372    atom_codes(V1, V0),
  373    normalize_space(atom(Plain), V1),
  374    (   git_is_clean(Dir)
  375    ->  Version = Plain
  376    ;   atom_concat(Plain, '-DIRTY', Version)
  377    ).
  378git_describe(Version, Options) :-
  379    option(directory(Dir), Options, .),
  380    option(commit(Commit), Options, 'HEAD'),
  381    setup_call_cleanup(
  382        process_create(path(git),
  383                       [ 'rev-parse', '--short',
  384                         Commit
  385                       ],
  386                       [ stdout(pipe(Out)),
  387                         stderr(null),
  388                         process(PID),
  389                         cwd(Dir)
  390                       ]),
  391        call_cleanup(
  392            read_stream_to_codes(Out, V0, []),
  393            git_wait(PID, Out, Status)),
  394        close(Out)),
  395    Status = exit(0),
  396    atom_codes(V1, V0),
  397    normalize_space(atom(Plain), V1),
  398    (   git_is_clean(Dir)
  399    ->  Version = Plain
  400    ;   atom_concat(Plain, '-DIRTY', Version)
  401    ).
  402
  403
  404:- multifile
  405    git_version_pattern/1.  406
  407git_version_pattern('V*').
  408git_version_pattern('*').
 git_is_clean(+Dir) is semidet
True if the given directory is in a git module and this module is clean. To us, clean only implies that git diff produces no output.
  417git_is_clean(Dir) :-
  418    setup_call_cleanup(process_create(path(git), ['diff', '--stat'],
  419                                      [ stdout(pipe(Out)),
  420                                        stderr(null),
  421                                        cwd(Dir)
  422                                      ]),
  423                       stream_char_count(Out, Count),
  424                       close(Out)),
  425    Count == 0.
  426
  427stream_char_count(Out, Count) :-
  428    setup_call_cleanup(open_null_stream(Null),
  429                       (   copy_stream_data(Out, Null),
  430                           character_count(Null, Count)
  431                       ),
  432                       close(Null)).
 git_hash(-Hash, +Options) is det
Return the hash of the indicated object.
  439git_hash(Hash, Options) :-
  440    option(commit(Commit), Options, 'HEAD'),
  441    git_process_output(['rev-parse', '--verify', Commit],
  442                       read_hash(Hash),
  443                       Options).
  444
  445read_hash(Hash, Stream) :-
  446    read_line_to_codes(Stream, Line),
  447    atom_codes(Hash, Line).
 is_git_hash(+Atom) is semidet
True when Atom represents a GIT hash, i.e., a 40 digit hexadecimal string.
  455is_git_hash(Atom) :-
  456    atom_length(Atom, 40),
  457    atom_codes(Atom, Codes),
  458    maplist(is_hex, Codes),
  459    !.
  460
  461is_hex(Code) :-
  462    code_type(Code, xdigit(_)).
 git_ls_tree(-Entries, +Options) is det
True when Entries is a list of entries in the the GIT repository, Each entry is a term:
object(Mode, Type, Hash, Size, Name)
  473git_ls_tree(Entries, Options) :-
  474    option(commit(Commit), Options, 'HEAD'),
  475    git_process_output(['ls-tree', '-z', '-r', '-l', Commit],
  476                       read_tree(Entries),
  477                       Options).
  478
  479read_tree(Entries, Stream) :-
  480    read_stream_to_codes(Stream, Codes),
  481    phrase(ls_tree(Entries), Codes).
  482
  483ls_tree([H|T]) -->
  484    ls_entry(H),
  485    !,
  486    ls_tree(T).
  487ls_tree([]) --> [].
  488
  489ls_entry(object(Mode, Type, Hash, Size, Name)) -->
  490    string(MS), " ",
  491    string(TS), " ",
  492    string(HS), " ",
  493    string(SS), "\t",
  494    string(NS), [0],
  495    !,
  496    { number_codes(Mode, [0'0,0'o|MS]),
  497      atom_codes(Type, TS),
  498      atom_codes(Hash, HS),
  499      (   Type == blob
  500      ->  number_codes(Size, SS)
  501      ;   Size = 0          % actually '-', but 0 sums easier
  502      ),
  503      atom_codes(Name, NS)
  504    }.
 git_remote_url(+Remote, -URL, +Options) is det
URL is the remote (fetch) URL for the given Remote.
  511git_remote_url(Remote, URL, Options) :-
  512    git_process_output([remote, show, Remote],
  513                       read_url("Fetch URL:", URL),
  514                       Options).
  515
  516read_url(Tag, URL, In) :-
  517    repeat,
  518        read_line_to_codes(In, Line),
  519        (   Line == end_of_file
  520        ->  !, fail
  521        ;   phrase(url_codes(Tag, Codes), Line)
  522        ->  !, atom_codes(URL, Codes)
  523        ).
  524
  525url_codes(Tag, Rest) -->
  526    { string_codes(Tag, TagCodes) },
  527    whites, string(TagCodes), whites, string(Rest).
 git_ls_remote(+GitURL, -Refs, +Options) is det
Execute git ls-remote against the remote repository to fetch references from the remote. Options processed:

For example, to find the hash of the remote HEAD, one can use

?- git_ls_remote('git://www.swi-prolog.org/home/pl/git/pl-devel.git',
                 Refs, [refs(['HEAD'])]).
Refs = ['5d596c52aa969d88e7959f86327f5c7ff23695f3'-'HEAD'].
Arguments:
Refs- is a list of pairs hash-name.
  549git_ls_remote(GitURL, Refs, Options) :-
  550    findall(O, ls_remote_option(Options, O), RemoteOptions),
  551    option(refs(LimitRefs), Options, []),
  552    must_be(list(atom), LimitRefs),
  553    append([ 'ls-remote' | RemoteOptions], [GitURL|LimitRefs], Argv),
  554    git_process_output(Argv, remote_refs(Refs), Options).
  555
  556ls_remote_option(Options, '--heads') :-
  557    option(heads(true), Options).
  558ls_remote_option(Options, '--tags') :-
  559    option(tags(true), Options).
  560
  561remote_refs(Refs, Out) :-
  562    read_line_to_codes(Out, Line0),
  563    remote_refs(Line0, Out, Refs).
  564
  565remote_refs(end_of_file, _, []) :- !.
  566remote_refs(Line, Out, [Hash-Ref|Tail]) :-
  567    phrase(remote_ref(Hash,Ref), Line),
  568    read_line_to_codes(Out, Line1),
  569    remote_refs(Line1, Out, Tail).
  570
  571remote_ref(Hash, Ref) -->
  572    string_without("\t ", HashCodes),
  573    whites,
  574    string_without("\t ", RefCodes),
  575    { atom_codes(Hash, HashCodes),
  576      atom_codes(Ref, RefCodes)
  577    }.
 git_remote_branches(+GitURL, -Branches) is det
Exploit git_ls_remote/3 to fetch the branches from a remote repository without downloading it.
  585git_remote_branches(GitURL, Branches) :-
  586    git_ls_remote(GitURL, Refs, [heads(true)]),
  587    findall(B, (member(_-Head, Refs),
  588                atom_concat('refs/heads/', B, Head)),
  589            Branches).
 git_default_branch(-BranchName, +Options) is det
True when BranchName is the default branch of a repository. This is hard to define. If possible, we perform rev-parse on origin/HEAD. If not, we look at branches shared between the local and remote and select main or master or the first common breach. Options:
remote(+Remote)
Remote used to detect the default branch. Default is origin.
  603git_default_branch(BranchName, Options) :-
  604    option(remote(Remote), Options, origin),
  605    atomic_list_concat([Remote, 'HEAD'], '/', HeadRef),
  606    git_process_output(['rev-parse', '--abbrev-ref', HeadRef],
  607                       read_default_branch(BranchName),
  608                       [ error(_),
  609                         status(Status)
  610                       | Options
  611                       ]),
  612    Status == exit(0),
  613    !.
  614git_default_branch(BranchName, Options) :-
  615    option(remote(Remote), Options, origin),
  616    git_branches(MyBranches, []),
  617    git_branches(RemoteBranches, [remote(true)]),
  618    (   preferred_default_branch(BranchName),
  619        shared_branch(Remote, MyBranches, RemoteBranches, BranchName)
  620    ->  true
  621    ;   shared_branch(Remote, MyBranches, RemoteBranches, BranchName)
  622    ->  true
  623    ).
  624
  625preferred_default_branch(main).
  626preferred_default_branch(master).
  627
  628shared_branch(Remote, MyBranches, RemoteBranches, BranchName) :-
  629    member(BranchName, MyBranches),
  630    atomic_list_concat([Remote, BranchName], '/', Orig),
  631    memberchk(Orig, RemoteBranches).
  632
  633read_default_branch(BranchName, In) :-
  634    read_line_to_string(In, Result),
  635    split_string(Result, "/", "", [_Origin,BranchString]),
  636    atom_string(BranchName, BranchString).
 git_default_branch(-BranchName, +Options) is semidet
True when BranchName is the current branch of a repository. Fails if the repo HEAD is detached
  643git_current_branch(BranchName, Options) :-
  644    git_process_output([branch],
  645                       read_current_branch(BranchName),
  646                       Options).
  647
  648read_current_branch(BranchName, In) :-
  649    repeat,
  650        read_line_to_codes(In, Line),
  651        (   Line == end_of_file
  652        ->  !, fail
  653        ;   phrase(current_branch(Codes), Line)
  654        ->  !, atom_codes(BranchName, Codes),
  655            \+ sub_atom(BranchName, _, _, _, '(HEAD detached')
  656        ).
  657
  658current_branch(Rest) -->
  659    "*", whites, string(Rest).
 git_branches(-Branches, +Options) is det
True when Branches is the list of branches in the repository. In addition to the usual options, this processes:
contains(Commit)
Return only branches that contain Commit.
remote(true)
Return remote branches
  671git_branches(Branches, Options) :-
  672    (   select_option(commit(Commit), Options, GitOptions)
  673    ->  Extra = ['--contains', Commit]
  674    ;   select_option(remote(true), Options, GitOptions)
  675    ->  Extra = ['-r']
  676    ;   Extra = [],
  677        GitOptions = Options
  678    ),
  679    git_process_output([branch|Extra],
  680                       read_branches(Branches),
  681                       GitOptions).
  682
  683read_branches(Branches, In) :-
  684    read_line_to_codes(In, Line),
  685    (   Line == end_of_file
  686    ->  Branches = []
  687    ;   Line = [_,_|Codes],
  688        atom_codes(H, Codes),
  689        (   sub_atom(H, _, _, _, '(HEAD detached at')
  690        ->  Branches = T
  691        ;   Branches = [H|T]
  692        ),
  693        read_branches(T, In)
  694    ).
 git_tags(-Tags, +Options) is det
True when Tags is a list of git tags defined on the repository.
  701git_tags(Tags, Options) :-
  702    git_process_output([tag],
  703                       read_lines_to_atoms(Tags),
  704                       Options).
  705
  706read_lines_to_atoms(Atoms, In) :-
  707    read_line_to_string(In, Line),
  708    (   Line == end_of_file
  709    ->  Atoms = []
  710    ;   atom_string(Atom, Line),
  711        Atoms = [Atom|T],
  712        read_lines_to_atoms(T, In)
  713    ).
 git_tags_on_branch(+Dir, +Branch, -Tags) is det
Tags is a list of tags in Branch on the GIT repository Dir, most recent tag first.
See also
- Git tricks at http://mislav.uniqpath.com/2010/07/git-tips/
  722git_tags_on_branch(Dir, Branch, Tags) :-
  723    git_process_output([ log, '--oneline', '--decorate', Branch ],
  724                       log_to_tags(Tags),
  725                       [ directory(Dir) ]).
  726
  727log_to_tags(Tags, Out) :-
  728    read_line_to_codes(Out, Line0),
  729    log_to_tags(Line0, Out, Tags, []).
  730
  731log_to_tags(end_of_file, _, Tags, Tags) :- !.
  732log_to_tags(Line, Out, Tags, Tail) :-
  733    phrase(tags_on_line(Tags, Tail1), Line),
  734    read_line_to_codes(Out, Line1),
  735    log_to_tags(Line1, Out, Tail1, Tail).
  736
  737tags_on_line(Tags, Tail) -->
  738    string_without(" ", _Hash),
  739    tags(Tags, Tail),
  740    skip_rest.
  741
  742tags(Tags, Tail) -->
  743    whites,
  744    "(",
  745    tag_list(Tags, Rest),
  746    !,
  747    tags(Rest, Tail).
  748tags(Tags, Tags) -->
  749    skip_rest.
  750
  751tag_list([H|T], Rest) -->
  752    "tag:", !, whites,
  753    string(Codes),
  754    (   ")"
  755    ->  { atom_codes(H, Codes),
  756          T = Rest
  757        }
  758    ;   ","
  759    ->  { atom_codes(H, Codes)
  760        },
  761        whites,
  762        tag_list(T, Rest)
  763    ).
  764tag_list(List, Rest) -->
  765    string(_),
  766    (   ")"
  767    ->  { List = Rest }
  768    ;   ","
  769    ->  whites,
  770        tag_list(List, Rest)
  771    ).
  772
  773skip_rest(_,_).
  774
  775
  776                 /*******************************
  777                 *        READ GIT HISTORY      *
  778                 *******************************/
 git_shortlog(+Dir, -ShortLog, +Options) is det
Fetch information like the GitWeb change overview. Processed options:
limit(+Count)
Maximum number of commits to show (default is 10)
revisions(+Revisions)
Git revision specification
path(+Path)
Only show commits that affect Path. Path is the path of a checked out file.
git_path(+Path)
Similar to path, but Path is relative to the repository.
Arguments:
ShortLog- is a list of git_log records.
  797:- record
  798    git_log(commit_hash:atom,
  799            author_name:atom,
  800            author_date_relative:atom,
  801            committer_name:atom,
  802            committer_date_relative:atom,
  803            committer_date_unix:integer,
  804            subject:atom,
  805            ref_names:list).  806
  807git_shortlog(Dir, ShortLog, Options) :-
  808    (   option(revisions(Range), Options)
  809    ->  RangeSpec = [Range]
  810    ;   option(limit(Limit), Options, 10),
  811        RangeSpec = ['-n', Limit]
  812    ),
  813    (   option(git_path(Path), Options)
  814    ->  Extra = ['--', Path]
  815    ;   option(path(Path), Options)
  816    ->  relative_file_name(Path, Dir, RelPath),
  817        Extra = ['--', RelPath]
  818    ;   Extra = []
  819    ),
  820    git_format_string(git_log, Fields, Format),
  821    append([[log, Format], RangeSpec, Extra], GitArgv),
  822    git_process_output(GitArgv,
  823                       read_git_formatted(git_log, Fields, ShortLog),
  824                       [directory(Dir)]).
  825
  826
  827read_git_formatted(Record, Fields, ShortLog, In) :-
  828    read_line_to_codes(In, Line0),
  829    read_git_formatted(Line0, In, Record, Fields, ShortLog).
  830
  831read_git_formatted(end_of_file, _, _, _, []) :- !.
  832read_git_formatted(Line, In, Record, Fields, [H|T]) :-
  833    record_from_line(Record, Fields, Line, H),
  834    read_line_to_codes(In, Line1),
  835    read_git_formatted(Line1, In, Record, Fields, T).
  836
  837record_from_line(RecordName, Fields, Line, Record) :-
  838    phrase(fields_from_line(Fields, Values), Line),
  839    Record =.. [RecordName|Values].
  840
  841fields_from_line([], []) --> [].
  842fields_from_line([F|FT], [V|VT]) -->
  843    to_nul_s(Codes),
  844    { field_to_prolog(F, Codes, V) },
  845    fields_from_line(FT, VT).
  846
  847to_nul_s([]) --> [0], !.
  848to_nul_s([H|T]) --> [H], to_nul_s(T).
  849
  850field_to_prolog(ref_names, Line, List) :-
  851    phrase(ref_names(List), Line),
  852    !.
  853field_to_prolog(committer_date_unix, Line, Stamp) :-
  854    !,
  855    number_codes(Stamp, Line).
  856field_to_prolog(_, Line, Atom) :-
  857    atom_codes(Atom, Line).
  858
  859ref_names([]) --> [].
  860ref_names(List) -->
  861    blanks, "(", ref_name_list(List), ")".
  862
  863ref_name_list([H|T]) -->
  864    string_without(",)", Codes),
  865    { atom_codes(H, Codes) },
  866    (   ",", blanks
  867    ->  ref_name_list(T)
  868    ;   {T=[]}
  869    ).
 git_show(+Dir, +Hash, -Commit, +Options) is det
Fetch info from a GIT commit. Options processed:
diff(Diff)
GIT option on how to format diffs. E.g. stat
max_lines(Count)
Truncate the body at Count lines.
Arguments:
Commit- is a term git_commit(...)-Body. Body is currently a list of lines, each line represented as a list of codes.
  885:- record
  886    git_commit(tree_hash:atom,
  887               parent_hashes:list,
  888               author_name:atom,
  889               author_date:atom,
  890               committer_name:atom,
  891               committer_date:atom,
  892               subject:atom).  893
  894git_show(Dir, Hash, Commit, Options) :-
  895    git_format_string(git_commit, Fields, Format),
  896    option(diff(Diff), Options, patch),
  897    diff_arg(Diff, DiffArg),
  898    git_process_output([ show, DiffArg, Hash, Format ],
  899                       read_commit(Fields, Commit, Options),
  900                       [directory(Dir)]).
  901
  902diff_arg(patch, '-p').
  903diff_arg(stat, '--stat').
  904
  905read_commit(Fields, Data-Body, Options, In) :-
  906    read_line_to_codes(In, Line1),
  907    record_from_line(git_commit, Fields, Line1, Data),
  908    read_line_to_codes(In, Line2),
  909    (   Line2 == []
  910    ->  option(max_lines(Max), Options, -1),
  911        read_n_lines(In, Max, Body)
  912    ;   Line2 == end_of_file
  913    ->  Body = []
  914    ).
  915
  916read_n_lines(In, Max, Lines) :-
  917    read_line_to_codes(In, Line1),
  918    read_n_lines(Line1, Max, In, Lines).
  919
  920read_n_lines(end_of_file, _, _, []) :- !.
  921read_n_lines(_, 0, In, []) :-
  922    !,
  923    setup_call_cleanup(open_null_stream(Out),
  924                       copy_stream_data(In, Out),
  925                       close(Out)).
  926read_n_lines(Line, Max0, In, [Line|More]) :-
  927    read_line_to_codes(In, Line2),
  928    Max is Max0-1,
  929    read_n_lines(Line2, Max, In, More).
 git_format_string(:Record, -FieldNames, -Format)
If Record is a record with fields whose names match the GIT format field-names, Format is a git --format= argument with the appropriate format-specifiers, terminated by %x00, which causes the actual field to be 0-terminated.
  939:- meta_predicate
  940    git_format_string(:, -, -).  941
  942git_format_string(M:RecordName, Fields, Format) :-
  943    current_record(RecordName, M:Term),
  944    findall(F, record_field(Term, F), Fields),
  945    maplist(git_field_format, Fields, Formats),
  946    atomic_list_concat(['--format='|Formats], Format).
  947
  948record_field(Term, Name) :-
  949    arg(_, Term, Field),
  950    field_name(Field, Name).
  951
  952field_name(Name:_Type=_Default, Name) :- !.
  953field_name(Name:_Type, Name) :- !.
  954field_name(Name=_Default, Name) :- !.
  955field_name(Name, Name).
  956
  957git_field_format(Field, Fmt) :-
  958    (   git_format(NoPercent, Field)
  959    ->  atomic_list_concat(['%', NoPercent, '%x00'], Fmt)
  960    ;   existence_error(git_format, Field)
  961    ).
  962
  963git_format('H', commit_hash).
  964git_format('h', abbreviated_commit_hash).
  965git_format('T', tree_hash).
  966git_format('t', abbreviated_tree_hash).
  967git_format('P', parent_hashes).
  968git_format('p', abbreviated_parent_hashes).
  969
  970git_format('an', author_name).
  971git_format('aN', author_name_mailcap).
  972git_format('ae', author_email).
  973git_format('aE', author_email_mailcap).
  974git_format('ad', author_date).
  975git_format('aD', author_date_rfc2822).
  976git_format('ar', author_date_relative).
  977git_format('at', author_date_unix).
  978git_format('ai', author_date_iso8601).
  979
  980git_format('cn', committer_name).
  981git_format('cN', committer_name_mailcap).
  982git_format('ce', committer_email).
  983git_format('cE', committer_email_mailcap).
  984git_format('cd', committer_date).
  985git_format('cD', committer_date_rfc2822).
  986git_format('cr', committer_date_relative).
  987git_format('ct', committer_date_unix).
  988git_format('ci', committer_date_iso8601).
  989
  990git_format('d', ref_names).             % git log?
  991git_format('e', encoding).              % git log?
  992
  993git_format('s', subject).
  994git_format('f', subject_sanitized).
  995git_format('b', body).
  996git_format('N', notes).
  997
  998git_format('gD', reflog_selector).
  999git_format('gd', shortened_reflog_selector).
 1000git_format('gs', reflog_subject).
 1001
 1002
 1003                 /*******************************
 1004                 *            MESSAGES          *
 1005                 *******************************/
 1006
 1007:- multifile
 1008    prolog:message//1. 1009
 1010prolog:message(git(output(Codes))) -->
 1011    { split_lines(Codes, Lines) },
 1012    git_lines(Lines).
 1013
 1014git_lines([]) --> [].
 1015git_lines([H|T]) -->
 1016    [ '~s'-[H] ],
 1017    (   {T==[]}
 1018    ->  []
 1019    ;   [nl], git_lines(T)
 1020    ).
 1021
 1022split_lines([], []) :- !.
 1023split_lines(All, [Line1|More]) :-
 1024    append(Line1, [0'\n|Rest], All),
 1025    !,
 1026    split_lines(Rest, More).
 1027split_lines(Line, [Line])