;;; evil-surround.el --- emulate surround.vim in Vimpulse

;; Copyright (C) 2010 Tim Harper
;;
;; Author: Tim Harper <timcharper at gmail dat com>
;;      Please send bug reports to the mailing list (see below).
;; Created: July 23 2010
;; Time-stamp: "2010-08-19 18:27:50 CEST stepnem"
;; Version: 0.1+git
;; Keywords: emulations, evil
;; Human-Keywords: vim, visual-mode, surround.vim
;; 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
;; Related: viper.el, evil.el, viper-in-more-modes.el
;;
;; This file is not part of GNU Emacs.

;;; Commentary:

;; `evil-surround' emulates surround.vim, a popular Vim plugin.
;;
;; The functionality is wrapped into a global minor mode, enabled by default.
;;
;; (require 'evil-surround) is all you need to get going.
;;
;; The code requires a recent evil version. More information on evil
;; and how to get it can be found here:

;; http://www.assembla.com/spaces/evil

;; Tested with GNU Emacs 23.2 and 24 (development version)

;;; Code:

(require 'evil)

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

(defcustom evil-surround-pairs
  '((")" . ("(" . ")"))
    ("(" . ("( " . " )"))
    ("]" . ("[" . "]"))
    ("[" . ("[ " . " ]"))
    ("}" . ("{" . "}"))
    ("{" . ("{ " . " }"))
    ("#" . ("#{" . "}"))
    ("t" . evil-surround-read-tag)
    ("<" . evil-surround-read-tag))
  "Alist 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 '(repeat (cons (regexp :tag "Key")
                       (symbol :tag "Surround pair"))))

(defun evil-surround-char-to-pair (char)
  (let ((pair (or (assoc-default char evil-surround-pairs)
                  (cons char char))))
    (if (functionp pair)
        (funcall pair)
      pair)))

(defvar *evil-surrounding* nil
  "Internal variable set by `evil-surround-define-text-object'.
