29
30:- module(wiki_edit,
31 [ location_wiki_file/2,
32 location_wiki_file/3
33 ]). 34:- use_module(library(lists)). 35:- use_module(library(debug)). 36:- use_module(library(http/http_dispatch)). 37:- use_module(library(http/http_parameters)). 38:- use_module(library(http/html_write)). 39:- use_module(library(http/js_write)). 40:- use_module(library(http/html_head)). 41:- use_module(library(http/http_path)). 42:- use_module(library(git)). 43:- use_module(library(broadcast)). 44:- use_module(wiki). 45:- use_module(git_html). 46:- use_module(markitup). 47:- use_module(notify). 48:- use_module(openid).
55:- http_handler(root(wiki_edit), wiki_edit, []). 56:- http_handler(root(wiki_save), wiki_save, []). 57:- http_handler(root(wiki/sandbox), wiki_sandbox, []). 58:- http_handler(root(wiki/changes), wiki_changes, []).
64:- public edit_button//1. 65:- multifile edit_button//1. 66
67edit_button(Location) -->
68 { http_link_to_id(wiki_edit, [location(Location)], HREF) },
69 html(a(href(HREF),
70 img([ class(action),
71 alt(edit),
72 title('Edit wiki page'),
73 src(location_by_id(pldoc_resource)+'edit.gif')
74 ]))).
75
76
77
85wiki_edit(Request) :-
86 authenticate(Request, Fields),
87 nth1(2, Fields, Author),
88 http_parameters(Request,
89 [ location(Location,
90 [ description('Wiki location to edit')
91 ])
92 ]),
93 location_wiki_file(Location, File),
94 allowed_file(File),
95 ( exists_file(File)
96 -> Action = 'Edit'
97 ; Action = 'Create'
98 ),
99 file_base_name(File, BaseName),
100 reply_html_page(
101 wiki(edit(Action, Location)),
102 title('~w ~w'-[Action, BaseName]),
103 \edit_page(Location, File, Author)).
104
105edit_page(Location, File, Author) -->
106 { ( exists_file(File)
107 -> read_file_to_codes(File, Codes, []),
108 string_codes(Content, Codes),
109 file_directory_name(File, Dir)
110 ; Content = "",
111 Dir = _ 112 ),
113 http_location_by_id(wiki_save, Action)
114 },
115 html(div(class(wiki_edit),
116 [ h4('Recent changes'),
117 \shortlog(Dir, [path(File), limit(5)]),
118 form([ action(Action), method('POST') ],
119 [ \hidden(location, Location),
120 table(class(wiki_edit),
121 [ tr(td([ class(wiki_text), colspan(2) ],
122 \markitup([ markup(pldoc),
123 id(text),
124 value(Content)
125 ]))),
126 tr([td(class(label), 'Comment summary:'),
127 td(input([id(git_msg), name(msg)]))]),
128 tr([td(class(label), 'Comment:'),
129 td(textarea([ id(git_comment), cols(55), rows(5), name(comment)],
130 ''))]),
131 tr(td([ align(right), colspan(2) ],
132 [ \amend_button(Dir, File, Author), ' ',
133 input([type(submit), value(save)])
134 ]))
135 ])
136 ])
137 ])).
143amend_button(Dir, File, Author) -->
144 { exists_file(File),
145 git_shortlog(Dir, [ShortLog], [path(File), limit(1)]),
146 git_log_data(author_name, ShortLog, LastAuthor),
147 debug(git, 'Amend: LastAuthor = ~q, Author = ~q', [LastAuthor, Author]),
148 LastAuthor == Author,
149 git_log_data(subject, ShortLog, CommitMessage),
150 split_commit_message(CommitMessage, Summary, _Comment)
151 },
152 js_script({|javascript(Summary,Comment)||
153 function ammend() {
154 if ( $("#ammend-tb").prop('checked') ) {
155 $("#git_msg").val(Summary);
156 $("#git_comment").val(Comment);
157 } else {
158 $("#git_msg").val("");
159 $("#git_comment").val("");
160 }
161 }
162 |}),
163 html([ input([ id('ammend-tb'),
164 type(checkbox),
165 name(amend),
166 value(yes),
167 onClick('ammend()')
168 ]),
169 'Amend previous commit'
170 ]).
171amend_button(_,_,_) --> [].
172
173split_commit_message(CommitMessage, Summary, Comment) :-
174 sub_atom(CommitMessage, B, _, A, '\n\n'), !,
175 sub_atom(CommitMessage, 0, B, _, Summary),
176 sub_atom(CommitMessage, _, A, 0, Comment).
177split_commit_message(Summary, Summary, '').
184shortlog(Dir, _Options) -->
185 { var(Dir) }, !.
186shortlog(Dir, Options) -->
187 html_requires(css('git.css')),
188 git_shortlog(Dir, Options).
189
190
191
199wiki_save(Request) :-
200 authenticate(Request, Fields),
201 author(Fields, Author),
202 http_parameters(Request,
203 [ location(Location,
204 [ description('Path of the file to edit')
205 ]),
206 text(Text,
207 [ description('Wiki content for the file')
208 ]),
209 amend(Amend,
210 [ optional(true),
211 description('Amend previous commit')
212 ]),
213 msg(Msg, []),
214 comment(Comment, [optional(true)])
215 ]),
216 location_wiki_file(Location, File),
217 allowed_file(File),
218 ( exists_file(File)
219 -> New = false
220 ; New = true
221 ),
222 save_file(File, Text),
223 update_wiki_page_title(Location),
224 ( var(Comment)
225 -> GitMsg = Msg
226 ; atomic_list_concat([Msg, Comment], '\n\n', GitMsg)
227 ),
228 file_directory_name(File, Dir),
229 file_base_name(File, Rel),
230 ( New == true
231 -> git([add, Rel], [ directory(Dir) ])
232 ; true
233 ),
234 atom_concat('--author=', Author, AuthorArg),
235 GitArgs0 = [ '-m', GitMsg, AuthorArg, Rel ],
236 ( Amend == yes
237 -> append([commit, '--amend'], GitArgs0, GitArgs)
238 ; append([commit], GitArgs0, GitArgs)
239 ),
240 git(GitArgs,
241 [ directory(Dir)
242 ]),
243 broadcast(modified(wiki(Location))),
244 notify(wiki(Location), wiki_edit(Text)),
245 http_redirect(see_other, Location, Request).
246
247author([_User, Name, EMail], Author) :- !,
248 atomic_list_concat([Name, ' <', EMail, '>'], Author).
249author([_User, Name], Author) :-
250 atomic_list_concat([Name, ' <nospam@nospam.org>'], Author).
256wiki_changes(_Request) :-
257 reply_html_page(
258 wiki(changes),
259 title('WIKI ChangeLog'),
260 \wiki_changelog).
261
262wiki_changelog -->
263 html({|html||
264 |}),
265 shortlog(www, [path(.), limit(50)]).
266
267
268
277location_wiki_file(Relative, File) :-
278 location_wiki_file(Relative, File, write).
279
280location_wiki_file(Relative, File, Access) :-
281 file_name_extension(Base, html, Relative),
282 wiki_extension(Ext),
283 file_name_extension(Base, Ext, WikiFile),
284 absolute_file_name(document_root(WikiFile),
285 File,
286 [ access(Access),
287 file_errors(fail)
288 ]), !.
289location_wiki_file(Relative, File, Access) :-
290 wiki_extension(Ext),
291 file_name_extension(_, Ext, Relative),
292 absolute_file_name(document_root(Relative),
293 File,
294 [ access(Access),
295 file_errors(fail)
296 ]), !.
297location_wiki_file(Relative, File, Access) :-
298 absolute_file_name(document_root(Relative),
299 Dir,
300 [ file_type(directory),
301 file_errors(fail)
302 ]),
303 setting(http:index_files, Indices),
304 member(Index, Indices),
305 directory_file_path(Dir, Index, File),
306 access_file(File, Access), !.
315save_file(File, Text) :-
316 setup_call_cleanup(open(File, write, Out,
317 [ encoding(utf8)
318 ]),
319 write_text(Out, Text),
320 close(Out)).
328write_text(Out, Text) :-
329 forall(sub_atom(Text, _, 1, _, Char),
330 put_non_cr(Out, Char)).
331
332put_non_cr(_Out, Char) :-
333 char_code(Char, 13), !.
334put_non_cr(Out, Char) :-
335 put_char(Out, Char).
343authenticate(Request, Fields) :-
344 authenticate(Request, wiki, Fields).
352allowed_file(File) :-
353 absolute_file_name(document_root(.),
354 DocRoot,
355 [ file_type(directory)
356 ]),
357 sub_atom(File, 0, _, _, DocRoot),
358 access_file(File, write), !.
359allowed_file(File) :-
360 permission_error(edit, file, File).
361
362
363hidden(Name, Value) -->
364 html(input([type(hidden), name(Name), value(Value)])).
371wiki_sandbox(_Request) :-
372 reply_html_page(wiki(sandbox),
373 title('PlDoc wiki sandbox'),
374 [ \sandbox
375 ]).
376
377sandbox -->
378 { http_absolute_location(root('pldoc/package/pldoc.html'), PlDoc, [])
379 },
380 html([ p([ 'This page provides a sandbox for the ',
381 a(href(PlDoc), 'PlDoc'),
382 ' wiki format. The preview window is updated every ',
383 'time you hit the RETURN or TAB key.'
384 ]),
385 p([ 'Note that PlDoc wiki is normally embedded in a ',
386 'Prolog source file using a ', i('structured comment'),
387 ', i.e., a comment that starts with %! or /**'
388 ]),
389 div(\markitup([ markup(pldoc),
390 preview(true)
391 ]))
392 ]).
393
394
395 398
399:- multifile
400 mail_notify:event_subject//1, 401 mail_notify:event_message//1. 402
403mail_notify:event_subject(wiki_edit(_)) -->
404 [ 'Wiki edit'-[] ].
405
406mail_notify:event_message(wiki_edit(Text)) -->
407 [ 'Wiki edit'-[],
408 nl, nl,
409 '====~n~w~n===='-[Text],
410 nl
411 ].
412
413
414:- multifile plweb:page_title//1. 415
416plweb:page_title(wiki(changes)) -->
417 html('Recent changes to the SWI-Prolog wiki pages')
Edit PlDoc wiki pages
*/