RCD Template Interpolation System for Emacs

;;; rcd-template.el --- RCD Template Interpolation System for Emacs

;; Copyright (C) 2021-2022 by Jean Louis

;; Author: Jean Louis <bugs@gnu.support>
;; Version: 1.16
;; Package-Requires:
;; Keywords: data extensions hypermedia maint matching processes tools
;; URL: https://hyperscope.link/3/7/1/3/3/RCD-Template-Interpolation-System-for-Emacs.html

;; This file is not part of GNU Emacs.

;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU Affero 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 Affero General Public
;; License along with this program. If not, see
;; <http://www.gnu.org/licenses/>.

;;; Commentary:

;;; This is the RCD Template Interpolation System for Emacs.
;;;
;;; It expands parts of the template into the evaluated Emacs Lisp
;;; code. If template is a string as "⟦ (+ 2 2) ⟧" then this system
;;; will expand the string into "4".
;;;
;;; Delimiters such as "⟦" and "⟧" may be defined by user and can be
;;; any strings:
;;;
;;; <% and %>
;;; >>> and <<<
;;; 〖 and 〗
;;; [[[ and ]]]
;;;
;;; You may install key bindings to easier insert the embedded snippet
;;; with delimiters, such as:
;;;
;;; (global-set-key (kbd "C-c i") 'rcd-template-insert-delimiters)
;;;
;;; This type of system is may be used to pre-process Markdown and
;;; other lightweight markup before its full expansion into the HTML
;;; pages. It will not know nothing about Markdown, it will
;;; pre-process any kind of text and interpolate Emacs Lisp values. It
;;; may be used to create any kind of dynamic reports. Thus any kind
;;; of text may have Emacs Lisp values that will be interpolated and
;;; expanded as a string.
;;;
;;; If an embedded variables does not exist such as:
;;;
;;; ⟦ non-existent-variable ⟧
;;;
;;; then such would be expanded into empty string "" and same would
;;; happen if the embedded Emacs Lisp fails to evaluate with success.
;;;
;;; Many similar templating systems are determined for online and real
;;; time interpolation. If a program receives any input from users
;;; that has to be used in the interpolation, such input could have
;;; malicious values and thus exploit the system. Programmer should
;;; thus understand the security risks involved:
;;; https://en.wikipedia.org/wiki/Eval#Security_risks
;;;
;;; Majority of templating systems also require programmer to provide
;;; a specific set of variables that should be expanded. This system
;;; will expand global variables whatever they may be and thus lessen
;;; the amount of programming efforts with full liberty.
;;;
;;; This package will work well for as long as lexical-binding is nil.
;;;
;;; You may invoke now `rcd-template-buffer-preview' to see how the
;;; following line expands ⟦ (+ 2 2) ⟧ into "4".
;;; 
;;; Two plus two equals ⟦ (+ 2 2) ⟧.
;;;
;;; Exit the preview by killing the buffer. 
;;;
;;; Example on how Markdown markup would be pre-processed:
;;;
;;; --- begin of Markdown markup ---
;;; # Today's prices
;;;
;;; Today's gold price is ⟦ (usd-eur (gold-price-kg 1)) ⟧
;;; --- end of Markdown markup ---
;;;
;;; Markdown pages cannot know what will be the result of evaluation
;;; such as (usd-eur (gold-price-kg 1)) thus after the processing with
;;; the RCD Template Interpolation System the markup will be expanded
;;; into following:
;;; 
;;; --- begin of pre-processed Markdown markup ---
;;; # Today's prices
;;;
;;; Today's gold price is € 47530.79
;;; --- end of pre-processed Markdown markup ---
;;;
;;; and after pre-processing, the page may be expanded into the HTML
;;; and get prepared for publishing.
;;;
;;; In similar way the RCD Template Interpolation System may be used
;;; to expand HTML templates.
;;;
;;; --- begin of HTML template ---
;;; <html>
;;;   <head>
;;;     <title>⟦ (xml-escape "Title is within <title>TITLE</title>") ⟧</title>
;;;   </head>
;;;   <body>
;;;     ⟦ markdown ⟧
;;;   </body>
;;; </html>
;;; --- end of HTML template ---
;;;
;;; when such HTML template is expanded, it would look as following:
;;;
;;; --- begin of HTML template ---
;;; <html>
;;;   <head>
;;;     <title>Title is within &lt;title&gt;TITLE&lt;/title&gt;</title>
;;;   </head>
;;;   <body>
;;;      <h1>Today's prices</h1>
;;;        <p>Today's gold price is € 47530.79</p>
;;;   </body>
;;; </html>
;;; --- end of HTML template ---
;;;
;;; Example of email template expansion:
;;;
;;; --- begin of email template ---
;;; Hello ⟦ hello-name ⟧,
;;;
;;; Last time I have sent my email to you on ⟦ (last-date-email-sent contact-id) ⟧
;;; and still have not heard from you. What happened?
;;;
;;; To unsubscribe click here: ⟦ (unsubscribe-url contact-id) ⟧
;;; --- end of email template ---
;;;
;;; such email template would then expand to following:
;;; 
;;; --- begin of email template ---
;;; Hello John,
;;;
;;; Last time I have sent my email to you on May 24th 2021,
;;; and still have not heard from you. What happened?
;;;
;;; To unsubscribe click here: https://www.example.com/unsubscribe?user=John
;;; --- end of email template ---
;;;
;;; You may supply HASH argument to this function, such as:
;;; 
;;; (rcd-template-eval text nil hash)
;;;
;;; which hash values will take precedence over global variables, when
;;; interpolating something like ⟦ hash-key ⟧
;;; 
;;; RCD is acronym for Reach, Connect, Deliver, my personal
;;; principle and formula for Wealth.
;;;
;;; The RCD Template Interpolation System for Emacs is used in mass
;;; communication systems such as bulk letter writing, mass SMS
;;; communication and the clients' follow-up mailing systems where it
;;; indirectly generates exchange of services and products for
;;; money. It is part of the RCD Notes suite.

;;; Change Log:

;;; Code:

(require 'subr-x)

(defcustom rcd-template-delimiter-open "⟦"
  "The opening delimiter for RCD Template Interpolation System."
  :group 'rcd
  :type 'string)

(defcustom rcd-template-delimiter-close "⟧"
  "The closing delimiter for RCD Template Interpolation System."
  :group 'rcd
  :type 'string)

(defun rcd-template-eval (string &optional delimiters hash function)
  "Evaluates Emacs Lisp STRING.

STRING is enclosed by `rcd-template-delimiter-open' and
`rcd-template-delimiter-close'.

Optional DELIMITERS list may be provided to change default
delimiters, first list member has to be the opening delimiter and
second the closing delimiter.

HASH may be supplied to interpolate values from hash key:
`⟦ KEY ⟧'.

When HASH keys are strings, the hash table :test must be \\='equal.

Space or new line has to follow `rcd-template-delimiter-open' and
precede `rcd-template-delimiter-close' for evaluation to get
invoked.

The function will evaluated to empty string on any error.

Errors are reported on the standard error output."
  (let* ((string (if (null string) "" string))
	 (max-lisp-eval-depth 10000)
	 (delimiters (or delimiters (list rcd-template-delimiter-open rcd-template-delimiter-close)))
	 (open (car delimiters))
	 (close (cadr delimiters))
	 (add (length open))
	 (minus (length close))
	 (keys (if hash (hash-table-keys hash)))
	 (test (when hash (hash-table-test hash)))
	 (debug-on-error nil))
    (with-temp-buffer
      (insert string)
      (goto-char 0)
      ;; I have changed one-or-more to zero-or-more here below on 2022-10-20
      (while (re-search-forward (rx (literal open)
				    (zero-or-more (or blank "\n")) 
				    (group (minimal-match (one-or-more anything)))
				    (zero-or-more (or blank "\n"))
				    (literal close))
				nil t)
	(let* ((match-beginning (match-beginning 0))
	       (match-end (match-end 0))
	       (match (buffer-substring-no-properties
		       (+ add match-beginning) (- match-end minus)))
	       (lisp (condition-case error
			 (read-from-string match)
		       (error (princ (format "rcd-template-eval: `read-from-string' error: %s for match: '%s'\n" error match))
			      "")))
	       (lisp (if (listp lisp) (car lisp) lisp))
	       (match (string-trim (prin1-to-string lisp)))
	       (parenthesis (substring match 0 1))
	       (lisp (car (read-from-string match)))
	       (value (condition-case error
			  (cond ((and (not (string= parenthesis "("))
				      keys 
				      (member 
				       (cond ((eql test 'eql) lisp)
					     ((eql test 'equal) (symbol-name lisp))
					     (t lisp))
				       keys))
 				 (gethash 
				  (cond ((eql test 'eql) lisp)
					((eql test 'equal) (symbol-name lisp))
					(t lisp))
				  hash ""))
				(t (eval lisp)))
			(error (cond (function (condition-case error
						   (funcall function lisp)
						 (error (princ (format "rcd-template-eval: `eval' error: %s for match: '(%s %s)'\n" error function match))
							"")))
				     (t (princ (format "rcd-template-eval: `eval' error: %s for match: '%s'\n" error match))))
			       "")))
	       (value (cond ((null value) "")
			    (t (format "%s" value)))))
	  (delete-region match-beginning match-end)
	  (insert (format "%s" value))))
      (buffer-string))))

(defun rcd-template-buffer-preview ()
  "Preview the interpolated buffer."
  (interactive)
  (let* ((current (current-buffer))
	 (buffer (format "Preview of buffer %s" current))
	 (string (buffer-string))
	 (mode major-mode)
	 (point (point)))
    (pop-to-buffer-same-window buffer)
    (erase-buffer)
    (goto-char (point-min))
    (insert (rcd-template-eval string))
    (goto-char point)
    (funcall mode)
    (message buffer)))

(defun rcd-template-insert-delimiters ()
  "Quickly insert the template evaluation snippet such as ⟦ () ⟧
and move cursor into parenthesis."
  (interactive)
  (insert (format "%s () %s" rcd-template-delimiter-open rcd-template-delimiter-close))
  (backward-char (+ 2 (length rcd-template-delimiter-close))))

(provide 'rcd-template)

;;; rcd-template.el ends here

My cow is now ( (psql-age "2017-01-01") ) old.

My cow is now 7 years 1 month 10 days old.