IMPORTANT NOTICE: Devheroes public code hosting will shut down at 1st of March 2023. Due to some difficulties, we have to shut down the instance. Since codeberg.org is pretty mature and welcoming, We highly recommend you to move your code there. Please be advised that on 1st of March, your data will be removed. Thanks for your time with us, and may the source be with you.

Browse Source

Finish the 'docs' command to generate basic html

ep8
Sameer Rahmani 8 months ago
parent
commit
ffcf493540
  1. 4
      build.el
  2. 155
      core/fg42/build/docs.el
  3. 162
      core/fg42/build/ox-template.el
  4. 14
      core/fg42/build/utils.el
  5. 4
      docs/site/templates/index.org
  6. 4
      docs/site/templates/links_template.org

4
build.el

@ -101,6 +101,10 @@ PARAMS: @@ -101,6 +101,10 @@ PARAMS:
(do-command
(require 'fpkg)
(fpkg/use dash)
(fpkg/use mustache)
(fpkg/use ht)
(fpkg/use htmlize)
(require 'fg42/build/docs)
(fg42/build-docs build-dir)))

155
core/fg42/build/docs.el

@ -25,10 +25,12 @@ @@ -25,10 +25,12 @@
;; way. Cubes are composable and a composition of cubes creates an editor.
;;
;;; Code:
(require 'ox-html)
(require 'cubes/all)
(require 'fg42/build/core)
(require 'fg42/build/utils)
(require 'fg42/build/ox-template)
(defconst cube-template (from-root "/docs/site/templates/cube.org"))
@ -54,7 +56,7 @@ @@ -54,7 +56,7 @@
(defun fg42/build-docs-copy-base (build-dir)
"Copy the base structure of the website to the BUILD-DIR."
(copy-directory (from-root "/docs/site/pages") (concat build-dir) nil t))
(copy-directory (from-root "/docs/site/pages") build-dir nil t))
(defun fg42/build-prepare-docs (build-dir)
@ -75,7 +77,7 @@ @@ -75,7 +77,7 @@
(cons :links (mapconcat (lambda (c)
(format "- [[%s][%s]]\n"
;; href
(format "cubes/%s.org" c)
(format "%s/cubes/%s.org" build-dir c)
;; title
(plist-get (symbol-plist c) :title)))
fg42/available-cubes)))))
@ -206,13 +208,73 @@ Not pages." @@ -206,13 +208,73 @@ Not pages."
"\n")))
(defun create-tag-pages (build-dir)
"Create all the tag files in the BUILD-DIR."
(let ((tags (get-all-tags)))
(mapcar
(lambda (tag)
(let ((out (format "%s/site/tags/%s.org" build-dir (or tag "Uncategorized")))
(files (cdr (assoc tag (cdr tags)))))
(copy-template
(from-root "/docs/site/templates/links_template.org")
out
(list
(cons :links
(mapconcat
(lambda (file-pair)
(format "- [[file:..%s][%s]]"
(replace-regexp-in-string (regexp-quote (from-root "/build/site"))
""
(cdr file-pair)
nil
'literal)
(get-file-global-props (cdr file-pair) "TITLE")))
(sort
(mapcar #'pair-file-with-date files)
(lambda (x y) (> (car x) (car y))))
"\n"))
(cons :title (or tag "Uncategorized"))))))
(car tags))))
(defun create-category-pages (build-dir)
"Create all the category files in the BUILD-DIR."
(let ((tags (get-all-categories)))
(mapcar
(lambda (tag)
(let ((out (format "%s/site/categories/%s.org" build-dir (or tag "Uncategorized")))
(files (cdr (assoc tag (cdr tags)))))
(when (null tag)
(message "[Error]: The following files are missig a category: %s"
(mapconcat
(lambda (x) (format " %s\n" x))
(sort
(mapcar #'pair-file-with-date files)
(lambda (x y) (> (car x) (car y))))))
(error "The above list of files are missing a category"))
(copy-template
(from-root "/docs/site/templates/links_template.org")
out
(list
(cons :links
(mapconcat
(lambda (file-pair)
(format "- [[file:..%s][%s]]"
(replace-regexp-in-string (regexp-quote (from-root "/build/site"))
"" (cdr file-pair) nil 'literal)
(get-file-global-props (cdr file-pair) "TITLE")))
(sort
(mapcar #'pair-file-with-date files)
(lambda (x y) (> (car x) (car y))))
"\n"))
(cons :title (or tag "Uncategorized"))))))
(car tags))))
(defun fg42/build-docs (build-dir)
"Build the documents and the website in the given BUILD-DIR."
;; UTF-8 as default encoding
(prefer-coding-system 'utf-8)
(set-default-coding-systems 'utf-8)
(set-terminal-coding-system 'utf-8)
(set-keyboard-coding-system 'utf-8)
;; Create org files for the cubes
(fg42/build-prepare-docs build-dir)
@ -234,26 +296,101 @@ Not pages." @@ -234,26 +296,101 @@ Not pages."
(setf org-html-link-home "")
(setf org-html-scripts "")
(copy-template (from-root "/docs/site/config.org")
(expand-file-name "config.org" build-dir)
'())
(let ((base-url (if (prod-p) "https://fg42.org" "http://localhost:3003")))
(let ((base-url (if (prod-p) "https://fg42.org" "http://localhost:3003"))
(stage1-dir (expand-file-name "site" build-dir))
(final-dir (expand-file-name "site-build" build-dir)))
(message "Creating the main index file")
(copy-template (from-root "/docs/site/templates/index.org")
(expand-file-name "site/index.org" build-dir)
(list
(cons :links
(latest-org-list base-url))))
(message "Creating categories")
(copy-template (from-root "/docs/site/templates/categories.org")
(expand-file-name "site/categories/index.org" build-dir)
(list
(cons :links
(category-org-list))))
(create-category-pages build-dir)
(message "Creating tags")
(copy-template (from-root "/docs/site/templates/tags.org")
(expand-file-name "site/tags/index.org" build-dir)
(list
(cons :links
(tags-org-list))))))
(tags-org-list))))
(create-tag-pages build-dir)
(setq org-html-preamble #'preamble-fn)
(setq org-html-htmlize-output-type nil)
(setq org-latex-listings t)
(setq org-publish-project-alist
`(("fg42.org"
:base-directory ,stage1-dir
:root-directory ,stage1-dir
:recursive t
:base-extension "org"
:publishing-directory ,final-dir
;; Exclude the blog archive index autogenerated below
;; Note that the regexp is relative to :base-directory
;; :exclude "^index.org"
:section-numbers nil
:with-author t
:with-drawers t
:html-format-drawer-function custom-drawer-format
:with-properties t
:with-tags t
:with-timestamps t
:with-toc nil
:base-url ,base-url
:html-link-home "/"
:html-template ,(from-root "/docs/site/templates/blog.html")
:html-page-preamble-template ,(from-root "/docs/site/templates/page-preamble.html")
:html-post-preabmle-template ,(from-root "/docs/site/templates/post-preamble.html")
:html-tags-template ,(from-root "/docs/site/templates/tags.html")
:publishing-function org-html-publish-to-templated-html
:auto-sitemap t
:htmlized-source nil
:sitemap-folders ignore
:sitemap-style list
:sitemap-title "FG42, The ultimate editor for true believers"
:sitemap-filename "sitemap.inc"
:sitemap-sort-files anti-chronologically
:html-format-headline-function headline-format
:makeindex nil)
("org->html"
:base-directory ,stage1-dir
:base-extension "org"
:publishing-directory ,final-dir
:recursive t
:publishing-function org-html-publish-to-html
:headline-levels 4
;; :html-preamble ,(use-html "templates/header.html")
;; :html-postamble ,(use-html "templates/footer.html")
:html-link-home "/"
:html-head-include-default-style nil
:html-head-include-scripts nil
:makeindex nil)
("statics"
:base-directory ,stage1-dir
:base-extension "css\\|js\\|png\\|jpg\\|gif\\|pdf\\|svg"
:publishing-directory ,final-dir
:recursive t
:publishing-function org-publish-attachment)
("build" :components ("fg42.org" "statics"))))
(org-publish-project "build" t nil)
(message "Build complete.")
))
(provide 'fg42/build/docs)
;;; docs.el ends here

162
core/fg42/build/ox-template.el

@ -0,0 +1,162 @@ @@ -0,0 +1,162 @@
;;; ox-template.el --- A HTML exporter via templates for org-mode
;; Copyright (C) 2021-2022 Sameer Rahmani
;; Author: Sameer Rahmani <lxsameer@gnu.org>
;; URL: https://devheroes.codes/lxsameer/lxhome
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Inspired by Juan Jose Garcia Ripoll work.
;;; Code:
;; We ensure the org infrastructure
(require 'org)
(require 'seq)
(require 'ox-publish)
(require 'mustache)
(require 'pp)
(require 'ht)
(require 'fg42/build/utils)
(defun use-html (path-to-template)
"Use the given template at PATH-TO-TEMPLATE as a template."
(with-temp-buffer
(insert-file-contents path-to-template)
(buffer-string)))
(defun render-tags (tags)
"Return a string representing TAGS html."
(if tags
(mapconcat (lambda (x) (format "<a href=\"/tags/%s.html\" class=\"tag-link\">#%s</a>" x x))
tags
" | ")
""))
(defun preamble-fn (info)
"Return a string for the header section of pages using INFO plist."
(let* ((file (plist-get info :input-file))
(page-template (or (plist-get info :html-page-preamble-template) "page-preamble.html"))
(post-template (or (plist-get info :html-post-preabmle-template) "post-preamble.html"))
(is-page? (string= (get-file-global-props file "PAGE") "true"))
(tags (get-file-tags file)))
(let ((title (get-file-global-props file "TITLE"))
(date (get-file-global-props file "DATE")))
(when (not title)
(message "'#+TITLE' is missing from '%s'" file)
(error "'#+TITLE' is missing from '%s'" file))
(if is-page?
(mustache-render (use-html page-template)
(ht ("title" title)))
(progn
(mustache-render (use-html post-template)
(ht
("title" title)
("date" (or date ""))
("tags" (render-tags tags)))))))))
(defun org-html-render-tag-template (tags info)
"Render the given TAGS and INFO using the :html-headline-template."
(let ((template (plist-get info :html-tags-template))
(ctx (ht ("tags" (format "%s" tags))
("base-url" (plist-get info :base-url)))))
(if (null tags)
""
(mustache-render (use-html template) ctx))))
;; Replace org-html--tags with our impelementation if the
;; `:html-headline-template' configuration exists
(advice-add 'org-html--tags :around 'org-html-tag-template)
(defun org-html-tag-template (orig-fn &rest args)
"Decide whether to run ORIG-FN with ARGS or the org-html-render-tag-template.
It looks for `:html-tags-template' in the info and if i exists it will
call `org-html-render-tag-template' otherwise will call ORIG-FN."
(let ((template (plist-get (cadr args) :html-tags-template)))
(if template
(apply #'org-html-render-tag-template args)
(apply orig-fn args))))
(org-export-define-derived-backend 'templated-html 'html
:translate-alist '((template . templated-html-template-fn)))
(defun headline-format (todo todo-type priority text tags info)
"Format the headline using TODO TODO-TYPE PRIORITY TEXT TAGS and INFO."
(let ((todo (org-html--todo todo info))
(priority (org-html--priority priority info))
;; We don't care about the tags here since we put the in the preamble
(tags nil))
(concat todo (and todo " ")
priority (and priority " ")
text
(and tags "&#xa0;&#xa0;&#xa0;") tags)))
(defun render-template (template-name contents info)
"Render the given template TEMPLATE-NAME using CONTENTS and INFO."
(let ((ctx (ht ("content" contents)
("head" (plist-get info :html-head-extra))
("base-url" (plist-get info :base-url))
("preamble" (org-html--build-pre/postamble 'preamble info))
("title" (get-file-global-props (plist-get info :input-file) "TITLE"))
("description" (or (get-file-global-props (plist-get info :input-file) "DESC")
""))
("postamble" (org-html--build-pre/postamble 'postamble info)))))
(mustache-render (use-html template-name) ctx)))
(defun templated-html-template-fn (contents info)
"Return the finalized html CONTENTS using the INFO and templates."
(let ((template (plist-get info :html-template)))
(if template
(render-template template contents info)
(org-html-template contents info))))
(defun custom-drawer-format (name content)
"Return the drawer format for the given drawer NAME and CONTENT."
(format "<section class='%s-drawer'><p>%s</p>%s</section>"
(downcase name)
(capitalize name)
content))
(defun org-html-publish-to-templated-html (plist filename pub-dir)
"Publish an org file to HTML.
FILENAME is the filename of the Org file to be published. PLIST
is the property list for the given project. PUB-DIR is the
publishing directory.
Return output file name."
(org-publish-org-to 'templated-html filename
(concat "." (or (plist-get plist :html-extension)
org-html-extension
"html"))
plist pub-dir))
(provide 'fg42/build/ox-template)
;;; ox-template.el ends here

14
core/fg42/build/utils.el

@ -59,5 +59,19 @@ @@ -59,5 +59,19 @@
(get-buffer-global-props prop)))
(defun pair-file-with-date (file)
"Return a pair for the given FILE with date as car and file as cdr."
(cons
(->epoch (get-file-global-props file "DATE"))
file))
(defun get-file-tags (file)
"Returna list of tags for the given FILE."
(with-temp-buffer
(insert-file-contents file)
(mapcar #'car (org-get-buffer-tags))))
(provide 'fg42/build/utils)
;;; utils.el ends here

4
docs/site/templates/index.org

@ -7,9 +7,9 @@ @@ -7,9 +7,9 @@
#+PAGE: true
#+DESC: An GNU/Emacs based editor for hackers
#+INCLUDE: "../../../README.org::*Future Gadgets 42" :only-contents t
#+INCLUDE: "../../README.org::*Future Gadgets 42" :only-contents t
* Recent updates:
<<<:links>>>
#+INCLUDE: "../../../README.org::*License"
#+INCLUDE: "../../README.org::*License"

4
docs/site/templates/links_template.org

@ -1,7 +1,7 @@ @@ -1,7 +1,7 @@
#+SETUPFILE: ../../config.org
#+OPTIONS: toc:nil
#+TITLE: <<<title>>>
#+TITLE: <<<:title>>>
#+PAGE: true
<<<links>>>
<<<:links>>>

Loading…
Cancel
Save