From: Andreas Gerler Date: Sun, 22 Dec 2024 12:24:21 +0000 (+0100) Subject: update yaml X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=9ecd1be32be9d1b36a54ad06ca331d3d345d983d;p=emacsconfig.git update yaml Signed-off-by: Andreas Gerler --- diff --git a/elpa/yaml-20230714.154/yaml-autoloads.el b/elpa/yaml-20230714.154/yaml-autoloads.el deleted file mode 100644 index 85ae8588..00000000 --- a/elpa/yaml-20230714.154/yaml-autoloads.el +++ /dev/null @@ -1,26 +0,0 @@ -;;; yaml-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "yaml" "yaml.el" (0 0 0 0)) -;;; Generated autoloads from yaml.el - -(register-definition-prefixes "yaml" '("yaml-")) - -;;;*** - -;;;### (autoloads nil nil ("yaml-pkg.el") (0 0 0 0)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; yaml-autoloads.el ends here diff --git a/elpa/yaml-20230714.154/yaml-pkg.el b/elpa/yaml-20230714.154/yaml-pkg.el deleted file mode 100644 index e6ead0f2..00000000 --- a/elpa/yaml-20230714.154/yaml-pkg.el +++ /dev/null @@ -1,14 +0,0 @@ -(define-package "yaml" "20230714.154" "YAML parser for Elisp" - '((emacs "25.1")) - :commit "ee86566af1ed4975531ab3aa4eb4dba770c227f6" :authors - '(("Zachary Romero" . "zkry@posteo.org")) - :maintainers - '(("Zachary Romero" . "zkry@posteo.org")) - :maintainer - '("Zachary Romero" . "zkry@posteo.org") - :keywords - '("tools") - :url "https://github.com/zkry/yaml.el") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/yaml-20230714.154/yaml.el b/elpa/yaml-20230714.154/yaml.el deleted file mode 100644 index 6c61ffcd..00000000 --- a/elpa/yaml-20230714.154/yaml.el +++ /dev/null @@ -1,2908 +0,0 @@ -;;; yaml.el --- YAML parser for Elisp -*- lexical-binding: t -*- - -;; Copyright © 2021 Zachary Romero - -;; Author: Zachary Romero -;; Version: 0.5.1 -;; Homepage: https://github.com/zkry/yaml.el -;; Package-Requires: ((emacs "25.1")) -;; Keywords: tools - -;; yaml.el requires at least GNU Emacs 25.1 - -;; This file is not part of GNU Emacs - -;; This file 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, 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. - -;; For a full copy of the GNU General Public License -;; see . - - -;;; Commentary: - -;; yaml.el contains the code for parsing YAML natively in Elisp with -;; no dependencies. The main function to parse YAML provided is -;; `yaml-parse-string'. `yaml-encode' is also provided to encode a -;; Lisp object to YAML. The following are some examples of its usage: -;; -;; (yaml-parse-string "key1: value1\nkey2: value2") -;; (yaml-parse-string "key1: value1\nkey2: value2" :object-type 'alist) -;; (yaml-parse-string "numbers: [1, 2, 3]" :sequence-type 'list) -;; -;; (yaml-encode '((count . 3) (value . 10) (items ("ruby" "diamond")))) - -;;; Code: - -(require 'subr-x) -(require 'seq) -(require 'cl-lib) - -(defconst yaml-parser-version "0.5.1") - -(defvar yaml--parse-debug nil - "Turn on debugging messages when parsing YAML when non-nil. - -This flag is intended for development purposes.") - -(defconst yaml--tracing-ignore '("s-space" - "s-tab" - "s-white" - "l-comment" - "b-break" - "b-line-feed" - "b-carriage-return" - "s-b-comment" - "b-comment" - "l-comment" - "ns-char" - "nb-char" - "b-char" - "c-printable" - "b-as-space")) - -(defvar yaml--parsing-input "" - "The string content of the current item being processed.") -(defvar yaml--parsing-position 0 - "The position that the parser is currently looking at.") -(defvar yaml--states nil - "Stack of parsing states.") - -(defvar yaml--parsing-object-type nil) -(defvar yaml--parsing-object-key-type nil) -(defvar yaml--parsing-sequence-type nil) -(defvar yaml--parsing-null-object nil) -(defvar yaml--parsing-false-object nil) -(defvar yaml--parsing-store-position nil) -(defvar yaml--string-values nil) - -(cl-defstruct (yaml--state (:constructor yaml--state-create) - (:copier nil)) - doc tt m name lvl beg end) - -(defmacro yaml--parse (data &rest forms) - "Parse DATA according to FORMS." - (declare (indent defun)) - `(progn (setq yaml--parsing-input ,data) - (setq yaml--parsing-position 0) - (yaml--initialize-state) - ,@forms)) - -(defun yaml--state-curr () - "Return the current state." - (or (car yaml--states) - (yaml--state-create - :name nil :doc nil :lvl 0 :beg 0 :end 0 :m nil :tt nil))) - -(defun yaml--state-set-m (val) - "Set the current value of t to VAL." - (let* ((states yaml--states)) - (while states - (let* ((top-state (car states)) - (new-state (yaml--state-create :doc (yaml--state-doc top-state) - :tt (yaml--state-tt top-state) - :m val - :name (yaml--state-name top-state) - :lvl (yaml--state-lvl top-state) - :beg (yaml--state-beg top-state) - :end (yaml--state-end top-state)))) - (setcar states new-state)) - (setq states (cdr states))))) - -(defun yaml--state-set-t (val) - "Set the current value of t to VAL." - (let* ((states yaml--states)) - (while states - (let* ((top-state (car states)) - (new-state (yaml--state-create :doc (yaml--state-doc top-state) - :tt val - :m (yaml--state-m top-state) - :name (yaml--state-name top-state) - :lvl (yaml--state-lvl top-state) - :beg (yaml--state-beg top-state) - :end (yaml--state-end top-state)))) - (setcar states new-state)) - (setq states (cdr states))))) - -(defun yaml--state-curr-doc () - "Return the doc property of current state." - (yaml--state-doc (yaml--state-curr))) - -(defun yaml--state-curr-t () - "Return the doc property of current state." - (yaml--state-tt (yaml--state-curr))) - -(defun yaml--state-curr-m () - "Return the doc property of current state." - (or (yaml--state-m (yaml--state-curr)) 1)) - -(defun yaml--state-curr-end () - "Return the doc property of current state." - (yaml--state-end (yaml--state-curr))) - -(defun yaml--push-state (name) - "Add a new state frame with NAME." - (let* ((curr-state (yaml--state-curr)) - (new-state (yaml--state-create - :doc (yaml--state-curr-doc) - :tt (yaml--state-curr-t) - :m (yaml--state-curr-m) - :name name - :lvl (1+ (yaml--state-lvl curr-state)) - :beg yaml--parsing-position - :end nil))) - (push new-state yaml--states))) - -(defun yaml--pop-state () - "Pop the current state." - (let ((popped-state (car yaml--states))) - (setq yaml--states (cdr yaml--states)) - (let ((top-state (car yaml--states))) - (when top-state - (setcar yaml--states - (yaml--state-create :doc (yaml--state-doc top-state) - :tt (yaml--state-tt top-state) - :m (yaml--state-m top-state) - :name (yaml--state-name top-state) - :lvl (yaml--state-lvl top-state) - :beg (yaml--state-beg popped-state) - :end yaml--parsing-position)))))) - -(defun yaml--initialize-state () - "Initialize the yaml state for parsing." - (setq yaml--states - (list (yaml--state-create :doc nil - :tt nil - :m nil - :name nil - :lvl 0 - :beg nil - :end nil)))) - -(defconst yaml--grammar-resolution-rules - '(("ns-plain" . literal)) - "Alist determining how to resolve grammar rule.") - -;;; Receiver Functions - -(defvar yaml--document-start-version nil) -(defvar yaml--document-start-explicit nil) -(defvar yaml--document-end-explicit nil) -(defvar yaml--tag-map nil) -(defvar yaml--tag-handle nil) -(defvar yaml--document-end nil) - -(defvar yaml--cache nil - "Stack of data for temporary calculations.") -(defvar yaml--object-stack nil - "Stack of objects currently being build.") -(defvar yaml--state-stack nil - "The state that the YAML parser is with regards to incoming events.") -(defvar yaml--root nil) - -(defvar yaml--anchor-mappings nil - "Hashmap containing the anchor mappings of the current parsing run.") -(defvar yaml--resolve-aliases nil - "Flag determining if the event processing should attempt to resolve aliases.") - -(defun yaml--parse-block-header (header) - "Parse the HEADER string returning chomping style and indent count." - (let* ((pos 0) - (chomp-indicator :clip) - (indentation-indicator nil) - (char (and (< pos (length header)) (aref header pos))) - (process-char (lambda (char) - (when char - (cond - ((< ?0 char ?9) - (progn (setq indentation-indicator (- char ?0)))) - ((equal char ?\-) (setq chomp-indicator :strip)) - ((equal char ?\+) (setq chomp-indicator :keep))) - (setq pos (1+ pos)))))) - (when (or (eq char ?\|) (eq char ?\>)) - (setq pos (1+ pos)) - (setq char (and (< pos (length header)) (aref header pos)))) - (funcall process-char char) - (let ((char (and (< pos (length header)) (aref header pos)))) ; - (funcall process-char char) - (list chomp-indicator indentation-indicator)))) - -(defun yaml--chomp-text (text-body chomp) - "Change the ending newline of TEXT-BODY based on CHOMP." - (cond ((eq :clip chomp) - (concat (replace-regexp-in-string "\n*\\'" "" text-body) "\n")) - ((eq :strip chomp) - (replace-regexp-in-string "\n*\\'" "" text-body)) - ((eq :keep chomp) - text-body))) - -(defun yaml--process-folded-text (text) - "Remove the header line for a folded match and return TEXT body formatted." - (let* ((text (yaml--process-literal-text text)) - (done)) - (while (not done) - (let ((replaced (replace-regexp-in-string "\\([^\n]\\)\n\\([^\n ]\\)" - "\\1 \\2" - text))) - (when (equal replaced text) - (setq done t)) - (setq text replaced))) - (replace-regexp-in-string - "\\(\\(?:^\\|\n\\)[^ \n][^\n]*\\)\n\\(\n+\\)\\([^\n ]\\)" "\\1\\2\\3" - text))) - -(defun yaml--process-literal-text (text) - "Remove the header line for a folded match and return TEXT body formatted." - (let ((n (get-text-property 0 'yaml-n text))) - (remove-text-properties 0 (length text) '(yaml-n nil) text) - (let* ((header-line (substring text 0 (string-match "\n" text))) - (text-body (substring text (1+ (string-match "\n" text)))) - (parsed-header (yaml--parse-block-header header-line)) - (chomp (car parsed-header)) - (starting-spaces-ct - (or (and (cadr parsed-header) (+ (or n 0) (cadr parsed-header))) - (let ((_ (string-match "^\n*\\( *\\)" text-body))) - (length (match-string 1 text-body))))) - (lines (split-string text-body "\n")) - (striped-lines - (seq-map (lambda (l) - (replace-regexp-in-string - (format "\\` \\{0,%d\\}" starting-spaces-ct) "" l)) - lines)) - (text-body (string-join striped-lines "\n"))) - (yaml--chomp-text text-body chomp)))) - -;; TODO: Process tags and use them in this function. -(defun yaml--resolve-scalar-tag (scalar) - "Convert a SCALAR string to it's corresponding object." - (cond - (yaml--string-values - scalar) - ;; tag:yaml.org,2002:null - ((or (equal "null" scalar) - (equal "Null" scalar) - (equal "NULL" scalar) - (equal "~" scalar)) - yaml--parsing-null-object) - ;; tag:yaml.org,2002:bool - ((or (equal "true" scalar) - (equal "True" scalar) - (equal "TRUE" scalar)) t) - ((or (equal "false" scalar) - (equal "False" scalar) - (equal "FALSE" scalar)) - yaml--parsing-false-object) - ;; tag:yaml.org,2002:int - ((string-match "^0$\\|^-?[1-9][0-9]*$" scalar) - (string-to-number scalar)) - ((string-match "^[-+]?[0-9]+$" scalar) - (string-to-number scalar)) - ((string-match "^0o[0-7]+$" scalar) - (string-to-number scalar 8)) - ((string-match "^0x[0-9a-fA-F]+$" scalar) - (string-to-number scalar 16)) - ;; tag:yaml.org,2002:float - ((string-match - "^[-+]?\\(\\.[0-9]+\\|[0-9]+\\(\\.[0-9]*\\)?\\)\\([eE][-+]?[0-9]+\\)?$" - scalar) - (string-to-number scalar 10)) - ((string-match "^[-+]?\\(\\.inf\\|\\.Inf\\|\\.INF\\)$" scalar) - 1.0e+INF) - ((string-match "^[-+]?\\(\\.nan\\|\\.NaN\\|\\.NAN\\)$" scalar) - 1.0e+INF) - ((string-match "^0$\\|^-?[1-9]\\(\\.[0-9]*\\)?\\(e[-+][1-9][0-9]*\\)?$" - scalar) - (string-to-number scalar)) - (t scalar))) - -(defun yaml--hash-table-to-alist (hash-table) - "Convert HASH-TABLE to a alist." - (let ((alist nil)) - (maphash - (lambda (k v) - (setq alist (cons (cons k v) alist))) - hash-table) - alist)) - -(defun yaml--hash-table-to-plist (hash-table) - "Convert HASH-TABLE to a plist." - (let ((plist nil)) - (maphash - (lambda (k v) - (setq plist (cons k (cons v plist)))) - hash-table) - plist)) - -(defun yaml--format-object (hash-table) - "Convert HASH-TABLE to alist of plist if specified." - (cond - ((equal yaml--parsing-object-type 'hash-table) - hash-table) - ((equal yaml--parsing-object-type 'alist) - (yaml--hash-table-to-alist hash-table)) - ((equal yaml--parsing-object-type 'plist) - (yaml--hash-table-to-plist hash-table)) - (t hash-table))) - -(defun yaml--format-list (l) - "Convert L to array if specified." - (cond - ((equal yaml--parsing-sequence-type 'list) - l) - ((equal yaml--parsing-sequence-type 'array) - (apply #'vector l)) - (t l))) - -(defun yaml--stream-start-event () - "Create the data for a stream-start event." - '(:stream-start)) - -(defun yaml--stream-end-event () - "Create the data for a stream-end event." - '(:stream-end)) - -(defun yaml--mapping-start-event (_) - "Process event indicating start of mapping." - ;; NOTE: currently don't have a use for FLOW - (push :mapping yaml--state-stack) - (push (make-hash-table :test 'equal) yaml--object-stack)) - -(defun yaml--mapping-end-event () - "Process event indicating end of mapping." - (pop yaml--state-stack) - (let ((obj (pop yaml--object-stack))) - (yaml--scalar-event nil obj)) - '(:mapping-end)) - -(defun yaml--sequence-start-event (_) - "Process event indicating start of sequence according to FLOW." - ;; NOTE: currently don't have a use for FLOW - (push :sequence yaml--state-stack) - (push nil yaml--object-stack) - '(:sequence-start)) - -(defun yaml--sequence-end-event () - "Process event indicating end of sequence." - (pop yaml--state-stack) - (let ((obj (pop yaml--object-stack))) - (yaml--scalar-event nil obj)) - '(:sequence-end)) - -(defun yaml--anchor-event (name) - "Process event indicating an anchor has been defined with NAME." - (push :anchor yaml--state-stack) - (push `(:anchor ,name) yaml--object-stack)) - -(defun yaml--scalar-event (style value) - "Process the completion of a scalar VALUE. - - Note that VALUE may be a complex object here. STYLE is - currently unused." - (let ((top-state (car yaml--state-stack)) - (value* (cond - ((stringp value) (yaml--resolve-scalar-tag value)) - ((listp value) (yaml--format-list value)) - ((hash-table-p value) (yaml--format-object value)) - ((vectorp value) value) - ((not value) nil)))) - (cond - ((not top-state) - (setq yaml--root value*)) - ((equal top-state :anchor) - (let* ((anchor (pop yaml--object-stack)) - (name (nth 1 anchor))) - (puthash name value yaml--anchor-mappings) - (pop yaml--state-stack) - (yaml--scalar-event nil value))) - ((equal top-state :sequence) - (let ((l (car yaml--object-stack))) - (setcar yaml--object-stack (append l (list value*))))) - ((equal top-state :mapping) - (progn - (push :mapping-value yaml--state-stack) - (push value* yaml--cache))) - ((equal top-state :mapping-value) - (progn - (let ((key (pop yaml--cache)) - (table (car yaml--object-stack))) - (when (stringp key) - (cond - ((eql 'symbol yaml--parsing-object-key-type) - (setq key (intern key))) - ((eql 'keyword yaml--parsing-object-key-type) - (setq key (intern (format ":%s" key)))))) - (puthash key value* table)) - (pop yaml--state-stack))) - ((equal top-state :trail-comments) - (pop yaml--state-stack) - (let ((comment-text (pop yaml--object-stack))) - (unless (stringp value*) - (error "Trail-comments can't be nested under non-string")) - (yaml--scalar-event - style - (replace-regexp-in-string (concat (regexp-quote comment-text) "\n*\\'") - "" - value*)))) - ((equal top-state nil)))) - '(:scalar)) - -(defun yaml--alias-event (name) - "Process a node has been defined via alias NAME." - (if yaml--resolve-aliases - (let ((resolved (gethash name yaml--anchor-mappings))) - (unless resolved (error "Undefined alias '%s'" name)) - (yaml--scalar-event nil resolved)) - (yaml--scalar-event nil (vector :alias name))) - '(:alias)) - -(defun yaml--trail-comments-event (text) - "Process trailing comments of TEXT which should be trimmed from parent." - (push :trail-comments yaml--state-stack) - (push text yaml--object-stack) - '(:trail-comments)) - - - -(defun yaml--check-document-end () - "Return non-nil if at end of document." - ;; NOTE: currently no need for this. May be needed in the future. - t) - -(defun yaml--reverse-at-list () - "Reverse the list at the top of the object stack. - -This is needed to get the correct order as lists are processed in -reverse order." - (setcar yaml--object-stack (reverse (car yaml--object-stack)))) - -(defconst yaml--grammar-events-in - '(("l-yaml-stream" . (lambda () - (yaml--stream-start-event) - (setq yaml--document-start-version nil) - (setq yaml--document-start-explicit nil) - (setq yaml--tag-map (make-hash-table)))) - ("c-flow-mapping" . (lambda () - (yaml--mapping-start-event t))) - ("c-flow-sequence" . (lambda () - (yaml--sequence-start-event nil))) - ("l+block-mapping" . (lambda () - (yaml--mapping-start-event nil))) - ("l+block-sequence" . (lambda () - (yaml--sequence-start-event nil))) - ("ns-l-compact-mapping" . (lambda () - (yaml--mapping-start-event nil))) - ("ns-l-compact-sequence" . (lambda () - (yaml--sequence-start-event nil))) - ("ns-flow-pair" . (lambda () - (yaml--mapping-start-event t))) - ("ns-l-block-map-implicit-entry" . (lambda ())) - ("ns-l-compact-mapping" . (lambda ())) - ("c-l-block-seq-entry" . (lambda ()))) - "List of functions for matched rules that run on the entering of a rule.") - -(defconst yaml--grammar-events-out - '(("c-b-block-header" . - (lambda (text) - nil)) - ("l-yaml-stream" . - (lambda (text) - (yaml--check-document-end) - (yaml--stream-end-event))) - ("ns-yaml-version" . - (lambda (text) - (when yaml--document-start-version - (throw 'error "Multiple %YAML directives not allowed.")) - (setq yaml--document-start-version text))) - ("c-tag-handle" . - (lambda (text) - (setq yaml--tag-handle text))) - ("ns-tag-prefix" . - (lambda (text) - (puthash yaml--tag-handle text yaml--tag-map))) - ("c-directives-end" . - (lambda (text) - (yaml--check-document-end) - (setq yaml--document-start-explicit t))) - ("c-document-end" . - (lambda (text) - (when (not yaml--document-end) - (setq yaml--document-end-explicit t)) - (yaml--check-document-end))) - ("c-flow-mapping" . - (lambda (text) - (yaml--mapping-end-event))) - ("c-flow-sequence" . - (lambda (text) - (yaml--sequence-end-event ))) - ("l+block-mapping" . - (lambda (text) - (yaml--mapping-end-event))) - ("l+block-sequence" . - (lambda (text) - (yaml--reverse-at-list) - (yaml--sequence-end-event))) - ("ns-l-compact-mapping" . - (lambda (text) - (yaml--mapping-end-event))) - ("ns-l-compact-sequence" . - (lambda (text) - (yaml--sequence-end-event))) - ("ns-flow-pair" . - (lambda (text) - (yaml--mapping-end-event))) - ("ns-plain" . - (lambda (text) - (let* ((replaced (if (and (zerop (length yaml--state-stack)) - (string-match "\\(^\\|\n\\)\\.\\.\\.\\'" text)) - ;; Hack to not send the document parse end. - ;; Will only occur with bare ns-plain at top level. - (replace-regexp-in-string "\\(^\\|\n\\)\\.\\.\\.\\'" - "" - text) - text)) - (replaced (replace-regexp-in-string - "\\(?:[ \t]*\r?\n[ \t]*\\)" - "\n" - replaced)) - (replaced (replace-regexp-in-string - "\\(\n\\)\\(\n*\\)" - (lambda (x) - (if (> (length x) 1) - (substring x 1) - " ")) - replaced))) - (yaml--scalar-event "plain" replaced)))) - ("c-single-quoted" . - (lambda (text) - (let* ((replaced (replace-regexp-in-string - "\\(?:[ \t]*\r?\n[ \t]*\\)" - "\n" - text)) - (replaced (replace-regexp-in-string - "\\(\n\\)\\(\n*\\)" - (lambda (x) - (if (> (length x) 1) - (substring x 1) - " ")) - replaced)) - (replaced (if (not (equal "''" replaced)) - (replace-regexp-in-string - "''" - (lambda (x) - (if (> (length x) 1) - (substring x 1) - "'")) - replaced) - replaced))) - (yaml--scalar-event "single" - (substring replaced 1 (1- (length replaced))))))) - ("c-double-quoted" . - (lambda (text) - (let* ((replaced (replace-regexp-in-string - "\\(?:[ \t]*\r?\n[ \t]*\\)" - "\n" - text)) - (replaced (replace-regexp-in-string - "\\(\n\\)\\(\n*\\)" - (lambda (x) - (if (> (length x) 1) - (substring x 1) - " ")) - replaced)) - (replaced (replace-regexp-in-string "\\\\\\([\"\\/]\\)" - "\\1" - replaced)) - (replaced (replace-regexp-in-string "\\\\ " " " replaced)) - (replaced (replace-regexp-in-string "\\\\ " " " replaced)) - (replaced (replace-regexp-in-string "\\\\b" "\b" replaced)) - (replaced (replace-regexp-in-string "\\\\t" "\t" replaced)) - (replaced (replace-regexp-in-string "\\\\n" "\n" replaced)) - (replaced (replace-regexp-in-string "\\\\r" "\r" replaced)) - (replaced (replace-regexp-in-string "\\\\r" "\r" replaced)) - (replaced (replace-regexp-in-string - "\\\\x\\([0-9a-fA-F]\\{2\\}\\)" - (lambda (x) - (let ((char-pt (substring 2 x))) - (string (string-to-number char-pt 16)))) - replaced)) - (replaced (replace-regexp-in-string - "\\\\x\\([0-9a-fA-F]\\{2\\}\\)" - (lambda (x) - (let ((char-pt (substring x 2))) - (string (string-to-number char-pt 16)))) - replaced)) - (replaced (replace-regexp-in-string - "\\\\x\\([0-9a-fA-F]\\{4\\}\\)" - (lambda (x) - (let ((char-pt (substring x 2))) - (string (string-to-number char-pt 16)))) - replaced)) - (replaced (replace-regexp-in-string - "\\\\x\\([0-9a-fA-F]\\{8\\}\\)" - (lambda (x) - (let ((char-pt (substring x 2))) - (string (string-to-number char-pt 16)))) - replaced)) - (replaced (replace-regexp-in-string - "\\\\\\\\" - "\\" - replaced)) - (replaced (substring replaced 1 (1- (length replaced))))) - (yaml--scalar-event "double" replaced)))) - ("c-l+literal" . - (lambda (text) - (when (equal (car yaml--state-stack) :trail-comments) - (pop yaml--state-stack) - (let ((comment-text (pop yaml--object-stack))) - (setq text (replace-regexp-in-string - (concat (regexp-quote comment-text) "\n*\\'") "" text)))) - (let* ((processed-text (yaml--process-literal-text text))) - (yaml--scalar-event "folded" processed-text)))) - ("c-l+folded" . - (lambda (text) - (when (equal (car yaml--state-stack) :trail-comments) - (pop yaml--state-stack) - (let ((comment-text (pop yaml--object-stack))) - (setq text (replace-regexp-in-string - (concat (regexp-quote comment-text) "\n*\\'") "" text)))) - (let* ((processed-text (yaml--process-folded-text text))) - (yaml--scalar-event "folded" processed-text)))) - ("e-scalar" . - (lambda (text) - (yaml--scalar-event "plain" "null"))) - ("c-ns-anchor-property" . - (lambda (text) - (yaml--anchor-event (substring text 1)))) - ("c-ns-tag-property" . - (lambda (text) - ;; TODO: Implement tags - )) - ("l-trail-comments" . - (lambda (text) - (yaml--trail-comments-event text))) - ("c-ns-alias-node" . - (lambda (text) - (yaml--alias-event (substring text 1))))) - "List of functions for matched rules that run on the exiting of a rule.") - -(defconst yaml--terminal-rules - '( "l-nb-literal-text" - "l-nb-diff-lines" - "ns-plain" - "c-single-quoted" - "c-double-quoted") - "List of rules that indicate at which the parse tree should stop. - -This addition is a hack to prevent the parse tree from going too deep and thus -risk hitting the stack depth limit. Each of these rules are recursive and -repeat for each character in a text.") - -(defun yaml--walk-events (tree) - "Event walker iterates over the parse TREE and signals events from the rules." - (when (consp tree) - (if (stringp (car tree)) - (let ((grammar-rule (car tree)) - (text (cadr tree)) - (children (cl-caddr tree))) - (let ((in-fn (cdr (assoc grammar-rule yaml--grammar-events-in))) - (out-fn (cdr (assoc grammar-rule yaml--grammar-events-out)))) - (when in-fn - (funcall in-fn)) - (yaml--walk-events children) - (when out-fn - (funcall out-fn text)))) - (yaml--walk-events (car tree)) - (yaml--walk-events (cdr tree))))) - -(defmacro yaml--frame (name rule) - "Add a new state frame of NAME for RULE." - (declare (indent defun)) - (let ((res-symbol (make-symbol "res"))) - `(let ((beg yaml--parsing-position) - (_ (when (and yaml--parse-debug - (not (member ,name yaml--tracing-ignore))) - (message "|%s>%s %40s args=%s '%s'" - (make-string (length yaml--states) ?-) - (make-string (- 70 (length yaml--states)) ?\s) - ,name - args - (replace-regexp-in-string - "\n" - "↓" - (yaml--slice yaml--parsing-position))))) - (_ (yaml--push-state ,name)) - (,res-symbol ,rule)) - (when (and yaml--parse-debug - ,res-symbol - (not (member ,name yaml--tracing-ignore))) - (message "<%s|%s %40s = '%s'" - (make-string (length yaml--states) ?-) - (make-string (- 70 (length yaml--states)) ?\s) - ,name - (replace-regexp-in-string - "\n" - "↓" - (substring yaml--parsing-input beg yaml--parsing-position)))) - (yaml--pop-state) - (if (not ,res-symbol) - nil - (let ((res-type (cdr (assoc ,name yaml--grammar-resolution-rules))) - (,res-symbol (if (member ,name yaml--terminal-rules) - ;; Ignore children if at-rule is - ;; indicated to be terminal. - t - ,res-symbol))) - (cond - ((or (assoc ,name yaml--grammar-events-in) - (assoc ,name yaml--grammar-events-out)) - (let ((str (substring yaml--parsing-input beg yaml--parsing-position))) - (when yaml--parsing-store-position - (setq str (propertize str 'yaml-position - (cons (1+ beg) - (1+ yaml--parsing-position))))) - (when (member ,name '("c-l+folded" "c-l+literal")) - (setq str (propertize str 'yaml-n (max 0 n)))) - (list ,name - (if yaml--parsing-store-position - (propertize str 'yaml-position (cons (1+ beg) - (1+ yaml--parsing-position))) - str) - ,res-symbol))) - ((equal res-type 'list) (list ,name ,res-symbol)) - ((equal res-type 'literal) - (substring yaml--parsing-input beg yaml--parsing-position)) - (t ,res-symbol))))))) - -(defun yaml--end-of-stream () - "Return non-nil if the current position is after the end of the document." - (>= yaml--parsing-position (length yaml--parsing-input))) - -(defun yaml--char-at-pos (pos) - "Return the character at POS." - (aref yaml--parsing-input pos)) - -(defun yaml--slice (pos) - "Return the character at POS." - (substring yaml--parsing-input pos)) - -(defun yaml--at-char () - "Return the current character." - (yaml--char-at-pos yaml--parsing-position)) - -(defun yaml--char-match (at &rest chars) - "Return non-nil if AT match any of CHARS." - (if (not chars) - nil - (or (equal at (car chars)) - (apply #'yaml--char-match (cons at (cdr chars)))))) - -(defun yaml--chr (c) - "Try to match the character C." - (if (or (yaml--end-of-stream) (not (equal (yaml--at-char) c))) - nil - (setq yaml--parsing-position (1+ yaml--parsing-position)) - t)) - -(defun yaml--chr-range (min max) - "Return non-nil if the current character is between MIN and MAX." - (if (or (yaml--end-of-stream) (not (<= min (yaml--at-char) max))) - nil - (setq yaml--parsing-position (1+ yaml--parsing-position)) - t)) - -(defun yaml--run-all (&rest funcs) - "Return list of all evaluated FUNCS if all of FUNCS pass." - (let* ((start-pos yaml--parsing-position) - (ress '()) - (break)) - (while (and (not break) funcs) - (let ((res (funcall (car funcs)))) - (when (not res) - (setq break t)) - (setq ress (append ress (list res))) - (setq funcs (cdr funcs)))) - (when break - (setq yaml--parsing-position start-pos)) - (if break nil ress))) - -(defmacro yaml--all (&rest forms) - "Pass and return all forms if all of FORMS pass." - `(yaml--run-all - ,@(mapcar (lambda (form) - `(lambda () ,form)) - forms))) - -(defmacro yaml--any (&rest forms) - "Pass if any of FORMS pass." - (if (= 1 (length forms)) - (car forms) - (let ((start-pos-sym (make-symbol "start")) - (rules-sym (make-symbol "rules")) - (res-sym (make-symbol "res"))) - `(let ((,start-pos-sym yaml--parsing-position) - (,rules-sym ,(cons 'list - (seq-map (lambda (form) `(lambda () ,form)) - forms))) - (,res-sym)) - (while (and (not ,res-sym) ,rules-sym) - (setq ,res-sym (funcall (car ,rules-sym))) - (unless ,res-sym - (setq yaml--parsing-position ,start-pos-sym)) - (setq ,rules-sym (cdr ,rules-sym))) - ,res-sym)))) - -(defmacro yaml--exclude (_) - "Set the excluded characters according to RULE. - -This is currently unimplemented." - ;; NOTE: This is currently not implemented. - 't) - -(defmacro yaml--max (_) - "Automatically pass." - t) - -(defun yaml--empty () - "Return non-nil indicating that empty rule needs nothing to pass." - 't) - -(defun yaml--sub (a b) - "Return A minus B." - (- a b)) - -(defun yaml--match () - "Return the content of the previous sibling completed." - (let* ((states yaml--states) - (res nil)) - (while (and states (not res)) - (let ((top-state (car states))) - (if (yaml--state-end top-state) - (let ((beg (yaml--state-beg top-state)) - (end (yaml--state-end top-state))) - (setq res (substring yaml--parsing-input beg end))) - (setq states (cdr states))))) - res)) - -(defun yaml--auto-detect (n) - "Detect the indentation given N." - (let* ((slice (yaml--slice yaml--parsing-position)) - (match (string-match - "^.*\n\\(\\(?: *\n\\)*\\)\\( *\\)" - slice))) - (if (not match) - 1 - (let ((pre (match-string 1 slice)) - (m (- (length (match-string 2 slice)) n))) - (if (< m 1) - 1 - (when (string-match (format "^.\\{%d\\}." m) pre) - (error "Spaces found after indent in auto-detect (5LLU)")) - m))))) - -(defun yaml--auto-detect-indent (n) - "Detect the indentation given N." - (let* ((pos yaml--parsing-position) - (in-seq (and - (> pos 0) - (yaml--char-match (yaml--char-at-pos (1- pos)) ?\- ?\? ?\:))) - (slice (yaml--slice pos)) - (_ (string-match - "^\\(\\(?: *\\(?:#.*\\)?\n\\)*\\)\\( *\\)" - slice)) - (pre (match-string 1 slice)) - (m (length (match-string 2 slice)))) - (if (and in-seq (= (length pre) 0)) - (when (= n -1) - (setq m (1+ m))) - (setq m (- m n))) - (when (< m 0) - (setq m 0)) - m)) - -(defun yaml--the-end () - "Return non-nil if at the end of input (?)." - (or (>= yaml--parsing-position (length yaml--parsing-input)) - (and (yaml--state-curr-doc) - (yaml--start-of-line) - (string-match - "\\^g\\(?:---|\\.\\.\\.\\)\\([[:blank:]]\\|$\\)" - (substring yaml--parsing-input yaml--parsing-position))))) - -(defun yaml--ord (f) - "Convert an ASCII number returned by F to a number." - (let ((res (funcall f))) - (- (aref res 0) 48))) - -(defun yaml--but (&rest fs) - "Match the first FS but none of the others." - (if (yaml--the-end) - nil - (let ((pos1 yaml--parsing-position)) - (if (not (funcall (car fs))) - nil - (let ((pos2 yaml--parsing-position)) - (setq yaml--parsing-position pos1) - (if (equal ':error (catch 'break - (dolist (f (cdr fs)) - (if (funcall f) - (progn - (setq yaml--parsing-position pos1) - (throw 'break ':error)))))) - nil - (setq yaml--parsing-position pos2) - t)))))) - -(defmacro yaml--rep (min max func) - "Repeat FUNC between MIN and MAX times." - (declare (indent 2)) - `(yaml--rep2 ,min ,max ,func)) - -(defun yaml--rep2 (min max func) - "Repeat FUNC between MIN and MAX times." - (declare (indent 2)) - (if (and max (< max 0)) - nil - (let* ((res-list '()) - (count 0) - (pos yaml--parsing-position) - (pos-start pos) - (break nil)) - (while (and (not break) (or (not max) (< count max))) - (let ((res (funcall func))) - (if (or (not res) (= yaml--parsing-position pos)) - (setq break t) - (setq res-list (cons res res-list)) - (setq count (1+ count)) - (setq pos yaml--parsing-position)))) - (if (and (>= count min) - (or (not max) (<= count max))) - (progn - (setq yaml--parsing-position pos) - (if (zerop count) - t - res-list)) - (setq yaml--parsing-position pos-start) - nil)))) - -(defun yaml--start-of-line () - "Return non-nil if start of line." - (or (= yaml--parsing-position 0) - (>= yaml--parsing-position (length yaml--parsing-input)) - (equal (yaml--char-at-pos (1- yaml--parsing-position)) ?\n))) - -(defun yaml--top () - "Perform top level YAML parsing rule." - (yaml--parse-from-grammar 'l-yaml-stream)) - -(defmacro yaml--set (variable value) - "Set the current state of VARIABLE to VALUE." - (let ((res-sym (make-symbol "res"))) - `(let ((,res-sym ,value)) - (when ,res-sym - (,(cond ((equal "m" (symbol-name variable)) 'yaml--state-set-m) - ((equal "t" (symbol-name variable)) 'yaml--state-set-t)) - ,res-sym) - ,res-sym)))) - -(defmacro yaml--chk (type expr) - "Check if EXPR is non-nil at the parsing position. - -If TYPE is \"<=\" then check at the previous position. If TYPE -is \"!\" ensure that EXPR is nil. Otherwise, if TYPE is \"=\" -then check EXPR at the current position." - (let ((start-symbol (make-symbol "start")) - (ok-symbol (make-symbol "ok"))) - `(let ((,start-symbol yaml--parsing-position) - (_ (when (equal ,type "<=") - (setq yaml--parsing-position (1- yaml--parsing-position)))) - (,ok-symbol (and (>= yaml--parsing-position 0) ,expr))) - (setq yaml--parsing-position ,start-symbol) - (if (equal ,type "!") - (not ,ok-symbol) - ,ok-symbol)))) - -(cl-defun yaml--initialize-parsing-state - (&key (null-object :null) - (false-object :false) - object-type - object-key-type - sequence-type - string-values) - "Initialize state required for parsing according to plist ARGS." - (setq yaml--cache nil) - (setq yaml--object-stack nil) - (setq yaml--state-stack nil) - (setq yaml--root nil) - (setq yaml--anchor-mappings (make-hash-table :test 'equal)) - (setq yaml--resolve-aliases nil) - (setq yaml--parsing-null-object null-object) - (setq yaml--parsing-false-object false-object) - (cond - ((or (not object-type) - (equal object-type 'hash-table)) - (setq yaml--parsing-object-type 'hash-table)) - ((equal 'alist object-type) - (setq yaml--parsing-object-type 'alist)) - ((equal 'plist object-type) - (setq yaml--parsing-object-type 'plist)) - (t (error "Invalid object-type. Must be hash-table, alist, or plist"))) - (cond - ((or (not object-key-type) - (equal 'symbol object-key-type)) - (if (equal 'plist yaml--parsing-object-type) - (setq yaml--parsing-object-key-type 'keyword) - (setq yaml--parsing-object-key-type 'symbol))) - ((equal 'string object-key-type) - (setq yaml--parsing-object-key-type 'string)) - ((equal 'keyword object-key-type) - (setq yaml--parsing-object-key-type 'keyword)) - (t (error "Invalid object-key-type. Must be string, keyword, or symbol"))) - (cond - ((or (not sequence-type) - (equal sequence-type 'array)) - (setq yaml--parsing-sequence-type 'array)) - ((equal 'list sequence-type) - (setq yaml--parsing-sequence-type 'list)) - (t (error "Invalid sequence-type. sequence-type must be list or array"))) - (if string-values - (setq yaml--string-values t) - (setq yaml--string-values nil))) - -(cl-defun yaml-parse-string (string - &key - (null-object :null) - (false-object :false) - object-type - object-key-type - sequence-type - string-values) - "Parse the YAML value in STRING. - -OBJECT-TYPE specifies the Lisp object to use for representing -key-value YAML mappings. Possible values for OBJECT-TYPE are -the symbols `hash-table' (default), `alist', and `plist'. - -OBJECT-KEY-TYPE specifies the Lisp type to use for keys in -key-value YAML mappings. Possible values are the symbols -`string', `symbol', and `keyword'. By default, this is `symbol'; -if OBJECT-TYPE is `plist', the default is `keyword' (and `symbol' -becomes synonym for `keyword'). - -SEQUENCE-TYPE specifies the Lisp object to use for representing -YAML sequences. Possible values for SEQUENCE-TYPE are the symbols -`list', and `array' (default). - -NULL-OBJECT contains the object used to represent the null value. -It defaults to the symbol `:null'. - -FALSE-OBJECT contains the object used to represent the false -value. It defaults to the symbol `:false'." - (yaml--initialize-parsing-state - :null-object null-object - :false-object false-object - :object-type object-type - :object-key-type object-key-type - :sequence-type sequence-type - :string-values string-values) - (let ((res (yaml--parse string - (yaml--top)))) - (when (< yaml--parsing-position (length yaml--parsing-input)) - (error - "Unable to parse YAML. Parser finished before end of input %s/%s" - yaml--parsing-position - (length yaml--parsing-input))) - (when yaml--parse-debug (message "Parsed data: %s" (pp-to-string res))) - (yaml--walk-events res) - (if (hash-table-empty-p yaml--anchor-mappings) - yaml--root - ;; Run event processing twice to resolve aliases. - (let ((yaml--root nil) - (yaml--resolve-aliases t)) - (yaml--walk-events res) - yaml--root)))) - -(defun yaml-parse-tree (string) - "Parse the YAML value in STRING and return its parse tree." - (yaml--initialize-parsing-state) - (let* ((yaml--parsing-store-position t) - (res (yaml--parse string - (yaml--top)))) - (when (< yaml--parsing-position (length yaml--parsing-input)) - (error - "Unable to parse YAML. Parser finished before end of input %s/%s" - yaml--parsing-position - (length yaml--parsing-input))) - res)) - -(defun yaml-parse-string-with-pos (string) - "Parse the YAML value in STRING, storing positions as text properties. - -NOTE: This is an experimental feature and may experience API -changes in the future." - (let ((yaml--parsing-store-position t)) - (yaml-parse-string string - :object-type 'alist - :object-key-type 'string - :string-values t))) - -(defun yaml--parse-from-grammar (state &rest args) - "Parse YAML grammar for given STATE and ARGS. - -Rules for this function are defined by the yaml-spec JSON file." - (pcase state - ('c-flow-sequence - (let ((n (nth 0 args)) - (c (nth 1 args))) - (yaml--frame "c-flow-sequence" - (yaml--all - (yaml--chr ?\[) - (yaml--rep 0 1 - (lambda () (yaml--parse-from-grammar 's-separate n c))) - (yaml--rep 0 1 - (lambda () - (yaml--parse-from-grammar - 'ns-s-flow-seq-entries n - (yaml--parse-from-grammar 'in-flow c)))) - (yaml--chr ?\]))))) - - ('c-indentation-indicator - (let ((m (nth 0 args))) - (yaml--frame "c-indentation-indicator" - (yaml--any (when (yaml--parse-from-grammar 'ns-dec-digit) - (yaml--set m (yaml--ord (lambda () (yaml--match)))) t) - (when (yaml--empty) - (let ((new-m (yaml--auto-detect m))) - (yaml--set m new-m)) - t))))) - - ('ns-reserved-directive - (yaml--frame "ns-reserved-directive" - (yaml--all (yaml--parse-from-grammar 'ns-directive-name) - (yaml--rep2 0 nil - (lambda () - (yaml--all - (yaml--parse-from-grammar 's-separate-in-line) - (yaml--parse-from-grammar 'ns-directive-parameter))))))) - - ('ns-flow-map-implicit-entry - (let ((n (nth 0 args)) - (c (nth 1 args))) - (yaml--frame "ns-flow-map-implicit-entry" - ;; NOTE: I ran into a bug with the order of these rules. It seems - ;; sometimes ns-flow-map-yaml-key-entry succeeds with an empty - ;; when the correct answer should be - ;; c-ns-flow-map-json-key-entry. Changing the order seemed to - ;; have fix this but this seems like a bandage fix. - (yaml--any - (yaml--parse-from-grammar 'c-ns-flow-map-json-key-entry n c) - (yaml--parse-from-grammar 'ns-flow-map-yaml-key-entry n c) - (yaml--parse-from-grammar 'c-ns-flow-map-empty-key-entry n c))))) - - ('ns-esc-double-quote - (yaml--frame "ns-esc-double-quote" - (yaml--chr ?\"))) - - ('c-mapping-start - (yaml--frame "c-mapping-start" (yaml--chr ?\{))) - - ('ns-flow-seq-entry - (let ((n (nth 0 args)) - (c (nth 1 args))) - (yaml--frame "ns-flow-seq-entry" - (yaml--any (yaml--parse-from-grammar 'ns-flow-pair n c) - (yaml--parse-from-grammar 'ns-flow-node n c))))) - - ('l-empty - (let ((n (nth 0 args)) - (c (nth 1 args))) - (yaml--frame "l-empty" - (yaml--all (yaml--any (yaml--parse-from-grammar 's-line-prefix n c) - (yaml--parse-from-grammar 's-indent-lt n)) - (yaml--parse-from-grammar 'b-as-line-feed))))) - - ('c-primary-tag-handle - (yaml--frame "c-primary-tag-handle" (yaml--chr ?\!))) - - ('ns-plain-safe-out - (yaml--frame "ns-plain-safe-out" - (yaml--parse-from-grammar 'ns-char))) - - ('c-ns-shorthand-tag - (yaml--frame "c-ns-shorthand-tag" - (yaml--all - (yaml--parse-from-grammar 'c-tag-handle) - (yaml--rep 1 nil (lambda () (yaml--parse-from-grammar 'ns-tag-char)))))) - - ('nb-ns-single-in-line - (yaml--frame "nb-ns-single-in-line" - (yaml--rep2 0 nil - (lambda () - (yaml--all (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 's-white))) - (yaml--parse-from-grammar 'ns-single-char)))))) - - ('l-strip-empty - (let ((n (nth 0 args))) - (yaml--frame "l-strip-empty" - (yaml--all - (yaml--rep2 0 nil - (lambda () (yaml--all - (yaml--parse-from-grammar 's-indent-le n) - (yaml--parse-from-grammar 'b-non-content)))) - (yaml--rep 0 1 - (lambda () (yaml--parse-from-grammar 'l-trail-comments n))))))) - - ('c-indicator - (yaml--frame "c-indicator" - (yaml--any (yaml--chr ?\-) - (yaml--chr ?\?) - (yaml--chr ?\:) - (yaml--chr ?\,) - (yaml--chr ?\[) - (yaml--chr ?\]) - (yaml--chr ?\{) - (yaml--chr ?\}) - (yaml--chr ?\#) - (yaml--chr ?\&) - (yaml--chr ?\*) - (yaml--chr ?\!) - (yaml--chr ?\|) - (yaml--chr ?\>) - (yaml--chr ?\') - (yaml--chr ?\") - (yaml--chr ?\%) - (yaml--chr ?\@) - (yaml--chr ?\`)))) - - ('c-l+literal - (let ((n (nth 0 args))) - (yaml--frame "c-l+literal" - (progn - (yaml--all - (yaml--chr ?\|) - (yaml--parse-from-grammar 'c-b-block-header n (yaml--state-curr-t)) - (yaml--parse-from-grammar 'l-literal-content - (max (+ n (yaml--state-curr-m)) 1) - (yaml--state-curr-t))))))) - - ('c-single-quoted - (let ((n (nth 0 args)) - (c (nth 1 args))) - (yaml--frame "c-single-quoted" - (yaml--all (yaml--chr ?\') - (yaml--parse-from-grammar 'nb-single-text n c) - (yaml--chr ?\'))))) - - ('c-forbidden - (yaml--frame "c-forbidden" - (yaml--all (yaml--start-of-line) - (yaml--any - (yaml--parse-from-grammar 'c-directives-end) - (yaml--parse-from-grammar 'c-document-end)) - (yaml--any - (yaml--parse-from-grammar 'b-char) - (yaml--parse-from-grammar 's-white) - (yaml--end-of-stream))))) - - ('c-ns-alias-node - (yaml--frame "c-ns-alias-node" - (yaml--all (yaml--chr ?\*) - (yaml--parse-from-grammar 'ns-anchor-name)))) - - ('c-secondary-tag-handle - (yaml--frame "c-secondary-tag-handle" - (yaml--all (yaml--chr ?\!) (yaml--chr ?\!)))) - - ('ns-esc-next-line - (yaml--frame "ns-esc-next-line" (yaml--chr ?N))) - - ('l-nb-same-lines - (let ((n (nth 0 args))) - (yaml--frame "l-nb-same-lines" - (yaml--all - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 'l-empty n "block-in"))) - (yaml--any (yaml--parse-from-grammar 'l-nb-folded-lines n) - (yaml--parse-from-grammar 'l-nb-spaced-lines n)))))) - - ('c-alias - (yaml--frame "c-alias" (yaml--chr ?\*))) - - ('ns-single-char - (yaml--frame "ns-single-char" - (yaml--but (lambda () (yaml--parse-from-grammar 'nb-single-char)) - (lambda () (yaml--parse-from-grammar 's-white))))) - - ('c-l-block-map-implicit-value - (let ((n (nth 0 args))) - (yaml--frame "c-l-block-map-implicit-value" - (yaml--all (yaml--chr ?\:) - (yaml--any - (yaml--parse-from-grammar 's-l+block-node n "block-out") - (yaml--all (yaml--parse-from-grammar 'e-node) - (yaml--parse-from-grammar 's-l-comments))))))) - - ('ns-uri-char - (yaml--frame "ns-uri-char" - (yaml--any (yaml--all (yaml--chr ?\%) - (yaml--parse-from-grammar 'ns-hex-digit) - (yaml--parse-from-grammar 'ns-hex-digit)) - (yaml--parse-from-grammar 'ns-word-char) - (yaml--chr ?\#) - (yaml--chr ?\;) - (yaml--chr ?\/) - (yaml--chr ?\?) - (yaml--chr ?\:) - (yaml--chr ?\@) - (yaml--chr ?\&) - (yaml--chr ?\=) - (yaml--chr ?\+) - (yaml--chr ?\$) - (yaml--chr ?\,) - (yaml--chr ?\_) - (yaml--chr ?\.) - (yaml--chr ?\!) - (yaml--chr ?\~) - (yaml--chr ?\*) - (yaml--chr ?\') - (yaml--chr ?\() - (yaml--chr ?\)) - (yaml--chr ?\[) - (yaml--chr ?\])))) - - ('ns-esc-16-bit - (yaml--frame "ns-esc-16-bit" - (yaml--all (yaml--chr ?u) - (yaml--rep 4 4 - (lambda () (yaml--parse-from-grammar 'ns-hex-digit)))))) - - ('l-nb-spaced-lines - (let ((n (nth 0 args))) - (yaml--frame "l-nb-spaced-lines" - (yaml--all - (yaml--parse-from-grammar 's-nb-spaced-text n) - (yaml--rep2 0 nil - (lambda () (yaml--all - (yaml--parse-from-grammar 'b-l-spaced n) - (yaml--parse-from-grammar 's-nb-spaced-text n)))))))) - - ('ns-plain - (let ((n (nth 0 args)) - (c (nth 1 args))) - (yaml--frame "ns-plain" - (pcase c - ("block-key" (yaml--parse-from-grammar 'ns-plain-one-line c)) - ("flow-in" (yaml--parse-from-grammar 'ns-plain-multi-line n c)) - ("flow-key" (yaml--parse-from-grammar 'ns-plain-one-line c)) - ("flow-out" (yaml--parse-from-grammar 'ns-plain-multi-line n c)))))) - - ('c-printable - (yaml--frame "c-printable" - (yaml--any (yaml--chr ?\x09) - (yaml--chr ?\x0A) - (yaml--chr ?\x0D) - (yaml--chr-range ?\x20 ?\x7E) - (yaml--chr ?\x85) - (yaml--chr-range ?\xA0 ?\xD7FF) - (yaml--chr-range ?\xE000 ?\xFFFD) - (yaml--chr-range ?\x010000 ?\x10FFFF)))) - - ('c-mapping-value - (yaml--frame "c-mapping-value" (yaml--chr ?\:))) - - ('l-nb-literal-text - (let ((n (nth 0 args))) - (yaml--frame "l-nb-literal-text" - (yaml--all - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 'l-empty n "block-in"))) - (yaml--parse-from-grammar 's-indent n) - (yaml--rep 1 nil - (lambda () (yaml--parse-from-grammar 'nb-char))))))) - - ('ns-plain-char - (let ((c (nth 0 args))) - (yaml--frame "ns-plain-char" - (yaml--any - (yaml--but - (lambda () (yaml--parse-from-grammar 'ns-plain-safe c)) - (lambda () (yaml--chr ?\:)) (lambda () (yaml--chr ?\#))) - (yaml--all - (yaml--chk "<=" (yaml--parse-from-grammar 'ns-char)) - (yaml--chr ?\#)) - (yaml--all - (yaml--chr ?\:) - (yaml--chk "=" (yaml--parse-from-grammar 'ns-plain-safe c))))))) - - ('ns-anchor-char - (yaml--frame "ns-anchor-char" - (yaml--but (lambda () (yaml--parse-from-grammar 'ns-char)) - (lambda () (yaml--parse-from-grammar 'c-flow-indicator))))) - - ('s-l+block-scalar - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "s-l+block-scalar" - (yaml--all (yaml--parse-from-grammar 's-separate (+ n 1) c) - (yaml--rep 0 1 - (lambda () - (yaml--all - (yaml--parse-from-grammar 'c-ns-properties (+ n 1) c) - (yaml--parse-from-grammar 's-separate (+ n 1) c)))) - (yaml--any (yaml--parse-from-grammar 'c-l+literal n) - (yaml--parse-from-grammar 'c-l+folded n)))))) - - ('ns-plain-safe-in - (yaml--frame "ns-plain-safe-in" - (yaml--but (lambda () (yaml--parse-from-grammar 'ns-char)) - (lambda () (yaml--parse-from-grammar 'c-flow-indicator))))) - - ('nb-single-text - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "nb-single-text" - (pcase c - ("block-key" (yaml--parse-from-grammar 'nb-single-one-line)) - ("flow-in" (yaml--parse-from-grammar 'nb-single-multi-line n)) - ("flow-key" (yaml--parse-from-grammar 'nb-single-one-line)) - ("flow-out" (yaml--parse-from-grammar 'nb-single-multi-line n)))))) - - ('s-indent-le - (let ((n (nth 0 args))) - (yaml--frame "s-indent-le" - (yaml--all (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 's-space))) - (<= (length (yaml--match)) n))))) - - ('ns-esc-carriage-return - (yaml--frame "ns-esc-carriage-return" (yaml--chr ?r))) - - ('l-chomped-empty - (let ((n (nth 0 args)) - (tt (nth 1 args))) - (yaml--frame "l-chomped-empty" - (pcase tt - ("clip" (yaml--parse-from-grammar 'l-strip-empty n)) - ("keep" (yaml--parse-from-grammar 'l-keep-empty n)) - ("strip" (yaml--parse-from-grammar 'l-strip-empty n)))))) - - ('c-s-implicit-json-key - (let ((c (nth 0 args))) - (yaml--frame "c-s-implicit-json-key" - (yaml--all - (yaml--max 1024) - (yaml--parse-from-grammar 'c-flow-json-node nil c) - (yaml--rep 0 1 - (lambda () (yaml--parse-from-grammar 's-separate-in-line))))))) - - ('b-as-space - (yaml--frame "b-as-space" - (yaml--parse-from-grammar 'b-break))) - - ('ns-s-flow-seq-entries - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "ns-s-flow-seq-entries" - (yaml--all - (yaml--parse-from-grammar 'ns-flow-seq-entry n c) - (yaml--rep 0 1 - (lambda () (yaml--parse-from-grammar 's-separate n c))) - (yaml--rep 0 1 - (lambda () - (yaml--all - (yaml--chr ?\,) - (yaml--rep 0 1 - (lambda () (yaml--parse-from-grammar 's-separate n c))) - (yaml--rep 0 1 - (lambda () - (yaml--parse-from-grammar 'ns-s-flow-seq-entries - n - c)))))))))) - - ('l-block-map-explicit-value - (let ((n (nth 0 args))) - (yaml--frame "l-block-map-explicit-value" - (yaml--all - (yaml--parse-from-grammar 's-indent n) - (yaml--chr ?\:) - (yaml--parse-from-grammar 's-l+block-indented n "block-out"))))) - - ('c-ns-flow-map-json-key-entry - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "c-ns-flow-map-json-key-entry" - (yaml--all - (yaml--parse-from-grammar 'c-flow-json-node n c) - (yaml--any - (yaml--all - (yaml--rep 0 1 - (lambda () (yaml--parse-from-grammar 's-separate n c))) - (yaml--parse-from-grammar 'c-ns-flow-map-adjacent-value n c)) - (yaml--parse-from-grammar 'e-node)))))) - - ('c-sequence-entry - (yaml--frame "c-sequence-entry" (yaml--chr ?\-))) - - ('l-bare-document - (yaml--frame "l-bare-document" - (yaml--all (yaml--exclude "c-forbidden") - (yaml--parse-from-grammar 's-l+block-node -1 "block-in")))) - - ;; TODO: don't use the symbol t as a variable. - ('b-chomped-last - (let ((tt (nth 0 args))) - (yaml--frame "b-chomped-last" - (pcase tt - ("clip" - ;; TODO: Fix this - (yaml--any (yaml--parse-from-grammar 'b-as-line-feed) - (yaml--end-of-stream))) - ("keep" - (yaml--any (yaml--parse-from-grammar 'b-as-line-feed) - (yaml--end-of-stream))) - ("strip" - (yaml--any (yaml--parse-from-grammar 'b-non-content) - (yaml--end-of-stream))))))) - - ('l-trail-comments - (let ((n (nth 0 args))) - (yaml--frame "l-trail-comments" - (yaml--all (yaml--parse-from-grammar 's-indent-lt n) - (yaml--parse-from-grammar 'c-nb-comment-text) - (yaml--parse-from-grammar 'b-comment) - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 'l-comment))))))) - - ('ns-flow-map-yaml-key-entry - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "ns-flow-map-yaml-key-entry" - (yaml--all - (yaml--parse-from-grammar 'ns-flow-yaml-node n c) - (yaml--any - (yaml--all - (yaml--rep 0 1 - (lambda () (yaml--parse-from-grammar 's-separate n c))) - (yaml--parse-from-grammar 'c-ns-flow-map-separate-value n c)) - (yaml--parse-from-grammar 'e-node)))))) - - ('s-indent - (let ((n (nth 0 args))) - (yaml--frame "s-indent" - (yaml--rep n n (lambda () (yaml--parse-from-grammar 's-space)))))) - - ('ns-esc-line-separator - (yaml--frame "ns-esc-line-separator" (yaml--chr ?L))) - - ('ns-flow-yaml-node - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "ns-flow-yaml-node" - (yaml--any - (yaml--parse-from-grammar 'c-ns-alias-node) - (yaml--parse-from-grammar 'ns-flow-yaml-content n c) - (yaml--all - (yaml--parse-from-grammar 'c-ns-properties n c) - (yaml--any - (yaml--all - (yaml--parse-from-grammar 's-separate n c) - (yaml--parse-from-grammar 'ns-flow-yaml-content n c)) - (yaml--parse-from-grammar 'e-scalar))))))) - - ('ns-yaml-version - (yaml--frame "ns-yaml-version" - (yaml--all (yaml--rep 1 nil - (lambda () (yaml--parse-from-grammar 'ns-dec-digit))) - (yaml--chr ?\.) - (yaml--rep 1 nil - (lambda () (yaml--parse-from-grammar 'ns-dec-digit)))))) - - ('c-folded - (yaml--frame "c-folded" (yaml--chr ?\>))) - - ('c-directives-end - (yaml--frame "c-directives-end" - (yaml--all (yaml--chr ?\-) (yaml--chr ?\-) (yaml--chr ?\-)))) - - ('s-double-break - (let ((n (nth 0 args))) - (yaml--frame "s-double-break" - (yaml--any (yaml--parse-from-grammar 's-double-escaped n) - (yaml--parse-from-grammar 's-flow-folded n))))) - - ('s-nb-spaced-text - (let ((n (nth 0 args))) - (yaml--frame "s-nb-spaced-text" - (yaml--all (yaml--parse-from-grammar 's-indent n) - (yaml--parse-from-grammar 's-white) - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 'nb-char))))))) - - ('l-folded-content - (let ((n (nth 0 args)) - (tt (nth 1 args))) - (yaml--frame "l-folded-content" - (yaml--all - (yaml--rep 0 1 - (lambda () - (yaml--all (yaml--parse-from-grammar 'l-nb-diff-lines n) - (yaml--parse-from-grammar 'b-chomped-last tt)))) - (yaml--parse-from-grammar 'l-chomped-empty n tt))))) - - ('nb-ns-plain-in-line - (let ((c (nth 0 args))) - (yaml--frame "nb-ns-plain-in-line" - (yaml--rep2 0 nil - (lambda () (yaml--all - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 's-white))) - (yaml--parse-from-grammar 'ns-plain-char c))))))) - - ('nb-single-multi-line - (let ((n (nth 0 args))) - (yaml--frame "nb-single-multi-line" - (yaml--all - (yaml--parse-from-grammar 'nb-ns-single-in-line) - (yaml--any - (yaml--parse-from-grammar 's-single-next-line n) - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 's-white)))))))) - - ('l-document-suffix - (yaml--frame "l-document-suffix" - (yaml--all (yaml--parse-from-grammar 'c-document-end) - (yaml--parse-from-grammar 's-l-comments)))) - - ('c-sequence-start - (yaml--frame "c-sequence-start" - (yaml--chr ?\[))) - - ('ns-l-block-map-entry - (yaml--frame "ns-l-block-map-entry" - (yaml--any - (yaml--parse-from-grammar 'c-l-block-map-explicit-entry - (nth 0 args)) - (yaml--parse-from-grammar 'ns-l-block-map-implicit-entry - (nth 0 args))))) - - ('ns-l-compact-mapping - (yaml--frame "ns-l-compact-mapping" - (yaml--all - (yaml--parse-from-grammar 'ns-l-block-map-entry (nth 0 args)) - (yaml--rep2 0 nil - (lambda () - (yaml--all - (yaml--parse-from-grammar 's-indent (nth 0 args)) - (yaml--parse-from-grammar 'ns-l-block-map-entry (nth 0 args)))))))) - - ('ns-esc-space - (yaml--frame "ns-esc-space" (yaml--chr ?\x20))) - ('ns-esc-vertical-tab - (yaml--frame "ns-esc-vertical-tab" (yaml--chr ?v))) - - ('ns-s-implicit-yaml-key - (let ((c (nth 0 args))) - (yaml--frame "ns-s-implicit-yaml-key" - (yaml--all - (yaml--max 1024) - (yaml--parse-from-grammar 'ns-flow-yaml-node nil c) - (yaml--rep 0 1 - (lambda () (yaml--parse-from-grammar 's-separate-in-line))))))) - - ('b-l-folded - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "b-l-folded" - (yaml--any (yaml--parse-from-grammar 'b-l-trimmed n c) - (yaml--parse-from-grammar 'b-as-space))))) - - ('s-l+block-collection - (yaml--frame "s-l+block-collection" - (yaml--all - (yaml--rep 0 1 - (lambda () - (yaml--all - (yaml--parse-from-grammar - 's-separate - (+ (nth 0 args) 1) - (nth 1 args)) - (yaml--parse-from-grammar - 'c-ns-properties - (+ (nth 0 args) 1) - (nth 1 args))))) - (yaml--parse-from-grammar 's-l-comments) - (yaml--any - (yaml--parse-from-grammar - 'l+block-sequence - (yaml--parse-from-grammar 'seq-spaces (nth 0 args) (nth 1 args))) - (yaml--parse-from-grammar 'l+block-mapping (nth 0 args)))))) - - ('c-quoted-quote - (yaml--frame "c-quoted-quote" (yaml--all (yaml--chr ?\') (yaml--chr ?\')))) - - ('l+block-sequence - (yaml--frame "l+block-sequence" - ;; NOTE: deviated from the spec example here by making new-m at least 1. - ;; The wording and examples lead me to believe this is how it's done. - ;; ie /* For some fixed auto-detected m > 0 */ - (let ((new-m (max (yaml--auto-detect-indent (nth 0 args)) 1))) - (yaml--all - (yaml--set m new-m) - (yaml--rep 1 nil - (lambda () - (yaml--all - (yaml--parse-from-grammar - 's-indent - (+ (nth 0 args) new-m)) - (yaml--parse-from-grammar - 'c-l-block-seq-entry - (+ (nth 0 args) new-m))))))))) - - ('c-double-quote - (yaml--frame "c-double-quote" - (yaml--chr ?\"))) - - ('ns-esc-backspace - (yaml--frame "ns-esc-backspace" - (yaml--chr ?b))) - - ('c-flow-json-content - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "c-flow-json-content" - (yaml--any (yaml--parse-from-grammar 'c-flow-sequence n c) - (yaml--parse-from-grammar 'c-flow-mapping n c) - (yaml--parse-from-grammar 'c-single-quoted n c) - (yaml--parse-from-grammar 'c-double-quoted n c))))) - - ('c-mapping-end - (yaml--frame "c-mapping-end" (yaml--chr ?\}))) - - ('nb-single-char - (yaml--frame "nb-single-char" - (yaml--any (yaml--parse-from-grammar 'c-quoted-quote) - (yaml--but (lambda () (yaml--parse-from-grammar 'nb-json)) - (lambda () (yaml--chr ?\')))))) - - ('ns-flow-node - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "ns-flow-node" - (yaml--any - (yaml--parse-from-grammar 'c-ns-alias-node) - (yaml--parse-from-grammar 'ns-flow-content n c) - (yaml--all - (yaml--parse-from-grammar 'c-ns-properties n c) - (yaml--any - (yaml--all (yaml--parse-from-grammar 's-separate n c) - (yaml--parse-from-grammar 'ns-flow-content n c)) - (yaml--parse-from-grammar 'e-scalar))))))) - - ('c-non-specific-tag - (yaml--frame "c-non-specific-tag" (yaml--chr ?\!))) - - ('l-directive-document - (yaml--frame "l-directive-document" - (yaml--all (yaml--rep 1 nil - (lambda () (yaml--parse-from-grammar 'l-directive))) - (yaml--parse-from-grammar 'l-explicit-document)))) - - ('c-l-block-map-explicit-entry - (let ((n (nth 0 args))) - (yaml--frame "c-l-block-map-explicit-entry" - (yaml--all - (yaml--parse-from-grammar 'c-l-block-map-explicit-key n) - (yaml--any (yaml--parse-from-grammar 'l-block-map-explicit-value n) - (yaml--parse-from-grammar 'e-node)))))) - - ('e-node - (yaml--frame "e-node" - (yaml--parse-from-grammar 'e-scalar))) - - ('seq-spaces - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "seq-spaces" - (pcase c - ("block-in" n) - ("block-out" (yaml--sub n 1)))))) - - ('l-yaml-stream - (yaml--frame "l-yaml-stream" - (yaml--all - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 'l-document-prefix))) - (yaml--rep 0 1 - (lambda () (yaml--parse-from-grammar 'l-any-document))) - (yaml--rep2 0 nil - (lambda () - (yaml--any - (yaml--all - (yaml--rep 1 nil - (lambda () (yaml--parse-from-grammar 'l-document-suffix))) - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 'l-document-prefix))) - (yaml--rep 0 1 - (lambda () (yaml--parse-from-grammar 'l-any-document)))) - (yaml--all - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 'l-document-prefix))) - (yaml--rep 0 1 - (lambda () - (yaml--parse-from-grammar 'l-explicit-document)))))))))) - - ('nb-double-one-line - (yaml--frame "nb-double-one-line" - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 'nb-double-char))))) - - ('s-l-comments - (yaml--frame "s-l-comments" - (yaml--all (yaml--any - (yaml--parse-from-grammar 's-b-comment) - (yaml--start-of-line)) - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 'l-comment)))))) - - ('nb-char - (yaml--frame "nb-char" - (yaml--but (lambda () (yaml--parse-from-grammar 'c-printable)) - (lambda () (yaml--parse-from-grammar 'b-char)) - (lambda () (yaml--parse-from-grammar 'c-byte-order-mark))))) - - ('ns-plain-first - (let ((c (nth 0 args))) - (yaml--frame "ns-plain-first" - (yaml--any - (yaml--but (lambda () (yaml--parse-from-grammar 'ns-char)) - (lambda () (yaml--parse-from-grammar 'c-indicator))) - (yaml--all - (yaml--any (yaml--chr ?\?) - (yaml--chr ?\:) - (yaml--chr ?\-)) - (yaml--chk "=" (yaml--parse-from-grammar 'ns-plain-safe c))))))) - - ('c-ns-esc-char - (yaml--frame "c-ns-esc-char" - (yaml--all - (yaml--chr ?\\) - (yaml--any (yaml--parse-from-grammar 'ns-esc-null) - (yaml--parse-from-grammar 'ns-esc-bell) - (yaml--parse-from-grammar 'ns-esc-backspace) - (yaml--parse-from-grammar 'ns-esc-horizontal-tab) - (yaml--parse-from-grammar 'ns-esc-line-feed) - (yaml--parse-from-grammar 'ns-esc-vertical-tab) - (yaml--parse-from-grammar 'ns-esc-form-feed) - (yaml--parse-from-grammar 'ns-esc-carriage-return) - (yaml--parse-from-grammar 'ns-esc-escape) - (yaml--parse-from-grammar 'ns-esc-space) - (yaml--parse-from-grammar 'ns-esc-double-quote) - (yaml--parse-from-grammar 'ns-esc-slash) - (yaml--parse-from-grammar 'ns-esc-backslash) - (yaml--parse-from-grammar 'ns-esc-next-line) - (yaml--parse-from-grammar 'ns-esc-non-breaking-space) - (yaml--parse-from-grammar 'ns-esc-line-separator) - (yaml--parse-from-grammar 'ns-esc-paragraph-separator) - (yaml--parse-from-grammar 'ns-esc-8-bit) - (yaml--parse-from-grammar 'ns-esc-16-bit) - (yaml--parse-from-grammar 'ns-esc-32-bit))))) - - ('ns-flow-map-entry - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "ns-flow-map-entry" - (yaml--any - (yaml--all (yaml--chr ?\?) - (yaml--parse-from-grammar 's-separate n c) - (yaml--parse-from-grammar 'ns-flow-map-explicit-entry n c)) - (yaml--parse-from-grammar 'ns-flow-map-implicit-entry n c))))) - - ('l-explicit-document - (yaml--frame "l-explicit-document" - (yaml--all - (yaml--parse-from-grammar 'c-directives-end) - (yaml--any (yaml--parse-from-grammar 'l-bare-document) - (yaml--all (yaml--parse-from-grammar 'e-node) - (yaml--parse-from-grammar 's-l-comments)))))) - - ('s-white - (yaml--frame "s-white" - (yaml--any (yaml--parse-from-grammar 's-space) - (yaml--parse-from-grammar 's-tab)))) - - ('l-keep-empty - (let ((n (nth 0 args))) - (yaml--frame "l-keep-empty" - (yaml--all - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 'l-empty n "block-in"))) - (yaml--rep 0 1 - (lambda () (yaml--parse-from-grammar 'l-trail-comments n))))))) - - ('ns-tag-prefix - (yaml--frame "ns-tag-prefix" - (yaml--any (yaml--parse-from-grammar 'c-ns-local-tag-prefix) - (yaml--parse-from-grammar 'ns-global-tag-prefix)))) - - ('c-l+folded - (let ((n (nth 0 args))) - (yaml--frame "c-l+folded" - (yaml--all - (yaml--chr ?\>) - (yaml--parse-from-grammar 'c-b-block-header - n - (yaml--state-curr-t)) - (yaml--parse-from-grammar 'l-folded-content - (max (+ n (yaml--state-curr-m)) 1) - (yaml--state-curr-t)))))) - - ('ns-directive-name - (yaml--frame "ns-directive-name" - (yaml--rep 1 nil (lambda () (yaml--parse-from-grammar 'ns-char))))) - - ('b-char - (yaml--frame "b-char" - (yaml--any (yaml--parse-from-grammar 'b-line-feed) - (yaml--parse-from-grammar 'b-carriage-return)))) - - ('ns-plain-multi-line - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "ns-plain-multi-line" - (yaml--all - (yaml--parse-from-grammar 'ns-plain-one-line c) - (yaml--rep2 0 nil - (lambda () - (yaml--parse-from-grammar 's-ns-plain-next-line n c))))))) - - ('ns-char - (yaml--frame "ns-char" - (yaml--but (lambda () (yaml--parse-from-grammar 'nb-char)) - (lambda () (yaml--parse-from-grammar 's-white))))) - - ('s-space - (yaml--frame "s-space" (yaml--chr ?\x20))) - - ('c-l-block-seq-entry - (yaml--frame "c-l-block-seq-entry" - (yaml--all (yaml--chr ?\-) - (yaml--chk "!" (yaml--parse-from-grammar 'ns-char)) - (yaml--parse-from-grammar 's-l+block-indented - (nth 0 args) - "block-in")))) - - ('c-ns-properties - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "c-ns-properties" - (yaml--any - (yaml--all - (yaml--parse-from-grammar 'c-ns-tag-property) - (yaml--rep 0 1 - (lambda () - (yaml--all - (yaml--parse-from-grammar 's-separate n c) - (yaml--parse-from-grammar 'c-ns-anchor-property))))) - (yaml--all - (yaml--parse-from-grammar 'c-ns-anchor-property) - (yaml--rep 0 1 - (lambda () (yaml--all - (yaml--parse-from-grammar 's-separate n c) - (yaml--parse-from-grammar 'c-ns-tag-property))))))))) - - ('ns-directive-parameter - (yaml--frame "ns-directive-parameter" - (yaml--rep 1 nil (lambda () (yaml--parse-from-grammar 'ns-char))))) - - ('c-chomping-indicator - (yaml--frame "c-chomping-indicator" - (yaml--any (when (yaml--chr ?\-) (yaml--set t "strip") t) - (when (yaml--chr ?\+) (yaml--set t "keep") t) - (when (yaml--empty) (yaml--set t "clip") t)))) - - ('ns-global-tag-prefix - (yaml--frame "ns-global-tag-prefix" - (yaml--all - (yaml--parse-from-grammar 'ns-tag-char) - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 'ns-uri-char)))))) - - ('c-ns-flow-pair-json-key-entry - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "c-ns-flow-pair-json-key-entry" - (yaml--all - (yaml--parse-from-grammar 'c-s-implicit-json-key "flow-key") - (yaml--parse-from-grammar 'c-ns-flow-map-adjacent-value n c))))) - - ('l-literal-content - (let ((n (nth 0 args)) - (tt (nth 1 args))) - (yaml--frame "l-literal-content" - (yaml--all - (yaml--rep 0 1 - (lambda () - (yaml--all (yaml--parse-from-grammar 'l-nb-literal-text n) - (yaml--rep2 0 nil - (lambda () - (yaml--parse-from-grammar 'b-nb-literal-next n))) - (yaml--parse-from-grammar 'b-chomped-last tt)))) - (yaml--parse-from-grammar 'l-chomped-empty n tt))))) - - ('c-document-end - (yaml--frame "c-document-end" - (yaml--all (yaml--chr ?\.) - (yaml--chr ?\.) - (yaml--chr ?\.)))) - - ('nb-double-text - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "nb-double-text" - (pcase c - ("block-key" (yaml--parse-from-grammar 'nb-double-one-line)) - ("flow-in" (yaml--parse-from-grammar 'nb-double-multi-line n)) - ("flow-key" (yaml--parse-from-grammar 'nb-double-one-line)) - ("flow-out" (yaml--parse-from-grammar 'nb-double-multi-line n)))))) - - ('s-b-comment - (yaml--frame "s-b-comment" - (yaml--all - (yaml--rep 0 1 - (lambda () - (yaml--all - (yaml--parse-from-grammar 's-separate-in-line) - (yaml--rep 0 1 - (lambda () (yaml--parse-from-grammar 'c-nb-comment-text)))))) - (yaml--parse-from-grammar 'b-comment)))) - - ('s-block-line-prefix - (let ((n (nth 0 args))) - (yaml--frame "s-block-line-prefix" - (yaml--parse-from-grammar 's-indent n)))) - - ('c-tag-handle - (yaml--frame "c-tag-handle" - (yaml--any (yaml--parse-from-grammar 'c-named-tag-handle) - (yaml--parse-from-grammar 'c-secondary-tag-handle) - (yaml--parse-from-grammar 'c-primary-tag-handle)))) - - ('ns-plain-one-line - (let ((c (nth 0 args))) - (yaml--frame "ns-plain-one-line" - (yaml--all (yaml--parse-from-grammar 'ns-plain-first c) - (yaml--parse-from-grammar 'nb-ns-plain-in-line c))))) - - ('nb-json - (yaml--frame "nb-json" - (yaml--any (yaml--chr ?\x09) - (yaml--chr-range ?\x20 ?\x10FFFF)))) - - ('s-ns-plain-next-line - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "s-ns-plain-next-line" - (yaml--all (yaml--parse-from-grammar 's-flow-folded n) - (yaml--parse-from-grammar 'ns-plain-char c) - (yaml--parse-from-grammar 'nb-ns-plain-in-line c))))) - - ('c-reserved - (yaml--frame "c-reserved" - (yaml--any (yaml--chr ?\@) (yaml--chr ?\`)))) - - ('b-l-trimmed - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "b-l-trimmed" - (yaml--all - (yaml--parse-from-grammar 'b-non-content) - (yaml--rep 1 nil - (lambda () (yaml--parse-from-grammar 'l-empty n c))))))) - - ('l-document-prefix - (yaml--frame "l-document-prefix" - (yaml--all - (yaml--rep 0 1 - (lambda () (yaml--parse-from-grammar 'c-byte-order-mark))) - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 'l-comment)))))) - - ('c-byte-order-mark - (yaml--frame "c-byte-order-mark" (yaml--chr ?\xFEFF))) - - ('c-anchor - (yaml--frame "c-anchor" (yaml--chr ?\&))) - - ('s-double-escaped - (let ((n (nth 0 args))) - (yaml--frame "s-double-escaped" - (yaml--all - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 's-white))) - (yaml--chr ?\\) - (yaml--parse-from-grammar 'b-non-content) - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 'l-empty n "flow-in"))) - (yaml--parse-from-grammar 's-flow-line-prefix n))))) - - ('ns-esc-32-bit - (yaml--frame "ns-esc-32-bit" - (yaml--all - (yaml--chr ?U) - (yaml--rep 8 8 (lambda () (yaml--parse-from-grammar 'ns-hex-digit)))))) - - - ('b-non-content - (yaml--frame "b-non-content" (yaml--parse-from-grammar 'b-break))) - - ('ns-tag-char - (yaml--frame "ns-tag-char" - (yaml--but (lambda () (yaml--parse-from-grammar 'ns-uri-char)) - (lambda () (yaml--chr ?\!)) - (lambda () (yaml--parse-from-grammar 'c-flow-indicator))))) - - ('b-carriage-return - (yaml--frame "b-carriage-return" (yaml--chr ?\x0D))) - - ('s-double-next-line - (let ((n (nth 0 args))) - (yaml--frame "s-double-next-line" - (yaml--all - (yaml--parse-from-grammar 's-double-break n) - (yaml--rep 0 1 - (lambda () - (yaml--all - (yaml--parse-from-grammar 'ns-double-char) - (yaml--parse-from-grammar 'nb-ns-double-in-line) - (yaml--any - (yaml--parse-from-grammar 's-double-next-line n) - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 's-white))))))))))) - - ('ns-esc-non-breaking-space - (yaml--frame "ns-esc-non-breaking-space" (yaml--chr ?\_))) - - ('l-nb-diff-lines - (let ((n (nth 0 args))) - (yaml--frame "l-nb-diff-lines" - (yaml--all - (yaml--parse-from-grammar 'l-nb-same-lines n) - (yaml--rep2 0 nil - (lambda () - (yaml--all (yaml--parse-from-grammar 'b-as-line-feed) - (yaml--parse-from-grammar 'l-nb-same-lines n)))))))) - - ('s-flow-folded - (let ((n (nth 0 args))) - (yaml--frame "s-flow-folded" - (yaml--all - (yaml--rep 0 1 - (lambda () (yaml--parse-from-grammar 's-separate-in-line))) - (yaml--parse-from-grammar 'b-l-folded n "flow-in") - (yaml--parse-from-grammar 's-flow-line-prefix n))))) - - ('ns-flow-map-explicit-entry - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "ns-flow-map-explicit-entry" - (yaml--any - (yaml--parse-from-grammar 'ns-flow-map-implicit-entry n c) - (yaml--all - (yaml--parse-from-grammar 'e-node) - (yaml--parse-from-grammar 'e-node)))))) - - ('ns-l-block-map-implicit-entry - (yaml--frame "ns-l-block-map-implicit-entry" - (yaml--all - (yaml--any (yaml--parse-from-grammar 'ns-s-block-map-implicit-key) - (yaml--parse-from-grammar 'e-node)) - (yaml--parse-from-grammar 'c-l-block-map-implicit-value (nth 0 args))))) - - ('l-nb-folded-lines - (let ((n (nth 0 args))) - (yaml--frame "l-nb-folded-lines" - (yaml--all - (yaml--parse-from-grammar 's-nb-folded-text n) - (yaml--rep2 0 nil - (lambda () - (yaml--all (yaml--parse-from-grammar 'b-l-folded n "block-in") - (yaml--parse-from-grammar 's-nb-folded-text n)))))))) - - ('c-l-block-map-explicit-key - (let ((n (nth 0 args))) - (yaml--frame "c-l-block-map-explicit-key" - (yaml--all - (yaml--chr ?\?) - (yaml--parse-from-grammar 's-l+block-indented n "block-out"))))) - - ('s-separate - (let ((n (nth 0 args)) - (c (nth 1 args))) - (yaml--frame "s-separate" - (pcase c - ("block-in" (yaml--parse-from-grammar 's-separate-lines n)) - ("block-key" (yaml--parse-from-grammar 's-separate-in-line)) - ("block-out" (yaml--parse-from-grammar 's-separate-lines n)) - ("flow-in" (yaml--parse-from-grammar 's-separate-lines n)) - ("flow-key" (yaml--parse-from-grammar 's-separate-in-line)) - ("flow-out" (yaml--parse-from-grammar 's-separate-lines n)))))) - - ('ns-flow-pair-entry - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "ns-flow-pair-entry" - (yaml--any - (yaml--parse-from-grammar 'ns-flow-pair-yaml-key-entry n c) - (yaml--parse-from-grammar 'c-ns-flow-map-empty-key-entry n c) - (yaml--parse-from-grammar 'c-ns-flow-pair-json-key-entry n c))))) - - ('c-flow-indicator - (yaml--frame "c-flow-indicator" - (yaml--any (yaml--chr ?\,) - (yaml--chr ?\[) - (yaml--chr ?\]) - (yaml--chr ?\{) - (yaml--chr ?\})))) - - ('ns-flow-pair-yaml-key-entry - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "ns-flow-pair-yaml-key-entry" - (yaml--all - (yaml--parse-from-grammar 'ns-s-implicit-yaml-key "flow-key") - (yaml--parse-from-grammar 'c-ns-flow-map-separate-value n c))))) - - ('e-scalar - (yaml--frame "e-scalar" (yaml--empty))) - - ('s-indent-lt - (let ((n (nth 0 args))) - (yaml--frame "s-indent-lt" - (yaml--all - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 's-space))) - (< (length (yaml--match)) n))))) - - ('nb-single-one-line - (yaml--frame "nb-single-one-line" - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 'nb-single-char))))) - - ('c-collect-entry - (yaml--frame "c-collect-entry" (yaml--chr ?\,))) - - ('ns-l-compact-sequence - (let ((n (nth 0 args))) - (yaml--frame "ns-l-compact-sequence" - (yaml--all - (yaml--parse-from-grammar 'c-l-block-seq-entry n) - (yaml--rep2 0 nil - (lambda () - (yaml--all - (yaml--parse-from-grammar 's-indent n) - (yaml--parse-from-grammar 'c-l-block-seq-entry n)))))))) - - ('c-comment - (yaml--frame "c-comment" (yaml--chr ?\#))) - - ('s-line-prefix - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "s-line-prefix" - (pcase c - ("block-in" (yaml--parse-from-grammar 's-block-line-prefix n)) - ("block-out" (yaml--parse-from-grammar 's-block-line-prefix n)) - ("flow-in" (yaml--parse-from-grammar 's-flow-line-prefix n)) - ("flow-out" (yaml--parse-from-grammar 's-flow-line-prefix n)))))) - - ('s-tab - (yaml--frame "s-tab" (yaml--chr ?\x09))) - - ('c-directive - (yaml--frame "c-directive" (yaml--chr ?\%))) - - ('ns-flow-pair - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "ns-flow-pair" - (yaml--any - (yaml--all (yaml--chr ?\?) - (yaml--parse-from-grammar 's-separate n c) - (yaml--parse-from-grammar 'ns-flow-map-explicit-entry n c)) - (yaml--parse-from-grammar 'ns-flow-pair-entry n c))))) - - ('s-l+block-indented - (yaml--frame "s-l+block-indented" - (let ((m (yaml--auto-detect-indent (nth 0 args)))) - (yaml--any - (yaml--all - (yaml--parse-from-grammar 's-indent m) - (yaml--any - (yaml--parse-from-grammar 'ns-l-compact-sequence - (+ (nth 0 args) (+ 1 m))) - (yaml--parse-from-grammar 'ns-l-compact-mapping - (+ (nth 0 args) (+ 1 m))))) - (yaml--parse-from-grammar 's-l+block-node (nth 0 args) (nth 1 args)) - (yaml--all (yaml--parse-from-grammar 'e-node) - (yaml--parse-from-grammar 's-l-comments)))))) - - ('c-single-quote - (yaml--frame "c-single-quote" (yaml--chr ?\'))) - - ('s-flow-line-prefix - (let ((n (nth 0 args))) - (yaml--frame "s-flow-line-prefix" - (yaml--all - (yaml--parse-from-grammar 's-indent n) - (yaml--rep 0 1 - (lambda () (yaml--parse-from-grammar 's-separate-in-line))))))) - - ('nb-double-char - (yaml--frame "nb-double-char" - (yaml--any - (yaml--parse-from-grammar 'c-ns-esc-char) - (yaml--but (lambda () (yaml--parse-from-grammar 'nb-json)) - (lambda () (yaml--chr ?\\)) (lambda () (yaml--chr ?\")))))) - - ('l-comment - (yaml--frame "l-comment" - (yaml--all - (yaml--parse-from-grammar 's-separate-in-line) - (yaml--rep 0 1 - (lambda () (yaml--parse-from-grammar 'c-nb-comment-text))) - (yaml--parse-from-grammar 'b-comment)))) - - ('ns-hex-digit - (yaml--frame "ns-hex-digit" - (yaml--any - (yaml--parse-from-grammar 'ns-dec-digit) - (yaml--chr-range ?\x41 ?\x46) - (yaml--chr-range ?\x61 ?\x66)))) - - ('s-l+flow-in-block - (let ((n (nth 0 args))) - (yaml--frame "s-l+flow-in-block" - (yaml--all - (yaml--parse-from-grammar 's-separate (+ n 1) "flow-out") - (yaml--parse-from-grammar 'ns-flow-node (+ n 1) "flow-out") - (yaml--parse-from-grammar 's-l-comments))))) - - ('c-flow-json-node - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "c-flow-json-node" - (yaml--all - (yaml--rep 0 1 - (lambda () - (yaml--all - (yaml--parse-from-grammar 'c-ns-properties n c) - (yaml--parse-from-grammar 's-separate n c)))) - (yaml--parse-from-grammar 'c-flow-json-content n c))))) - - ('c-b-block-header - (let ((m (nth 0 args)) - (tt (nth 1 args))) - (yaml--frame "c-b-block-header" - (yaml--all - (yaml--any - (and (not (string-match "\\`[-+][0-9]" - (yaml--slice yaml--parsing-position))) - ;; hack to not match this case if there is a number. - (yaml--all - (yaml--parse-from-grammar 'c-indentation-indicator m) - (yaml--parse-from-grammar 'c-chomping-indicator tt))) - (yaml--all - (yaml--parse-from-grammar 'c-chomping-indicator tt) - (yaml--parse-from-grammar 'c-indentation-indicator m))) - (yaml--parse-from-grammar 's-b-comment))))) - - ('ns-esc-8-bit - (yaml--frame "ns-esc-8-bit" - (yaml--all (yaml--chr ?x) - (yaml--rep 2 2 - (lambda () (yaml--parse-from-grammar 'ns-hex-digit)))))) - - ('ns-anchor-name - (yaml--frame "ns-anchor-name" - (yaml--rep 1 nil - (lambda () (yaml--parse-from-grammar 'ns-anchor-char))))) - - ('ns-esc-slash - (yaml--frame "ns-esc-slash" (yaml--chr ?\/))) - - ('s-nb-folded-text - (let ((n (nth 0 args))) - (yaml--frame "s-nb-folded-text" - (yaml--all (yaml--parse-from-grammar 's-indent n) - (yaml--parse-from-grammar 'ns-char) - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 'nb-char))))))) - - ('ns-word-char - (yaml--frame "ns-word-char" - (yaml--any (yaml--parse-from-grammar 'ns-dec-digit) - (yaml--parse-from-grammar 'ns-ascii-letter) - (yaml--chr ?\-)))) - - ('ns-esc-form-feed - (yaml--frame "ns-esc-form-feed" (yaml--chr ?f))) - - ('ns-s-block-map-implicit-key - (yaml--frame "ns-s-block-map-implicit-key" - (yaml--any - (yaml--parse-from-grammar 'c-s-implicit-json-key "block-key") - (yaml--parse-from-grammar 'ns-s-implicit-yaml-key "block-key")))) - - ('ns-esc-null (yaml--frame "ns-esc-null" (yaml--chr ?\0))) - - ('c-ns-tag-property - (yaml--frame "c-ns-tag-property" - (yaml--any (yaml--parse-from-grammar 'c-verbatim-tag) - (yaml--parse-from-grammar 'c-ns-shorthand-tag) - (yaml--parse-from-grammar 'c-non-specific-tag)))) - - ('c-ns-local-tag-prefix - (yaml--frame "c-ns-local-tag-prefix" - (yaml--all - (yaml--chr ?\!) - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 'ns-uri-char)))))) - - ('ns-tag-directive - (yaml--frame "ns-tag-directive" - (yaml--all (yaml--chr ?T) (yaml--chr ?A) (yaml--chr ?G) - (yaml--parse-from-grammar 's-separate-in-line) - (yaml--parse-from-grammar 'c-tag-handle) - (yaml--parse-from-grammar 's-separate-in-line) - (yaml--parse-from-grammar 'ns-tag-prefix)))) - - ('c-flow-mapping - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "c-flow-mapping" - (yaml--all - (yaml--chr ?\{) - (yaml--rep 0 1 - (lambda () (yaml--parse-from-grammar 's-separate n c))) - (yaml--rep 0 1 - (lambda () - (yaml--parse-from-grammar 'ns-s-flow-map-entries - n - (yaml--parse-from-grammar 'in-flow c)))) - (yaml--chr ?\}))))) - - ('ns-double-char - (yaml--frame "ns-double-char" - (yaml--but (lambda () (yaml--parse-from-grammar 'nb-double-char)) - (lambda () (yaml--parse-from-grammar 's-white))))) - - ('ns-ascii-letter - (yaml--frame "ns-ascii-letter" - (yaml--any (yaml--chr-range ?\x41 ?\x5A) - (yaml--chr-range ?\x61 ?\x7A)))) - - ('b-break - (yaml--frame "b-break" - (yaml--any (yaml--all (yaml--parse-from-grammar 'b-carriage-return) - (yaml--parse-from-grammar 'b-line-feed)) - (yaml--parse-from-grammar 'b-carriage-return) - (yaml--parse-from-grammar 'b-line-feed)))) - - ('nb-ns-double-in-line - (yaml--frame "nb-ns-double-in-line" - (yaml--rep2 0 nil - (lambda () - (yaml--all - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 's-white))) - (yaml--parse-from-grammar 'ns-double-char)))))) - - ('s-l+block-node - (yaml--frame "s-l+block-node" - (yaml--any - (yaml--parse-from-grammar 's-l+block-in-block (nth 0 args) (nth 1 args)) - (yaml--parse-from-grammar 's-l+flow-in-block (nth 0 args))))) - - ('ns-esc-bell - (yaml--frame "ns-esc-bell" (yaml--chr ?a))) - - ('c-named-tag-handle - (yaml--frame "c-named-tag-handle" - (yaml--all - (yaml--chr ?\!) - (yaml--rep 1 nil (lambda () (yaml--parse-from-grammar 'ns-word-char))) - (yaml--chr ?\!)))) - - ('s-separate-lines - (let ((n (nth 0 args))) - (yaml--frame "s-separate-lines" - (yaml--any (yaml--all (yaml--parse-from-grammar 's-l-comments) - (yaml--parse-from-grammar 's-flow-line-prefix n)) - (yaml--parse-from-grammar 's-separate-in-line))))) - - ('l-directive - (yaml--frame "l-directive" - (yaml--all (yaml--chr ?\%) - (yaml--any (yaml--parse-from-grammar 'ns-yaml-directive) - (yaml--parse-from-grammar 'ns-tag-directive) - (yaml--parse-from-grammar 'ns-reserved-directive)) - (yaml--parse-from-grammar 's-l-comments)))) - - ('ns-esc-escape - (yaml--frame "ns-esc-escape" (yaml--chr ?e))) - - ('b-nb-literal-next - (let ((n (nth 0 args))) - (yaml--frame "b-nb-literal-next" - (yaml--all (yaml--parse-from-grammar 'b-as-line-feed) - (yaml--parse-from-grammar 'l-nb-literal-text n))))) - - ('ns-s-flow-map-entries - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "ns-s-flow-map-entries" - (yaml--all - (yaml--parse-from-grammar 'ns-flow-map-entry n c) - (yaml--rep 0 1 (lambda () (yaml--parse-from-grammar 's-separate n c))) - (yaml--rep 0 1 - (lambda () - (yaml--all - (yaml--chr ?\,) - (yaml--rep 0 1 - (lambda () (yaml--parse-from-grammar 's-separate n c))) - (yaml--rep 0 1 - (lambda () - (yaml--parse-from-grammar 'ns-s-flow-map-entries - n - c)))))))))) - - ('c-nb-comment-text - (yaml--frame "c-nb-comment-text" - (yaml--all - (yaml--chr ?\#) - (yaml--rep2 0 nil (lambda () (yaml--parse-from-grammar 'nb-char)))))) - - ('ns-dec-digit - (yaml--frame "ns-dec-digit" - (yaml--chr-range ?\x30 ?\x39))) - - ('ns-yaml-directive - (yaml--frame "ns-yaml-directive" - (yaml--all (yaml--chr ?Y) (yaml--chr ?A) (yaml--chr ?M) (yaml--chr ?L) - (yaml--parse-from-grammar 's-separate-in-line) - (yaml--parse-from-grammar 'ns-yaml-version)))) - - ('c-mapping-key - (yaml--frame "c-mapping-key" (yaml--chr ?\?))) - - ('b-as-line-feed - (yaml--frame "b-as-line-feed" - (yaml--parse-from-grammar 'b-break))) - - ('s-l+block-in-block - (yaml--frame "s-l+block-in-block" - (yaml--any - (yaml--parse-from-grammar 's-l+block-scalar - (nth 0 args) - (nth 1 args)) - (yaml--parse-from-grammar 's-l+block-collection - (nth 0 args) - (nth 1 args))))) - - ('ns-esc-paragraph-separator - (yaml--frame "ns-esc-paragraph-separator" (yaml--chr ?P))) - - ('c-double-quoted - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "c-double-quoted" - (yaml--all (yaml--chr ?\") - (yaml--parse-from-grammar 'nb-double-text n c) - (yaml--chr ?\"))))) - - ('b-line-feed - (yaml--frame "b-line-feed" (yaml--chr ?\x0A))) - - ('ns-esc-horizontal-tab - (yaml--frame "ns-esc-horizontal-tab" - (yaml--any (yaml--chr ?t) (yaml--chr ?\x09)))) - - ('c-ns-flow-map-empty-key-entry - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "c-ns-flow-map-empty-key-entry" - (yaml--all - (yaml--parse-from-grammar 'e-node) - (yaml--parse-from-grammar 'c-ns-flow-map-separate-value n c))))) - - ('l-any-document - (yaml--frame "l-any-document" - (yaml--any (yaml--parse-from-grammar 'l-directive-document) - (yaml--parse-from-grammar 'l-explicit-document) - (yaml--parse-from-grammar 'l-bare-document)))) - - ('c-tag (yaml--frame "c-tag" (yaml--chr ?\!))) - - ('c-escape (yaml--frame "c-escape" (yaml--chr ?\\))) - - ('c-sequence-end (yaml--frame "c-sequence-end" (yaml--chr ?\]))) - - ('l+block-mapping - (yaml--frame "l+block-mapping" - (let ((new-m (yaml--auto-detect-indent (nth 0 args)))) - (if (= 0 new-m) - nil ;; For some fixed auto-detected m > 0 ;; Is this right??? - (yaml--all - (yaml--set m new-m) - (yaml--rep 1 nil - (lambda () - (yaml--all - (yaml--parse-from-grammar 's-indent - (+ (nth 0 args) new-m)) - (yaml--parse-from-grammar 'ns-l-block-map-entry - (+ (nth 0 args) new-m)))))))))) - - ('c-ns-flow-map-adjacent-value - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "c-ns-flow-map-adjacent-value" - (yaml--all - (yaml--chr ?\:) - (yaml--any - (yaml--all - (yaml--rep 0 1 - (lambda () (yaml--parse-from-grammar 's-separate n c))) - (yaml--parse-from-grammar 'ns-flow-node n c)) - (yaml--parse-from-grammar 'e-node)))))) - - ('s-single-next-line - (let ((n (nth 0 args))) - (yaml--frame "s-single-next-line" - (yaml--all - (yaml--parse-from-grammar 's-flow-folded n) - (yaml--rep 0 1 - (lambda () - (yaml--all - (yaml--parse-from-grammar 'ns-single-char) - (yaml--parse-from-grammar 'nb-ns-single-in-line) - (yaml--any - (yaml--parse-from-grammar 's-single-next-line n) - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 's-white))))))))))) - - ('s-separate-in-line - (yaml--frame "s-separate-in-line" - (yaml--any (yaml--rep 1 nil - (lambda () (yaml--parse-from-grammar 's-white))) - (yaml--start-of-line)))) - - ('b-comment - (yaml--frame "b-comment" - (yaml--any (yaml--parse-from-grammar 'b-non-content) - (yaml--end-of-stream)))) - - ('ns-esc-backslash - (yaml--frame "ns-esc-backslash" (yaml--chr ?\\))) - - ('c-ns-anchor-property - (yaml--frame "c-ns-anchor-property" - (yaml--all (yaml--chr ?\&) - (yaml--parse-from-grammar 'ns-anchor-name)))) - - ('ns-plain-safe - (let ((c (nth 0 args))) - (yaml--frame "ns-plain-safe" - (pcase c - ("block-key" (yaml--parse-from-grammar 'ns-plain-safe-out)) - ("flow-in" (yaml--parse-from-grammar 'ns-plain-safe-in)) - ("flow-key" (yaml--parse-from-grammar 'ns-plain-safe-in)) - ("flow-out" (yaml--parse-from-grammar 'ns-plain-safe-out)))))) - - ('ns-flow-content - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "ns-flow-content" - (yaml--any (yaml--parse-from-grammar 'ns-flow-yaml-content n c) - (yaml--parse-from-grammar 'c-flow-json-content n c))))) - - ('c-ns-flow-map-separate-value - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "c-ns-flow-map-separate-value" - (yaml--all - (yaml--chr ?\:) - (yaml--chk "!" (yaml--parse-from-grammar 'ns-plain-safe c)) - (yaml--any (yaml--all (yaml--parse-from-grammar 's-separate n c) - (yaml--parse-from-grammar 'ns-flow-node n c)) - (yaml--parse-from-grammar 'e-node)))))) - - ('in-flow - (let ((c (nth 0 args))) - (yaml--frame "in-flow" - (pcase c - ("block-key" "flow-key") - ("flow-in" "flow-in") - ("flow-key" "flow-key") - ("flow-out" "flow-in"))))) - - ('c-verbatim-tag - (yaml--frame "c-verbatim-tag" - (yaml--all - (yaml--chr ?\!) - (yaml--chr ?\<) - (yaml--rep 1 nil (lambda () (yaml--parse-from-grammar 'ns-uri-char))) - (yaml--chr ?\>)))) - - ('c-literal - (yaml--frame "c-literal" (yaml--chr ?\|))) - - ('ns-esc-line-feed - (yaml--frame "ns-esc-line-feed" (yaml--chr ?n))) - - ('nb-double-multi-line - (let ((n (nth 0 args))) - (yaml--frame "nb-double-multi-line" - (yaml--all - (yaml--parse-from-grammar 'nb-ns-double-in-line) - (yaml--any (yaml--parse-from-grammar 's-double-next-line n) - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 's-white)))))))) - - ('b-l-spaced - (let ((n (nth 0 args))) - (yaml--frame "b-l-spaced" - (yaml--all - (yaml--parse-from-grammar 'b-as-line-feed) - (yaml--rep2 0 nil - (lambda () (yaml--parse-from-grammar 'l-empty n "block-in"))))))) - - ('ns-flow-yaml-content - (let ((n (nth 0 args)) (c (nth 1 args))) - (yaml--frame "ns-flow-yaml-content" - (yaml--parse-from-grammar 'ns-plain n c)))) - (_ (error "Unknown parsing grammar state: %s %s" state args)))) - -;;; Encoding - -(defun yaml-encode (object) - "Encode OBJECT to a YAML string." - (with-temp-buffer - (yaml--encode-object object 0) - (buffer-string))) - -(defun yaml--encode-object (object indent &optional auto-indent) - "Encode a Lisp OBJECT to YAML. - -INDENT indicates how deeply nested the object will be displayed -in the YAML. If AUTO-INDENT is non-nil, then emit the object -without first inserting a newline." - (cond - ((yaml--scalarp object) (yaml--encode-scalar object)) - ((hash-table-p object) (yaml--encode-hash-table object indent auto-indent)) - ((listp object) (yaml--encode-list object indent auto-indent)) - ((arrayp object) (yaml--encode-array object indent auto-indent)) - (t (error "Unknown object %s" object)))) - -(defun yaml--scalarp (object) - "Return non-nil if OBJECT correlates to a YAML scalar." - (or (numberp object) - (symbolp object) - (stringp object) - (not object))) - -(defun yaml--encode-escape-string (s) - "Escape yaml special characters in string S." - (let* ((s (replace-regexp-in-string "\\\\" "\\\\" s)) - (s (replace-regexp-in-string "\n" "\\\\n" s)) - (s (replace-regexp-in-string "\t" "\\\\t" s)) - (s (replace-regexp-in-string "\r" "\\\\r" s)) - (s (replace-regexp-in-string "\"" "\\\\\"" s))) - s)) - -(defun yaml--encode-array (a indent &optional auto-indent) - "Encode array A to a string in the context of being INDENT deep. - -If AUTO-INDENT is non-nil, start the list on the current line, -auto-detecting the indentation. Functionality defers to -`yaml--encode-list'." - (yaml--encode-list (seq-map #'identity a) - indent - auto-indent)) - - -(defun yaml--encode-scalar (s) - "Encode scalar S to buffer." - (cond - ((not s) (insert "null")) - ((eql t s) (insert "true")) - ((symbolp s) - (cond - ((eql s :null) (insert "null")) - ((eql s :false) (insert "false")) - (t (insert (symbol-name s))))) - ((numberp s) (insert (number-to-string s))) - ((stringp s) - (if (string-match "\\`[-_a-zA-Z0-9]+\\'" s) - (insert s) - (insert "\"" (yaml--encode-escape-string s) "\""))))) - -(defun yaml--alist-to-hash-table (l) - "Return hash representation of L if it is an alist, nil otherwise." - (when (and (listp l) - (seq-every-p (lambda (x) (and (consp x) (atom (car x)))) l)) - (let ((h (make-hash-table))) - (seq-map (lambda (cpair) - (let* ((k (car cpair)) - (v (alist-get k l))) - (puthash k v h))) - l) - h))) - -(defun yaml--encode-list (l indent &optional auto-indent) - "Encode list L to a string in the context of being INDENT deep. - -If AUTO-INDENT is non-nil, start the list on the current line, -auto-detecting the indentation" - (let ((ht (yaml--alist-to-hash-table l))) - (cond (ht - (yaml--encode-hash-table ht indent auto-indent)) - ((zerop (length l)) - (insert "[]")) - ((seq-every-p #'yaml--scalarp l) - (insert "[") - (yaml--encode-object (car l) 0) - (seq-do (lambda (object) - (insert ", ") - (yaml--encode-object object 0)) - (cdr l)) - (insert "]")) - (t - (when (zerop indent) - (setq indent 2)) - (let* ((first t) - (indent-string (make-string (- indent 2) ?\s))) - (seq-do - (lambda (object) - (if (not first) - (insert "\n" indent-string "- ") - (if auto-indent - (let ((curr-indent (yaml--encode-auto-detect-indent))) - (insert (make-string (- indent curr-indent) ?\s) "- ")) - (insert "\n" indent-string "- ")) - (setq first nil)) - (if (or (hash-table-p object) - (yaml--alist-to-hash-table object)) - (yaml--encode-object object indent t) - (yaml--encode-object object (+ indent 2) nil))) - l)))))) - -(defun yaml--encode-auto-detect-indent () - "Return the amount of indentation at current place in encoding." - (length (thing-at-point 'line))) - -(defun yaml--encode-hash-table (m indent &optional auto-indent) - "Encode hash table M to a string in the context of being INDENT deep. - -If AUTO-INDENT is non-nil, auto-detect the indent on the current -line and insert accordingly." - (cond ((zerop (hash-table-size m)) - (insert "{}")) - (t - (let ((first t) - (indent-string (make-string indent ?\s))) - (maphash - (lambda (k v) - (if (not first) - (insert "\n" indent-string) - (if auto-indent - (let ((curr-indent (yaml--encode-auto-detect-indent))) - (when (> curr-indent indent) - (setq indent (+ curr-indent 1))) - (insert (make-string (- indent curr-indent) ?\s))) - (insert "\n" indent-string)) - (setq first nil)) - (yaml--encode-object k indent nil) - (insert ": ") - (yaml--encode-object v (+ indent 2))) - m))))) - -(provide 'yaml) - -;;; yaml.el ends here diff --git a/elpa/yaml-20241129.2114/yaml-autoloads.el b/elpa/yaml-20241129.2114/yaml-autoloads.el new file mode 100644 index 00000000..5dfa6517 --- /dev/null +++ b/elpa/yaml-20241129.2114/yaml-autoloads.el @@ -0,0 +1,28 @@ +;;; yaml-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) + + + +;;; Generated autoloads from yaml.el + +(register-definition-prefixes "yaml" '("yaml-")) + +;;; End of scraped data + +(provide 'yaml-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; no-native-compile: t +;; coding: utf-8-emacs-unix +;; End: + +;;; yaml-autoloads.el ends here diff --git a/elpa/yaml-20241129.2114/yaml-pkg.el b/elpa/yaml-20241129.2114/yaml-pkg.el new file mode 100644 index 00000000..94eec439 --- /dev/null +++ b/elpa/yaml-20241129.2114/yaml-pkg.el @@ -0,0 +1,10 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "yaml" "20241129.2114" + "YAML parser for Elisp." + '((emacs "25.1")) + :url "https://github.com/zkry/yaml.el" + :commit "cd3edfc02cb12514426c00e07160b87bd8340f4a" + :revdesc "cd3edfc02cb1" + :keywords '("tools") + :authors '(("Zachary Romero" . "zkry@posteo.org")) + :maintainers '(("Zachary Romero" . "zkry@posteo.org"))) diff --git a/elpa/yaml-20241129.2114/yaml.el b/elpa/yaml-20241129.2114/yaml.el new file mode 100644 index 00000000..66836a33 --- /dev/null +++ b/elpa/yaml-20241129.2114/yaml.el @@ -0,0 +1,2910 @@ +;;; yaml.el --- YAML parser for Elisp -*- lexical-binding: t -*- + +;; Copyright © 2021-2024 Free Software Foundation, Inc. + +;; Author: Zachary Romero +;; Package-Version: 20241129.2114 +;; Package-Revision: cd3edfc02cb1 +;; Homepage: https://github.com/zkry/yaml.el +;; Package-Requires: ((emacs "25.1")) +;; Keywords: tools + +;; yaml.el requires at least GNU Emacs 25.1 + +;; This file 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, 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. + +;; For a full copy of the GNU General Public License +;; see . + + +;;; Commentary: + +;; yaml.el contains the code for parsing YAML natively in Elisp with +;; no dependencies. The main function to parse YAML provided is +;; `yaml-parse-string'. `yaml-encode' is also provided to encode a +;; Lisp object to YAML. The following are some examples of its usage: +;; +;; (yaml-parse-string "key1: value1\nkey2: value2") +;; (yaml-parse-string "key1: value1\nkey2: value2" :object-type 'alist) +;; (yaml-parse-string "numbers: [1, 2, 3]" :sequence-type 'list) +;; +;; (yaml-encode '((count . 3) (value . 10) (items ("ruby" "diamond")))) + +;;; Code: + +(require 'subr-x) +(require 'seq) +(require 'cl-lib) + +(defconst yaml-parser-version "0.5.1") + +(defvar yaml--parse-debug nil + "Turn on debugging messages when parsing YAML when non-nil. + +This flag is intended for development purposes.") + +(defconst yaml--tracing-ignore '("s-space" + "s-tab" + "s-white" + "l-comment" + "b-break" + "b-line-feed" + "b-carriage-return" + "s-b-comment" + "b-comment" + "l-comment" + "ns-char" + "nb-char" + "b-char" + "c-printable" + "b-as-space")) + +(defvar yaml--parsing-input "" + "The string content of the current item being processed.") +(defvar yaml--parsing-position 0 + "The position that the parser is currently looking at.") +(defvar yaml--states nil + "Stack of parsing states.") + +(defvar yaml--parsing-object-type nil) +(defvar yaml--parsing-object-key-type nil) +(defvar yaml--parsing-sequence-type nil) +(defvar yaml--parsing-null-object nil) +(defvar yaml--parsing-false-object nil) +(defvar yaml--parsing-store-position nil) +(defvar yaml--string-values nil) + +(cl-defstruct (yaml--state (:constructor yaml--state-create) + (:copier nil)) + doc tt m name lvl beg end) + +(defmacro yaml--parse (data &rest forms) + "Parse DATA according to FORMS." + (declare (indent defun)) + `(progn (setq yaml--parsing-input ,data) + (setq yaml--parsing-position 0) + (yaml--initialize-state) + ,@forms)) + +(defun yaml--state-curr () + "Return the current state." + (or (car yaml--states) + (yaml--state-create + :name nil :doc nil :lvl 0 :beg 0 :end 0 :m nil :tt nil))) + +(defun yaml--state-set-m (val) + "Set the current value of t to VAL." + (let* ((states yaml--states)) + (while states + (let* ((top-state (car states)) + (new-state (yaml--state-create :doc (yaml--state-doc top-state) + :tt (yaml--state-tt top-state) + :m val + :name (yaml--state-name top-state) + :lvl (yaml--state-lvl top-state) + :beg (yaml--state-beg top-state) + :end (yaml--state-end top-state)))) + (setcar states new-state)) + (setq states (cdr states))))) + +(defun yaml--state-set-t (val) + "Set the current value of t to VAL." + (let* ((states yaml--states)) + (while states + (let* ((top-state (car states)) + (new-state (yaml--state-create :doc (yaml--state-doc top-state) + :tt val + :m (yaml--state-m top-state) + :name (yaml--state-name top-state) + :lvl (yaml--state-lvl top-state) + :beg (yaml--state-beg top-state) + :end (yaml--state-end top-state)))) + (setcar states new-state)) + (setq states (cdr states))))) + +(defun yaml--state-curr-doc () + "Return the doc property of current state." + (yaml--state-doc (yaml--state-curr))) + +(defun yaml--state-curr-t () + "Return the doc property of current state." + (yaml--state-tt (yaml--state-curr))) + +(defun yaml--state-curr-m () + "Return the doc property of current state." + (or (yaml--state-m (yaml--state-curr)) 1)) + +(defun yaml--state-curr-end () + "Return the doc property of current state." + (yaml--state-end (yaml--state-curr))) + +(defun yaml--push-state (name) + "Add a new state frame with NAME." + (let* ((curr-state (yaml--state-curr)) + (new-state (yaml--state-create + :doc (yaml--state-curr-doc) + :tt (yaml--state-curr-t) + :m (yaml--state-curr-m) + :name name + :lvl (1+ (yaml--state-lvl curr-state)) + :beg yaml--parsing-position + :end nil))) + (push new-state yaml--states))) + +(defun yaml--pop-state () + "Pop the current state." + (let ((popped-state (car yaml--states))) + (setq yaml--states (cdr yaml--states)) + (let ((top-state (car yaml--states))) + (when top-state + (setcar yaml--states + (yaml--state-create :doc (yaml--state-doc top-state) + :tt (yaml--state-tt top-state) + :m (yaml--state-m top-state) + :name (yaml--state-name top-state) + :lvl (yaml--state-lvl top-state) + :beg (yaml--state-beg popped-state) + :end yaml--parsing-position)))))) + +(defun yaml--initialize-state () + "Initialize the yaml state for parsing." + (setq yaml--states + (list (yaml--state-create :doc nil + :tt nil + :m nil + :name nil + :lvl 0 + :beg nil + :end nil)))) + +(defconst yaml--grammar-resolution-rules + '(("ns-plain" . literal)) + "Alist determining how to resolve grammar rule.") + +;;; Receiver Functions + +(defvar yaml--document-start-version nil) +(defvar yaml--document-start-explicit nil) +(defvar yaml--document-end-explicit nil) +(defvar yaml--tag-map nil) +(defvar yaml--tag-handle nil) +(defvar yaml--document-end nil) + +(defvar yaml--cache nil + "Stack of data for temporary calculations.") +(defvar yaml--object-stack nil + "Stack of objects currently being build.") +(defvar yaml--state-stack nil + "The state that the YAML parser is with regards to incoming events.") +(defvar yaml--root nil) + +(defvar yaml--anchor-mappings nil + "Hashmap containing the anchor mappings of the current parsing run.") +(defvar yaml--resolve-aliases nil + "Flag determining if the event processing should attempt to resolve aliases.") + +(defun yaml--parse-block-header (header) + "Parse the HEADER string returning chomping style and indent count." + (let* ((pos 0) + (chomp-indicator :clip) + (indentation-indicator nil) + (char (and (< pos (length header)) (aref header pos))) + (process-char (lambda (char) + (when char + (cond + ((< ?0 char ?9) + (progn (setq indentation-indicator (- char ?0)))) + ((equal char ?\-) (setq chomp-indicator :strip)) + ((equal char ?\+) (setq chomp-indicator :keep))) + (setq pos (1+ pos)))))) + (when (or (eq char ?\|) (eq char ?\>)) + (setq pos (1+ pos)) + (setq char (and (< pos (length header)) (aref header pos)))) + (funcall process-char char) + (let ((char (and (< pos (length header)) (aref header pos)))) ; + (funcall process-char char) + (list chomp-indicator indentation-indicator)))) + +(defun yaml--chomp-text (text-body chomp) + "Change the ending newline of TEXT-BODY based on CHOMP." + (cond ((eq :clip chomp) + (concat (replace-regexp-in-string "\n*\\'" "" text-body) "\n")) + ((eq :strip chomp) + (replace-regexp-in-string "\n*\\'" "" text-body)) + ((eq :keep chomp) + text-body))) + +(defun yaml--process-folded-text (text) + "Remove the header line for a folded match and return TEXT body formatted." + (let* ((text (yaml--process-literal-text text)) + (done)) + (while (not done) + (let ((replaced (replace-regexp-in-string "\\([^\n]\\)\n\\([^\n ]\\)" + "\\1 \\2" + text))) + (when (equal replaced text) + (setq done t)) + (setq text replaced))) + (replace-regexp-in-string + "\\(\\(?:^\\|\n\\)[^ \n][^\n]*\\)\n\\(\n+\\)\\([^\n ]\\)" "\\1\\2\\3" + text))) + +(defun yaml--process-literal-text (text) + "Remove the header line for a folded match and return TEXT body formatted." + (let ((n (get-text-property 0 'yaml-n text))) + (remove-text-properties 0 (length text) '(yaml-n nil) text) + (let* ((header-line (substring text 0 (string-match "\n" text))) + (text-body (substring text (1+ (string-match "\n" text)))) + (parsed-header (yaml--parse-block-header header-line)) + (chomp (car parsed-header)) + (starting-spaces-ct + (or (and (cadr parsed-header) (+ (or n 0) (cadr parsed-header))) + (let ((_ (string-match "^\n*\\( *\\)" text-body))) + (length (match-string 1 text-body))))) + (lines (split-string text-body "\n")) + (striped-lines + (seq-map (lambda (l) + (replace-regexp-in-string + (format "\\` \\{0,%d\\}" starting-spaces-ct) "" l)) + lines)) + (text-body (string-join striped-lines "\n"))) + (yaml--chomp-text text-body chomp)))) + +;; TODO: Process tags and use them in this function. +(defun yaml--resolve-scalar-tag (scalar) + "Convert a SCALAR string to it's corresponding object." + (cond + (yaml--string-values + scalar) + ;; tag:yaml.org,2002:null + ((or (equal "null" scalar) + (equal "Null" scalar) + (equal "NULL" scalar) + (equal "~" scalar)) + yaml--parsing-null-object) + ;; tag:yaml.org,2002:bool + ((or (equal "true" scalar) + (equal "True" scalar) + (equal "TRUE" scalar)) t) + ((or (equal "false" scalar) + (equal "False" scalar) + (equal "FALSE" scalar)) + yaml--parsing-false-object) + ;; tag:yaml.org,2002:int + ((string-match "^0$\\|^-?[1-9][0-9]*$" scalar) + (string-to-number scalar)) + ((string-match "^[-+]?[0-9]+$" scalar) + (string-to-number scalar)) + ((string-match "^0o[0-7]+$" scalar) + (string-to-number (substring scalar 2) 8)) + ((string-match "^0x[0-9a-fA-F]+$" scalar) + (string-to-number (substring scalar 2) 16)) + ;; tag:yaml.org,2002:float + ((string-match + "^[-+]?\\(\\.[0-9]+\\|[0-9]+\\(\\.[0-9]*\\)?\\)\\([eE][-+]?[0-9]+\\)?$" + scalar) + (string-to-number scalar 10)) + ((string-match "^[-+]?\\(\\.inf\\|\\.Inf\\|\\.INF\\)$" scalar) + 1.0e+INF) + ((string-match "^[-+]?\\(\\.nan\\|\\.NaN\\|\\.NAN\\)$" scalar) + 1.0e+INF) + ((string-match "^0$\\|^-?[1-9]\\(\\.[0-9]*\\)?\\(e[-+][1-9][0-9]*\\)?$" + scalar) + (string-to-number scalar)) + (t scalar))) + +(defun yaml--hash-table-to-alist (hash-table) + "Convert HASH-TABLE to a alist." + (let ((alist nil)) + (maphash + (lambda (k v) + (setq alist (cons (cons k v) alist))) + hash-table) + alist)) + +(defun yaml--hash-table-to-plist (hash-table) + "Convert HASH-TABLE to a plist." + (let ((plist nil)) + (maphash + (lambda (k v) + (setq plist (cons k (cons v plist)))) + hash-table) + plist)) + +(defun yaml--format-object (hash-table) + "Convert HASH-TABLE to alist of plist if specified." + (cond + ((equal yaml--parsing-object-type 'hash-table) + hash-table) + ((equal yaml--parsing-object-type 'alist) + (yaml--hash-table-to-alist hash-table)) + ((equal yaml--parsing-object-type 'plist) + (yaml--hash-table-to-plist hash-table)) + (t hash-table))) + +(defun yaml--format-list (l) + "Convert L to array if specified." + (cond + ((equal yaml--parsing-sequence-type 'list) + l) + ((equal yaml--parsing-sequence-type 'array) + (apply #'vector l)) + (t l))) + +(defun yaml--stream-start-event () + "Create the data for a stream-start event." + '(:stream-start)) + +(defun yaml--stream-end-event () + "Create the data for a stream-end event." + '(:stream-end)) + +(defun yaml--mapping-start-event (_) + "Process event indicating start of mapping." + ;; NOTE: currently don't have a use for FLOW + (push :mapping yaml--state-stack) + (push (make-hash-table :test 'equal) yaml--object-stack)) + +(defun yaml--mapping-end-event () + "Process event indicating end of mapping." + (pop yaml--state-stack) + (let ((obj (pop yaml--object-stack))) + (yaml--scalar-event nil obj)) + '(:mapping-end)) + +(defun yaml--sequence-start-event (_) + "Process event indicating start of sequence according to FLOW." + ;; NOTE: currently don't have a use for FLOW + (push :sequence yaml--state-stack) + (push nil yaml--object-stack) + '(:sequence-start)) + +(defun yaml--sequence-end-event () + "Process event indicating end of sequence." + (pop yaml--state-stack) + (let ((obj (pop yaml--object-stack))) + (yaml--scalar-event nil obj)) + '(:sequence-end)) + +(defun yaml--anchor-event (name) + "Process event indicating an anchor has been defined with NAME." + (push :anchor yaml--state-stack) + (push `(:anchor ,name) yaml--object-stack)) + +(defun yaml--scalar-event (style value) + "Process the completion of a scalar VALUE. + + Note that VALUE may be a complex object here. STYLE is + currently unused." + (let ((top-state (car yaml--state-stack)) + (value* (cond + ((stringp value) (yaml--resolve-scalar-tag value)) + ((listp value) (yaml--format-list value)) + ((hash-table-p value) (yaml--format-object value)) + ((vectorp value) value) + ((not value) nil)))) + (cond + ((not top-state) + (setq yaml--root value*)) + ((equal top-state :anchor) + (let* ((anchor (pop yaml--object-stack)) + (name (nth 1 anchor))) + (puthash name value yaml--anchor-mappings) + (pop yaml--state-stack) + (yaml--scalar-event nil value))) + ((equal top-state :sequence) + (let ((l (car yaml--object-stack))) + (setcar yaml--object-stack (append l (list value*))))) + ((equal top-state :mapping) + (progn + (push :mapping-value yaml--state-stack) + (push value* yaml--cache))) + ((equal top-state :mapping-value) + (progn + (let ((key (pop yaml--cache)) + (table (car yaml--object-stack))) + (when (stringp key) + (cond + ((eql 'symbol yaml--parsing-object-key-type) + (setq key (intern key))) + ((eql 'keyword yaml--parsing-object-key-type) + (setq key (intern (format ":%s" key)))))) + (puthash key value* table)) + (pop yaml--state-stack))) + ((equal top-state :trail-comments) + (pop yaml--state-stack) + (let ((comment-text (pop yaml--object-stack))) + (unless (stringp value*) + (error "Trail-comments can't be nested under non-string")) + (yaml--scalar-event + style + (replace-regexp-in-string (concat (regexp-quote comment-text) "\n*\\'") + "" + value*)))) + ((equal top-state nil)))) + '(:scalar)) + +(defun yaml--alias-event (name) + "Process a node has been defined via alias NAME." + (if yaml--resolve-aliases + (let ((resolved (gethash name yaml--anchor-mappings))) + (unless resolved (error "Undefined alias '%s'" name)) + (yaml--scalar-event nil resolved)) + (yaml--scalar-event nil (vector :alias name))) + '(:alias)) + +(defun yaml--trail-comments-event (text) + "Process trailing comments of TEXT which should be trimmed from parent." + (push :trail-comments yaml--state-stack) + (push text yaml--object-stack) + '(:trail-comments)) + + + +(defun yaml--check-document-end () + "Return non-nil if at end of document." + ;; NOTE: currently no need for this. May be needed in the future. + t) + +(defun yaml--reverse-at-list () + "Reverse the list at the top of the object stack. + +This is needed to get the correct order as lists are processed in +reverse order." + (setcar yaml--object-stack (reverse (car yaml--object-stack)))) + +(defconst yaml--grammar-events-in + '(("l-yaml-stream" . (lambda () + (yaml--stream-start-event) + (setq yaml--document-start-version nil) + (setq yaml--document-start-explicit nil) + (setq yaml--tag-map (make-hash-table)))) + ("c-flow-mapping" . (lambda () + (yaml--mapping-start-event t))) + ("c-flow-sequence" . (lambda () + (yaml--sequence-start-event nil))) + ("l+block-mapping" . (lambda () + (yaml--mapping-start-event nil))) + ("l+block-sequence" . (lambda () + (yaml--sequence-start-event nil))) + ("ns-l-compact-mapping" . (lambda () + (yaml--mapping-start-event nil))) + ("ns-l-compact-sequence" . (lambda () + (yaml--sequence-start-event nil))) + ("ns-flow-pair" . (lambda () + (yaml--mapping-start-event t))) + ("ns-l-block-map-implicit-entry" . (lambda ())) + ("ns-l-compact-mapping" . (lambda ())) + ("c-l-block-seq-entry" . (lambda ()))) + "List of functions for matched rules that run on the entering of a rule.") + +(defconst yaml--grammar-events-out + '(("c-b-block-header" . + (lambda (text) + nil)) + ("l-yaml-stream" . + (lambda (text) + (yaml--check-document-end) + (yaml--stream-end-event))) + ("ns-yaml-version" . + (lambda (text) + (when yaml--document-start-version + (throw 'error "Multiple %YAML directives not allowed.")) + (setq yaml--document-start-version text))) + ("c-tag-handle" . + (lambda (text) + (setq yaml--tag-handle text))) + ("ns-tag-prefix" . + (lambda (text) + (puthash yaml--tag-handle text yaml--tag-map))) + ("c-directives-end" . + (lambda (text) + (yaml--check-document-end) + (setq yaml--document-start-explicit t))) + ("c-document-end" . + (lambda (text) + (when (not yaml--document-end) + (setq yaml--document-end-explicit t)) + (yaml--check-document-end))) + ("c-flow-mapping" . + (lambda (text) + (yaml--mapping-end-event))) + ("c-flow-sequence" . + (lambda (text) + (yaml--sequence-end-event ))) + ("l+block-mapping" . + (lambda (text) + (yaml--mapping-end-event))) + ("l+block-sequence" . + (lambda (text) + (yaml--reverse-at-list) + (yaml--sequence-end-event))) + ("ns-l-compact-mapping" . + (lambda (text) + (yaml--mapping-end-event))) + ("ns-l-compact-sequence" . + (lambda (text) + (yaml--sequence-end-event))) + ("ns-flow-pair" . + (lambda (text) + (yaml--mapping-end-event))) + ("ns-plain" . + (lambda (text) + (let* ((replaced (if (and (zerop (length yaml--state-stack)) + (string-match "\\(^\\|\n\\)\\.\\.\\.\\'" text)) + ;; Hack to not send the document parse end. + ;; Will only occur with bare ns-plain at top level. + (replace-regexp-in-string "\\(^\\|\n\\)\\.\\.\\.\\'" + "" + text) + text)) + (replaced (replace-regexp-in-string + "\\(?:[ \t]*\r?\n[ \t]*\\)" + "\n" + replaced)) + (replaced (replace-regexp-in-string + "\\(\n\\)\\(\n*\\)" + (lambda (x) + (if (> (length x) 1) + (substring x 1) + " ")) + replaced))) + (yaml--scalar-event "plain" replaced)))) + ("c-single-quoted" . + (lambda (text) + (let* ((replaced (replace-regexp-in-string + "\\(?:[ \t]*\r?\n[ \t]*\\)" + "\n" + text)) + (replaced (replace-regexp-in-string + "\\(\n\\)\\(\n*\\)" + (lambda (x) + (if (> (length x) 1) + (substring x 1) + " ")) + replaced)) + (replaced (if (not (equal "''" replaced)) + (replace-regexp-in-string + "''" + (lambda (x) + (if (> (length x) 1) + (substring x 1) + "'")) + replaced) + replaced))) + (yaml--scalar-event "single" + (substring replaced 1 (1- (length replaced))))))) + ("c-double-quoted" . + (lambda (text) + (let* ((replaced (replace-regexp-in-string + "\\(?:[ \t]*\r?\n[ \t]*\\)" + "\n" + text)) + (replaced (replace-regexp-in-string + "\\(\n\\)\\(\n*\\)" + (lambda (x) + (if (> (length x) 1) + (substring x 1) + " ")) + replaced)) + (replaced (replace-regexp-in-string "\\\\\\([\"\\/]\\)" + "\\1" + replaced)) + (replaced (replace-regexp-in-string "\\\\ " " " replaced)) + (replaced (replace-regexp-in-string "\\\\ " " " replaced)) + (replaced (replace-regexp-in-string "\\\\b" "\b" replaced)) + (replaced (replace-regexp-in-string "\\\\t" "\t" replaced)) + (replaced (replace-regexp-in-string "\\\\n" "\n" replaced)) + (replaced (replace-regexp-in-string "\\\\r" "\r" replaced)) + (replaced (replace-regexp-in-string "\\\\r" "\r" replaced)) + (replaced (replace-regexp-in-string + "\\\\x\\([0-9a-fA-F]\\{2\\}\\)" + (lambda (x) + (let ((char-pt (substring 2 x))) + (string (string-to-number char-pt 16)))) + replaced)) + (replaced (replace-regexp-in-string + "\\\\x\\([0-9a-fA-F]\\{2\\}\\)" + (lambda (x) + (let ((char-pt (substring x 2))) + (string (string-to-number char-pt 16)))) + replaced)) + (replaced (replace-regexp-in-string + "\\\\x\\([0-9a-fA-F]\\{4\\}\\)" + (lambda (x) + (let ((char-pt (substring x 2))) + (string (string-to-number char-pt 16)))) + replaced)) + (replaced (replace-regexp-in-string + "\\\\x\\([0-9a-fA-F]\\{8\\}\\)" + (lambda (x) + (let ((char-pt (substring x 2))) + (string (string-to-number char-pt 16)))) + replaced)) + (replaced (replace-regexp-in-string + "\\\\\\\\" + "\\" + replaced)) + (replaced (substring replaced 1 (1- (length replaced))))) + (yaml--scalar-event "double" replaced)))) + ("c-l+literal" . + (lambda (text) + (when (equal (car yaml--state-stack) :trail-comments) + (pop yaml--state-stack) + (let ((comment-text (pop yaml--object-stack))) + (setq text (replace-regexp-in-string + (concat (regexp-quote comment-text) "\n*\\'") "" text)))) + (let* ((processed-text (yaml--process-literal-text text))) + (yaml--scalar-event "folded" processed-text)))) + ("c-l+folded" . + (lambda (text) + (when (equal (car yaml--state-stack) :trail-comments) + (pop yaml--state-stack) + (let ((comment-text (pop yaml--object-stack))) + (setq text (replace-regexp-in-string + (concat (regexp-quote comment-text) "\n*\\'") "" text)))) + (let* ((processed-text (yaml--process-folded-text text))) + (yaml--scalar-event "folded" processed-text)))) + ("e-scalar" . + (lambda (text) + (yaml--scalar-event "plain" "null"))) + ("c-ns-anchor-property" . + (lambda (text) + (yaml--anchor-event (substring text 1)))) + ("c-ns-tag-property" . + (lambda (text) + ;; TODO: Implement tags + )) + ("l-trail-comments" . + (lambda (text) + (yaml--trail-comments-event text))) + ("c-ns-alias-node" . + (lambda (text) + (yaml--alias-event (substring text 1))))) + "List of functions for matched rules that run on the exiting of a rule.") + +(defconst yaml--terminal-rules + '( "l-nb-literal-text" + "l-nb-diff-lines" + "ns-plain" + "c-single-quoted" + "c-double-quoted") + "List of rules that indicate at which the parse tree should stop. + +This addition is a hack to prevent the parse tree from going too deep and thus +risk hitting the stack depth limit. Each of these rules are recursive and +repeat for each character in a text.") + +(defun yaml--walk-events (tree) + "Event walker iterates over the parse TREE and signals events from the rules." + (when (consp tree) + (if (stringp (car tree)) + (let ((grammar-rule (car tree)) + (text (cadr tree)) + (children (cl-caddr tree))) + (let ((in-fn (cdr (assoc grammar-rule yaml--grammar-events-in))) + (out-fn (cdr (assoc grammar-rule yaml--grammar-events-out)))) + (when in-fn + (funcall in-fn)) + (yaml--walk-events children) + (when out-fn + (funcall out-fn text)))) + (yaml--walk-events (car tree)) + (yaml--walk-events (cdr tree))))) + +(defmacro yaml--frame (name rule) + "Add a new state frame of NAME for RULE." + (declare (indent defun)) + (let ((res-symbol (make-symbol "res"))) + `(let ((beg yaml--parsing-position) + (_ (when (and yaml--parse-debug + (not (member ,name yaml--tracing-ignore))) + (message "|%s>%s %40s args=%s '%s'" + (make-string (length yaml--states) ?-) + (make-string (- 70 (length yaml--states)) ?\s) + ,name + args + (replace-regexp-in-string + "\n" + "↓" + (yaml--slice yaml--parsing-position))))) + (_ (yaml--push-state ,name)) + (,res-symbol ,rule)) + (when (and yaml--parse-debug + ,res-symbol + (not (member ,name yaml--tracing-ignore))) + (message "<%s|%s %40s = '%s'" + (make-string (length yaml--states) ?-) + (make-string (- 70 (length yaml--states)) ?\s) + ,name + (replace-regexp-in-string + "\n" + "↓" + (substring yaml--parsing-input beg yaml--parsing-position)))) + (yaml--pop-state) + (if (not ,res-symbol) + nil + (let ((res-type (cdr (assoc ,name yaml--grammar-resolution-rules))) + (,res-symbol (if (member ,name yaml--terminal-rules) + ;; Ignore children if at-rule is + ;; indicated to be terminal. + t + ,res-symbol))) + (cond + ((or (assoc ,name yaml--grammar-events-in) + (assoc ,name yaml--grammar-events-out)) + (let ((str (substring yaml--parsing-input beg yaml--parsing-position))) + (when yaml--parsing-store-position + (setq str (propertize str 'yaml-position + (cons (1+ beg) + (1+ yaml--parsing-position))))) + (when (member ,name '("c-l+folded" "c-l+literal")) + (setq str (propertize str 'yaml-n (max 0 n)))) + (list ,name + (if yaml--parsing-store-position + (propertize str 'yaml-position (cons (1+ beg) + (1+ yaml--parsing-position))) + str) + ,res-symbol))) + ((equal res-type 'list) (list ,name ,res-symbol)) + ((equal res-type 'literal) + (substring yaml--parsing-input beg yaml--parsing-position)) + (t ,res-symbol))))))) + +(defun yaml--end-of-stream () + "Return non-nil if the current position is after the end of the document." + (>= yaml--parsing-position (length yaml--parsing-input))) + +(defun yaml--char-at-pos (pos) + "Return the character at POS." + (aref yaml--parsing-input pos)) + +(defun yaml--slice (pos) + "Return the character at POS." + (substring yaml--parsing-input pos)) + +(defun yaml--at-char () + "Return the current character." + (yaml--char-at-pos yaml--parsing-position)) + +(defun yaml--char-match (at &rest chars) + "Return non-nil if AT match any of CHARS." + (if (not chars) + nil + (or (equal at (car chars)) + (apply #'yaml--char-match (cons at (cdr chars)))))) + +(defun yaml--chr (c) + "Try to match the character C." + (if (or (yaml--end-of-stream) (not (equal (yaml--at-char) c))) + nil + (setq yaml--parsing-position (1+ yaml--parsing-position)) + t)) + +(defun yaml--chr-range (min max) + "Return non-nil if the current character is between MIN and MAX." + (if (or (yaml--end-of-stream) (not (<= min (yaml--at-char) max))) + nil + (setq yaml--parsing-position (1+ yaml--parsing-position)) + t)) + +(defun yaml--run-all (&rest funcs) + "Return list of all evaluated FUNCS if all of FUNCS pass." + (let* ((start-pos yaml--parsing-position) + (ress '()) + (break)) + (while (and (not break) funcs) + (let ((res (funcall (car funcs)))) + (when (not res) + (setq break t)) + (setq ress (append ress (list res))) + (setq funcs (cdr funcs)))) + (when break + (setq yaml--parsing-position start-pos)) + (if break nil ress))) + +(defmacro yaml--all (&rest forms) + "Pass and return all forms if all of FORMS pass." + `(yaml--run-all + ,@(mapcar (lambda (form) + `(lambda () ,form)) + forms))) + +(defmacro yaml--any (&rest forms) + "Pass if any of FORMS pass." + (if (= 1 (length forms)) + (car forms) + (let ((start-pos-sym (make-symbol "start")) + (rules-sym (make-symbol "rules")) + (res-sym (make-symbol "res"))) + `(let ((,start-pos-sym yaml--parsing-position) + (,rules-sym ,(cons 'list + (seq-map (lambda (form) `(lambda () ,form)) + forms))) + (,res-sym)) + (while (and (not ,res-sym) ,rules-sym) + (setq ,res-sym (funcall (car ,rules-sym))) + (unless ,res-sym + (setq yaml--parsing-position ,start-pos-sym)) + (setq ,rules-sym (cdr ,rules-sym))) + ,res-sym)))) + +(defmacro yaml--exclude (_) + "Set the excluded characters according to RULE. + +This is currently unimplemented." + ;; NOTE: This is currently not implemented. + 't) + +(defmacro yaml--max (_) + "Automatically pass." + t) + +(defun yaml--empty () + "Return non-nil indicating that empty rule needs nothing to pass." + 't) + +(defun yaml--sub (a b) + "Return A minus B." + (- a b)) + +(defun yaml--match () + "Return the content of the previous sibling completed." + (let* ((states yaml--states) + (res nil)) + (while (and states (not res)) + (let ((top-state (car states))) + (if (yaml--state-end top-state) + (let ((beg (yaml--state-beg top-state)) + (end (yaml--state-end top-state))) + (setq res (substring yaml--parsing-input beg end))) + (setq states (cdr states))))) + res)) + +(defun yaml--auto-detect (n) + "Detect the indentation given N." + (let* ((slice (yaml--slice yaml--parsing-position)) + (match (string-match + "^.*\n\\(\\(?: *\n\\)*\\)\\( *\\)" + slice))) + (if (not match) + 1 + (let ((pre (match-string 1 slice)) + (m (- (length (match-string 2 slice)) n))) + (if (< m 1) + 1 + (when (string-match (format "^.\\{%d\\}." m) pre) + (error "Spaces found after indent in auto-detect (5LLU)")) + m))))) + +(defun yaml--auto-detect-indent (n) + "Detect the indentation given N." + (let* ((pos yaml--parsing-position) + (in-seq (and + (> pos 0) + (yaml--char-match (yaml--char-at-pos (1- pos)) ?\- ?\? ?\:))) + (slice (yaml--slice pos)) + (_ (string-match + "^\\(\\(?: *\\(?:#.*\\)?\n\\)*\\)\\( *\\)" + slice)) + (pre (match-string 1 slice)) + (m (length (match-string 2 slice)))) + (if (and in-seq (= (length pre) 0)) + (when (= n -1) + (setq m (1+ m))) + (setq m (- m n))) + (when (< m 0) + (setq m 0)) + m)) + +(defun yaml--the-end () + "Return non-nil if at the end of input (?)." + (or (>= yaml--parsing-position (length yaml--parsing-input)) + (and (yaml--state-curr-doc) + (yaml--start-of-line) + (string-match + "\\^g\\(?:---|\\.\\.\\.\\)\\([[:blank:]]\\|$\\)" + (substring yaml--parsing-input yaml--parsing-position))))) + +(defun yaml--ord (f) + "Convert an ASCII number returned by F to a number." + (let ((res (funcall f))) + (- (aref res 0) 48))) + +(defun yaml--but (&rest fs) + "Match the first FS but none of the others." + (if (yaml--the-end) + nil + (let ((pos1 yaml--parsing-position)) + (if (not (funcall (car fs))) + nil + (let ((pos2 yaml--parsing-position)) + (setq yaml--parsing-position pos1) + (if (equal ':error (catch 'break + (dolist (f (cdr fs)) + (if (funcall f) + (progn + (setq yaml--parsing-position pos1) + (throw 'break ':error)))))) + nil + (setq yaml--parsing-position pos2) + t)))))) + +(defmacro yaml--rep (min max func) + "Repeat FUNC between MIN and MAX times." + (declare (indent 2)) + `(yaml--rep2 ,min ,max ,func)) + +(defun yaml--rep2 (min max func) + "Repeat FUNC between MIN and MAX times." + (declare (indent 2)) + (if (and max (< max 0)) + nil + (let* ((res-list '()) + (count 0) + (pos yaml--parsing-position) + (pos-start pos) + (break nil)) + (while (and (not break) (or (not max) (< count max))) + (let ((res (funcall func))) + (if (or (not res) (= yaml--parsing-position pos)) + (setq break t) + (setq res-list (cons res res-list)) + (setq count (1+ count)) + (setq pos yaml--parsing-position)))) + (if (and (>= count min) + (or (not max) (<= count max))) + (progn + (setq yaml--parsing-position pos) + (if (zerop count) + t + res-list)) + (setq yaml--parsing-position pos-start) + nil)))) + +(defun yaml--start-of-line () + "Return non-nil if start of line." + (or (= yaml--parsing-position 0) + (>= yaml--parsing-position (length yaml--parsing-input)) + (equal (yaml--char-at-pos (1- yaml--parsing-position)) ?\n))) + +(defun yaml--top () + "Perform top level YAML parsing rule." + (yaml--parse-from-grammar 'l-yaml-stream)) + +(defmacro yaml--set (variable value) + "Set the current state of VARIABLE to VALUE." + (let ((res-sym (make-symbol "res"))) + `(let ((,res-sym ,value)) + (when ,res-sym + (,(cond ((equal "m" (symbol-name variable)) 'yaml--state-set-m) + ((equal "t" (symbol-name variable)) 'yaml--state-set-t)) + ,res-sym) + ,res-sym)))) + +(defmacro yaml--chk (type expr) + "Check if EXPR is non-nil at the parsing position. + +If TYPE is \"<=\" then check at the previous position. If TYPE +is \"!\" ensure that EXPR is nil. Otherwise, if TYPE is \"=\" +then check EXPR at the current position." + (let ((start-symbol (make-symbol "start")) + (ok-symbol (make-symbol "ok"))) + `(let ((,start-symbol yaml--parsing-position) + (_ (when (equal ,type "<=") + (setq yaml--parsing-position (1- yaml--parsing-position)))) + (,ok-symbol (and (>= yaml--parsing-position 0) ,expr))) + (setq yaml--parsing-position ,start-symbol) + (if (equal ,type "!") + (not ,ok-symbol) + ,ok-symbol)))) + +(cl-defun yaml--initialize-parsing-state + (&key (null-object :null) + (false-object :false) + object-type + object-key-type + sequence-type + string-values) + "Initialize state required for parsing according to plist ARGS." + (setq yaml--cache nil) + (setq yaml--object-stack nil) + (setq yaml--state-stack nil) + (setq yaml--root nil) + (setq yaml--anchor-mappings (make-hash-table :test 'equal)) + (setq yaml--resolve-aliases nil) + (setq yaml--parsing-null-object null-object) + (setq yaml--parsing-false-object false-object) + (cond + ((or (not object-type) + (equal object-type 'hash-table)) + (setq yaml--parsing-object-type 'hash-table)) + ((equal 'alist object-type) + (setq yaml--parsing-object-type 'alist)) + ((equal 'plist object-type) + (setq yaml--parsing-object-type 'plist)) + (t (error "Invalid object-type. Must be hash-table, alist, or plist"))) + (cond + ((or (not object-key-type) + (equal 'symbol object-key-type)) + (if (equal 'plist yaml--parsing-object-type) + (setq yaml--parsing-object-key-type 'keyword) + (setq yaml--parsing-object-key-type 'symbol))) + ((equal 'string object-key-type) + (setq yaml--parsing-object-key-type 'string)) + ((equal 'keyword object-key-type) + (setq yaml--parsing-object-key-type 'keyword)) + (t (error "Invalid object-key-type. Must be string, keyword, or symbol"))) + (cond + ((or (not sequence-type) + (equal sequence-type 'array)) + (setq yaml--parsing-sequence-type 'array)) + ((equal 'list sequence-type) + (setq yaml--parsing-sequence-type 'list)) + (t (error "Invalid sequence-type. sequence-type must be list or array"))) + (if string-values + (setq yaml--string-values t) + (setq yaml--string-values nil))) + +(cl-defun yaml-parse-string (string + &key + (null-object :null) + (false-object :false) + object-type + object-key-type + sequence-type + string-values) + "Parse the YAML value in STRING. + +OBJECT-TYPE specifies the Lisp object to use for representing +key-value YAML mappings. Possible values for OBJECT-TYPE are +the symbols `hash-table' (default), `alist', and `plist'. + +OBJECT-KEY-TYPE specifies the Lisp type to use for keys in +key-value YAML mappings. Possible values are the symbols +`string', `symbol', and `keyword'. By default, this is `symbol'; +if OBJECT-TYPE is `plist', the default is `keyword' (and `symbol' +becomes synonym for `keyword'). + +SEQUENCE-TYPE specifies the Lisp object to use for representing +YAML sequences. Possible values for SEQUENCE-TYPE are the symbols +`list', and `array' (default). + +NULL-OBJECT contains the object used to represent the null value. +It defaults to the symbol `:null'. + +FALSE-OBJECT contains the object used to represent the false +value. It defaults to the symbol `:false'." + (yaml--initialize-parsing-state + :null-object null-object + :false-object false-object + :object-type object-type + :object-key-type object-key-type + :sequence-type sequence-type + :string-values string-values) + (let ((res (yaml--parse string + (yaml--top)))) + (when (< yaml--parsing-position (length yaml--parsing-input)) + (error + "Unable to parse YAML. Parser finished before end of input %s/%s" + yaml--parsing-position + (length yaml--parsing-input))) + (when yaml--parse-debug (message "Parsed data: %s" (pp-to-string res))) + (yaml--walk-events res) + (if (hash-table-empty-p yaml--anchor-mappings) + yaml--root + ;; Run event processing twice to resolve aliases. + (let ((yaml--root nil) + (yaml--resolve-aliases t)) + (yaml--walk-events res) + yaml--root)))) + +(defun yaml-parse-tree (string) + "Parse the YAML value in STRING and return its parse tree." + (yaml--initialize-parsing-state) + (let* ((yaml--parsing-store-position t) + (res (yaml--parse string + (yaml--top)))) + (when (< yaml--parsing-position (length yaml--parsing-input)) + (error + "Unable to parse YAML. Parser finished before end of input %s/%s" + yaml--parsing-position + (length yaml--parsing-input))) + res)) + +(defun yaml-parse-string-with-pos (string) + "Parse the YAML value in STRING, storing positions as text properties. + +NOTE: This is an experimental feature and may experience API +changes in the future." + (let ((yaml--parsing-store-position t)) + (yaml-parse-string string + :object-type 'alist + :object-key-type 'string + :string-values t))) + +(defun yaml--parse-from-grammar (state &rest args) + "Parse YAML grammar for given STATE and ARGS. + +Rules for this function are defined by the yaml-spec JSON file." + (pcase state + ('c-flow-sequence + (let ((n (nth 0 args)) + (c (nth 1 args))) + (yaml--frame "c-flow-sequence" + (yaml--all + (yaml--chr ?\[) + (yaml--rep 0 1 + (lambda () (yaml--parse-from-grammar 's-separate n c))) + (yaml--rep 0 1 + (lambda () + (yaml--parse-from-grammar + 'ns-s-flow-seq-entries n + (yaml--parse-from-grammar 'in-flow c)))) + (yaml--chr ?\]))))) + + ('c-indentation-indicator + (let ((m (nth 0 args))) + (yaml--frame "c-indentation-indicator" + (yaml--any (when (yaml--parse-from-grammar 'ns-dec-digit) + (yaml--set m (yaml--ord (lambda () (yaml--match)))) t) + (when (yaml--empty) + (let ((new-m (yaml--auto-detect m))) + (yaml--set m new-m)) + t))))) + + ('ns-reserved-directive + (yaml--frame "ns-reserved-directive" + (yaml--all (yaml--parse-from-grammar 'ns-directive-name) + (yaml--rep2 0 nil + (lambda () + (yaml--all + (yaml--parse-from-grammar 's-separate-in-line) + (yaml--parse-from-grammar 'ns-directive-parameter))))))) + + ('ns-flow-map-implicit-entry + (let ((n (nth 0 args)) + (c (nth 1 args))) + (yaml--frame "ns-flow-map-implicit-entry" + ;; NOTE: I ran into a bug with the order of these rules. It seems + ;; sometimes ns-flow-map-yaml-key-entry succeeds with an empty + ;; when the correct answer should be + ;; c-ns-flow-map-json-key-entry. Changing the order seemed to + ;; have fix this but this seems like a bandage fix. + (yaml--any + (yaml--parse-from-grammar 'c-ns-flow-map-json-key-entry n c) + (yaml--parse-from-grammar 'ns-flow-map-yaml-key-entry n c) + (yaml--parse-from-grammar 'c-ns-flow-map-empty-key-entry n c))))) + + ('ns-esc-double-quote + (yaml--frame "ns-esc-double-quote" + (yaml--chr ?\"))) + + ('c-mapping-start + (yaml--frame "c-mapping-start" (yaml--chr ?\{))) + + ('ns-flow-seq-entry + (let ((n (nth 0 args)) + (c (nth 1 args))) + (yaml--frame "ns-flow-seq-entry" + (yaml--any (yaml--parse-from-grammar 'ns-flow-pair n c) + (yaml--parse-from-grammar 'ns-flow-node n c))))) + + ('l-empty + (let ((n (nth 0 args)) + (c (nth 1 args))) + (yaml--frame "l-empty" + (yaml--all (yaml--any (yaml--parse-from-grammar 's-line-prefix n c) + (yaml--parse-from-grammar 's-indent-lt n)) + (yaml--parse-from-grammar 'b-as-line-feed))))) + + ('c-primary-tag-handle + (yaml--frame "c-primary-tag-handle" (yaml--chr ?\!))) + + ('ns-plain-safe-out + (yaml--frame "ns-plain-safe-out" + (yaml--parse-from-grammar 'ns-char))) + + ('c-ns-shorthand-tag + (yaml--frame "c-ns-shorthand-tag" + (yaml--all + (yaml--parse-from-grammar 'c-tag-handle) + (yaml--rep 1 nil (lambda () (yaml--parse-from-grammar 'ns-tag-char)))))) + + ('nb-ns-single-in-line + (yaml--frame "nb-ns-single-in-line" + (yaml--rep2 0 nil + (lambda () + (yaml--all (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 's-white))) + (yaml--parse-from-grammar 'ns-single-char)))))) + + ('l-strip-empty + (let ((n (nth 0 args))) + (yaml--frame "l-strip-empty" + (yaml--all + (yaml--rep2 0 nil + (lambda () (yaml--all + (yaml--parse-from-grammar 's-indent-le n) + (yaml--parse-from-grammar 'b-non-content)))) + (yaml--rep 0 1 + (lambda () (yaml--parse-from-grammar 'l-trail-comments n))))))) + + ('c-indicator + (yaml--frame "c-indicator" + (yaml--any (yaml--chr ?\-) + (yaml--chr ?\?) + (yaml--chr ?\:) + (yaml--chr ?\,) + (yaml--chr ?\[) + (yaml--chr ?\]) + (yaml--chr ?\{) + (yaml--chr ?\}) + (yaml--chr ?\#) + (yaml--chr ?\&) + (yaml--chr ?\*) + (yaml--chr ?\!) + (yaml--chr ?\|) + (yaml--chr ?\>) + (yaml--chr ?\') + (yaml--chr ?\") + (yaml--chr ?\%) + (yaml--chr ?\@) + (yaml--chr ?\`)))) + + ('c-l+literal + (let ((n (nth 0 args))) + (yaml--frame "c-l+literal" + (progn + (yaml--all + (yaml--chr ?\|) + (yaml--parse-from-grammar 'c-b-block-header n (yaml--state-curr-t)) + (yaml--parse-from-grammar 'l-literal-content + (max (+ n (yaml--state-curr-m)) 1) + (yaml--state-curr-t))))))) + + ('c-single-quoted + (let ((n (nth 0 args)) + (c (nth 1 args))) + (yaml--frame "c-single-quoted" + (yaml--all (yaml--chr ?\') + (yaml--parse-from-grammar 'nb-single-text n c) + (yaml--chr ?\'))))) + + ('c-forbidden + (yaml--frame "c-forbidden" + (yaml--all (yaml--start-of-line) + (yaml--any + (yaml--parse-from-grammar 'c-directives-end) + (yaml--parse-from-grammar 'c-document-end)) + (yaml--any + (yaml--parse-from-grammar 'b-char) + (yaml--parse-from-grammar 's-white) + (yaml--end-of-stream))))) + + ('c-ns-alias-node + (yaml--frame "c-ns-alias-node" + (yaml--all (yaml--chr ?\*) + (yaml--parse-from-grammar 'ns-anchor-name)))) + + ('c-secondary-tag-handle + (yaml--frame "c-secondary-tag-handle" + (yaml--all (yaml--chr ?\!) (yaml--chr ?\!)))) + + ('ns-esc-next-line + (yaml--frame "ns-esc-next-line" (yaml--chr ?N))) + + ('l-nb-same-lines + (let ((n (nth 0 args))) + (yaml--frame "l-nb-same-lines" + (yaml--all + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 'l-empty n "block-in"))) + (yaml--any (yaml--parse-from-grammar 'l-nb-folded-lines n) + (yaml--parse-from-grammar 'l-nb-spaced-lines n)))))) + + ('c-alias + (yaml--frame "c-alias" (yaml--chr ?\*))) + + ('ns-single-char + (yaml--frame "ns-single-char" + (yaml--but (lambda () (yaml--parse-from-grammar 'nb-single-char)) + (lambda () (yaml--parse-from-grammar 's-white))))) + + ('c-l-block-map-implicit-value + (let ((n (nth 0 args))) + (yaml--frame "c-l-block-map-implicit-value" + (yaml--all (yaml--chr ?\:) + (yaml--any + (yaml--parse-from-grammar 's-l+block-node n "block-out") + (yaml--all (yaml--parse-from-grammar 'e-node) + (yaml--parse-from-grammar 's-l-comments))))))) + + ('ns-uri-char + (yaml--frame "ns-uri-char" + (yaml--any (yaml--all (yaml--chr ?\%) + (yaml--parse-from-grammar 'ns-hex-digit) + (yaml--parse-from-grammar 'ns-hex-digit)) + (yaml--parse-from-grammar 'ns-word-char) + (yaml--chr ?\#) + (yaml--chr ?\;) + (yaml--chr ?\/) + (yaml--chr ?\?) + (yaml--chr ?\:) + (yaml--chr ?\@) + (yaml--chr ?\&) + (yaml--chr ?\=) + (yaml--chr ?\+) + (yaml--chr ?\$) + (yaml--chr ?\,) + (yaml--chr ?\_) + (yaml--chr ?\.) + (yaml--chr ?\!) + (yaml--chr ?\~) + (yaml--chr ?\*) + (yaml--chr ?\') + (yaml--chr ?\() + (yaml--chr ?\)) + (yaml--chr ?\[) + (yaml--chr ?\])))) + + ('ns-esc-16-bit + (yaml--frame "ns-esc-16-bit" + (yaml--all (yaml--chr ?u) + (yaml--rep 4 4 + (lambda () (yaml--parse-from-grammar 'ns-hex-digit)))))) + + ('l-nb-spaced-lines + (let ((n (nth 0 args))) + (yaml--frame "l-nb-spaced-lines" + (yaml--all + (yaml--parse-from-grammar 's-nb-spaced-text n) + (yaml--rep2 0 nil + (lambda () (yaml--all + (yaml--parse-from-grammar 'b-l-spaced n) + (yaml--parse-from-grammar 's-nb-spaced-text n)))))))) + + ('ns-plain + (let ((n (nth 0 args)) + (c (nth 1 args))) + (yaml--frame "ns-plain" + (pcase c + ("block-key" (yaml--parse-from-grammar 'ns-plain-one-line c)) + ("flow-in" (yaml--parse-from-grammar 'ns-plain-multi-line n c)) + ("flow-key" (yaml--parse-from-grammar 'ns-plain-one-line c)) + ("flow-out" (yaml--parse-from-grammar 'ns-plain-multi-line n c)))))) + + ('c-printable + (yaml--frame "c-printable" + (yaml--any (yaml--chr ?\x09) + (yaml--chr ?\x0A) + (yaml--chr ?\x0D) + (yaml--chr-range ?\x20 ?\x7E) + (yaml--chr ?\x85) + (yaml--chr-range ?\xA0 ?\xD7FF) + (yaml--chr-range ?\xE000 ?\xFFFD) + (yaml--chr-range ?\x010000 ?\x10FFFF)))) + + ('c-mapping-value + (yaml--frame "c-mapping-value" (yaml--chr ?\:))) + + ('l-nb-literal-text + (let ((n (nth 0 args))) + (yaml--frame "l-nb-literal-text" + (yaml--all + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 'l-empty n "block-in"))) + (yaml--parse-from-grammar 's-indent n) + (yaml--rep 1 nil + (lambda () (yaml--parse-from-grammar 'nb-char))))))) + + ('ns-plain-char + (let ((c (nth 0 args))) + (yaml--frame "ns-plain-char" + (yaml--any + (yaml--but + (lambda () (yaml--parse-from-grammar 'ns-plain-safe c)) + (lambda () (yaml--chr ?\:)) (lambda () (yaml--chr ?\#))) + (yaml--all + (yaml--chk "<=" (yaml--parse-from-grammar 'ns-char)) + (yaml--chr ?\#)) + (yaml--all + (yaml--chr ?\:) + (yaml--chk "=" (yaml--parse-from-grammar 'ns-plain-safe c))))))) + + ('ns-anchor-char + (yaml--frame "ns-anchor-char" + (yaml--but (lambda () (yaml--parse-from-grammar 'ns-char)) + (lambda () (yaml--parse-from-grammar 'c-flow-indicator))))) + + ('s-l+block-scalar + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "s-l+block-scalar" + (yaml--all (yaml--parse-from-grammar 's-separate (+ n 1) c) + (yaml--rep 0 1 + (lambda () + (yaml--all + (yaml--parse-from-grammar 'c-ns-properties (+ n 1) c) + (yaml--parse-from-grammar 's-separate (+ n 1) c)))) + (yaml--any (yaml--parse-from-grammar 'c-l+literal n) + (yaml--parse-from-grammar 'c-l+folded n)))))) + + ('ns-plain-safe-in + (yaml--frame "ns-plain-safe-in" + (yaml--but (lambda () (yaml--parse-from-grammar 'ns-char)) + (lambda () (yaml--parse-from-grammar 'c-flow-indicator))))) + + ('nb-single-text + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "nb-single-text" + (pcase c + ("block-key" (yaml--parse-from-grammar 'nb-single-one-line)) + ("flow-in" (yaml--parse-from-grammar 'nb-single-multi-line n)) + ("flow-key" (yaml--parse-from-grammar 'nb-single-one-line)) + ("flow-out" (yaml--parse-from-grammar 'nb-single-multi-line n)))))) + + ('s-indent-le + (let ((n (nth 0 args))) + (yaml--frame "s-indent-le" + (yaml--all (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 's-space))) + (<= (length (yaml--match)) n))))) + + ('ns-esc-carriage-return + (yaml--frame "ns-esc-carriage-return" (yaml--chr ?r))) + + ('l-chomped-empty + (let ((n (nth 0 args)) + (tt (nth 1 args))) + (yaml--frame "l-chomped-empty" + (pcase tt + ("clip" (yaml--parse-from-grammar 'l-strip-empty n)) + ("keep" (yaml--parse-from-grammar 'l-keep-empty n)) + ("strip" (yaml--parse-from-grammar 'l-strip-empty n)))))) + + ('c-s-implicit-json-key + (let ((c (nth 0 args))) + (yaml--frame "c-s-implicit-json-key" + (yaml--all + (yaml--max 1024) + (yaml--parse-from-grammar 'c-flow-json-node nil c) + (yaml--rep 0 1 + (lambda () (yaml--parse-from-grammar 's-separate-in-line))))))) + + ('b-as-space + (yaml--frame "b-as-space" + (yaml--parse-from-grammar 'b-break))) + + ('ns-s-flow-seq-entries + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "ns-s-flow-seq-entries" + (yaml--all + (yaml--parse-from-grammar 'ns-flow-seq-entry n c) + (yaml--rep 0 1 + (lambda () (yaml--parse-from-grammar 's-separate n c))) + (yaml--rep 0 1 + (lambda () + (yaml--all + (yaml--chr ?\,) + (yaml--rep 0 1 + (lambda () (yaml--parse-from-grammar 's-separate n c))) + (yaml--rep 0 1 + (lambda () + (yaml--parse-from-grammar 'ns-s-flow-seq-entries + n + c)))))))))) + + ('l-block-map-explicit-value + (let ((n (nth 0 args))) + (yaml--frame "l-block-map-explicit-value" + (yaml--all + (yaml--parse-from-grammar 's-indent n) + (yaml--chr ?\:) + (yaml--parse-from-grammar 's-l+block-indented n "block-out"))))) + + ('c-ns-flow-map-json-key-entry + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "c-ns-flow-map-json-key-entry" + (yaml--all + (yaml--parse-from-grammar 'c-flow-json-node n c) + (yaml--any + (yaml--all + (yaml--rep 0 1 + (lambda () (yaml--parse-from-grammar 's-separate n c))) + (yaml--parse-from-grammar 'c-ns-flow-map-adjacent-value n c)) + (yaml--parse-from-grammar 'e-node)))))) + + ('c-sequence-entry + (yaml--frame "c-sequence-entry" (yaml--chr ?\-))) + + ('l-bare-document + (yaml--frame "l-bare-document" + (yaml--all (yaml--exclude "c-forbidden") + (yaml--parse-from-grammar 's-l+block-node -1 "block-in")))) + + ;; TODO: don't use the symbol t as a variable. + ('b-chomped-last + (let ((tt (nth 0 args))) + (yaml--frame "b-chomped-last" + (pcase tt + ("clip" + ;; TODO: Fix this + (yaml--any (yaml--parse-from-grammar 'b-as-line-feed) + (yaml--end-of-stream))) + ("keep" + (yaml--any (yaml--parse-from-grammar 'b-as-line-feed) + (yaml--end-of-stream))) + ("strip" + (yaml--any (yaml--parse-from-grammar 'b-non-content) + (yaml--end-of-stream))))))) + + ('l-trail-comments + (let ((n (nth 0 args))) + (yaml--frame "l-trail-comments" + (yaml--all (yaml--parse-from-grammar 's-indent-lt n) + (yaml--parse-from-grammar 'c-nb-comment-text) + (yaml--parse-from-grammar 'b-comment) + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 'l-comment))))))) + + ('ns-flow-map-yaml-key-entry + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "ns-flow-map-yaml-key-entry" + (yaml--all + (yaml--parse-from-grammar 'ns-flow-yaml-node n c) + (yaml--any + (yaml--all + (yaml--rep 0 1 + (lambda () (yaml--parse-from-grammar 's-separate n c))) + (yaml--parse-from-grammar 'c-ns-flow-map-separate-value n c)) + (yaml--parse-from-grammar 'e-node)))))) + + ('s-indent + (let ((n (nth 0 args))) + (yaml--frame "s-indent" + (yaml--rep n n (lambda () (yaml--parse-from-grammar 's-space)))))) + + ('ns-esc-line-separator + (yaml--frame "ns-esc-line-separator" (yaml--chr ?L))) + + ('ns-flow-yaml-node + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "ns-flow-yaml-node" + (yaml--any + (yaml--parse-from-grammar 'c-ns-alias-node) + (yaml--parse-from-grammar 'ns-flow-yaml-content n c) + (yaml--all + (yaml--parse-from-grammar 'c-ns-properties n c) + (yaml--any + (yaml--all + (yaml--parse-from-grammar 's-separate n c) + (yaml--parse-from-grammar 'ns-flow-yaml-content n c)) + (yaml--parse-from-grammar 'e-scalar))))))) + + ('ns-yaml-version + (yaml--frame "ns-yaml-version" + (yaml--all (yaml--rep 1 nil + (lambda () (yaml--parse-from-grammar 'ns-dec-digit))) + (yaml--chr ?\.) + (yaml--rep 1 nil + (lambda () (yaml--parse-from-grammar 'ns-dec-digit)))))) + + ('c-folded + (yaml--frame "c-folded" (yaml--chr ?\>))) + + ('c-directives-end + (yaml--frame "c-directives-end" + (yaml--all (yaml--chr ?\-) (yaml--chr ?\-) (yaml--chr ?\-)))) + + ('s-double-break + (let ((n (nth 0 args))) + (yaml--frame "s-double-break" + (yaml--any (yaml--parse-from-grammar 's-double-escaped n) + (yaml--parse-from-grammar 's-flow-folded n))))) + + ('s-nb-spaced-text + (let ((n (nth 0 args))) + (yaml--frame "s-nb-spaced-text" + (yaml--all (yaml--parse-from-grammar 's-indent n) + (yaml--parse-from-grammar 's-white) + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 'nb-char))))))) + + ('l-folded-content + (let ((n (nth 0 args)) + (tt (nth 1 args))) + (yaml--frame "l-folded-content" + (yaml--all + (yaml--rep 0 1 + (lambda () + (yaml--all (yaml--parse-from-grammar 'l-nb-diff-lines n) + (yaml--parse-from-grammar 'b-chomped-last tt)))) + (yaml--parse-from-grammar 'l-chomped-empty n tt))))) + + ('nb-ns-plain-in-line + (let ((c (nth 0 args))) + (yaml--frame "nb-ns-plain-in-line" + (yaml--rep2 0 nil + (lambda () (yaml--all + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 's-white))) + (yaml--parse-from-grammar 'ns-plain-char c))))))) + + ('nb-single-multi-line + (let ((n (nth 0 args))) + (yaml--frame "nb-single-multi-line" + (yaml--all + (yaml--parse-from-grammar 'nb-ns-single-in-line) + (yaml--any + (yaml--parse-from-grammar 's-single-next-line n) + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 's-white)))))))) + + ('l-document-suffix + (yaml--frame "l-document-suffix" + (yaml--all (yaml--parse-from-grammar 'c-document-end) + (yaml--parse-from-grammar 's-l-comments)))) + + ('c-sequence-start + (yaml--frame "c-sequence-start" + (yaml--chr ?\[))) + + ('ns-l-block-map-entry + (yaml--frame "ns-l-block-map-entry" + (yaml--any + (yaml--parse-from-grammar 'c-l-block-map-explicit-entry + (nth 0 args)) + (yaml--parse-from-grammar 'ns-l-block-map-implicit-entry + (nth 0 args))))) + + ('ns-l-compact-mapping + (yaml--frame "ns-l-compact-mapping" + (yaml--all + (yaml--parse-from-grammar 'ns-l-block-map-entry (nth 0 args)) + (yaml--rep2 0 nil + (lambda () + (yaml--all + (yaml--parse-from-grammar 's-indent (nth 0 args)) + (yaml--parse-from-grammar 'ns-l-block-map-entry (nth 0 args)))))))) + + ('ns-esc-space + (yaml--frame "ns-esc-space" (yaml--chr ?\x20))) + ('ns-esc-vertical-tab + (yaml--frame "ns-esc-vertical-tab" (yaml--chr ?v))) + + ('ns-s-implicit-yaml-key + (let ((c (nth 0 args))) + (yaml--frame "ns-s-implicit-yaml-key" + (yaml--all + (yaml--max 1024) + (yaml--parse-from-grammar 'ns-flow-yaml-node nil c) + (yaml--rep 0 1 + (lambda () (yaml--parse-from-grammar 's-separate-in-line))))))) + + ('b-l-folded + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "b-l-folded" + (yaml--any (yaml--parse-from-grammar 'b-l-trimmed n c) + (yaml--parse-from-grammar 'b-as-space))))) + + ('s-l+block-collection + (yaml--frame "s-l+block-collection" + (yaml--all + (yaml--rep 0 1 + (lambda () + (yaml--all + (yaml--parse-from-grammar + 's-separate + (+ (nth 0 args) 1) + (nth 1 args)) + (yaml--parse-from-grammar + 'c-ns-properties + (+ (nth 0 args) 1) + (nth 1 args))))) + (yaml--parse-from-grammar 's-l-comments) + (yaml--any + (yaml--parse-from-grammar + 'l+block-sequence + (yaml--parse-from-grammar 'seq-spaces (nth 0 args) (nth 1 args))) + (yaml--parse-from-grammar 'l+block-mapping (nth 0 args)))))) + + ('c-quoted-quote + (yaml--frame "c-quoted-quote" (yaml--all (yaml--chr ?\') (yaml--chr ?\')))) + + ('l+block-sequence + (yaml--frame "l+block-sequence" + ;; NOTE: deviated from the spec example here by making new-m at least 1. + ;; The wording and examples lead me to believe this is how it's done. + ;; ie /* For some fixed auto-detected m > 0 */ + (let ((new-m (max (yaml--auto-detect-indent (nth 0 args)) 1))) + (yaml--all + (yaml--set m new-m) + (yaml--rep 1 nil + (lambda () + (yaml--all + (yaml--parse-from-grammar + 's-indent + (+ (nth 0 args) new-m)) + (yaml--parse-from-grammar + 'c-l-block-seq-entry + (+ (nth 0 args) new-m))))))))) + + ('c-double-quote + (yaml--frame "c-double-quote" + (yaml--chr ?\"))) + + ('ns-esc-backspace + (yaml--frame "ns-esc-backspace" + (yaml--chr ?b))) + + ('c-flow-json-content + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "c-flow-json-content" + (yaml--any (yaml--parse-from-grammar 'c-flow-sequence n c) + (yaml--parse-from-grammar 'c-flow-mapping n c) + (yaml--parse-from-grammar 'c-single-quoted n c) + (yaml--parse-from-grammar 'c-double-quoted n c))))) + + ('c-mapping-end + (yaml--frame "c-mapping-end" (yaml--chr ?\}))) + + ('nb-single-char + (yaml--frame "nb-single-char" + (yaml--any (yaml--parse-from-grammar 'c-quoted-quote) + (yaml--but (lambda () (yaml--parse-from-grammar 'nb-json)) + (lambda () (yaml--chr ?\')))))) + + ('ns-flow-node + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "ns-flow-node" + (yaml--any + (yaml--parse-from-grammar 'c-ns-alias-node) + (yaml--parse-from-grammar 'ns-flow-content n c) + (yaml--all + (yaml--parse-from-grammar 'c-ns-properties n c) + (yaml--any + (yaml--all (yaml--parse-from-grammar 's-separate n c) + (yaml--parse-from-grammar 'ns-flow-content n c)) + (yaml--parse-from-grammar 'e-scalar))))))) + + ('c-non-specific-tag + (yaml--frame "c-non-specific-tag" (yaml--chr ?\!))) + + ('l-directive-document + (yaml--frame "l-directive-document" + (yaml--all (yaml--rep 1 nil + (lambda () (yaml--parse-from-grammar 'l-directive))) + (yaml--parse-from-grammar 'l-explicit-document)))) + + ('c-l-block-map-explicit-entry + (let ((n (nth 0 args))) + (yaml--frame "c-l-block-map-explicit-entry" + (yaml--all + (yaml--parse-from-grammar 'c-l-block-map-explicit-key n) + (yaml--any (yaml--parse-from-grammar 'l-block-map-explicit-value n) + (yaml--parse-from-grammar 'e-node)))))) + + ('e-node + (yaml--frame "e-node" + (yaml--parse-from-grammar 'e-scalar))) + + ('seq-spaces + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "seq-spaces" + (pcase c + ("block-in" n) + ("block-out" (yaml--sub n 1)))))) + + ('l-yaml-stream + (yaml--frame "l-yaml-stream" + (yaml--all + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 'l-document-prefix))) + (yaml--rep 0 1 + (lambda () (yaml--parse-from-grammar 'l-any-document))) + (yaml--rep2 0 nil + (lambda () + (yaml--any + (yaml--all + (yaml--rep 1 nil + (lambda () (yaml--parse-from-grammar 'l-document-suffix))) + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 'l-document-prefix))) + (yaml--rep 0 1 + (lambda () (yaml--parse-from-grammar 'l-any-document)))) + (yaml--all + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 'l-document-prefix))) + (yaml--rep 0 1 + (lambda () + (yaml--parse-from-grammar 'l-explicit-document)))))))))) + + ('nb-double-one-line + (yaml--frame "nb-double-one-line" + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 'nb-double-char))))) + + ('s-l-comments + (yaml--frame "s-l-comments" + (yaml--all (yaml--any + (yaml--parse-from-grammar 's-b-comment) + (yaml--start-of-line)) + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 'l-comment)))))) + + ('nb-char + (yaml--frame "nb-char" + (yaml--but (lambda () (yaml--parse-from-grammar 'c-printable)) + (lambda () (yaml--parse-from-grammar 'b-char)) + (lambda () (yaml--parse-from-grammar 'c-byte-order-mark))))) + + ('ns-plain-first + (let ((c (nth 0 args))) + (yaml--frame "ns-plain-first" + (yaml--any + (yaml--but (lambda () (yaml--parse-from-grammar 'ns-char)) + (lambda () (yaml--parse-from-grammar 'c-indicator))) + (yaml--all + (yaml--any (yaml--chr ?\?) + (yaml--chr ?\:) + (yaml--chr ?\-)) + (yaml--chk "=" (yaml--parse-from-grammar 'ns-plain-safe c))))))) + + ('c-ns-esc-char + (yaml--frame "c-ns-esc-char" + (yaml--all + (yaml--chr ?\\) + (yaml--any (yaml--parse-from-grammar 'ns-esc-null) + (yaml--parse-from-grammar 'ns-esc-bell) + (yaml--parse-from-grammar 'ns-esc-backspace) + (yaml--parse-from-grammar 'ns-esc-horizontal-tab) + (yaml--parse-from-grammar 'ns-esc-line-feed) + (yaml--parse-from-grammar 'ns-esc-vertical-tab) + (yaml--parse-from-grammar 'ns-esc-form-feed) + (yaml--parse-from-grammar 'ns-esc-carriage-return) + (yaml--parse-from-grammar 'ns-esc-escape) + (yaml--parse-from-grammar 'ns-esc-space) + (yaml--parse-from-grammar 'ns-esc-double-quote) + (yaml--parse-from-grammar 'ns-esc-slash) + (yaml--parse-from-grammar 'ns-esc-backslash) + (yaml--parse-from-grammar 'ns-esc-next-line) + (yaml--parse-from-grammar 'ns-esc-non-breaking-space) + (yaml--parse-from-grammar 'ns-esc-line-separator) + (yaml--parse-from-grammar 'ns-esc-paragraph-separator) + (yaml--parse-from-grammar 'ns-esc-8-bit) + (yaml--parse-from-grammar 'ns-esc-16-bit) + (yaml--parse-from-grammar 'ns-esc-32-bit))))) + + ('ns-flow-map-entry + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "ns-flow-map-entry" + (yaml--any + (yaml--all (yaml--chr ?\?) + (yaml--parse-from-grammar 's-separate n c) + (yaml--parse-from-grammar 'ns-flow-map-explicit-entry n c)) + (yaml--parse-from-grammar 'ns-flow-map-implicit-entry n c))))) + + ('l-explicit-document + (yaml--frame "l-explicit-document" + (yaml--all + (yaml--parse-from-grammar 'c-directives-end) + (yaml--any (yaml--parse-from-grammar 'l-bare-document) + (yaml--all (yaml--parse-from-grammar 'e-node) + (yaml--parse-from-grammar 's-l-comments)))))) + + ('s-white + (yaml--frame "s-white" + (yaml--any (yaml--parse-from-grammar 's-space) + (yaml--parse-from-grammar 's-tab)))) + + ('l-keep-empty + (let ((n (nth 0 args))) + (yaml--frame "l-keep-empty" + (yaml--all + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 'l-empty n "block-in"))) + (yaml--rep 0 1 + (lambda () (yaml--parse-from-grammar 'l-trail-comments n))))))) + + ('ns-tag-prefix + (yaml--frame "ns-tag-prefix" + (yaml--any (yaml--parse-from-grammar 'c-ns-local-tag-prefix) + (yaml--parse-from-grammar 'ns-global-tag-prefix)))) + + ('c-l+folded + (let ((n (nth 0 args))) + (yaml--frame "c-l+folded" + (yaml--all + (yaml--chr ?\>) + (yaml--parse-from-grammar 'c-b-block-header + n + (yaml--state-curr-t)) + (yaml--parse-from-grammar 'l-folded-content + (max (+ n (yaml--state-curr-m)) 1) + (yaml--state-curr-t)))))) + + ('ns-directive-name + (yaml--frame "ns-directive-name" + (yaml--rep 1 nil (lambda () (yaml--parse-from-grammar 'ns-char))))) + + ('b-char + (yaml--frame "b-char" + (yaml--any (yaml--parse-from-grammar 'b-line-feed) + (yaml--parse-from-grammar 'b-carriage-return)))) + + ('ns-plain-multi-line + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "ns-plain-multi-line" + (yaml--all + (yaml--parse-from-grammar 'ns-plain-one-line c) + (yaml--rep2 0 nil + (lambda () + (yaml--parse-from-grammar 's-ns-plain-next-line n c))))))) + + ('ns-char + (yaml--frame "ns-char" + (yaml--but (lambda () (yaml--parse-from-grammar 'nb-char)) + (lambda () (yaml--parse-from-grammar 's-white))))) + + ('s-space + (yaml--frame "s-space" (yaml--chr ?\x20))) + + ('c-l-block-seq-entry + (yaml--frame "c-l-block-seq-entry" + (yaml--all (yaml--chr ?\-) + (yaml--chk "!" (yaml--parse-from-grammar 'ns-char)) + (yaml--parse-from-grammar 's-l+block-indented + (nth 0 args) + "block-in")))) + + ('c-ns-properties + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "c-ns-properties" + (yaml--any + (yaml--all + (yaml--parse-from-grammar 'c-ns-tag-property) + (yaml--rep 0 1 + (lambda () + (yaml--all + (yaml--parse-from-grammar 's-separate n c) + (yaml--parse-from-grammar 'c-ns-anchor-property))))) + (yaml--all + (yaml--parse-from-grammar 'c-ns-anchor-property) + (yaml--rep 0 1 + (lambda () (yaml--all + (yaml--parse-from-grammar 's-separate n c) + (yaml--parse-from-grammar 'c-ns-tag-property))))))))) + + ('ns-directive-parameter + (yaml--frame "ns-directive-parameter" + (yaml--rep 1 nil (lambda () (yaml--parse-from-grammar 'ns-char))))) + + ('c-chomping-indicator + (yaml--frame "c-chomping-indicator" + (yaml--any (when (yaml--chr ?\-) (yaml--set t "strip") t) + (when (yaml--chr ?\+) (yaml--set t "keep") t) + (when (yaml--empty) (yaml--set t "clip") t)))) + + ('ns-global-tag-prefix + (yaml--frame "ns-global-tag-prefix" + (yaml--all + (yaml--parse-from-grammar 'ns-tag-char) + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 'ns-uri-char)))))) + + ('c-ns-flow-pair-json-key-entry + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "c-ns-flow-pair-json-key-entry" + (yaml--all + (yaml--parse-from-grammar 'c-s-implicit-json-key "flow-key") + (yaml--parse-from-grammar 'c-ns-flow-map-adjacent-value n c))))) + + ('l-literal-content + (let ((n (nth 0 args)) + (tt (nth 1 args))) + (yaml--frame "l-literal-content" + (yaml--all + (yaml--rep 0 1 + (lambda () + (yaml--all (yaml--parse-from-grammar 'l-nb-literal-text n) + (yaml--rep2 0 nil + (lambda () + (yaml--parse-from-grammar 'b-nb-literal-next n))) + (yaml--parse-from-grammar 'b-chomped-last tt)))) + (yaml--parse-from-grammar 'l-chomped-empty n tt))))) + + ('c-document-end + (yaml--frame "c-document-end" + (yaml--all (yaml--chr ?\.) + (yaml--chr ?\.) + (yaml--chr ?\.)))) + + ('nb-double-text + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "nb-double-text" + (pcase c + ("block-key" (yaml--parse-from-grammar 'nb-double-one-line)) + ("flow-in" (yaml--parse-from-grammar 'nb-double-multi-line n)) + ("flow-key" (yaml--parse-from-grammar 'nb-double-one-line)) + ("flow-out" (yaml--parse-from-grammar 'nb-double-multi-line n)))))) + + ('s-b-comment + (yaml--frame "s-b-comment" + (yaml--all + (yaml--rep 0 1 + (lambda () + (yaml--all + (yaml--parse-from-grammar 's-separate-in-line) + (yaml--rep 0 1 + (lambda () (yaml--parse-from-grammar 'c-nb-comment-text)))))) + (yaml--parse-from-grammar 'b-comment)))) + + ('s-block-line-prefix + (let ((n (nth 0 args))) + (yaml--frame "s-block-line-prefix" + (yaml--parse-from-grammar 's-indent n)))) + + ('c-tag-handle + (yaml--frame "c-tag-handle" + (yaml--any (yaml--parse-from-grammar 'c-named-tag-handle) + (yaml--parse-from-grammar 'c-secondary-tag-handle) + (yaml--parse-from-grammar 'c-primary-tag-handle)))) + + ('ns-plain-one-line + (let ((c (nth 0 args))) + (yaml--frame "ns-plain-one-line" + (yaml--all (yaml--parse-from-grammar 'ns-plain-first c) + (yaml--parse-from-grammar 'nb-ns-plain-in-line c))))) + + ('nb-json + (yaml--frame "nb-json" + (yaml--any (yaml--chr ?\x09) + (yaml--chr-range ?\x20 ?\x10FFFF)))) + + ('s-ns-plain-next-line + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "s-ns-plain-next-line" + (yaml--all (yaml--parse-from-grammar 's-flow-folded n) + (yaml--parse-from-grammar 'ns-plain-char c) + (yaml--parse-from-grammar 'nb-ns-plain-in-line c))))) + + ('c-reserved + (yaml--frame "c-reserved" + (yaml--any (yaml--chr ?\@) (yaml--chr ?\`)))) + + ('b-l-trimmed + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "b-l-trimmed" + (yaml--all + (yaml--parse-from-grammar 'b-non-content) + (yaml--rep 1 nil + (lambda () (yaml--parse-from-grammar 'l-empty n c))))))) + + ('l-document-prefix + (yaml--frame "l-document-prefix" + (yaml--all + (yaml--rep 0 1 + (lambda () (yaml--parse-from-grammar 'c-byte-order-mark))) + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 'l-comment)))))) + + ('c-byte-order-mark + (yaml--frame "c-byte-order-mark" (yaml--chr ?\xFEFF))) + + ('c-anchor + (yaml--frame "c-anchor" (yaml--chr ?\&))) + + ('s-double-escaped + (let ((n (nth 0 args))) + (yaml--frame "s-double-escaped" + (yaml--all + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 's-white))) + (yaml--chr ?\\) + (yaml--parse-from-grammar 'b-non-content) + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 'l-empty n "flow-in"))) + (yaml--parse-from-grammar 's-flow-line-prefix n))))) + + ('ns-esc-32-bit + (yaml--frame "ns-esc-32-bit" + (yaml--all + (yaml--chr ?U) + (yaml--rep 8 8 (lambda () (yaml--parse-from-grammar 'ns-hex-digit)))))) + + + ('b-non-content + (yaml--frame "b-non-content" (yaml--parse-from-grammar 'b-break))) + + ('ns-tag-char + (yaml--frame "ns-tag-char" + (yaml--but (lambda () (yaml--parse-from-grammar 'ns-uri-char)) + (lambda () (yaml--chr ?\!)) + (lambda () (yaml--parse-from-grammar 'c-flow-indicator))))) + + ('b-carriage-return + (yaml--frame "b-carriage-return" (yaml--chr ?\x0D))) + + ('s-double-next-line + (let ((n (nth 0 args))) + (yaml--frame "s-double-next-line" + (yaml--all + (yaml--parse-from-grammar 's-double-break n) + (yaml--rep 0 1 + (lambda () + (yaml--all + (yaml--parse-from-grammar 'ns-double-char) + (yaml--parse-from-grammar 'nb-ns-double-in-line) + (yaml--any + (yaml--parse-from-grammar 's-double-next-line n) + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 's-white))))))))))) + + ('ns-esc-non-breaking-space + (yaml--frame "ns-esc-non-breaking-space" (yaml--chr ?\_))) + + ('l-nb-diff-lines + (let ((n (nth 0 args))) + (yaml--frame "l-nb-diff-lines" + (yaml--all + (yaml--parse-from-grammar 'l-nb-same-lines n) + (yaml--rep2 0 nil + (lambda () + (yaml--all (yaml--parse-from-grammar 'b-as-line-feed) + (yaml--parse-from-grammar 'l-nb-same-lines n)))))))) + + ('s-flow-folded + (let ((n (nth 0 args))) + (yaml--frame "s-flow-folded" + (yaml--all + (yaml--rep 0 1 + (lambda () (yaml--parse-from-grammar 's-separate-in-line))) + (yaml--parse-from-grammar 'b-l-folded n "flow-in") + (yaml--parse-from-grammar 's-flow-line-prefix n))))) + + ('ns-flow-map-explicit-entry + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "ns-flow-map-explicit-entry" + (yaml--any + (yaml--parse-from-grammar 'ns-flow-map-implicit-entry n c) + (yaml--all + (yaml--parse-from-grammar 'e-node) + (yaml--parse-from-grammar 'e-node)))))) + + ('ns-l-block-map-implicit-entry + (yaml--frame "ns-l-block-map-implicit-entry" + (yaml--all + (yaml--any (yaml--parse-from-grammar 'ns-s-block-map-implicit-key) + (yaml--parse-from-grammar 'e-node)) + (yaml--parse-from-grammar 'c-l-block-map-implicit-value (nth 0 args))))) + + ('l-nb-folded-lines + (let ((n (nth 0 args))) + (yaml--frame "l-nb-folded-lines" + (yaml--all + (yaml--parse-from-grammar 's-nb-folded-text n) + (yaml--rep2 0 nil + (lambda () + (yaml--all (yaml--parse-from-grammar 'b-l-folded n "block-in") + (yaml--parse-from-grammar 's-nb-folded-text n)))))))) + + ('c-l-block-map-explicit-key + (let ((n (nth 0 args))) + (yaml--frame "c-l-block-map-explicit-key" + (yaml--all + (yaml--chr ?\?) + (yaml--parse-from-grammar 's-l+block-indented n "block-out"))))) + + ('s-separate + (let ((n (nth 0 args)) + (c (nth 1 args))) + (yaml--frame "s-separate" + (pcase c + ("block-in" (yaml--parse-from-grammar 's-separate-lines n)) + ("block-key" (yaml--parse-from-grammar 's-separate-in-line)) + ("block-out" (yaml--parse-from-grammar 's-separate-lines n)) + ("flow-in" (yaml--parse-from-grammar 's-separate-lines n)) + ("flow-key" (yaml--parse-from-grammar 's-separate-in-line)) + ("flow-out" (yaml--parse-from-grammar 's-separate-lines n)))))) + + ('ns-flow-pair-entry + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "ns-flow-pair-entry" + (yaml--any + (yaml--parse-from-grammar 'ns-flow-pair-yaml-key-entry n c) + (yaml--parse-from-grammar 'c-ns-flow-map-empty-key-entry n c) + (yaml--parse-from-grammar 'c-ns-flow-pair-json-key-entry n c))))) + + ('c-flow-indicator + (yaml--frame "c-flow-indicator" + (yaml--any (yaml--chr ?\,) + (yaml--chr ?\[) + (yaml--chr ?\]) + (yaml--chr ?\{) + (yaml--chr ?\})))) + + ('ns-flow-pair-yaml-key-entry + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "ns-flow-pair-yaml-key-entry" + (yaml--all + (yaml--parse-from-grammar 'ns-s-implicit-yaml-key "flow-key") + (yaml--parse-from-grammar 'c-ns-flow-map-separate-value n c))))) + + ('e-scalar + (yaml--frame "e-scalar" (yaml--empty))) + + ('s-indent-lt + (let ((n (nth 0 args))) + (yaml--frame "s-indent-lt" + (yaml--all + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 's-space))) + (< (length (yaml--match)) n))))) + + ('nb-single-one-line + (yaml--frame "nb-single-one-line" + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 'nb-single-char))))) + + ('c-collect-entry + (yaml--frame "c-collect-entry" (yaml--chr ?\,))) + + ('ns-l-compact-sequence + (let ((n (nth 0 args))) + (yaml--frame "ns-l-compact-sequence" + (yaml--all + (yaml--parse-from-grammar 'c-l-block-seq-entry n) + (yaml--rep2 0 nil + (lambda () + (yaml--all + (yaml--parse-from-grammar 's-indent n) + (yaml--parse-from-grammar 'c-l-block-seq-entry n)))))))) + + ('c-comment + (yaml--frame "c-comment" (yaml--chr ?\#))) + + ('s-line-prefix + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "s-line-prefix" + (pcase c + ("block-in" (yaml--parse-from-grammar 's-block-line-prefix n)) + ("block-out" (yaml--parse-from-grammar 's-block-line-prefix n)) + ("flow-in" (yaml--parse-from-grammar 's-flow-line-prefix n)) + ("flow-out" (yaml--parse-from-grammar 's-flow-line-prefix n)))))) + + ('s-tab + (yaml--frame "s-tab" (yaml--chr ?\x09))) + + ('c-directive + (yaml--frame "c-directive" (yaml--chr ?\%))) + + ('ns-flow-pair + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "ns-flow-pair" + (yaml--any + (yaml--all (yaml--chr ?\?) + (yaml--parse-from-grammar 's-separate n c) + (yaml--parse-from-grammar 'ns-flow-map-explicit-entry n c)) + (yaml--parse-from-grammar 'ns-flow-pair-entry n c))))) + + ('s-l+block-indented + (yaml--frame "s-l+block-indented" + (let ((m (yaml--auto-detect-indent (nth 0 args)))) + (yaml--any + (yaml--all + (yaml--parse-from-grammar 's-indent m) + (yaml--any + (yaml--parse-from-grammar 'ns-l-compact-sequence + (+ (nth 0 args) (+ 1 m))) + (yaml--parse-from-grammar 'ns-l-compact-mapping + (+ (nth 0 args) (+ 1 m))))) + (yaml--parse-from-grammar 's-l+block-node (nth 0 args) (nth 1 args)) + (yaml--all (yaml--parse-from-grammar 'e-node) + (yaml--parse-from-grammar 's-l-comments)))))) + + ('c-single-quote + (yaml--frame "c-single-quote" (yaml--chr ?\'))) + + ('s-flow-line-prefix + (let ((n (nth 0 args))) + (yaml--frame "s-flow-line-prefix" + (yaml--all + (yaml--parse-from-grammar 's-indent n) + (yaml--rep 0 1 + (lambda () (yaml--parse-from-grammar 's-separate-in-line))))))) + + ('nb-double-char + (yaml--frame "nb-double-char" + (yaml--any + (yaml--parse-from-grammar 'c-ns-esc-char) + (yaml--but (lambda () (yaml--parse-from-grammar 'nb-json)) + (lambda () (yaml--chr ?\\)) (lambda () (yaml--chr ?\")))))) + + ('l-comment + (yaml--frame "l-comment" + (yaml--all + (yaml--parse-from-grammar 's-separate-in-line) + (yaml--rep 0 1 + (lambda () (yaml--parse-from-grammar 'c-nb-comment-text))) + (yaml--parse-from-grammar 'b-comment)))) + + ('ns-hex-digit + (yaml--frame "ns-hex-digit" + (yaml--any + (yaml--parse-from-grammar 'ns-dec-digit) + (yaml--chr-range ?\x41 ?\x46) + (yaml--chr-range ?\x61 ?\x66)))) + + ('s-l+flow-in-block + (let ((n (nth 0 args))) + (yaml--frame "s-l+flow-in-block" + (yaml--all + (yaml--parse-from-grammar 's-separate (+ n 1) "flow-out") + (yaml--parse-from-grammar 'ns-flow-node (+ n 1) "flow-out") + (yaml--parse-from-grammar 's-l-comments))))) + + ('c-flow-json-node + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "c-flow-json-node" + (yaml--all + (yaml--rep 0 1 + (lambda () + (yaml--all + (yaml--parse-from-grammar 'c-ns-properties n c) + (yaml--parse-from-grammar 's-separate n c)))) + (yaml--parse-from-grammar 'c-flow-json-content n c))))) + + ('c-b-block-header + (let ((m (nth 0 args)) + (tt (nth 1 args))) + (yaml--frame "c-b-block-header" + (yaml--all + (yaml--any + (and (not (string-match "\\`[-+][0-9]" + (yaml--slice yaml--parsing-position))) + ;; hack to not match this case if there is a number. + (yaml--all + (yaml--parse-from-grammar 'c-indentation-indicator m) + (yaml--parse-from-grammar 'c-chomping-indicator tt))) + (yaml--all + (yaml--parse-from-grammar 'c-chomping-indicator tt) + (yaml--parse-from-grammar 'c-indentation-indicator m))) + (yaml--parse-from-grammar 's-b-comment))))) + + ('ns-esc-8-bit + (yaml--frame "ns-esc-8-bit" + (yaml--all (yaml--chr ?x) + (yaml--rep 2 2 + (lambda () (yaml--parse-from-grammar 'ns-hex-digit)))))) + + ('ns-anchor-name + (yaml--frame "ns-anchor-name" + (yaml--rep 1 nil + (lambda () (yaml--parse-from-grammar 'ns-anchor-char))))) + + ('ns-esc-slash + (yaml--frame "ns-esc-slash" (yaml--chr ?\/))) + + ('s-nb-folded-text + (let ((n (nth 0 args))) + (yaml--frame "s-nb-folded-text" + (yaml--all (yaml--parse-from-grammar 's-indent n) + (yaml--parse-from-grammar 'ns-char) + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 'nb-char))))))) + + ('ns-word-char + (yaml--frame "ns-word-char" + (yaml--any (yaml--parse-from-grammar 'ns-dec-digit) + (yaml--parse-from-grammar 'ns-ascii-letter) + (yaml--chr ?\-)))) + + ('ns-esc-form-feed + (yaml--frame "ns-esc-form-feed" (yaml--chr ?f))) + + ('ns-s-block-map-implicit-key + (yaml--frame "ns-s-block-map-implicit-key" + (yaml--any + (yaml--parse-from-grammar 'c-s-implicit-json-key "block-key") + (yaml--parse-from-grammar 'ns-s-implicit-yaml-key "block-key")))) + + ('ns-esc-null (yaml--frame "ns-esc-null" (yaml--chr ?\0))) + + ('c-ns-tag-property + (yaml--frame "c-ns-tag-property" + (yaml--any (yaml--parse-from-grammar 'c-verbatim-tag) + (yaml--parse-from-grammar 'c-ns-shorthand-tag) + (yaml--parse-from-grammar 'c-non-specific-tag)))) + + ('c-ns-local-tag-prefix + (yaml--frame "c-ns-local-tag-prefix" + (yaml--all + (yaml--chr ?\!) + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 'ns-uri-char)))))) + + ('ns-tag-directive + (yaml--frame "ns-tag-directive" + (yaml--all (yaml--chr ?T) (yaml--chr ?A) (yaml--chr ?G) + (yaml--parse-from-grammar 's-separate-in-line) + (yaml--parse-from-grammar 'c-tag-handle) + (yaml--parse-from-grammar 's-separate-in-line) + (yaml--parse-from-grammar 'ns-tag-prefix)))) + + ('c-flow-mapping + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "c-flow-mapping" + (yaml--all + (yaml--chr ?\{) + (yaml--rep 0 1 + (lambda () (yaml--parse-from-grammar 's-separate n c))) + (yaml--rep 0 1 + (lambda () + (yaml--parse-from-grammar 'ns-s-flow-map-entries + n + (yaml--parse-from-grammar 'in-flow c)))) + (yaml--chr ?\}))))) + + ('ns-double-char + (yaml--frame "ns-double-char" + (yaml--but (lambda () (yaml--parse-from-grammar 'nb-double-char)) + (lambda () (yaml--parse-from-grammar 's-white))))) + + ('ns-ascii-letter + (yaml--frame "ns-ascii-letter" + (yaml--any (yaml--chr-range ?\x41 ?\x5A) + (yaml--chr-range ?\x61 ?\x7A)))) + + ('b-break + (yaml--frame "b-break" + (yaml--any (yaml--all (yaml--parse-from-grammar 'b-carriage-return) + (yaml--parse-from-grammar 'b-line-feed)) + (yaml--parse-from-grammar 'b-carriage-return) + (yaml--parse-from-grammar 'b-line-feed)))) + + ('nb-ns-double-in-line + (yaml--frame "nb-ns-double-in-line" + (yaml--rep2 0 nil + (lambda () + (yaml--all + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 's-white))) + (yaml--parse-from-grammar 'ns-double-char)))))) + + ('s-l+block-node + (yaml--frame "s-l+block-node" + (yaml--any + (yaml--parse-from-grammar 's-l+block-in-block (nth 0 args) (nth 1 args)) + (yaml--parse-from-grammar 's-l+flow-in-block (nth 0 args))))) + + ('ns-esc-bell + (yaml--frame "ns-esc-bell" (yaml--chr ?a))) + + ('c-named-tag-handle + (yaml--frame "c-named-tag-handle" + (yaml--all + (yaml--chr ?\!) + (yaml--rep 1 nil (lambda () (yaml--parse-from-grammar 'ns-word-char))) + (yaml--chr ?\!)))) + + ('s-separate-lines + (let ((n (nth 0 args))) + (yaml--frame "s-separate-lines" + (yaml--any (yaml--all (yaml--parse-from-grammar 's-l-comments) + (yaml--parse-from-grammar 's-flow-line-prefix n)) + (yaml--parse-from-grammar 's-separate-in-line))))) + + ('l-directive + (yaml--frame "l-directive" + (yaml--all (yaml--chr ?\%) + (yaml--any (yaml--parse-from-grammar 'ns-yaml-directive) + (yaml--parse-from-grammar 'ns-tag-directive) + (yaml--parse-from-grammar 'ns-reserved-directive)) + (yaml--parse-from-grammar 's-l-comments)))) + + ('ns-esc-escape + (yaml--frame "ns-esc-escape" (yaml--chr ?e))) + + ('b-nb-literal-next + (let ((n (nth 0 args))) + (yaml--frame "b-nb-literal-next" + (yaml--all (yaml--parse-from-grammar 'b-as-line-feed) + (yaml--parse-from-grammar 'l-nb-literal-text n))))) + + ('ns-s-flow-map-entries + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "ns-s-flow-map-entries" + (yaml--all + (yaml--parse-from-grammar 'ns-flow-map-entry n c) + (yaml--rep 0 1 (lambda () (yaml--parse-from-grammar 's-separate n c))) + (yaml--rep 0 1 + (lambda () + (yaml--all + (yaml--chr ?\,) + (yaml--rep 0 1 + (lambda () (yaml--parse-from-grammar 's-separate n c))) + (yaml--rep 0 1 + (lambda () + (yaml--parse-from-grammar 'ns-s-flow-map-entries + n + c)))))))))) + + ('c-nb-comment-text + (yaml--frame "c-nb-comment-text" + (yaml--all + (yaml--chr ?\#) + (yaml--rep2 0 nil (lambda () (yaml--parse-from-grammar 'nb-char)))))) + + ('ns-dec-digit + (yaml--frame "ns-dec-digit" + (yaml--chr-range ?\x30 ?\x39))) + + ('ns-yaml-directive + (yaml--frame "ns-yaml-directive" + (yaml--all (yaml--chr ?Y) (yaml--chr ?A) (yaml--chr ?M) (yaml--chr ?L) + (yaml--parse-from-grammar 's-separate-in-line) + (yaml--parse-from-grammar 'ns-yaml-version)))) + + ('c-mapping-key + (yaml--frame "c-mapping-key" (yaml--chr ?\?))) + + ('b-as-line-feed + (yaml--frame "b-as-line-feed" + (yaml--parse-from-grammar 'b-break))) + + ('s-l+block-in-block + (yaml--frame "s-l+block-in-block" + (yaml--any + (yaml--parse-from-grammar 's-l+block-scalar + (nth 0 args) + (nth 1 args)) + (yaml--parse-from-grammar 's-l+block-collection + (nth 0 args) + (nth 1 args))))) + + ('ns-esc-paragraph-separator + (yaml--frame "ns-esc-paragraph-separator" (yaml--chr ?P))) + + ('c-double-quoted + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "c-double-quoted" + (yaml--all (yaml--chr ?\") + (yaml--parse-from-grammar 'nb-double-text n c) + (yaml--chr ?\"))))) + + ('b-line-feed + (yaml--frame "b-line-feed" (yaml--chr ?\x0A))) + + ('ns-esc-horizontal-tab + (yaml--frame "ns-esc-horizontal-tab" + (yaml--any (yaml--chr ?t) (yaml--chr ?\x09)))) + + ('c-ns-flow-map-empty-key-entry + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "c-ns-flow-map-empty-key-entry" + (yaml--all + (yaml--parse-from-grammar 'e-node) + (yaml--parse-from-grammar 'c-ns-flow-map-separate-value n c))))) + + ('l-any-document + (yaml--frame "l-any-document" + (yaml--any (yaml--parse-from-grammar 'l-directive-document) + (yaml--parse-from-grammar 'l-explicit-document) + (yaml--parse-from-grammar 'l-bare-document)))) + + ('c-tag (yaml--frame "c-tag" (yaml--chr ?\!))) + + ('c-escape (yaml--frame "c-escape" (yaml--chr ?\\))) + + ('c-sequence-end (yaml--frame "c-sequence-end" (yaml--chr ?\]))) + + ('l+block-mapping + (yaml--frame "l+block-mapping" + (let ((new-m (yaml--auto-detect-indent (nth 0 args)))) + (if (= 0 new-m) + nil ;; For some fixed auto-detected m > 0 ;; Is this right??? + (yaml--all + (yaml--set m new-m) + (yaml--rep 1 nil + (lambda () + (yaml--all + (yaml--parse-from-grammar 's-indent + (+ (nth 0 args) new-m)) + (yaml--parse-from-grammar 'ns-l-block-map-entry + (+ (nth 0 args) new-m)))))))))) + + ('c-ns-flow-map-adjacent-value + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "c-ns-flow-map-adjacent-value" + (yaml--all + (yaml--chr ?\:) + (yaml--any + (yaml--all + (yaml--rep 0 1 + (lambda () (yaml--parse-from-grammar 's-separate n c))) + (yaml--parse-from-grammar 'ns-flow-node n c)) + (yaml--parse-from-grammar 'e-node)))))) + + ('s-single-next-line + (let ((n (nth 0 args))) + (yaml--frame "s-single-next-line" + (yaml--all + (yaml--parse-from-grammar 's-flow-folded n) + (yaml--rep 0 1 + (lambda () + (yaml--all + (yaml--parse-from-grammar 'ns-single-char) + (yaml--parse-from-grammar 'nb-ns-single-in-line) + (yaml--any + (yaml--parse-from-grammar 's-single-next-line n) + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 's-white))))))))))) + + ('s-separate-in-line + (yaml--frame "s-separate-in-line" + (yaml--any (yaml--rep 1 nil + (lambda () (yaml--parse-from-grammar 's-white))) + (yaml--start-of-line)))) + + ('b-comment + (yaml--frame "b-comment" + (yaml--any (yaml--parse-from-grammar 'b-non-content) + (yaml--end-of-stream)))) + + ('ns-esc-backslash + (yaml--frame "ns-esc-backslash" (yaml--chr ?\\))) + + ('c-ns-anchor-property + (yaml--frame "c-ns-anchor-property" + (yaml--all (yaml--chr ?\&) + (yaml--parse-from-grammar 'ns-anchor-name)))) + + ('ns-plain-safe + (let ((c (nth 0 args))) + (yaml--frame "ns-plain-safe" + (pcase c + ("block-key" (yaml--parse-from-grammar 'ns-plain-safe-out)) + ("flow-in" (yaml--parse-from-grammar 'ns-plain-safe-in)) + ("flow-key" (yaml--parse-from-grammar 'ns-plain-safe-in)) + ("flow-out" (yaml--parse-from-grammar 'ns-plain-safe-out)))))) + + ('ns-flow-content + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "ns-flow-content" + (yaml--any (yaml--parse-from-grammar 'ns-flow-yaml-content n c) + (yaml--parse-from-grammar 'c-flow-json-content n c))))) + + ('c-ns-flow-map-separate-value + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "c-ns-flow-map-separate-value" + (yaml--all + (yaml--chr ?\:) + (yaml--chk "!" (yaml--parse-from-grammar 'ns-plain-safe c)) + (yaml--any (yaml--all (yaml--parse-from-grammar 's-separate n c) + (yaml--parse-from-grammar 'ns-flow-node n c)) + (yaml--parse-from-grammar 'e-node)))))) + + ('in-flow + (let ((c (nth 0 args))) + (yaml--frame "in-flow" + (pcase c + ("block-key" "flow-key") + ("flow-in" "flow-in") + ("flow-key" "flow-key") + ("flow-out" "flow-in"))))) + + ('c-verbatim-tag + (yaml--frame "c-verbatim-tag" + (yaml--all + (yaml--chr ?\!) + (yaml--chr ?\<) + (yaml--rep 1 nil (lambda () (yaml--parse-from-grammar 'ns-uri-char))) + (yaml--chr ?\>)))) + + ('c-literal + (yaml--frame "c-literal" (yaml--chr ?\|))) + + ('ns-esc-line-feed + (yaml--frame "ns-esc-line-feed" (yaml--chr ?n))) + + ('nb-double-multi-line + (let ((n (nth 0 args))) + (yaml--frame "nb-double-multi-line" + (yaml--all + (yaml--parse-from-grammar 'nb-ns-double-in-line) + (yaml--any (yaml--parse-from-grammar 's-double-next-line n) + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 's-white)))))))) + + ('b-l-spaced + (let ((n (nth 0 args))) + (yaml--frame "b-l-spaced" + (yaml--all + (yaml--parse-from-grammar 'b-as-line-feed) + (yaml--rep2 0 nil + (lambda () (yaml--parse-from-grammar 'l-empty n "block-in"))))))) + + ('ns-flow-yaml-content + (let ((n (nth 0 args)) (c (nth 1 args))) + (yaml--frame "ns-flow-yaml-content" + (yaml--parse-from-grammar 'ns-plain n c)))) + (_ (error "Unknown parsing grammar state: %s %s" state args)))) + +;;; Encoding + +(defun yaml-encode (object) + "Encode OBJECT to a YAML string." + (with-temp-buffer + (yaml--encode-object object 0) + (goto-char (point-min)) + (while (looking-at-p "\n") + (delete-char 1)) + (buffer-string))) + +(defun yaml--encode-object (object indent &optional auto-indent) + "Encode a Lisp OBJECT to YAML. + +INDENT indicates how deeply nested the object will be displayed +in the YAML. If AUTO-INDENT is non-nil, then emit the object +without first inserting a newline." + (cond + ((yaml--scalarp object) (yaml--encode-scalar object)) + ((hash-table-p object) (yaml--encode-hash-table object indent auto-indent)) + ((listp object) (yaml--encode-list object indent auto-indent)) + ((arrayp object) (yaml--encode-array object indent auto-indent)) + (t (error "Unknown object %s" object)))) + +(defun yaml--scalarp (object) + "Return non-nil if OBJECT correlates to a YAML scalar." + (or (numberp object) + (symbolp object) + (stringp object) + (not object))) + +(defun yaml--encode-escape-string (s) + "Escape yaml special characters in string S." + (let* ((s (replace-regexp-in-string "\\\\" "\\\\" s)) + (s (replace-regexp-in-string "\n" "\\\\n" s)) + (s (replace-regexp-in-string "\t" "\\\\t" s)) + (s (replace-regexp-in-string "\r" "\\\\r" s)) + (s (replace-regexp-in-string "\"" "\\\\\"" s))) + s)) + +(defun yaml--encode-array (a indent &optional auto-indent) + "Encode array A to a string in the context of being INDENT deep. + +If AUTO-INDENT is non-nil, start the list on the current line, +auto-detecting the indentation. Functionality defers to +`yaml--encode-list'." + (yaml--encode-list (seq-map #'identity a) + indent + auto-indent)) + + +(defun yaml--encode-scalar (s) + "Encode scalar S to buffer." + (cond + ((not s) (insert "null")) + ((eql t s) (insert "true")) + ((symbolp s) + (cond + ((eql s :null) (insert "null")) + ((eql s :false) (insert "false")) + (t (insert (symbol-name s))))) + ((numberp s) (insert (number-to-string s))) + ((stringp s) + (if (string-match "\\`[-_a-zA-Z0-9]+\\'" s) + (insert s) + (insert "\"" (yaml--encode-escape-string s) "\""))))) + +(defun yaml--alist-to-hash-table (l) + "Return hash representation of L if it is an alist, nil otherwise." + (when (and (listp l) + (seq-every-p (lambda (x) (and (consp x) (atom (car x)))) l)) + (let ((h (make-hash-table))) + (seq-map (lambda (cpair) + (let* ((k (car cpair)) + (v (alist-get k l))) + (puthash k v h))) + l) + h))) + +(defun yaml--encode-list (l indent &optional auto-indent) + "Encode list L to a string in the context of being INDENT deep. + +If AUTO-INDENT is non-nil, start the list on the current line, +auto-detecting the indentation" + (let ((ht (yaml--alist-to-hash-table l))) + (cond (ht + (yaml--encode-hash-table ht indent auto-indent)) + ((zerop (length l)) + (insert "[]")) + ((seq-every-p #'yaml--scalarp l) + (insert "[") + (yaml--encode-object (car l) 0) + (seq-do (lambda (object) + (insert ", ") + (yaml--encode-object object 0)) + (cdr l)) + (insert "]")) + (t + (when (zerop indent) + (setq indent 2)) + (let* ((first t) + (indent-string (make-string (- indent 2) ?\s))) + (seq-do + (lambda (object) + (if (not first) + (insert "\n" indent-string "- ") + (if auto-indent + (let ((curr-indent (yaml--encode-auto-detect-indent))) + (insert (make-string (- indent curr-indent) ?\s) "- ")) + (insert "\n" indent-string "- ")) + (setq first nil)) + (if (or (hash-table-p object) + (yaml--alist-to-hash-table object)) + (yaml--encode-object object indent t) + (yaml--encode-object object (+ indent 2) nil))) + l)))))) + +(defun yaml--encode-auto-detect-indent () + "Return the amount of indentation at current place in encoding." + (length (thing-at-point 'line))) + +(defun yaml--encode-hash-table (m indent &optional auto-indent) + "Encode hash table M to a string in the context of being INDENT deep. + +If AUTO-INDENT is non-nil, auto-detect the indent on the current +line and insert accordingly." + (cond ((zerop (hash-table-size m)) + (insert "{}")) + (t + (let ((first t) + (indent-string (make-string indent ?\s))) + (maphash + (lambda (k v) + (if (not first) + (insert "\n" indent-string) + (if auto-indent + (let ((curr-indent (yaml--encode-auto-detect-indent))) + (when (> curr-indent indent) + (setq indent (+ curr-indent 1))) + (insert (make-string (- indent curr-indent) ?\s))) + (insert "\n" indent-string)) + (setq first nil)) + (yaml--encode-object k indent nil) + (insert ": ") + (yaml--encode-object v (+ indent 2))) + m))))) + +(provide 'yaml) + +;;; yaml.el ends here diff --git a/elpa/yaml-mode-20230714.440/yaml-mode-autoloads.el b/elpa/yaml-mode-20230714.440/yaml-mode-autoloads.el deleted file mode 100644 index ac6dee22..00000000 --- a/elpa/yaml-mode-20230714.440/yaml-mode-autoloads.el +++ /dev/null @@ -1,39 +0,0 @@ -;;; yaml-mode-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "yaml-mode" "yaml-mode.el" (0 0 0 0)) -;;; Generated autoloads from yaml-mode.el - -(let ((loads (get 'yaml 'custom-loads))) (if (member '"yaml-mode" loads) nil (put 'yaml 'custom-loads (cons '"yaml-mode" loads)))) - -(autoload 'yaml-mode "yaml-mode" "\ -Simple mode to edit YAML. - -\\{yaml-mode-map} - -\(fn)" t nil) - -(add-to-list 'auto-mode-alist '("\\.\\(e?ya?\\|ra\\)ml\\'" . yaml-mode)) - -(add-to-list 'magic-mode-alist '("^%YAML\\s-+[0-9]+\\.[0-9]+\\(\\s-+#\\|\\s-*$\\)" . yaml-mode)) - -(register-definition-prefixes "yaml-mode" '("yaml-")) - -;;;*** - -;;;### (autoloads nil nil ("yaml-mode-pkg.el") (0 0 0 0)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; yaml-mode-autoloads.el ends here diff --git a/elpa/yaml-mode-20230714.440/yaml-mode-pkg.el b/elpa/yaml-mode-20230714.440/yaml-mode-pkg.el deleted file mode 100644 index c2eff04e..00000000 --- a/elpa/yaml-mode-20230714.440/yaml-mode-pkg.el +++ /dev/null @@ -1,15 +0,0 @@ -(define-package "yaml-mode" "20230714.440" "Major mode for editing YAML files" - '((emacs "24.1")) - :commit "13728b4b1b1bd33d3a754236a0f23e4c76d6ba91" :authors - '(("Yoshiki Kurihara" . "clouder@gmail.com") - ("Marshall T. Vandegrift" . "llasram@gmail.com")) - :maintainers - '(("Vasilij Schneidermann" . "mail@vasilij.de")) - :maintainer - '("Vasilij Schneidermann" . "mail@vasilij.de") - :keywords - '("data" "yaml") - :url "https://github.com/yoshiki/yaml-mode") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/yaml-mode-20230714.440/yaml-mode.el b/elpa/yaml-mode-20230714.440/yaml-mode.el deleted file mode 100644 index d3c1da8e..00000000 --- a/elpa/yaml-mode-20230714.440/yaml-mode.el +++ /dev/null @@ -1,489 +0,0 @@ -;;; yaml-mode.el --- Major mode for editing YAML files -*- lexical-binding: t -*- - -;; Copyright (C) 2010-2014 Yoshiki Kurihara - -;; Author: Yoshiki Kurihara -;; Marshall T. Vandegrift -;; Maintainer: Vasilij Schneidermann -;; URL: https://github.com/yoshiki/yaml-mode -;; Package-Requires: ((emacs "24.1")) -;; Keywords: data yaml -;; Version: 0.0.15 - -;; This file is not part of Emacs - -;; 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 . - -;;; Commentary: - -;; This is a major mode for editing files in the YAML data -;; serialization format. It was initially developed by Yoshiki -;; Kurihara and many features were added by Marshall Vandegrift. As -;; YAML and Python share the fact that indentation determines -;; structure, this mode provides indentation and indentation command -;; behavior very similar to that of python-mode. - -;;; Installation: - -;; To install, just drop this file into a directory in your -;; `load-path' and (optionally) byte-compile it. To automatically -;; handle files ending in '.yml', add something like: -;; -;; (require 'yaml-mode) -;; (add-to-list 'auto-mode-alist '("\\.yml\\'" . yaml-mode)) -;; -;; to your .emacs file. -;; -;; Unlike python-mode, this mode follows the Emacs convention of not -;; binding the ENTER key to `newline-and-indent'. To get this -;; behavior, add the key definition to `yaml-mode-hook': -;; -;; (add-hook 'yaml-mode-hook -;; '(lambda () -;; (define-key yaml-mode-map "\C-m" 'newline-and-indent))) - -;;; Known Bugs: - -;; YAML is easy to write but complex to parse, and this mode doesn't -;; even really try. Indentation and highlighting will break on -;; abnormally complicated structures. - -;;; Code: - - -;; User definable variables - -;;;###autoload -(defgroup yaml nil - "Support for the YAML serialization format" - :group 'languages - :prefix "yaml-") - -(defcustom yaml-mode-hook nil - "*Hook run by `yaml-mode'." - :type 'hook - :group 'yaml) - -(defcustom yaml-indent-offset 2 - "*Amount of offset per level of indentation." - :type 'integer - :safe 'natnump - :group 'yaml) - -(defcustom yaml-backspace-function 'backward-delete-char-untabify - "*Function called by `yaml-electric-backspace' when deleting backwards. -It will receive one argument, the numeric prefix value." - :type 'function - :group 'yaml) - -(defcustom yaml-block-literal-search-lines 100 - "*Maximum number of lines to search for start of block literals." - :type 'integer - :group 'yaml) - -(defcustom yaml-block-literal-electric-alist - '((?| . "") (?> . "-")) - "*Characters for which to provide electric behavior. -The association list key should be a key code and the associated value -should be a string containing additional characters to insert when -that key is pressed to begin a block literal." - :type 'alist - :group 'yaml) - -(defface yaml-tab-face - '((((class color)) (:background "red" :foreground "red" :bold t)) - (t (:reverse-video t))) - "Face to use for highlighting tabs in YAML files." - :group 'faces - :group 'yaml) - -(defcustom yaml-imenu-generic-expression - '((nil "^\\(:?[a-zA-Z_-]+\\):" 1)) - "The imenu regex to parse an outline of the yaml file." - :type 'string - :group 'yaml) - - -;; Constants - -(defconst yaml-mode-version "0.0.15" "Version of `yaml-mode'.") - -(defconst yaml-blank-line-re "^ *$" - "Regexp matching a line containing only (valid) whitespace.") - -(defconst yaml-directive-re "^\\(?:--- \\)? *%\\(\\w+\\)" - "Regexp matching a line containing a YAML directive.") - -(defconst yaml-document-delimiter-re "^\\(?:---\\|[.][.][.]\\)" - "Rexexp matching a YAML document delimiter line.") - -(defconst yaml-node-anchor-alias-re "[&*][a-zA-Z0-9_-]+" - "Regexp matching a YAML node anchor or alias.") - -(defconst yaml-tag-re "!!?[^ \n]+" - "Rexexp matching a YAML tag.") - -(defconst yaml-bare-scalar-re - "\\(?:[^-:,#!\n{\\[ ]\\|[^#!\n{\\[ ]\\S-\\)[^#\n]*?" - "Rexexp matching a YAML bare scalar.") - -(defconst yaml-hash-key-re - (concat "\\(?:^\\(?:--- \\)?\\|{\\|\\(?:[-,] +\\)+\\) *" - "\\(?:" yaml-tag-re " +\\)?" - "\\(" yaml-bare-scalar-re "\\) *:" - "\\(?: +\\|$\\)") - "Regexp matching a single YAML hash key.") - -(defconst yaml-scalar-context-re - (concat "\\(?:^\\(?:--- \\)?\\|{\\|\\(?: *[-,] +\\)+\\) *" - "\\(?:" yaml-bare-scalar-re " *: \\)?") - "Regexp indicating the beginning of a scalar context.") - -(defconst yaml-nested-map-re - (concat "[^#\n]*: *\\(?:&.*\\|{ *\\|" yaml-tag-re " *\\)?$") - "Regexp matching a line beginning a YAML nested structure.") - -(defconst yaml-block-literal-base-re " *[>|][-+0-9]* *\\(?:\n\\|\\'\\)" - "Regexp matching the substring start of a block literal.") - -(defconst yaml-block-literal-re - (concat yaml-scalar-context-re - "\\(?:" yaml-tag-re "\\)?" - yaml-block-literal-base-re) - "Regexp matching a line beginning a YAML block literal.") - -(defconst yaml-nested-sequence-re - (concat "^\\(?:\\(?: *- +\\)+\\|\\(:? *-$\\)\\)" - "\\(?:" yaml-bare-scalar-re " *:\\(?: +.*\\)?\\)?$") - "Regexp matching a line containing one or more nested YAML sequences.") - -(defconst yaml-constant-scalars-re - (concat "\\(?:^\\|\\(?::\\|-\\|,\\|{\\|\\[\\) +\\) *" - (regexp-opt - '("~" "null" "Null" "NULL" - ".nan" ".NaN" ".NAN" - ".inf" ".Inf" ".INF" - "-.inf" "-.Inf" "-.INF" - "y" "Y" "yes" "Yes" "YES" "n" "N" "no" "No" "NO" - "true" "True" "TRUE" "false" "False" "FALSE" - "on" "On" "ON" "off" "Off" "OFF") t) - "\\_>") - "Regexp matching certain scalar constants in scalar context.") - - -;; Mode setup - -(defvar yaml-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "|" 'yaml-electric-bar-and-angle) - (define-key map ">" 'yaml-electric-bar-and-angle) - (define-key map "-" 'yaml-electric-dash-and-dot) - (define-key map "." 'yaml-electric-dash-and-dot) - (define-key map (kbd "DEL") 'yaml-electric-backspace) - map) - "Keymap used in `yaml-mode' buffers.") - -(defvar yaml-mode-syntax-table - (let ((syntax-table (make-syntax-table))) - (modify-syntax-entry ?\' "\"" syntax-table) - (modify-syntax-entry ?\" "\"" syntax-table) - (modify-syntax-entry ?# "<" syntax-table) - (modify-syntax-entry ?\n ">" syntax-table) - (modify-syntax-entry ?\\ "\\" syntax-table) - (modify-syntax-entry ?- "_" syntax-table) - (modify-syntax-entry ?_ "_" syntax-table) - (modify-syntax-entry ?& "." syntax-table) - (modify-syntax-entry ?* "." syntax-table) - (modify-syntax-entry ?\( "." syntax-table) - (modify-syntax-entry ?\) "." syntax-table) - (modify-syntax-entry ?\{ "(}" syntax-table) - (modify-syntax-entry ?\} "){" syntax-table) - (modify-syntax-entry ?\[ "(]" syntax-table) - (modify-syntax-entry ?\] ")[" syntax-table) - syntax-table) - "Syntax table in use in `yaml-mode' buffers.") - -;;;###autoload -(define-derived-mode yaml-mode text-mode "YAML" - "Simple mode to edit YAML. - -\\{yaml-mode-map}" - :syntax-table yaml-mode-syntax-table - (set (make-local-variable 'comment-start) "# ") - (set (make-local-variable 'comment-start-skip) "#+ *") - (set (make-local-variable 'indent-line-function) 'yaml-indent-line) - (set (make-local-variable 'indent-tabs-mode) nil) - (set (make-local-variable 'fill-paragraph-function) 'yaml-fill-paragraph) - - (set (make-local-variable 'syntax-propertize-function) - 'yaml-mode-syntax-propertize-function) - (setq font-lock-defaults '(yaml-font-lock-keywords))) - - -;; Font-lock support - -(defvar yaml-font-lock-keywords - `((yaml-font-lock-block-literals 0 font-lock-string-face) - (,yaml-constant-scalars-re . (1 font-lock-constant-face)) - (,yaml-tag-re . (0 font-lock-type-face)) - (,yaml-node-anchor-alias-re . (0 font-lock-function-name-face)) - (,yaml-hash-key-re . (1 font-lock-variable-name-face)) - (,yaml-document-delimiter-re . (0 font-lock-comment-face)) - (,yaml-directive-re . (1 font-lock-builtin-face)) - ("^[\t]+" 0 'yaml-tab-face t)) - "Additional expressions to highlight in YAML mode.") - -(defun yaml-mode-syntax-propertize-function (beg end) - "Override buffer's syntax table for special syntactic constructs." - ;; Unhighlight foo#bar tokens between BEG and END. - (save-excursion - (goto-char beg) - (while (search-forward "#" end t) - (save-excursion - (forward-char -1) - ;; both ^# and [ \t]# are comments - (when (and (not (bolp)) - (not (memq (preceding-char) '(?\s ?\t)))) - (put-text-property (point) (1+ (point)) - 'syntax-table (string-to-syntax "_")))))) - - (save-excursion - (goto-char beg) - (while (and - (> end (point)) - (re-search-forward "['\"]" end t)) - (when (get-text-property (point) 'yaml-block-literal) - (put-text-property (1- (point)) (point) - 'syntax-table (string-to-syntax "w"))) - (let* ((pt (point)) - (sps (save-excursion (syntax-ppss (1- pt))))) - (when (not (nth 8 sps)) - (cond - ((and (char-equal ?' (char-before (1- pt))) - (char-equal ?' (char-before pt))) - (put-text-property (- pt 2) pt - 'syntax-table (string-to-syntax "w")) - ;; Workaround for https://debbugs.gnu.org/41195. - (let ((syntax-propertize--done syntax-propertize--done)) - ;; Carefully invalidate the last cached ppss. - (syntax-ppss-flush-cache (- pt 2)))) - ;; If quote is detected as a syntactic string start but appeared - ;; after a non-whitespace character, then mark it as syntactic word. - ((and (char-before (1- pt)) - (char-equal ?w (char-syntax (char-before (1- pt))))) - (put-text-property (1- pt) pt - 'syntax-table (string-to-syntax "w"))) - (t - ;; We're right after a quote that opens a string literal. - ;; Skip over it (big speedup for long JSON strings). - (goto-char (1- pt)) - (condition-case nil - (forward-sexp) - (scan-error - (goto-char end)))))))))) - -(defun yaml-font-lock-block-literals (bound) - "Find lines within block literals. -Find the next line of the first (if any) block literal after point and -prior to BOUND. Returns the beginning and end of the block literal -line in the match data, as consumed by `font-lock-keywords' matcher -functions. The function begins by searching backwards to determine -whether or not the current line is within a block literal. This could -be time-consuming in large buffers, so the number of lines searched is -artificially limited to the value of -`yaml-block-literal-search-lines'." - (if (eolp) (goto-char (1+ (point)))) - (unless (or (eobp) (>= (point) bound)) - (let ((begin (point)) - (end (min (1+ (line-end-position)) bound))) - (goto-char (line-beginning-position)) - (while (and (looking-at yaml-blank-line-re) - (not (bobp))) - (forward-line -1)) - (let ((nlines yaml-block-literal-search-lines) - (min-level (current-indentation))) - (forward-line -1) - (while (and (/= nlines 0) - (/= min-level 0) - (not (looking-at yaml-block-literal-re)) - (not (bobp))) - (setq nlines (1- nlines)) - (unless (looking-at yaml-blank-line-re) - (setq min-level (min min-level (current-indentation)))) - (forward-line -1)) - (when (looking-at-p " *- ") - (setq min-level (- min-level 2))) - (cond - ((and (< (current-indentation) min-level) - (looking-at yaml-block-literal-re)) - (goto-char end) - (put-text-property begin end 'yaml-block-literal t) - (set-match-data (list begin end)) - t) - ((progn - (goto-char begin) - (re-search-forward (concat yaml-block-literal-re - " *\\(.*\\)\n") - bound t)) - (let ((range (nthcdr 2 (match-data)))) - (put-text-property (car range) (cadr range) 'yaml-block-literal t) - (set-match-data range)) - t)))))) - - -;; Indentation and electric keys - -(defun yaml-compute-indentation () - "Calculate the maximum sensible indentation for the current line." - (save-excursion - (beginning-of-line) - (if (looking-at yaml-document-delimiter-re) 0 - (forward-line -1) - (while (and (looking-at yaml-blank-line-re) - (> (point) (point-min))) - (forward-line -1)) - (+ (current-indentation) - (if (looking-at yaml-nested-map-re) yaml-indent-offset 0) - (if (looking-at yaml-nested-sequence-re) yaml-indent-offset 0) - (if (looking-at yaml-block-literal-re) yaml-indent-offset 0))))) - -(defun yaml-indent-line () - "Indent the current line. -The first time this command is used, the line will be indented to the -maximum sensible indentation. Each immediately subsequent usage will -back-dent the line by `yaml-indent-offset' spaces. On reaching column -0, it will cycle back to the maximum sensible indentation." - (interactive "*") - (let ((ci (current-indentation)) - (need (yaml-compute-indentation))) - (save-excursion - (if (and (equal last-command this-command) (/= ci 0)) - (indent-line-to (* (/ (- ci 1) yaml-indent-offset) yaml-indent-offset)) - (indent-line-to need))) - (if (< (current-column) (current-indentation)) - (forward-to-indentation 0)))) - -(defun yaml-electric-backspace (arg) - "Delete characters or back-dent the current line. -If invoked following only whitespace on a line, will back-dent to the -immediately previous multiple of `yaml-indent-offset' spaces." - (interactive "*p") - (if (or (/= (current-indentation) (current-column)) (bolp)) - (funcall yaml-backspace-function arg) - (let ((ci (current-column))) - (beginning-of-line) - (delete-horizontal-space) - (indent-to (* (/ (- ci (* arg yaml-indent-offset)) - yaml-indent-offset) - yaml-indent-offset))))) - -(defun yaml-electric-bar-and-angle (arg) - "Insert the bound key and possibly begin a block literal. -Inserts the bound key. If inserting the bound key causes the current -line to match the initial line of a block literal, then inserts the -matching string from `yaml-block-literal-electric-alist', a newline, -and indents appropriately." - (interactive "*P") - (self-insert-command (prefix-numeric-value arg)) - (let ((extra-chars - (assoc last-command-event - yaml-block-literal-electric-alist))) - (cond - ((and extra-chars (not arg) (eolp) - (save-excursion - (beginning-of-line) - (looking-at yaml-block-literal-re))) - (insert (cdr extra-chars)) - (newline-and-indent))))) - -(defun yaml-electric-dash-and-dot (arg) - "Insert the bound key and possibly de-dent line. -Inserts the bound key. If inserting the bound key causes the current -line to match a document delimiter, de-dent the line to the left -margin." - (interactive "*P") - (self-insert-command (prefix-numeric-value arg)) - (save-excursion - (beginning-of-line) - (when (and (not arg) (looking-at yaml-document-delimiter-re)) - (delete-horizontal-space)))) - -(defun yaml-narrow-to-block-literal () - "Narrow the buffer to block literal if the point is in it, -otherwise do nothing." - (interactive) - (save-excursion - (goto-char (line-beginning-position)) - (while (and (looking-at-p yaml-blank-line-re) (not (bobp))) - (forward-line -1)) - (let ((nlines yaml-block-literal-search-lines) - (min-level (current-indentation)) - beg) - (forward-line -1) - (while (and (/= nlines 0) - (/= min-level 0) - (not (looking-at-p yaml-block-literal-re)) - (not (bobp))) - (setq nlines (1- nlines)) - (unless (looking-at-p yaml-blank-line-re) - (setq min-level (min min-level (current-indentation)))) - (forward-line -1)) - (when (and (< (current-indentation) min-level) - (looking-at-p yaml-block-literal-re)) - (setq min-level (current-indentation)) - (forward-line) - (setq beg (point)) - (while (and (not (eobp)) - (or (looking-at-p yaml-blank-line-re) - (> (current-indentation) min-level))) - (forward-line)) - (narrow-to-region beg (point)))))) - -(defun yaml-fill-paragraph (&optional justify region) - "Fill paragraph. -Outside of comments, this behaves as `fill-paragraph' except that -filling does not cross boundaries of block literals. Inside comments, -this will do usual adaptive fill behaviors." - (interactive "*P") - (save-restriction - (yaml-narrow-to-block-literal) - (let ((fill-paragraph-function nil)) - (or (fill-comment-paragraph justify) - (fill-paragraph justify region))))) - -(defun yaml-set-imenu-generic-expression () - (make-local-variable 'imenu-generic-expression) - (make-local-variable 'imenu-create-index-function) - (setq imenu-create-index-function 'imenu-default-create-index-function) - (setq imenu-generic-expression yaml-imenu-generic-expression)) - -(add-hook 'yaml-mode-hook 'yaml-set-imenu-generic-expression) - - -(defun yaml-mode-version () - "Display version of `yaml-mode'." - (interactive) - (message "yaml-mode %s" yaml-mode-version) - yaml-mode-version) - -;;;###autoload -(add-to-list 'auto-mode-alist '("\\.\\(e?ya?\\|ra\\)ml\\'" . yaml-mode)) - -;;;###autoload -(add-to-list 'magic-mode-alist - '("^%YAML\\s-+[0-9]+\\.[0-9]+\\(\\s-+#\\|\\s-*$\\)" . yaml-mode)) - -(provide 'yaml-mode) - -;;; yaml-mode.el ends here diff --git a/elpa/yaml-mode-20241003.153/yaml-mode-autoloads.el b/elpa/yaml-mode-20241003.153/yaml-mode-autoloads.el new file mode 100644 index 00000000..953e1f9b --- /dev/null +++ b/elpa/yaml-mode-20241003.153/yaml-mode-autoloads.el @@ -0,0 +1,37 @@ +;;; yaml-mode-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) + + + +;;; Generated autoloads from yaml-mode.el + +(let ((loads (get 'yaml 'custom-loads))) (if (member '"yaml-mode" loads) nil (put 'yaml 'custom-loads (cons '"yaml-mode" loads)) (put 'languages 'custom-loads (cons 'yaml (get 'languages 'custom-loads))))) +(autoload 'yaml-mode "yaml-mode" "\ +Simple mode to edit YAML. + +\\{yaml-mode-map} + +(fn)" t) +(add-to-list 'auto-mode-alist '("\\.\\(e?ya?\\|ra\\)ml\\'" . yaml-mode)) +(add-to-list 'magic-mode-alist '("^%YAML\\s-+[0-9]+\\.[0-9]+\\(\\s-+#\\|\\s-*$\\)" . yaml-mode)) +(register-definition-prefixes "yaml-mode" '("yaml-")) + +;;; End of scraped data + +(provide 'yaml-mode-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; no-native-compile: t +;; coding: utf-8-emacs-unix +;; End: + +;;; yaml-mode-autoloads.el ends here diff --git a/elpa/yaml-mode-20241003.153/yaml-mode-pkg.el b/elpa/yaml-mode-20241003.153/yaml-mode-pkg.el new file mode 100644 index 00000000..3c3a53a7 --- /dev/null +++ b/elpa/yaml-mode-20241003.153/yaml-mode-pkg.el @@ -0,0 +1,11 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "yaml-mode" "20241003.153" + "Major mode for editing YAML files." + '((emacs "24.1")) + :url "https://github.com/yoshiki/yaml-mode" + :commit "d91f878729312a6beed77e6637c60497c5786efa" + :revdesc "d91f87872931" + :keywords '("data" "yaml") + :authors '(("Yoshiki Kurihara" . "clouder@gmail.com") + ("Marshall T. Vandegrift" . "llasram@gmail.com")) + :maintainers '(("Vasilij Schneidermann" . "mail@vasilij.de"))) diff --git a/elpa/yaml-mode-20241003.153/yaml-mode.el b/elpa/yaml-mode-20241003.153/yaml-mode.el new file mode 100644 index 00000000..721a49f9 --- /dev/null +++ b/elpa/yaml-mode-20241003.153/yaml-mode.el @@ -0,0 +1,492 @@ +;;; yaml-mode.el --- Major mode for editing YAML files -*- lexical-binding: t -*- + +;; Copyright (C) 2010-2014 Yoshiki Kurihara + +;; Author: Yoshiki Kurihara +;; Marshall T. Vandegrift +;; Maintainer: Vasilij Schneidermann +;; URL: https://github.com/yoshiki/yaml-mode +;; Package-Requires: ((emacs "24.1")) +;; Keywords: data yaml +;; Package-Version: 20241003.153 +;; Package-Revision: d91f87872931 + +;; This file is not part of Emacs + +;; 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 . + +;;; Commentary: + +;; This is a major mode for editing files in the YAML data +;; serialization format. It was initially developed by Yoshiki +;; Kurihara and many features were added by Marshall Vandegrift. As +;; YAML and Python share the fact that indentation determines +;; structure, this mode provides indentation and indentation command +;; behavior very similar to that of python-mode. + +;;; Installation: + +;; To install, just drop this file into a directory in your +;; `load-path' and (optionally) byte-compile it. To automatically +;; handle files ending in '.yml', add something like: +;; +;; (require 'yaml-mode) +;; (add-to-list 'auto-mode-alist '("\\.yml\\'" . yaml-mode)) +;; +;; to your .emacs file. +;; +;; Unlike python-mode, this mode follows the Emacs convention of not +;; binding the ENTER key to `newline-and-indent'. To get this +;; behavior, add the key definition to `yaml-mode-hook': +;; +;; (add-hook 'yaml-mode-hook +;; '(lambda () +;; (define-key yaml-mode-map "\C-m" 'newline-and-indent))) + +;;; Known Bugs: + +;; YAML is easy to write but complex to parse, and this mode doesn't +;; even really try. Indentation and highlighting will break on +;; abnormally complicated structures. + +;;; Code: + + +;; User definable variables + +;;;###autoload +(defgroup yaml nil + "Support for the YAML serialization format" + :group 'languages + :prefix "yaml-") + +(defcustom yaml-mode-hook nil + "*Hook run by `yaml-mode'." + :type 'hook + :group 'yaml) + +(defcustom yaml-indent-offset 2 + "*Amount of offset per level of indentation." + :type 'integer + :safe 'natnump + :group 'yaml) + +(defcustom yaml-backspace-function 'backward-delete-char-untabify + "*Function called by `yaml-electric-backspace' when deleting backwards. +It will receive one argument, the numeric prefix value." + :type 'function + :group 'yaml) + +(defcustom yaml-block-literal-search-lines 100 + "*Maximum number of lines to search for start of block literals." + :type 'integer + :group 'yaml) + +(defcustom yaml-block-literal-electric-alist + '((?| . "") (?> . "-")) + "*Characters for which to provide electric behavior. +The association list key should be a key code and the associated value +should be a string containing additional characters to insert when +that key is pressed to begin a block literal." + :type 'alist + :group 'yaml) + +(defface yaml-tab-face + '((((class color)) (:background "red" :foreground "red" :bold t)) + (t (:inverse-video t))) + "Face to use for highlighting tabs in YAML files." + :group 'faces + :group 'yaml) + +(defcustom yaml-imenu-generic-expression + '((nil "^\\(:?[a-zA-Z_-]+\\):" 1)) + "The imenu regex to parse an outline of the yaml file." + :type 'string + :group 'yaml) + + +;; Constants + +(defconst yaml-mode-version "0.0.15" "Version of `yaml-mode'.") + +(defconst yaml-blank-line-re "^ *$" + "Regexp matching a line containing only (valid) whitespace.") + +(defconst yaml-directive-re "^\\(?:--- \\)? *%\\(\\w+\\)" + "Regexp matching a line containing a YAML directive.") + +(defconst yaml-document-delimiter-re "^\\(?:---\\|[.][.][.]\\)" + "Rexexp matching a YAML document delimiter line.") + +(defconst yaml-node-anchor-alias-re "[&*][a-zA-Z0-9_-]+" + "Regexp matching a YAML node anchor or alias.") + +(defconst yaml-tag-re "!!?[^ \n]+" + "Rexexp matching a YAML tag.") + +(defconst yaml-bare-scalar-re + "\\(?:[^-:,#!\n{\\[ ]\\|[^#!\n{\\[ ]\\S-\\)[^#\n]*?" + "Rexexp matching a YAML bare scalar.") + +(defconst yaml-hash-key-re + (concat "\\(?:^\\(?:--- \\)?\\|{\\|\\(?:[-,] +\\)+\\) *" + "\\(?:" yaml-tag-re " +\\)?" + "\\(" yaml-bare-scalar-re "\\) *:" + "\\(?: +\\|$\\)") + "Regexp matching a single YAML hash key.") + +(defconst yaml-scalar-context-re + (concat "\\(?:^\\(?:--- \\)?\\|{\\|\\(?: *[-,] +\\)+\\) *" + "\\(?:" yaml-bare-scalar-re " *: \\)?") + "Regexp indicating the beginning of a scalar context.") + +(defconst yaml-nested-map-re + (concat "[^#\n]*: *\\(?:&.*\\|{ *\\|" yaml-tag-re " *\\)?$") + "Regexp matching a line beginning a YAML nested structure.") + +(defconst yaml-block-literal-base-re " *[>|][-+0-9]* *\\(?:\n\\|\\'\\)" + "Regexp matching the substring start of a block literal.") + +(defconst yaml-block-literal-re + (concat yaml-scalar-context-re + "\\(?:" yaml-tag-re "\\)?" + yaml-block-literal-base-re) + "Regexp matching a line beginning a YAML block literal.") + +(defconst yaml-nested-sequence-re + (concat "^\\(?:\\(?: *- +\\)+\\|\\(:? *-$\\)\\)" + "\\(?:" yaml-bare-scalar-re " *:\\(?: +.*\\)?\\)?$") + "Regexp matching a line containing one or more nested YAML sequences.") + +(defconst yaml-constant-scalars-re + (concat "\\(?:^\\|\\(?::\\|-\\|,\\|{\\|\\[\\) +\\) *" + (regexp-opt + '("~" "null" "Null" "NULL" + ".nan" ".NaN" ".NAN" + ".inf" ".Inf" ".INF" + "-.inf" "-.Inf" "-.INF" + "y" "Y" "yes" "Yes" "YES" "n" "N" "no" "No" "NO" + "true" "True" "TRUE" "false" "False" "FALSE" + "on" "On" "ON" "off" "Off" "OFF") t) + "\\_>") + "Regexp matching certain scalar constants in scalar context.") + + +;; Mode setup + +(defvar yaml-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "|" 'yaml-electric-bar-and-angle) + (define-key map ">" 'yaml-electric-bar-and-angle) + (define-key map "-" 'yaml-electric-dash-and-dot) + (define-key map "." 'yaml-electric-dash-and-dot) + (define-key map (kbd "DEL") 'yaml-electric-backspace) + map) + "Keymap used in `yaml-mode' buffers.") + +(defvar yaml-mode-syntax-table + (let ((syntax-table (make-syntax-table))) + (modify-syntax-entry ?\' "\"" syntax-table) + (modify-syntax-entry ?\" "\"" syntax-table) + (modify-syntax-entry ?# "<" syntax-table) + (modify-syntax-entry ?\n ">" syntax-table) + (modify-syntax-entry ?\\ "\\" syntax-table) + (modify-syntax-entry ?- "_" syntax-table) + (modify-syntax-entry ?_ "_" syntax-table) + (modify-syntax-entry ?& "." syntax-table) + (modify-syntax-entry ?* "." syntax-table) + (modify-syntax-entry ?\( "." syntax-table) + (modify-syntax-entry ?\) "." syntax-table) + (modify-syntax-entry ?\{ "(}" syntax-table) + (modify-syntax-entry ?\} "){" syntax-table) + (modify-syntax-entry ?\[ "(]" syntax-table) + (modify-syntax-entry ?\] ")[" syntax-table) + syntax-table) + "Syntax table in use in `yaml-mode' buffers.") + +;;;###autoload +(define-derived-mode yaml-mode text-mode "YAML" + "Simple mode to edit YAML. + +\\{yaml-mode-map}" + :syntax-table yaml-mode-syntax-table + (set (make-local-variable 'comment-start) "# ") + (set (make-local-variable 'comment-start-skip) "#+ *") + (set (make-local-variable 'comment-end) "") + (set (make-local-variable 'indent-line-function) 'yaml-indent-line) + (set (make-local-variable 'indent-tabs-mode) nil) + (set (make-local-variable 'fill-paragraph-function) 'yaml-fill-paragraph) + (set (make-local-variable 'page-delimiter) "^---\\([ \t].*\\)*\n") + + (set (make-local-variable 'syntax-propertize-function) + 'yaml-mode-syntax-propertize-function) + (setq font-lock-defaults '(yaml-font-lock-keywords))) + + +;; Font-lock support + +(defvar yaml-font-lock-keywords + `((yaml-font-lock-block-literals 0 font-lock-string-face) + (,yaml-constant-scalars-re . (1 font-lock-constant-face)) + (,yaml-tag-re . (0 font-lock-type-face)) + (,yaml-node-anchor-alias-re . (0 font-lock-function-name-face)) + (,yaml-hash-key-re . (1 font-lock-variable-name-face)) + (,yaml-document-delimiter-re . (0 font-lock-comment-face)) + (,yaml-directive-re . (1 font-lock-builtin-face)) + ("^[\t]+" 0 'yaml-tab-face t)) + "Additional expressions to highlight in YAML mode.") + +(defun yaml-mode-syntax-propertize-function (beg end) + "Override buffer's syntax table for special syntactic constructs." + ;; Unhighlight foo#bar tokens between BEG and END. + (save-excursion + (goto-char beg) + (while (search-forward "#" end t) + (save-excursion + (forward-char -1) + ;; both ^# and [ \t]# are comments + (when (and (not (bolp)) + (not (memq (preceding-char) '(?\s ?\t)))) + (put-text-property (point) (1+ (point)) + 'syntax-table (string-to-syntax "_")))))) + + (save-excursion + (goto-char beg) + (while (and + (> end (point)) + (re-search-forward "['\"]" end t)) + (when (get-text-property (point) 'yaml-block-literal) + (put-text-property (1- (point)) (point) + 'syntax-table (string-to-syntax "w"))) + (let* ((pt (point)) + (sps (save-excursion (syntax-ppss (1- pt))))) + (when (not (nth 8 sps)) + (cond + ((and (char-equal ?' (char-before (1- pt))) + (char-equal ?' (char-before pt))) + (put-text-property (- pt 2) pt + 'syntax-table (string-to-syntax "w")) + ;; Workaround for https://debbugs.gnu.org/41195. + (let ((syntax-propertize--done syntax-propertize--done)) + ;; Carefully invalidate the last cached ppss. + (syntax-ppss-flush-cache (- pt 2)))) + ;; If quote is detected as a syntactic string start but appeared + ;; after a non-whitespace character, then mark it as syntactic word. + ((and (char-before (1- pt)) + (char-equal ?w (char-syntax (char-before (1- pt))))) + (put-text-property (1- pt) pt + 'syntax-table (string-to-syntax "w"))) + (t + ;; We're right after a quote that opens a string literal. + ;; Skip over it (big speedup for long JSON strings). + (goto-char (1- pt)) + (condition-case nil + (forward-sexp) + (scan-error + (goto-char end)))))))))) + +(defun yaml-font-lock-block-literals (bound) + "Find lines within block literals. +Find the next line of the first (if any) block literal after point and +prior to BOUND. Returns the beginning and end of the block literal +line in the match data, as consumed by `font-lock-keywords' matcher +functions. The function begins by searching backwards to determine +whether or not the current line is within a block literal. This could +be time-consuming in large buffers, so the number of lines searched is +artificially limited to the value of +`yaml-block-literal-search-lines'." + (if (eolp) (goto-char (1+ (point)))) + (unless (or (eobp) (>= (point) bound)) + (let ((begin (point)) + (end (min (1+ (line-end-position)) bound))) + (goto-char (line-beginning-position)) + (while (and (looking-at yaml-blank-line-re) + (not (bobp))) + (forward-line -1)) + (let ((nlines yaml-block-literal-search-lines) + (min-level (current-indentation))) + (forward-line -1) + (while (and (/= nlines 0) + (/= min-level 0) + (not (looking-at yaml-block-literal-re)) + (not (bobp))) + (setq nlines (1- nlines)) + (unless (looking-at yaml-blank-line-re) + (setq min-level (min min-level (current-indentation)))) + (forward-line -1)) + (when (looking-at-p " *- ") + (setq min-level (- min-level 2))) + (cond + ((and (< (current-indentation) min-level) + (looking-at yaml-block-literal-re)) + (goto-char end) + (put-text-property begin end 'yaml-block-literal t) + (set-match-data (list begin end)) + t) + ((progn + (goto-char begin) + (re-search-forward (concat yaml-block-literal-re + " *\\(.*\\)\n") + bound t)) + (let ((range (nthcdr 2 (match-data)))) + (put-text-property (car range) (cadr range) 'yaml-block-literal t) + (set-match-data range)) + t)))))) + + +;; Indentation and electric keys + +(defun yaml-compute-indentation () + "Calculate the maximum sensible indentation for the current line." + (save-excursion + (beginning-of-line) + (if (looking-at yaml-document-delimiter-re) 0 + (forward-line -1) + (while (and (looking-at yaml-blank-line-re) + (> (point) (point-min))) + (forward-line -1)) + (+ (current-indentation) + (if (looking-at yaml-nested-map-re) yaml-indent-offset 0) + (if (looking-at yaml-nested-sequence-re) yaml-indent-offset 0) + (if (looking-at yaml-block-literal-re) yaml-indent-offset 0))))) + +(defun yaml-indent-line () + "Indent the current line. +The first time this command is used, the line will be indented to the +maximum sensible indentation. Each immediately subsequent usage will +back-dent the line by `yaml-indent-offset' spaces. On reaching column +0, it will cycle back to the maximum sensible indentation." + (interactive "*") + (let ((ci (current-indentation)) + (need (yaml-compute-indentation))) + (save-excursion + (if (and (equal last-command this-command) (/= ci 0)) + (indent-line-to (* (/ (- ci 1) yaml-indent-offset) yaml-indent-offset)) + (indent-line-to need))) + (if (< (current-column) (current-indentation)) + (forward-to-indentation 0)))) + +(defun yaml-electric-backspace (arg) + "Delete characters or back-dent the current line. +If invoked following only whitespace on a line, will back-dent to the +immediately previous multiple of `yaml-indent-offset' spaces." + (interactive "*p") + (if (or (/= (current-indentation) (current-column)) (bolp)) + (funcall yaml-backspace-function arg) + (let ((ci (current-column))) + (beginning-of-line) + (delete-horizontal-space) + (indent-to (* (/ (- ci (* arg yaml-indent-offset)) + yaml-indent-offset) + yaml-indent-offset))))) + +(defun yaml-electric-bar-and-angle (arg) + "Insert the bound key and possibly begin a block literal. +Inserts the bound key. If inserting the bound key causes the current +line to match the initial line of a block literal, then inserts the +matching string from `yaml-block-literal-electric-alist', a newline, +and indents appropriately." + (interactive "*P") + (self-insert-command (prefix-numeric-value arg)) + (let ((extra-chars + (assoc last-command-event + yaml-block-literal-electric-alist))) + (cond + ((and extra-chars (not arg) (eolp) + (save-excursion + (beginning-of-line) + (looking-at yaml-block-literal-re))) + (insert (cdr extra-chars)) + (newline-and-indent))))) + +(defun yaml-electric-dash-and-dot (arg) + "Insert the bound key and possibly de-dent line. +Inserts the bound key. If inserting the bound key causes the current +line to match a document delimiter, de-dent the line to the left +margin." + (interactive "*P") + (self-insert-command (prefix-numeric-value arg)) + (save-excursion + (beginning-of-line) + (when (and (not arg) (looking-at yaml-document-delimiter-re)) + (delete-horizontal-space)))) + +(defun yaml-narrow-to-block-literal () + "Narrow the buffer to block literal if the point is in it, +otherwise do nothing." + (interactive) + (save-excursion + (goto-char (line-beginning-position)) + (while (and (looking-at-p yaml-blank-line-re) (not (bobp))) + (forward-line -1)) + (let ((nlines yaml-block-literal-search-lines) + (min-level (current-indentation)) + beg) + (forward-line -1) + (while (and (/= nlines 0) + (/= min-level 0) + (not (looking-at-p yaml-block-literal-re)) + (not (bobp))) + (setq nlines (1- nlines)) + (unless (looking-at-p yaml-blank-line-re) + (setq min-level (min min-level (current-indentation)))) + (forward-line -1)) + (when (and (< (current-indentation) min-level) + (looking-at-p yaml-block-literal-re)) + (setq min-level (current-indentation)) + (forward-line) + (setq beg (point)) + (while (and (not (eobp)) + (or (looking-at-p yaml-blank-line-re) + (> (current-indentation) min-level))) + (forward-line)) + (narrow-to-region beg (point)))))) + +(defun yaml-fill-paragraph (&optional justify region) + "Fill paragraph. +Outside of comments, this behaves as `fill-paragraph' except that +filling does not cross boundaries of block literals. Inside comments, +this will do usual adaptive fill behaviors." + (interactive "*P") + (save-restriction + (yaml-narrow-to-block-literal) + (let ((fill-paragraph-function nil)) + (or (fill-comment-paragraph justify) + (fill-paragraph justify region))))) + +(defun yaml-set-imenu-generic-expression () + (make-local-variable 'imenu-generic-expression) + (make-local-variable 'imenu-create-index-function) + (setq imenu-create-index-function 'imenu-default-create-index-function) + (setq imenu-generic-expression yaml-imenu-generic-expression)) + +(add-hook 'yaml-mode-hook 'yaml-set-imenu-generic-expression) + + +(defun yaml-mode-version () + "Display version of `yaml-mode'." + (interactive) + (message "yaml-mode %s" yaml-mode-version) + yaml-mode-version) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.\\(e?ya?\\|ra\\)ml\\'" . yaml-mode)) + +;;;###autoload +(add-to-list 'magic-mode-alist + '("^%YAML\\s-+[0-9]+\\.[0-9]+\\(\\s-+#\\|\\s-*$\\)" . yaml-mode)) + +(provide 'yaml-mode) + +;;; yaml-mode.el ends here diff --git a/elpa/yaml-mode-readme.txt b/elpa/yaml-mode-readme.txt deleted file mode 100644 index 7afdf205..00000000 --- a/elpa/yaml-mode-readme.txt +++ /dev/null @@ -1,25 +0,0 @@ -This is a major mode for editing files in the YAML data -serialization format. It was initially developed by Yoshiki -Kurihara and many features were added by Marshall Vandegrift. As -YAML and Python share the fact that indentation determines -structure, this mode provides indentation and indentation command -behavior very similar to that of python-mode. - -Installation: - -To install, just drop this file into a directory in your -`load-path' and (optionally) byte-compile it. To automatically -handle files ending in '.yml', add something like: - - (require 'yaml-mode) - (add-to-list 'auto-mode-alist '("\\.yml\\'" . yaml-mode)) - -to your .emacs file. - -Unlike python-mode, this mode follows the Emacs convention of not -binding the ENTER key to `newline-and-indent'. To get this -behavior, add the key definition to `yaml-mode-hook': - - (add-hook 'yaml-mode-hook - '(lambda () - (define-key yaml-mode-map "\C-m" 'newline-and-indent)))