web: Put the menu structure into an alist and other fixes.
[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
122 (defun gpgweb--insert-menuitem (item lvl selected-file)
123   (when item
124     (dotimes (i lvl) (insert "  "))
125     (insert "    <li><a href=\"" (car item) "\"")
126     (when (string= (car item) selected-file)
127       (insert " class=\"selected\""))
128     (insert  ">" (cadr item) "</a></li>\n")
129     (when (caddr item)
130       (dotimes (i (1+ lvl)) (insert "  "))
131       (insert "  <ul>\n")
132       (gpgweb--insert-menu (caddr item) (1+ lvl) selected-file)
133       (dotimes (i (1+ lvl)) (insert "  "))
134       (insert "  </ul>\n"))))
135
136 (defun gpgweb--insert-menu (menu lvl selected-file)
137   (when menu
138     (gpgweb--insert-menuitem (car menu) lvl selected-file)
139     (gpgweb--insert-menu (cdr menu) lvl selected-file)))
140
141 (defun gpgweb-insert-menu (selected-file)
142   "Insert the menu structure into the HTML file."
143   (goto-char (point-min))
144   (when (re-search-forward "^<body>\n" nil t)
145     (insert "<div id=\"header\">&nbsp;</div>
146 <div id=\"leftColumn\">
147   <nav>
148   <ul>
149 ")
150     (gpgweb--insert-menu gpgweb-gnupg-menu-alist 0 selected-file)
151     (insert "  </ul>
152   </nav>
153 </div>
154 <main>
155 ")))
156
157 (defun gpgweb-insert-footer ()
158   (goto-char (point-min))
159   (unless (search-forward "<!--disable-copyright-footer-->" nil t)
160     (goto-char (point-max))
161     (insert "<div id=\"cpyright\">
162     <a rel=\"license\" href=\"http://creativecommons.org/licenses/by-sa/3.0/\"
163       ><img alt=\"CC-BY-SA 3.0\" style=\"border: 0\"
164             src=\"/share/cc-by-sa-3.0_80x15.png\"/></a><br/>
165     These web pages are
166     Copyright 1998--2014 The GnuPG Project<a href=\"/copying.html\">ยน</a>
167     and licensed under a
168     <a rel=\"license\" href=\"http://creativecommons.org/licenses/by-sa/3.0/\"
169     >Creative Commons Attribution-ShareAlike 3.0 Unported License</a>.  See
170     <a href=\"/copying.html\">copying</a> for details.
171 </div>
172 </main>
173 </body>
174 </html>")))
175
176
177 ;;; Post-process the generated HTML file:
178 ;;;
179 ;;; - Insert header and footer
180 ;;; - Insert "class=selected" into the active menu entry
181 ;;; - Fixup sitemap.
182 (defun gpgweb-postprocess-html (plist orgfile htmlfile)
183   (let* ((visitingp (find-buffer-visiting htmlfile))
184          (work-buffer (or visitingp (find-file-noselect htmlfile))))
185     (prog1 (with-current-buffer work-buffer
186              (let ((fname (file-name-nondirectory htmlfile))
187                    (fname-2 (replace-regexp-in-string
188                              ".*/stage\\(/.*\\)$" "\\1" htmlfile t))
189                    (title (org-publish-find-title orgfile))
190                    (generated-at (current-time)))
191                ;; Insert header, menu, and footer.
192                (gpgweb-insert-header title generated-at)
193                (gpgweb-insert-menu fname-2)
194                (gpgweb-insert-footer)
195
196                ; Fixup the sitemap
197                (when (string-equal fname "sitemap.html")
198                  (goto-char (point-min))
199                  (while (re-search-forward
200                          "^.*<li>.*>\\(GnuPG - \\).*<span.*$" nil t)
201                    (replace-match "" t nil nil 1)))
202
203                ; Due to a problem with the current org exporter (cases
204                ; were we link to file mapped via a webserver alias) we
205                ; have to use a full URL at some places in the org
206                ; source.  We fix that up here.
207                (goto-char (point-min))
208                (while (re-search-forward
209                        "href=\"\\(https://www.gnupg.org\\)/.*\"" nil t)
210                  (replace-match "" t t nil 1))
211
212                ; And save the changes
213                (basic-save-buffer))
214       (unless visitingp (kill-buffer work-buffer))))))
215
216 ;;;
217 ;;; The publishing function used by the HTML exporter
218 ;;;
219 (defun gpgweb-org-to-html (plist filename pub-dir)
220   (gpgweb-postprocess-html plist filename
221                            (org-gpgweb-publish-to-html plist filename pub-dir)))
222
223
224 (defun gpgweb-upload ()
225   (let ((stagedir (plist-get project-plist :publishing-directory)))
226     (message "gpgweb  rootdir '%s'" gpgweb-root-dir)
227     (message "gpgweb stagedir '%s'" stagedir)
228     (shell-command
229      (concat "cd " gpgweb-root-dir " && cd " stagedir
230              "&& rsync -rlt --exclude \"*~\" ./ "
231              "werner@trithemius.gnupg.org:"
232              "/var/www/www/www.gnupg.org/htdocs/ ;"
233              " ssh werner@trithemius.gnupg.org"
234              " touch /var/www/www/www.gnupg.org/htdocs/donate/donors.dat"))
235 ))
236
237 (provide 'gpgweb)