* lisp/json.el: Add pretty-print option.

(json-encoding-separator, json-encoding-default-indentation)
(json--encoding-current-indentation, json-encoding-pretty-print)
(json-encoding-lisp-style-closings): New vars.
(json--with-indentation): New macro.
(json-encode-hash-table, json-encode-alist, json-encode-plist)
(json-encode-array): Use it to obey json-encoding-pretty-print.
(json-pretty-print-buffer, json-pretty-print): New commands.

Fixes: debbugs:12634

2 files changed, 122 insertions, 25 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 8df55eaa108..97b3a6608ad 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,14 @@
+2012-12-14  Ryan Crum  <ryan.crum@eleostech.com>
+
+        * json.el: Add pretty-print option (bug#12634).
+        (json-encoding-separator, json-encoding-default-indentation)
+        (json--encoding-current-indentation, json-encoding-pretty-print)
+        (json-encoding-lisp-style-closings): New vars.
+        (json--with-indentation): New macro.
+        (json-encode-hash-table, json-encode-alist, json-encode-plist)
+        (json-encode-array): Use it to obey json-encoding-pretty-print.
+        (json-pretty-print-buffer, json-pretty-print): New commands.
+
 2012-12-14  Dmitry Gutov  <dgutov@yandex.ru>
 
         * progmodes/ruby-mode.el (ruby-syntax-propertize-function):
diff --git a/lisp/json.el b/lisp/json.el
index b1ea03120dc..0927625de9f 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -3,7 +3,7 @@
 ;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
 
 ;; Author: Edward O'Connor <ted@oconnor.cx>
-;; Version: 1.3
+;; Version: 1.4
 ;; Keywords: convenience
 
 ;; This file is part of GNU Emacs.
@@ -48,6 +48,7 @@
 ;; 2006-12-29 - XEmacs support, from Aidan Kehoe <kehoea@parhasard.net>.
 ;; 2008-02-21 - Installed in GNU Emacs.
 ;; 2011-10-17 - Patch `json-alist-p' and `json-plist-p' to avoid recursion -tzz
+;; 2012-10-25 - Added pretty-printed reformatting -Ryan Crum (ryan@ryancrum.org)
 
 ;;; Code:
 
@@ -98,6 +99,24 @@ If this has the same value as `json-false', you might not be able to
 tell the difference between `false' and `null'.  Consider let-binding
 this around your call to `json-read' instead of `setq'ing it.")
 
+(defvar json-encoding-separator ","
+  "Value to use as an element seperator when encoding.")
+
+(defvar json-encoding-default-indentation "  "
+  "The default indentation level for encoding.
+Used only when `json-encoding-pretty-print' is non-nil.")
+
+(defvar json--encoding-current-indentation "\n"
+  "Internally used to keep track of the current indentation level of encoding.
+Used only when `json-encoding-pretty-print' is non-nil.")
+
+(defvar json-encoding-pretty-print nil
+  "If non-nil, then the output of `json-encode' will be pretty-printed.")
+
+(defvar json-encoding-lisp-style-closings nil
+  "If non-nil, ] and } closings will be formatted lisp-style,
+without indentation.")
+
 
 
 ;;; Utilities
@@ -123,6 +142,14 @@ this around your call to `json-read' instead of `setq'ing it.")
                  'not-plist)))
   (null list))
 
+(defmacro json--with-indentation (body)
+  `(let ((json--encoding-current-indentation
+          (if json-encoding-pretty-print
+              (concat json--encoding-current-indentation
+                      json-encoding-default-indentation)
+            "")))
+     ,body))
+
 ;; Reader utilities
 
 (defsubst json-advance (&optional n)
@@ -401,41 +428,70 @@ 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}"
+  (format "{%s%s}"
           (json-join
            (let (r)
-             (maphash
-              (lambda (k v)
-                (push (format "%s:%s"
-                              (json-encode-key k)
-                              (json-encode v))
-                      r))
-              hash-table)
+             (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."
-  (format "{%s}"
-          (json-join (mapcar (lambda (cons)
-                               (format "%s:%s"
-                                       (json-encode-key (car cons))
-                                       (json-encode (cdr cons))))
-                             alist)
-                     ", ")))
+  (format "{%s%s}"
+          (json-join
+           (json--with-indentation
+            (mapcar (lambda (cons)
+                      (format (if json-encoding-pretty-print
+                                  "%s%s: %s"
+                                "%s%s:%s")
+                              json--encoding-current-indentation
+                              (json-encode-key (car cons))
+                              (json-encode (cdr cons))))
+                    alist))
+           json-encoding-separator)
+          (if (or (not json-encoding-pretty-print)
+                  json-encoding-lisp-style-closings)
+              ""
+            json--encoding-current-indentation)))
 
 (defun json-encode-plist (plist)
   "Return a JSON representation of PLIST."
   (let (result)
-    (while plist
-      (push (concat (json-encode-key (car plist))
-                    ":"
-                    (json-encode (cadr plist)))
-            result)
-      (setq plist (cddr plist)))
-    (concat "{" (json-join (nreverse 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.
@@ -474,7 +530,22 @@ become JSON objects."
 
 (defun json-encode-array (array)
   "Return a JSON representation of ARRAY."
-  (concat "[" (mapconcat 'json-encode array ", ") "]"))
+  (if (and json-encoding-pretty-print
+           (> (length array) 0))
+      (concat
+       (json--with-indentation
+         (concat (format "[%s" json--encoding-current-indentation)
+                 (json-join (mapcar 'json-encode array)
+                            (format "%s%s"
+                                    json-encoding-separator
+                                    json--encoding-current-indentation))))
+       (format "%s]"
+               (if json-encoding-lisp-style-closings
+                   ""
+                 json--encoding-current-indentation)))
+    (concat "["
+            (mapconcat 'json-encode array json-encoding-separator)
+            "]")))
 
 
 
@@ -541,6 +612,21 @@ Advances point just past JSON object."
         ((listp object)        (json-encode-list object))
         (t                     (signal 'json-error (list object)))))
 
+;; Pretty printing
+
+(defun json-pretty-print-buffer ()
+  "Pretty-print current buffer."
+  (interactive)
+  (json-pretty-print (point-min) (point-max)))
+
+(defun json-pretty-print (begin end)
+  "Pretty-print selected region."
+  (interactive "r")
+  (atomic-change-group
+    (let ((json-encoding-pretty-print t)
+          (txt (delete-and-extract-region begin end)))
+      (insert (json-encode (json-read-from-string txt))))))
+
 (provide 'json)
 
 ;;; json.el ends here