M4 support take#2

[Brad Knotwell <bknotwell@yahoo.com>]

[-- Attachment #1.1: Type: text/plain, Size: 793 bytes --]

Given the code review from earlier, I've added a second file with the requested changes.  I also added the ability to transparently run the changequote builtin on startup as well as the list delimiters.  I looked at doing a test-ob-m4.el but the examples didn't make it all clear how to proceed.
I've attached the updated file.
As an aside, some of the ugliness comes from needing to do default values if one of the custom attributes (e.g. :list-start) is unset.  I would've thought something like the following would work:
   (defvar org-babel-default-header-args:m4 '((:list-start . "[") (:list-end . "]")))
but that didn't appear to do anything (the elisp tracing facility didn't show those at all unless they were passed in explicitly via the #+begin_src statement).
Thx.
--Brad

[-- Attachment #1.2: Type: text/html, Size: 1225 bytes --]

[-- Attachment #2: ob-m4.el --]
[-- Type: application/octet-stream, Size: 7102 bytes --]

;;; ob-m4.el --- Babel Functions for m4 scripts    -*- lexical-binding: t; -*-

;; Copyright (C) 2018-2018 Free Software Foundation, Inc.

;; Author: Brad Knotwell
;; Keywords: literate programming, reproducible research
;; Version: 0.1.0

;; This file is part of GNU Emacs.

;; GNU Emacs 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.

;; GNU Emacs 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 GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Provides a way to evaluate m4 scripts in Org mode.

;;; Usage:

;; Add to your Emacs config:

;; (org-babel-do-load-languages
;;  'org-babel-load-languages
;;  '((m4 . t)))

;; In addition to the normal header arguments, ob-m4 also provides
;; six specific options:
;;  :cmd-line -- allows a user to append arguments to the call
;;  :prefix-buildins -- calls with the -P option to automatically
;;       prefix all built-in macros with 'm4_'
;;  :quote/:unquote -- set the m4 quoting characters to a non-default value
;;  :list-start/:list-end -- default "[" and "]" but can be set to something else (e.g. "(" and ")")
;;                           if you want to use "[" and "]" as quote characters
;;
;;
;; Note:  it is a bad idea to explicitly pass the "-P" option in :cmd-line to enable prefixing
;; as any arguments specified via var NAME=value will be prefixed incorrectly.
;;
;; Explaining this with a bit more detail, all :var NAME=value arguments are
;; prepended to the body as definitions:
;;     define(NAME,value)
;;            or
;;     m4_define(NAME,value) iff :prefix-builtins is set
;;
;; Note:  the :prefix-builtin option is incompatible with Posix compliant m4 implementations.
;;        This is fine for two reasons:
;;           * a Posix compliant utility is correct by default as the -P option is omitted
;;           * GNU's m4 implementation is (essentially) standard at this point
(require 'ob)

(defvar org-babel-m4-command "m4"
  "Name of the m4 executable command.")

(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("m4" . "m4"))

(defconst org-babel-header-args:m4
  '((:cmd-line . :any)
    (:quote . :any)
    (:unquote . :any)
    (:list-start . :any)
    (:list-end . :any)
    (:prefix-builtins))
  "M4 specific header arguments.")

(defvar org-babel-default-header-args:m4 '()
  "Default arguments for evaluating a m4 source block.")

;; passed-in macro definitions are constructed as a single string that is
;; prepended to the script body.
;;
;; :prefix-builtins is necessary for the -P option to work

(defun org-babel--m4-prefix (params)
  "Prefix m4_ if :prefix-builtins is set"
  (if (assq :prefix-builtins params) "m4_" ""))

(defun org-babel--m4-changequote (params)
  "Declare quoting behavior if start-quote and end-quote are set.  Otherwise, return an empty string."
  (let ((prefix (org-babel--m4-prefix params))
	(start-quote (cdr (assq :quote params)))
	(end-quote (cdr (assq :unquote params))))
    (if (and start-quote end-quote) (format "%schangequote(%s,%s)%sdnl\n" prefix start-quote end-quote prefix) "")))

(defun org-babel--variable-assignment:m4_generic (params varname values)
  "Build the simple macro definitions prepended to the script body."
  (let ((prefix (org-babel--m4-prefix params)))
	(format "%sdefine(%s,%s)%sdnl\n" prefix varname values prefix)))

(defun org-babel--variable-assignment:m4_list (params varname values)
  "Build the complex macro definitions prepended to the script body."
  (let ((prefix (org-babel--m4-prefix params))
	(list-start (or (cdr (assq :list-start params)) "["))
	(list-end (or (cdr (assq :list-end params)) "]")))
    (format "%sdefine(%s,%s%s%s)%sdnl\n" prefix varname list-start
	    (mapconcat
	     (lambda (value)
	       ;; value could be a numeric table entry as well as a string
	       (if (= (length value) 1) (format "%s" (car value))
		 (concat list-start (mapconcat (lambda (x) (format "%s" x)) value ",")
			 list-end))) values ",") list-end prefix)))

(defun org-babel--variable-assignments:m4 (params varnames values)
  "Internal helper that converts parameters to m4 definitions."
  (pcase values
    (`(,_ . ,_) (org-babel--variable-assignment:m4_list params varnames values))
    (_ (org-babel--variable-assignment:m4_generic params varnames values))))

(defun org-babel-variable-assignments:m4 (params)
  "Interface function that converts parameters to m4 definitions."
  (concat (org-babel--m4-changequote params)
	  (apply #'concat (mapcar (lambda (pair) (org-babel--variable-assignments:m4
						  params (car pair) (cdr pair)))
				  (org-babel--get-vars params)))))

;; Required to make tangling work
;; The final "\n" is needed as GNU m4 errors out if a file doesn't end in a newline.
(defun org-babel-expand-body:m4 (body params)
  "Expand BODY according to PARAMS, return the expanded body."
  (concat (org-babel-variable-assignments:m4 params) body "\n"))

(defun org-babel-execute:m4 (body params)
  "Execute a block of m4 code with Org Babel.
BODY is the source inside a m4 source block and PARAMS is an
association list over the source block configurations.  This
function is called by `org-babel-execute-src-block'."
  (message "executing m4 source code block")
  (let* ((result-params (cdr (assq :result-params params)))
         (cmd-line (cdr (assq :cmd-line params)))
	 (prefix-builtins (assq :prefix-builtins params))
	 (code-file (let ((file (org-babel-temp-file "m4-")))
                      (with-temp-file file
			(insert (org-babel-expand-body:m4 body params) file)) file))
	 (stdin (let ((stdin (cdr (assq :stdin params))))
		   (when stdin
		     (let ((tmp (org-babel-temp-file "m4-stdin-"))
			   (res (org-babel-ref-resolve stdin)))
		       (with-temp-file tmp
			 (insert res))
		       tmp))))
         (cmd (mapconcat #'identity
			 (remq nil
			       (list org-babel-m4-command
				     cmd-line (if prefix-builtins "-P") "<" code-file))
			 " ")))
    (org-babel-reassemble-table
     (let ((results
            (cond
             (stdin (with-temp-buffer
                      (call-process-shell-command cmd stdin (current-buffer))
                      (buffer-string)))
             (t (org-babel-eval cmd "")))))
       (when results
         (org-babel-result-cond result-params
	   results
	   (let ((tmp (org-babel-temp-file "m4-results-")))
	     (with-temp-file tmp (insert results))
	     (org-babel-import-elisp-from-file tmp)))))
     (org-babel-pick-name
      (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
     (org-babel-pick-name
      (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))

(provide 'ob-m4)
;;; ob-m4.el ends here