It triggers `evil-change'. Nothing to see here, move along.")

(defvar *evil-surround-start-size* nil)
(defvar *evil-surround-end-size* nil)

(defvar evil-surround-read-tag-keymap
  (let ((map (copy-keymap minibuffer-local-map)))
    (define-key map ">" 'exit-minibuffer)
    map))

(defun evil-surround-read-tag ()
  (let* ((input (read-from-minibuffer "<" "" evil-surround-read-tag-keymap))
         (_ (string-match "\\([a-z-]+\\)\\(.*?\\)[>]*$" input))
         (tag  (match-string 1 input))
         (rest (match-string 2 input)))
    (cons (format "<%s%s>" tag rest) (format "</%s>" tag))))

(defun evil-Surround-region (beg end)
  "Surround selection with input."
  (interactive "r")
  (let ((pair (evil-surround-char-to-pair
               (format "%c" (read-char))))
        (o (make-overlay beg end)))
    (goto-char (overlay-start o))
    (insert (car pair))
    (indent-according-to-mode)
    (newline-and-indent)
    (goto-char (overlay-end o))
    (newline)
    (insert (cdr pair))
    (indent-according-to-mode)
    (goto-char (overlay-start o))
    (delete-overlay o)))

(defun evil-surround-region (beg end)
  "Surround selection with input."
  (interactive "r")
  (if (equal (evil-visual-type) 'line)
      (evil-Surround-region beg end)
    (let ((pair (evil-surround-char-to-pair
                 (format "%c" (read-char))))
          (o (make-overlay beg end)))
      (goto-char (overlay-start o))
      (insert (car pair))
      (goto-char (overlay-end o))
      (insert (cdr pair))
      (goto-char (overlay-start o))
      (delete-overlay o))))

(defun evil-surround-prepend-key-prefix (keys)
  (mapcar (lambda (key) (concat "s" key)) keys))

(defmacro evil-surround-define-text-object (object args docstring &rest body)
  (let ((strip-object-name (intern (concat (symbol-name object) "-strip")))
        forward-args strip-keys keys)
    (unless (stringp docstring)
      (throw 'exception (format "Invalid docstring: %S" docstring)))
    (while (keywordp (car body))
      (setq keyword (pop body))
      (cond
       ((eq keyword :keys)
        (setq keys (evil-surround-prepend-key-prefix
                    (evil-unquote (pop body)))))
       ((eq keyword :strip-keys)
        (setq strip-keys (evil-surround-prepend-key-prefix
                          (evil-unquote (pop body)))))
       (t
        (push (pop body) forward-args)
        (push keyword forward-args))))

    (setq output '(progn))
    (when keys
      (nconc output `((evil-define-text-object ,object ,args
                        ,docstring
                        ,@forward-args
                        :keys ',keys
                        (setq *evil-surrounding* t)
                        ,@body))))
    (when strip-keys
      (nconc output `((evil-define-text-object ,strip-object-name ,args
                        ,docstring
                        ,@forward-args
                        :keys ',strip-keys
                        (setq *evil-surrounding* 'strip)
                        ,@body))))
    output))

(defun evil-surround-zap-whitespace (direction boundary)
  (let ((pred (if (= direction 1)
		  'looking-at
		'looking-back)))
    (while (and (funcall pred "[ \t]") (not (= (point) boundary)))
      (delete-char direction)
      (when (= direction 1) (setq boundary (1- boundary))))))

(defun evil-surround-delete (begin end strip)
  "Delete the surrounding characters in the range BEGIN END.
If STRIP is non-nil, eliminate all whitespace surrounding the range."
  (let ((o (make-overlay begin end)))
    (goto-char (overlay-start o)) (delete-char 1)
    (goto-char (overlay-end o)) (delete-char -1)
    (when strip
      (evil-surround-zap-whitespace -1 (overlay-start o))
      (goto-char (overlay-start o))
      (evil-surround-zap-whitespace 1 (overlay-end o)))
    (goto-char (overlay-start o))
    (delete-overlay o)))

(defun evil-surround-change (begin end strip)
  "Replace items surrounding the range BEGIN END for new ones.
See `evil-surround-delete' for the meaning of the STRIP argument."
  (let ((o (make-overlay begin end)))
    (evil-surround-delete begin end strip)
    (evil-surround-region (overlay-start o) (overlay-end o))
    (delete-overlay o)))

(defun evil-delete-surround-or-delete (&optional beg end dont-save)
  "Dispatcher replacement for `evil-delete'.
Prompt for a range. If the range returned is detected to be a surround
range, dispatch to `evil-surround-delete'.
Otherwise, dispatch to `evil-delete'."
  (interactive)
  (let (*evil-surrounding*)
    (unless beg
      (let ((range (evil-operator-range)))
        (setq beg (car range)
              end (cadr range))))
    (if *evil-surrounding*
        (evil-surround-delete beg end (eq *evil-surrounding* 'strip))
      (evil-delete beg end dont-save))))

(defun evil-change-surround-or-change (&optional beg end dont-save)
  "Dispatcher replacement for `evil-change'.
Prompt for a range. If the range returned is detected to be a surround
range, dispatch to `evil-surround-change'.
Otherwise, dispatch to `evil-change'."
  (interactive)
  (let (*evil-surrounding*)
    (unless beg
      (let ((range (evil-operator-range)))
        (setq beg (car range)
              end (cadr range))))
    (if *evil-surrounding*
        (evil-surround-change beg end (eq *evil-surrounding* 'strip))
      (evil-change beg end dont-save))))

(define-key evil-normal-state-map "d" 'evil-delete-surround-or-delete)
(define-key evil-normal-state-map "c" 'evil-change-surround-or-change)

(define-key evil-visual-state-map "s" 'evil-surround-region)
(define-key evil-visual-state-map "S" 'evil-Surround-region)

(evil-surround-define-text-object evil-surround-paren (arg)
  "Select surrounding parentheses."
  :keys '("b" ")")
  :strip-keys '("(")
  (evil-paren-range arg ?\( ?\)))

(evil-surround-define-text-object evil-surround-bracket (arg)
  "Select surrounding square brackets."
  :keys '("]")
  :strip-keys '("[")
  (evil-paren-range arg ?\[ ?\]))

(evil-surround-define-text-object evil-surround-brace (arg)
  "Select surrounding curly braces."
  :keys '("B" "}")
  :strip-keys '("{")
  (evil-paren-range arg ?\{ ?\}))

(evil-surround-define-text-object evil-surround-angle (arg)
  "Select surrounding angle brackets."
  :keys '(">")
  :strip-keys '("<")
  (evil-paren-range arg ?< ?>))

(evil-surround-define-text-object evil-surround-single-quote (arg)
  "Select a single-quoted expression."
  :keys '("'")
  (evil-paren-range count ?' ?'))

(evil-surround-define-text-object evil-surround-double-quote (arg)
  "Select a double-quoted expression."
  :keys '("\"")
  (evil-paren-range count ?" ?"))

(define-key evil-motion-state-map "s(" 'evil-surround-paren)
(define-key evil-motion-state-map "s)" 'evil-surround-paren)
(define-key evil-motion-state-map "s[" 'evil-surround-bracket)
(define-key evil-motion-state-map "s]" 'evil-surround-bracket)
(define-key evil-motion-state-map "s{" 'evil-surround-brace)
(define-key evil-motion-state-map "s}" 'evil-surround-brace)
(define-key evil-motion-state-map "s<" 'evil-surround-angle)
(define-key evil-motion-state-map "s>" 'evil-surround-angle)
(define-key evil-motion-state-map "s'" 'evil-surround-single-quote)
(define-key evil-motion-state-map "s\"" 'evil-surround-double-quote)



(provide 'evil-surround)
;;; evil-surround.el ends here