blog: Convert all html files to org-mode
[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 COMMITED-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      (("/features.html"                    "Features")
76       ("/news.html"                        "News")
77       ("/people/index.html"                "People")
78       ("/service.html"                     "Service")))
79     ("/donate/index.html"
80      "Donate"
81      (("/donate/kudos.html"                "List of Donors")))
82     ("/download/index.html"
83      "Download"
84      (("/download/integrity_check.html"    "Integrity&nbsp;Check")
85       ("/download/supported_systems.html"  "Supported&nbsp;Systems")
86       ("/download/release_notes.html"      "Release&nbsp;Notes")
87       ("/download/mirrors.html"            "Mirrors")
88       ("/download/cvs_access.html"         "GIT")))
89     ("/documentation/index.html"
90      "Documentation"
91      (("/documentation/howtos.html"        "HOWTOs")
92       ("/documentation/manuals.html"       "Manuals")
93       ("/documentation/guides.html"        "Guides")
94       ("/documentation/faqs.html"          "FAQs")
95       ("/documentation/mailing-lists.html" "Mailing&nbsp;Lists")
96       ("/documentation/sites.html"         "Sites")
97       ("/documentation/bts.html"           "Bug&nbsp;Tracker")))
98     ("/related_software/index.html"
99      "Related software"
100      (("/related_software/frontends.html"  "Frontends")
101       ("/related_software/tools.html"      "Tools")
102       ("/related_software/libraries.html"  "Libraries")
103       ("/related_software/swlist.html"     "All"))))
104   "The definition of the gnupg.org menu structure.")
105
106 (defconst gpgweb-gnupg-bottom-menu-alist
107   '(("/privacy-policy.html"
108      "Privacy&nbsp;Policy"
109      ())
110     ("/imprint.html"
111      "Imprint"
112      ())
113     ("/misc/index.html"
114      "Archive"
115      ())
116     ("/sitemap.html"
117      "Sitemap"
118      ())
119     ("/blog/index.html"
120      "Blog"
121      ()))
122   "The definition of the gnupg.org bottom menu structure.")
123
124
125 (defun gpgweb--any-selected-menu-p (menu selected-file)
126   "Return t if any item in MENU has been selected."
127   (let ((item (car menu))
128         res)
129     (when menu
130       (when item
131         (when (string= (car item) selected-file)
132             (setq res t))
133         (when (caddr item)
134           (when (gpgweb--any-selected-menu-p (caddr item) selected-file)
135             (setq res t))))
136       (when (gpgweb--any-selected-menu-p (cdr menu) selected-file)
137         (setq res t)))
138     res))
139
140
141 (defun gpgweb--selected-top-menu (menu selected-file)
142   "Return the selected top menu or nil."
143   (when menu
144     (let ((item (car menu)))
145       (if (and item
146                (or (string= (car item) selected-file)
147                    (gpgweb--any-selected-menu-p (caddr item) selected-file)))
148           menu
149         (gpgweb--selected-top-menu (cdr menu) selected-file)))))
150
151 (defun gpgweb--insert-menu (menu lvl selected-file)
152   "Helper function to insert the menu."
153   (when menu
154     (let ((item (car menu)))
155       (when item
156         (dotimes (i (1+ lvl)) (insert "  "))
157         (insert "  <li><a href=\"" (car item) "\"")
158         (when (or (string= (car item) selected-file)
159                   (gpgweb--any-selected-menu-p (caddr item) selected-file))
160           (insert " class=\"selected\""))
161         (insert  ">" (cadr item) "</a>\n")
162         (when (caddr item)
163           (dotimes (i (1+ lvl)) (insert "  "))
164           (insert "  <ul class=\"sub-menu\">\n")
165           (gpgweb--insert-menu (caddr item) (1+ lvl) selected-file)
166           (dotimes (i (1+ lvl)) (insert "  "))
167           (insert "  </ul>\n"))
168         (dotimes (i (1+ lvl)) (insert "  "))
169         (insert "  </li>\n")))
170     (gpgweb--insert-menu (cdr menu) lvl selected-file)))
171
172
173 (defun gpgweb--insert-submenu (menu selected-file)
174    "Helper function to insert the sub-menu."
175    (when menu
176      (let ((item (car menu)))
177        (when item
178          (insert "    <li><a href=\"" (car item) "\"")
179          (when (or (string= (car item) selected-file)
180                    (gpgweb--any-selected-menu-p (caddr item) selected-file))
181            (insert " class=\"selected\""))
182          (insert ">" (cadr item) "</a></li>\n")))
183      (gpgweb--insert-submenu (cdr menu) selected-file)))
184
185
186 (defun gpgweb-insert-menu (selected-file)
187   "Insert the menu structure into the HTML file."
188   (goto-char (point-min))
189   (when (re-search-forward "^<body>\n" nil t)
190     (insert "<div id=\"wrapper\">
191 <div id=\"header\"><a href=\"/index.html\" class=\"logo\"
192      ><img src=\"/share/logo-gnupg-light-purple-bg.png\"></a>&nbsp;</div>
193 <nav>
194   <ul>
195 ")
196     (gpgweb--insert-menu gpgweb-gnupg-menu-alist 0 selected-file)
197     (insert "  </ul>
198 </nav>
199 ")
200     (let ((m (caddr (car (gpgweb--selected-top-menu
201                           gpgweb-gnupg-menu-alist selected-file)))))
202       (when m
203           (insert "<nav class=\"subnav\">\n  <ul>\n")
204           (gpgweb--insert-submenu m selected-file)
205           (insert "  </ul>\n</nav>\n")))
206     (insert "<main>
207 <div id=\"content\">
208 ")))
209
210
211 (defun gpgweb-fixup-blog (info)
212   "Fix up a a blog entry."
213   (goto-char (point-min))
214   (if (re-search-forward "^<h2 id=.*\n" nil t)
215     (insert "<p class=\"postdate\">Posted "
216             (car (plist-get info :date))
217             " by "
218             (car (plist-get info :author))
219             "</p>\n")))
220
221
222 (defun gpgweb-insert-footer ()
223   (goto-char (point-max))
224   (insert "</div><!-- end content -->
225 </main>
226 <div id=\"footer\">
227   <div id=\"nav_bottom\">
228   <ul>
229 ")
230   (gpgweb--insert-menu gpgweb-gnupg-bottom-menu-alist 0 nil)
231   (insert "  </ul>
232   </div>
233 ")
234   (goto-char (point-min))
235   (unless (search-forward "<!--disable-copyright-footer-->" nil t)
236     (goto-char (point-max))
237     (insert "  <div id=\"cpyright\">
238     <a rel=\"license\" href=\"http://creativecommons.org/licenses/by-sa/3.0/\"
239       ><img alt=\"CC-BY-SA 3.0\" style=\"border: 0\"
240             src=\"/share/cc-by-sa-3.0_80x15.png\"/></a>&nbsp;
241     These web pages are
242     Copyright 1998--2014 The GnuPG Project and licensed under a
243     <a rel=\"license\" href=\"http://creativecommons.org/licenses/by-sa/3.0/\"
244     >Creative Commons Attribution-ShareAlike 3.0 Unported License</a>.  See
245     <a href=\"/copying.html\">copying</a> for details.
246   </div>\n"))
247   (goto-char (point-max))
248   (insert "</div>
249 </div><!-- end wrapper -->
250 </body>
251 </html>"))
252
253
254 ;;; Post-process the generated HTML file:
255 ;;;
256 ;;; - Insert header and footer
257 ;;; - Insert "class=selected" into the active menu entry
258 ;;; - Fixup sitemap.
259 (defun gpgweb-postprocess-html (plist orgfile htmlfile blogmode)
260   (let* ((visitingp (find-buffer-visiting htmlfile))
261          (work-buffer (or visitingp (find-file-noselect htmlfile)))
262          (committed-at (shell-command-to-string
263                         (concat "git log -1 --format='%ci' -- " orgfile))))
264     (prog1 (with-current-buffer work-buffer
265              (let ((fname (file-name-nondirectory htmlfile))
266                    (fname-2 (replace-regexp-in-string
267                              ".*/stage\\(/.*\\)$" "\\1" htmlfile t))
268                    (title (org-publish-find-title orgfile)))
269                ;; Insert header, menu, and footer.
270                (gpgweb-insert-header title committed-at)
271                (gpgweb-insert-menu fname-2)
272                (if blogmode
273                    (gpgweb-fixup-blog plist))
274                (gpgweb-insert-footer)
275
276                ; Fixup the sitemap
277                (when (string-equal fname "sitemap.html")
278                  (goto-char (point-min))
279                  (while (re-search-forward
280                          "^.*<li>.*>\\(GnuPG - \\).*<span.*$" nil t)
281                    (replace-match "" t nil nil 1)))
282
283                ; Due to a problem with the current org exporter (cases
284                ; were we link to file mapped via a webserver alias) we
285                ; have to use a full URL at some places in the org
286                ; source.  We fix that up here.
287                (goto-char (point-min))
288                (while (re-search-forward
289                        "href=\"\\(https://www.gnupg.org\\)/.*\"" nil t)
290                  (replace-match "" t t nil 1))
291
292                ; And save the changes
293                (basic-save-buffer))
294       (unless visitingp (kill-buffer work-buffer))))))
295
296
297 ;;;
298 ;;; The publishing function used by the HTML exporter
299 ;;;
300 (defun gpgweb-org-to-html (plist filename pub-dir)
301   (gpgweb-postprocess-html plist
302                            filename
303                            (org-gpgweb-publish-to-html plist filename pub-dir)
304                            nil))
305
306
307 ;;;
308 ;;; The specialized publisher for the blog entries.
309 ;;;
310 (defun gpgweb-render-blob ()
311   (interactive)
312   (let* ((extplist '(:language "en"
313                      :section-numbers nil
314                      :tags nil
315                      :with-toc nil))
316          (orgfile (buffer-file-name))
317          (plist (org-export-get-environment 'gpgweb nil extplist))
318          (htmlfile (org-gpgweb-export-to-html nil nil nil t extplist)))
319     (gpgweb-postprocess-html plist orgfile htmlfile t)))
320
321
322
323 (defun gpgweb-upload ()
324   (let ((stagedir (plist-get project-plist :publishing-directory)))
325     (message "gpgweb  rootdir '%s'" gpgweb-root-dir)
326     (message "gpgweb stagedir '%s'" stagedir)
327     (shell-command
328      (concat "cd " gpgweb-root-dir " && cd " stagedir
329              "&& rsync -rlt --exclude \"*~\" ./ "
330              "werner@trithemius.gnupg.org:"
331              "/var/www/www/www.gnupg.org/htdocs/ ;"
332              " ssh werner@trithemius.gnupg.org"
333              " touch /var/www/www/www.gnupg.org/htdocs/donate/donors.dat"))
334 ))
335
336 (provide 'gpgweb)