web: Open only the active submenu.
[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 generated-at)
44   "Insert the header.
45
46 Note that using GENERATED-AT is highly problematic because rsync
47 would the always update the file.  IF would be better to use the
48 file date of the source file but that has the problem that git
49 does not track it.  We need to find a solution for this unless we
50 can do without DC.Date.  A possible way to fix this is to use a
51 source file property which could be updated using Emacs features.
52 Or set a new date only if the file really changed. "
53   (goto-char (point-min))
54   (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>
55 <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
56                \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
57 <html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"en\" xml:lang=\"en\">
58 <head>
59 <title>" title "</title>
60 <meta http-equiv=\"Content-Type\" content=\"text/html;charset=utf-8\"/>
61 <meta name=\"DC.Language\" content=\"en\" />
62 <meta name=\"DC.Title\" content=\"" title "\"/>
63 <meta name=\"DC.Description\"
64  content=\"GnuPG is a free implementation of OpenPGP\" />
65 <meta name=\"DC.Creator\" content=\"The People of the GnuPG Project\" />
66 <meta name=\"DC.Publisher\" content=\"The GnuPG Project\" />
67 <meta name=\"DC.Identifier\" content=\"https://gnupg.org/\" />
68 <meta name=\"DC.Rights\" content=\"https://gnupg.org/copying.html\" />
69 <link rel=\"stylesheet\" href=\"/share/site.css\" type=\"text/css\" />
70 </head>
71 <body>\n"))
72 ;;; <meta name=\"DC.Date\" content=\""
73 ;;;   (format-time-string "%Y-%m-%d" generated-at t) "\" />
74
75
76 (defconst gpgweb-gnupg-menu-alist
77   '(("/index.html"
78      "Home"
79      (("/features.html"                    "Features")
80       ("/news.html"                        "News")
81       ("/service.html"                     "Service")))
82     ("/donate/index.html"
83      "Donate"
84      (("/donate/kudos.html"                "List of Donors")))
85     ("/download/index.html"
86      "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      ())
110     ("/privacy-policy.html"
111      "Privacy&nbsp;Policy"
112      ())
113     ("/misc/index.html"
114      "Archive"
115      ())
116     ("/sitemap.html"
117      "Sitemap"
118      ()))
119   "The definition of the gnupg.org menu structure.")
120
121 (defun gpgweb--any-selected-menu-p (menu selected-file)
122   "Return t if any item in MENU has been selected."
123   (let ((item (car menu))
124         res)
125     (when menu
126       (when item
127         (when (string= (car item) selected-file)
128             (setq res t))
129         (when (caddr item)
130           (when (gpgweb--any-selected-menu-p (caddr item) selected-file)
131             (setq res t))))
132       (when (gpgweb--any-selected-menu-p (cdr menu) selected-file)
133         (setq res t)))
134     res))
135
136
137 (defun gpgweb--insert-menu (menu lvl selected-file)
138   "Helper function to insert the menu."
139   (when menu
140     (let ((item (car menu))
141           sel)
142       (when item
143         (dotimes (i lvl) (insert "  "))
144         (insert "    <li><a href=\"" (car item) "\"")
145         (when (string= (car item) selected-file)
146           (setq sel t)
147           (insert " class=\"selected\""))
148         (insert  ">" (cadr item) "</a></li>\n")
149         (when (and (caddr item)
150                    (or
151                     sel
152                     (gpgweb--any-selected-menu-p (caddr item) selected-file)))
153           (dotimes (i (1+ lvl)) (insert "  "))
154           (insert "  <ul>\n")
155           (gpgweb--insert-menu (caddr item) (1+ lvl) selected-file)
156           (dotimes (i (1+ lvl)) (insert "  "))
157           (insert "  </ul>\n"))))
158     (gpgweb--insert-menu (cdr menu) lvl selected-file)))
159
160 (defun gpgweb-insert-menu (selected-file)
161   "Insert the menu structure into the HTML file."
162   (goto-char (point-min))
163   (when (re-search-forward "^<body>\n" nil t)
164     (insert "<div id=\"header\">&nbsp;</div>
165 <div id=\"leftColumn\">
166   <nav>
167   <ul>
168 ")
169     (gpgweb--insert-menu gpgweb-gnupg-menu-alist 0 selected-file)
170     (insert "  </ul>
171   </nav>
172 </div>
173 <main>
174 ")))
175
176 (defun gpgweb-insert-footer ()
177   (goto-char (point-min))
178   (unless (search-forward "<!--disable-copyright-footer-->" nil t)
179     (goto-char (point-max))
180     (insert "<div id=\"cpyright\">
181     <a rel=\"license\" href=\"http://creativecommons.org/licenses/by-sa/3.0/\"
182       ><img alt=\"CC-BY-SA 3.0\" style=\"border: 0\"
183             src=\"/share/cc-by-sa-3.0_80x15.png\"/></a><br/>
184     These web pages are
185     Copyright 1998--2014 The GnuPG Project<a href=\"/copying.html\">ยน</a>
186     and licensed under a
187     <a rel=\"license\" href=\"http://creativecommons.org/licenses/by-sa/3.0/\"
188     >Creative Commons Attribution-ShareAlike 3.0 Unported License</a>.  See
189     <a href=\"/copying.html\">copying</a> for details.
190 </div>
191 </main>
192 </body>
193 </html>")))
194
195
196 ;;; Post-process the generated HTML file:
197 ;;;
198 ;;; - Insert header and footer
199 ;;; - Insert "class=selected" into the active menu entry
200 ;;; - Fixup sitemap.
201 (defun gpgweb-postprocess-html (plist orgfile htmlfile)
202   (let* ((visitingp (find-buffer-visiting htmlfile))
203          (work-buffer (or visitingp (find-file-noselect htmlfile))))
204     (prog1 (with-current-buffer work-buffer
205              (let ((fname (file-name-nondirectory htmlfile))
206                    (fname-2 (replace-regexp-in-string
207                              ".*/stage\\(/.*\\)$" "\\1" htmlfile t))
208                    (title (org-publish-find-title orgfile))
209                    (generated-at (current-time)))
210                ;; Insert header, menu, and footer.
211                (gpgweb-insert-header title generated-at)
212                (gpgweb-insert-menu fname-2)
213                (gpgweb-insert-footer)
214
215                ; Fixup the sitemap
216                (when (string-equal fname "sitemap.html")
217                  (goto-char (point-min))
218                  (while (re-search-forward
219                          "^.*<li>.*>\\(GnuPG - \\).*<span.*$" nil t)
220                    (replace-match "" t nil nil 1)))
221
222                ; Due to a problem with the current org exporter (cases
223                ; were we link to file mapped via a webserver alias) we
224                ; have to use a full URL at some places in the org
225                ; source.  We fix that up here.
226                (goto-char (point-min))
227                (while (re-search-forward
228                        "href=\"\\(https://www.gnupg.org\\)/.*\"" nil t)
229                  (replace-match "" t t nil 1))
230
231                ; And save the changes
232                (basic-save-buffer))
233       (unless visitingp (kill-buffer work-buffer))))))
234
235 ;;;
236 ;;; The publishing function used by the HTML exporter
237 ;;;
238 (defun gpgweb-org-to-html (plist filename pub-dir)
239   (gpgweb-postprocess-html plist filename
240                            (org-gpgweb-publish-to-html plist filename pub-dir)))
241
242
243 (defun gpgweb-upload ()
244   (let ((stagedir (plist-get project-plist :publishing-directory)))
245     (message "gpgweb  rootdir '%s'" gpgweb-root-dir)
246     (message "gpgweb stagedir '%s'" stagedir)
247     (shell-command
248      (concat "cd " gpgweb-root-dir " && cd " stagedir
249              "&& rsync -rlt --exclude \"*~\" ./ "
250              "werner@trithemius.gnupg.org:"
251              "/var/www/www/www.gnupg.org/htdocs/ ;"
252              " ssh werner@trithemius.gnupg.org"
253              " touch /var/www/www/www.gnupg.org/htdocs/donate/donors.dat"))
254 ))
255
256 (provide 'gpgweb)