kibi-swipl-linux-x64-gnu 1.0.0

package/lib/swipl/library/git.pl

@@ -0,0 +1,1027 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c) 2010-2023, University of Amsterdam,
+                             VU University
+                             SWI-Prolog Solutions b.v.
+    Amsterdam All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:- module(git,
+          [ git/2,                      % +Argv, +Options
+            git_process_output/3,       % +Argv, :OnOutput, +Options
+            git_open_file/4,            % +Dir, +File, +Branch, -Stream
+            is_git_directory/1,         % +Dir
+            git_describe/2,             % -Version, +Options
+            git_hash/2,                 % -Hash, +Options
+            git_ls_tree/2,              % -Content, +Options
+            git_remote_url/3,           % +Remote, -URL, +Options
+            git_ls_remote/3,            % +GitURL, -Refs, +Options
+            git_branches/2,             % -Branches, +Options
+            git_remote_branches/2,      % +GitURL, -Branches
+            git_default_branch/2,       % -DefaultBranch, +Options
+            git_current_branch/2,       % -CurrentBranch, +Options
+            git_tags/2,                 % -Tags, +Options
+            git_tags_on_branch/3,       % +Dir, +Branch, -Tags
+            git_shortlog/3,             % +Dir, -Shortlog, +Options
+            git_log_data/3,             % +Field, +Record, -Value
+            git_show/4,                 % +Dir, +Hash, -Commit, +Options
+            git_commit_data/3,          % +Field, +Record, -Value
+            is_git_hash/1               % +Atom
+          ]).
+:- use_module(library(record),[(record)/1,current_record/2, op(_,_,record)]).
+
+:- autoload(library(apply),[maplist/3]).
+:- autoload(library(error),[must_be/2,existence_error/2]).
+:- autoload(library(filesex),
+	    [directory_file_path/3,relative_file_name/3]).
+:- autoload(library(lists),[append/3,member/2,append/2]).
+:- autoload(library(option),[option/2,option/3,select_option/3]).
+:- autoload(library(process),[process_create/3,process_wait/2]).
+:- autoload(library(readutil),
+	    [ read_stream_to_codes/3,
+	      read_line_to_codes/2,
+	      read_stream_to_codes/2
+	    ]).
+:- autoload(library(dcg/basics),
+	    [string//1,whites//0,string_without//2,blanks//0]).
+
+
+:- meta_predicate
+    git_process_output(+, 1, +).
+
+/** <module> 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.
+*/
+
+:- predicate_options(git/2, 2,
+                     [ directory(atom),
+                       error(-codes),
+                       output(-codes),
+                       status(-any),
+                       askpass(any)
+                     ]).
+:- predicate_options(git_default_branch/2, 2,
+                     [ pass_to(git_process_output/3, 3)
+                     ] ).
+:- predicate_options(git_describe/2, 2,
+                     [ commit(atom),
+                       directory(atom),
+                       match(atom)
+                     ]).
+:- predicate_options(git_hash/2, 2,
+                     [ commit(atom),
+                       directory(atom),
+                       pass_to(git_process_output/3, 3)
+                     ]).
+:- predicate_options(git_ls_tree/2, 2,
+                     [ commit(atom),
+                       directory(atom)
+                     ]).
+:- predicate_options(git_process_output/3, 3,
+                     [ directory(atom),
+                       askpass(any),
+                       error(-codes),
+                       status(-integer)
+                     ]).
+:- predicate_options(git_remote_url/3, 3,
+                     [ pass_to(git_process_output/3, 3)
+                     ]).
+:- predicate_options(git_shortlog/3, 3,
+                     [ revisions(atom),
+                       limit(nonneg),
+                       path(atom)
+                     ]).
+:- predicate_options(git_show/4, 4,
+                     [ diff(oneof([patch,stat]))
+                     ]).
+
+
+%!  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
+
+git(Argv, Options) :-
+    git_cwd_options(Argv, Argv1, Options),
+    env_options(Extra, Options),
+    setup_call_cleanup(
+        process_create(path(git), Argv1,
+                       [ stdout(pipe(Out)),
+                         stderr(pipe(Error)),
+                         process(PID)
+                       | Extra
+                       ]),
+        call_cleanup(
+            ( read_stream_to_codes(Out, OutCodes, []),
+              read_stream_to_codes(Error, ErrorCodes, [])
+            ),
+            process_wait(PID, Status)),
+        close_streams([Out,Error])),
+    print_error(ErrorCodes, Options),
+    print_output(OutCodes, Options),
+    (   option(status(Status0), Options)
+    ->  Status = Status0
+    ;   Status == exit(0)
+    ->  true
+    ;   throw(error(process_error(git(Argv), Status), _))
+    ).
+
+git_cwd_options(Argv0, Argv, Options) :-
+    option(directory(Dir), Options),
+    !,
+    Argv = ['-C', file(Dir) | Argv0 ].
+git_cwd_options(Argv, Argv, _).
+
+env_options([env(['GIT_ASKPASS'=Program])], Options) :-
+    option(askpass(Exe), Options),
+    !,
+    exe_options(ExeOptions),
+    absolute_file_name(Exe, PlProg, ExeOptions),
+    prolog_to_os_filename(PlProg, Program).
+env_options([], _).
+
+exe_options(Options) :-
+    current_prolog_flag(windows, true),
+    !,
+    Options = [ extensions(['',exe,com]), access(read) ].
+exe_options(Options) :-
+    Options = [ access(execute) ].
+
+print_output(OutCodes, Options) :-
+    option(output(Codes), Options),
+    !,
+    Codes = OutCodes.
+print_output([], _) :- !.
+print_output(OutCodes, _) :-
+    print_message(informational, git(output(OutCodes))).
+
+print_error(OutCodes, Options) :-
+    option(error(Codes), Options),
+    !,
+    Codes = OutCodes.
+print_error([], _) :- !.
+print_error(OutCodes, _) :-
+    phrase(classify_message(Level), OutCodes, _),
+    print_message(Level, git(output(OutCodes))).
+
+classify_message(error) -->
+    string(_), "fatal:",
+    !.
+classify_message(error) -->
+    string(_), "error:",
+    !.
+classify_message(warning) -->
+    string(_), "warning:",
+    !.
+classify_message(informational) -->
+    [].
+
+%!  close_streams(+Streams:list) is det.
+%
+%   Close a list of streams, throwing the first error if some stream
+%   failed to close.
+
+close_streams(List) :-
+    phrase(close_streams(List), Errors),
+    (   Errors = [Error|_]
+    ->  throw(Error)
+    ;   true
+    ).
+
+close_streams([H|T]) -->
+    { catch(close(H), E, true) },
+    (   { var(E) }
+    ->  []
+    ;   [E]
+    ),
+    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).
+
+git_process_output(Argv, OnOutput, Options) :-
+    git_cwd_options(Argv, Argv1, Options),
+    env_options(Extra, Options),
+    setup_call_cleanup(
+        process_create(path(git), Argv1,
+                       [ stdout(pipe(Out)),
+                         stderr(pipe(Error)),
+                         process(PID)
+                       | Extra
+                       ]),
+        call_cleanup(
+            ( call(OnOutput, Out),
+              read_stream_to_codes(Error, ErrorCodes, [])
+            ),
+            git_wait(PID, Out, Status)),
+        close_streams([Out,Error])),
+    print_error(ErrorCodes, Options),
+    (   option(status(Status), Options)
+    ->  true
+    ;   Status = exit(0)
+    ->  true
+    ;   throw(error(process_error(git, Status)))
+    ).
+
+git_wait(PID, Out, Status) :-
+    at_end_of_stream(Out),
+    !,
+    process_wait(PID, Status).
+git_wait(PID, Out, Status) :-
+    setup_call_cleanup(
+        open_null_stream(Null),
+        copy_stream_data(Out, Null),
+        close(Null)),
+    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.
+
+git_open_file(Dir, File, Branch, In) :-
+    atomic_list_concat([Branch, :, File], Ref),
+    process_create(path(git),
+                   [ '-C', file(Dir), show, Ref ],
+                   [ stdout(pipe(In))
+                   ]),
+    set_stream(In, file_name(File)).
+
+
+%!  is_git_directory(+Directory) is semidet.
+%
+%   True if Directory is a  git   directory  (Either  checked out or
+%   bare).
+
+is_git_directory(Directory) :-
+    directory_file_path(Directory, '.git', GitDir),
+    exists_directory(GitDir),
+    !.
+is_git_directory(Directory) :-
+    exists_directory(Directory),
+    git(['rev-parse', '--git-dir'],
+        [ output(Codes),
+          error(_),
+          status(Status),
+          directory(Directory)
+        ]),
+    Status == exit(0),
+    string_codes(GitDir0, Codes),
+    split_string(GitDir0, "", " \n", [GitDir]),
+    sub_string(GitDir, B, _, A, "/.git/modules/"),
+    !,
+    sub_string(GitDir, 0, B, _, Main),
+    sub_string(GitDir, _, A, 0, Below),
+    directory_file_path(Main, Below, Dir),
+    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 git describe
+
+git_describe(Version, Options) :-
+    (   option(match(Pattern), Options)
+    ->  true
+    ;   git_version_pattern(Pattern)
+    ),
+    (   option(commit(Commit), Options)
+    ->  Extra = [Commit]
+    ;   Extra = []
+    ),
+    option(directory(Dir), Options, .),
+    setup_call_cleanup(
+        process_create(path(git),
+                       [ 'describe',
+                         '--match', Pattern
+                       | Extra
+                       ],
+                       [ stdout(pipe(Out)),
+                         stderr(null),
+                         process(PID),
+                         cwd(Dir)
+                       ]),
+        call_cleanup(
+            read_stream_to_codes(Out, V0, []),
+            git_wait(PID, Out, Status)),
+        close(Out)),
+    Status = exit(0),
+    !,
+    atom_codes(V1, V0),
+    normalize_space(atom(Plain), V1),
+    (   git_is_clean(Dir)
+    ->  Version = Plain
+    ;   atom_concat(Plain, '-DIRTY', Version)
+    ).
+git_describe(Version, Options) :-
+    option(directory(Dir), Options, .),
+    option(commit(Commit), Options, 'HEAD'),
+    setup_call_cleanup(
+        process_create(path(git),
+                       [ 'rev-parse', '--short',
+                         Commit
+                       ],
+                       [ stdout(pipe(Out)),
+                         stderr(null),
+                         process(PID),
+                         cwd(Dir)
+                       ]),
+        call_cleanup(
+            read_stream_to_codes(Out, V0, []),
+            git_wait(PID, Out, Status)),
+        close(Out)),
+    Status = exit(0),
+    atom_codes(V1, V0),
+    normalize_space(atom(Plain), V1),
+    (   git_is_clean(Dir)
+    ->  Version = Plain
+    ;   atom_concat(Plain, '-DIRTY', Version)
+    ).
+
+
+:- multifile
+    git_version_pattern/1.
+
+git_version_pattern('V*').
+git_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.
+
+git_is_clean(Dir) :-
+    setup_call_cleanup(process_create(path(git), ['diff', '--stat'],
+                                      [ stdout(pipe(Out)),
+                                        stderr(null),
+                                        cwd(Dir)
+                                      ]),
+                       stream_char_count(Out, Count),
+                       close(Out)),
+    Count == 0.
+
+stream_char_count(Out, Count) :-
+    setup_call_cleanup(open_null_stream(Null),
+                       (   copy_stream_data(Out, Null),
+                           character_count(Null, Count)
+                       ),
+                       close(Null)).
+
+
+%!  git_hash(-Hash, +Options) is det.
+%
+%   Return the hash of the indicated object.
+
+git_hash(Hash, Options) :-
+    option(commit(Commit), Options, 'HEAD'),
+    git_process_output(['rev-parse', '--verify', Commit],
+                       read_hash(Hash),
+                       Options).
+
+read_hash(Hash, Stream) :-
+    read_line_to_codes(Stream, Line),
+    atom_codes(Hash, Line).
+
+
+%!  is_git_hash(+Atom) is semidet.
+%
+%   True when Atom represents a GIT hash,   i.e., a 40 digit hexadecimal
+%   string.
+
+is_git_hash(Atom) :-
+    atom_length(Atom, 40),
+    atom_codes(Atom, Codes),
+    maplist(is_hex, Codes),
+    !.
+
+is_hex(Code) :-
+    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)
+%     ==
+
+git_ls_tree(Entries, Options) :-
+    option(commit(Commit), Options, 'HEAD'),
+    git_process_output(['ls-tree', '-z', '-r', '-l', Commit],
+                       read_tree(Entries),
+                       Options).
+
+read_tree(Entries, Stream) :-
+    read_stream_to_codes(Stream, Codes),
+    phrase(ls_tree(Entries), Codes).
+
+ls_tree([H|T]) -->
+    ls_entry(H),
+    !,
+    ls_tree(T).
+ls_tree([]) --> [].
+
+ls_entry(object(Mode, Type, Hash, Size, Name)) -->
+    string(MS), " ",
+    string(TS), " ",
+    string(HS), " ",
+    string(SS), "\t",
+    string(NS), [0],
+    !,
+    { number_codes(Mode, [0'0,0'o|MS]),
+      atom_codes(Type, TS),
+      atom_codes(Hash, HS),
+      (   Type == blob
+      ->  number_codes(Size, SS)
+      ;   Size = 0          % actually '-', but 0 sums easier
+      ),
+      atom_codes(Name, NS)
+    }.
+
+
+%!  git_remote_url(+Remote, -URL, +Options) is det.
+%
+%   URL is the remote (fetch) URL for the given Remote.
+
+git_remote_url(Remote, URL, Options) :-
+    git_process_output([remote, show, Remote],
+                       read_url("Fetch URL:", URL),
+                       Options).
+
+read_url(Tag, URL, In) :-
+    repeat,
+        read_line_to_codes(In, Line),
+        (   Line == end_of_file
+        ->  !, fail
+        ;   phrase(url_codes(Tag, Codes), Line)
+        ->  !, atom_codes(URL, Codes)
+        ).
+
+url_codes(Tag, Rest) -->
+    { string_codes(Tag, TagCodes) },
+    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:
+%
+%     * heads(Boolean)
+%     * tags(Boolean)
+%     * refs(List)
+%
+%   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'].
+%     ==
+%
+%   @param Refs is a list of pairs hash-name.
+
+git_ls_remote(GitURL, Refs, Options) :-
+    findall(O, ls_remote_option(Options, O), RemoteOptions),
+    option(refs(LimitRefs), Options, []),
+    must_be(list(atom), LimitRefs),
+    append([ 'ls-remote' | RemoteOptions], [GitURL|LimitRefs], Argv),
+    git_process_output(Argv, remote_refs(Refs), Options).
+
+ls_remote_option(Options, '--heads') :-
+    option(heads(true), Options).
+ls_remote_option(Options, '--tags') :-
+    option(tags(true), Options).
+
+remote_refs(Refs, Out) :-
+    read_line_to_codes(Out, Line0),
+    remote_refs(Line0, Out, Refs).
+
+remote_refs(end_of_file, _, []) :- !.
+remote_refs(Line, Out, [Hash-Ref|Tail]) :-
+    phrase(remote_ref(Hash,Ref), Line),
+    read_line_to_codes(Out, Line1),
+    remote_refs(Line1, Out, Tail).
+
+remote_ref(Hash, Ref) -->
+    string_without("\t ", HashCodes),
+    whites,
+    string_without("\t ", RefCodes),
+    { atom_codes(Hash, HashCodes),
+      atom_codes(Ref, RefCodes)
+    }.
+
+
+%!  git_remote_branches(+GitURL, -Branches) is det.
+%
+%   Exploit git_ls_remote/3 to fetch  the   branches  from  a remote
+%   repository without downloading it.
+
+git_remote_branches(GitURL, Branches) :-
+    git_ls_remote(GitURL, Refs, [heads(true)]),
+    findall(B, (member(_-Head, Refs),
+                atom_concat('refs/heads/', B, Head)),
+            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`.
+
+git_default_branch(BranchName, Options) :-
+    option(remote(Remote), Options, origin),
+    atomic_list_concat([Remote, 'HEAD'], '/', HeadRef),
+    git_process_output(['rev-parse', '--abbrev-ref', HeadRef],
+                       read_default_branch(BranchName),
+                       [ error(_),
+                         status(Status)
+                       | Options
+                       ]),
+    Status == exit(0),
+    !.
+git_default_branch(BranchName, Options) :-
+    option(remote(Remote), Options, origin),
+    git_branches(MyBranches, []),
+    git_branches(RemoteBranches, [remote(true)]),
+    (   preferred_default_branch(BranchName),
+        shared_branch(Remote, MyBranches, RemoteBranches, BranchName)
+    ->  true
+    ;   shared_branch(Remote, MyBranches, RemoteBranches, BranchName)
+    ->  true
+    ).
+
+preferred_default_branch(main).
+preferred_default_branch(master).
+
+shared_branch(Remote, MyBranches, RemoteBranches, BranchName) :-
+    member(BranchName, MyBranches),
+    atomic_list_concat([Remote, BranchName], '/', Orig),
+    memberchk(Orig, RemoteBranches).
+
+read_default_branch(BranchName, In) :-
+    read_line_to_string(In, Result),
+    split_string(Result, "/", "", [_Origin,BranchString]),
+    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
+
+git_current_branch(BranchName, Options) :-
+    git_process_output([branch],
+                       read_current_branch(BranchName),
+                       Options).
+
+read_current_branch(BranchName, In) :-
+    repeat,
+        read_line_to_codes(In, Line),
+        (   Line == end_of_file
+        ->  !, fail
+        ;   phrase(current_branch(Codes), Line)
+        ->  !, atom_codes(BranchName, Codes),
+            \+ sub_atom(BranchName, _, _, _, '(HEAD detached')
+        ).
+
+current_branch(Rest) -->
+    "*", 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
+
+git_branches(Branches, Options) :-
+    (   select_option(commit(Commit), Options, GitOptions)
+    ->  Extra = ['--contains', Commit]
+    ;   select_option(remote(true), Options, GitOptions)
+    ->  Extra = ['-r']
+    ;   Extra = [],
+        GitOptions = Options
+    ),
+    git_process_output([branch|Extra],
+                       read_branches(Branches),
+                       GitOptions).
+
+read_branches(Branches, In) :-
+    read_line_to_codes(In, Line),
+    (   Line == end_of_file
+    ->  Branches = []
+    ;   Line = [_,_|Codes],
+        atom_codes(H, Codes),
+        (   sub_atom(H, _, _, _, '(HEAD detached at')
+        ->  Branches = T
+        ;   Branches = [H|T]
+        ),
+        read_branches(T, In)
+    ).
+
+
+%!  git_tags(-Tags, +Options) is det.
+%
+%   True when Tags is a list of git tags defined on the repository.
+
+git_tags(Tags, Options) :-
+    git_process_output([tag],
+                       read_lines_to_atoms(Tags),
+                       Options).
+
+read_lines_to_atoms(Atoms, In) :-
+    read_line_to_string(In, Line),
+    (   Line == end_of_file
+    ->  Atoms = []
+    ;   atom_string(Atom, Line),
+        Atoms = [Atom|T],
+        read_lines_to_atoms(T, In)
+    ).
+
+%!  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 Git tricks at http://mislav.uniqpath.com/2010/07/git-tips/
+
+git_tags_on_branch(Dir, Branch, Tags) :-
+    git_process_output([ log, '--oneline', '--decorate', Branch ],
+                       log_to_tags(Tags),
+                       [ directory(Dir) ]).
+
+log_to_tags(Tags, Out) :-
+    read_line_to_codes(Out, Line0),
+    log_to_tags(Line0, Out, Tags, []).
+
+log_to_tags(end_of_file, _, Tags, Tags) :- !.
+log_to_tags(Line, Out, Tags, Tail) :-
+    phrase(tags_on_line(Tags, Tail1), Line),
+    read_line_to_codes(Out, Line1),
+    log_to_tags(Line1, Out, Tail1, Tail).
+
+tags_on_line(Tags, Tail) -->
+    string_without(" ", _Hash),
+    tags(Tags, Tail),
+    skip_rest.
+
+tags(Tags, Tail) -->
+    whites,
+    "(",
+    tag_list(Tags, Rest),
+    !,
+    tags(Rest, Tail).
+tags(Tags, Tags) -->
+    skip_rest.
+
+tag_list([H|T], Rest) -->
+    "tag:", !, whites,
+    string(Codes),
+    (   ")"
+    ->  { atom_codes(H, Codes),
+          T = Rest
+        }
+    ;   ","
+    ->  { atom_codes(H, Codes)
+        },
+        whites,
+        tag_list(T, Rest)
+    ).
+tag_list(List, Rest) -->
+    string(_),
+    (   ")"
+    ->  { List = Rest }
+    ;   ","
+    ->  whites,
+        tag_list(List, Rest)
+    ).
+
+skip_rest(_,_).
+
+
+                 /*******************************
+                 *        READ GIT HISTORY      *
+                 *******************************/
+
+%!  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.
+%
+%   @param ShortLog is a list of =git_log= records.
+
+:- record
+    git_log(commit_hash:atom,
+            author_name:atom,
+            author_date_relative:atom,
+            committer_name:atom,
+            committer_date_relative:atom,
+            committer_date_unix:integer,
+            subject:atom,
+            ref_names:list).
+
+git_shortlog(Dir, ShortLog, Options) :-
+    (   option(revisions(Range), Options)
+    ->  RangeSpec = [Range]
+    ;   option(limit(Limit), Options, 10),
+        RangeSpec = ['-n', Limit]
+    ),
+    (   option(git_path(Path), Options)
+    ->  Extra = ['--', Path]
+    ;   option(path(Path), Options)
+    ->  relative_file_name(Path, Dir, RelPath),
+        Extra = ['--', RelPath]
+    ;   Extra = []
+    ),
+    git_format_string(git_log, Fields, Format),
+    append([[log, Format], RangeSpec, Extra], GitArgv),
+    git_process_output(GitArgv,
+                       read_git_formatted(git_log, Fields, ShortLog),
+                       [directory(Dir)]).
+
+
+read_git_formatted(Record, Fields, ShortLog, In) :-
+    read_line_to_codes(In, Line0),
+    read_git_formatted(Line0, In, Record, Fields, ShortLog).
+
+read_git_formatted(end_of_file, _, _, _, []) :- !.
+read_git_formatted(Line, In, Record, Fields, [H|T]) :-
+    record_from_line(Record, Fields, Line, H),
+    read_line_to_codes(In, Line1),
+    read_git_formatted(Line1, In, Record, Fields, T).
+
+record_from_line(RecordName, Fields, Line, Record) :-
+    phrase(fields_from_line(Fields, Values), Line),
+    Record =.. [RecordName|Values].
+
+fields_from_line([], []) --> [].
+fields_from_line([F|FT], [V|VT]) -->
+    to_nul_s(Codes),
+    { field_to_prolog(F, Codes, V) },
+    fields_from_line(FT, VT).
+
+to_nul_s([]) --> [0], !.
+to_nul_s([H|T]) --> [H], to_nul_s(T).
+
+field_to_prolog(ref_names, Line, List) :-
+    phrase(ref_names(List), Line),
+    !.
+field_to_prolog(committer_date_unix, Line, Stamp) :-
+    !,
+    number_codes(Stamp, Line).
+field_to_prolog(_, Line, Atom) :-
+    atom_codes(Atom, Line).
+
+ref_names([]) --> [].
+ref_names(List) -->
+    blanks, "(", ref_name_list(List), ")".
+
+ref_name_list([H|T]) -->
+    string_without(",)", Codes),
+    { atom_codes(H, Codes) },
+    (   ",", blanks
+    ->  ref_name_list(T)
+    ;   {T=[]}
+    ).
+
+
+%!  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.
+%
+%   @param  Commit is a term git_commit(...)-Body.  Body is currently
+%           a list of lines, each line represented as a list of
+%           codes.
+
+:- record
+    git_commit(tree_hash:atom,
+               parent_hashes:list,
+               author_name:atom,
+               author_date:atom,
+               committer_name:atom,
+               committer_date:atom,
+               subject:atom).
+
+git_show(Dir, Hash, Commit, Options) :-
+    git_format_string(git_commit, Fields, Format),
+    option(diff(Diff), Options, patch),
+    diff_arg(Diff, DiffArg),
+    git_process_output([ show, DiffArg, Hash, Format ],
+                       read_commit(Fields, Commit, Options),
+                       [directory(Dir)]).
+
+diff_arg(patch, '-p').
+diff_arg(stat, '--stat').
+
+read_commit(Fields, Data-Body, Options, In) :-
+    read_line_to_codes(In, Line1),
+    record_from_line(git_commit, Fields, Line1, Data),
+    read_line_to_codes(In, Line2),
+    (   Line2 == []
+    ->  option(max_lines(Max), Options, -1),
+        read_n_lines(In, Max, Body)
+    ;   Line2 == end_of_file
+    ->  Body = []
+    ).
+
+read_n_lines(In, Max, Lines) :-
+    read_line_to_codes(In, Line1),
+    read_n_lines(Line1, Max, In, Lines).
+
+read_n_lines(end_of_file, _, _, []) :- !.
+read_n_lines(_, 0, In, []) :-
+    !,
+    setup_call_cleanup(open_null_stream(Out),
+                       copy_stream_data(In, Out),
+                       close(Out)).
+read_n_lines(Line, Max0, In, [Line|More]) :-
+    read_line_to_codes(In, Line2),
+    Max is Max0-1,
+    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.
+
+:- meta_predicate
+    git_format_string(:, -, -).
+
+git_format_string(M:RecordName, Fields, Format) :-
+    current_record(RecordName, M:Term),
+    findall(F, record_field(Term, F), Fields),
+    maplist(git_field_format, Fields, Formats),
+    atomic_list_concat(['--format='|Formats], Format).
+
+record_field(Term, Name) :-
+    arg(_, Term, Field),
+    field_name(Field, Name).
+
+field_name(Name:_Type=_Default, Name) :- !.
+field_name(Name:_Type, Name) :- !.
+field_name(Name=_Default, Name) :- !.
+field_name(Name, Name).
+
+git_field_format(Field, Fmt) :-
+    (   git_format(NoPercent, Field)
+    ->  atomic_list_concat(['%', NoPercent, '%x00'], Fmt)
+    ;   existence_error(git_format, Field)
+    ).
+
+git_format('H', commit_hash).
+git_format('h', abbreviated_commit_hash).
+git_format('T', tree_hash).
+git_format('t', abbreviated_tree_hash).
+git_format('P', parent_hashes).
+git_format('p', abbreviated_parent_hashes).
+
+git_format('an', author_name).
+git_format('aN', author_name_mailcap).
+git_format('ae', author_email).
+git_format('aE', author_email_mailcap).
+git_format('ad', author_date).
+git_format('aD', author_date_rfc2822).
+git_format('ar', author_date_relative).
+git_format('at', author_date_unix).
+git_format('ai', author_date_iso8601).
+
+git_format('cn', committer_name).
+git_format('cN', committer_name_mailcap).
+git_format('ce', committer_email).
+git_format('cE', committer_email_mailcap).
+git_format('cd', committer_date).
+git_format('cD', committer_date_rfc2822).
+git_format('cr', committer_date_relative).
+git_format('ct', committer_date_unix).
+git_format('ci', committer_date_iso8601).
+
+git_format('d', ref_names).             % git log?
+git_format('e', encoding).              % git log?
+
+git_format('s', subject).
+git_format('f', subject_sanitized).
+git_format('b', body).
+git_format('N', notes).
+
+git_format('gD', reflog_selector).
+git_format('gd', shortened_reflog_selector).
+git_format('gs', reflog_subject).
+
+
+                 /*******************************
+                 *            MESSAGES          *
+                 *******************************/
+
+:- multifile
+    prolog:message//1.
+
+prolog:message(git(output(Codes))) -->
+    { split_lines(Codes, Lines) },
+    git_lines(Lines).
+
+git_lines([]) --> [].
+git_lines([H|T]) -->
+    [ '~s'-[H] ],
+    (   {T==[]}
+    ->  []
+    ;   [nl], git_lines(T)
+    ).
+
+split_lines([], []) :- !.
+split_lines(All, [Line1|More]) :-
+    append(Line1, [0'\n|Rest], All),
+    !,
+    split_lines(Rest, More).
+split_lines(Line, [Line]).