@@ 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
@@ 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.