;;; evil-surround.el --- emulate surround.vim from Vim

;; Copyright (C) 2010 - 2017 Tim Harper
;; Copyright (C) 2018 - 2020 The evil-surround.el Contributors

;; Licensed under the same terms as Emacs (GPLv3)

;;
;; Author: Tim Harper <timcharper at gmail dot com>
;;         Vegard Øye <vegard_oye at hotmail dot com>
;; Current Maintainer: ninrod (github.com/ninrod)
;; Created: July 23 2011
;; Version: 1.0.3
;; Package-Version: 1.1.1
;; Package-Commit: 346d4d85fcf1f9517e9c4991c1efe68b4130f93a
;; Package-Requires: ((evil "1.2.12"))
;; Mailing list: <implementations-list at lists.ourproject.org>
;;      Subscribe: http://tinyurl.com/implementations-list
;;      Newsgroup: nntp://news.gmane.org/gmane.emacs.vim-emulation
;;      Archives: http://dir.gmane.org/gmane.emacs.vim-emulation
;; Keywords: emulation, vi, evil
;;
;; This file is not part of GNU Emacs.

;;; Commentary:

;; This package emulates surround.vim by Tim Pope.
;; The functionality is wrapped into a minor mode. To enable
;; it globally, add the following lines to ~/.emacs:
;;
;;     (require 'evil-surround)
;;     (global-evil-surround-mode 1)
;;
;; Alternatively, you can enable evil-surround-mode along a major mode
;; by adding `turn-on-evil-surround-mode' to the mode hook.
;;
;; This package uses Evil as its vi layer. It is available from:
;;
;;     https://github.com/emacs-evil/evil

;;; Code:

(require 'evil)

(defgroup evil-surround nil
  "surround.vim for Emacs"
  :prefix "evil-surround-"
  :group 'evil)

;; make surround's `ysw' work like `cw', not `ce'
(when (boundp 'evil-change-commands)
  (add-to-list 'evil-change-commands 'evil-surround-region))

(defcustom evil-surround-pairs-alist
  '((?\( . ("( " . " )"))
    (?\[ . ("[ " . " ]"))
    (?\{ . ("{ " . " }"))

    (?\) . ("(" . ")"))
    (?\] . ("[" . "]"))
    (?\} . ("{" . "}"))

    (?# . ("#{" . "}"))
    (?b . ("(" . ")"))
    (?B . ("{" . "}"))
    (?> . ("<" . ">"))
    (?t . evil-surround-read-tag)
    (?< . evil-surround-read-tag)
    (?f . evil-surround-function))
  "Association list of surround items.
Each item is of the form (TRIGGER . (LEFT . RIGHT)), all strings.
Alternatively, a function can be put in place of (LEFT . RIGHT).
This only affects inserting pairs, not deleting or changing them."
  :group 'evil-surround
  :type '(alist
          :key-type (character :tag "Key")
          :value-type (choice
                       (cons (string :tag "Opening") (string :tag "Closing"))
                       (function :tag "Function"))))
(make-variable-buffer-local 'evil-surround-pairs-alist)

(defcustom evil-surround-operator-alist
  '((evil-change . change)
    (evil-delete . delete))
  "Association list of operators to their fundamental operation.
Each item is of the form (OPERATOR . OPERATION)."
  :group 'evil-surround
  :type '(repeat (cons (symbol :tag "Operator")
                       (symbol :tag "Operation"))))

(defvar evil-surround-read-tag-map
  (let ((map (copy-keymap minibuffer-local-map)))
    (define-key map ">" (lambda ()
                          (interactive)
                          (call-interactively #'self-insert-command)
                          (exit-minibuffer)))
    map)
  "Keymap used by `evil-surround-read-tag'.")

(defvar evil-surround-record-repeat nil
  "Flag to indicate we're manually recording repeat info.")

(defvar evil-surround-last-deleted-left ""
  "The previously deleted LEFT region.")

(defun evil-surround-read-from-minibuffer (&rest args)
  (when (or evil-surround-record-repeat
            (evil-repeat-recording-p))
    (evil-repeat-keystrokes 'post))
  (let ((res (apply #'read-from-minibuffer args)))
    (when (or evil-surround-record-repeat
              (evil-repeat-recording-p))
      (evil-repeat-record res))
    res))

;; The operator state narrows the buffer to the current field. This
;; function widens temporarily before reading a character so the
;; narrowing is not visible to the user.
(defun evil-surround-read-char ()
  (if (evil-operator-state-p)
      (save-restriction (widen) (read-char))
    (read-char)))

(defun evil-surround-input-char ()
  (list (evil-surround-read-char)))

(defun evil-surround-input-region-char ()
  (append (evil-operator-range t)
          (evil-surround-input-char)))

(defun evil-surround-function ()
  "Read a functionname from the minibuffer and wrap selection in function call"
  (let ((fname (evil-surround-read-from-minibuffer "" "")))
    (cons (format "%s(" (or fname ""))
          ")")))

(defconst evil-surround-tag-name-re "\\([0-9a-zA-Z\.-]+\\)"
  "Regexp matching an XML tag name.")

(defun evil-surround-tag-p (string)
  "Return t if `STRING' looks like a tag."
  (string-match-p evil-surround-tag-name-re string))

(defun evil-surround-read-tag ()
  "Read a XML tag from the minibuffer."
  (let* ((input (evil-surround-read-from-minibuffer "<" "" evil-surround-read-tag-map))
         (match (string-match (concat evil-surround-tag-name-re "\\(.*?\\)\\([>]*\\)$") input))
         (tag  (match-string 1 input))
         (rest (match-string 2 input))
         (keep-attributes (not (string-match-p ">" input)))
         (original-tag (when (evil-surround-tag-p evil-surround-last-deleted-left)
                         (substring evil-surround-last-deleted-left
                                    (string-match (concat "<" evil-surround-tag-name-re) evil-surround-last-deleted-left)
                                    (match-end 0))))
         (original-attributes (when (and keep-attributes original-tag)
                                (substring evil-surround-last-deleted-left (length original-tag)))))
    (cons (format "<%s%s%s" (or tag "") (or rest "") (or original-attributes ">"))
          (format "</%s>" (or tag "")))))

(defun evil-surround-valid-char-p (char)
  "Returns whether CHAR is a valid surround char or not."
  (not (memq char '(?\C-\[ ?\C-?))))

(defun evil-surround-delete-char-noop-p (char)
  "Returns whether CHAR is a noop when used with surround delete."
  (memq char (list (string-to-char "w")
                   (string-to-char "W")
                   (string-to-char "s")
                   (string-to-char "p"))))

(defun evil-surround-pair (char)
  "Return the evil-surround pair of char.
This is a cons cell (LEFT . RIGHT), both strings."
  (let ((pair (assoc-default char evil-surround-pairs-alist)))
    (cond
     ((functionp pair)
      (funcall pair))

     ((consp pair)
      pair)

     (t
      (cons (format "%c" char) (format "%c" char))))))

(defvar-local evil-surround-local-outer-text-object-map-list nil
  "Buffer-local list of outer text object keymaps that are added to
  evil-surround")

(defvar-local evil-surround-local-inner-text-object-map-list nil
  "Buffer-local list of inner text object keymaps that are added to
  evil-surround")

(defun evil-surround-outer-overlay (char)
  "Return outer overlay for the delimited range represented by CHAR.
This overlay includes the delimiters.
See also `evil-surround-inner-overlay'."
  (let ((outer (lookup-key
                 (make-composed-keymap
                   evil-surround-local-outer-text-object-map-list
                   evil-outer-text-objects-map) (string char))))
    (when (functionp outer)
      (setq outer (funcall outer))
      (when (evil-range-p outer)
        (evil-surround-trim-whitespace-from-range outer "[[:space:]]")
        (setq outer (make-overlay (evil-range-beginning outer)
                                  (evil-range-end outer)
                                  nil nil t))))))

(defun evil-surround-trim-whitespace-from-range (range &optional regexp)
  "Given an evil-range, trim whitespace around range by shrinking the range such that it neither begins nor ends with whitespace. Does not modify the buffer."
  (let ((regexp (or regexp "[ \f\t\n\r\v]")))
    (save-excursion
      (save-match-data
        (goto-char (evil-range-beginning range))
        (while (looking-at regexp) (forward-char))
        (evil-set-range-beginning range (point))
        (goto-char (evil-range-end range))
        (while (looking-back regexp) (backward-char))
        (evil-set-range-end range (point))))))

(defun evil-surround-inner-overlay (char)
  "Return inner overlay for the delimited range represented by CHAR.
This overlay excludes the delimiters.
See also `evil-surround-outer-overlay'."
  (let ((inner (lookup-key
                 (make-composed-keymap
                   evil-surround-local-inner-text-object-map-list
                   evil-inner-text-objects-map) (string char))))
    (when (functionp inner)
      (setq inner (funcall inner))
      (when (evil-range-p inner)
        (when (eq (char-syntax char) ?\()
          (evil-surround-trim-whitespace-from-range inner "[[:space:]]"))
        (setq inner (make-overlay (evil-range-beginning inner)
                                  (evil-range-end inner)
                                  nil nil t))))))

(evil-define-motion evil-surround-line (count)
  "Move COUNT - 1 lines down but return exclusive character motion."
  :type exclusive
  (let ((beg (line-beginning-position)))
    (evil-line count)
    (end-of-line)
    (let ((range (evil-range beg (point) 'exclusive)))
      (evil-expand-range range)
      range)))

;;;###autoload
(defun evil-surround-delete (char &optional outer inner)
  "Delete the surrounding delimiters represented by CHAR.
Alternatively, the text to delete can be represented with
the overlays OUTER and INNER, where OUTER includes the delimiters
and INNER excludes them. The intersection (i.e., difference)
between these overlays is what is deleted."
  (interactive (evil-surround-input-char))
  (cond
   ((and outer inner)
    (setq evil-surround-last-deleted-left
          (delete-and-extract-region (overlay-start outer) (overlay-start inner)))
    (delete-region (overlay-end inner) (overlay-end outer))
    (goto-char (overlay-start outer)))
   (t
    ;; no overlays specified: create them on the basis of CHAR
    ;; and delete after use
    (let* ((outer (evil-surround-outer-overlay char))
           (inner (evil-surround-inner-overlay char)))
      (unwind-protect
          (when (and outer inner)
            (evil-surround-delete char outer inner))
        (when outer (delete-overlay outer))
        (when inner (delete-overlay inner)))))))

;;;###autoload
(defun evil-surround-change (char &optional outer inner)
  "Change the surrounding delimiters represented by CHAR.
Alternatively, the text to delete can be represented with the
overlays OUTER and INNER, which are passed to `evil-surround-delete'."
  (interactive (evil-surround-input-char))
  (cond
   ((and outer inner)
    (unless (evil-surround-delete-char-noop-p char)
      (evil-surround-delete char outer inner))
    (let ((key (evil-surround-read-char)))
      (evil-surround-region (overlay-start outer)
                            (overlay-end outer)
                            nil (if (evil-surround-valid-char-p key) key char))))
   (t
    (let* ((outer (evil-surround-outer-overlay char))
           (inner (evil-surround-inner-overlay char)))
      (unwind-protect
          (when (and outer inner)
            (evil-surround-change char outer inner))
        (when outer (delete-overlay outer))
        (when inner (delete-overlay inner)))))))

(defun evil-surround-interactive-setup ()
  (setq evil-inhibit-operator t)
  (list (assoc-default evil-this-operator
                       evil-surround-operator-alist)))

(defun evil-surround-setup-surround-line-operators ()
  (define-key evil-operator-shortcut-map "s" 'evil-surround-line)
  (define-key evil-operator-shortcut-map "S" 'evil-surround-line))

(defun evil-surround-column-at (pos)
  (save-excursion (goto-char pos) (current-column)))

(defun evil-surround-block (beg end char)
  "Surrounds a block selection with a character, as if `evil-surround-region'
were called on each segment in each line. This skips lines where EOL < BEG's
column."
  (let ((beg-col (evil-surround-column-at beg))
        (end-col (evil-surround-column-at end)))
    (evil-apply-on-block
     (lambda (ibeg iend)
       (unless (< (evil-surround-column-at ibeg) (min beg-col end-col))
         (evil-surround-region ibeg iend t char)))
     beg end nil)))

(defun evil-surround-call-with-repeat (callback)
  "Record keystrokes to repeat surround-region operator and it's motion.
This is necessary because `evil-yank' operator is not repeatable (:repeat nil)"
  (evil-repeat-start)
  (evil-repeat-record "y")
  (evil-repeat-record (this-command-keys))

  ;; set `this-command-keys' to the command that will be executed
  ;; interactively; as a result, `evil-this-operator' will be
  ;; correctly set to, for example, `evil-surround-region' instead of
  ;; `evil-yank' when surround has been invoked by `ys'
  (setq this-command callback)
  (let ((evil-surround-record-repeat t))
    (call-interactively callback))
  (evil-repeat-keystrokes 'post)
  (evil-repeat-stop))

;; Dispatcher function in Operator-Pending state.
;; "cs" calls `evil-surround-change', "ds" calls `evil-surround-delete',
;; and "ys" calls `evil-surround-region'.
(evil-define-command evil-surround-edit (operation)
  "Edit the surrounding delimiters represented by CHAR.
If OPERATION is `change', call `evil-surround-change'.
if OPERATION is `delete', call `evil-surround-delete'.
Otherwise call `evil-surround-region'."
  (interactive (evil-surround-interactive-setup))
  (cond
   ((eq operation 'change)
    (call-interactively 'evil-surround-change))
   ((eq operation 'delete)
    (call-interactively 'evil-surround-delete))
   (t
    (evil-surround-setup-surround-line-operators)
    (evil-surround-call-with-repeat 'evil-surround-region))))

(evil-define-command evil-Surround-edit (operation)
  "Like evil-surround-edit, but for surrounding with additional new-lines.

It does nothing for change / delete."
  (interactive (evil-surround-interactive-setup))
  (cond
   ((eq operation 'change) nil)
   ((eq operation 'delete) nil)
   (t
    (evil-surround-setup-surround-line-operators)
    (evil-surround-call-with-repeat 'evil-Surround-region))))

(evil-define-operator evil-surround-region (beg end type char &optional force-new-line)
  "Surround BEG and END with CHAR.

When force-new-line is true, and region type is not line, the
following: (vertical bars indicate region start/end points)

   do |:thing|

Becomes this:

   do {
     :thing
   }"

  (interactive (evil-surround-input-region-char))
  (if evil-this-motion-count
    (evil-repeat-record (int-to-string evil-this-motion-count)))

  (when (evil-surround-valid-char-p char)
    (let* ((overlay (make-overlay beg end nil nil t))
           (pair (or (and (boundp 'pair) pair) (evil-surround-pair char)))
           (open (car pair))
           (close (cdr pair))
           (beg-pos (overlay-start overlay)))
      (unwind-protect
          (progn
            (goto-char beg-pos)
            (cond ((eq type 'block)
                   (evil-surround-block beg end char))

                  ((eq type 'line)
                   (setq force-new-line
                         (or force-new-line
                             ;; Force newline if not invoked from an operator, e.g. visual line mode with VS)
                             (evil-visual-state-p)
                             ;; Or on multi-line operator surrounds (like 'ysj]')
                             (/= (line-number-at-pos) (line-number-at-pos (1- end)))))

                   (back-to-indentation)
                   (setq beg-pos (point))
                   (insert open)
                   (when force-new-line (newline-and-indent))
                   (goto-char (overlay-end overlay))
                   (if force-new-line
                       (when (eobp)
                         (newline-and-indent))
                     (backward-char)
                     (evil-last-non-blank)
                     (forward-char))
                   (insert close)
                   (when (or force-new-line
                             (/= (line-number-at-pos) (line-number-at-pos beg-pos)))
                     (indent-region beg-pos (point))
                     (newline-and-indent)))

                  (force-new-line
                   (insert open)
                   (newline-and-indent)
                   (let ((pt (point)))
                     (goto-char (overlay-end overlay))
                     (newline-and-indent)
                     (insert close)
                     (indent-region pt (point))))

                  (t
                   (insert open)
                   (goto-char (overlay-end overlay))
                   (insert close)))
            (goto-char beg-pos))
        (delete-overlay overlay)))))

(evil-define-operator evil-Surround-region (beg end type char)
  "Call surround-region, toggling force-new-line"
  (interactive (evil-surround-input-region-char))
  (evil-surround-region beg end type char t))

;;;###autoload
(define-minor-mode evil-surround-mode
  "Buffer-local minor mode to emulate surround.vim."
  :keymap (make-sparse-keymap)
  (evil-normalize-keymaps))

;;;###autoload
(defun turn-on-evil-surround-mode ()
  "Enable evil-surround-mode in the current buffer."
  (evil-surround-mode 1))

;;;###autoload
(defun turn-off-evil-surround-mode ()
  "Disable evil-surround-mode in the current buffer."
  (evil-surround-mode -1))

;;;###autoload
(define-globalized-minor-mode global-evil-surround-mode
  evil-surround-mode turn-on-evil-surround-mode
  "Global minor mode to emulate surround.vim.")

(evil-define-key 'operator evil-surround-mode-map "s" 'evil-surround-edit)
(evil-define-key 'operator evil-surround-mode-map "S" 'evil-Surround-edit)

(evil-define-key 'visual evil-surround-mode-map "S" 'evil-surround-region)
(evil-define-key 'visual evil-surround-mode-map "gS" 'evil-Surround-region)

(provide 'evil-surround)

;;; evil-surround.el ends here