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