bug#12634: Patch for pretty-printing in json.el

[Ryan Crum <ryan.j.crum@gmail.com>]

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

OK, let's try this again.

New patch attached.

On Tue, Oct 30, 2012 at 4:03 PM, Stefan Monnier <monnier@iro.umontreal.ca>wrote:

> - Your patch does not apply to the trunk version of json.el where
>   alist/plist keys are encoded with a new json-encode-key.
>

Oops. Fixed.


>
> - I don't understand this helper function.  Why not store the leading "\n"
>   directly in json-encoding-current-indentation so that
>   we can use json-encoding-current-indentation directly instead of
>   calling json--current-whitespace?
>

Yeah, I see what you mean. Fixed.


>
> - BTW your patch calls json-encoding-current-indentation as a function in
>   json-encode-plist.
>

Foggy-headed. Fixed.


>
> - OTOH, I wouldn't mind a helper function/macro to consolidate all the
>
>           (let ((json-encoding-current-indentation
>                  (if json-encoding-pretty-print
>                      (concat json-encoding-current-indentation
>                              json-encoding-default-indentation)
>                    "")))
>
>   in a single spot.
>

I created a little macro for this (json--with-indentation).


>
> - Why use ", " rather than "," for json-encoding-default-separator?
>

Vestigial code from a much older version of this patch. Fixed.


>
> - json-encoding-default-separator is a bad name since it holds the
>   *current* separator, rather than the default.
>

Renamed to json-encoding-separator. This was also vestigial (at one point
it only used line-breaks if lists were beyond a certain length; overly
complex).


> - Why (format "%s" (json--current-whitespace)) rather than
>   (json--current-whitespace)?
>

Yeah, good question. Fixed.

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

[-- Attachment #2: json-pretty-printing.diff --]
[-- Type: application/octet-stream, Size: 8516 bytes --]

*** a/json.el
--- b/json.el
***************
*** 3,9 ****
  ;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
  
  ;; Author: Edward O'Connor <ted@oconnor.cx>
! ;; Version: 1.3
  ;; Keywords: convenience
  
  ;; This file is part of GNU Emacs.
--- 3,9 ----
  ;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
  
  ;; Author: Edward O'Connor <ted@oconnor.cx>
! ;; Version: 1.4
  ;; Keywords: convenience
  
  ;; This file is part of GNU Emacs.
***************
*** 48,53 ****
--- 48,54 ----
  ;; 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:
  
***************
*** 99,104 **** If this has the same value as `json-false', you might not be able to
--- 100,124 ----
  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
+   "Setting this to non-nil will result in the output of `json-encode'
+ to be pretty-printed.")
+ 
+ (defvar json-encoding-lisp-style-closings nil
+   "Setting this to `t' will cause ] and } closings to happen lisp-style,
+ without indentation.")
+ 
  \f
  
  ;;; Utilities
***************
*** 124,129 **** this around your call to `json-read' instead of `setq'ing it.")
--- 144,157 ----
                   '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)
***************
*** 402,442 **** 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}"
            (json-join
             (let (r)
!              (maphash
!               (lambda (k v)
!                 (push (format "%s:%s"
!                               (json-encode-key k)
!                               (json-encode v))
!                       r))
!               hash-table)
               r)
!            ", ")))
  
  ;; 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)
!                      ", ")))
  
  (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) ", ") "}")))
  
  (defun json-encode-list (list)
    "Return a JSON representation of LIST.
--- 430,497 ----
  
  (defun json-encode-hash-table (hash-table)
    "Return a JSON representation of HASH-TABLE."
!   (format (if json-encoding-pretty-print "{%s%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 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 (if json-encoding-pretty-print "{%s%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 json-encoding-lisp-style-closings
!               ""
!             json-encoding-current-indentation)))
  
  (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))
!                 json-encoding-current-indentation
!               "")
!             "}")))
  
  (defun json-encode-list (list)
    "Return a JSON representation of LIST.
***************
*** 475,481 **** become JSON objects."
  
  (defun json-encode-array (array)
    "Return a JSON representation of ARRAY."
!   (concat "[" (mapconcat 'json-encode array ", ") "]"))
  
  \f
  
--- 530,553 ----
  
  (defun json-encode-array (array)
    "Return a JSON representation of ARRAY."
!   (if (and json-encoding-pretty-print
!            (> (length array) 0))
!       (concat
!        (let ((json-encoding-current-indentation
!               (concat json-encoding-current-indentation
!                       json-encoding-default-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)
!             "]")))
  
  \f
  
***************
*** 542,547 **** Advances point just past JSON object."
--- 614,642 ----
          ((listp object)        (json-encode-list object))
          (t                     (signal 'json-error (list object)))))
  
+ ;; Pretty printing
+ 
+ (defun json-pretty-print-buffer ()
+   "Pretty-print current buffer."
+   (interactive)
+   (let* ((json-encoding-pretty-print t)
+          (json-string (json-encode (json-read-from-string (buffer-string))))
+          (buf (current-buffer)))
+     (with-current-buffer buf
+       (erase-buffer)
+       (insert json-string))))
+ 
+ (defun json-pretty-print ()
+   "Pretty-print selected region."
+   (interactive)
+   (unless mark-active
+     (error "No region selected."))
+   (let ((begin (region-beginning))
+         (end (region-end))
+         (json-encoding-pretty-print t))
+     (kill-region begin end)
+     (insert (json-encode (json-read-from-string (current-kill 0))))))
+ 
  (provide 'json)
  
  ;;; json.el ends here