View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2011, VU University Amsterdam
    7
    8    This program is free software; you can redistribute it and/or
    9    modify it under the terms of the GNU General Public License
   10    as published by the Free Software Foundation; either version 2
   11    of the License, or (at your option) any later version.
   12
   13    This program is distributed in the hope that it will be useful,
   14    but WITHOUT ANY WARRANTY; without even the implied warranty of
   15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16    GNU General Public License for more details.
   17
   18    You should have received a copy of the GNU General Public
   19    License along with this library; if not, write to the Free Software
   20    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   21
   22    As a special exception, if you link this library with other files,
   23    compiled with a Free Software compiler, to produce an executable, this
   24    library does not by itself cause the resulting executable to be covered
   25    by the GNU General Public License. This exception does not however
   26    invalidate any other reasons why the executable file might be covered by
   27    the GNU General Public License.
   28*/
   29
   30:- module(git_html,
   31	  [ git_shortlog//2,		% +Dir, +Options
   32	    git_commit_info//3		% +Dir, +Hash, +Options
   33	  ]).   34:- use_module(library(git)).   35:- use_module(library(dcg/basics)).   36:- use_module(library(http/http_dispatch)).   37:- use_module(library(http/html_write)).   38:- use_module(library(http/html_head)).   39:- use_module(library(http/http_wrapper)).   40:- use_module(library(http/http_parameters)).   41
   42:- html_meta
   43	odd_even_row(+, -, html, ?, ?).   44
   45:- predicate_options(git_commit_info//3, 3,
   46		     [ diff(oneof([patch,stat])),
   47		       pass_to(git:git_show/4, 4)
   48		     ]).   49:- predicate_options(git_shortlog//2, 2,
   50		     [ pass_to(git:git_shortlog/3, 3)
   51		     ]).   52
   53:- http_handler(root(git_show), git_show, []).
 git_shortlog(+Dir, +Options)//
Component that show the top-N most recent changes in Pack.
   59git_shortlog(Dir, Options) -->
   60	{ git_shortlog(Dir, ShortLog, Options) },
   61	html(table(class(git_shortlog),
   62		   \shortlog_rows(ShortLog, Dir, 1))).
   63
   64shortlog_rows([], _, _) --> [].
   65shortlog_rows([H|T], Pack, Row) -->
   66	odd_even_row(Row, Next, \shortlog_row(H, Pack)),
   67	shortlog_rows(T, Pack, Next).
   68
   69shortlog_row(Record, Pack) -->
   70	html([ \td_git_log(Pack, author_date_relative, Record),
   71	       \td_git_log(Pack, author_name, Record),
   72	       \td_git_log(Pack, subject_and_refnames, Record)
   73	     ]).
   74
   75td_git_log(Pack, subject_and_refnames, Record) --> !,
   76	{ git_log_data(subject, Record, Subject),
   77	  git_log_data(ref_names, Record, RefNames),
   78	  git_log_data(commit_hash, Record, Commit),
   79	  http_link_to_id(git_show, [a(commit),h(Commit),r(Pack)], HREF)
   80	},
   81	html(td(class(subject),
   82		[ a(href(HREF), \trunc(Subject, 50)), \ref_names(RefNames)])).
   83td_git_log(_, Field, Record) -->
   84	{ git_log_data(Field, Record, Value),
   85	  (   Value == ''
   86	  ->  Class = empty
   87	  ;   Class = Field
   88	  )
   89	},
   90	html(td(class(Class), Value)).
   91
   92ref_names([]) --> !.
   93ref_names(List) -->
   94	html(span(class(ref_names), \ref_name_list(List))).
   95
   96ref_name_list([]) --> [].
   97ref_name_list([H|T]) -->
   98	html(span(class(ref_name), H)), ref_name_list(T).
   99
  100trunc(Text, Max) -->
  101	{ truncate_atom(Text, Max, Show) },
  102	html(Show).
 git_show(+Request) is det
HTTP handler to handle GIT requests.
  109git_show(Request) :-
  110	http_parameters(Request,
  111			[ a(Action,
  112			    [ oneof([commit]),
  113			      description('Action to perform')
  114			    ]),
  115			  h(Hash,
  116			    [ description('Hash to work on')
  117			    ]),
  118			  r(Dir,
  119			    [ description('Git directory')
  120			    ]),
  121			  diff(Diff,
  122			       [ oneof([stat,patch]),
  123				 default(stat),
  124				 description('Diff-style for commit')
  125			       ])
  126			]),
  127	reply_html_page(git(show(Action, Dir, Hash)),
  128			title('Commit info'),
  129			[ \html_requires(css('plweb.css')),
  130			  \git_commit_info(Dir, Hash, [diff(Diff)])
  131			]).
 git_commit_info(+Dir, +Hash, +Options)//
