Update custom-faces and add json-mode

This commit is contained in:
Marcus Kammer 2019-12-03 17:37:52 +01:00
parent 9d93fa9702
commit 869dadd9f9
15 changed files with 929 additions and 2 deletions

View file

@ -81,7 +81,7 @@
'(package-enable-at-startup t) '(package-enable-at-startup t)
'(package-selected-packages '(package-selected-packages
(quote (quote
(elpy darkroom dockerfile-mode ein spacemacs-theme flucui-themes leuven-theme htmlize scss-mode berrys-theme web-mode python-docstring sphinx-doc sphinx-frontend sphinx-mode ox-nikola racket-mode slime gherkin-mode powershell typescript-mode ob-http ob-ipython ob-restclient nord-theme restclient request restclient-test yaml-mode magit))) (json-mode elpy darkroom dockerfile-mode ein spacemacs-theme flucui-themes leuven-theme htmlize scss-mode berrys-theme web-mode python-docstring sphinx-doc sphinx-frontend sphinx-mode ox-nikola racket-mode slime gherkin-mode powershell typescript-mode ob-http ob-ipython ob-restclient nord-theme restclient request restclient-test yaml-mode magit)))
'(python-shell-interpreter "python3") '(python-shell-interpreter "python3")
'(register-preview-delay 2) '(register-preview-delay 2)
'(register-separator 43) '(register-separator 43)
@ -104,4 +104,6 @@
;; If you edit it by hand, you could mess it up, so be careful. ;; If you edit it by hand, you could mess it up, so be careful.
;; Your init file should contain only one such instance. ;; Your init file should contain only one such instance.
;; If there is more than one, they won't work right. ;; If there is more than one, they won't work right.
'(highlight-indentation-current-column-face ((t (:inherit hl-line))))
'(highlight-indentation-face ((t (:inherit hl-line))))
'(variable-pitch ((t (:family "Noto Sans"))))) '(variable-pitch ((t (:family "Noto Sans")))))

View file

