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

Add the missing fg42/build module

ep8
Sameer Rahmani 8 months ago
parent
commit
51b5c42bd4
  1. 2
      .gitignore
  2. 23
      core/fg42/build/core.el
  3. 220
      core/fg42/build/docs.el
  4. 0
      docs/site/templates/cube.org
  5. 2
      docs/site/templates/cubes.org

2
.gitignore vendored

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

23
core/fg42/build/core.el

@ -26,6 +26,9 @@ @@ -26,6 +26,9 @@
;;
;;; Code:
(require 'seq)
(defvar project-root nil
"Root directory of the website source code.")
@ -33,6 +36,7 @@ @@ -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: @@ -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

220
core/fg42/build/docs.el

@ -0,0 +1,220 @@ @@ -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

0
docs/site/templates/cube_template.org → docs/site/templates/cube.org

2
docs/site/templates/cubes.org

@ -10,4 +10,4 @@ to a functionality in a single callable and function like entity. For more info @@ -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>>>

Loading…
Cancel
Save