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