Add the missing fg42/build module

.gitignore

@@ -43,7 +43,7 @@ website/*~
 #*#
 
 emacs.d/
-./build/
+/build/
 
 docs/site/orgs/cubes/
 **/*/sitemap.inc

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

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 <lxsameer@gnu.org>
+;; 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 <http://www.gnu.org/licenses/>.
+;;
+;;; 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

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>>>
+<<<:links>>>