M4 support take#3

[Brad Knotwell <bknotwell@yahoo.com>]

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

 Thanks for the code review.  With one exception--:prefix-builtins is an option not an argument--I've incorporated your feedback.
As far as papers, I've read the information on that link several times and it appears the simplest thing to do is for me to put these changes in the public domain.  If that works, let me know and I'll remove the license and put in a disclaimer to that effect.  If not, it'll need to live in contrib as the bureaucracy seems excessive.
Thx.
--Brad
    On Friday, April 13, 2018, 1:31:53 PM PDT, Nicolas Goaziou <mail@nicolasgoaziou.fr> wrote:  
 
 Hello,

Brad Knotwell <bknotwell@yahoo.com> writes:

> Given the code review from earlier, I've added a second file with the
> requested changes.

Thank you. Some minor comments follow.

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

Missing allowed type for last header. Maybe :any ?

> (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."

The line is too long. The second sentence should go onto another line.

>  (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) "")))

See above.

> (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)))

The (format ...) is not correctly indented.

> (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)))

The line is too long. `values' should be below (lambda ...), so does
",". `list-end' and `prefix' should be below "%sdefine..."

> (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)))))

(mapcar ...) should be below #'concat.

> ;; 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))

Last `file' should be below (let ((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))

(and prefix-builtins "-P")

"<" and `code-file' should go below `#'identity'.

I cannot remember: do you plan to have it integrated into Org proper? If
so, have you started the process of signing FSF papers?

Regards,

-- 
Nicolas Goaziou
  

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

[-- Attachment #2: ob-m4.el --]
[-- Type: application/octet-stream, Size: 7162 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"))

;; prefix-builtins is a flag
(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 (and 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