Enable sorting of JSON object keys when encoding

* lisp/json.el (json-encoding-object-sort-predicate): New variable for
specifying a sorting predicate for JSON objects during encoding.
(json--plist-to-alist): New utility function.
(json-encode-hash-table): Re-use `json-encode-alist' when object keys
are to be sorted.
(json-encode-alist): Sort output by
`json-encoding-object-sort-predicate, when set.
(json-encode-plist): Re-use `json-encode-alist' when object keys are
to be sorted.
(json-pretty-print-buffer-ordered): New command to pretty print the
buffer with object keys sorted alphabetically.
(json-pretty-print-ordered): New command to pretty print the region with
object keys sorted alphabetically.

* test/automated/json-tests.el (test-json-plist-to-alist)
(test-json-encode-plist, test-json-encode-hash-table)
(test-json-encode-alist-with-sort-predicate)
(test-json-encode-plist-with-sort-predicate): New tests.

* etc/NEWS: Add an entry for the new commands.

1 files changed, 78 insertions, 39 deletions

diff --git a/lisp/json.el b/lisp/json.el
index 97cf9934c34..0214a3e3a4d 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -52,6 +52,8 @@
 
 ;;; Code:
 
+(require 'map)
+
 ;; Parameters
 
 (defvar json-object-type 'alist
@@ -111,6 +113,13 @@ Used only when `json-encoding-pretty-print' is non-nil.")
   "If non-nil, ] and } closings will be formatted lisp-style,
 without indentation.")
 
+(defvar json-encoding-object-sort-predicate nil
+  "Sorting predicate for JSON object keys during encoding.
+If nil, no sorting is performed.  Else, JSON object keys are
+ordered by the specified sort predicate during encoding.  For
+instance, setting this to `string<' will have JSON object keys
+ordered alphabetically.")
+
 (defvar json-pre-element-read-function nil
   "Function called (if non-nil) by `json-read-array' and
 `json-read-object' right before reading a JSON array or object,
@@ -159,6 +168,15 @@ Unlike `reverse', this keeps the property-value pairs intact."
         (push prop res)))
     res))
 
+(defun json--plist-to-alist (plist)
+  "Return an alist of the property-value pairs in PLIST."
+  (let (res)
+    (while plist
+      (let ((prop (pop plist))
+            (val (pop plist)))
+        (push (cons prop val) res)))
+    (nreverse res)))
+
 (defmacro json--with-indentation (body)
   `(let ((json--encoding-current-indentation
           (if json-encoding-pretty-print
@@ -492,32 +510,39 @@ Please see the documentation of `json-object-type' and `json-key-type'."
 
 (defun json-encode-hash-table (hash-table)
   "Return a JSON representation of HASH-TABLE."
-  (format "{%s%s}"
-          (json-join
-           (let (r)
-             (json--with-indentation
-              (maphash
-               (lambda (k v)
-                 (push (format
-                        (if json-encoding-pretty-print
-                            "%s%s: %s"
-                          "%s%s:%s")
-                        json--encoding-current-indentation
-                        (json-encode-key k)
-                        (json-encode v))
-                       r))
-               hash-table))
-             r)
-           json-encoding-separator)
-          (if (or (not json-encoding-pretty-print)
-                  json-encoding-lisp-style-closings)
-              ""
-            json--encoding-current-indentation)))
+  (if json-encoding-object-sort-predicate
+      (json-encode-alist (map-into hash-table 'list))
+    (format "{%s%s}"
+            (json-join
+             (let (r)
+               (json--with-indentation
+                (maphash
+                 (lambda (k v)
+                   (push (format
+                          (if json-encoding-pretty-print
+                              "%s%s: %s"
+                            "%s%s:%s")
+                          json--encoding-current-indentation
+                          (json-encode-key k)
+                          (json-encode v))
+                         r))
+                 hash-table))
+               r)
+             json-encoding-separator)
+            (if (or (not json-encoding-pretty-print)
+                    json-encoding-lisp-style-closings)
+                ""
+              json--encoding-current-indentation))))
 
 ;; List encoding (including alists and plists)
 
 (defun json-encode-alist (alist)
   "Return a JSON representation of ALIST."
+  (when json-encoding-object-sort-predicate
+    (setq alist
+          (sort alist (lambda (a b)
+                        (funcall json-encoding-object-sort-predicate
+                                 (car a) (car b))))))
   (format "{%s%s}"
           (json-join
            (json--with-indentation
@@ -537,25 +562,27 @@ Please see the documentation of `json-object-type' and `json-key-type'."
 
 (defun json-encode-plist (plist)
   "Return a JSON representation of PLIST."
-  (let (result)
-    (json--with-indentation
-      (while plist
-        (push (concat
-               json--encoding-current-indentation
-               (json-encode-key (car plist))
-               (if json-encoding-pretty-print
-                   ": "
-                 ":")
-               (json-encode (cadr plist)))
-              result)
-        (setq plist (cddr plist))))
-    (concat "{"
-            (json-join (nreverse result) json-encoding-separator)
-            (if (and json-encoding-pretty-print
-                     (not json-encoding-lisp-style-closings))
+  (if json-encoding-object-sort-predicate
+      (json-encode-alist (json--plist-to-alist plist))
+    (let (result)
+      (json--with-indentation
+       (while plist
+         (push (concat
                 json--encoding-current-indentation
-              "")
-            "}")))
+                (json-encode-key (car plist))
+                (if json-encoding-pretty-print
+                    ": "
+                  ":")
+                (json-encode (cadr plist)))
+               result)
+         (setq plist (cddr plist))))
+      (concat "{"
+              (json-join (nreverse result) json-encoding-separator)
+              (if (and json-encoding-pretty-print
+                       (not json-encoding-lisp-style-closings))
+                  json--encoding-current-indentation
+                "")
+              "}"))))
 
 (defun json-encode-list (list)
   "Return a JSON representation of LIST.
@@ -698,6 +725,18 @@ Advances point just past JSON object."
           (txt (delete-and-extract-region begin end)))
       (insert (json-encode (json-read-from-string txt))))))
 
+(defun json-pretty-print-buffer-ordered ()
+  "Pretty-print current buffer with object keys ordered."
+  (interactive)
+  (let ((json-encoding-object-sort-predicate 'string<))
+    (json-pretty-print-buffer)))
+
+(defun json-pretty-print-ordered (begin end)
+  "Pretty-print the region with object keys ordered."
+  (interactive "r")
+  (let ((json-encoding-object-sort-predicate 'string<))
+    (json-pretty-print begin end)))
+
 (provide 'json)
 
 ;;; json.el ends here