Archived
1
0
Fork 0
This repository has been archived on 2024-10-19. You can view files and clone it, but cannot push or open issues or pull requests.
emacs/code/elpa/json-mode-20240427.1245/json-mode.el
2024-07-28 12:03:37 -04:00

308 lines
10 KiB
EmacsLisp
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; json-mode.el --- Major mode for editing JSON files -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2023 Josh Johnston, taku0
;; Author: Josh Johnston
;; taku0
;; URL: https://github.com/joshwnj/json-mode
;; Version: 1.9.2
;; Package-Requires: ((json-snatcher "1.0.0") (emacs "24.4"))
;; 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)
(defgroup json '()
"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))
;;; make byte-compiler happy
(defvar json-mode--auto-mode-entry)
;;;###autoload
(defcustom json-mode-auto-mode-list '(".babelrc"
".bowerrc"
"composer.lock")
"List of filenames for the JSON entry of `auto-mode-alist'.
Note however that custom `json-mode' entries in `auto-mode-alist'
wont be affected."
:group 'json
: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 (optional ?-)
(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-keyword-re 1 font-lock-constant-face)
(list json-mode-number-re 1 font-lock-constant-face))
"Level one font lock.")
(defvar json-mode-syntax-table
(let ((st (make-syntax-table)))
;; Objects
(modify-syntax-entry ?\{ "(}" st)
(modify-syntax-entry ?\} "){" st)
;; Arrays
(modify-syntax-entry ?\[ "(]" st)
(modify-syntax-entry ?\] ")[" st)
;; Strings
(modify-syntax-entry ?\" "\"" st)
;; Comments
(modify-syntax-entry ?\n ">" st)
;; Dot in floating point number literal.
(modify-syntax-entry ?. "_" st)
st))
(defvar json-mode--string-syntax-table
(let ((st (copy-syntax-table json-mode-syntax-table)))
(modify-syntax-entry ?. "." st)
st)
"Syntax table for strings.")
(defvar jsonc-mode-syntax-table
(let ((st (copy-syntax-table json-mode-syntax-table)))
;; Comments
(modify-syntax-entry ?/ ". 124" st)
(modify-syntax-entry ?\n ">" st)
(modify-syntax-entry ?\^m ">" st)
(modify-syntax-entry ?* ". 23bn" st)
st))
(defvar jsonc-mode--string-syntax-table
(let ((st (copy-syntax-table jsonc-mode-syntax-table)))
(modify-syntax-entry ?. "." st)
st)
"Syntax table for strings and comments.")
(defun json-mode--syntactic-face (state)
"Return syntactic face function for the position represented by STATE.
STATE is a `parse-partial-sexp' state, and the returned function is the
json font lock syntactic face function."
(cond
((nth 3 state)
;; This might be a string or a name
(let ((startpos (nth 8 state)))
(save-excursion
(goto-char startpos)
(if (looking-at-p json-mode-quoted-key-re)
font-lock-keyword-face
font-lock-string-face))))
((nth 4 state) font-lock-comment-face)))
(defun json-mode-forward-sexp (&optional arg)
"Move point forward an atom or balanced bracket.
See `forward-sexp for ARG."
(interactive "p")
(unless arg
(setq arg 1))
(let ((forward-sexp-function nil)
(sign (if (< arg 0) -1 1))
state)
(while (not (zerop arg))
(setq state (syntax-ppss))
(if (nth 8 state)
;; Inside a string or comment.
(progn
(with-syntax-table
(if (eq major-mode 'jsonc-mode)
jsonc-mode--string-syntax-table
json-mode--string-syntax-table)
(forward-sexp sign)))
(forward-sexp sign))
(setq arg (- arg sign)))))
;;;###autoload
(define-derived-mode json-mode javascript-mode "JSON"
"Major mode for editing JSON files."
:syntax-table json-mode-syntax-table
(setq font-lock-defaults
'(json-font-lock-keywords-1
nil nil nil nil
(font-lock-syntactic-face-function . json-mode--syntactic-face)))
(setq-local forward-sexp-function #'json-mode-forward-sexp))
;;;###autoload
(define-derived-mode jsonc-mode json-mode "JSONC"
"Major mode for editing JSON files with comments."
:syntax-table jsonc-mode-syntax-table)
;; 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."
(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 ()
"Save JSON path to object at point to kill ring."
(interactive)
(kill-new (jsons-print-path)))
(define-key json-mode-map (kbd "C-c C-k") 'json-mode-kill-path)
;;;###autoload
(defun json-mode-beautify (begin end)
"Beautify/pretty-print from BEGIN to END.
If the region is not active, beautify the entire buffer ."
(interactive "r")
(unless (use-region-p)
(setq begin (point-min)
end (point-max)))
(json-pretty-print begin end))
(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 "P")
(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 (&optional delta)
"Subtract DELTA from the number at point; DELTA defaults to 1."
(interactive "P")
(json-increment-number-at-point (- (or delta 1))))
(define-key json-mode-map (kbd "C-c C-d") 'json-decrement-number-at-point)
(provide 'json-mode)
;;; json-mode.el ends here