branch: externals/tomelr
commit 52dc93201deb02a3d380d841e839f5f3e5f32c95
Author: Kaushal Modi <kaushal.m...@gmail.com>
Commit: Kaushal Modi <kaushal.m...@gmail.com>
feat: First cut -- Port json-encode from json.el to tomelr-encode
Contains only the fixes needed to make the boolean key-value pair look
right in TOML.
---
tomelr.el | 288 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 288 insertions(+)
diff --git a/tomelr.el b/tomelr.el
new file mode 100644
index 0000000000..2a60f9d0e2
--- /dev/null
+++ b/tomelr.el
@@ -0,0 +1,288 @@
+;;; tomelr.el --- Convert Emacs s-expressions to TOML -*-
lexical-binding: t -*-
+
+;; Authors: Kaushal Modi <kaushal.m...@gmail.com>
+
+;; 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 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 General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; tomelr.el is a library that provides functions to convert Emacs
+;; symbolic expressions to TOML.
+
+;;; Code:
+
+(require 'map)
+
+
+;;; Variables
+
+(defvar tomelr-false '(:false 'false "false")
+ "S-exp values to be interpreted as TOML `false'.")
+
+(defvar tomelr-encoding-default-indentation " "
+ "String used for a single indentation level during encoding.
+This value is repeated for each further nested element.")
+
+(defvar tomelr-encoding-lisp-style-closings nil
+ "If non-nil, delimiters ] and } will be formatted Lisp-style.
+This means they will be placed on the same line as the last
+element of the respective array or object, without indentation.")
+
+(defvar tomelr-encoding-object-sort-predicate nil
+ "Sorting predicate for TOML object keys during encoding.
+If nil, no sorting is performed. Else, TOML object keys are
+ordered by the specified sort predicate during encoding. For
+instance, setting this to `string<' will have TOML object keys
+ordered alphabetically.")
+
+;;;; Internal Variables
+(defvar tomelr--print-indentation-prefix "\n"
+ "String used to start indentation during encoding.")
+
+(defvar tomelr--print-indentation-depth -1
+ "Current indentation level during encoding.
+Dictates repetitions of `tomelr-encoding-default-indentation'.")
+
+(defvar tomelr--print-keyval-separator " = "
+ "String used to separate key-value pairs during encoding.")
+
+
+
+;;; Error conditions
+
+(define-error 'tomelr-error "Unknown TOML error")
+(define-error 'tomelr-key-format "Bad TOML object key" 'tomelr-error)
+
+
+
+;;; Utilities
+
+(defun tomelr-alist-p (list)
+ "Non-nil if and only if LIST is an alist with simple keys."
+ (declare (pure t) (side-effect-free error-free))
+ (while (and (consp (car-safe list))
+ (atom (caar list))
+ (setq list (cdr list))))
+ (null list))
+
+(defun tomelr-plist-p (list)
+ "Non-nil if and only if LIST is a plist with keyword keys."
+ (declare (pure t) (side-effect-free error-free))
+ (while (and (keywordp (car-safe list))
+ (consp (cdr list))
+ (setq list (cddr list))))
+ (null list))
+
+(defmacro tomelr--with-output-to-string (&rest body)
+ "Eval BODY in a temporary buffer bound to `standard-output'.
+Return the resulting buffer contents as a string."
+ (declare (indent 0) (debug t))
+ `(with-output-to-string
+ (with-current-buffer standard-output
+ ;; This affords decent performance gains.
+ (setq-local inhibit-modification-hooks t)
+ ,@body)))
+
+(defmacro tomelr--with-indentation (&rest body)
+ "Eval BODY with the TOML encoding nesting incremented by one step.
+This macro sets up appropriate variable bindings for
+`tomelr--print-indentation' to produce the correct indentation."
+ (declare (debug t) (indent 0))
+ `(let ((tomelr--print-indentation-depth (1+
tomelr--print-indentation-depth)))
+ ,@body))
+
+(defun tomelr--print-indentation ()
+ "Insert the current indentation for TOML encoding at point."
+ (insert tomelr--print-indentation-prefix)
+ (dotimes (_ tomelr--print-indentation-depth)
+ (insert tomelr-encoding-default-indentation)))
+
+
+
+;;; Encoding
+
+;;;; Keywords
+(defun tomelr-encode-keyword (keyword)
+ "Encode KEYWORD as a TOML value."
+ (declare (side-effect-free t))
+ ;; (message "[tomelr-encode-keyword DBG] keyword = %S" keyword)
+ (cond ((eq keyword t) "true")
+ ((member keyword tomelr-false) "false")))
+
+(defun tomelr--print-keyword (keyword)
+ "Insert KEYWORD as a TOML value at point.
+Return nil if KEYWORD is not recognized as a TOML keyword."
+ (prog1 (setq keyword (tomelr-encode-keyword keyword))
+ (and keyword (insert keyword))))
+
+;;;; Strings
+(defconst tomelr-special-chars
+ '((?\" . ?\")
+ (?\\ . ?\\)
+ (?b . ?\b)
+ (?f . ?\f)
+ (?n . ?\n)
+ (?r . ?\r)
+ (?t . ?\t))
+ "Characters which are escaped in TOML, with their Elisp counterparts.")
+
+(defun tomelr--print-string (string &optional from)
+ "Insert a TOML representation of STRING at point.
+FROM is the index of STRING to start from and defaults to 0."
+ ;; (message "[tomelr--print-string DBG] string = %s" string)
+ (insert ?\")
+ (goto-char (prog1 (point) (princ string)))
+ (and from (delete-char from))
+ ;; Escape only quotation mark, backslash, and the control
+ ;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
+ (while (re-search-forward (rx (in ?\" ?\\ cntrl)) nil 'move)
+ (let ((char (preceding-char)))
+ (delete-char -1)
+ (insert ?\\ (or
+ ;; Special TOML character (\n, \r, etc.).
+ (car (rassq char tomelr-special-chars))
+ ;; Fallback: UCS code point in \uNNNN form.
+ (format "u%04x" char)))))
+ (insert ?\")
+ string)
+
+(defun tomelr-encode-string (string)
+ "Return a TOML representation of STRING."
+ (tomelr--with-output-to-string (tomelr--print-string string)))
+
+(defun tomelr--print-stringlike (object)
+ "Insert OBJECT encoded as a TOML string at point.
+Return nil if OBJECT cannot be encoded as a TOML string."
+ (cond ((stringp object)
+ ;; (message "[tomelr--print-stringlike DBG] string")
+ (tomelr--print-string object))
+ ((keywordp object)
+ ;; (message "[tomelr--print-stringlike DBG] keyword")
+ (tomelr--print-string (symbol-name object) 1))
+ ((symbolp object)
+ ;; (message "[tomelr--print-stringlike DBG] symbol")
+ (princ (symbol-name object))
+ ;; (tomelr--print-string (symbol-name object))
+ )))
+
+(defun tomelr--print-key (object)
+ "Insert a TOML key representation of OBJECT at point.
+Signal `tomelr-key-format' if it cannot be encoded as a string."
+ (or (tomelr--print-stringlike object)
+ (signal 'tomelr-key-format (list object))))
+
+;;;; Objects
+(defun tomelr--print-pair (key val)
+ "Insert TOML representation of KEY-VAL pair at point."
+ (tomelr--print-indentation) ;Newline before each key in a key-value pair
+ (tomelr--print-key key)
+ (insert tomelr--print-keyval-separator)
+ (tomelr--print val))
+
+(defun tomelr--print-map (map)
+ "Insert TOML object representation of MAP at point.
+This works for any MAP satisfying `mapp'."
+ (unless (map-empty-p map)
+ (tomelr--with-indentation
+ (map-do #'tomelr--print-pair map))))
+
+(defun tomelr--print-unordered-map (map)
+ "Like `tomelr--print-map', but optionally sort MAP first.
+If `tomelr-encoding-object-sort-predicate' is non-nil, this first
+transforms an unsortable MAP into a sortable alist."
+ (if (and tomelr-encoding-object-sort-predicate
+ (not (map-empty-p map)))
+ (tomelr--print-alist (map-pairs map) t)
+ (tomelr--print-map map)))
+
+;;;; Lists (including alists and plists)
+(defun tomelr--print-alist (alist &optional destructive)
+ "Insert a TOML representation of ALIST at point.
+Sort ALIST first if `tomelr-encoding-object-sort-predicate' is
+non-nil. Sorting can optionally be DESTRUCTIVE for speed."
+ (tomelr--print-map (if (and tomelr-encoding-object-sort-predicate alist)
+ (sort (if destructive alist (copy-sequence alist))
+ (lambda (a b)
+ (funcall tomelr-encoding-object-sort-predicate
+ (car a) (car b))))
+ alist)))
+
+;; The following two are unused but useful to keep around due to the
+;; inherent ambiguity of lists.
+(defun tomelr-encode-alist (alist)
+ "Return a TOML representation of ALIST."
+ (tomelr--with-output-to-string (tomelr--print-alist alist)))
+
+(defun tomelr-encode-plist (plist)
+ "Return a TOML representation of PLIST."
+ (tomelr--with-output-to-string (tomelr--print-unordered-map plist)))
+;;
+
+(defun tomelr--print-list (list)
+ "Like `tomelr-encode-list', but insert the TOML at point."
+ (cond ((tomelr-alist-p list) (tomelr--print-alist list))
+ ((tomelr-plist-p list) (tomelr--print-unordered-map list))
+ ((listp list) (tomelr--print-array list))
+ ((signal 'tomelr-error (list list)))))
+
+;;;; Arrays
+(defun tomelr--print-array (array)
+ "Like `tomelr-encode-array', but insert the TOML at point."
+ (insert ?\[)
+ (unless (length= array 0)
+ (tomelr--with-indentation
+ (tomelr--print-indentation)
+ (let ((first t))
+ (mapc (lambda (elt)
+ (if first
+ (setq first nil)
+ (insert ",")
+ (tomelr--print-indentation))
+ (tomelr--print elt))
+ array)))
+ (or tomelr-encoding-lisp-style-closings
+ (tomelr--print-indentation)))
+ (insert ?\]))
+
+(defun tomelr-encode-array (array)
+ "Return a TOML representation of ARRAY.
+ARRAY can also be a list."
+ (tomelr--with-output-to-string (tomelr--print-array array)))
+
+;;;; Print wrapper
+(defun tomelr--print (object)
+ "Like `tomelr-encode', but insert or print the TOML at point."
+ (cond ((tomelr--print-keyword object))
+ ((listp object) (tomelr--print-list object))
+ ((tomelr--print-stringlike object))
+ ((numberp object) (prin1 object))
+ ((arrayp object) (tomelr--print-array object))
+ ((hash-table-p object) (tomelr--print-unordered-map object))
+ ((signal 'tomelr-error (list object)))))
+
+
+;;; User API
+(defun tomelr-encode (object)
+ "Return a TOML representation of OBJECT as a string.
+If an error is detected during encoding, an error based on
+`tomelr-error' is signaled."
+ (string-trim
+ (tomelr--with-output-to-string (tomelr--print object))))
+
+
+(provide 'tomelr)
+
+;;; tomelr.el ends here