@ -1509,7 +1509,7 @@
("Phillip Lord" . "phillip.lord@russet.org.uk")) ("Phillip Lord" . "phillip.lord@russet.org.uk"))
(:url . "http://elpa.gnu.org/packages/persist.html"))]) (:url . "http://elpa.gnu.org/packages/persist.html"))])
(phps-mode . (phps-mode .
[(0 3 19) [(0 3 20)
((emacs ((emacs
(26))) (26)))
"Major mode for PHP with Semantic integration" tar "Major mode for PHP with Semantic integration" tar

View file

@ -0,0 +1 @@
An Emacs port of the Atom One Dark theme from Atom.io.

View file

@ -0,0 +1,65 @@
;;; json-mode-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "json-mode" "json-mode.el" (0 0 0 0))
;;; Generated autoloads from json-mode.el
(defconst json-mode-standard-file-ext '(".json" ".jsonld") "\
List of JSON file extensions.")
(defsubst json-mode--update-auto-mode (filenames) "\
Update the `json-mode' entry of `auto-mode-alist'.
FILENAMES should be a list of file as string.
Return the new `auto-mode-alist' entry" (let* ((new-regexp (rx-to-string (\` (seq (eval (cons (quote or) (append json-mode-standard-file-ext (quote (\, filenames))))) eot)))) (new-entry (cons new-regexp (quote json-mode))) (old-entry (when (boundp (quote json-mode--auto-mode-entry)) json-mode--auto-mode-entry))) (setq auto-mode-alist (delete old-entry auto-mode-alist)) (add-to-list (quote auto-mode-alist) new-entry) new-entry))
(defvar json-mode-auto-mode-list '(".babelrc" ".bowerrc" "composer.lock") "\
List of filename as string to pass for the JSON entry of
`auto-mode-alist'.
Note however that custom `json-mode' entries in `auto-mode-alist'
wont be affected.")
(custom-autoload 'json-mode-auto-mode-list "json-mode" nil)
(defvar json-mode--auto-mode-entry (json-mode--update-auto-mode json-mode-auto-mode-list) "\
Regexp generated from the `json-mode-auto-mode-list'.")
(autoload 'json-mode "json-mode" "\
Major mode for editing JSON files
\(fn)" t nil)
(add-to-list 'magic-fallback-mode-alist '("^[{[]$" . json-mode))
(autoload 'json-mode-show-path "json-mode" "\
Print the path to the node at point to the minibuffer, and yank to the kill ring.
\(fn)" t nil)
(autoload 'json-mode-kill-path "json-mode" "\
\(fn)" t nil)
(autoload 'json-mode-beautify "json-mode" "\
Beautify / pretty-print the active region (or the entire buffer if no active region).
\(fn)" t nil)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "json-mode" '("json-")))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; json-mode-autoloads.el ends here

View file

@ -0,0 +1,2 @@
;;; -*- no-byte-compile: t -*-
(define-package "json-mode" "20190123.422" "Major mode for editing JSON files." '((json-reformat "0.0.5") (json-snatcher "1.0.0")) :commit "0e819e519ae17a2686e0881c4ca51fa873fa9b83" :authors '(("Josh Johnston")) :maintainer '("Josh Johnston") :url "https://github.com/joshwnj/json-mode")

View file

@ -0,0 +1,223 @@
;;; json-mode.el --- Major mode for editing JSON files.
;; Copyright (C) 2011-2014 Josh Johnston
;; Author: Josh Johnston
;; URL: https://github.com/joshwnj/json-mode
;; Package-Version: 20190123.422
;; Version: 1.6.0
;; Package-Requires: ((json-reformat "0.0.5") (json-snatcher "1.0.0"))
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; extend the builtin js-mode's syntax highlighting
;;; Code:
(require 'js)
(require 'rx)
(require 'json-snatcher)
(require 'json-reformat)
(defgroup json-mode '()
"Major mode for editing JSON files."
:group 'js)
;;;###autoload
(defconst json-mode-standard-file-ext '(".json" ".jsonld")
"List of JSON file extensions.")
;; This is to be sure the customization is loaded. Otherwise,
;; autoload discards any defun or defcustom.
;;;###autoload
(defsubst json-mode--update-auto-mode (filenames)
"Update the `json-mode' entry of `auto-mode-alist'.
FILENAMES should be a list of file as string.
Return the new `auto-mode-alist' entry"
(let* ((new-regexp
(rx-to-string
`(seq (eval
(cons 'or
(append json-mode-standard-file-ext
',filenames))) eot)))
(new-entry (cons new-regexp 'json-mode))
(old-entry (when (boundp 'json-mode--auto-mode-entry)
json-mode--auto-mode-entry)))
(setq auto-mode-alist (delete old-entry auto-mode-alist))
(add-to-list 'auto-mode-alist new-entry)
new-entry))
;;;###autoload
(defcustom json-mode-auto-mode-list '(
".babelrc"
".bowerrc"
"composer.lock"
)
"List of filename as string to pass for the JSON entry of
`auto-mode-alist'.
Note however that custom `json-mode' entries in `auto-mode-alist'
wont be affected."
:group 'json-mode
:type '(repeat string)
:set (lambda (symbol value)
"Update SYMBOL with a new regexp made from VALUE.
This function calls `json-mode--update-auto-mode' to change the
`json-mode--auto-mode-entry' entry in `auto-mode-alist'."
(set-default symbol value)
(setq json-mode--auto-mode-entry (json-mode--update-auto-mode value))))
;; Autoload needed to initalize the the `auto-list-mode' entry.
;;;###autoload
(defvar json-mode--auto-mode-entry (json-mode--update-auto-mode json-mode-auto-mode-list)
"Regexp generated from the `json-mode-auto-mode-list'.")
(defconst json-mode-quoted-string-re
(rx (group (char ?\")
(zero-or-more (or (seq ?\\ ?\\)
(seq ?\\ ?\")
(seq ?\\ (not (any ?\" ?\\)))
(not (any ?\" ?\\))))
(char ?\"))))
(defconst json-mode-quoted-key-re
(rx (group (char ?\")
(zero-or-more (or (seq ?\\ ?\\)
(seq ?\\ ?\")
(seq ?\\ (not (any ?\" ?\\)))
(not (any ?\" ?\\))))
(char ?\"))
(zero-or-more blank)
?\:))
(defconst json-mode-number-re (rx (group (one-or-more digit)
(optional ?\. (one-or-more digit)))))
(defconst json-mode-keyword-re (rx (group (or "true" "false" "null"))))
(defconst json-font-lock-keywords-1
(list
(list json-mode-quoted-key-re 1 font-lock-keyword-face)
(list json-mode-quoted-string-re 1 font-lock-string-face)
(list json-mode-keyword-re 1 font-lock-constant-face)
(list json-mode-number-re 1 font-lock-constant-face)
)
"Level one font lock.")
;;;###autoload
(define-derived-mode json-mode javascript-mode "JSON"
"Major mode for editing JSON files"
(set (make-local-variable 'font-lock-defaults) '(json-font-lock-keywords-1 t)))
;; Well formatted JSON files almost always begin with “{” or “[”.
;;;###autoload
(add-to-list 'magic-fallback-mode-alist '("^[{[]$" . json-mode))
;;;###autoload
(defun json-mode-show-path ()
"Print the path to the node at point to the minibuffer, and yank to the kill ring."
(interactive)
(message (jsons-print-path)))
(define-key json-mode-map (kbd "C-c C-p") 'json-mode-show-path)
;;;###autoload
(defun json-mode-kill-path ()
(interactive)
(kill-new (jsons-print-path)))
(define-key json-mode-map (kbd "C-c P") 'json-mode-kill-path)
;;;###autoload
(defun json-mode-beautify ()
"Beautify / pretty-print the active region (or the entire buffer if no active region)."
(interactive)
(let ((json-reformat:indent-width js-indent-level)
(json-reformat:pretty-string? t))
(if (use-region-p)
(json-reformat-region (region-beginning) (region-end))
(json-reformat-region (buffer-end -1) (buffer-end 1)))))
(define-key json-mode-map (kbd "C-c C-f") 'json-mode-beautify)
(defun json-toggle-boolean ()
"If point is on `true' or `false', toggle it."
(interactive)
(unless (nth 8 (syntax-ppss)) ; inside a keyword, string or comment
(let* ((bounds (bounds-of-thing-at-point 'symbol))
(string (and bounds (buffer-substring-no-properties (car bounds) (cdr bounds))))
(pt (point)))
(when (and bounds (member string '("true" "false")))
(delete-region (car bounds) (cdr bounds))
(cond
((string= "true" string)
(insert "false")
(goto-char (if (= pt (cdr bounds)) (1+ pt) pt)))
(t
(insert "true")
(goto-char (if (= pt (cdr bounds)) (1- pt) pt))))))))
(define-key json-mode-map (kbd "C-c C-t") 'json-toggle-boolean)
(defun json-nullify-sexp ()
"Replace the sexp at point with `null'."
(interactive)
(let ((syntax (syntax-ppss)) symbol)
(cond
((nth 4 syntax) nil) ; inside a comment
((nth 3 syntax) ; inside a string
(goto-char (nth 8 syntax))
(when (save-excursion (forward-sexp) (skip-chars-forward "[:space:]") (eq (char-after) ?:))
;; sexp is an object key, so we nullify the entire object
(goto-char (nth 1 syntax)))
(kill-sexp)
(insert "null"))
((setq symbol (bounds-of-thing-at-point 'symbol))
(cond
((looking-at-p "null"))
((save-excursion (skip-chars-backward "[0-9.]") (looking-at json-mode-number-re))
(kill-region (match-beginning 0) (match-end 0))
(insert "null"))
(t (kill-region (car symbol) (cdr symbol)) (insert "null"))))
((< 0 (nth 0 syntax))
(goto-char (nth 1 syntax))
(kill-sexp)
(insert "null"))
(t nil))))
(define-key json-mode-map (kbd "C-c C-k") 'json-nullify-sexp)
(defun json-increment-number-at-point (&optional delta)
"Add DELTA to the number at point; DELTA defaults to 1."
(interactive)
(when (save-excursion (skip-chars-backward "[0-9.]") (looking-at json-mode-number-re))
(let ((num (+ (or delta 1)
(string-to-number (buffer-substring-no-properties (match-beginning 0) (match-end 0)))))
(pt (point)))
(delete-region (match-beginning 0) (match-end 0))
(insert (number-to-string num))
(goto-char pt))))
(define-key json-mode-map (kbd "C-c C-i") 'json-increment-number-at-point)
(defun json-decrement-number-at-point ()
"Decrement the number at point."
(interactive)
(json-increment-number-at-point -1))
(define-key json-mode-map (kbd "C-c C-d") 'json-decrement-number-at-point)
(provide 'json-mode)
;;; json-mode.el ends here

Binary file not shown.

View file

@ -0,0 +1,31 @@
;;; json-reformat-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "json-reformat" "json-reformat.el" (0 0 0 0))
;;; Generated autoloads from json-reformat.el
(autoload 'json-reformat-region "json-reformat" "\
Reformat the JSON in the specified region.
If you want to customize the reformat style,
please see the documentation of `json-reformat:indent-width'
and `json-reformat:pretty-string?'.
\(fn BEGIN END)" t nil)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "json-reformat" '("json-reformat")))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; json-reformat-autoloads.el ends here

View file

@ -0,0 +1,2 @@
;;; -*- no-byte-compile: t -*-
(define-package "json-reformat" "20160212.853" "Reformatting tool for JSON" 'nil :commit "8eb6668ed447988aea06467ba8f42e1f2178246f" :keywords '("json") :authors '(("Wataru MIYAGUNI" . "gonngo@gmail.com")) :maintainer '("Wataru MIYAGUNI" . "gonngo@gmail.com") :url "https://github.com/gongo/json-reformat")

View file

@ -0,0 +1,221 @@
;;; json-reformat.el --- Reformatting tool for JSON
;; Author: Wataru MIYAGUNI <gonngo@gmail.com>
;; URL: https://github.com/gongo/json-reformat
;; Package-Version: 20160212.853
;; Version: 0.0.6
;; Keywords: json
;; Copyright (c) 2012 Wataru MIYAGUNI
;;
;; MIT License
;;
;; Permission is hereby granted, free of charge, to any person obtaining
;; a copy of this software and associated documentation files (the
;; "Software"), to deal in the Software without restriction, including
;; without limitation the rights to use, copy, modify, merge, publish,
;; distribute, sublicense, and/or sell copies of the Software, and to
;; permit persons to whom the Software is furnished to do so, subject to
;; the following conditions:
;;
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
;;; Commentary:
;; json-reformat.el is a reformatting tool for JSON (http://json.org/).
;;
;; ## Usage
;;
;; 1. Specify region
;; 2. Call 'M-x json-reformat-region'
;;
;; ## Customize
;;
;; - `json-reformat:indent-width'
;; - `json-reformat:pretty-string?'
;;
;;; Code:
(require 'json)
(eval-when-compile (require 'cl))
(unless (require 'subr-x nil t)
;; built-in subr-x from 24.4
(defsubst hash-table-keys (hash-table)
"Return a list of keys in HASH-TABLE."
(let ((keys '()))
(maphash (lambda (k _v) (push k keys)) hash-table)
keys)))
(put 'json-reformat-error 'error-message "JSON Reformat error")
(put 'json-reformat-error 'error-conditions '(json-reformat-error error))
(defconst json-reformat:special-chars-as-pretty-string
'((?\" . ?\")
(?\\ . ?\\)))
(defcustom json-reformat:indent-width 4
"How much indentation `json-reformat-region' should do at each level."
:type 'integer
:safe #'integerp
:group 'json-reformat)
(defcustom json-reformat:pretty-string? nil
"Whether to decode the string.
Example:
{\"name\":\"foobar\",\"nick\":\"foo \\u00e4 bar\",\"description\":\"<pre>\\nbaz\\n</pre>\"}
If nil:
{
\"name\": \"foobar\",
\"nick\": \"foo \\u00e4 bar\",
\"description\": \"<pre>\\nbaz\\n<\\/pre>\"
}
Else t:
{
\"name\": \"foobar\",
\"nick\": \"foo ä bar\",
\"description\": \"<pre>
baz
</pre>\"
}"
:type 'boolean
:safe #'booleanp
:group 'json-reformat)
(defun json-reformat:indent (level)
(make-string (* level json-reformat:indent-width) ? ))
(defun json-reformat:number-to-string (val)
(number-to-string val))
(defun json-reformat:symbol-to-string (val)
(cond ((equal 't val) "true")
((equal json-false val) "false")
(t (symbol-name val))))
(defun json-reformat:encode-char-as-pretty (char)
(setq char (encode-char char 'ucs))
(let ((special-char (car (rassoc char json-reformat:special-chars-as-pretty-string))))
(if special-char
(format "\\%c" special-char)
(format "%c" char))))
(defun json-reformat:string-to-string (val)
(if json-reformat:pretty-string?
(format "\"%s\"" (mapconcat 'json-reformat:encode-char-as-pretty val ""))
(json-encode-string val)))
(defun json-reformat:vector-to-string (val level)
(if (= (length val) 0) "[]"
(concat "[\n"
(mapconcat
'identity
(loop for v across val
collect (concat
(json-reformat:indent (1+ level))
(json-reformat:print-node v (1+ level))
))
(concat ",\n"))
"\n" (json-reformat:indent level) "]"
)))
(defun json-reformat:print-node (val level)
(cond ((hash-table-p val) (json-reformat:tree-to-string (json-reformat:tree-sibling-to-plist val) level))
((numberp val) (json-reformat:number-to-string val))
((vectorp val) (json-reformat:vector-to-string val level))
((null val) "null")
((symbolp val) (json-reformat:symbol-to-string val))
(t (json-reformat:string-to-string val))))
(defun json-reformat:tree-sibling-to-plist (root)
(let (pl)
(dolist (key (reverse (hash-table-keys root)) pl)
(setq pl (plist-put pl key (gethash key root))))))
(defun json-reformat:tree-to-string (root level)
(concat "{\n"
(let (key val str)
(while root
(setq key (car root)
val (cadr root)
root (cddr root))
(setq str
(concat str (json-reformat:indent (1+ level))
"\"" key "\""
": "
(json-reformat:print-node val (1+ level))
(when root ",")
"\n"
)))
str)
(json-reformat:indent level)
"}"))
(defun json-reformat-from-string (string)
(with-temp-buffer
(insert string)
(goto-char (point-min))
(condition-case errvar
(let ((json-key-type 'string)
(json-object-type 'hash-table)
json-tree)
(setq json-tree (json-read))
(json-reformat:print-node json-tree 0))
(json-error
(signal 'json-reformat-error
(list (error-message-string errvar)
(line-number-at-pos (point))
(point)))))))
;;;###autoload
(defun json-reformat-region (begin end)
"Reformat the JSON in the specified region.
If you want to customize the reformat style,
please see the documentation of `json-reformat:indent-width'
and `json-reformat:pretty-string?'."
(interactive "*r")
(let ((start-line (line-number-at-pos begin))
(start-pos begin))
(save-excursion
(save-restriction
(narrow-to-region begin end)
(goto-char (point-min))
(let (reformatted)
(condition-case errvar
(progn
(setq reformatted
(json-reformat-from-string
(buffer-substring-no-properties (point-min) (point-max))))
(delete-region (point-min) (point-max))
(insert reformatted))
(json-reformat-error
(let ((reason (nth 1 errvar))
(line (nth 2 errvar))
(position (nth 3 errvar)))
(message
"JSON parse error [Reason] %s [Position] In buffer, line %d (char %d)"
reason
(+ start-line line -1)
(+ start-pos position -1))))))))))
(provide 'json-reformat)
;;; json-reformat.el ends here

Binary file not shown.

View file

@ -0,0 +1,27 @@
;;; json-snatcher-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "json-snatcher" "json-snatcher.el" (0 0 0 0))
;;; Generated autoloads from json-snatcher.el
(autoload 'jsons-print-path "json-snatcher" "\
Print the path to the JSON value under point, and save it in the kill ring.
\(fn)" t nil)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "json-snatcher" '("jsons-")))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; json-snatcher-autoloads.el ends here

View file

@ -0,0 +1,2 @@
;;; -*- no-byte-compile: t -*-
(define-package "json-snatcher" "20150512.347" "Grabs the path to JSON values in a JSON file" '((emacs "24")) :commit "c4cecc0a5051bd364373aa499c47a1bb7a5ac51c" :authors '(("Sterling Graham" . "sterlingrgraham@gmail.com")) :maintainer '("Sterling Graham" . "sterlingrgraham@gmail.com") :url "http://github.com/sterlingg/json-snatcher")

View file

@ -0,0 +1,351 @@
;;; json-snatcher.el --- Grabs the path to JSON values in a JSON file -*- lexical-binding: t -*-
;; Copyright (C) 2013 Sterling Graham <sterlingrgraham@gmail.com>
;; Author: Sterling Graham <sterlingrgraham@gmail.com>
;; URL: http://github.com/sterlingg/json-snatcher
;; Package-Version: 20150512.347
;; Version: 1.0
;; Package-Requires: ((emacs "24"))
;; This file is not part of GNU Emacs.
;;; Commentary:
;;
;; Well this was my first excursion into ELisp programmming. It didn't go too badly once
;; I fiddled around with a bunch of the functions.
;;
;; The process of getting the path to a JSON value at point starts with
;; a call to the jsons-print-path function.
;;
;; It works by parsing the current buffer into a list of parse tree nodes
;; if the buffer hasn't already been parsed in the current Emacs session.
;; While parsing, the region occupied by the node is recorded into the
;; jsons-parsed-regions hash table as a list.The list contains the location
;; of the first character occupied by the node, the location of the last
;; character occupied, and the path to the node. The parse tree is also stored
;; in the jsons-parsed list for possible future use.
;;
;; Once the buffer has been parsed, the node at point is looked up in the
;; jsons-curr-region list, which is the list of regions described in the
;; previous paragraph for the current buffer. If point is not in one of these
;; interval ranges nil is returned, otherwise the path to the value is returned
;; in the form [<key-string>] for objects, and [<loc-int>] for arrays.
;; eg: ['value1'][0]['value2'] gets the array at with name value1, then gets the
;; 0th element of the array (another object), then gets the value at 'value2'.
;;
;;; Installation:
;;
;; IMPORTANT: Works ONLY in Emacs 24 due to the use of the lexical-binding variable.
;;
;; To install add the json-snatcher.el file to your load-path, and
;; add the following lines to your .emacs file:
;;(require 'json-snatcher)
;; (defun js-mode-bindings ()
;; "Sets a hotkey for using the json-snatcher plugin."
;; (when (string-match "\\.json$" (buffer-name))
;; (local-set-key (kbd "C-c C-g") 'jsons-print-path)))
;; (add-hook 'js-mode-hook 'js-mode-bindings)
;; (add-hook 'js2-mode-hook 'js-mode-bindings)
;;
;; This binds the key to snatch the path to the JSON value to C-c C-g only
;; when either JS mode, or JS2 mode is active on a buffer ending with
;; the .json extension.
;;; License:
;; 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Code:
(defvar jsons-curr-token 0
"The current character in the buffer being parsed.")
(defvar jsons-parsed (make-hash-table :test 'equal)
"Hashes each open buffer to the parse tree for that buffer.")
(defvar jsons-parsed-regions (make-hash-table :test 'equal)
"Hashes each open buffer to the ranges in the buffer for each of the parse trees nodes.")
(defvar jsons-curr-region () "The node ranges in the current buffer.")
(defvar jsons-path-printer 'jsons-print-path-python "Default jsons path printer")
(add-hook 'kill-buffer-hook 'jsons-remove-buffer)
(defun jsons-consume-token ()
"Return the next token in the stream."
(goto-char jsons-curr-token)
(let* ((delim_regex "\\([\][\\{\\}:,]\\)")
;; TODO: Improve this regex. Although now it SEEMS to be working, and can be
;; used to validate escapes if needed later. The second half of the string regex is pretty
;; pointless at the moment. I did it this way, so that the code closely mirrors
;; the RFC.
(string_regex "\\(\"\\(\\([^\"\\\\\r\s\t\n]\\)*\\([\r\s\t\n]\\)*\\|\\(\\(\\\\\\\\\\)*\\\\\\(\\([^\r\s\t\n]\\|\\(u[0-9A-Fa-f]\\{4\\}\\)\\)\\)\\)\\)+\"\\)")
(num_regex "\\(-?\\(0\\|\\([1-9][[:digit:]]*\\)\\)\\(\\.[[:digit:]]+\\)?\\([eE][-+]?[[:digit:]]+\\)?\\)")
(literal_regex "\\(true\\|false\\|null\\)")
(full_regex (concat "\\(" delim_regex "\\|" literal_regex "\\|" string_regex "\\|" num_regex "\\)")))
(if (re-search-forward full_regex (point-max) "Not nil")
(progn
(setq jsons-curr-token (match-end 0))
(buffer-substring-no-properties (match-beginning 0) (match-end 0)))
(message "Reached EOF. Possibly invalid JSON."))))
(defun jsons-array (path)
"Create a new json array object that contain the identifier \"json-array\".
a list of the elements contained in the array, and the PATH to the array."
(let*(
(token (jsons-consume-token))
(array "json-array")
(elements ())
(i 0))
(while (not (string= token "]"))
(if (not (string= token ","))
(let ((json-val (jsons-value token path i)))
(setq i (+ i 1))
(push json-val elements)
(setq token (jsons-consume-token)))
(setq token (jsons-consume-token))))
(list array (reverse elements) path)))
(defun jsons-literal (token path)
"Given a TOKEN and PATH, this function return the PATH to the literal."
(let ((match_start (match-beginning 0))
(match_end (match-end 0)))
(progn
(setq jsons-curr-region (append (list (list match_start match_end path)) jsons-curr-region))
(list "json-literal" token path (list match_start match_end)))))
(defun jsons-member (token path)
"This function is called when a member in a JSON object needs to be parsed.
Given the current TOKEN, and the PATH to this member."
(let* ((member ())
(value token)
(range_start (match-beginning 0))
(range_end (match-end 0))
)
(setq member (list "json-member" token))
(if (not (string= (jsons-consume-token) ":"))
(error "Encountered token other than : in jsons-member")
nil)
(let ((json-val (jsons-value (jsons-consume-token) (cons value path) nil)))
(setq member (list member (append json-val
(list range_start range_end))))
(setq jsons-curr-region (append (list (list range_start range_end (elt json-val 2))) jsons-curr-region))
member)))
(defun jsons-number (token path)
"This function will return a json-number given by the current TOKEN.
PATH points to the path to this number. A json-number is defined as per
the num_regex in the `jsons-get-tokens' function."
(progn
(setq jsons-curr-region (append (list (list (match-beginning 0) (match-end 0) path)) jsons-curr-region))
(list "json-number" token path)))
(defun jsons-object (path)
"This function is called when a { is encountered while parsing.
PATH is the path in the tree to this object."
(let*(
(token (jsons-consume-token))
(members (make-hash-table :test 'equal))
(object (list "json-object" members path)))
(while (not (string= token "}"))
(if (not (string= token ","))
(let ((json-mem (jsons-member token path)))
(puthash (elt (elt json-mem 0) 1) (elt json-mem 1) (elt object 1))
(setq token (jsons-consume-token)))
(setq token (jsons-consume-token))))
object))
(defun jsons-string (token path)
"This function is called when a string is encountered while parsing.
The TOKEN is the current token being examined.
The PATH is the path to this string."
(let ((match_start (match-beginning 0))
(match_end (match-end 0)))
(progn
(setq jsons-curr-region (append (list (list match_start match_end path)) jsons-curr-region))
(list "json-string" token path (list match_start match_end)))))
(defun jsons-value (token path array-index)
"A value, which is either an object, array, string, number, or literal.
The is-array variable is nil if inside an array, or the index in
the array that it occupies.
TOKEN is the current token being parsed.
PATH is the path to this value.
ARRAY-INDEX is non-nil if the value is contained within an array, and
points to the index of this value in the containing array."
;;TODO: Refactor the if array-index statement.
(if array-index
(if (jsons-is-number token)
(list "json-value" (jsons-number token (cons array-index path)) (list (match-beginning 0) (match-end 0)))
(cond
((string= token "{") (jsons-object (cons array-index path)))
((string= token "[") (jsons-array (cons array-index path)))
((string= (substring token 0 1) "\"") (jsons-string token (cons array-index path)))
(t (jsons-literal token (cons array-index path)))))
(if (jsons-is-number token)
(list "json-value" (jsons-number token path) path (list (match-beginning 0) (match-end 0)))
(cond
((string= token "{") (jsons-object path))
((string= token "[") (jsons-array path))
((string= (substring token 0 1) "\"") (jsons-string token path))
(t (jsons-literal token path))))))
(defun jsons-get-path ()
"Function to check whether we can grab the json path from the cursor position in the json file."
(let ((i 0)
(node nil))
(setq jsons-curr-region (gethash (current-buffer) jsons-parsed-regions))
(when (not (gethash (current-buffer) jsons-parsed))
(jsons-parse))
(while (< i (length jsons-curr-region))
(let*
((json_region (elt jsons-curr-region i))
(min_token (elt json_region 0))
(max_token (elt json_region 1)))
(when (and (> (point) min_token) (< (point) max_token))
(setq node (elt json_region 2))))
(setq i (+ i 1)))
node))
(defun jsons-is-number (str)
"Test to see whether STR is a valid JSON number."
(progn
(match-end 0)
(save-match-data
(if (string-match "^\\(-?\\(0\\|\\([1-9][[:digit:]]*\\)\\)\\(\\.[[:digit:]]+\\)?\\([eE][-+]?[[:digit:]]+\\)?\\)$" str)
(progn
(match-end 0)
t)
nil))))
(defun jsons-parse ()
"Parse the file given in file, return a list of nodes representing the file."
(save-excursion
(setq jsons-curr-token 0)
(setq jsons-curr-region ())
(if (not (gethash (current-buffer) jsons-parsed))
(let* ((token (jsons-consume-token))
(return_val nil))
(cond
((string= token "{") (setq return_val (jsons-object ())))
((string= token "[") (setq return_val (jsons-array ())))
(t nil))
(puthash (current-buffer) return_val jsons-parsed)
(puthash (current-buffer) jsons-curr-region jsons-parsed-regions)
return_val)
(gethash (current-buffer) jsons-parsed))))
(defun jsons-print-to-buffer (node buffer)
"Prints the given NODE to the BUFFER specified in buffer argument.
TODO: Remove extra comma printed after lists of object members, and lists of array members."
(let ((id (elt node 0)))
(cond
((string= id "json-array")
(progn
(jsons-put-string buffer "[")
(mapc (lambda (x) (progn
(jsons-print-to-buffer buffer x)
(jsons-put-string buffer ",") )) (elt node 1))
(jsons-put-string buffer "]")))
((string= id "json-literal")
(jsons-put-string buffer (elt node 1)))
((string= id "json-member")
(jsons-put-string buffer (elt node 1))
(jsons-put-string buffer ": ")
(jsons-print-to-buffer buffer (elt node 2)))
((string= id "json-number")
(jsons-put-string buffer (elt node 1)))
((string= id "json-object")
(progn
(jsons-put-string buffer "{")
(maphash (lambda (key value)
(progn
(jsons-put-string buffer key)
(jsons-put-string buffer ":")
(jsons-print-to-buffer buffer value)
(jsons-put-string buffer ","))) (elt node 1))
(jsons-put-string buffer "}")))
((string= id "json-string")
(jsons-put-string buffer (elt node 1)))
((string= id "json-value")
(jsons-print-to-buffer buffer (elt node 1)))
(t nil))))
(defun jsons-print-path-jq ()
"Print the jq path to the JSON value under point, and save it in the kill ring."
(let* ((path (jsons-get-path))
(i 0)
(jq_str ".")
key)
(setq path (reverse path))
(while (< i (length path))
(if (numberp (elt path i))
(progn
(setq jq_str (concat jq_str "[" (number-to-string (elt path i)) "]"))
(setq i (+ i 1)))
(progn
(setq key (elt path i))
(setq jq_str (concat jq_str (substring key 1 (- (length key) 1))))
(setq i (+ i 1))))
(when (elt path i)
(unless (numberp (elt path i))
(setq jq_str (concat jq_str ".")))))
(progn (kill-new jq_str)
(princ jq_str))))
(defun jsons-print-path-python ()
"Print the python path to the JSON value under point, and save it in the kill ring."
(let ((path (jsons-get-path))
(i 0)
(python_str ""))
(setq path (reverse path))
(while (< i (length path))
(if (numberp (elt path i))
(progn
(setq python_str (concat python_str "[" (number-to-string (elt path i)) "]"))
(setq i (+ i 1)))
(progn
(setq python_str (concat python_str "[" (elt path i) "]"))
(setq i (+ i 1)))))
(progn (kill-new python_str)
(princ python_str))))
;;;###autoload
(defun jsons-print-path ()
"Print the path to the JSON value under point, and save it in the kill ring."
(interactive)
(funcall jsons-path-printer))
(defun jsons-put-string (buffer str)
"Append STR to the BUFFER specified in the argument."
(save-current-buffer
(set-buffer (get-buffer-create buffer))
(insert (prin1-to-string str t))))
(defun jsons-remove-buffer ()
"Used to clean up the token regions, and parse tree used by the parser."
(progn
(remhash (current-buffer) jsons-parsed)
(remhash (current-buffer) jsons-parsed-regions)))
(provide 'json-snatcher)
;; Local-Variables:
;; indent-tabs-mode: nil
;; End:
;;; json-snatcher.el ends here

Binary file not shown.