Adjust indentation at work.
+requires
+
+#+begin_src sh :eval never
+ port install tree-sitter-yaml
+#+end_src
+
#+BEGIN_SRC emacs-lisp
;; load yaml-mode
(require 'yaml-mode)
(add-hook 'yaml-mode-hook
(lambda()
(auto-fill-mode -1)
+ (yaml-pro-ts-mode 1)
+ (eldoc-mode 1)
;; (stripes-mode 1)
(setq bba-keep-whitespaces 1)))
--- /dev/null
+;;; yaml-pro-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)))
+
+
+\f
+;;; Generated autoloads from yaml-pro.el
+
+(autoload 'yaml-pro-ts-mode "yaml-pro" "\
+Minor mode to enable yaml-pro treesitter keymap.
+
+\\{yaml-pro-mode-map}
+
+This is a minor mode. If called interactively, toggle the `Yaml-Pro-Ts
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate the variable `yaml-pro-ts-mode'.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
+(fn &optional ARG)" t)
+(autoload 'yaml-pro-mode "yaml-pro" "\
+Binds additional functions to aid in editing YAML files.
+
+\\{yaml-pro-mode-map}
+
+This is a minor mode. If called interactively, toggle the `Yaml-Pro
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate the variable `yaml-pro-mode'.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
+(fn &optional ARG)" t)
+(register-definition-prefixes "yaml-pro" '("yaml-pro-"))
+
+\f
+;;; Generated autoloads from yaml-pro-edit.el
+
+(autoload 'yaml-pro-edit-scalar "yaml-pro-edit" "\
+Edit the scalar value at the point in a separate buffer.
+If prefix argument P is provided, prompt user for initialization command.
+
+(fn P)" t)
+(register-definition-prefixes "yaml-pro-edit" '("yaml-pro-edit-"))
+
+\f
+;;; Generated autoloads from yaml-pro-format.el
+
+(register-definition-prefixes "yaml-pro-format" '("yaml-pro-format"))
+\f
+;;; End of scraped data
+
+(provide 'yaml-pro-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-pro-autoloads.el ends here
--- /dev/null
+;;; yaml-pro-edit.el --- Functions for editing functionality -*- lexical-binding: t -*-
+
+;; Author: Zachary Romero
+;; Maintainer: Zachary Romero
+;; Homepage: https://github.com/zkry/yaml-pro
+;; Keywords: tools
+
+;; This file is not part of GNU 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; M-x yaml-pro-edit-ts-scalar
+
+;;; Code:
+
+(require 'treesit nil t)
+(require 'yaml)
+
+(defconst yaml-pro-edit-mode-map
+ (let ((map (make-sparse-keymap)))
+ (prog1 map
+ ;;(suppress-keymap map)
+ (define-key map (kbd "C-c C-k") #'yaml-pro-edit-quit)
+ (define-key map (kbd "C-c C-c") #'yaml-pro-edit-complete)
+ (define-key map (kbd "C-c C-s") #'yaml-pro-edit-change-output)))
+ "Keymap of yaml-edit-mode.")
+
+(defconst yaml-pro-edit-buffer-name "*yaml-pro-edit*")
+(defvar-local yaml-pro-edit-ts-node-position nil)
+(put 'yaml-pro-edit-ts-node-position 'permanent-local t)
+(defvar-local yaml-pro-edit-scalar nil
+ "The current scalar being edited on.
+Used to fetch location properties on completion.")
+(put 'yaml-pro-edit-scalar 'permanent-local t)
+(defvar-local yaml-pro-edit-scalar-overlay nil
+ "Overlay to go on top of the text currently being edited.")
+(put 'yaml-pro-edit-scalar-overlay 'permanent-local t)
+(defvar-local yaml-pro-edit-parent-buffer nil
+ "Reference to the buffer where the edited YAML originated.")
+(put 'yaml-pro-edit-parent-buffer 'permanent-local t)
+(defvar-local yaml-pro-edit-output-type nil
+ "When completing an edit buffer, output scalar according to this.")
+(put 'yaml-pro-edit-output-type 'permanent-local t)
+(defvar-local yaml-pro-edit-initialization-cache nil
+ "Hashmap of YAML path to initialization function.")
+(put 'yaml-pro-edit-initialization-cache 'permanent-local t)
+
+
+(define-minor-mode yaml-pro-edit-mode
+ "Minor-mode for editing a YAML scalar in a separate buffer."
+ :lighter " YAML-pro"
+ :keymap yaml-pro-edit-mode-map
+ (add-hook 'change-major-mode-hook
+ (lambda ()
+ (let ((buf (current-buffer)))
+ ;; Setting the header-line-format in the
+ ;; change-major-mode-hook doesn't work. Probably some
+ ;; major mode thing is done after the hook call. This
+ ;; timer hack makes sure the header-line-format is set
+ ;; properly.
+ (run-with-timer
+ 0.01 nil
+ (lambda ()
+ (with-current-buffer buf
+ (setq header-line-format (yaml-pro-edit--header-line)))))))
+ nil t))
+(put 'yaml-pro-edit-mode 'permanent-local t)
+
+(defun yaml-pro-edit-cleanup-parent ()
+ "Remove overlay and properties of edited text."
+ (with-current-buffer (or yaml-pro-edit-parent-buffer (current-buffer))
+ (when yaml-pro-edit-scalar-overlay
+ (delete-overlay yaml-pro-edit-scalar-overlay)
+ (setq yaml-pro-edit-scalar-overlay nil))))
+
+(defun yaml-pro-edit--infer-scalar-indent (scalar-block-string)
+ "Infer the scalar indentation SCALAR-BLOCK-STRING."
+ (with-temp-buffer
+ (insert scalar-block-string)
+ (goto-char (point-min))
+ (save-excursion
+ (let ((min-indent 10000))
+ (while (not (eobp))
+ (when (not (looking-at " *\n"))
+ (let ((ct 0))
+ (while (looking-at-p " ")
+ (forward-char 1)
+ (cl-incf ct))
+ (when (< ct min-indent)
+ (setq min-indent ct))))
+ (forward-line 1))
+ min-indent))))
+
+(defun yaml-pro-edit--infer-indent (&optional pos)
+ "Infer the YAML indentation of POS or the current point."
+ (save-excursion
+ (let ((pos (or pos (point))))
+ (goto-char pos)
+ (when (and (eobp) ;; fix edge where end of scalar at eop has end after newline
+ (eql (char-before (point)) ?\n))
+ (forward-line -1))
+ (forward-line 0)
+ (skip-chars-forward "- \n")
+ (current-column))))
+
+(defconst yaml-pro-edit-output-types
+ '(("|" . literal)
+ ("|-" . literal-strip)
+ ("|+" . literal-keep)
+ (">" . folded)
+ (">-" . folded-strip)
+ (">+" . folded-keep)
+ ("'" . single)
+ ("\"" . double))
+ "Alist of selection item to type key.")
+
+(defun yaml-pro-edit--block-style-annotation (v)
+ "Return the completion annotation of the selection string V."
+ (let ((annotations
+ '(("|" . "keep newlines, single newline at end")
+ ("|-" . "keep newlines, strip newlines at end")
+ ("|+" . "keep newlines, keep newlines at end")
+ (">" . "fold newlines to space, single newline at end")
+ (">-" . "fold newlines to space, strip newlines at end")
+ (">+" . "fold newlines to space, keep newlines at end")
+ ("'" . "nothing escaped")
+ ("\"" . "newlines escaped"))))
+ (concat " " (cdr (assoc v annotations)))))
+
+(defun yaml-pro-edit--block-output (type)
+ "Return the block prefix of TYPE if one exists."
+ (when (not (memq type '(single double)))
+ (car (rassoc type yaml-pro-edit-output-types))))
+
+(defun yaml-pro-edit-apply-indentation (content indent &optional type)
+ "Apply an indentation level of INDENT to the string CONTENT and return."
+ (with-temp-buffer
+ (insert content)
+ (goto-char (point-min))
+ (let ((indent-str (make-string indent ?\s)))
+ (when (eql type 'single)
+ (forward-line 1))
+ (while (not (eobp))
+ (when (not (looking-at-p "^ *\n"))
+ (insert indent-str))
+ (forward-line 1)))
+ (buffer-string)))
+
+(defun yaml-pro-edit--header-line ()
+ "Return the string to display in the header line."
+ (let* ((base-text (substitute-command-keys "Edit, then exit with \
+`\\[yaml-pro-edit-complete]' or abort with `\\[yaml-pro-edit-quit]'.")))
+ (if yaml-pro-edit-output-type
+ (let* ((type-str
+ (or (yaml-pro-edit--block-output yaml-pro-edit-output-type)
+ (and (eql yaml-pro-edit-output-type 'double) "\"\"")
+ (and (eql yaml-pro-edit-output-type 'single) "''")))
+ (type-str-prp (propertize type-str 'face 'font-lock-string-face)))
+ (concat base-text
+ "Outputting "
+ type-str-prp
+ (substitute-command-keys
+ ", `\\[yaml-pro-edit-change-output]' to change out type")))
+ (concat base-text
+ (substitute-command-keys
+ "Change output with `\\[yaml-pro-edit-change-output]'")))))
+
+(defun yaml-pro-edit-initialize-buffer
+ (parent-buffer buffer initial-text type initialize path)
+ "Initialize the YAML edit buffer.
+
+PARENT-BUFFER is the buffer from which the YAML was copied.
+BUFFER is the editing buffer. The buffer is initialized with the
+text INITIAL-TEXT.
+
+TYPE indicates the type of scalar that the block was copied
+from (ex literal or folded).
+
+INITIALIZE, if non-nil, will run before the buffer is
+initialized. The INITIALIZE function will be cached under PATH,
+resulting in the function being ran upon subsequent edits."
+ (when (not yaml-pro-edit-initialization-cache)
+ (setq-local yaml-pro-edit-initialization-cache
+ (make-hash-table :test 'equal)))
+ (let* ((init-cache yaml-pro-edit-initialization-cache)
+ (init-fn (or initialize (and path (gethash path init-cache)))))
+ (with-current-buffer buffer
+ (when (functionp init-fn)
+ (condition-case e
+ (progn
+ (funcall init-fn)
+ (when (and initialize path)
+ (puthash path initialize init-cache)))
+ (error (message "Initialization failed with: %S"
+ (error-message-string e)))))
+ (unless yaml-pro-edit-mode
+ (yaml-pro-edit-mode))
+ (erase-buffer)
+ (setq-local require-final-newline nil)
+ (setq-local yaml-pro-edit-parent-buffer parent-buffer)
+ (setq-local yaml-pro-edit-output-type nil)
+ (when type (setq-local yaml-pro-edit-output-type type))
+ (setq header-line-format (yaml-pro-edit--header-line))
+ (insert initial-text))))
+
+(defun yaml-pro-edit--extract-scalar-text (scalar-block-string yaml-indentation)
+ "Strip SCALAR-BLOCK-STRING of indentation with a basis of YAML-INDENTATION."
+ ;; TODO: consider consolidating this logic with that of yaml.el
+ (save-match-data
+ (let ((indent-ct-num
+ (progn (string-match "\\`[^\n]*\\([0-9]+\\) *\n" scalar-block-string)
+ (let ((num-str (match-string 1 scalar-block-string)))
+ (and num-str (+ (string-to-number num-str)
+ yaml-indentation))))))
+ (setq scalar-block-string (string-trim-left scalar-block-string ".*\n"))
+ (with-temp-buffer
+ (insert scalar-block-string)
+ (goto-char (point-min))
+ (let* ((indentation
+ (or indent-ct-num
+ (yaml-pro-edit--infer-scalar-indent scalar-block-string)))
+ (indentation-regexp
+ (regexp-quote (make-string indentation ?\s))))
+ (while (not (eobp))
+ (when (looking-at-p indentation-regexp)
+ (delete-char indentation))
+ (forward-line 1)))
+ (buffer-string)))))
+
+;; Interactive Functions
+
+(defun yaml-pro-edit-change-output ()
+ "Change the selected output type after completing the YAML."
+ (interactive)
+ (unless yaml-pro-edit-mode
+ (user-error "not in yaml-pro edit buffer"))
+ (let* ((completion-extra-properties
+ '(:annotation-function yaml-pro-edit--block-style-annotation))
+ (output-type (completing-read "Output: " yaml-pro-edit-output-types))
+ (key (cdr (assoc output-type yaml-pro-edit-output-types 'equal))))
+ (setq yaml-pro-edit-output-type key)
+ (setq header-line-format (yaml-pro-edit--header-line))))
+
+(defun yaml-pro-edit-quit ()
+ "Quit the edit buffer."
+ (interactive)
+ (unless yaml-pro-edit-mode
+ (user-error "not in yaml-pro edit buffer"))
+ (yaml-pro-edit-cleanup-parent)
+ (let ((b (current-buffer)))
+ (quit-window)
+ (kill-buffer b)))
+
+(defun yaml-pro-edit-complete ()
+ "Deleting edit buffer and move its contents to the original YAML buffer."
+ (interactive)
+ (unless yaml-pro-edit-mode
+ (user-error "not in yaml-pro edit buffer"))
+ (unless yaml-pro-edit-parent-buffer
+ (error "Buffer not connected with yaml buffer"))
+ ;; first ensure that buffer ends with at least one newline
+ (let* ((edit-buf (current-buffer))
+ (edit-str (buffer-substring-no-properties (point-min) (point-max)))
+ (type yaml-pro-edit-output-type))
+ (when (not (memq type '(single double)))
+ (save-excursion
+ (goto-char (point-max))
+ (unless (looking-back "\n" (- (point) 2))
+ (insert "\n")
+ (setq edit-str (buffer-substring-no-properties (point-min) (point-max))))))
+ (save-excursion
+ (with-current-buffer yaml-pro-edit-parent-buffer
+ (let* ((pos (or (and yaml-pro-ts-mode yaml-pro-edit-ts-node-position)
+ (get-text-property 0 'yaml-position yaml-pro-edit-scalar)))
+ (start (car pos))
+ (end (cdr pos))
+ (indent (yaml-pro-edit--infer-indent start))
+ (scalar-indent (yaml-pro-edit--infer-scalar-indent edit-str))
+ (indented-edit-str
+ (yaml-pro-edit-apply-indentation edit-str (+ indent 2) type))
+ (block-header (or (yaml-pro-edit--block-output type)
+ (and (not type)
+ (> (length (split-string edit-str "\n")) 1)
+ ">-")))
+ (extract-string (buffer-substring-no-properties start end))
+ (end-newline-p (= (aref extract-string
+ (1- (length extract-string)))
+ ?\n)))
+ (yaml-pro-edit-cleanup-parent)
+ (delete-region start end)
+ (goto-char start)
+ (cond (block-header
+ (if (> scalar-indent 0)
+ (insert block-header "2\n")
+ (insert block-header "\n"))
+ (insert indented-edit-str))
+ ((or (eql type 'double)
+ (and (not type)
+ (and (= (length (split-string edit-str "\n")) 1)
+ (string-prefix-p " " edit-str))))
+ (insert "\"" (replace-regexp-in-string "\"" "\\\\\""
+ (replace-regexp-in-string "\n" "\\\\n" edit-str))
+ "\""))
+ ((eql type 'single)
+ (insert "'" (string-trim-right (replace-regexp-in-string
+ "'" "''"
+ indented-edit-str))
+ "'"))
+ (t
+ (insert edit-str)))
+ ;; following blocks are tricky
+ ;; if the text being extracted is a block, then it ends in a newline
+ ;; meaning the resulting code should return a newline
+ ;; if the text being extracted is quoted, we need to make sure that
+ ;; the block doesn't add too many lines than needed.
+ (when (and (not (memq type '(double single)))
+ (not end-newline-p))
+ (delete-char 1))
+ (when (and (memq type '(double single))
+ end-newline-p)
+ (insert "\n")))))
+ (quit-window)
+ (kill-buffer edit-buf)))
+
+(declare-function yaml-pro--value-at-point "yaml-pro")
+(declare-function yaml-pro--fast-value-at-point "yaml-pro")
+(declare-function yaml-pro--path-at-point "yaml-pro")
+(declare-function yaml-pro--use-fast-p "yaml-pro")
+
+(defun yaml-pro-edit-ts-scalar-node-at (point)
+ "Return the node at POINT corresponding with editable scalar."
+ (let* ((at-node (treesit-node-at point 'yaml)))
+ (cond
+ ((member (treesit-node-type at-node) '("block_scalar" "string_scalar"))
+ at-node)
+ ((member (treesit-node-type at-node) '("'" "\"" "escape_sequence"))
+ (treesit-node-parent at-node)))))
+
+(defun yaml-pro-edit-ts-strip-quotes (text)
+ "Strip the first and last quote character in TEXT."
+ (let ((is-single-quote (eql (aref text 0) ?'))
+ (base-string (substring text 1 (1- (length text)))))
+ (if is-single-quote
+ (replace-regexp-in-string " *\n+ *" " " base-string)
+ base-string)))
+
+(defun yaml-pro-edit-ts-scalar (p)
+ "Edit the scalar value at the point in a separate buffer.
+This command utilizes tree-sitter to detirmine syntax
+locations. If prefix argument P is provided, prompt user for
+initialization command."
+ (interactive "p")
+ (let* ((init-func)
+ (parent-buffer (current-buffer))
+ (at-node (yaml-pro-edit-ts-scalar-node-at (point)))
+ (start (treesit-node-start at-node))
+ (end (treesit-node-end at-node))
+ (node-text (treesit-node-text at-node)))
+ (when (= 4 p)
+ (setq init-func (read-command "Initialization command: ")))
+ (unless at-node
+ (error "No scalar found at point"))
+ (setq yaml-pro-edit-ts-node-position (cons start end))
+ (save-excursion
+ (goto-char (treesit-node-start at-node))
+ (let* ((yaml-indentation (yaml-pro-edit--infer-indent end))
+ (folded-block-p (looking-at-p ">"))
+ (literal-block-p (looking-at-p "|"))
+ (strip-p (looking-at-p ".-[0-9]+\n"))
+ (keep-p (looking-at-p ".+[0-9]+\n"))
+ (double-quote-string-p (equal "double_quote_scalar" (treesit-node-type at-node)))
+ (single-quote-string-p (equal "single_quote_scalar" (treesit-node-type at-node)))
+ (type (cond ((and folded-block-p strip-p) 'folded-strip)
+ ((and literal-block-p strip-p) 'literal-strip)
+ ((and folded-block-p keep-p) 'folded-keep)
+ ((and literal-block-p keep-p) 'literal-keep)
+ (folded-block-p 'folded)
+ (literal-block-p 'literal)
+ (single-quote-string-p 'single)
+ (double-quote-string-p 'double))))
+ (when yaml-pro-edit-scalar-overlay
+ (delete-overlay yaml-pro-edit-scalar-overlay))
+ (let ((ov (make-overlay start end))
+ (read-only
+ (list
+ (lambda (&rest _) (user-error "Can't modify a scalar being edited in a dedicated buffer")))))
+ (overlay-put ov 'modification-hooks read-only)
+ (overlay-put ov 'insert-in-front-hooks read-only)
+ (overlay-put ov 'insert-behind-hooks read-only)
+ (overlay-put ov 'face 'secondary-selection)
+ (setq yaml-pro-edit-scalar-overlay ov))
+ (let ((b (get-buffer-create yaml-pro-edit-buffer-name)))
+ (if (or folded-block-p literal-block-p)
+ (yaml-pro-edit-initialize-buffer
+ parent-buffer b (yaml-pro-edit--extract-scalar-text node-text yaml-indentation) type init-func nil)
+ (yaml-pro-edit-initialize-buffer
+ parent-buffer b (yaml-parse-string node-text) type init-func nil))
+ (let ((window (display-buffer b)))
+ (when window
+ (select-window window))))))))
+
+;;;###autoload
+(defun yaml-pro-edit-scalar (p)
+ "Edit the scalar value at the point in a separate buffer.
+If prefix argument P is provided, prompt user for initialization command."
+ (interactive "p")
+ (let* ((init-func)
+ (fast-p (yaml-pro--use-fast-p))
+ (at-scalar (if fast-p (yaml-pro--fast-value-at-point)
+ (yaml-pro--value-at-point)))
+ (path (and (not fast-p) (yaml-pro--path-at-point)))
+ (parent-buffer (current-buffer)))
+ (unless at-scalar
+ (user-error "No value found at point"))
+ (when (= 4 p)
+ (setq init-func (read-command "Initialization command: ")))
+ (setq yaml-pro-edit-scalar at-scalar)
+ (let* ((bounds (or (get-text-property 0 'yaml-position at-scalar)
+ (get-text-property 0 'yaml-position (string-trim at-scalar "[ \n]*"))))
+ (start (car bounds))
+ (end (cdr bounds))
+ (yaml-indentation (yaml-pro-edit--infer-indent start))
+ (scalar-text (buffer-substring start end))
+ (raw-scalar (yaml-pro-edit--extract-scalar-text
+ scalar-text yaml-indentation))
+ (folded-block-p
+ (string-match-p "\\` *>\\(?:+\\|-\\)?[0-9]*\n" scalar-text))
+ (literal-block-p
+ (string-match-p "\\` *|\\(?:+\\|-\\)?[0-9]*\n" scalar-text))
+ (strip-p
+ (string-match-p "\\` *.-[0-9]*\n" scalar-text))
+ (keep-p
+ (string-match-p "\\` *.\\+[0-9]*\n" scalar-text))
+ (double-quote-string-p
+ (string-match-p "\\`\".*\"\\'" scalar-text))
+ (single-quote-string-p
+ (string-match-p "\\`'\\(.\\|\n\\)*'\\'" scalar-text))
+ (type (cond ((and folded-block-p strip-p) 'folded-strip)
+ ((and literal-block-p strip-p) 'literal-strip)
+ ((and folded-block-p keep-p) 'folded-keep)
+ ((and literal-block-p keep-p) 'literal-keep)
+ (folded-block-p 'folded)
+ (literal-block-p 'literal)
+ (single-quote-string-p 'single)
+ (double-quote-string-p 'double))))
+ ;; setup overlay and text properties
+ (when yaml-pro-edit-scalar-overlay
+ (delete-overlay yaml-pro-edit-scalar-overlay))
+ (let ((ov (make-overlay start end))
+ (read-only
+ (list
+ (lambda (&rest _)
+ (user-error "Can't modify an scalar being edited in a \
+dedicated buffer")))))
+ (overlay-put ov 'modification-hooks read-only)
+ (overlay-put ov 'insert-in-front-hooks read-only)
+ (overlay-put ov 'insert-behind-hooks read-only)
+ (overlay-put ov 'face 'secondary-selection)
+ (setq yaml-pro-edit-scalar-overlay ov))
+ (let ((b (get-buffer-create yaml-pro-edit-buffer-name)))
+ (if (or folded-block-p literal-block-p)
+ ;; we need to pass the text in buffer if type is block
+ (yaml-pro-edit-initialize-buffer
+ parent-buffer b raw-scalar type init-func path)
+ ;; otherwise use its scalar value (to not show quotes)
+ (yaml-pro-edit-initialize-buffer
+ parent-buffer b at-scalar type init-func path))
+ (let ((window (display-buffer b)))
+ (when window
+ (select-window window)))))))
+
+(provide 'yaml-pro-edit)
+
+;;; yaml-pro-edit.el ends here
--- /dev/null
+;;; yaml-pro-format.el --- Pretty formatting for YAML code -*- lexical-binding: t -*-
+
+;; Author: Zachary Romero
+;; Maintainer: Zachary Romero
+;; Package-Requires: ((emacs "28.1"))
+;; Homepage: https://github.com/zkry/yaml-pro
+;; Keywords: tools
+
+;; This file is not part of GNU 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; yaml-pro-format-ts is a command which will format the current
+;; buffer to make have uniform styling. The rules the formatter
+;; applies are defined in the `yaml-pro-format-features' variable. By
+;; changing its value you can enable and disable formatting rules.
+;;
+;; The pretty formatter was inspired by the prettier.js YAML formatter
+;; but does have a number of differences, some limited by the
+;; capabilities of Tree Sitter.
+
+;;; Code:
+
+(require 'treesit nil t)
+(require 'cl-lib)
+
+(defvar yaml-pro-indent)
+
+(defcustom yaml-pro-format-print-width 80
+ "Width until which to break flow sequences."
+ :group 'yaml-pro
+ :type 'integer)
+
+(defcustom yaml-pro-format-features
+ '(reduce-newlines document-separator-own-line oneline-flow block-formatting
+ reduce-spaces bm-fn-next-line clean-doc-end remove-spaces-before-comments
+ expand-long-flow single-to-double indent)
+ "Features to enable when formatting buffer.
+
+This value should be a list containing any of the following symbols:
+
+- `indent' When present, indent each line by `yaml-pro-indent'.
+
+- `reduce-newlines' When present, remove adjacent newlines so at
+ most one one remains. New lines in strings won't be removed.
+
+- `oneline-flow' When present, reduce flow mappings to one line.
+
+- `block-formatting' When present, format the spacing around
+ block components' colons and dashes.
+
+- `reduce-spaces' When present, attempt to reduce multiple
+ adjacent space characters down to one.
+
+- `bm-fn-next-line' When present, move the value of a key-value pair to the
+ next line, indented, if it's width is longer than
+ `yaml-pro-format-print-width'.
+
+- `expand-log-flow' When present, flatten flow elements that pass
+ column `yaml-pro-format-print-width'.
+
+- `single-to-double' When present, convert single quoted strings
+ to double quoted, when it wouldn't change its meaning.
+
+- `remove-spaces-before-comments' When present, remove spaces
+ before a comment until it is one space after the preceeding
+ content (e.g. \"a: b # space before here\").
+
+- `clean-doc-end' When present, remove unnecessary document-end
+ indicators (\"...\").
+
+- `document-separator-own-line' When present, makes sure the
+ document separator \"---\" isn't on a line with another element."
+ :group 'yaml-pro
+ :type '(set (const :tag "Remove adjacent blank lines, leaving at most one"
+ reduce-newlines)
+ (const :tag "Put document separators (---) are on a line of their own"
+ document-separator-own-line)
+ (const :tag "Try to reduce flow (JSON-like) elements to one line"
+ oneline-flow)
+ (const :tag "Format spacing around block elments' colon and dashes"
+ block-formatting)
+ (const :tag "Reduce spacing down to one when appropriate"
+ reduce-spaces)
+ (const :tag "Transform \"key: value\" to \"key:\\n value\" if column passes `yaml-pro-format-print-width'"
+ bm-fn-next-line)
+ (const :tag "Remove unnecessary document end indicator (...)"
+ clean-doc-end)
+ (const :tag "Leave only one space before comments"
+ remove-spaces-before-comments)
+ (const :tag "Flatten flow nodes if column passes `yaml-pro-format-print-width'"
+ expand-long-flow)
+ (const :tag "Convert single-quoted strings to double-quoted strings"
+ single-to-double)
+ (const :tag "Indent according to treesitter level information"
+ indent)))
+
+(defun yaml-pro-format-ts--bm-single-space ()
+ "Ensure proper spacing around the colon character in a block mapping."
+ (let* ((nodes (treesit-query-capture
+ (treesit-buffer-root-node 'yaml)
+ '((block_mapping_pair
+ key: (flow_node) @key
+ ":" @colon
+ value: [(flow_node) (block_node)] @val))))
+ (del-ovs '()))
+ (while nodes
+ (save-excursion
+ (let* ((colon-node (alist-get 'colon nodes))
+ (key-node (alist-get 'key nodes))
+ (val-node (alist-get 'val nodes)))
+ (setq nodes (cdddr nodes))
+ (when (and (not (= (treesit-node-start colon-node)
+ (treesit-node-end key-node)))
+ ;; we should only be overwriting blank here
+ (string-match-p "\\`[ \n]*\\'"
+ (buffer-substring-no-properties
+ (treesit-node-end key-node)
+ (treesit-node-start colon-node)))
+ ;; alias names need a space after them
+ (not (equal (treesit-node-type
+ (treesit-node-at (treesit-node-end key-node) 'yaml))
+ "alias_name")))
+ (push (make-overlay (treesit-node-end key-node)
+ (treesit-node-start colon-node))
+ del-ovs))
+ (when
+ (and (or (string-suffix-p "_scalar" (treesit-node-type val-node))
+ (equal (treesit-node-type val-node) "flow_node"))
+ (not (= (1+ (treesit-node-end colon-node))
+ (treesit-node-start val-node)))
+ ;; the region should only replace blank
+ (string-match-p
+ "\\`[ \n]*\\'"
+ (buffer-substring-no-properties
+ (treesit-node-end colon-node)
+ (treesit-node-start val-node))))
+ (let ((ov (make-overlay (treesit-node-end colon-node)
+ (treesit-node-start val-node))))
+ (overlay-put ov 'yaml-pro-format-insert " ")
+ (push ov del-ovs))))))
+ del-ovs))
+
+(defun yaml-pro-format-ts--oneline-flow ()
+ "Compress flow elements to one line."
+ (let* ((nodes (treesit-query-capture
+ (treesit-buffer-root-node 'yaml)
+ '((document
+ (flow_node
+ [(flow_mapping) (flow_sequence)] @flow))
+ (block_mapping_pair
+ (flow_node
+ [(flow_mapping) (flow_sequence)] @flow))
+ (block_sequence_item
+ (flow_node
+ [(flow_mapping) (flow_sequence)] @flow)))))
+ (del-ovs '()))
+ (pcase-dolist (`(_ . ,node) nodes)
+ ;; don't compress flow with comments
+ (unless (treesit-query-capture node '((comment) @comment))
+ (save-match-data
+ (save-excursion
+ (goto-char (treesit-node-start node))
+ (while (search-forward "\n" (treesit-node-end node) t)
+ (unless (equal (treesit-node-type
+ (treesit-node-at (match-beginning 0) 'yaml))
+ "comment")
+ (let* ((ov (make-overlay (match-beginning 0) (match-end 0))))
+ (push ov del-ovs))))))))
+ ;; Following code ensures that compressed flow is pretty formatted
+ (let* ((nodes (treesit-query-capture
+ (treesit-buffer-root-node 'yaml)
+ '((flow_mapping "," @comma)))))
+ (pcase-dolist (`(_ . ,comma-node) nodes)
+ (cond
+ ((save-excursion (goto-char (treesit-node-end comma-node))
+ (looking-at-p " *\n? *}"))
+ (let* ((ov (make-overlay (treesit-node-start comma-node)
+ (treesit-node-end comma-node))))
+ (overlay-put ov 'yaml-pro-format-insert " ")
+ (push ov del-ovs)))
+ ((save-excursion (goto-char (treesit-node-start comma-node))
+ (looking-back "[^\n] *" (- (point) 80)))
+ (let* ((ov (make-overlay (save-excursion
+ (goto-char (treesit-node-start comma-node))
+ (skip-chars-backward " ")
+ (point))
+ (treesit-node-start comma-node))))
+ (push ov del-ovs))))))
+ (let* ((nodes (treesit-query-capture
+ (treesit-buffer-root-node 'yaml)
+ '((flow_mapping "}" @rbrace)))))
+ (pcase-dolist (`(_ . ,rbrace-node) nodes)
+ (when (save-excursion (goto-char (treesit-node-start rbrace-node))
+ (not (looking-back "[ \n{] ?" (- (point) 4))))
+ (let* ((ov (make-overlay (treesit-node-start rbrace-node)
+ (treesit-node-start rbrace-node))))
+ (overlay-put ov 'yaml-pro-format-insert " ")
+ (push ov del-ovs)))))
+ (let* ((nodes (treesit-query-capture
+ (treesit-buffer-root-node 'yaml)
+ '((flow_mapping "{" @lbrace)))))
+ (pcase-dolist (`(_ . ,lbrace-node) nodes)
+ (when (save-excursion (goto-char (treesit-node-end lbrace-node))
+ (not (looking-at-p "[ \n}]")))
+ (let* ((ov (make-overlay (treesit-node-end lbrace-node)
+ (treesit-node-end lbrace-node))))
+ (overlay-put ov 'yaml-pro-format-insert " ")
+ (push ov del-ovs)))))
+ del-ovs))
+
+
+(defun yaml-pro-format-ts--no-comments-after-tags ()
+ "Move comments to a newline if they occur after a tag (e.g. !!set)."
+ (let* ((del-ovs '())
+ (nodes (treesit-query-capture
+ (treesit-buffer-root-node 'yaml)
+ '((_ (tag) @tag :anchor (comment) @comment)))))
+ (while nodes
+ (let* ((tag-node (alist-get 'tag nodes))
+ (comment-node (alist-get 'comment nodes)))
+ (setq nodes (cddr nodes))
+ (when (= (line-number-at-pos (treesit-node-end tag-node))
+ (line-number-at-pos (treesit-node-start comment-node)))
+ (let* ((ov (make-overlay (treesit-node-end tag-node)
+ (treesit-node-start comment-node))))
+ (overlay-put ov 'yaml-pro-format-insert "\n")
+ (push ov del-ovs)))))
+ del-ovs))
+
+(defun yaml-pro-format-ts--flow-seq-grouping-space ()
+ "Remove all whitespace before and after flow nodes' [ ] chars."
+ (let* ((nodes (treesit-query-capture
+ (treesit-buffer-root-node 'yaml)
+ '((flow_mapping) @flow
+ (flow_sequence) @flow)))
+ (del-ovs '()))
+ (pcase-dolist (`(_ . ,node) nodes)
+ (let-alist (treesit-query-capture
+ node
+ '((flow_sequence "[" @open :anchor (_) @after-open-node
+ (_) @before-close-node :anchor "]" @close)))
+ (when (and .open .close .after-open-node .before-close-node)
+ (if (= (line-number-at-pos (treesit-node-end .open))
+ (line-number-at-pos (treesit-node-start .close)))
+ ;; If [ ] is on one line, remove spacing after [ and before ].
+ (let* ((ov-beg (make-overlay (treesit-node-end .open)
+ (treesit-node-start .after-open-node)))
+ (ov-end (make-overlay (treesit-node-end .before-close-node)
+ (treesit-node-start .close))))
+ (push ov-beg del-ovs)
+ (unless (equal (treesit-node-type .before-close-node) "comment")
+ (push ov-end del-ovs)))
+ ;; If [ ] is on multiple lines, ensure [ ] are on their own lines.
+ (let* ((after-open-indent
+ (yaml-pro-format-ts--node-indent .after-open-node))
+ (ov-beg (make-overlay (treesit-node-end .open)
+ (treesit-node-start .after-open-node)))
+ (ov-end (make-overlay (treesit-node-end .before-close-node)
+ (treesit-node-start .close))))
+ (overlay-put ov-beg 'yaml-pro-format-insert
+ (concat "\n" (make-string
+ (* after-open-indent yaml-pro-indent)
+ ?\s)))
+ (overlay-put ov-end 'yaml-pro-format-insert
+ (concat ",\n" (make-string
+ (* (- after-open-indent 1)
+ yaml-pro-indent)
+ ?\s)))
+ (push ov-beg del-ovs)
+ (unless (equal (treesit-node-type .before-close-node) "comment")
+ (push ov-end del-ovs)))))))
+ del-ovs))
+
+(defun yaml-pro-format-ts--bm-fn-next-line ()
+ "If a flow node passes the 80th column, put it on the next line."
+ (let* ((nodes (treesit-query-capture
+ (treesit-buffer-root-node 'yaml)
+ '((block_mapping_pair
+ ":" @colon :anchor value: (flow_node) @child)
+ @parent)))
+ (del-ovs '()))
+ (while nodes
+ (let-alist (seq-take nodes 3)
+ (setq nodes (cdddr nodes))
+ (when (and (= (line-number-at-pos (treesit-node-start .parent))
+ (line-number-at-pos (treesit-node-start .child)))
+ (> (save-excursion (goto-char (treesit-node-end .child))
+ (current-column))
+ 80))
+ (let* ((indent (yaml-pro-format-ts--node-indent .child))
+ (ov (make-overlay (treesit-node-end .colon)
+ (treesit-node-start .child))))
+ (overlay-put
+ ov 'yaml-pro-format-insert
+ (concat "\n" (make-string (* indent yaml-pro-indent) ?\s)))
+ (push ov del-ovs)))))
+ del-ovs))
+
+(defun yaml-pro-format-ts--clean-doc-end ()
+ "Remove the document end symbol (...)."
+ (let* ((del-ovs '())
+ (capture (treesit-query-capture
+ (treesit-buffer-root-node 'yaml)
+ '(("..." @doc-end)))))
+ (pcase-dolist (`(_ . ,node) capture)
+ (save-excursion
+ (goto-char (treesit-node-end node))
+ (skip-chars-forward "\n \t")
+ (let* ((next-node (treesit-node-at (point) 'yaml)))
+ (cond
+ ((member (treesit-node-type next-node) '("comment" "directive_name"))
+ ;; leave alone if next node is a comment
+ )
+ ((equal (treesit-node-type next-node) "---")
+ (let* ((ov (make-overlay (1- (treesit-node-start node))
+ (treesit-node-end node))))
+ (push ov del-ovs)))
+ (t
+ (let* ((ov (make-overlay (treesit-node-start node)
+ (treesit-node-end node))))
+ (overlay-put ov 'yaml-pro-format-insert "---")
+ (push ov del-ovs)))))))
+ del-ovs))
+
+(defun yaml-pro-format-ts--remove-spaces-before-comments ()
+ "Remove spaces before comments.
+If there is nothing before the comment on a line, move it to col 0.
+If there is other text, ensure one space remains."
+ (let* ((del-ovs '())
+ (capture (treesit-query-capture
+ (treesit-buffer-root-node 'yaml)
+ '((comment) @comment))))
+ (pcase-dolist (`(_ . ,comment-node) capture)
+ (save-excursion
+ (save-match-data
+ (goto-char (treesit-node-start comment-node))
+ (cond
+ ((looking-back "\n *" (- (point) 80))
+ (let* ((ov (make-overlay (pos-bol) (treesit-node-start comment-node))))
+ (push ov del-ovs)))
+ ((looking-back "[^\n] *" (- (point) 80))
+ (let* ((ov (make-overlay
+ (save-excursion (goto-char (treesit-node-start comment-node))
+ (skip-chars-backward " \t")
+ (point))
+ (treesit-node-start comment-node))))
+ (overlay-put ov 'yaml-pro-format-insert " ")
+ (push ov del-ovs)))))))
+ del-ovs))
+
+(defun yaml-pro-format-ts--expand-long-flow-sequence ()
+ "Expand flow sequence to multiple lines if extend past column 80.
+Assumes that flow sequences have been previously reduced to one line."
+ (let* ((nodes (treesit-query-capture
+ (treesit-buffer-root-node 'yaml)
+ '((flow_sequence) @seq)))
+ (ovs '()))
+ (pcase-dolist (`(_ . ,node) nodes)
+ (when (save-excursion (goto-char (treesit-node-end node))
+ (and (looking-at-p ",? *\n")
+ (> (current-column) yaml-pro-format-print-width)))
+ (let* ((capture (treesit-query-capture
+ node
+ '((flow_sequence (flow_node) @child)))))
+ (pcase-dolist (`(_ . ,child) capture)
+ (when (treesit-node-eq (treesit-node-parent child) node)
+ (let* ((indent (yaml-pro-format-ts--node-indent child))
+ (ov (make-overlay
+ (treesit-node-start child) (treesit-node-start child))))
+ (overlay-put
+ ov 'yaml-pro-format-insert
+ (concat "\n" (make-string (* indent yaml-pro-indent) ?\s)))
+ (push ov ovs)))))
+ (pcase-dolist (`(_ . ,close) (treesit-query-capture
+ node
+ '((flow_sequence "]" @close :anchor))))
+ (when (treesit-node-eq (treesit-node-parent close) node)
+ (let* ((ov (make-overlay (treesit-node-start close)
+ (treesit-node-start close)))
+ (indent (yaml-pro-format-ts--node-indent close))
+ (end-str "\n"))
+ (when (not (save-excursion (goto-char (treesit-node-start close))
+ (looking-back ", *" (- (point) 80))))
+ (setq end-str ",\n"))
+ (overlay-put ov 'yaml-pro-format-insert
+ (concat end-str
+ (make-string (* indent yaml-pro-indent)
+ ?\s)))
+ (push ov ovs))))))
+ ovs))
+
+(defun yaml-pro-format-ts--expand-long-flow-mapping ()
+ "Expand flow mapping to multiple lines if extend past column 80.
+Assumes that flow mappings have been previously reduced to one line."
+ (let* ((nodes (treesit-query-capture
+ (treesit-buffer-root-node 'yaml)
+ '((flow_mapping) @map)))
+ (ovs '()))
+ (pcase-dolist (`(_ . ,node) nodes)
+ (when (save-excursion
+ (goto-char (treesit-node-end node))
+ (and (looking-at-p ",? *\n")
+ (or (> (current-column) yaml-pro-format-print-width)
+ ;; if the flow is already spanning multiple lines, expand
+ ;; it so it looks nice.
+ (not (= (line-number-at-pos (treesit-node-start node))
+ (line-number-at-pos (treesit-node-end node)))))))
+ (let* ((capture (treesit-query-capture
+ node
+ '((flow_mapping [(flow_pair) (flow_node)] @child)))))
+ (pcase-dolist (`(_ . ,child) capture)
+ (when (and (treesit-node-eq (treesit-node-parent child) node)
+ (save-excursion ;; dont add newline if one already exists
+ (goto-char (treesit-node-start child))
+ (not (looking-back "\n *" (- (point) 80)))))
+ (let* ((indent (yaml-pro-format-ts--node-indent child))
+ (ov (make-overlay (treesit-node-start child)
+ (treesit-node-start child))))
+ (overlay-put ov 'yaml-pro-format-insert
+ (concat "\n" (make-string (* indent yaml-pro-indent)
+ ?\s)))
+ (push ov ovs)))))
+ (let* ((capture (treesit-query-capture
+ node
+ '((flow_mapping "}" @close :anchor)))))
+ (pcase-dolist (`(_ . ,close) capture)
+ (when (treesit-node-eq (treesit-node-parent close) node)
+ (let* ((ov (make-overlay (save-excursion
+ (goto-char (treesit-node-start close))
+ (skip-chars-backward " ")
+ (point))
+ (treesit-node-start close)))
+ (indent (yaml-pro-format-ts--node-indent close))
+ (end-str "\n"))
+ ;; we only add this ov if flow is on same line
+ (unless (save-excursion (goto-char (treesit-node-start close))
+ (looking-back "\n *" (- (point) 80)))
+ (when (not (save-excursion (goto-char (treesit-node-start close))
+ (looking-back ", *" (- (point) 10))))
+ (setq end-str ",\n"))
+
+ (overlay-put
+ ov 'yaml-pro-format-insert
+ (concat end-str (make-string (* indent yaml-pro-indent) ?\s)))
+ (push ov ovs))))))))
+ ovs))
+
+(defun yaml-pro-format-ts--block-sequence ()
+ "Ensure proper spacing around sequences' - character."
+ (let* ((nodes (treesit-query-capture
+ (treesit-buffer-root-node 'yaml)
+ `((block_sequence_item "-" @dash (_) @elt))))
+ (groups (seq-group-by
+ (lambda (capture)
+ (treesit-node-parent (cdr capture)))
+ nodes))
+ (del-ovs '()))
+ (while groups
+ (save-excursion
+ (let* ((dash-node (alist-get 'dash (cdar groups)))
+ (elt-node (alist-get 'elt (cdar groups))))
+ (let ((ov (make-overlay (treesit-node-end dash-node)
+ (treesit-node-start elt-node))))
+ (overlay-put ov 'yaml-pro-format-insert " ")
+ (push ov del-ovs)))
+ (setq groups (cdr groups))))
+ del-ovs))
+
+(defun yaml-pro-format-ts--single-to-double ()
+ "Convert single quote if it doesn't contain backslashes."
+ (let* ((nodes (treesit-query-capture
+ (treesit-buffer-root-node 'yaml)
+ '((single_quote_scalar) @scalar)))
+ (del-ovs '()))
+ (pcase-dolist (`(_ . ,node) nodes)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (treesit-node-start node) (treesit-node-end node))
+ (goto-char (treesit-node-start node))
+ (unless (search-forward "\\" nil t)
+ ;; single quotes are to use backslash w/o escaping. If
+ ;; single scalar has backslash, don't convert.
+ (while (search-forward "''" nil t)
+ (let* ((ov (make-overlay (match-beginning 0) (match-end 0))))
+ (overlay-put ov 'yaml-pro-format-insert "'")
+ (push ov del-ovs)))
+ (let* ((open-ov (make-overlay (treesit-node-start node)
+ (1+ (treesit-node-start node))))
+ (close-ov (make-overlay (1- (treesit-node-end node))
+ (treesit-node-end node))))
+ (overlay-put open-ov 'yaml-pro-format-insert "\"")
+ (overlay-put close-ov 'yaml-pro-format-insert "\"")
+ (push open-ov del-ovs)
+ (push close-ov del-ovs))))))
+ del-ovs))
+
+(defun yaml-pro-format-ts--reduce-spaces ()
+ "Remove multiple spaces when not affecting meaning."
+ (let* ((del-ovs '()))
+ (save-excursion
+ (save-match-data
+ (goto-char (point-min))
+ (while (search-forward-regexp "[ \t][ \t]+" nil t)
+ (when (not (looking-back "\n *" (- (point) 80)))
+ (let* ((at-node-type (treesit-node-type (treesit-node-on
+ (match-beginning 0)
+ (match-end 0)
+ 'yaml))))
+ (when (not (member at-node-type
+ '("string_scalar" "double_quote_scalar"
+ "single_quote_scalar" "block_scalar"
+ "block_sequence_item" "comment")))
+ (let* ((ov (make-overlay (match-beginning 0) (match-end 0))))
+
+ (overlay-put ov 'yaml-pro-format-insert " ")
+ (push ov del-ovs))))))))
+ del-ovs))
+
+(defun yaml-pro-format-ts--after-keep-p (point)
+ "Return non-nil of POINT is after a block scalar keep item.
+This is needed due to a mismatch of the TreeSitter grammer and the YAML spec."
+ (save-excursion
+ (save-match-data
+ (goto-char point)
+ (while (looking-back "[\n ]" (- (point) 2))
+ (forward-char -1))
+ (let* ((at-node (treesit-node-at (point) 'yaml)))
+ (and (equal (treesit-node-type at-node)
+ "block_scalar")
+ (yaml-pro-format-ts--node-keep-block-scalar-p at-node))))))
+
+(defun yaml-pro-format-ts--reduce-newlines ()
+ "Reduce all appropriate grouped empty lines into one."
+ (let* ((del-ovs '()))
+ (save-excursion
+ (save-match-data
+ (goto-char (point-min))
+ (while (search-forward-regexp "\\(?:\n[ \t]*\\)\\(?:\n[ \t]*\\)+\n" nil t)
+ (let* ((on-node-type
+ (treesit-node-type (treesit-node-on (match-beginning 0)
+ (match-end 0)
+ 'yaml))))
+ (when (and (not (member
+ on-node-type '("string_scalar" "double_quote_scalar"
+ "single_quote_scalar" "block_scalar")))
+ (not (yaml-pro-format-ts--after-keep-p (point))))
+ (let* ((ov (make-overlay (match-beginning 0 ) (match-end 0))))
+ (overlay-put ov 'yaml-pro-format-insert "\n\n")
+ (push ov del-ovs)))))))
+ del-ovs))
+
+(defun yaml-pro-format-ts--document-separator-own-line ()
+ "If document contans ---, make sure it's on its own line."
+ (let* ((del-ovs '())
+ (capture (treesit-query-capture (treesit-buffer-root-node 'yaml)
+ '((document "---" @dashes)))))
+ (pcase-dolist (`(_ . ,node) capture)
+ (save-excursion
+ (save-match-data
+ (goto-char (treesit-node-end node))
+ (when (looking-at "\\( *\\)[^ \n]")
+ (let* ((ov (make-overlay (match-beginning 1) (match-end 1))))
+ (overlay-put ov 'yaml-pro-format-insert "\n")
+ (push ov del-ovs))))))
+ del-ovs))
+
+(defun yaml-pro-format-ts--node-numbered-block-scalar-p (node)
+ "Return non-nil if NODE is a block scalar with an indent count."
+ (and (equal (treesit-node-type node) "block_scalar")
+ (string-match-p "^[>|][0-9]+" (treesit-node-text node))))
+
+(defun yaml-pro-format-ts--node-keep-block-scalar-p (node)
+ "Return non-nil if NODE is a block scalar with an indent count."
+ (and (equal (treesit-node-type node) "block_scalar")
+ (string-match-p "^[>|][0-9]*\\+" (treesit-node-text node))))
+
+(defun yaml-pro-format-ts--lowest-block-scalar-indent (node)
+ "Return the lowest indentation of text in NODE."
+ (save-match-data
+ (apply #'min
+ (cdr (seq-map (lambda (line)
+ (when (string-match "^ *" line)
+ (length (match-string 0 line))))
+ (string-lines (treesit-node-text node) t))))))
+
+(defun yaml-pro-format-ts--commenting-next-node (node)
+ "If NODE is a comment, return the node next in the tree if commenting it.
+Often times a comment block will be commenting on something below
+it. We infer this if a comment is part of a block where there is
+a blank line above it."
+ (when (equal (treesit-node-type node) "comment")
+ (let* ((comment-block-start node)
+ (comment-block-end node))
+ (catch 'out
+ (while t
+ (let* ((next-sib (treesit-node-next-sibling comment-block-end)))
+ (if (and (equal (treesit-node-type next-sib) "comment")
+ (= (line-number-at-pos (treesit-node-start next-sib))
+ (1+ (line-number-at-pos (treesit-node-start comment-block-end)))))
+ (setq comment-block-end next-sib)
+ (throw 'out nil)))))
+ (catch 'out
+ (while t
+ (let* ((prev-sib (treesit-node-prev-sibling comment-block-start)))
+ (if (and (equal (treesit-node-type prev-sib) "comment")
+ (= (line-number-at-pos (treesit-node-start prev-sib))
+ (1- (line-number-at-pos (treesit-node-start comment-block-start)))))
+ (setq comment-block-start prev-sib)
+ (throw 'out nil)))))
+ (when (save-excursion
+ (goto-char (treesit-node-start comment-block-start))
+ (forward-line -1)
+ (looking-at-p " *\n"))
+ (let* ((next-block-node
+ (save-excursion
+ (goto-char (treesit-node-start comment-block-end))
+ (forward-line 1)
+ (back-to-indentation)
+ (and (looking-at-p " *[^ \n\t-]")
+ (treesit-node-at (point) 'yaml)))))
+ (when (not (equal (treesit-node-type next-block-node) "comment"))
+ next-block-node))))))
+
+(defun yaml-pro-format-ts--node-indent (root-node)
+ "Return the number of indent parents of ROOT-NODE."
+ (let* ((ct 0)
+ (node root-node))
+ ;; base count calculation
+ (while node
+ (when (and (equal (treesit-node-field-name node) "key")
+ (not (equal (treesit-node-type (treesit-node-parent node))
+ "flow_pair")))
+ (cl-decf ct))
+ (when (member (treesit-node-type node) '("-" "{" "[" "}" "]"))
+ (cl-decf ct))
+ (when (member (treesit-node-type node)
+ '("block_mapping_pair" "block_sequence_item"
+ "flow_mapping" "flow_sequence"))
+ (cl-incf ct))
+ (setq node (treesit-node-parent node)))
+
+ ;; When a non-numbered block scalar is at indent level-0, indent
+ ;; body contents.
+ (when (and (= 0 ct)
+ (equal (treesit-node-type root-node) "block_scalar")
+ (not (yaml-pro-format-ts--node-numbered-block-scalar-p root-node)))
+ (cl-incf ct))
+
+ ;; Block scalars' text that is past the most indent needs to keep
+ ;; its extra indentation
+ (when (and (equal (treesit-node-type root-node) "block_scalar")
+ (> (current-column)
+ (yaml-pro-format-ts--lowest-block-scalar-indent root-node)))
+ (cl-incf ct (/ (- (current-column)
+ (yaml-pro-format-ts--lowest-block-scalar-indent root-node))
+ yaml-pro-indent)))
+ ct))
+
+(defun yaml-pro-format-ts--should-indent-p (node)
+ "Return non-nil if NODE should be indented according to tree parse."
+ (cond
+ ((yaml-pro-format-ts--node-numbered-block-scalar-p node) nil)
+ ((equal (treesit-node-type node) ":") nil)
+ (t t)))
+
+(defun yaml-pro-format-ts--indent ()
+ "Indent elements according to tree position."
+ (let* ((del-ovs '()))
+ (save-excursion
+ (save-match-data
+ (goto-char (point-min))
+ (while (search-forward-regexp "\\(\n *\\)[^ \n]" nil t)
+ (forward-char -1)
+ (let* ((at-node (treesit-node-at (point) 'yaml)))
+ (when (yaml-pro-format-ts--should-indent-p at-node)
+ ;; in certain cases, a comment should be indented by the node
+ ;; after it.
+ (setq at-node (or (yaml-pro-format-ts--commenting-next-node at-node)
+ at-node))
+ (let* ((indent (yaml-pro-format-ts--node-indent at-node))
+ (indent-str
+ (make-string (* indent yaml-pro-indent) ?\s))
+ (ov (make-overlay (1+ (match-beginning 0)) (point))))
+ (overlay-put ov 'yaml-pro-format-insert indent-str)
+ (push ov del-ovs)))))))
+ del-ovs))
+
+(defun yaml-pro-format-ts--process-overlay (ov)
+ "Delete characters in OV. Insert text of property `yaml-pro-format-insert'.
+OV is deleted after this function finishes."
+ (let* ((insert-text (overlay-get ov 'yaml-pro-format-insert)))
+ (goto-char (overlay-start ov))
+ (delete-region (overlay-start ov) (overlay-end ov))
+ (when insert-text
+ (insert insert-text))
+ (delete-overlay ov)))
+
+(defun yaml-pro-format-ts--run-while-changing (functions)
+ "Run FUNCTIONS in order. Keep running FUNCTIONS until no change made."
+ (catch 'done
+ (while t
+ (let ((changed nil))
+ (dolist (f functions)
+ (let* ((ovs (funcall f)))
+ (when (> (length ovs) 0)
+ (setq changed t))
+ (save-excursion
+ (seq-map #'yaml-pro-format-ts--process-overlay ovs))))
+ (if (not changed)
+ (throw 'done nil)
+ (setq changed nil))))))
+
+(defvar-local yaml-pro-format-ts-indent-groups '()
+ "List of nodes that need to be indented together at the same time.")
+
+(defun yaml-pro-format-ts--create-indent-groups ()
+ "Populate `yaml-pro-format-ts-indent-groups' based on initial tree."
+ (setq yaml-pro-format-ts-indent-groups nil)
+ (let* ((capture (treesit-query-capture
+ (treesit-buffer-root-node 'yaml)
+ '((block_sequence_item "-") @item)))
+ (groups (seq-group-by (pcase-lambda (node)
+ (treesit-node-parent node))
+ (seq-map #'cdr capture))))
+ (pcase-dolist (`(_ . ,items) groups)
+ (when (> (length items) 1)
+ (push (seq-map
+ (pcase-lambda (node)
+ (make-overlay (treesit-node-start node)
+ (treesit-node-end node) nil t))
+ items)
+ yaml-pro-format-ts-indent-groups))))
+ (let* ((capture (treesit-query-capture
+ (treesit-buffer-root-node 'yaml)
+ '((block_mapping_pair ":") @item)))
+ (groups (seq-group-by (pcase-lambda (node)
+ (treesit-node-parent node))
+ (seq-map #'cdr capture))))
+ (pcase-dolist (`(_ . ,items) groups)
+ (when (> (length items) 1)
+ (push (seq-map (pcase-lambda (node)
+ (make-overlay (treesit-node-start node)
+ (treesit-node-end node) nil t))
+ items)
+ yaml-pro-format-ts-indent-groups)))))
+
+(defun yaml-pro-format-ts--ensure-indent-groups ()
+ "Ensure that indent groups are on same level of indentation."
+ (let* ((ovs '()))
+ (dolist (group yaml-pro-format-ts-indent-groups)
+ (let* ((indent (save-excursion (goto-char (overlay-start (car group)))
+ (current-column))))
+ (dolist (node (cdr group))
+ (let* ((node-indent (save-excursion (goto-char (overlay-start node))
+ (current-column)))
+ (indent-diff (- indent node-indent)))
+ (cond
+ ((< indent-diff 0)
+ (let* ((ov (make-overlay (+ (overlay-start node) indent-diff)
+ (overlay-start node))))
+ (push ov ovs)))
+ ((< 0 indent-diff)
+ (let* ((ov (make-overlay (overlay-start node)
+ (overlay-start node))))
+ (overlay-put ov 'yaml-pro-format-insert
+ (make-string indent-diff ?\s))
+ (push ov ovs))))))))
+ ovs))
+
+(defconst yaml-pro-format-ts-functions
+ '((reduce-newlines . yaml-pro-format-ts--reduce-newlines)
+ (document-separator-own-line . yaml-pro-format-ts--document-separator-own-line)
+ (oneline-flow . yaml-pro-format-ts--oneline-flow)
+ (block-formatting . yaml-pro-format-ts--bm-single-space)
+ ((or oneline-flow expand-flow) . yaml-pro-format-ts--flow-seq-grouping-space)
+ (reduce-spaces . yaml-pro-format-ts--reduce-spaces)
+ (block-formatting . yaml-pro-format-ts--block-sequence)
+ (bm-fn-next-line . yaml-pro-format-ts--bm-fn-next-line)
+ (clean-doc-end . yaml-pro-format-ts--clean-doc-end)
+ (remove-spaces-before-comments . yaml-pro-format-ts--remove-spaces-before-comments)
+ (expand-long-flow .
+ (lambda ()
+ (yaml-pro-format-ts--run-while-changing
+ '(yaml-pro-format-ts--expand-long-flow-sequence
+ yaml-pro-format-ts--expand-long-flow-mapping))))
+ (single-to-double .
+ yaml-pro-format-ts--single-to-double)
+ ;; yaml-pro-format-ts--prose-wrap TODO
+ (indent . yaml-pro-format-ts--indent))
+ "Alist of feature symbol and formatting functions.")
+
+
+(defun yaml-pro-format ()
+ "Format the YAML buffer according to pre-defined rules."
+ (interactive)
+ (when (treesit-query-capture (treesit-buffer-root-node 'yaml) '((ERROR) @err))
+ (user-error "Error encountered when parsing buffer with treesitter. Please ensure your syntax is correct and try again"))
+ (save-excursion
+ (goto-char (point-max))
+ (insert "\n"))
+ (yaml-pro-format-ts--create-indent-groups)
+ (let* ((fmt-functions
+ (seq-map
+ #'cdr
+ (seq-filter
+ (pcase-lambda (`(,sym . _))
+ (pcase sym
+ (`(or . ,elts)
+ (seq-find (lambda (sym) (member sym yaml-pro-format-features))
+ elts))
+ (sym (member sym yaml-pro-format-features))))
+ yaml-pro-format-ts-functions))))
+ (dolist (f fmt-functions)
+ (let* ((ovs (funcall f)))
+ (save-excursion
+ (seq-map #'yaml-pro-format-ts--process-overlay ovs)))
+ (let* ((ovs (yaml-pro-format-ts--ensure-indent-groups)))
+ (save-excursion
+ (seq-map #'yaml-pro-format-ts--process-overlay ovs))))
+ (delete-trailing-whitespace (point-min) (point-max))))
+
+(defalias 'yaml-pro-format-ts #'yaml-pro-format)
+
+(provide 'yaml-pro-format)
+
+;;; yaml-pro-format.el ends here
--- /dev/null
+;; -*- no-byte-compile: t; lexical-binding: nil -*-
+(define-package "yaml-pro" "20241223.1723"
+ "Parser-aided YAML editing features."
+ '((emacs "26.1")
+ (yaml "0.5.1"))
+ :url "https://github.com/zkry/yaml-pro"
+ :commit "f7706ea170de98d29b7cdd5a4f189bd038b1e27b"
+ :revdesc "f7706ea170de"
+ :keywords '("tools"))
--- /dev/null
+;;; yaml-pro.el --- Parser-aided YAML editing features -*- lexical-binding: t -*-
+
+;; Author: Zachary Romero
+;; Maintainer: Zachary Romero
+;; Package-Version: 20241223.1723
+;; Package-Revision: f7706ea170de
+;; Package-Requires: ((emacs "26.1") (yaml "0.5.1"))
+;; Homepage: https://github.com/zkry/yaml-pro
+;; Keywords: tools
+
+;; This file is not part of GNU 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 <https://www.gnu.org/licenses/>.
+
+
+;;; Commentary:
+
+;; yaml-pro contains a new mode which provides conveniences when
+;; editing YAML. Running `yaml-pro-mode' switches the mode and the
+;; following commands are available:
+;; - `yaml-pro-move-subtree-up' and `yaml-pro-move-subtree-down'
+;; - `yaml-pro-next-subtree' and `yaml-pro-prev-subtree',
+;; - `yaml-pro-kill-subtree'
+;; - `yaml-pro-up-level'
+;; - `yaml-pro-fold-at-point' and `yaml-pro-unfold-at-point'.
+;; - `yaml-pro-edit-scalar'
+;; - `yaml-pro-jump' or if consult exists `yaml-pro-consult-jump'
+
+;;; Code:
+
+(require 'yaml)
+(require 'yaml-pro-edit)
+(require 'yaml-pro-format)
+(require 'treesit nil t)
+(require 'consult nil t)
+
+(defgroup yaml-pro nil
+ "YAML editing tools."
+ :prefix "yaml-pro-"
+ :group 'convenience)
+
+
+;;; yaml-pro tree sitter
+
+(defcustom yaml-pro-ts-yank-subtrees t
+ "Non-nil means when yanking subtrees, adjust the level."
+ :group 'yaml-pro
+ :type 'boolean)
+
+(defcustom yaml-pro-ts-path-element-separator ?.
+ "Character separating path elements when generating node labels."
+ :group 'yaml-pro
+ :type 'character)
+
+(defun yaml-pro-ts--until-mapping (node)
+ "Recursively look up from NODE returning first `block_mapping_pair'."
+ (treesit-parent-until
+ node
+ (lambda (node)
+ (equal (treesit-node-type node) "block_mapping_pair"))))
+
+(defun yaml-pro-ts--until-mapping-or-list (node)
+ "Recursively look up from NODE returning first `block_mapping_pair'."
+ (treesit-parent-until
+ node
+ (lambda (node)
+ (or (equal (treesit-node-type node) "block_mapping_pair")
+ (equal (treesit-node-type node) "block_sequence_item")))))
+
+(defun yaml-pro-ts--until-list (node)
+ "Recursively look up from NODE returning first `block_sequence_item'."
+ (treesit-parent-until
+ node
+ (lambda (node)
+ (equal (treesit-node-type node) "block_sequence_item"))))
+
+(defun yaml-pro-ts--until-mapping-or-list (node)
+ "Recursively look up from NODE returning first mapping or sequence item."
+ (treesit-parent-until
+ node
+ (lambda (node)
+ (or
+ (equal (treesit-node-type node) "block_mapping_pair")
+ (equal (treesit-node-type node) "block_sequence_item")))))
+
+(defun yaml-pro-ts-kill-subtree ()
+ "Kill the entire subtree located at the current-point."
+ (interactive)
+ (let* ((at-node (treesit-node-at (point) 'yaml))
+ (tree-top (yaml-pro-ts--until-mapping-or-list at-node)))
+ (when tree-top
+ (kill-region (treesit-node-start tree-top)
+ (treesit-node-end tree-top)))))
+
+(defun yaml-pro-copy-node-path-at-point ()
+ "Copy node path at point to clipboard."
+ (interactive)
+ (let* ((at-node (treesit-node-at (point) 'yaml))
+ (path (yaml-pro-ts--imenu-node-label at-node)))
+ (kill-new path)
+ (message "%s was copied to clipboard" (propertize path 'face '(bold default)))))
+
+(defun yaml-pro-ts-up-level ()
+ "Move the point to the parent tree."
+ (interactive)
+ (let* ((at-node (treesit-node-at (point) 'yaml))
+ (tree-top (yaml-pro-ts--until-mapping-or-list at-node))
+ (parent-tree-top (and tree-top (yaml-pro-ts--until-mapping-or-list tree-top))))
+ (when parent-tree-top
+ (goto-char (treesit-node-start parent-tree-top)))))
+
+(defun yaml-pro-ts-down-level ()
+ "Move the point down to first child of current item."
+ (interactive)
+ (let* ((at-node (treesit-node-at (point) 'yaml))
+ (tree-top (yaml-pro-ts--until-mapping-or-list at-node))
+ (nodes (seq-map #'cdr
+ (treesit-query-capture tree-top '((block_sequence_item) @match
+ (block_mapping_pair) @match))))
+ (children (seq-sort-by
+ #'treesit-node-start
+ #'<
+ (seq-filter
+ (lambda (node)
+ (treesit-node-eq tree-top (yaml-pro-ts--until-mapping-or-list node)))
+ nodes))))
+ (if (car children)
+ (goto-char (treesit-node-start (car children)))
+ (beep))))
+
+(defun yaml-pro-ts-first-sibling ()
+ "Move the point to the first sibling."
+ (interactive)
+ (let* ((at-node (treesit-node-at (point) 'yaml))
+ (at-sibling (yaml-pro-ts--until-mapping-or-list at-node))
+ (parent (treesit-node-parent at-sibling))
+ (all-siblings (treesit-node-children parent))
+ (first-sibling (car all-siblings)))
+ (if first-sibling
+ (goto-char (treesit-node-start first-sibling))
+ (beep))))
+
+(defun yaml-pro-ts-last-sibling ()
+ "Move the point to the last sibling."
+ (interactive)
+ (let* ((at-node (treesit-node-at (point) 'yaml))
+ (at-sibling (yaml-pro-ts--until-mapping-or-list at-node))
+ (parent (treesit-node-parent at-sibling))
+ (all-siblings (treesit-node-children parent))
+ (last-sibling (car (last all-siblings))))
+ (if last-sibling
+ (goto-char (treesit-node-start last-sibling))
+ (beep))))
+
+(defun yaml-pro-ts-prev-mapping-node (tree-top type)
+ "Return nearest previous sibling node of TREE-TOP of type TYPE."
+ (interactive)
+ (setq tree-top (treesit-node-prev-sibling tree-top))
+ (while (and tree-top
+ (not (equal (treesit-node-type tree-top) type)))
+ (setq tree-top (treesit-node-prev-sibling tree-top)))
+ tree-top)
+
+(defun yaml-pro-ts-next-mapping-node (tree-top type)
+ "Return nearest next sibling node of TREE-TOP of type TYPE."
+ (interactive)
+ (setq tree-top (treesit-node-next-sibling tree-top))
+ (while (and tree-top
+ (not (equal (treesit-node-type tree-top) type)))
+ (setq tree-top (treesit-node-next-sibling tree-top)))
+ tree-top)
+
+
+(defun yaml-pro-ts-prev-subtree ()
+ "Move the point to the previous subtree or list."
+ (interactive)
+ (let* ((at-node (treesit-node-at (point) 'yaml))
+ (prev-node
+ (if (and (equal (treesit-node-type at-node) "-")
+ (equal (treesit-node-type (treesit-node-parent at-node))
+ "block_sequence_item"))
+ (yaml-pro-ts-prev-mapping-node (yaml-pro-ts--until-list at-node) "block_sequence_item")
+ (yaml-pro-ts-prev-mapping-node (yaml-pro-ts--until-mapping at-node) "block_mapping_pair"))))
+ (if prev-node
+ (goto-char (treesit-node-start prev-node))
+ (ding))))
+
+(defun yaml-pro-ts-backward-sentence ()
+ (interactive)
+ (let* ((at-node (treesit-node-at (point) 'yaml))
+ (starting-point (point)))
+ (unless (bobp)
+ (cond
+ ((or (equal (treesit-node-type at-node) "\"")
+ (equal (treesit-node-type at-node) "'")
+ (equal (treesit-node-type at-node) "block_scalar"))
+ (let ((sentence-end "\\. "))
+ (backward-sentence)
+ (when (not (equal
+ (treesit-node-type at-node)
+ (treesit-node-type (treesit-node-at (point) 'yaml))))
+ (goto-char (treesit-node-start at-node))
+ (forward-line -1)
+ (yaml-pro-ts-backward-sentence))))
+ (t
+ (let ((ring-bell-function #'ignore))
+ (forward-line -1)
+ (while (looking-at "^ *\\(#.*\\)?$")
+ (forward-line -1))
+ (when (not (bobp))
+ (cl-flet ((move-to-leaf ()
+ (let ((start-point (point)))
+ (catch 'done
+ (while t
+ (yaml-pro-ts-down-level)
+ (when (eql (point) start-point)
+ (throw 'done t))
+ (setq start-point (point))))
+ (goto-char (pos-eol)))))
+ (let ((start (point)))
+ (while (progn (move-to-leaf)
+ (>= (point) starting-point))
+ (goto-char start)
+ (forward-line -1)
+ (while (and (looking-at "^ *\\(#.*\\)?$")
+ (not (bobp)))
+ (forward-line -1))
+ (setq start (point))))))))))))
+
+(defun yaml-pro-ts-forward-sentence ()
+ (interactive)
+ (let* ((at-node (treesit-node-at (point) 'yaml)))
+ (cond
+ ((or (equal (treesit-node-type at-node) "\"")
+ (equal (treesit-node-type at-node) "'")
+ (equal (treesit-node-type at-node) "block_scalar"))
+ (let ((sentence-end "\\. "))
+ (forward-sentence)
+ (when (not (equal
+ (treesit-node-type at-node)
+ (treesit-node-type (treesit-node-at (point) 'yaml))))
+ (goto-char (treesit-node-end at-node))
+ (forward-line 1)
+ (yaml-pro-ts-forward-sentence))))
+ (t
+ (let ((ring-bell-function #'ignore))
+ (forward-line 1)
+ (while (and (looking-at "^ *\\(#.*\\)?$")
+ (not (eobp)))
+ (forward-line 1))
+ (let ((start-point (point)))
+ (catch 'done
+ (while t
+ (yaml-pro-ts-down-level)
+ (when (or (eql (point) start-point)
+ (eobp))
+ (throw 'done t))
+ (setq start-point (point))))
+ (goto-char (pos-eol))))))))
+
+(defun yaml-pro-ts-next-subtree ()
+ "Move the point to the next subtree or list."
+ (interactive)
+ (let* ((at-node (treesit-node-at (point) 'yaml))
+ (next-node
+ (if (and (equal (treesit-node-type at-node) "-")
+ (equal (treesit-node-type (treesit-node-parent at-node))
+ "block_sequence_item"))
+ (yaml-pro-ts-next-mapping-node (yaml-pro-ts--until-list at-node) "block_sequence_item")
+ (yaml-pro-ts-next-mapping-node (yaml-pro-ts--until-mapping at-node) "block_mapping_pair"))))
+ (if next-node
+ (goto-char (treesit-node-start next-node))
+ (ding))))
+
+(defun yaml-pro-ts-move-subtree (dir)
+ "Get the current and DIR node and swap the contents of the two."
+ (interactive)
+ (let* ((at-node (treesit-node-at (point) 'yaml))
+ (tree-top (yaml-pro-ts--until-mapping-or-list at-node))
+ (tree-top-type (treesit-node-type tree-top))
+ (sibling-node (if (eq dir 'down)
+ (yaml-pro-ts-next-mapping-node tree-top tree-top-type)
+ (yaml-pro-ts-prev-mapping-node tree-top tree-top-type)))
+ (at-start-marker (make-marker))
+ (at-end-marker (make-marker))
+ (sibling-start-marker (make-marker))
+ (sibling-end-marker (make-marker))
+ (sibling-end-trailing-newline nil))
+ (when (and tree-top sibling-node)
+ (set-marker at-start-marker (treesit-node-start tree-top))
+ (set-marker at-end-marker (treesit-node-end tree-top))
+ (set-marker sibling-start-marker (treesit-node-start sibling-node))
+ (set-marker sibling-end-marker (treesit-node-end sibling-node))
+ ;; Check if there's a trailing newline after the last node. We
+ ;; do this because we don't want to insert a trailing newline if
+ ;; the user doesn't have a trailing newline.
+ (save-excursion
+ (goto-char sibling-end-marker)
+ (setq sibling-end-trailing-newline (equal (char-before) ?\n)))
+ (let* ((at-tree-text (buffer-substring-no-properties
+ at-start-marker at-end-marker))
+ (sibling-tree-text (buffer-substring-no-properties
+ sibling-start-marker sibling-end-marker)))
+ (delete-region at-start-marker at-end-marker)
+ (delete-region sibling-start-marker sibling-end-marker)
+ (goto-char sibling-start-marker)
+ ;; Empty newlines that are after the last node are moved along
+ ;; with the last node, so after text has been deleted from
+ ;; at-node and sibling-node, there's no newline for
+ ;; at-node. We only do this when the last item has a trailing
+ ;; newline.
+ (when (and (eobp) sibling-end-trailing-newline)
+ (save-excursion
+ (insert "\n")))
+ (insert at-tree-text)
+ (goto-char at-start-marker)
+ ;; We delete the last newline (if there's one) because when we
+ ;; move to `at-start-marker', there's already an empty line.
+ (insert (replace-regexp-in-string "\n\\'" "" sibling-tree-text))
+ (goto-char sibling-start-marker)))))
+
+(defun yaml-pro-ts-move-subtree-up ()
+ "Swap the current tree with that of the next sibling's."
+ (interactive)
+ (yaml-pro-ts-move-subtree 'up))
+
+(defun yaml-pro-ts-move-subtree-down ()
+ "Swap the current tree with that of the previous sibling's."
+ (interactive)
+ (yaml-pro-ts-move-subtree 'down))
+
+(defun yaml-pro-ts-meta-return ()
+ "Insert new list item after current item."
+ (interactive)
+ (let* ((at-node (treesit-node-at (point) 'yaml))
+ (list-item-top (yaml-pro-ts--until-list at-node))
+ (list-item-end-in-newline nil))
+ (when list-item-top
+ (let* ((indentation (save-excursion
+ (goto-char (treesit-node-start list-item-top))
+ (current-column))))
+ (goto-char (treesit-node-end list-item-top))
+ ;; If the file didn't have a newline at the end of the item,
+ ;; then we are looking at ^$
+ (setq list-item-end-in-newline (looking-at "^$"))
+ (cond
+ ;; After visiting the end of the top item, we check if we are
+ ;; in a newline or not. If we are not, we start a new line.
+ ((not (looking-at "^$"))
+ (insert "\n" (make-string indentation ?\s) "- "))
+ ;; When there are empty lines above the point after going to
+ ;; the end of the element. When in the top last element of a
+ ;; list, treesit-node-end considers empty lines as part of
+ ;; the list element.
+ ((save-excursion
+ (forward-line -1)
+ (looking-at "^$"))
+ (while (save-excursion
+ (forward-line -1)
+ (looking-at "^$"))
+ (forward-line -1))
+ (insert (make-string indentation ?\s) "- "))
+ ;; If none of the cases are true, we are at the beginning of
+ ;; a line just one line below the previous item, so we just
+ ;; start another item.
+ (t
+ (insert (make-string indentation ?\s) "- ")))
+ ;; If the the user inserted a newline at the end of the item,
+ ;; we insert a newline. If the user didn't, we don't insert a
+ ;; newline. We do this to conform with the POSIX definition of
+ ;; a line and at the same time to act according the user's
+ ;; preferences.
+ (when list-item-end-in-newline
+ (save-excursion
+ (insert "\n")))))))
+
+(defun yaml-pro-convolute-tree ()
+ "Swap the keys of the parent of the item at point and the parent's parent."
+ (interactive)
+ (let* ((at-node (yaml-pro-ts--until-mapping (treesit-node-at (point) 'yaml)))
+ (parent-tree (yaml-pro-ts--until-mapping at-node))
+ (grandparent-tree (yaml-pro-ts--until-mapping
+ (treesit-node-parent parent-tree))))
+ (when (and parent-tree grandparent-tree)
+ (let* ((query '((block_mapping_pair key: (_) @key)))
+ (parent-key (alist-get 'key (treesit-query-capture parent-tree query)))
+ (parent-start (treesit-node-start parent-key))
+ (parent-end (treesit-node-end parent-key))
+ (parent-text (buffer-substring-no-properties parent-start parent-end))
+ (grandparent-key (alist-get 'key (treesit-query-capture grandparent-tree query)))
+ (grandparent-start (treesit-node-start grandparent-key))
+ (grandparent-end (treesit-node-end grandparent-key))
+ (grandparent-text (buffer-substring-no-properties
+ grandparent-start grandparent-end)))
+ (save-excursion
+ (delete-region parent-start parent-end)
+ (goto-char parent-start)
+ (insert grandparent-text)
+ (delete-region grandparent-start grandparent-end)
+ (goto-char grandparent-start)
+ (insert parent-text))))))
+
+(defun yaml-pro-ts-indent-subtree (prefix)
+ "Indent the current subtree by one level.
+
+This function uses tree-sitter. Indentation is controlled by the
+variable `yaml-pro-indent'."
+ (interactive "p\n")
+ (let* ((at-subtree (yaml-pro-ts--until-mapping (treesit-node-at (point) 'yaml)))
+ (origin-marker (make-marker))
+ (end-marker (make-marker))
+ (indent-str (make-string yaml-pro-indent ?\s))
+ (original-content (concat
+ (buffer-substring-no-properties
+ (save-excursion (goto-char (treesit-node-start at-subtree)) (pos-bol))
+ (treesit-node-start at-subtree))
+ (treesit-node-text at-subtree t)))
+ (original-point (point))
+ (start-point (save-excursion (goto-char (treesit-node-start at-subtree)) (pos-bol))))
+ (set-marker origin-marker (point))
+ (set-marker end-marker (treesit-node-end at-subtree))
+ (goto-char start-point)
+ (forward-line 0)
+ (while (< (point) end-marker)
+ (when (not (looking-at " *$"))
+ (insert indent-str))
+ (forward-line 1))
+ (goto-char origin-marker)
+ (when (and
+ (= prefix 1)
+ (treesit-query-capture (treesit-buffer-root-node 'yaml) '((ERROR) @err)))
+ (delete-region start-point end-marker)
+ (goto-char start-point)
+ (insert original-content)
+ (goto-char original-point)
+ (beep)
+ (message "indent would result in broken tree. Prefix command with `C-u' to force indent."))
+ (set-marker origin-marker nil)
+ (set-marker end-marker nil)))
+
+(defun yaml-pro-ts-unindent-subtree (prefix)
+ "Unindent the current subtree by one level.
+
+This function uses tree-sitter. Indentation is controlled by the
+variable `yaml-pro-indent'."
+ (interactive "p\n")
+ (let* ((at-subtree (yaml-pro-ts--until-mapping (treesit-node-at (point) 'yaml)))
+ (origin-marker (make-marker))
+ (end-marker (make-marker))
+ (indent-str (make-string yaml-pro-indent ?\s))
+ (original-content (concat
+ (buffer-substring-no-properties
+ (save-excursion (goto-char (treesit-node-start at-subtree)) (pos-bol))
+ (treesit-node-start at-subtree))
+ (treesit-node-text at-subtree t)))
+ (original-point (point))
+ (start-point (save-excursion (goto-char (treesit-node-start at-subtree))
+ (pos-bol))))
+ (set-marker origin-marker (point))
+ (set-marker end-marker (treesit-node-end at-subtree))
+ (goto-char start-point)
+ (forward-line 0)
+ (while (< (point) end-marker)
+ (when (looking-at (regexp-quote indent-str))
+ (delete-char yaml-pro-indent))
+ (forward-line 1))
+ (goto-char origin-marker)
+ (when (and
+ (= 1 prefix)
+ (treesit-query-capture (treesit-buffer-root-node 'yaml) '((ERROR) @err)))
+ (delete-region start-point end-marker)
+ (goto-char start-point)
+ (insert original-content)
+ (goto-char original-point)
+ (beep)
+ (message "unindent would result in broken tree. Prefix command with `C-u' to force indent."))
+ (set-marker origin-marker nil)
+ (set-marker end-marker nil)))
+
+(defun yaml-pro-ts-mark-subtree (up)
+ "Mark the current subtree.
+This puts point at the start of the current subtree, and mark at
+the end. If a numeric prefix UP is given, move up into the
+hierarchy of headlines by UP levels before marking the subtree."
+ (interactive "P")
+ (while (and up (> up 0))
+ (yaml-pro-ts-up-level)
+ (cl-decf up))
+ (let* ((at-subtree (yaml-pro-ts--until-mapping-or-list (treesit-node-at (point) 'yaml))))
+ (if (and (not up)
+ (or (and (eq last-command this-command) (mark t))
+ (and transient-mark-mode mark-active)))
+ (progn
+ (while (and at-subtree (<= (treesit-node-end at-subtree) (mark)))
+ (setq at-subtree
+ (yaml-pro-ts-next-mapping-node
+ at-subtree (treesit-node-type at-subtree))))
+ (when at-subtree
+ (set-mark (treesit-node-end at-subtree))))
+ (push-mark (treesit-node-end at-subtree))
+ (goto-char (treesit-node-start at-subtree))
+ (activate-mark))))
+
+(defun yaml-pro-ts--kill-is-subtree (&optional tree)
+ "Return non-nil if TREE (or current kill) is a valid tree."
+ (unless tree
+ (setq tree (and kill-ring (current-kill 0))))
+ (when (and tree (> (length (string-split tree "\n")) 1))
+ (let ((node (treesit-parse-string tree 'yaml)))
+ (treesit-query-capture node '((block_mapping_pair) @key)))))
+
+(defun yaml-pro-ts--kill-is-sequence (&optional tree)
+ "Return non-nil if TREE (or current kill) is a valid sequence."
+ (unless tree
+ (setq tree (and kill-ring (current-kill 0))))
+ (let ((first-line (car (string-split (string-trim-left tree) "\n"))))
+ (when (and tree (> (length (string-split tree "\n")) 1))
+ (let ((node (treesit-parse-string first-line 'yaml)))
+ (treesit-query-capture node '((block_sequence) @key))))))
+
+(defun yaml-pro-ts-paste-sequence (&optional remove)
+ "Insert the current kill into the buffer, preserving sequence structure.
+If REMOVE is non-nil, pop item off `kill-ring'."
+ (interactive)
+ (let ((seq (current-kill 0)))
+ (unless (yaml-pro-ts--kill-is-sequence seq)
+ (user-error
+ (substitute-command-keys
+ "The kill is not a YAML-sequence. Use `\\[yank]' to yank anyways")))
+ (let* ((base-indent (current-column))
+ (seq (string-trim seq))
+ (seq-lines (split-string seq "\n"))
+ (indent-lengths (save-match-data
+ (or (seq-map
+ (lambda (line)
+ (string-match "^\\( *\\)" line)
+ (length (match-string 1 line)))
+ (seq-filter
+ (lambda (line)
+ (string-match-p "^ *-" line))
+ (cdr seq-lines)))
+ (list (* yaml-pro-indent 2)))))
+ (smallest-indent (apply #'min indent-lengths))
+ (smallest-indent-string (make-string smallest-indent ?\s))
+ (seq-rest-lines-at-indent (string-join
+ (seq-map
+ (lambda (line)
+ (concat
+ (make-string base-indent ?\s)
+ (string-remove-prefix smallest-indent-string line)))
+ (cdr seq-lines))
+ "\n")))
+ (push-mark (point) 'nomsg)
+ (insert (car seq-lines) "\n")
+ (insert seq-rest-lines-at-indent))))
+
+(defun yaml-pro-ts-paste-subtree (&optional remove)
+ "Insert the current kill into the buffer, preserving tree structure.
+If REMOVE is non-nil, pop item off `kill-ring'."
+ (interactive)
+ (let ((tree (current-kill 0)))
+ (unless (yaml-pro-ts--kill-is-subtree tree)
+ (user-error
+ (substitute-command-keys
+ "The kill is not a YAML-tree. Use `\\[yank]' to yank anyways")))
+ (let* ((base-indent (current-column))
+ (indent-lengths (save-match-data
+ (seq-map
+ (lambda (line)
+ (string-match "^\\( *\\)" line)
+ (length (match-string 1 line)))
+ (seq-filter
+ (lambda (line)
+ (string-match-p "^ *[a-zA-Z0-9\"'_-]+:" line))
+ (cdr (split-string tree "\n")))))))
+ (if (not indent-lengths)
+ (progn
+ (push-mark (point) 'nomsg)
+ (insert tree))
+ (let* (;; does the killed text have more than one top level?
+ ;; if so we need to calculate indentation differently.
+ (single-top-lvl-p
+ (seq-every-p
+ (lambda (len)
+ (<= (car indent-lengths) len))
+ (cdr indent-lengths)))
+ ;; indent that the rest of kill text should have
+ (kill-indent (max (+ (apply #'min indent-lengths)
+ (if single-top-lvl-p -2 0))
+ 0))
+ (kill-indent-string (make-string kill-indent ?\s))
+ (base-indent-string (make-string base-indent ?\s))
+ (insertion-string (with-temp-buffer
+ (insert tree)
+ (goto-char (point-min))
+ (forward-line 1)
+ (while (not (eobp))
+ (when (looking-at kill-indent-string)
+ (delete-char kill-indent)
+ (insert base-indent-string))
+ (forward-line 1))
+ (buffer-string))))
+ (push-mark (point) 'nomsg)
+ (insert insertion-string)))))
+ (when remove (pop kill-ring)))
+
+(defun yaml-pro-ts-yank (&optional arg)
+ "Yank text on kill ring. If YAML-subtree, then indent it correctly.
+This command will look at the current kill and check if it is a
+subtree, or series of subtrees. If so, and ARG is nil, the
+subtree is yanked with the appropriate amount of whitespace
+inserted to make the tree retain its original structure."
+ (interactive "P")
+ (setq this-command 'yank)
+ (if arg
+ (call-interactively #'yank)
+ (let* ((subtreep (yaml-pro-ts--kill-is-subtree))
+ (seqp (yaml-pro-ts--kill-is-sequence))
+ (pos (point))
+ ;; Is point on a placeholder for a block node?
+ (block-allowed-p
+ (and
+ ;; The line must not have nothing but spaces after the point.
+ (looking-at "[ \t]*$")
+ (and (save-excursion
+ (skip-chars-backward " \t")
+ (or
+ ;; The line is blank.
+ (bolp)
+ ;; The point is preceded by a block struct indicator.
+ ;; Note that compact collections cannot be preceded by
+ ;; anchors or tags.
+ (and (memq (char-before) '(?- ?: ??))
+ ;; Block struct indicators must be followed by spaces.
+ (memq (char-before pos) '(?\s ?\t)))))))))
+ (cond
+ ((and seqp block-allowed-p yaml-pro-ts-yank-subtrees)
+ (yaml-pro-ts-paste-sequence))
+ ((and subtreep block-allowed-p yaml-pro-ts-yank-subtrees)
+ (yaml-pro-ts-paste-subtree))
+ (t (call-interactively #'yank))))))
+
+(defun yaml-pro-ts-newline (&optional arg interactive)
+ (interactive "*P\np")
+ (barf-if-buffer-read-only)
+ (cond
+ ((or (looking-at-p " *[^ \n]")
+ (equal (treesit-node-type (treesit-node-at (point) 'yaml)) ":")
+ (equal (treesit-node-type (treesit-node-parent (treesit-node-at (point) 'yaml)))
+ "block_scalar"))
+ (let* ((indent (yaml-pro-format-ts--node-indent (treesit-node-at (point) 'yaml)))
+ (indent-column (* indent yaml-pro-indent)))
+ (call-interactively #'newline)
+ (when (< (current-column) indent-column)
+ (insert (make-string (- indent-column (current-column)) ?\s)))))
+ (t (call-interactively #'newline))))
+
+(defun yaml-pro-ts--imenu-node-label (node)
+ "Return an imenu label for NODE."
+ (let ((top node)
+ (root (treesit-buffer-root-node 'yaml))
+ (label ""))
+ (while (not (treesit-node-eq node root))
+ (cond
+ ((equal (treesit-node-type node) "block_mapping_pair")
+ (let ((key-node (treesit-node-child-by-field-name node "key")))
+ (when key-node
+ (setq label (concat (treesit-node-text key-node)
+ (if (equal label "") "" (string yaml-pro-ts-path-element-separator))
+ label)))))
+ ((equal (treesit-node-type node) "block_sequence_item")
+ (setq label (format "[%d]%c%s" (treesit-node-index node) yaml-pro-ts-path-element-separator label))))
+ (setq node (treesit-node-parent node)))
+ label))
+
+(defun yaml-pro-ts-create-index ()
+ "Create imenu index of YAML file using treesitter."
+ (let ((all-keys (treesit-query-capture (treesit-buffer-root-node 'yaml) '((block_mapping_pair key: (_) @key))))
+ (imenu-items '()))
+ (dolist (key-item all-keys)
+ (let* ((key-node (cdr key-item))
+ (key-label (yaml-pro-ts--imenu-node-label key-node)))
+ (push (cons key-label (treesit-node-start key-node)) imenu-items)))
+ (seq-reverse imenu-items)))
+
+(defun yaml-pro-ts-eldoc (&rest _ignored)
+ "Return eldoc message of current point."
+ (let* ((at-tree (yaml-pro-ts--until-mapping-or-list (treesit-node-at (point) 'yaml))))
+ (when at-tree
+ (yaml-pro-ts--imenu-node-label at-tree))))
+
+(defun yaml-pro-ts--path-to-imenu-key (path)
+ "Stringify path to the same format that imenu uses.
+E.g. the path (\"one\" 0 \"two\") results in the key string \"one.[0].two\"."
+ (string-join
+ (seq-map
+ (lambda (elt) (if (numberp elt) (format "[%d]" elt) elt))
+ path)
+ (string yaml-pro-ts-path-element-separator)))
+
+(defun yaml-pro-ts-jump-to-definition (&rest parts)
+ "Jump to a part of the YAML file based on PARTS.
+If element is a sting, use it as block mapping key.
+If element is a number, use it as a sequence index."
+ (imenu (yaml-pro-ts--path-to-imenu-key parts)))
+
+(defun yaml-pro-ts-add-mapping (&rest keys)
+ "Add KEYS as levels beneath current node's block mapping.
+KEYS are added as increasingly nested levels."
+ (let* ((paths (seq-map #'car (yaml-pro-ts-create-index)))
+ (to-go keys)
+ (to-add'()))
+ (while (and (not (member (yaml-pro-ts--path-to-imenu-key to-go) paths))
+ to-go)
+ (setq to-add (append (last to-go) to-add))
+ (setq to-go (butlast to-go)))
+ (when to-go
+ (apply #'yaml-pro-ts-jump-to-definition to-go))
+ (when to-add
+ (let* ((at-node (treesit-node-at (point) 'yaml))
+ (parent (treesit-parent-until
+ at-node
+ (lambda (node)
+ (equal (treesit-node-type node) "block_mapping_pair"))
+ t))
+ (parent-indent (if to-go
+ (save-excursion
+ (goto-char (treesit-node-start parent))
+ (current-column))
+ (- yaml-pro-indent))))
+ (if (or (not to-go)
+ (or (not (treesit-node-child-by-field-name parent "value"))
+ (equal (treesit-node-type (car (treesit-node-children (treesit-node-child-by-field-name parent "value"))))
+ "block_mapping")))
+ (progn
+ (if to-go
+ (goto-char (treesit-node-end parent))
+ (goto-char (point-max))
+ (unless (looking-back "\n" (- (point) 2))
+ (insert "\n")))
+ (while to-add
+ (insert "\n")
+ (insert (make-string (+ yaml-pro-indent parent-indent) ?\s))
+ (insert (car to-add) ":")
+ (setq to-add (cdr to-add))
+ (cl-incf parent-indent yaml-pro-indent)))
+ (user-error "unable to to insert element at position"))))))
+
+(defconst yaml-pro-ts-mode-map
+ (let ((map (make-sparse-keymap)))
+ (prog1 map
+ (define-key map (kbd "C-c C-x C-w") #'yaml-pro-ts-kill-subtree)
+ (define-key map (kbd "C-c C-u") #'yaml-pro-ts-up-level)
+ (define-key map (kbd "C-c C-d") #'yaml-pro-ts-down-level)
+
+ (define-key map (kbd "C-c C-p") #'yaml-pro-ts-prev-subtree)
+ (define-key map (kbd "C-c C-n") #'yaml-pro-ts-next-subtree)
+
+ (define-key map (kbd "M-a") #'yaml-pro-ts-backward-sentence)
+ (define-key map (kbd "M-e") #'yaml-pro-ts-forward-sentence)
+
+ (define-key map (kbd "s-<up>") #'yaml-pro-ts-move-subtree-up)
+ (define-key map (kbd "s-<down>") #'yaml-pro-ts-move-subtree-down)
+
+ (define-key map (kbd "C-c >") #'yaml-pro-ts-indent-subtree)
+ (define-key map (kbd "C-c <") #'yaml-pro-ts-unindent-subtree)
+
+ (define-key map (kbd "M-<return>") #'yaml-pro-ts-meta-return)
+ (define-key map (kbd "M-?") #'yaml-pro-convolute-tree)
+ (define-key map (kbd "C-c @") #'yaml-pro-ts-mark-subtree)
+ (define-key map (kbd "C-c C-x C-y") #'yaml-pro-ts-paste-subtree)
+
+ (define-key map [remap yank] #'yaml-pro-ts-yank)
+
+ (define-key map (kbd "C-c '") #'yaml-pro-edit-ts-scalar)))
+ "Map for minor mode `yaml-pro-ts-mode'.")
+
+;;;###autoload
+(define-minor-mode yaml-pro-ts-mode
+ "Minor mode to enable yaml-pro treesitter keymap.
+
+\\{yaml-pro-mode-map}"
+ :init-value nil
+ :group 'yaml-pro
+ :keymap yaml-pro-ts-mode-map
+
+ (when yaml-pro-ts-mode
+ (unless (featurep 'treesit)
+ (user-error "Tree-sitter not supported in current Emacs version"))
+ (unless (treesit-ready-p 'yaml)
+ (user-error "YAML tree-sitter not ready"))
+ (treesit-parser-create 'yaml)
+ (setq imenu-generic-expression nil)
+ (setq imenu-create-index-function #'yaml-pro-ts-create-index)
+ (if (boundp 'eldoc-documentation-functions)
+ (add-hook 'eldoc-documentation-functions #'yaml-pro-ts-eldoc nil t)
+ (setq-local eldoc-documentation-function #'yaml-pro-ts-eldoc))))
+
+\f
+;;; yaml-pro parser
+
+(defcustom yaml-pro-max-parse-size 5000
+ "Size of buffer for which any size greater than use heuristic to parse.
+
+Note that this isn't fully compatable with every command."
+ :group 'yaml-pro
+ :type 'number
+ :package-version '(yaml-pro "0.2.0"))
+
+(defface yaml-pro-fold-replacement-face
+ '((t :inherit 'font-lock-comment-face))
+ "Face for fold replacement text.")
+
+(defcustom yaml-pro-indent (if (boundp 'yaml-indent)
+ yaml-indent
+ 2)
+ "Default indentation to use for yaml-pro."
+ :group 'yaml-pro
+ :type 'integer)
+
+(defvar-local yaml-pro-buffer-tree nil)
+
+(defun yaml-pro--get-yaml-position (string)
+ "Return the property `yaml-position' of STRING.
+This function is needed as the parser may insert unpropertized
+spacing before the match."
+ (or (get-text-property 0 'yaml-position string)
+ (get-text-property 0 'yaml-position (string-trim-left string "[ \n]*"))))
+
+(defun yaml-pro--offset-parse-tree (tree offset)
+ "Offset all TREE values of `yaml-position' property by OFFSET."
+ (cond
+ ((or (listp tree) (vectorp tree))
+ (seq-map
+ (lambda (elt)
+ (yaml-pro--offset-parse-tree elt offset))
+ tree))
+ ((stringp tree)
+ (let* ((yaml-position (yaml-pro--get-yaml-position tree)))
+ (when yaml-position
+ (let ((offset-position (cons (+ (car yaml-position) offset)
+ (+ (cdr yaml-position) offset))))
+ (set-text-properties 0
+ (length tree)
+ (list 'yaml-position offset-position)
+ tree)))))))
+
+(defun yaml-pro--use-fast-p ()
+ "Return non nil if buffer size is larger than `yaml-pro-max-parse-size'."
+ (>= (buffer-size) yaml-pro-max-parse-size))
+
+(defun yaml-pro--fast-parse-bounds (&optional point)
+ "Return a list of the start and end point of subsection to parse.
+
+Find subsection based off of POINT if provided."
+ (let* ((point-indent
+ (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward " ")
+ (current-column)))
+ (indent-regexp (make-string point-indent ?\s))
+ (start-point)
+ (end-point))
+ (if (= point-indent 0)
+ (setq start-point (point-min)
+ end-point (point-max))
+ (save-excursion
+ (beginning-of-line)
+ (while (not (or (bobp)
+ (and (looking-at " *[a-zA-Z_0-9-]+:\\s-*$")
+ (not (looking-at indent-regexp)))))
+ (forward-line -1))
+ (setq start-point (point)))
+ (save-excursion
+ (beginning-of-line)
+ (while (not (or (eobp)
+ (and (not (looking-at indent-regexp))
+ (not (looking-at " *$")))))
+ (forward-line 1))
+ (setq end-point (point))))
+ (list start-point end-point)))
+
+(defun yaml-pro--get-buffer-tree ()
+ "Return the cached buffer-tree if exists, else regenerate it."
+ (or yaml-pro-buffer-tree
+ (if (not (yaml-pro--use-fast-p))
+ (let ((tree (yaml-parse-tree (buffer-string))))
+ (setq yaml-pro-buffer-tree tree)
+ tree)
+ (seq-let (start-point end-point) (yaml-pro--fast-parse-bounds)
+ (let* ((subsection-string (buffer-substring start-point end-point))
+ (tree (yaml-parse-tree subsection-string)))
+ (yaml-pro--offset-parse-tree tree (1- start-point))
+ (when (and (= start-point (point-min))
+ (= end-point (point-max)))
+ (setq yaml-pro-buffer-tree tree))
+ tree)))))
+
+(defun yaml-pro--after-change-hook (_ _ _)
+ "Delete cached tree on buffer change."
+ (setq yaml-pro-buffer-tree nil))
+
+(defun yaml-pro--find-node (parse point)
+ "Recursively look through PARSE to find scalar at POINT."
+ (catch 'done
+ (cond
+ ((vectorp parse)
+ (seq-do
+ (lambda (item)
+ (let ((res (yaml-pro--find-node item point)))
+ (when res
+ (throw 'done res))))
+ parse)
+ nil)
+ ((listp parse)
+ (dolist (item parse)
+ (let ((res (yaml-pro--find-node (cdr item) point)))
+ (when res
+ (throw 'done res)))))
+ ((stringp parse)
+ (let* ((bounds (yaml-pro--get-yaml-position parse))
+ (start (and bounds (car bounds)))
+ (end (and bounds (cdr bounds))))
+ (if (and start end (<= start point end))
+ parse
+ nil))))))
+
+(defun yaml-pro--fast-value-at-point ()
+ "Return the scalar under the current point.
+
+This function uses a heuristic to limit the amount of parsing
+that has to be done."
+
+ (seq-let (start-point end-point) (yaml-pro--fast-parse-bounds)
+ (let* ((subsection-string (buffer-substring start-point end-point))
+ (parse (yaml-parse-string-with-pos subsection-string))
+ (val (yaml-pro--find-node parse (1+ (- (point) start-point)))))
+ (when val
+ (let* ((yaml-position (yaml-pro--get-yaml-position val))
+ (new-position (cons (1- (+ (car yaml-position) start-point))
+ (1- (+ (cdr yaml-position) start-point)))))
+ (set-text-properties 0 (length val) (list 'yaml-position new-position) val)
+ val)))))
+
+(defun yaml-pro--value-at-point ()
+ "Return the scalar under the current point."
+ (let* ((parse (yaml-parse-string-with-pos (buffer-string))))
+ (yaml-pro--find-node parse (point))))
+
+(defun yaml-pro--get-parent-block* (tree point)
+ "Return subtree from TREE that best contain POINT."
+ (if (not (listp tree))
+ nil
+ (let ((sub-blocks
+ (seq-filter #'identity
+ (seq-map (lambda (st)
+ (yaml-pro--get-parent-block* st point))
+ tree))))
+ (cond
+ ((and sub-blocks
+ (stringp (car tree))
+ (let* ((bounds (yaml-pro--get-yaml-position (cadr tree)))
+ (start (car bounds))
+ (end (cdr bounds)))
+ (and (numberp start) (<= start point end))))
+ (let* ((bounds (yaml-pro--get-yaml-position (cadr tree)))
+ (start (car bounds))
+ (end (cdr bounds)))
+ (throw 'result (list start end))))
+ (sub-blocks
+ (car sub-blocks))
+ ((stringp (car tree))
+ (let* ((bounds (yaml-pro--get-yaml-position (cadr tree)))
+ (start (and bounds (car bounds)))
+ (end (and bounds (cdr bounds))))
+ (if (and (numberp start) (<= start point end))
+ (list start end)
+ nil)))
+ (t nil)))))
+
+(defun yaml-pro-get-parent-block (tree point)
+ "Return the nearest parent block in TREE to node in POINT."
+ (catch 'result
+ (yaml-pro--get-parent-block* tree point)))
+
+(defun yaml-pro-get-block-bounds (tree point)
+ "Return subtree from TREE that best contain POINT."
+ (if (not (listp tree))
+ nil
+ (let ((sub-blocks
+ (seq-filter #'identity
+ (seq-map (lambda (st) (yaml-pro-get-block-bounds st point))
+ tree))))
+ (cond
+ (sub-blocks
+ ;; TODO should find best match instead of firt (?)
+ (car sub-blocks))
+ ((and (stringp (car tree)) (not (equal (car tree) "")))
+ (let* ((bounds (yaml-pro--get-yaml-position (cadr tree)))
+ (start (and bounds (car bounds)))
+ (end (and bounds (cdr bounds))))
+ (if (and
+ (numberp start)
+ (<= start point end)
+ (not (= (save-excursion
+ (goto-char start) (beginning-of-line) (point))
+ (save-excursion
+ (goto-char end) (beginning-of-line) (point)))))
+ (list start end)
+ nil)))
+ (t nil)))))
+
+(defun yaml-pro-get-block (tree point)
+ "Return subtree from TREE that best contain POINT."
+ (if (not (listp tree))
+ nil
+ (let ((sub-blocks
+ (seq-filter #'identity
+ (seq-map (lambda (st) (yaml-pro-get-block st point))
+ tree))))
+ (cond
+ (sub-blocks
+ ;; TODO should find best match instead of firt (?)
+ (car sub-blocks))
+ ((stringp (car tree))
+ (let* ((bounds (yaml-pro--get-yaml-position (cadr tree)))
+ (start (and bounds (car bounds)))
+ (end (and bounds (cdr bounds))))
+ (if (and (numberp start)
+ (<= start point end)
+ ;; hack to get small maps to not get selected
+ (yaml-pro--fix-bounds (list start end)))
+ (list start end)
+ nil)))
+ (t nil)))))
+
+(defun yaml-pro--fix-bounds (bounds)
+ "Adjust BOUNDS to proper fold points."
+ (seq-let (beg end) bounds
+ (save-excursion
+ (goto-char beg)
+ (cond
+ ((looking-at-p "[ \t]*-")
+ (setq beg (1- (point))))
+ ((and (not (looking-at "{"))
+ (not (looking-at "\\[")))
+ (end-of-line)
+ (setq beg (point)))
+ ((looking-at-p "\\(\\[\\|{\\)")
+ (setq beg (1+ (point))))))
+ (save-excursion
+ (goto-char end)
+ (cond
+ ((looking-back "\n" (- (point) 2))
+ (setq end (1- end)))
+ ((looking-back "\\(\\]\\|\\}\\)" (- (point) 2))
+ (setq end (1- end)))))
+ (if (>= beg end)
+ nil
+ (list beg end))))
+
+(defun yaml-pro--search-location (tree point path)
+ "Return path up to POINT of TREE having visited at PATH."
+ (cond
+ ((stringp tree)
+ (let ((pos (yaml-pro--get-yaml-position tree)))
+ (when (<= (car pos) point (cdr pos))
+ path)))
+ (t
+ (seq-find #'identity
+ (seq-map
+ (lambda (tuple)
+ (let* ((key (car tuple))
+ (key-pos (and (stringp key)
+ (yaml-pro--get-yaml-position key)))
+ (val (cdr tuple))
+ (val-pos (and (stringp val)
+ (yaml-pro--get-yaml-position val))))
+ (cond
+ ((and key-pos (<= (car key-pos) point (cdr key-pos)))
+ path)
+ ((and val-pos (<= (car val-pos) point (cdr val-pos)))
+ (cons key path))
+ ((vectorp val)
+ (catch 'found
+ (dotimes (i (length val))
+ (let* ((elt (aref val i))
+ (res (yaml-pro--search-location
+ elt
+ point
+ (cons (number-to-string i)
+ (cons key path)))))
+ (when res
+ (throw 'found res))))
+ nil))
+ ((listp val)
+ (yaml-pro--search-location val point (cons key path)))
+ (t nil))))
+ tree)))))
+
+(defun yaml-pro--path-at-point ()
+ "Return the object path to current point.
+
+NOTE: This is an experimental feature."
+ ;; first look for current position
+ (let* ((parse (yaml-parse-string-with-pos (buffer-string)))
+ (path (yaml-pro--search-location parse (point) '())))
+ (seq-map
+ (lambda (s)
+ (set-text-properties 0 (length s) nil s)
+ s)
+ (or (nreverse path)
+ ;; if not found, go back before ":" and try again
+ (save-excursion
+ (when (looking-back "[ \"a-zA-Z_-]+: +[ \"a-zA-Z_-]+" (- (point) 60))
+ (beginning-of-line)
+ (skip-chars-forward " ")
+ (let ((path (yaml-pro--search-location parse (point) '())))
+ (nreverse path))))))))
+
+(defun yaml-pro--flatten-tree (tree)
+ "Return a \"flattened\" copy of TREE. Copied from Emacs 27.1."
+ (let (elems)
+ (while (consp tree)
+ (let ((elem (pop tree)))
+ (while (consp elem)
+ (push (cdr elem) tree)
+ (setq elem (car elem)))
+ (if elem (push elem elems))))
+ (if tree (push tree elems))
+ (nreverse elems)))
+
+(defun yaml-pro--extract-paths (tree &optional path)
+ "Given TREE of parse, return all paths of tree to leaf nodes.
+
+PATH is the current path we have already traversed down."
+ (cond
+ ((listp tree)
+ (yaml-pro--flatten-tree
+ (seq-map (lambda (key+val)
+ (yaml-pro--extract-paths (cdr key+val)
+ (append path (list (car key+val)))))
+ tree)))
+ ((vectorp tree)
+ (yaml-pro--flatten-tree
+ (seq-mapn
+ (lambda (n val)
+ (yaml-pro--extract-paths val (append path (list (format "[%d]" n)))))
+ (number-sequence 0 (1- (length tree)))
+ tree)))
+ (t (concat (string-join path " ") ": " tree))))
+
+(defun yaml-pro-hide-overlay (ov)
+ "Put fold-related properties on overlay OV."
+ (overlay-put ov 'invisible 'yaml-pro)
+ (overlay-put ov 'display "...")
+ (overlay-put ov 'face 'yaml-pro-fold-replacement-face))
+
+(defun yaml-pro-show-overlay (ov)
+ "Remove fold-related properties of overlay OV."
+ (overlay-put ov 'invisible nil)
+ (overlay-put ov 'display nil)
+ (overlay-put ov 'face nil))
+
+(defun yaml-pro--get-last-yaml-pos (str)
+ "Return the last-most text-property `yaml-position' of STR."
+ (let ((i (1- (length str)))
+ (pos))
+ (while (or (not pos) (< i 0))
+ (let ((at-pos (get-text-property i 'yaml-position str)))
+ (when at-pos
+ (setq pos at-pos))
+ (cl-decf i)))
+ pos))
+
+(defun yaml-pro-jump ()
+ "Jump to a specified path."
+ (interactive)
+ (let* ((tree (yaml-parse-string-with-pos (buffer-string)))
+ (paths (yaml-pro--extract-paths tree))
+ (selected (completing-read "Jump to: " paths nil t))
+ ;; get original string which has properties intact
+ (original-str (seq-find (lambda (s) (string= s selected)) paths))
+ (pos (yaml-pro--get-last-yaml-pos original-str)))
+ (goto-char (car pos))))
+
+(declare-function consult--read "consult")
+(declare-function consult--overlay "consult")
+(declare-function consult--invisible-open-temporarily "consult")
+
+(defun yaml-pro--consult-jump-preview ()
+ "Return a consult function for displaying current selection."
+ (let ((invisible)
+ (overlays)
+ (saved-pos (point-marker))
+ (saved-min (point-min-marker))
+ (saved-max (point-max-marker)))
+ (lambda (cand restore)
+ (mapc #'funcall invisible)
+ (mapc #'delete-overlay overlays)
+ (cond
+ (restore
+ (let ((saved-buffer (marker-buffer saved-pos)))
+ (set-buffer saved-buffer)
+ (narrow-to-region saved-min saved-max)
+ (goto-char saved-pos)))
+ (cand
+ (let ((pos (and (not (string-blank-p cand))
+ (yaml-pro--get-last-yaml-pos cand))))
+ (when pos
+ (widen)
+ (goto-char (car pos))
+ (run-hooks 'consult-after-jump-hook)
+ (setq invisible (consult--invisible-open-temporarily)
+ overlays
+ (list (consult--overlay (car pos) (cdr pos)
+ 'face 'consult-preview-cursor
+ 'window (selected-window)))))))))))
+
+;;; Interactive commands
+
+(defun yaml-pro-consult-jump ()
+ "Jump to a specified path."
+ (interactive)
+ (let* ((tree (yaml-parse-string-with-pos (buffer-string)))
+ (paths (yaml-pro--extract-paths tree))
+ (sorted-paths (seq-sort-by (lambda (path)
+ (car (yaml-pro--get-last-yaml-pos path)))
+ #'< paths))
+ (selected (consult--read
+ sorted-paths
+ :prompt "Jump to: "
+ :history 'yaml-pro-jump
+ :require-match t
+ :sort nil
+ :state (let ((preview (yaml-pro--consult-jump-preview)))
+ (lambda (str restore)
+ (funcall preview str restore)))))
+ (original-str (seq-find (lambda (s) (string= s selected)) paths)))
+ (goto-char (car (yaml-pro--get-last-yaml-pos original-str)))))
+
+(defun yaml-pro-fold-at-point ()
+ "Fold YAML at point."
+ (interactive)
+ (save-excursion
+ (skip-syntax-forward " " (line-end-position))
+ (let ((parse-tree (yaml-pro--get-buffer-tree)))
+ (let* ((bounds (yaml-pro--fix-bounds
+ (yaml-pro-get-block parse-tree (point))))
+ (beg (car bounds))
+ (end (cadr bounds)))
+ (when bounds
+ ;; Delete all inner folds before creating outer one
+ (let ((ovs (overlays-in beg end)))
+ (dolist (ov ovs)
+ (when (eql (overlay-get ov 'creator) 'yaml-pro)
+ (delete-overlay ov))))
+ (let ((ov (make-overlay beg end)))
+ (overlay-put ov 'creator 'yaml-pro)
+ (overlay-put ov 'invisible 'yaml-pro)
+ (overlay-put ov 'isearch-open-invisible 'yaml-pro-isearch-show)
+ (overlay-put ov 'isearch-open-invisible-temporary
+ (lambda (ov hide-p)
+ (if hide-p (yaml-pro-hide-overlay ov)
+ (yaml-pro-show-overlay ov))))
+ (overlay-put ov 'display "...")
+ (overlay-put ov 'face 'yaml-pro-fold-replacement-face)))))))
+
+(defun yaml-pro-unfold-at-point ()
+ "Unfold YAML at point."
+ (interactive)
+ (save-excursion
+ (cond
+ ((looking-at ".*:")
+ (let ((ovs (overlays-in (point)
+ (save-excursion (end-of-line) (1+ (point))))))
+ (dolist (ov ovs)
+ (when (eql (overlay-get ov 'creator) 'yaml-pro)
+ (delete-overlay ov)))))
+ (t
+ (let ((ovs (overlays-at (1+ (point)))))
+ (dolist (ov ovs)
+ (when (eql (overlay-get ov 'creator) 'yaml-pro)
+ (delete-overlay ov))))))))
+
+(defun yaml-pro-up-level ()
+ "Move the point to the parent tree."
+ (interactive)
+ (if (and (bolp) (not (looking-at "[ \n\t#]")))
+ (goto-char (point-min))
+ (let* ((start (point))
+ (parse-tree (yaml-pro--get-buffer-tree))
+ (bounds (yaml-pro-get-block-bounds parse-tree (point))))
+ (goto-char (car bounds))
+ (when (= start (point))
+ (let* ((parse-tree (yaml-pro--get-buffer-tree))
+ (bounds (yaml-pro-get-parent-block parse-tree (point))))
+ (goto-char (car bounds))
+ (when (= start (point))
+ ;; the block we're at and it's parent have the same start,
+ ;; move back one char and try again
+ (forward-char -1)
+ (yaml-pro-up-level))))
+ (when (and (bolp) (looking-at "[ \t]"))
+ ;; Don't let the command end at a block that begins a line
+ (yaml-pro-up-level)))))
+
+(defun yaml-pro-kill-subtree ()
+ "Kill the entire subtree located at the current point."
+ (interactive)
+ (let* ((parse-tree (yaml-pro--get-buffer-tree))
+ (bounds (yaml-pro-get-block-bounds parse-tree (point)))
+ (start (car bounds))
+ (end (cadr bounds)))
+ (when (save-excursion
+ (goto-char end)
+ (looking-back "\n" (- (point) 2)))
+ (setq end (1- end)))
+ (kill-region start end)))
+
+(defun yaml-pro-prev-subtree ()
+ "Move the point to the previous sibling subtree."
+ (interactive)
+ (let* ((start-pos (point))
+ (parse-tree (yaml-pro--get-buffer-tree))
+ (at-bounds (yaml-pro-get-block-bounds parse-tree (point))))
+ (goto-char (car at-bounds))
+ (let ((at-col (current-column))
+ (at-dash-p (looking-at "-")))
+ (catch 'done
+ (while (not (bobp))
+ (forward-line -1)
+ (while (looking-at "[ \n]*$")
+ (forward-line -1))
+ (if at-dash-p
+ (skip-chars-forward " \n")
+ (skip-chars-forward " \n-"))
+ (when (and (< (current-column) at-col)
+ (not (looking-at "#")))
+ (goto-char start-pos)
+ (ding)
+ (throw 'done nil))
+ (when (and (= (current-column) at-col)
+ (not (looking-at "#")))
+ (throw 'done t)))
+ (if (looking-at "#")
+ (progn
+ (goto-char start-pos)
+ (ding)
+ nil)
+ t)))))
+
+(defun yaml-pro-next-subtree ()
+ "Move the point to the next sibling subtree."
+ (interactive)
+ (let* ((start-pos (point))
+ (start-col (current-column))
+ (parse-tree (yaml-pro--get-buffer-tree))
+ (at-bounds (yaml-pro-get-block-bounds parse-tree (point))))
+ (goto-char (cadr at-bounds))
+ (skip-chars-forward " \n")
+ (if (or (not (= start-col (current-column)))
+ (eobp))
+ (progn
+ (ding)
+ (goto-char start-pos)
+ nil)
+ t)))
+
+(defun yaml-pro-indent-subtree ()
+ "Indent the current subtree by one level.
+
+Indentation is controlled by the variable `yaml-pro-indent'."
+ (interactive)
+ (save-excursion
+ (back-to-indentation)
+ (let* ((parse-tree (yaml-pro--get-buffer-tree))
+ (at-bounds (yaml-pro-get-block-bounds parse-tree (point))))
+ (goto-char (car at-bounds))
+ (if (not (looking-back "^[ ]*" nil))
+ (progn
+ (forward-line 0)
+ (skip-chars-forward " ")
+ (yaml-pro-indent-subtree))
+ (let ((beginning-line (line-number-at-pos)))
+ (goto-char (cadr at-bounds))
+ (when (looking-back "\n" (- (point) 2))
+ (forward-char -1))
+ (forward-line 0)
+ (while (>= (line-number-at-pos) beginning-line)
+ (insert (make-string yaml-pro-indent ?\s))
+ (forward-line -1)))))))
+
+(defun yaml-pro-unindent-subtree ()
+ "Unindent the current subtree by one level.
+
+Indentation is controlled by the variable `yaml-pro-indent'."
+ (interactive)
+ (let* ((parse-tree (yaml-pro--get-buffer-tree))
+ (at-bounds (yaml-pro-get-block-bounds parse-tree (point))))
+ (save-excursion
+ (goto-char (car at-bounds))
+ ;; ensure that the subtree can be unintented
+ (save-excursion
+ (forward-line 0)
+ (unless (looking-at-p (make-string yaml-pro-indent ?\s))
+ (error "Subtree can't be unintented further")))
+ (if (not (looking-back "^[ ]*" nil))
+ (progn
+ (forward-line 0)
+ (skip-chars-forward " ")
+ (yaml-pro-indent-subtree))
+ (let ((beginning-line (line-number-at-pos)))
+ (goto-char (cadr at-bounds))
+ (when (looking-back "\n" (- (point) 2))
+ (forward-char -1))
+ (forward-line 0)
+ (while (>= (line-number-at-pos) beginning-line)
+ (when (looking-at-p (make-string yaml-pro-indent ?\s))
+ (delete-char yaml-pro-indent))
+ (forward-line -1)))))))
+
+(defun yaml-pro-move-subtree-up ()
+ "Swap the current subtree with the previous one."
+ (interactive)
+ (let* ((parse-tree (yaml-pro--get-buffer-tree))
+ (at-bounds (yaml-pro-get-block-bounds parse-tree (point)))
+ (at-contents (buffer-substring (car at-bounds) (cadr at-bounds)))
+ (prev-bounds (save-excursion
+ (let ((ok (yaml-pro-prev-subtree)))
+ (and ok (yaml-pro-get-block-bounds parse-tree
+ (point))))))
+ (prev-contents (and prev-bounds
+ (buffer-substring (car prev-bounds)
+ (cadr prev-bounds)))))
+ (when (not prev-bounds)
+ (error "Can't move subtree"))
+ (goto-char (car at-bounds))
+ (delete-region (car at-bounds) (cadr at-bounds))
+ (insert prev-contents)
+ (goto-char (car prev-bounds))
+ (delete-region (car prev-bounds) (cadr prev-bounds))
+ (insert at-contents)
+ (goto-char (car prev-bounds))))
+
+(defun yaml-pro-move-subtree-down ()
+ "Swap the current subtree with the previous one."
+ (interactive)
+ (yaml-pro-next-subtree)
+ (yaml-pro-move-subtree-up)
+ (yaml-pro-next-subtree))
+
+(defun yaml-pro-create-index ()
+ "Create an imenu index using the legacy parser."
+ (let* ((tree (yaml-parse-string-with-pos (buffer-string)))
+ (paths (yaml-pro--extract-paths tree))
+ (sorted-paths (seq-sort-by (lambda (path)
+ (car (yaml-pro--get-last-yaml-pos path)))
+ #'< paths)))
+ (seq-map
+ (lambda (item)
+ (let ((pos (car (yaml-pro--get-last-yaml-pos item))))
+ (cons item pos)))
+ sorted-paths)))
+
+(defconst yaml-pro-mode-map
+ (let ((map (make-sparse-keymap)))
+ (prog1 map
+ (define-key map (kbd "C-c C-x C-w") #'yaml-pro-kill-subtree)
+
+ (define-key map (kbd "C-c C-u") #'yaml-pro-up-level)
+
+ (define-key map (kbd "C-c C-p") #'yaml-pro-prev-subtree)
+ (define-key map (kbd "C-c C-n") #'yaml-pro-next-subtree)
+
+ (define-key map (kbd "C-c C-f") #'yaml-pro-fold-at-point)
+ (define-key map (kbd "C-c C-o") #'yaml-pro-unfold-at-point)
+
+ (define-key map (kbd "s-<up>") #'yaml-pro-move-subtree-up)
+ (define-key map (kbd "s-<down>") #'yaml-pro-move-subtree-down)
+
+ (define-key map (kbd "C-c '") #'yaml-pro-edit-scalar)
+
+ (define-key map (kbd "C-c >") #'yaml-pro-indent-subtree)
+
+ (define-key map (kbd "C-c <") #'yaml-pro-unindent-subtree)
+
+ (define-key map (kbd "C-c C-j") (if (featurep 'consult)
+ #'yaml-pro-consult-jump
+ #'yaml-pro-jump)))))
+
+(make-obsolete 'yaml-pro-consult-jump "Use imenu feature instead of this command." "0.3.2")
+
+(defconst yaml-pro-required-yaml-parser-version "0.5.1")
+
+;;;###autoload
+(define-minor-mode yaml-pro-mode
+ "Binds additional functions to aid in editing YAML files.
+
+\\{yaml-pro-mode-map}"
+ :init-value nil
+ :group 'yaml-pro
+ :keymap yaml-pro-mode-map
+ (if yaml-pro-mode
+ (progn
+ (when (or (not (boundp 'yaml-parser-version))
+ (not yaml-parser-version)
+ (version< yaml-parser-version
+ yaml-pro-required-yaml-parser-version))
+ (error "Unsupported yaml.el version. \
+Ensure that yaml.el package installed and at version %s"
+ yaml-pro-required-yaml-parser-version))
+ (setq imenu-generic-expression nil)
+ (setq imenu-create-index-function #'yaml-pro-create-index)
+ (when (equal mode-name "YAML")
+ (add-hook 'after-change-functions #'yaml-pro--after-change-hook nil t)))
+ (remove-hook 'after-change-functions #'yaml-pro--after-change-hook t)))
+
+(provide 'yaml-pro)
+
+;;; yaml-pro.el ends here
projects / emacsconfig.git / commitdiff