~yrk/blaze

ee5c2883ae818448b0d1f0094423ce30a7e2cb1c — Yoni Rabkin 1 year, 28 days ago
initial revision
2 files changed, 400 insertions(+), 0 deletions(-)

A Makefile
A blaze.el
A  => Makefile +17 -0
@@ 1,17 @@
EMACS=emacs
ALLSOURCE=$(wildcard *.el)
ALLCOMPILED=$(wildcard *.elc)
SOURCE=$(ALLSOURCE)
TARGET=$(patsubst %.el,%.elc,$(SOURCE))

.PHONY: all clean
.PRECIOUS: %.elc
all: $(TARGET)

%.elc: %.el
	@$(EMACS) -q -batch -L . -l blaze.el -f batch-byte-compile $<

clean:
	-rm -f *~ *.elc

neat: all clean

A  => blaze.el +383 -0
@@ 1,383 @@
;;; -*- show-trailing-whitespace: t -*-
;;; blaze.lisp --- Publish Websites in a Real Language

;;; Copyright (C) 2020-2021  Yoni Rabkin

;; Author: Yoni Rabkin <yrk@gnu.org>
;;
;; This file 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, or (at your
;; option) any later version.
;;
;; You should have received a copy of the GNU General Public License
;; along with this software; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
;; Boston, MA 02110-1301 USA


;;; Code:
(require 'subr-x)

(defvar blaze-version "1"
  "Version number.")

;; "no end tags" loosely covers both forbidden and optional end tags
;; as described in
;; [http://www.w3.org/TR/1999/REC-html401-19991224/index/elements.html]
(defvar blaze-elements-with-no-end-tags
  '(:area :base :br :col :hr :img :input :link :meta :param)
  "List of elements with no end tag.")

(defvar blaze-filename-extension
  ".blaze")

(defvar blaze-index-filename
  "index")

(defvar blaze-debug-output nil)

(defvar blaze-debug-output-buffer-name "*blaze debug*")

;; for example:
;; '(((site . traditionalworks)
;;    (root-directory   . "~/devel/traditionalworks/")
;;    (source-directory . "~/devel/traditionalworks/src/")
;;    (output-directory . "~/devel/traditionalworks/site/"))
;;   ((site . libreguide)
;;    (root-directory   . "~/devel/libreguide/")
;;    (source-directory . "~/devel/libreguide/src/")
;;    (output-directory . "~/devel/libreguide/site/"))))
(defvar blaze-site-definition-alist
  nil)

