web: Add "Traueranzeige"
[gnupg-doc.git] / web / share / gpgweb.el
1 ;;; gpgweb.el --- elisp helper code for the GnuPG web pages
2
3 (require 'org-exp)
4
5 (defun gpgweb-setup-project ()
6   "Set up an org-publish project for the gnupg.org website."
7   (progn
8    (require 'ox-gpgweb (concat gpgweb-root-dir "share/ox-gpgweb.el"))
9    (aput 'org-publish-project-alist "gpgweb-org"
10    '(:base-directory "~/s/gnupg-doc/web"
11      :base-extension "org"
12      :language "en"
13      :html-extension "html"
14      :recursive t
15      :publishing-directory "../stage"
16      :publishing-function gpgweb-org-to-html
17      :body-only t
18      :section-numbers nil
19      :tags nil
20      :with-toc nil
21      :makeindex t
22      :auto-sitemap nil
23      :sitemap-title "GnuPG - Sitemap"
24      :sitemap-sort-folders "last"
25      :sitemap-file-entry-format "%t  @@html:<span id=\"smallnote\">@@(%d)@@html:</span>@@"
26      :style-include-default nil
27      :timestamp-file nil
28      :html-head "<link rel=\"stylesheet\" href=\"gnupg.css\" type=\"text/css\" />"
29      :html-head-include-scripts nil))
30
31    (aput 'org-publish-project-alist "gpgweb-other"
32    '(:base-directory "."
33      :base-extension "jpg\\|png\\|css\\|txt\\|rss\\|lst\\|sig"
34      :recursive t
35      :publishing-directory "../stage"
36      :publishing-function org-publish-attachment
37      :completion-function gpgweb-upload))
38
39    (aput 'org-publish-project-alist "gpgweb"
40    '(:components ("gpgweb-org" "gpgweb-other")))))
41
42
43 (defun gpgweb-insert-header (title committed-at)
44   "Insert the header.
45
46 COMMITTED-AT is the commit date string of the source file or nil
47 if not available."
48   (goto-char (point-min))
49   (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>
50 <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
51                \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
52 <html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"en\" xml:lang=\"en\">
53 <head>
54 <title>" title "</title>
55 <meta http-equiv=\"Content-Type\" content=\"text/html;charset=utf-8\" />\n")
56   (when (and committed-at (>= (length committed-at) 10))
57       (insert "<meta name=\"DC.Date\" content=\""
58               (substring committed-at 0 10) "\" />\n"))
59   (insert "<meta name=\"DC.Language\" content=\"en\" />
60 <meta name=\"DC.Title\" content=\"" title "\" />
61 <meta name=\"DC.Description\"
62  content=\"GnuPG is a free implementation of OpenPGP\" />
63 <meta name=\"DC.Creator\" content=\"The People of the GnuPG Project\" />
64 <meta name=\"DC.Publisher\" content=\"The GnuPG Project\" />
65 <meta name=\"DC.Identifier\" content=\"https://gnupg.org/\" />
66 <meta name=\"DC.Rights\" content=\"https://gnupg.org/copying.html\" />
67 <link rel=\"stylesheet\" href=\"/share/site.css\" type=\"text/css\" />
68 </head>
69 <body>
70 "))
71
72 (defconst gpgweb-gnupg-menu-alist
73   '(("/index.html"
74      "Home"
75      (("/index.html"                       "Home")
76       ("/features.html"                    "Features")
77       ("/news.html"                        "News")
78       ("/people/index.html"                "People")
79       ("/service.html"                     "Service")))
80     ("/donate/index.html"
81      "Donate"
82      (("/donate/index.html"                "Donate")
83       ("/donate/kudos.html"                "List of Donors")))
84     ("/download/index.html"
85      "Download"
86      (("/download/index.html"              "Download")
87       ("/download/integrity_check.html"    "Integrity&nbsp;Check")
88       ("/download/supported_systems.html"  "Supported&nbsp;Systems")
89       ("/download/release_notes.html"      "Release&nbsp;Notes")
90       ("/download/mirrors.html"            "Mirrors")
91       ("/download/cvs_access.html"         "GIT")))
92     ("/documentation/index.html"
93      "Documentation"
94      (("/documentation/howtos.html"        "HOWTOs")
95       ("/documentation/manuals.html"       "Manuals")
96       ("/documentation/guides.html"        "Guides")
97       ("/documentation/faqs.html"          "FAQs")
98       ("/documentation/mailing-lists.html" "Mailing&nbsp;Lists")
99       ("/documentation/sites.html"         "Sites")
100       ("/documentation/bts.html"           "Bug&nbsp;Tracker")))
101     ("/related_software/index.html"
102      "Related software"
103      (("/related_software/frontends.html"  "Frontends")
104       ("/related_software/tools.html"      "Tools")
105       ("/related_software/libraries.html"  "Libraries")
106       ("/related_software/swlist.html"     "All")))
107     ("/blog/index.html"
108      "Blog"))
109   "The definition of the gnupg.org menu structure.")
110
111 (defconst gpgweb-gnupg-bottom-menu-alist
112   '(("/privacy-policy.html"
113      "Privacy&nbsp;Policy"
114      ())
115     ("/imprint.html"
116      "Imprint"
117      ())
118     ("/misc/index.html"
119      "Archive"
120      ())
121     ("/sitemap.html"
122      "Sitemap"
123      ())
124     ("/blog/index.html"
125      "Blog"
126      ()))
127   "The definition of the gnupg.org bottom menu structure.")
128
129
130 (defun gpgweb--any-selected-menu-p (menu selected-file)
131   "Return t if any item in MENU has been selected."
132   (let ((item (car menu))
133         res)
134     (when menu
135       (when item
136         (when (string= (car item) selected-file)
137             (setq res t))
138         (when (caddr item)
139           (when (gpgweb--any-selected-menu-p (caddr item) selected-file)
140             (setq res t))))
141       (when (gpgweb--any-selected-menu-p (cdr menu) selected-file)
142         (setq res t)))
143     res))
144
145
146 (defun gpgweb--selected-top-menu (menu selected-file)
147   "Return the selected top menu or nil."
148   (when menu
149     (let ((item (car menu)))
150       (if (and item
151                (or (string= (car item) selected-file)
152                    (gpgweb--any-selected-menu-p (caddr item) selected-file)))
153           menu
154         (gpgweb--selected-top-menu (cdr menu) selected-file)))))
155
156 (defun gpgweb--insert-menu (menu lvl selected-file)
157   "Helper function to insert the menu."
158   (when menu
159     (let ((item (car menu)))
160       (when item
161         (dotimes (i (1+ lvl)) (insert "  "))
162         (insert "  <li><a href=\"" (car item) "\"")
163         (when (or (string= (car item) selected-file)
164                   (gpgweb--any-selected-menu-p (caddr item) selected-file))
165           (insert " class=\"selected\""))
166         (insert  ">" (cadr item) "</a>\n")
167         (when (caddr item)
168           (dotimes (i (1+ lvl)) (insert "  "))
169           (insert "  <ul class=\"sub-menu\">\n")
170           (gpgweb--insert-menu (caddr item) (1+ lvl) selected-file)
171           (dotimes (i (1+ lvl)) (insert "  "))
172           (insert "  </ul>\n"))
173         (dotimes (i (1+ lvl)) (insert "  "))
174         (insert "  </li>\n")))
175     (gpgweb--insert-menu (cdr menu) lvl selected-file)))
176
177
178 (defun gpgweb--insert-submenu (menu selected-file)
179    "Helper function to insert the sub-menu."
180    (when menu
181      (let ((item (car menu)))
182        (when item
183          (insert "    <li><a href=\"" (car item) "\"")
184          (when (or (string= (car item) selected-file)
185                    (gpgweb--any-selected-menu-p (caddr item) selected-file))
186            (insert " class=\"selected\""))
187          (insert ">" (cadr item) "</a></li>\n")))
188      (gpgweb--insert-submenu (cdr menu) selected-file)))
189
190
191 (defun gpgweb-insert-menu (selected-file)
192   "Insert the menu structure into the HTML file."
193   (goto-char (point-min))
194   (when (re-search-forward "^<body>\n" nil t)
195     (insert "<div id=\"wrapper\">
196 <div id=\"header\"><a href=\"/index.html\" class=\"logo\"
197      ><img src=\"/share/logo-gnupg-light-purple-bg.png\"></a>&nbsp;</div>
198 <nav>
199   <ul>
200 ")
201     (gpgweb--insert-menu gpgweb-gnupg-menu-alist 0 selected-file)
202     (insert "  </ul>
203 </nav>
204 ")
205     (let ((m (caddr (car (gpgweb--selected-top-menu
206                           gpgweb-gnupg-menu-alist selected-file)))))
207       (when m
208           (insert "<nav class=\"subnav\">\n  <ul>\n")
209           (gpgweb--insert-submenu m selected-file)
210           (insert "  </ul>\n</nav>\n")))
211     (insert "<main>
212 <div id=\"content\">
213 ")))
214
215
216 (defun gpgweb-blog-index (orgfile filelist)
217   "Return the index of ORGFILE in FILELIST or nil if not found."
218   (let (found
219         (i 0))
220     (while (and filelist (not found))
221       (if (string= orgfile (car filelist))
222           (setq found i))
223       (setq i (1+ i))
224       (setq filelist (cdr filelist)))
225     found))
226
227 (defun gpgweb-blog-prev (fileidx filelist)
228   "Return the chronological previous file at FILEIDX from FILELIST
229 with the suffixed replaced by \"html\"."
230   (if (> fileidx 1)
231       (concat (file-name-sans-extension (nth (1- fileidx) filelist)) ".html")))
232
233 (defun gpgweb-blog-next (orgfile filelist)
234   "Return the chronological next file at FILEIDX from FILELIST
235 with the suffixed replaced by \"html\"."
236   (if (< fileidx (1- (length filelist)))
237       (concat (file-name-sans-extension (nth (1+ fileidx) filelist)) ".html")))
238
239 (defun gpgweb-fixup-blog (info orgfile filelist)
240   "Insert the blog specific content.  INFO is the usual
241 plist. ORGFILE is the name of the current source file without the
242 directory part.  If FILELIST is a list it has an ordered list of
243 org filenames."
244   (let ((authorstr (car (plist-get info :author)))
245         (datestr   (car (plist-get info :date))))
246     (goto-char (point-min))
247     (if (re-search-forward "^<main>" nil t)
248         (let* ((indexp (string= orgfile "index.org"))
249                (fileidx (if (listp filelist)
250                             (if indexp
251                                 (1- (length filelist))
252                               (gpgweb-blog-index orgfile filelist))))
253                (prevfile (if fileidx
254                              (gpgweb-blog-prev fileidx filelist)))
255                (nextfile (if (and fileidx (not indexp))
256                            (gpgweb-blog-next fileidx filelist))))
257           (move-beginning-of-line nil)
258           (insert "<nav class=\"subnav\">\n  <ul>\n")
259           (if prevfile
260               (insert "    <li><a href=\"" prevfile "\">Previous</a></li>\n"))
261           (insert
262            "    <li><a href=\"/blog/index.html#blogindex\">Index</a></li>\n")
263           (if nextfile
264               (insert "    <li><a href=\"" nextfile "\">Next</a></li>\n"))
265           (insert "  </ul>\n</nav>\n")))
266     (if (and datestr authorstr)
267         (if (re-search-forward "^<h2 id=.*\n" nil t)
268             (insert "<p class=\"postdate\">Posted "
269                     datestr
270                     " by "
271                     authorstr
272                     "</p>\n")))))
273
274
275 (defun gpgweb-insert-footer (htmlfile committed-at blogmode)
276   "Insert the footer.
277
278 HTMLFILE is HTML file name and COMMITTED-AT is the commit date
279 string of the source file or nil if not available."
280   (let ((srcfile (concat "https://git.gnupg.org/cgi-bin/gitweb.cgi?"
281                          "p=gnupg-doc.git;a=blob;f="
282                          (if blogmode "misc/blog.gnupg.org" "web")
283                          ;; The replace below is a hack to cope with
284                          ;; blogmode where HTMLFILE is like "./foo.html".
285                          (replace-regexp-in-string
286                           "^\\./" "/"
287                           (file-name-sans-extension htmlfile) t)
288                          ".org"))
289         (changed (if (and committed-at (>= (length committed-at) 10))
290                      (substring committed-at 0 10)
291                      "[unknown]")))
292     (goto-char (point-max))
293     (insert "</div><!-- end content -->
294 </main>
295 <div id=\"footer\">
296   <div id=\"nav_bottom\">
297   <ul>
298 ")
299     (gpgweb--insert-menu gpgweb-gnupg-bottom-menu-alist 0 nil)
300     (insert "    </ul>
301   </div>
302 ")
303     (insert "  <div class=\"footerbox\">
304   <a><img src=\"/share/traueranzeige-g10_v2015.png\"
305           width=\"200px\" height=\"73px\"
306           alt=\"Traueranzeige: Wir nehmen Abschied von einem sicher geglaubten Freund, dem | Fernmeldegeheimniss | (Artikel 10 Grundgesetz) | * 23. Mai 1949, + 18. Dezember 2015\"
307           title=\"Article 10 of the German constitution (communication privacy) is not anymore with us.\" /></a>
308   <p></p>
309   </div>
310 ")
311     (goto-char (point-min))
312     (unless (search-forward "<!--disable-copyright-footer-->" nil t)
313       (goto-char (point-max))
314       (insert "  <div id=\"cpyright\">
315     <a rel=\"license\" href=\"http://creativecommons.org/licenses/by-sa/3.0/\"
316       ><img alt=\"CC-BY-SA 3.0\" style=\"border: 0\"
317             src=\"/share/cc-by-sa-3.0_80x15.png\"/></a>&nbsp;
318     These web pages are
319     Copyright 1998--2015 The GnuPG Project and licensed under a
320     <a rel=\"license\" href=\"http://creativecommons.org/licenses/by-sa/3.0/\"
321     >Creative Commons Attribution-ShareAlike 3.0 Unported License</a>.  See
322     <a href=\"/copying.html\">copying</a> for details.
323     Page <a href=\"" srcfile "\">source</a> last changed on " changed ".
324   </div>\n"))
325   (goto-char (point-max))
326   (insert "</div>
327 </div><!-- end wrapper -->
328 </body>
329 </html>")))
330
331
332 ;;; Post-process the generated HTML file:
333 ;;;
334 ;;; - Insert header and footer
335 ;;; - Insert "class=selected" into the active menu entry
336 ;;; - Fixup sitemap.
337 ;;;
338 ;;; If blogmode is not nil the output is rendered as a blog.  BLOGMODE
339 ;;; may then contain an ordered list of org file names which are used
340 ;;; to create the previous and Next links for an entry.
341 ;;;
342 (defun gpgweb-postprocess-html (plist orgfile htmlfile blogmode)
343   (let* ((visitingp (find-buffer-visiting htmlfile))
344          (work-buffer (or visitingp (find-file-noselect htmlfile)))
345          (committed-at (shell-command-to-string
346                         (concat "git log -1 --format='%ci' -- " orgfile))))
347     (prog1 (with-current-buffer work-buffer
348              (let ((fname (file-name-nondirectory htmlfile))
349                    (fname-2 (replace-regexp-in-string
350                               ".*/stage\\(/.*\\)$" "\\1" htmlfile t))
351                    (title (org-publish-find-title orgfile)))
352                ;; Insert header, menu, and footer.
353                (gpgweb-insert-header title committed-at)
354                (gpgweb-insert-menu fname-2)
355                (if blogmode
356                    (gpgweb-fixup-blog plist
357                                       (file-name-nondirectory orgfile)
358                                       blogmode))
359                (gpgweb-insert-footer fname-2 committed-at blogmode)
360
361                ; Fixup the sitemap
362                (when (string-equal fname "sitemap.html")
363                  (goto-char (point-min))
364                  (while (re-search-forward
365                          "^.*<li>.*>\\(GnuPG - \\).*<span.*$" nil t)
366                    (replace-match "" t nil nil 1)))
367
368                ; Due to a problem with the current org exporter (cases
369                ; were we link to file mapped via a webserver alias) we
370                ; have to use a full URL at some places in the org
371                ; source.  We fix that up here.
372                (goto-char (point-min))
373                (while (re-search-forward
374                        "href=\"\\(https://www.gnupg.org\\)/.*\"" nil t)
375                  (replace-match "" t t nil 1))
376
377                ; If the wideright flag is used, change <td> and <th>
378                ; attributes.
379                (goto-char (point-min))
380                (when (search-forward "<!--table_data_wideright-->" nil t)
381                  (goto-char (point-min))
382                  (while (re-search-forward
383                          "^<t[hd].*class=\"\\(right\\)\".*$" nil t)
384                    (replace-match "right wideright" t nil nil 1)))
385
386                ; And save the changes
387                (basic-save-buffer))
388       (unless visitingp (kill-buffer work-buffer))))))
389
390
391 ;;;
392 ;;; The publishing function used by the HTML exporter
393 ;;;
394 (defun gpgweb-org-to-html (plist filename pub-dir)
395   (gpgweb-postprocess-html plist
396                            filename
397                            (org-gpgweb-publish-to-html plist filename pub-dir)
398                            nil))
399
400
401 ;;;
402 ;;; Turn the current buffer which has an org-mode blog entry into its
403 ;;; rendered form and save it with the suffix .html.
404 ;;;
405 (defun gpgweb-render-blog (&optional filelist)
406   (interactive)
407   (let* ((extplist '(:language "en"
408                      :section-numbers nil
409                      :tags nil
410                      :with-toc nil))
411          (orgfile (buffer-file-name))
412          (plist (org-export-get-environment 'gpgweb nil extplist))
413          (htmlfile (org-gpgweb-export-to-html nil nil nil t extplist)))
414     (gpgweb-postprocess-html plist orgfile htmlfile (if filelist filelist t))))
415
416
417 ;;;
418 ;;; Publish all blog entries in the current directory
419 ;;;
420 (defun gpgweb-publish-blogs ()
421   (interactive)
422   (let ((orgfiles (directory-files "." nil "^2[0-9]+-.*\.org$")))
423     (dolist (file (cons "index.org" orgfiles))
424       (let* ((visitingp (find-buffer-visiting file))
425              (work-buffer (or visitingp (find-file-noselect file))))
426         (with-current-buffer work-buffer
427           (gpgweb-render-blog orgfiles)
428           (basic-save-buffer))
429         (unless visitingp
430           (kill-buffer work-buffer))))))
431
432
433
434 (defun gpgweb-upload ()
435   (let ((stagedir (plist-get project-plist :publishing-directory)))
436     (message "gpgweb  rootdir '%s'" gpgweb-root-dir)
437     (message "gpgweb stagedir '%s'" stagedir)
438     (shell-command
439      (concat "cd " gpgweb-root-dir " && cd " stagedir
440              "&& rsync -rlt --exclude \"*~\" ./ "
441              "werner@trithemius.gnupg.org:"
442              "/var/www/www/www.gnupg.org/htdocs/ ;"
443              " ssh werner@trithemius.gnupg.org"
444              " touch /var/www/www/www.gnupg.org/htdocs/donate/donors.dat"))
445 ))
446
447 (provide 'gpgweb)