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