Component to show an individual commit. Options:
diff(Diff)
One of stat (default) or patch (full difference)
  141git_commit_info(Dir, Hash, Options) -->
  142	{ select_option(diff(Diff), Options, Rest, stat),
  143	  git_show(Dir, Hash, Record-Body, [diff(Diff)|Rest]),
  144	  git_commit_data(subject, Record, Subject)
  145	},
  146	html_requires(css('git.css')),
  147	html(div(class(cpack),
  148		 [ div(class('git-comment'), Subject),
  149		   table(class(commit),
  150			 [ \tr_commit(author,	 author_name, Record),
  151			   \tr_commit('',        author_date, Record),
  152			   \tr_commit(committer, committer_name, Record),
  153			   \tr_commit('',        committer_date, Record),
  154			   tr([th(commit),       td(class(commit), Hash)]),
  155			   \tr_commit(tree,      tree_hash, Record),
  156			   \tr_commit(parent,    parent_hashes, Record)
  157			 ]),
  158		   \select_diff(Diff),
  159		   pre(class(commitdiff),
  160		       \diff_lines(Body, Diff))
  161		 ])).
  162
  163select_diff(Now) -->
  164	{ other_diff(Now, Other),
  165	  http_current_request(Request),
  166	  http_reload_with_parameters(Request, [diff(Other)], HREF)
  167	},
  168	html(div(class(diffstyle),
  169	       ['Diff style: ', b(Now), ' ', a(href(HREF), Other)])).
  170
  171other_diff(patch, stat).
  172other_diff(stat, patch).
  173
  174diff_lines([], _) --> [].
  175diff_lines([Line|T], Diff) -->
  176	(   { diff_line_class(Line, Diff, Class) }
  177	->  html(span(class(Class), ['~s'-[Line]]))
  178	;   diff_line(Line, Diff)
  179	->  []
  180	;   html('~s'-[Line])
  181	),
  182	(   {T==[]}
  183	->  []
  184	;   ['\n'],
  185	    diff_lines(T, Diff)
  186	).
  187
  188term_expansion(diff_line_class(Start, Diff, Class),
  189	       diff_line_class(Codes, Diff, Class)) :-
  190	string_codes(Start, StartCodes),
  191	append(StartCodes, _, Codes).
  192
  193diff_line_class("diff ", patch, diff).
  194diff_line_class("--- ", patch, a).
  195diff_line_class("+++ ", patch, b).
  196diff_line_class("-", patch, del).
  197diff_line_class("+", patch, add).
  198
  199diff_line(Line, stat) -->
  200	{ phrase(dirstat(File, Sep, Count, Plusses, Minus), Line) },
  201	html([ ' ', span(class(file), '~s'-[File]),
  202	       '~s'-[Sep],
  203	       '~s'-[Count], ' ',
  204	       span(class(add), '~s'-[Plusses]),
  205	       span(class(del), '~s'-[Minus])
  206	     ]).
  207
  208dirstat(File, Sep, [D0|RD], Plusses, Minus) -->
  209	" ",
  210	string_without(" ", File),
  211	string(Sep),
  212	digit(D0),digits(RD),
  213	" ",
  214	plusses(Plusses),
  215	minuss(Minus).
  216
  217plusses([0'+|T]) --> "+", !, plusses(T).
  218plusses([]) --> [].
  219
  220minuss([0'-|T]) --> "-", !, minuss(T).
  221minuss([]) --> [].
  222
  223tr_commit(Label, Field, Record) -->
  224	{ git_commit_data(Field, Record, Value) },
  225	html(tr([th(Label), td(class(Field), Value)])).
  226
  227
  228		 /*******************************
  229		 *	       UTIL		*
  230		 *******************************/
 odd_even_row(+Row, -Next, :Content)//
Create odd/even alternating table rows from a DCG.
  236odd_even_row(Row, Next, Content) -->
  237	{ (   Row mod 2 =:= 0
  238	  ->  Class = even
  239	  ;   Class = odd
  240	  ),
  241	  Next is Row+1
  242	},
  243	html(tr(class(Class), Content)).
 truncate_atom(+Atom, +MaxLen, -Truncated) is det
If Atom is longer than MaxLen, truncate it. If MaxLen is inf, Truncated is unified with Atom.
  250truncate_atom(Atom, inf, All) :- !,
  251	All = Atom.
  252truncate_atom(Atom, MaxLen, Truncated) :-
  253	atom_length(Atom, Len),
  254	(   Len =< MaxLen
  255	->  Truncated = Atom
  256	;   TLen is max(3, MaxLen-4),
  257	    sub_atom(Atom, 0, TLen, _, S0),
  258	    atom_concat(S0, ' ...', Truncated)
  259	).
  260
  261:- multifile plweb:page_title//1.  262
  263plweb:page_title(git(show(commit, _Dir, _Commit))) -->
  264	html('GIT commit info')