From: "Simen Heggestøyl" <simenheg@gmail.com>
To: Dmitry Gutov <dgutov@yandex.ru>
Cc: 21798@debbugs.gnu.org
Subject: bug#21798: 25.0.50; [PATCH] Add support for retrieving paths to JSON elements
Date: Sun, 08 Nov 2015 13:34:14 +0100 [thread overview]
Message-ID: <1446986054.1975.1@smtp.gmail.com> (raw)
In-Reply-To: <1446985933.1975.0@smtp.gmail.com>
[-- Attachment #1.1: Type: text/plain, Size: 209 bytes --]
On Sun, Nov 8, 2015 at 1:32 PM, Simen Heggestøyl <simenheg@gmail.com>
wrote:
> A revised patch implementing your suggestion is attached.
Sorry, I forgot to attach the patch.
Here it is!
-- Simen
[-- Attachment #1.2: Type: text/html, Size: 336 bytes --]
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-support-for-retrieving-paths-to-JSON-elements.patch --]
[-- Type: text/x-patch, Size: 7784 bytes --]
From 2e220a1bfce42081ed84c343ecd809263215a54e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Simen=20Heggest=C3=B8yl?= <simenheg@gmail.com>
Date: Sun, 25 Oct 2015 14:44:59 +0100
Subject: [PATCH] Add support for retrieving paths to JSON elements
Add support for retrieving the path to a JSON element. This can for
instance be useful to retrieve paths in deeply nested JSON
structures.
* lisp/json.el (json-pre-read-function, json-post-read-function): New
variables to hold pre- and post read callback functions for
`json-read'.
(json--path): New variable used internally by `json-path-to-position'.
(json--record-path, json--check-position): New functions used
internally by `json-path-to-position'.
(json-path-to-position): New function for retrieving the path to a
JSON element at a given position.
(json-read-object, json-read-array): Pass the current JSON key to
subsequent calls to `json-read'.
(json-read): Call `json-pre-read-function' and
`json-post-read-function' before and after reading a JSON element,
respectively.
* test/automated/json-tests.el (test-json-path-to-position-with-objects)
(test-json-path-to-position-with-arrays)
(test-json-path-to-position-no-match): New tests for
`json-path-to-position'.
---
lisp/json.el | 88 +++++++++++++++++++++++++++++++++++++++++---
test/automated/json-tests.el | 19 ++++++++++
2 files changed, 101 insertions(+), 6 deletions(-)
diff --git a/lisp/json.el b/lisp/json.el
index b23d12a..2982f08 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -111,6 +111,16 @@ json-encoding-lisp-style-closings
"If non-nil, ] and } closings will be formatted lisp-style,
without indentation.")
+(defvar json-pre-read-function nil
+ "Function called (if non-nil) by `json-read' right before
+reading a JSON element. The function is called with one
+argument, which is the current JSON key when reading an array or
+object, else it is nil.")
+
+(defvar json-post-read-function nil
+ "Function called (if non-nil) by `json-read' right after
+reading a JSON element.")
+
\f
;;; Utilities
@@ -196,6 +206,63 @@ 'json-end-of-file
\f
+;;; Paths
+
+(defvar json--path '()
+ "Used internally by `json-path-to-position' to keep track of
+the path during recursive calls to `json-read'. Each entry is a
+cons of a buffer position, and a JSON key (if any, else nil).")
+
+(defun json--record-path (key)
+ "Record the KEY to the current JSON path.
+Used internally by `json-path-to-position'."
+ (push (cons (point) key) json--path))
+
+(defun json--check-position (position)
+ "Check if the last parsed JSON structure passed POSITION.
+Used internally by `json-path-to-position'."
+ (let ((start (caar json--path)))
+ (when (< start position (+ (point) 1))
+ (let ((path (nreverse (delq nil (mapcar #'cdr json--path)))))
+ (throw :json-path (list :path path
+ :match-start start
+ :match-end (point))))))
+ (pop json--path))
+
+(defun json-path-to-position (position &optional string)
+ "Return the path to the JSON element at POSITION.
+
+When STRING is provided, return the path to the position in the
+string, else to the position in the current buffer.
+
+The return value is a property list with the following
+properties:
+
+:path -- A list of strings and numbers forming the path to
+ the JSON element at the given position. Strings
+ denote object names, while numbers denote array
+ indexes.
+
+:match-start -- Position where the matched JSON element begins.
+
+:match-end -- Position where the matched JSON element ends.
+
+This can for instance be useful to determine the path to a JSON
+element in a deeply nested structure."
+ (save-excursion
+ (unless string
+ (goto-char (point-min)))
+ (let* ((json--path '())
+ (json-pre-read-function #'json--record-path)
+ (json-post-read-function
+ (apply-partially #'json--check-position position))
+ (path (catch :json-path
+ (if string
+ (json-read-from-string string)
+ (json-read)))))
+ (when (plist-get path :path)
+ path))))
+
;;; Keywords
(defvar json-keywords '("true" "false" "null")
@@ -403,7 +470,8 @@ json-read-object
(if (char-equal (json-peek) ?:)
(json-advance)
(signal 'json-object-format (list ":" (json-peek))))
- (setq value (json-read))
+ (json-skip-whitespace)
+ (setq value (json-read key))
(setq elements (json-add-to-object elements key value))
(json-skip-whitespace)
(unless (char-equal (json-peek) ?})
@@ -507,14 +575,17 @@ json-read-array
(json-advance)
(json-skip-whitespace)
;; read values until "]"
- (let (elements)
+ (let ((index 0)
+ elements)
(while (not (char-equal (json-peek) ?\]))
- (push (json-read) elements)
+ (json-skip-whitespace)
+ (push (json-read index) elements)
(json-skip-whitespace)
(unless (char-equal (json-peek) ?\])
(if (char-equal (json-peek) ?,)
(json-advance)
- (signal 'json-error (list 'bleah)))))
+ (signal 'json-error (list 'bleah))))
+ (setq index (+ index 1)))
;; Skip over the "]"
(json-advance)
(apply json-array-type (nreverse elements))))
@@ -558,7 +629,7 @@ json-readtable
table)
"Readtable for JSON reader.")
-(defun json-read ()
+(defun json-read (&optional current-key)
"Parse and return the JSON object following point.
Advances point just past JSON object."
(json-skip-whitespace)
@@ -566,7 +637,12 @@ json-read
(if (not (eq char :json-eof))
(let ((record (cdr (assq char json-readtable))))
(if (functionp (car record))
- (apply (car record) (cdr record))
+ (prog2
+ (when json-pre-read-function
+ (funcall json-pre-read-function current-key))
+ (apply (car record) (cdr record))
+ (when json-post-read-function
+ (funcall json-post-read-function)))
(signal 'json-readtable-error record)))
(signal 'json-end-of-file nil))))
diff --git a/test/automated/json-tests.el b/test/automated/json-tests.el
index d1b7a2f..fa1f548 100644
--- a/test/automated/json-tests.el
+++ b/test/automated/json-tests.el
@@ -49,5 +49,24 @@
(should (equal (json-read-from-string "\"\\nasd\\u0444\\u044b\\u0432fgh\\t\"")
"\nasdфывfgh\t")))
+(ert-deftest test-json-path-to-position-with-objects ()
+ (let* ((json-string "{\"foo\": {\"bar\": {\"baz\": \"value\"}}}")
+ (matched-path (json-path-to-position 32 json-string)))
+ (should (equal (plist-get matched-path :path) '("foo" "bar" "baz")))
+ (should (equal (plist-get matched-path :match-start) 25))
+ (should (equal (plist-get matched-path :match-end) 32))))
+
+(ert-deftest test-json-path-to-position-with-arrays ()
+ (let* ((json-string "{\"foo\": [\"bar\", [\"baz\"]]}")
+ (matched-path (json-path-to-position 20 json-string)))
+ (should (equal (plist-get matched-path :path) '("foo" 1 0)))
+ (should (equal (plist-get matched-path :match-start) 18))
+ (should (equal (plist-get matched-path :match-end) 23))))
+
+(ert-deftest test-json-path-to-position-no-match ()
+ (let* ((json-string "{\"foo\": {\"bar\": \"baz\"}}")
+ (matched-path (json-path-to-position 5 json-string)))
+ (should (null matched-path))))
+
(provide 'json-tests)
;;; json-tests.el ends here
--
2.6.2
next prev parent reply other threads:[~2015-11-08 12:34 UTC|newest]
Thread overview: 16+ messages / expand[flat|nested] mbox.gz Atom feed top
2015-10-31 8:46 bug#21798: 25.0.50; [PATCH] Add support for retrieving paths to JSON elements Simen Heggestøyl
2015-10-31 14:23 ` Dmitry Gutov
2015-11-01 19:52 ` Simen Heggestøyl
2015-11-01 23:27 ` Simen Heggestøyl
2015-11-03 2:00 ` Dmitry Gutov
2015-11-06 16:31 ` Simen Heggestøyl
2015-11-06 17:15 ` Dmitry Gutov
2015-11-07 13:23 ` Richard Stallman
2015-11-07 13:43 ` Dmitry Gutov
2015-11-07 18:50 ` Simen Heggestøyl
2015-11-07 19:18 ` Dmitry Gutov
2015-11-08 12:32 ` Simen Heggestøyl
2015-11-08 12:34 ` Simen Heggestøyl [this message]
2015-11-08 16:16 ` Dmitry Gutov
2015-11-08 21:12 ` Simen Heggestøyl
2015-11-09 0:20 ` Dmitry Gutov
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=1446986054.1975.1@smtp.gmail.com \
--to=simenheg@gmail.com \
--cc=21798@debbugs.gnu.org \
--cc=dgutov@yandex.ru \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.