From 51b5c42bd40ec10e35a95c5db303b26df5b3e939 Mon Sep 17 00:00:00 2001 From: Sameer Rahmani Date: Tue, 28 Jun 2022 22:22:29 +0100 Subject: [PATCH] Add the missing fg42/build module --- .gitignore | 2 +- core/fg42/build/core.el | 23 ++ core/fg42/build/docs.el | 220 ++++++++++++++++++ .../templates/{cube_template.org => cube.org} | 0 docs/site/templates/cubes.org | 2 +- 5 files changed, 245 insertions(+), 2 deletions(-) create mode 100644 core/fg42/build/docs.el rename docs/site/templates/{cube_template.org => cube.org} (100%) diff --git a/.gitignore b/.gitignore index 4000337..59b2fba 100644 --- a/.gitignore +++ b/.gitignore @@ -43,7 +43,7 @@ website/*~ #*# emacs.d/ -./build/ +/build/ docs/site/orgs/cubes/ **/*/sitemap.inc diff --git a/core/fg42/build/core.el b/core/fg42/build/core.el index 58473be..0aee9b1 100644 --- a/core/fg42/build/core.el +++ b/core/fg42/build/core.el @@ -26,6 +26,9 @@ ;; ;;; Code: +(require 'seq) + + (defvar project-root nil "Root directory of the website source code.") @@ -33,6 +36,7 @@ "Return the full path of the given PATH in the project root." (concat project-root path)) + (defun read-args (args) "Parse the give ARGS list and return a list in the following format: @@ -42,5 +46,24 @@ format: ;; function and now we need to parse the ARGS for :e and :d keys `(() ,args)) + +(defun replace-in-buffer (str replacement) + "Replace the given STR with its REPLACEMENT in current buffer." + (with-current-buffer (current-buffer) + (goto-char (point-min)) + (while (search-forward str nil t) + (replace-match replacement)))) + + +(defun copy-template (src dest context) + "Replace the placeholder in SRC with list of pairs given in CONTEXT +and write it to DEST." + (make-directory (file-name-directory dest) t) + (with-temp-file dest + (insert-file-contents src) + (dolist (pair context) + (replace-in-buffer (format "<<<%s>>>" (car pair)) (cdr pair))))) + + (provide 'fg42/build/core) ;;; core.el ends here diff --git a/core/fg42/build/docs.el b/core/fg42/build/docs.el new file mode 100644 index 0000000..9234cbd --- /dev/null +++ b/core/fg42/build/docs.el @@ -0,0 +1,220 @@ +;;; Buid --- The builder for FG42 -*- lexical-binding: t; -*- +;; +;; Copyright (c) 2010-2021 Sameer Rahmani & Contributors +;; +;; Author: Sameer Rahmani +;; URL: https://gitlab.com/FG42/FG42 +;; Version: 3.0.0 +;; +;; 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 thnis program. If not, see . +;; +;;; Commentary: +;; Cubes are the building blocks of any `FG42' editor. Each `cube' is a +;; unit which defines different abilities in a deterministic and idempotent +;; way. Cubes are composable and a composition of cubes creates an editor. +;; +;;; Code: + +(require 'cubes/all) +(require 'fg42/build/core) + +(defconst cube-template (from-root "/docs/site/templates/cube.org")) +(defconst cubes-index-template (from-root "/docs/site/templates/cubes.org")) + +(defconst author-name "Sameer Rahmani") +(defconst author-email "lxsameer@gnu.org") + + +(defun fg42/build-docs-for-cube (build-dir cube) + "Build the given CUBE's doc in BUILD-DIR" + (let* ((cubes-dir (expand-file-name "site/cubes/" build-dir)) + (props (symbol-plist cube)) + (docs (plist-get props :docs)) + (cube-file (concat (expand-file-name (symbol-name cube) cubes-dir) + ".org"))) + (message "Processing the docs for '%s' cube" cube) + (copy-template cube-template + cube-file + (list + (cons :title (plist-get props :title)) + (cons :docs docs))))) + + +(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)) + + +(defun fg42/build-prepare-docs (build-dir) + "Prepare the documents and the website in the given BUILD-DIR." + (fg42/build-docs-copy-base build-dir) + + ;; Build the org files for each cube + (mapcar (lambda (cube) + (fg42/build-docs-for-cube build-dir cube)) + fg42/available-cubes) + + ;; Build the cubes list index file + (message "Processing cubes index file") + (copy-template cubes-index-template + (expand-file-name "site/cubes/index.org" build-dir) + (list + (cons :links (mapconcat (lambda (c) + (format "- [[%s][%s]]\n" + ;; href + (format "cubes/%s.org" c) + ;; title + (plist-get (symbol-plist c) :title))) + fg42/available-cubes))))) + + +(defun all-org-files () + "Return a list of all the org files in the orgs directory." + (mapcar #'identity + (split-string + (shell-command-to-string (format "find %s -iname \"*.org\"" org-directory)) + "\n" t))) + + +(defun get-all-posts () + "Return all the post org files. +Not pages." + (let ((files (all-org-files))) + (seq-reduce + (lambda (result file) + (let ((is-page? (string= (get-file-global-props file "PAGE") "true"))) + (if (not is-page?) + ;; It's a post + (cons + (list + ;; This is not effecient since we parse the file + ;; on each query, but who cares :D ? + (->epoch (get-file-global-props file "DATE")) + (get-file-global-props file "TITLE") + (replace-regexp-in-string "\\.org" ".html" + (file-name-nondirectory file))) + result) + result))) + files + '()))) + + +(defun get-all-sorted-posts () + "Return all posts in sorted order." + (sort + (get-all-posts) + (lambda (x y) (> (car x) (car y))))) + + +(defun latest-org-list (base-url) + "Return a list of links (using BASE-URL) to the tags in org format." + (let ((posts (get-all-sorted-posts))) + (mapconcat + (lambda (post) + (format " - [[%s/essays/%s][%s]]" base-url (nth 2 post) (nth 1 post))) + posts + "\n"))) + + +(defun get-all-categories () + "Return all the categories of the org files." + (seq-reduce + ;; all-cats is in (cats . cat->files) form + (lambda (all-cats file) + (let ((is-page? (string= (get-file-global-props file "PAGE") "true")) + (cat (get-file-global-props file "CATEGORY")) + (cat-list (car all-cats)) + (cat->file (cdr all-cats))) + + (if (not is-page?) + (cons + ;; Category list + (if (member cat cat-list) cat-list (sort (cons cat cat-list) 'string<)) + ;; cat->file + (cons (cons cat + ;; Current value of the the given cat (all the files + ;; under that category) + (append (list file) (cdr (assoc cat cat->file)))) + cat->file)) + all-cats))) + (all-org-files) + '())) + + +(defun category-org-list () + "Return a list of links to the categories in org format." + (let ((categories (get-all-categories))) + (mapconcat + (lambda (cat) + (let ((count (length (cdr (assoc cat (cdr categories)))))) + (format " - [[./%s.html][%s(%s)]]" cat cat count))) + (car categories) + "\n"))) + + +(defun tags-org-list () + "Return a list of links to the tags in org format." + (let ((tags (get-all-tags))) + (mapconcat + (lambda (tag) + (let ((count (length (cdr (assoc tag (cdr tags)))))) + (format " - [[./%s.html][%s(%s)]]" tag tag count))) + (car tags) + "\n"))) + + +(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) + + ;; We will use the org-agenda to extract all the tags + + ;;; Set the dir containing org the org-files + (setq org-directory (expand-file-name "/site/" build-dir)) + + ;;; Discover all the org files + (setq org-agenda-files (all-org-files)) + + (setf user-full-name author-name) + (setf user-mail-address author-email) + + ;; Disable default header links (top, next) + (setf org-html-home/up-format "") + (setf org-html-link-up "") + (setf org-html-link-home "") + (setf org-html-scripts "") + + + (let ((base-url (if (prod-p) "https://fg42.org" "http://localhost:3003"))) + (copy-template (from-root "/docs/sites/templates/index.org") + (expand-file-name "/site/index.org" build-dir) + (latest-org-list base-url)) + + (copy-template (from-root "/docs/sites/templates/categories.org") + (expand-file-name "/site/categories/index.org" build-dir) + (category-org-list)) + + (copy-template (from-root "/docs/sites/templates/tags.org") + (expand-file-name "/site/tags/index.org" build-dir) + (tags-org-list)))) + +(provide 'fg42/build/docs) +;;; docs.el ends here diff --git a/docs/site/templates/cube_template.org b/docs/site/templates/cube.org similarity index 100% rename from docs/site/templates/cube_template.org rename to docs/site/templates/cube.org diff --git a/docs/site/templates/cubes.org b/docs/site/templates/cubes.org index 80b7a71..432f0db 100644 --- a/docs/site/templates/cubes.org +++ b/docs/site/templates/cubes.org @@ -10,4 +10,4 @@ to a functionality in a single callable and function like entity. For more info ][documentation]]. Here is a list of available cubes: -<<>> +<<<:links>>>