;;; gpgweb.el --- elisp helper code for the GnuPG web pages (require 'org-exp) ;; makeindex disabled because the generated file is created in the ;; source directory. (defun gpgweb-setup-project () "Set up an org-publish project for the gnupg.org website." (progn (require 'ox-gpgweb (concat gpgweb-root-dir "share/ox-gpgweb.el")) (aput 'org-publish-project-alist "gpgweb-org" `(:base-directory ,gpgweb-root-dir :base-extension "org" :language "en" :html-extension "html" :recursive t :publishing-directory ,gpgweb-stage-dir :publishing-function gpgweb-org-to-html :body-only t :section-numbers nil :tags nil :with-toc nil :makeindex nil :auto-sitemap nil :sitemap-title "GnuPG - Sitemap" :sitemap-sort-folders "last" :sitemap-file-entry-format "%t @@html:@@(%d)@@html:@@" :style-include-default nil :timestamp-file nil :html-head "" :html-head-include-scripts nil)) (aput 'org-publish-project-alist "gpgweb-other" `(:base-directory ,gpgweb-root-dir :base-extension "jpg\\|png\\|css\\|txt\\|rss\\|lst\\|sig" :recursive t :publishing-directory ,gpgweb-stage-dir :publishing-function org-publish-attachment :completion-function gpgweb-upload)) (aput 'org-publish-project-alist "gpgweb" '(:components ("gpgweb-org" "gpgweb-other"))) (add-hook 'org-export-before-processing-hook 'gpgweb-preprocess))) (defun gpgweb-preprocess (backend) "Insert certain stuff before processing." (let () (goto-char (point-min)) (when (re-search-forward "^#\\+GPGWEB-NEED-SWDB\\b" 2048 t) (beginning-of-line) (kill-line 1) (insert (org-file-contents (concat gpgweb-root-dir "swdb.mac") 'noerror))))) (defun gpgweb-insert-header (title committed-at) "Insert the header. COMMITTED-AT is the commit date string of the source file or nil if not available." (goto-char (point-min)) (insert " " title " \n") (when (and committed-at (>= (length committed-at) 10)) (insert "\n")) (insert " ")) (defconst gpgweb-gnupg-menu-alist '(("/index.html" "Home" (("/index.html" "Home") ("/features.html" "Features") ("/news.html" "News") ("/people/index.html" "People") ("/documentation/sites.html" "Sites") ("/service.html" "Service"))) ("/donate/index.html" "Donate" (("/donate/index.html" "Donate") ("/donate/kudos.html" "List of Donors"))) ("/download/index.html" "Download" (("/download/index.html" "Download") ("/download/integrity_check.html" "Integrity Check") ("/download/supported_systems.html" "Supported Systems") ("/download/release_notes.html" "Release Notes") ("/download/mirrors.html" "Mirrors") ("/download/git.html" "GIT"))) ("/documentation/index.html" "Support" (("/documentation/howtos.html" "HOWTOs") ("/documentation/manuals.html" "Manuals") ("/documentation/guides.html" "Guides") ("/documentation/faqs.html" "FAQs") ("/documentation/mailing-lists.html" "Mailing Lists") ("/documentation/bts.html" "Bug Tracker") ("/documentation/security.html" "Security"))) ("/related_software/index.html" "Related software" (("/related_software/frontends.html" "Frontends") ("/related_software/tools.html" "Tools") ("/related_software/libraries.html" "Libraries") ("/related_software/swlist.html" "All"))) ("/blog/index.html" "Blog")) "The definition of the gnupg.org menu structure.") (defconst gpgweb-gnupg-bottom-menu-alist '(("/privacy-policy.html" "Privacy Policy" ()) ("/imprint.html" "Imprint" ()) ("/misc/index.html" "Archive" ()) ("/sitemap.html" "Sitemap" ()) ("/blog/index.html" "Blog" ())) "The definition of the gnupg.org bottom menu structure.") (defun gpgweb--any-selected-menu-p (menu selected-file) "Return t if any item in MENU has been selected." (let ((item (car menu)) res) (when menu (when item (when (string= (car item) selected-file) (setq res t)) (when (caddr item) (when (gpgweb--any-selected-menu-p (caddr item) selected-file) (setq res t)))) (when (gpgweb--any-selected-menu-p (cdr menu) selected-file) (setq res t))) res)) (defun gpgweb--selected-top-menu (menu selected-file) "Return the selected top menu or nil." (when menu (let ((item (car menu))) (if (and item (or (string= (car item) selected-file) (gpgweb--any-selected-menu-p (caddr item) selected-file))) menu (gpgweb--selected-top-menu (cdr menu) selected-file))))) (defun gpgweb--insert-menu (menu lvl selected-file) "Helper function to insert the menu." (when menu (let ((item (car menu))) (when item (dotimes (i (1+ lvl)) (insert " ")) (insert "
  • " (cadr item) "\n") (when (caddr item) (dotimes (i (1+ lvl)) (insert " ")) (insert " \n")) (dotimes (i (1+ lvl)) (insert " ")) (insert "
  • \n"))) (gpgweb--insert-menu (cdr menu) lvl selected-file))) (defun gpgweb--insert-submenu (menu selected-file) "Helper function to insert the sub-menu." (when menu (let ((item (car menu))) (when item (insert "
  • " (cadr item) "
  • \n"))) (gpgweb--insert-submenu (cdr menu) selected-file))) (defun gpgweb-insert-menu (selected-file) "Insert the menu structure into the HTML file." (goto-char (point-min)) (when (re-search-forward "^\n" nil t) (insert "
    ") (let ((m (caddr (car (gpgweb--selected-top-menu gpgweb-gnupg-menu-alist selected-file))))) (when m (insert "\n"))) (insert "
    "))) (defun gpgweb-blog-index (orgfile filelist) "Return the index of ORGFILE in FILELIST or nil if not found." (let (found (i 0)) (while (and filelist (not found)) (if (string= orgfile (car filelist)) (setq found i)) (setq i (1+ i)) (setq filelist (cdr filelist))) found)) (defun gpgweb-blog-prev (fileidx filelist) "Return the chronological previous file at FILEIDX from FILELIST with the suffixed replaced by \"html\"." (if (> fileidx 1) (concat (file-name-sans-extension (nth (1- fileidx) filelist)) ".html"))) (defun gpgweb-blog-next (orgfile filelist) "Return the chronological next file at FILEIDX from FILELIST with the suffixed replaced by \"html\"." (if (< fileidx (1- (length filelist))) (concat (file-name-sans-extension (nth (1+ fileidx) filelist)) ".html"))) (defun gpgweb-fixup-blog (info orgfile filelist) "Insert the blog specific content. INFO is the usual plist. ORGFILE is the name of the current source file without the directory part. If FILELIST is a list it has an ordered list of org filenames." (let ((authorstr (car (plist-get info :author))) (datestr (car (plist-get info :date)))) (goto-char (point-min)) (if (re-search-forward "^
    " nil t) (let* ((indexp (string= orgfile "index.org")) (fileidx (if (listp filelist) (if indexp (1- (length filelist)) (gpgweb-blog-index orgfile filelist)))) (prevfile (if fileidx (gpgweb-blog-prev fileidx filelist))) (nextfile (if (and fileidx (not indexp)) (gpgweb-blog-next fileidx filelist)))) (move-beginning-of-line nil) (insert "\n"))) (if (and datestr authorstr) (if (re-search-forward "^

    Posted " datestr " by " authorstr "

    \n"))))) (defun gpgweb-insert-footer (htmlfile committed-at blogmode) "Insert the footer. HTMLFILE is HTML file name and COMMITTED-AT is the commit date string of the source file or nil if not available." (let ((srcfile (concat "https://git.gnupg.org/cgi-bin/gitweb.cgi?" "p=gnupg-doc.git;a=blob;f=" (if blogmode "misc/blog.gnupg.org" "web") ;; The replace below is a hack to cope with ;; blogmode where HTMLFILE is like "./foo.html". (replace-regexp-in-string "^\\./" "/" (file-name-sans-extension htmlfile) t) ".org")) (changed (if (and committed-at (>= (length committed-at) 10)) (substring committed-at 0 10) "[unknown]"))) (goto-char (point-max)) (insert "

      ") (gpgweb--insert-menu gpgweb-gnupg-bottom-menu-alist 0 nil) (insert "
    ") (insert "

    ") (goto-char (point-min)) (unless (search-forward "" nil t) (goto-char (point-max)) (insert "
    \"CC-BY-SA  These web pages are Copyright 1998--2015 The GnuPG Project and licensed under a Creative Commons Attribution-ShareAlike 3.0 Unported License. See copying for details. Page source last changed on " changed ".
    \n")) (goto-char (point-max)) (insert "
    "))) ;;; Post-process the generated HTML file: ;;; ;;; - Insert header and footer ;;; - Insert "class=selected" into the active menu entry ;;; - Fixup sitemap. ;;; ;;; If blogmode is not nil the output is rendered as a blog. BLOGMODE ;;; may then contain an ordered list of org file names which are used ;;; to create the previous and Next links for an entry. ;;; (defun gpgweb-postprocess-html (plist orgfile htmlfile blogmode) (let* ((visitingp (find-buffer-visiting htmlfile)) (work-buffer (or visitingp (find-file-noselect htmlfile))) (committed-at (shell-command-to-string (concat "git log -1 --format='%ci' -- " orgfile)))) (prog1 (with-current-buffer work-buffer (let ((fname (file-name-nondirectory htmlfile)) (fname-2 (replace-regexp-in-string ".*/gpgweb-stage\\(/.*\\)$" "\\1" htmlfile t)) (title (org-publish-find-title orgfile))) ;; Insert header, menu, and footer. (gpgweb-insert-header title committed-at) (gpgweb-insert-menu fname-2) (if blogmode (gpgweb-fixup-blog plist (file-name-nondirectory orgfile) blogmode)) (gpgweb-insert-footer fname-2 committed-at blogmode) ; Fixup the sitemap (when (string-equal fname "sitemap.html") (goto-char (point-min)) (while (re-search-forward "^.*
  • .*>\\(GnuPG - \\).* and ; attributes. (goto-char (point-min)) (when (search-forward "" nil t) (goto-char (point-min)) (while (re-search-forward "^