/
vimpulse-surround.el
268 lines (232 loc) · 9.5 KB
/
vimpulse-surround.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
;;; vimpulse-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, vimpulse
;; 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, vimpulse.el, viper-in-more-modes.el
;;
;; This file is not part of GNU Emacs.
;;; Commentary:
;; `vimpulse-surround' emulates surround.vim, a popular Vim plugin.
;;
;; The functionality is wrapped into a global minor mode, enabled by default.
;;
;; (require 'vimpulse-surround) is all you need to get going.
;;
;; The code requires a recent Vimpulse version. More information on Vimpulse
;; and how to get it can be found here:
;; http://www.assembla.com/spaces/vimpulse
;; Tested with GNU Emacs 23.2 and 24 (development version)
;;; Code:
(require 'vimpulse)
(defgroup vimpulse-surround nil
"surround.vim for Emacs"
:prefix "vimpulse-surround-"
:group 'vimpulse)
(defcustom vimpulse-surround-pairs
'((")" . ("(" . ")"))
("(" . ("( " . " )"))
("]" . ("[" . "]"))
("[" . ("[ " . " ]"))
("}" . ("{" . "}"))
("{" . ("{ " . " }"))
("#" . ("#{" . "}"))
("t" . vimpulse-surround-read-tag)
("<" . vimpulse-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 'vimpulse-surround
:type '(repeat (cons (regexp :tag "Key")
(symbol :tag "Surround pair"))))
(defun vimpulse-surround-char-to-pair (char)
(let ((pair (or (assoc-default char vimpulse-surround-pairs)
(cons char char))))
(if (functionp pair)
(funcall pair)
pair)))
(defvar *vimpulse-surrounding* nil
"Internal variable set by `vimpulse-surround-define-text-object'.
It triggers `vimpulse-change'. Nothing to see here, move along.")
(defvar *vimpulse-surround-start-size* nil)
(defvar *vimpulse-surround-end-size* nil)
(defvar vimpulse-surround-read-tag-keymap
(let ((map (copy-keymap minibuffer-local-map)))
(define-key map ">" 'exit-minibuffer)
map))
(defun vimpulse-surround-read-tag ()
(let* ((input (read-from-minibuffer "<" "" vimpulse-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 vimpulse-Surround-region (beg end)
"Surround selection with input."
(interactive "r")
(let ((pair (vimpulse-surround-char-to-pair
(format "%c" (viper-read-char-exclusive))))
(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 vimpulse-surround-region (beg end)
"Surround selection with input."
(interactive "r")
(if (equal vimpulse-visual-mode 'line)
(vimpulse-Surround-region beg end)
(let ((pair (vimpulse-surround-char-to-pair
(format "%c" (viper-read-char-exclusive))))
(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 vimpulse-surround-prepend-key-prefix (keys)
(mapcar (lambda (key) (concat "s" key)) keys))
(defmacro vimpulse-surround-define-text-object (object args &rest body)
(let ((strip-object-name (intern (concat (symbol-name object) "-strip")))
(docstring (pop body))
forward-args strip-keys keys)
(while (keywordp (car body))
(setq keyword (pop body))
(cond
((eq keyword :keys)
(setq keys (vimpulse-surround-prepend-key-prefix
(vimpulse-unquote (pop body)))))
((eq keyword :strip-keys)
(setq strip-keys (vimpulse-surround-prepend-key-prefix
(vimpulse-unquote (pop body)))))
(t
(push (pop body) forward-args)
(push keyword forward-args))))
(setq output '(progn))
(when keys
(nconc output `((vimpulse-define-text-object ,object ,args
,docstring
,@forward-args
:keys ',keys
(setq *vimpulse-surrounding* t)
,@body))))
(when strip-keys
(nconc output `((vimpulse-define-text-object ,strip-object-name ,args
,docstring
,@forward-args
:keys ',strip-keys
(setq *vimpulse-surrounding* 'strip)
,@body))))
output))
(defun vimpulse-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 vimpulse-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
(vimpulse-surround-zap-whitespace -1 (overlay-start o))
(goto-char (overlay-start o))
(vimpulse-surround-zap-whitespace 1 (overlay-end o)))
(goto-char (overlay-start o))
(delete-overlay o)))
(defun vimpulse-surround-change (begin end strip)
"Replace items surrounding the range BEGIN END for new ones.
See `vimpulse-surround-delete' for the meaning of the STRIP argument."
(let ((o (make-overlay begin end)))
(vimpulse-surround-delete begin end strip)
(vimpulse-surround-region (overlay-start o) (overlay-end o))
(delete-overlay o)))
(defun vimpulse-delete-surround-or-delete (&optional beg end dont-save)
"Dispatcher replacement for `vimpulse-delete'.
Prompt for a range. If the range returned is detected to be a surround
range, dispatch to `vimpulse-surround-delete'.
Otherwise, dispatch to `vimpulse-delete'."
(interactive)
(let (*vimpulse-surrounding*)
(unless beg
(let ((range (vimpulse-range)))
(setq beg (car range)
end (cadr range))))
(if *vimpulse-surrounding*
(vimpulse-surround-delete beg end (eq *vimpulse-surrounding* 'strip))
(vimpulse-delete beg end dont-save))))
(defun vimpulse-change-surround-or-change (&optional beg end dont-save)
"Dispatcher replacement for `vimpulse-change'.
Prompt for a range. If the range returned is detected to be a surround
range, dispatch to `vimpulse-surround-change'.
Otherwise, dispatch to `vimpulse-change'."
(interactive)
(let (*vimpulse-surrounding*)
(unless beg
(let ((range (vimpulse-range)))
(setq beg (car range)
end (cadr range))))
(if *vimpulse-surrounding*
(vimpulse-surround-change beg end (eq *vimpulse-surrounding* 'strip))
(vimpulse-change beg end dont-save))))
(add-to-list 'vimpulse-newline-cmds 'vimpulse-change-surround-or-change)
(add-to-list 'vimpulse-newline-cmds 'vimpulse-delete-surround-or-delete)
(define-key viper-vi-basic-map "d" 'vimpulse-delete-surround-or-delete)
(define-key viper-vi-basic-map "c" 'vimpulse-change-surround-or-change)
(define-key vimpulse-visual-basic-map "s" 'vimpulse-surround-region)
(define-key vimpulse-visual-basic-map "S" 'vimpulse-Surround-region)
(vimpulse-surround-define-text-object vimpulse-surround-paren (arg)
"Select surrounding parentheses."
:keys '("b" ")")
:strip-keys '("(")
(vimpulse-paren-range arg ?\( nil t))
(vimpulse-surround-define-text-object vimpulse-surround-bracket (arg)
:keys '("]")
:strip-keys '("[")
"Select surrounding square brackets."
(vimpulse-paren-range arg ?\[ nil t))
(vimpulse-surround-define-text-object vimpulse-surround-brace (arg)
"Select surrounding curly braces."
:keys '("}")
:strip-keys '("{")
(vimpulse-paren-range arg ?\{ nil t))
(vimpulse-surround-define-text-object vimpulse-surround-angle (arg)
:keys '(">")
:strip-keys '("<")
"Select surrounding angle brackets."
(vimpulse-paren-range arg ?< nil t))
(vimpulse-surround-define-text-object vimpulse-surround-single-quote (arg)
"Select a single-quoted expression."
:keys '("'")
(vimpulse-quote-range arg ?' t))
(vimpulse-surround-define-text-object vimpulse-surround-double-quote (arg)
"Select a double-quoted expression."
:keys '("\"")
(vimpulse-quote-range arg ?\" t))
(define-minor-mode vimpulse-surround-mode
"Emulate the surround.vim Vim plugin in Vimpulse."
t nil :global t)
(vimpulse-define-key 'vimpulse-surround-mode 'vi-state "d" 'vimpulse-delete-surround-or-delete)
(vimpulse-define-key 'vimpulse-surround-mode 'vi-state "c" 'vimpulse-change-surround-or-change)
(vimpulse-define-key 'vimpulse-surround-mode 'visual-state "s" 'vimpulse-surround-region)
(provide 'vimpulse-surround)
;;; vimpulse-surround.el ends here