(defvar blaze-newline-elements-list
  '("div" "title" "head" "body" "cite" "p" "a" "footer" "blockquote"))

(defvar blaze-newline-internal-elements-list
  '("html" "head" "body" ))

(defvar blaze-header-comment-string-start
  "<!--generated by blaze")

(defvar blaze-header-comment-string-end
  "-->")

(defvar blaze-header-comment-regexp
  (concat "^"
	  blaze-header-comment-string-start
	  "\\(.+\\)"
	  blaze-header-comment-string-end
	  "$"))

(defvar blaze-source-code-url
  "https://libreguide.org/blaze.git")


;;; ------------------------------------------------------------------
;;; site generation
;;; ------------------------------------------------------------------
(defun blaze-indent-buffer ()
  "Indent the entire buffer."
  (indent-region (point-min)
		 (point-max)))

(defun blaze-get-output-filename ()
  "Return the current filename"
  (concat (blaze-get-output-directory)
	  (file-name-base
	   (if load-in-progress
	       load-file-name
	     (buffer-file-name)))
	  ".html"))

(defun blaze-get-output-source-filename ()
  (concat (blaze-get-output-directory)
	  (file-name-base
	   (if load-in-progress
	       load-file-name
	     (buffer-file-name)))
	  ".blaze"))

(defun blaze-get-input-source-filename ()
  (if load-in-progress
      load-file-name
    (buffer-file-name)))

(defun blaze-debug (string)
  "Provide a debug output."
  (when blaze-debug-output
    (with-current-buffer (get-buffer-create blaze-debug-output-buffer-name)
      (insert string))))

(defun blaze-find-site (site)
  "Return SITE from `blaze-site-definition-alist'."
  (when (not blaze-site-definition-alist)
    (error "`blaze-site-definition-alist' not defined"))
  (let (result)
    (mapc (lambda (e)
	    (when (eq site (cdar e))
	      (setq result e)))
	  blaze-site-definition-alist)
    (if (not result)
	(error "%s is not a site, check defintions" site)
      result)))

(defun blaze-derive-site ()
  "Derive the site from file directory."
  (let (result
	dir
	(location
	 (cond (load-in-progress
		(message "deriving site from load-in-progress")
		load-file-name)
	       ((eq major-mode 'dired-mode)
		(message "deriving site from dired-mode")
		dired-directory)
	       (buffer-file-name
		(message "deriving site from buffer-file-name %s" buffer-file-name)
		buffer-file-name))))
    (if (not location)
	(error "could not derive location")
      (setq dir (file-name-directory location)))
    (mapc
     #'(lambda (def)
	 (let ((site (alist-get 'site def))
	       (site-name-string
		(symbol-name
		 (alist-get 'site def))))
	   (when (string-match-p site-name-string dir)
	     (setq result site))))
     blaze-site-definition-alist)
    result))

(defun blaze-list-sites ()
  "Return the list of sites from `blaze-site-definition-alist'."
  (when (not blaze-site-definition-alist)
    (error "`blaze-site-definition-alist' not defined"))
  (mapcar (lambda (e)
	    (cdar e))
	  blaze-site-definition-alist))

(defun blaze-get-source-directory ()
  "Return the source directory of site."
  (file-name-directory
   (cdr (assoc 'source-directory
	       (blaze-find-site (blaze-derive-site))))))

(defun blaze-get-output-directory ()
  "Return the output directory of site."
  (file-name-directory
   (cdr (assoc 'output-directory
	       (blaze-find-site (blaze-derive-site))))))

(defun blaze-version-links (filename)
  "Generate a random link to identify FILENAME."
  (if (not (file-exists-p filename))
      (error "cannot find file")
    (with-temp-buffer
      (insert-file-contents filename)
      (goto-char (point-min))
      (while (re-search-forward "\\.css\\|\\.html" (point-max) t)
	(insert (format "?version=%d" (random 10000))))
      (write-file filename))))

(defun blaze-write (markup &optional flags)
  "Generate the part of site defined in MARKUP.

FLAGS is a list of flags for processing:
`indent': indent the markup before writing the file."
  (let* ((output-filename (blaze-get-output-filename))
	 (output-source-filename (blaze-get-output-source-filename))
	 (input-source-filename (blaze-get-input-source-filename))
	 (comment-header (blaze-generate-comment-header
			  (if (file-exists-p output-filename)
			      (with-temp-buffer
				(insert-file-contents output-filename)
				(blaze-parse-comment-header))
			    nil))))
    (blaze-debug (format "writing %s\n" output-filename))
    (with-temp-file output-filename
      (html-mode)
      (insert comment-header)
      (insert markup)
      (when (member 'indent flags)
	(blaze-indent-buffer)))

    (blaze-debug (format "writing source %s\n" output-source-filename))
    (with-temp-file output-source-filename
      (insert-file-contents input-source-filename))))

(defun blaze-parse-comment-header ()
  "Return parsed comment header or nil if none found."
  (let (header)
    (save-excursion
      (goto-char (point-min))
      (when (re-search-forward blaze-header-comment-regexp (point-at-eol) t)
	(setq header (read (match-string-no-properties 1)))
	(blaze-debug (format "parsed comment header %S\n" header))))
    header))

(defun blaze-comment-header-of ()
  (let ((filename (blaze-get-output-filename)))
    (when (file-exists-p filename)
      (with-temp-buffer
	(insert-file-contents filename)
	(blaze-parse-comment-header)))))

(defun blaze-generate-comment-header (previous-header)
  (let ((previous-build (cdr (assoc 'build previous-header))))
    (format "%s%S%s\n"
	    blaze-header-comment-string-start
	    `((version   . ,blaze-version)
	      (timestamp . ,(current-time))
	      (build     . ,(if previous-build
				(1+ previous-build)
			      0))
	      (source    . ,(file-name-nondirectory
			     (blaze-get-output-source-filename))))
	    blaze-header-comment-string-end)))

(defun blaze-generate-build-line (header)
  (when (not header)
    (setq header
	  (with-temp-buffer
	    (insert (blaze-generate-comment-header nil))
	    (blaze-parse-comment-header))))
  (let ((build         (alist-get 'build   header))
	(timestamp     (alist-get 'timestamp header))
	(blaze-version (alist-get 'version header))
	(source        (alist-get 'source  header)))
    (blaze-sexp
     `(((:div :class "blaze_build_line")
	((:div :class "blaze_build")
	 ,(format "Generated by blaze version %s on %s, build number %d."
		  blaze-version
		  (format-time-string "%FT%T%z" timestamp)
		  build))
	((:div :class "blaze_source")
	 ((:a :href ,source) "source code for this page"))
	((:div :class "blaze_git_clone")
	 ,(format "$ git clone %s" blaze-source-code-url)))))))


;;; ------------------------------------------------------------------
;;; interpreter
;;; ------------------------------------------------------------------
(defun blaze-node-no-end-tag-p (sexp)
  "Return t if SEXP is a no end tag."
  (and (listp sexp)
       (listp (car sexp))
       (keywordp (caar sexp))
       (let ((element (caar sexp)))
	 (member element blaze-elements-with-no-end-tags))))

(defun blaze-element-name-of (node)
  "Return the element name of NODE."
  (let ((keyword (caar node)))
    (string-trim (format "%s" keyword) ":")))

(defun blaze-element-newline-p (element)
  (member element blaze-newline-elements-list))

(defun blaze-element-newline-internal-p (element)
  (member element blaze-newline-internal-elements-list))

(defun blaze-atts-vals-list-of (node)
  "Return the attribute value list of NODE."
  (cdar node))

(defun blaze-content-of (node)
  "Return the content of NODE."
  (cdr node))

(defun blaze-compile-atts-vals-int (av-list acc)
  "Compile AV-LIST using accumulator ACC."
  (cond ((null av-list) acc)
	(t (let ((att (string-trim (format "%s" (car av-list)) ":"))
		 (val (cadr av-list)))
	     (blaze-compile-atts-vals-int
	      (cddr av-list)
	      (concat acc " " att "=" "\"" val "\""))))))

(defun blaze-compile-atts-vals (av-list)
  "Compile AV-LIST."
  (blaze-compile-atts-vals-int av-list ""))

(defun blaze-node-p (sexp)
  "Return t if SEXP is a node."
  (and (listp sexp)
       (listp (car sexp))
       (keywordp (caar sexp))))

(defun blaze-sexp (c)
  "Compile the sexp C."
  (with-temp-buffer
    (cond ((null c) nil)

	  ((stringp c)
	   (insert c))

	  ((keywordp c)
	   (string-trim (format "%s" c) ":"))

	  ((blaze-node-no-end-tag-p c)
	   (insert "<")
	   (insert (blaze-element-name-of c))
	   (insert (blaze-compile-atts-vals
		    (blaze-atts-vals-list-of c)))
	   (insert " />")
	   (newline))

	  ((blaze-node-p c)
	   (insert "<")
	   (insert (blaze-element-name-of c))
	   (insert (blaze-compile-atts-vals
		    (blaze-atts-vals-list-of c)))
	   (insert ">")
	   (when (blaze-element-newline-internal-p
		  (blaze-element-name-of c))
	     (newline))
	   (insert (blaze-sexp (blaze-content-of c)))
	   (insert "</")
	   (insert (blaze-element-name-of c))
	   (insert ">")
	   (when (blaze-element-newline-p
		  (blaze-element-name-of c))
	     (newline)))

	  ((listp c)
	   (insert
	    (mapconcat #'(lambda (e)
			   (blaze-sexp e))
		       c "")))

	  (t (error "unhandled form")))

    (buffer-substring (point-min) (point-max))))


;;; ------------------------------------------------------------------
;;; interface
;;; ------------------------------------------------------------------
(defun blaze-write-site ()
  "Generate SITE."
  (interactive)
  (let ((index (concat (blaze-get-source-directory)
		       blaze-index-filename
		       blaze-filename-extension)))
    (blaze-debug
     (format "\n\nblaze-write-site called on %s\n" (current-time-string)))
    ;; load index first
    (when (file-exists-p index)
      (blaze-debug (format "found index file, loading %s\n" index))
      (load index)))
  (mapc #'(lambda (filename)
	    (blaze-debug (format "processing %s\n" filename))
	    (load filename))
	(directory-files (blaze-get-source-directory) t ".*blaze")))


(provide 'blaze)

;;; blaze.el ends here.