Disable Transient Mark mode after temporary activation.
[vimpulse:vimpulse.git] / vimpulse-visual-mode.el
1 ;;;; Visual mode
2
3 ;; Visual mode is defined as another Viper state, just like vi state,
4 ;; Insert state, Replace state etc. It inherits keybindings from
5 ;; vi state (movement), but defines some bindings of its own
6 ;; on top of that.
7 ;;
8 ;; Text selection in Emacs and Vim differs subtly by that in Vim, the
9 ;; character under the cursor is always included in the selection,
10 ;; while Emacs' region excludes it when point follows mark. Vimpulse
11 ;; solves the problem by "translating" a Visual selection to the
12 ;; equivalent Emacs region when a command is about to be executed.
13 ;; Likewise, a Line selection is translated to an Emacs region of
14 ;; whole lines.
15 ;;
16 ;; This is pretty transparent, except that we don't wish to do any
17 ;; translating when the user is just moving around in the buffer.
18 ;; To that end, the variable `vimpulse-movement-cmds' lists all of
19 ;; Viper's movement commands, so that translation can be postponed
20 ;; until the user executes a non-movement command.
21 ;;
22 ;; Block selections are rectangle compatible. This means Emacs'
23 ;; rectangular commands are applicable on the selection, and you can
24 ;; write your own utilities using the rect.el library. Alternatively,
25 ;; use the `vimpulse-apply-on-block' function.
26
27 (vimpulse-define-state visual
28   "Visual mode is a flexible and easy way to select text.
29 To use Visual mode, press v in vi (command) mode. Then use the
30 motion commands to expand the selection. Press d to delete, c to
31 change, r to replace, or y to copy. You can use p to paste.
32 For Line selection, press V instead of v; then you can copy and
33 paste whole lines. For Block selection, press C-v; now you can
34 copy and paste the selected rectangle. In Block selection, you
35 may use I or A to insert or append text before or after the
36 selection on each line."
37   :id "<VIS> "
38   :basic-minor-mode 'vimpulse-visual-mode
39   :enable '((vimpulse-visual-mode (or vimpulse-visual-mode t))
40             (vimpulse-operator-remap-minor-mode nil)
41             operator-state
42             vi-state)
43   (cond
44    ((eq new-state 'visual-state)
45     (unless (memq vimpulse-visual-mode '(normal line block))
46       (vimpulse-visual-mode 1)))
47    (t
48     (vimpulse-visual-mode -1))))
49
50 (defgroup vimpulse-visual nil
51   "Visual mode for Viper."
52   :prefix "vimpulse-visual-"
53   :group  'vimpulse)
54
55 ;; Visual mode comprises three "submodes": characterwise, linewise
56 ;; and blockwise selection. We implement this by setting the mode
57 ;; variable `vimpulse-visual-mode' to either `normal', `line'
58 ;; or `block'.
59 (define-minor-mode vimpulse-visual-mode
60   "Toggles Visual mode in Viper."
61   :initial-value nil
62   :keymap vimpulse-visual-basic-map
63   :group 'vimpulse-visual
64   (cond
65    (vimpulse-visual-mode
66     (unless (memq vimpulse-visual-mode '(normal line block))
67       (vimpulse-visual-activate 'normal)))
68    (t
69     ;; This is executed when we do (vimpulse-visual-mode -1).
70     ;; It must run without error even if Visual mode is not active.
71     (vimpulse-visual-highlight -1)
72     ;; Clean up local variables
73     (dolist (var vimpulse-visual-local-vars)
74       (when (assq var vimpulse-visual-vars-alist)
75         (set var (cdr (assq var vimpulse-visual-vars-alist))))
76       (when (memq var vimpulse-visual-global-vars)
77         (kill-local-variable var)))
78     ;; Deactivate mark
79     (when vimpulse-visual-vars-alist
80       (vimpulse-deactivate-mark t))
81     (vimpulse-transient-restore)
82     (kill-local-variable 'vimpulse-visual-vars-alist)
83     (kill-local-variable 'vimpulse-visual-global-vars)
84     ;; If Viper state is not already changed,
85     ;; change it to vi (command) state
86     (when (eq viper-current-state 'visual-state)
87       (cond
88        ((eq vimpulse-visual-previous-state 'emacs-state)
89         (viper-change-state-to-emacs))
90        (t
91         (save-excursion (viper-change-state-to-vi)))))
92     (kill-local-variable 'vimpulse-visual-previous-state))))
93
94 ;;; Activation
95
96 (eval-and-compile
97   (fset 'viper-deactivate-mark 'vimpulse-deactivate-mark)
98   (fset 'vimpulse-activate-mark 'vimpulse-activate-region))
99
100 (defun vimpulse-visual-activate (&optional mode)
101   "Activate Visual mode. MODE is `normal', `line' or `block'.
102 May also be used to change the Visual mode."
103   (unless (memq vimpulse-visual-mode '(normal line block))
104     ;; We are activating Visual mode for the first time
105     (kill-local-variable 'vimpulse-visual-vars-alist)
106     (kill-local-variable 'vimpulse-visual-global-vars)
107     (setq vimpulse-visual-previous-state viper-current-state)
108     ;; Make global variables buffer-local
109     (setq vimpulse-visual-vars-alist nil)
110     (vimpulse-visual-block-cleanup-whitespace)
111     (vimpulse-transient-remember)
112     (dolist (var vimpulse-visual-local-vars)
113       (when (and (boundp var)
114                  (not (assq var vimpulse-visual-vars-alist)))
115         ;; Remember old value
116         (add-to-list 'vimpulse-visual-vars-alist
117                      (cons var (eval var))))
118       (unless (assoc var (buffer-local-variables))
119         (make-local-variable var)
120         (add-to-list 'vimpulse-visual-global-vars var)))
121     ;; Re-add hooks in case they were cleared
122     (add-hook 'pre-command-hook 'vimpulse-visual-pre-command)
123     (add-hook 'post-command-hook 'vimpulse-visual-post-command)
124     (if (featurep 'xemacs)
125         (add-hook 'zmacs-deactivate-region-hook
126                   'vimpulse-visual-deactivate-hook)
127       (add-hook 'deactivate-mark-hook 'vimpulse-visual-deactivate-hook))
128     ;; Activate mark at point
129     (cond
130      ((eq mode 'block)
131       (set-mark (point))
132       (vimpulse-deactivate-mark t)     ; `set-mark' activates the mark
133       (vimpulse-transient-mark -1))
134      (t
135       (vimpulse-transient-mark 1)
136       ;; Convert active Emacs region to Visual selection, if any
137       (cond
138        ((region-active-p)
139         (vimpulse-visual-contract-region
140          (not viper-ESC-moves-cursor-back)))
141        (t
142         (vimpulse-activate-mark (point))))
143       (vimpulse-visual-highlight))))
144   ;; Set the Visual mode
145   (setq mode (or mode 'normal))
146   (setq vimpulse-visual-mode mode
147         vimpulse-visual-last mode)
148   (viper-change-state 'visual-state)
149   (viper-restore-cursor-type)           ; use vi cursor
150   ;; Reactivate mark
151   (cond
152    ((eq mode 'block)
153     (vimpulse-deactivate-mark t)
154     (vimpulse-transient-mark -1))
155    (t
156     (vimpulse-transient-mark 1)
157     (vimpulse-activate-mark))))
158
159 (defun vimpulse-visual-toggle (mode)
160   "Enable Visual MODE if this is not the current mode.
161 Otherwise disable Visual mode."
162   (if (eq mode vimpulse-visual-mode)
163       (vimpulse-visual-mode -1)
164     (vimpulse-visual-activate mode)))
165
166 (defun vimpulse-visual-activate-normal ()
167   "Enable Visual selection."
168   (interactive)
169   (let (message-log-max)
170     (vimpulse-visual-activate 'normal)
171     (message "-- VISUAL --")))
172
173 (defun vimpulse-visual-activate-line ()
174   "Enable Visual Line selection."
175   (interactive)
176   (let (message-log-max)
177     (vimpulse-visual-activate 'line)
178     (message "-- VISUAL LINE --")))
179
180 (defun vimpulse-visual-activate-block ()
181   "Enable Visual Block selection."
182   (interactive)
183   (let (message-log-max)
184     (vimpulse-visual-activate 'block)
185     (message "-- VISUAL BLOCK --")))
186
187 (defun vimpulse-visual-toggle-normal ()
188   "Toggle Visual selection."
189   (interactive)
190   (let (message-log-max)
191     (vimpulse-visual-toggle 'normal)
192     (when vimpulse-visual-mode
193       (message "-- VISUAL --"))))
194
195 (defun vimpulse-visual-toggle-line ()
196   "Toggle Visual Line selection."
197   (interactive)
198   (let (message-log-max)
199     (vimpulse-visual-toggle 'line)
200     (when vimpulse-visual-mode
201       (message "-- VISUAL LINE --"))))
202
203 (defun vimpulse-visual-toggle-block ()
204   "Toggle Visual Block selection."
205   (interactive)
206   (let (message-log-max)
207     (vimpulse-visual-toggle 'block)
208     (when vimpulse-visual-mode
209       (message "-- VISUAL BLOCK --"))))
210
211 ;;; Visualization
212
213 (defun vimpulse-deactivate-mark (&optional now)
214   "Don't deactivate mark in Visual mode."
215   (cond
216    ((and vimpulse-visual-mode
217          (not (eq vimpulse-visual-mode 'block)))
218     nil)
219    (t
220     (vimpulse-deactivate-region now))))
221
222 (defun vimpulse-transient-mark (&optional arg)
223   "Enable Transient Mark mode (and Cua mode) if not already enabled.
224 Enable forcefully with positive ARG. Disable with negative ARG.
225 Saves the previous state of Transient Mark mode in
226 `vimpulse-visual-vars-alist', so it can be restored with
227 `vimpulse-transient-restore'."
228   (setq deactivate-mark nil)
229   (and (boundp 'mark-active)
230        (setq mark-active (region-active-p)))
231   (let (deactivate-mark)
232     (cond
233      ;; Disable Transient Mark/Cua
234      ((and (integerp arg) (< arg 1))
235       (and (fboundp 'cua-mode)
236            cua-mode
237            (cua-mode -1))
238       (and (fboundp 'transient-mark-mode)
239            transient-mark-mode
240            (transient-mark-mode -1))
241       (and (boundp 'zmacs-regions)
242            (setq zmacs-regions nil)))
243      ;; Enable Transient Mark/Cua
244      (t
245       (vimpulse-transient-remember)
246       (cond
247        ((and (fboundp 'cua-mode)
248              (and (vimpulse-visual-before (eq cua-mode t)))
249              (or (not cua-mode) (numberp arg)))
250         (cua-mode 1))
251        ((and (fboundp 'transient-mark-mode)
252              (or (not transient-mark-mode) (numberp arg)))
253         (transient-mark-mode 1))
254        ((and (boundp 'zmacs-regions)
255              (or (not zmacs-regions) (numberp arg)))
256         (setq zmacs-regions t)))))))
257
258 (defun vimpulse-transient-remember ()
259   "Remember Transient Mark mode state in `vimpulse-visual-vars-alist'."
260   (when (and (boundp 'transient-mark-mode)
261              (not (assq 'transient-mark-mode
262                         vimpulse-visual-vars-alist)))
263     (add-to-list 'vimpulse-visual-vars-alist
264                  (cons 'transient-mark-mode
265                        (when (eq transient-mark-mode t)
266                          transient-mark-mode))))
267   (when (and (boundp 'cua-mode)
268              (not (assq 'cua-mode vimpulse-visual-vars-alist)))
269     (add-to-list 'vimpulse-visual-vars-alist
270                  (cons 'cua-mode cua-mode))))
271
272 (defun vimpulse-transient-restore ()
273   "Restore Transient Mark mode to what is was before Visual mode.
274  Also restores Cua mode."
275   (when vimpulse-visual-vars-alist
276     (when (boundp 'transient-mark-mode)
277       (if (and (vimpulse-visual-before transient-mark-mode))
278           (transient-mark-mode 1)
279         (transient-mark-mode -1)))
280     (when (boundp 'cua-mode)
281       (if (and (vimpulse-visual-before cua-mode))
282           (cua-mode 1)
283         (cua-mode -1)))
284     (when (boundp 'zmacs-regions)
285       (let ((oldval (and (vimpulse-visual-before zmacs-regions))))
286         (setq zmacs-regions oldval)))))
287
288 (defmacro vimpulse-visual-before (&rest body)
289   "Evaluate BODY with original system values from before Visual mode.
290 This is based on `vimpulse-visual-vars-alist'."
291   ;; This needs to be expanded at runtime, obviously
292   `(eval `(let ,(mapcar (lambda (elt)
293                           `(,(car elt) (quote ,(cdr elt))))
294                         vimpulse-visual-vars-alist)
295             ,',@body)))
296
297 (defun vimpulse-visual-beginning (&optional mode force)
298   "Return beginning of Visual selection.
299 See `vimpulse-visual-range'."
300   (apply 'min (vimpulse-motion-range
301                (vimpulse-visual-range mode force))))
302
303 (defun vimpulse-visual-end (&optional mode force)
304   "Return end of Visual selection.
305 See `vimpulse-visual-range'."
306   (apply 'max (vimpulse-motion-range
307                (vimpulse-visual-range mode force))))
308
309 (defun vimpulse-visual-range (&optional mode force)
310   "Return a Visual motion range (TYPE BEG END).
311 TYPE is the Visual mode.
312
313 The range depends on `point', `mark' and `vimpulse-visual-mode'.
314 The Visual mode may be specified explicitly with MODE, which must
315 be one of `normal', `line' and `block'.
316
317 In Normal mode, returns region plus one character.
318 In Line mode, returns region as whole lines.
319 In Block mode, returns rectangle plus one column.
320
321 If the Visual selection is already translated to Emacs' region,
322 returns the region as-is. This can be overridden with FORCE.
323
324 See also `vimpulse-visual-beginning' and `vimpulse-visual-end'."
325   (let ((mark  (or (mark t) 1))
326         (point (point)))
327     (setq mode (or mode vimpulse-visual-mode))
328     (unless (memq mode '(line block))
329       (setq mode (if vimpulse-visual-mode 'inclusive 'exclusive)))
330     (cond
331      ((and (not force)
332            (or (not vimpulse-visual-mode)
333                vimpulse-visual-region-expanded))
334       (list mode (min mark point) (max mark point)))
335      ((eq mode 'block)
336       (vimpulse-block-range mark point))
337      ((eq mode 'line)
338       (vimpulse-line-range mark point))
339      (t
340       (vimpulse-inclusive-range mark point)))))
341
342 (defun vimpulse-visual-select (beg end &optional widen)
343   "Visually select text inclusively from BEG to END.
344 Return nil if selection is unchanged. If WIDEN is non-nil, only
345 modify selection if it does not already encompass BEG and END.
346
347 Under the hood, this function changes Emacs' `point' and `mark'.
348 The boundaries of the Visual selection are deduced from these and
349 the current Visual mode via `vimpulse-visual-beginning' and
350 `vimpulse-visual-end'."
351   (cond
352    ;; In Visual mode, protect the value of `mark-active'
353    (vimpulse-visual-mode
354     (let (mark-active)
355       (vimpulse-set-region
356        (min beg end)
357        (if vimpulse-visual-region-expanded
358            (max beg end)
359          (max (min beg end) (1- (max beg end))))
360        widen)))
361    (t
362     (vimpulse-set-region
363      (min beg end) (max beg end) widen))))
364
365 (defun vimpulse-visual-expand-region
366   (&optional mode no-trailing-newline)
367   "Expand Emacs region to Visual selection.
368 If NO-TRAILING-NEWLINE is t and selection ends with a newline,
369 exclude that newline from the region."
370   (let ((range (vimpulse-visual-range mode))
371         mark-active)
372     (when no-trailing-newline
373       (save-excursion
374         (goto-char (apply 'max (vimpulse-motion-range range)))
375         (and (bolp) (not (bobp))
376              (setq range
377                    (list (vimpulse-motion-type range)
378                          (apply 'min (vimpulse-motion-range range))
379                          (max (apply 'min
380                                      (vimpulse-motion-range range))
381                               (1- (point))))))))
382     (setq vimpulse-visual-region-expanded t)
383     (vimpulse-mark-range range)))
384
385 (defun vimpulse-visual-contract-region (&optional keep-point)
386   "Opposite of `vimpulse-visual-expand-region'.
387 I.e., the resulting Visual selection is equivalent to the former
388 Emacs region. If KEEP-POINT is t, does not move point.
389 Return nil if selection is unchanged."
390   (let ((opoint (point)) (omark (mark t)))
391     (setq vimpulse-visual-region-expanded nil)
392     (vimpulse-visual-select (region-beginning) (region-end))
393     (when keep-point (goto-char opoint))
394     (not (and (= (point)  opoint)
395               (= (mark t) omark)))))
396
397 (defun vimpulse-visual-restore ()
398   "Restore previous selection.
399 This selects a specific range of text in the buffer.
400 See also `vimpulse-visual-reselect'."
401   (interactive)
402   (setq vimpulse-visual-region-expanded nil)
403   (let ((last vimpulse-visual-last))
404     (cond
405      ;; If no previous selection, try a quick C-x C-x
406      ((or (not vimpulse-visual-point)
407           (not vimpulse-visual-mark))
408       (vimpulse-activate-mark nil)
409       (vimpulse-visual-mode 1))
410      (t
411       (unless vimpulse-visual-mode
412         (cond
413          ((eq last 'line)
414           (vimpulse-visual-activate-line))
415          ((eq last 'block)
416           (vimpulse-visual-activate-block))
417          (t                             ; normal
418           (vimpulse-visual-activate-normal))))
419       (set-mark vimpulse-visual-mark)
420       (goto-char vimpulse-visual-point)
421       (vimpulse-visual-contract-region)
422       (vimpulse-visual-highlight)))))
423
424 (defun vimpulse-visual-reselect (&optional mode height width pos)
425   "Create a Visual MODE selection of dimensions HEIGHT and WIDTH.
426 When called interactively, uses dimensions of previous selection.
427 If specified, selects about POS; otherwise selects about point.
428 See also `vimpulse-visual-restore'."
429   (interactive)
430   (when pos
431     (goto-char pos))
432   (setq mode (or mode vimpulse-visual-mode vimpulse-visual-last)
433         height (or height vimpulse-visual-height 1)
434         width (or width vimpulse-visual-width 1))
435   (unless vimpulse-visual-mode
436     (vimpulse-visual-activate mode))
437   (cond
438    ((eq mode 'block)
439     (viper-next-line-carefully (1- height))
440     (setq width (+ (1- width) (current-column)))
441     (vimpulse-move-to-column width)
442     (setq height (count-lines (vimpulse-visual-beginning mode)
443                               (vimpulse-visual-end mode)))
444     (while (and (not (eq (current-column) width))
445                 (> height 1))
446       (viper-next-line-carefully -1)
447       (setq height (1- height))
448       (move-to-column width)))
449    ((eq mode 'line)
450     (viper-next-line-carefully (1- height)))
451    (t                                   ; normal
452     (viper-forward-char-carefully (1- width)))))
453
454 (defun vimpulse-visual-markers (&optional point mark)
455   "Refresh `vimpulse-visual-point' and `vimpulse-visual-mark'."
456   (setq mark  (vimpulse-visual-beginning 'normal)
457         point (vimpulse-visual-end 'normal))
458   (when (< (point) (mark t))
459     (setq mark (prog1 point
460                  (setq point mark))))
461   (viper-move-marker-locally 'vimpulse-visual-point point)
462   (viper-move-marker-locally 'vimpulse-visual-mark  mark)
463   (set-marker-insertion-type vimpulse-visual-point
464                              (<= point mark))
465   (set-marker-insertion-type vimpulse-visual-mark
466                              (> point mark)))
467
468 (defun vimpulse-visual-dimensions (&optional beg end mode)
469   "Refresh `vimpulse-visual-height' and `vimpulse-visual-width'."
470   (vimpulse-visual-markers beg end)
471   (setq mode (or mode vimpulse-visual-mode)
472         beg (or beg (vimpulse-visual-beginning mode))
473         end (or end (vimpulse-visual-end mode)))
474   (cond
475    ((eq mode 'block)
476     (setq vimpulse-visual-height
477           (count-lines beg
478                        (save-excursion
479                          (goto-char end)
480                          (if (and (bolp) (not (eobp)))
481                              (1+ end)
482                            end)))
483           vimpulse-visual-width (abs (- (save-excursion
484                                           (goto-char end)
485                                           (current-column))
486                                         (save-excursion
487                                           (goto-char beg)
488                                           (current-column))))))
489    ((eq mode 'line)
490     (setq vimpulse-visual-height (count-lines beg end)
491           vimpulse-visual-width nil))
492    (t
493     (setq vimpulse-visual-height nil
494           vimpulse-visual-width (abs (- end beg))))))
495
496 (defun vimpulse-visual-highlight (&optional arg)
497   "Highlight Visual selection, depending on region and Visual mode.
498 With negative ARG, removes highlighting."
499   (cond
500    ((and (numberp arg) (< arg 1))
501     (when (viper-overlay-live-p vimpulse-visual-overlay)
502       (vimpulse-delete-overlay vimpulse-visual-overlay))
503     (mapc 'vimpulse-delete-overlay vimpulse-visual-block-overlays)
504     (setq vimpulse-visual-block-overlays nil)
505     ;; Clean up unreferenced overlays
506     (dolist (overlay (vimpulse-overlays-at (point)))
507       (when (eq (viper-overlay-get overlay 'face) (vimpulse-region-face))
508         (vimpulse-delete-overlay overlay))))
509    ((eq vimpulse-visual-mode 'block)
510     ;; Remove any normal/line highlighting
511     (when (viper-overlay-live-p vimpulse-visual-overlay)
512       (vimpulse-delete-overlay vimpulse-visual-overlay))
513     ;; Block highlighting isn't perfect
514     (condition-case nil
515         (vimpulse-visual-highlight-block
516          (vimpulse-visual-beginning)
517          (vimpulse-visual-end))
518       (error nil)))
519    (vimpulse-visual-mode                ; normal or line
520     (let ((beg (vimpulse-visual-beginning))
521           (end (vimpulse-visual-end)))
522       ;; Remove any block highlighting
523       (mapc 'vimpulse-delete-overlay vimpulse-visual-block-overlays)
524       (setq vimpulse-visual-block-overlays nil)
525       ;; Reuse overlay if possible
526       (if (viper-overlay-live-p vimpulse-visual-overlay)
527           (viper-move-overlay vimpulse-visual-overlay beg end)
528         (setq vimpulse-visual-overlay
529               (vimpulse-make-overlay beg end nil t))
530         (viper-overlay-put vimpulse-visual-overlay
531                            'face (vimpulse-region-face))
532         (viper-overlay-put vimpulse-visual-overlay
533                            'priority 99))))))
534
535 (defun vimpulse-visual-highlight-block (beg end)
536   "Highlight rectangular region from BEG to END.
537 We do this by putting an overlay on each line within the
538 rectangle. Each overlay extends across all the columns of the
539 rectangle. We try to reuse overlays where possible because this
540 is more efficient and results in less flicker.
541
542 Adapted from: `rm-highlight-rectangle' in rect-mark.el."
543   (let ((opoint (point))                ; remember point
544         (omark  (mark t))               ; remember mark
545         (old vimpulse-visual-block-overlays)
546         beg-col end-col new nlines overlay window-beg window-end)
547     ;; Calculate the rectangular region represented by BEG and END,
548     ;; but put BEG in the north-west corner and END in the south-east
549     ;; corner if not already there
550     (save-excursion
551       (setq beg-col (save-excursion (goto-char beg)
552                                     (current-column))
553             end-col (save-excursion (goto-char end)
554                                     (current-column)))
555       (when (>= beg-col end-col)
556         (if (= beg-col end-col)
557             (setq end-col (1+ end-col))
558           (setq beg-col (prog1 end-col
559                           (setq end-col beg-col))))
560         (setq beg (save-excursion (goto-char beg)
561                                   (vimpulse-move-to-column beg-col)
562                                   (point))
563               end (save-excursion (goto-char end)
564                                   (vimpulse-move-to-column end-col 1)
565                                   (point))))
566       ;; Force a redisplay so we can do reliable
567       ;; windows BEG/END calculations
568       (sit-for 0)
569       (setq window-beg (max (window-start) beg)
570             window-end (min (window-end) (1+ end))
571             nlines (count-lines window-beg
572                                 (min window-end (point-max))))
573       ;; Iterate over those lines of the rectangle which are
574       ;; visible in the currently selected window
575       (goto-char window-beg)
576       (dotimes (i nlines)
577         (let (row-beg row-end bstring astring)
578           ;; Beginning of row
579           (vimpulse-move-to-column beg-col)
580           (when (< (current-column) beg-col)
581             ;; Prepend overlay with virtual spaces if we are unable to
582             ;; move directly to the first column
583             (setq bstring
584                   (propertize
585                    (make-string
586                     (- beg-col (current-column)) ?\ )
587                    'face
588                    (or (get-text-property (1- (point)) 'face)
589                        'default))))
590           (setq row-beg (point))
591           ;; End of row
592           (vimpulse-move-to-column end-col)
593           (when (< (current-column) end-col)
594             ;; Append overlay with virtual spaces if we are unable to
595             ;; move directly to the last column
596             (setq astring
597                   (propertize
598                    (make-string
599                     (if (= (point) row-beg)
600                         (- end-col beg-col)
601                       (- end-col (current-column)))
602                     ?\ ) 'face (vimpulse-region-face)))
603             ;; Place cursor on one of the virtual spaces
604             ;; (only works in GNU Emacs)
605             (if (= opoint row-beg)
606                 (put-text-property
607                  0 (min (length astring) 1)
608                  'cursor t astring)
609               (put-text-property
610                (max 0 (1- (length astring))) (length astring)
611                'cursor t astring)))
612           (setq row-end (min (point) (line-end-position)))
613           ;; XEmacs bug: zero-length extents display
614           ;; end-glyph before start-glyph
615           (and (featurep 'xemacs)
616                bstring astring
617                (= row-beg row-end)
618                (setq bstring (prog1 astring
619                                (setq astring bstring))))
620           ;; Trim old leading overlays
621           (while (and old
622                       (setq overlay (car old))
623                       (< (viper-overlay-start overlay) row-beg)
624                       (/= (viper-overlay-end overlay) row-end))
625             (vimpulse-delete-overlay overlay)
626             (setq old (cdr old)))
627           ;; Reuse an overlay if possible, otherwise create one
628           (cond
629            ((and old (setq overlay (car old))
630                  (or (= (viper-overlay-start overlay) row-beg)
631                      (= (viper-overlay-end overlay) row-end)))
632             (viper-move-overlay overlay row-beg row-end)
633             (vimpulse-overlay-before-string overlay bstring)
634             (vimpulse-overlay-after-string overlay astring)
635             (setq new (cons overlay new)
636                   old (cdr old)))
637            (t
638             (setq overlay (vimpulse-make-overlay row-beg row-end))
639             (vimpulse-overlay-before-string overlay bstring)
640             (vimpulse-overlay-after-string overlay astring)
641             (viper-overlay-put overlay 'face (vimpulse-region-face))
642             (viper-overlay-put overlay 'priority 99)
643             (setq new (cons overlay new)))))
644         (forward-line 1))
645       ;; Trim old trailing overlays
646       (mapc 'vimpulse-delete-overlay old)
647       (setq vimpulse-visual-block-overlays (nreverse new)))))
648
649 (defun vimpulse-visual-pre-command ()
650   "Run before each command in Visual mode."
651   (when vimpulse-visual-mode
652     ;; Refresh Visual restore markers and marks
653     (vimpulse-visual-dimensions)
654     (cond
655      ;; Movement command: don't expand region
656      ((vimpulse-movement-cmd-p this-command)
657       (setq vimpulse-visual-region-expanded nil))
658      (t
659       ;; Add whitespace if necessary for making a rectangle
660       (and (eq vimpulse-visual-mode 'block)
661            (vimpulse-visual-block-add-whitespace))
662       (vimpulse-visual-expand-region
663        ;; If in Line mode, don't include trailing newline
664        ;; unless the command has real need of it
665        nil (and (eq vimpulse-visual-mode 'line)
666                 (not (vimpulse-needs-newline-p this-command))))))))
667
668 (defun vimpulse-visual-post-command ()
669   "Run after each command in Visual mode."
670   (cond
671    (vimpulse-visual-mode
672     ;; Quitting: exit to vi (command) mode
673     (cond
674      (quit-flag                         ; C-g
675       (vimpulse-visual-mode -1))
676      ((eq this-command 'keyboard-quit)
677       (vimpulse-visual-mode -1))
678      ((and (not (region-active-p))
679            (not (eq vimpulse-visual-mode 'block)))
680       (vimpulse-visual-mode -1))
681      ;; Region was expanded, so contract it
682      (vimpulse-visual-region-expanded
683       (when (eq vimpulse-visual-mode 'block)
684         (vimpulse-visual-block-cleanup-whitespace))
685       (if (eq vimpulse-visual-mode 'line)
686           (vimpulse-visual-restore)
687         (vimpulse-visual-contract-region))
688       (vimpulse-visual-highlight))
689      (t
690       (vimpulse-visual-highlight))))
691    ;; Not in the Visual state, but maybe the mark
692    ;; was activated in vi (command) state?
693    ((and (region-active-p)
694          (eq viper-current-state 'vi-state)
695          (if (boundp 'deactivate-mark) (not deactivate-mark) t))
696     (vimpulse-visual-mode 1))))
697
698 (defun vimpulse-visual-deactivate-hook ()
699   "Hook run when mark is deactivated in Visual mode."
700   (when vimpulse-visual-mode
701     (and (not (region-active-p))
702          (not (vimpulse-movement-cmd-p this-command))
703          (vimpulse-visual-mode -1))))
704
705 (add-hook 'pre-command-hook 'vimpulse-visual-pre-command)
706 (add-hook 'post-command-hook 'vimpulse-visual-post-command)
707 (if (featurep 'xemacs)
708     (add-hook 'zmacs-deactivate-region-hook
709               'vimpulse-visual-deactivate-hook)
710   (add-hook 'deactivate-mark-hook 'vimpulse-visual-deactivate-hook))
711
712 ;; Advise viper-intercept-ESC-key to exit Visual mode with ESC
713 (defadvice viper-intercept-ESC-key
714   (around vimpulse-ESC-exit-visual-mode activate)
715   "Exit Visual mode with ESC."
716   (let ((viper-ESC-moves-cursor-back (not (region-active-p)))
717         deactivate-mark)
718     (if (and vimpulse-visual-mode
719              (not (input-pending-p)))
720         (vimpulse-visual-mode -1)
721       ad-do-it)))
722
723 (defadvice viper-Put-back (around vimpulse-visual activate)
724   "Delete selection before pasting in Visual mode."
725   (let (inserted-text replaced-text mode)
726     (setq yank-window-start (window-start))
727     (cond
728      (vimpulse-visual-mode
729       (setq mode vimpulse-visual-mode)
730       (unless (eq mode 'block)
731         ;; Add replaced text to the kill-ring before the current kill
732         (setq inserted-text (current-kill 0))
733         (setq replaced-text
734               (buffer-substring (region-beginning) (region-end)))
735         (kill-new replaced-text t)
736         (kill-new inserted-text))
737       (vimpulse-delete (region-beginning) (region-end) t)
738       (when (and (eq mode 'normal)
739                  (not (bolp))
740                  (viper-end-with-a-newline-p inserted-text))
741         (newline))
742       (when (and (eq mode 'line)
743                  (not (viper-end-with-a-newline-p inserted-text)))
744         (save-excursion (newline))))
745      ((region-active-p)
746       (delete-region (region-beginning) (region-end))))
747     (if (and killed-rectangle
748              kill-ring
749              (eq (get 'killed-rectangle 'previous-kill)
750                  (current-kill 0)))
751         (save-excursion
752           (yank-rectangle))
753       ad-do-it)
754     (when vimpulse-visual-mode
755       (vimpulse-visual-mode -1))))
756
757 (defadvice viper-put-back (around vimpulse-visual activate)
758   "Delete selection before pasting in Visual mode."
759   (setq yank-window-start (window-start))
760   (cond
761    (vimpulse-visual-mode
762     (viper-Put-back arg))
763    ((region-active-p)
764     (viper-Put-back arg))
765    ((and killed-rectangle
766          kill-ring
767          (eq (get 'killed-rectangle 'previous-kill)
768              (current-kill 0)))
769     (unless (eolp)
770       (viper-forward-char-carefully))
771     (save-excursion
772       (yank-rectangle)))
773    (t
774     ad-do-it))
775   (when vimpulse-visual-mode
776     (vimpulse-visual-mode -1)))
777
778 ;; Viper's larger movement commands use the mark to store the previous
779 ;; position, which is fine and useful when the mark isn't active. When
780 ;; it is, however, it has the effect of remaking the region.
781 (defadvice push-mark (around vimpulse-visual-mode activate)
782   (unless (and vimpulse-visual-mode
783                ;; Note: if you really need to call `push-mark'
784                ;; in proximity with these commands (e.g., in a hook),
785                ;; do (let (this-command) (push-mark)).
786                (memq this-command
787                      '(vimpulse-goto-first-line
788                        vimpulse-goto-line
789                        viper-backward-paragraph
790                        viper-backward-sentence
791                        viper-forward-paragraph
792                        viper-forward-sentence
793                        viper-goto-line
794                        viper-search-next
795                        viper-search-Next
796                        viper-window-bottom
797                        viper-window-middle
798                        viper-window-top)))
799     ad-do-it))
800
801 ;; Block selection disables Transient Mark mode
802 (defadvice deactivate-mark (after vimpulse-visual activate)
803   "Deactivate Visual Block mode."
804   (when (eq vimpulse-visual-mode 'block)
805     (vimpulse-visual-mode -1)))
806
807 (defmacro vimpulse-visual-mouse-advice (cmd)
808   "Advise mouse command CMD to enable Visual mode."
809   `(defadvice ,cmd (around vimpulse-visual activate)
810      "Enable Visual mode in vi (command) state."
811      (let ((w (posn-window (event-start (ad-get-arg 0)))))
812        (cond
813         ;; If Visual mode is enabled in the window clicked in,
814         ;; adjust region afterwards
815         ((with-selected-window w
816            vimpulse-visual-mode)
817          (vimpulse-visual-highlight -1)
818          ad-do-it
819          (when (eq (selected-window) w)
820            (vimpulse-visual-contract-region t)
821            (vimpulse-visual-highlight)))
822         ;; Otherwise, if in vi (command) state, enable Visual mode
823         ((with-selected-window w
824            (eq viper-current-state 'vi-state))
825          ad-do-it
826          (when (eq (selected-window) w)
827            (cond
828             (vimpulse-visual-mode
829              (vimpulse-visual-contract-region t))
830             ((region-active-p)
831              (vimpulse-visual-mode 1)
832              (setq vimpulse-visual-region-expanded nil)
833              (vimpulse-visual-contract-region t)))))
834         (t
835          ad-do-it)))))
836
837 (vimpulse-visual-mouse-advice mouse-drag-region)
838 (vimpulse-visual-mouse-advice mouse-save-then-kill)
839
840 (defadvice mouse-show-mark (before vimpulse-visual activate)
841   "Refresh highlighting of Visual selection."
842   (when vimpulse-visual-mode
843     (vimpulse-visual-highlight)))
844
845 (defun vimpulse-movement-cmd-p (command)
846   "Whether COMMAND is a \"movement\" command.
847 That is, whether it is listed in `vimpulse-movement-cmds'."
848   ;; We use `member' rather than `memq' to allow lambdas
849   (member command vimpulse-movement-cmds))
850
851 (defun vimpulse-needs-newline-p (command)
852   "Whether COMMAND needs trailing newline in Visual Line mode.
853 In most cases (say, when wrapping the selection in a skeleton),
854 it is more useful to exclude the last newline from the region."
855   (or (member command vimpulse-newline-cmds)
856       (vimpulse-operator-cmd-p command)))
857
858 (defun vimpulse-visual-remap (from to)
859   "Remap FROM to TO in Visual mode."
860   (vimpulse-remap vimpulse-visual-basic-map from to))
861
862 (defun vimpulse-filter-undos (undo-list)
863   "Filters all `nil' marks from `undo-list' until the first
864 occurrence of `vimpulse-buffer-undo-list-mark'."
865   (cond
866    ((null undo-list)
867     nil)
868    ((eq (car undo-list) 'vimpulse)
869     (cdr undo-list))
870    ((null (car undo-list))
871     (vimpulse-filter-undos (cdr undo-list)))
872    (t
873     (cons (car undo-list)
874           (vimpulse-filter-undos (cdr undo-list))))))
875
876 (defun vimpulse-connect-undos ()
877   "Connects all undo-steps from `buffer-undo-list' up to the
878 first occurrence of `vimpulse-buffer-undo-list-mark'."
879   (when (and vimpulse-undo-needs-adjust
880              (listp buffer-undo-list))
881     (setq buffer-undo-list
882           (vimpulse-filter-undos buffer-undo-list)))
883   (setq vimpulse-undo-needs-adjust nil))
884
885 (defun vimpulse-push-buffer-undo-list-mark ()
886   (setq vimpulse-undo-needs-adjust t)
887   (push vimpulse-buffer-undo-list-mark buffer-undo-list))
888
889 ;;; Ex
890
891 (defun vimpulse-visual-ex (arg)
892   "Call `viper-ex' on region."
893   (interactive "p")
894   (viper-ex arg))
895
896 ;;; Insert/append
897
898 (defun vimpulse-visual-insert (beg end &optional arg)
899   "Enter Insert state at beginning of Visual selection."
900   (interactive "r\nP")
901   (let (deactivate-mark)
902     (cond
903      ((eq vimpulse-visual-mode 'block)
904       (vimpulse-visual-block-rotate 'upper-left beg end)
905       (setq beg (vimpulse-visual-beginning)
906             end (vimpulse-visual-end))
907       (vimpulse-visual-mode -1)
908       (goto-char
909        (vimpulse-visual-create-coords 'block ?i beg end))
910       (viper-insert arg))
911      (t
912       (vimpulse-visual-mode -1)
913       (push-mark end t t)
914       (goto-char beg)
915       (viper-insert arg))
916      (t
917       (error "Not in Visual mode")))))
918
919 (defun vimpulse-visual-append (beg end &optional arg)
920   "Enter Insert state at end of Visual selection."
921   (interactive "r\nP")
922   (let (deactivate-mark)
923     (cond
924      ((eq vimpulse-visual-mode 'block)
925       (vimpulse-visual-block-rotate 'upper-left beg end)
926       (setq beg (vimpulse-visual-beginning)
927             end (vimpulse-visual-end))
928       (setq vimpulse-visual-whitespace-overlay nil)
929       (vimpulse-visual-mode -1)
930       (goto-char
931        (vimpulse-visual-create-coords 'block ?a beg end))
932       (viper-append arg))
933      (t
934       (vimpulse-visual-mode -1)
935       (push-mark beg t t)
936       (goto-char end)
937       (viper-insert arg))
938      (t
939       (error "Not in Visual mode")))))
940
941 ;;; Block selection
942
943 (defun vimpulse-apply-on-block (func &optional beg end &rest args)
944   "Call FUNC for each line of Visual Block selection.
945 The selection may be specified explicitly with BEG and END.
946 FUNC must take at least two arguments, the beginning and end of
947 each line. Extra arguments to FUNC may be passed via ARGS."
948   (let (beg-col end-col)
949     (save-excursion
950       (setq beg (or beg (vimpulse-visual-beginning))
951             end (or end (vimpulse-visual-end)))
952       ;; Ensure BEG < END
953       (setq beg (prog1 (min beg end)
954                   (setq end (max beg end))))
955       ;; Calculate columns
956       (goto-char end)
957       (setq end-col (current-column))
958       (goto-char beg)
959       (setq beg-col (current-column))
960       ;; Ensure BEG-COL < END-COL
961       (when (> beg-col end-col)
962         (setq beg-col (prog1 end-col
963                         (setq end-col beg-col)))
964         (setq end (save-excursion
965                     (goto-char end)
966                     (move-to-column end-col)
967                     (point))))
968       ;; Apply FUNC on each line
969       (while (< (point) end)
970         (apply func
971                (save-excursion
972                  (move-to-column beg-col)
973                  (point))
974                (save-excursion
975                  (move-to-column end-col)
976                  (point))
977                args)
978         (forward-line 1)))))
979
980 (defun vimpulse-visual-block-position (corner &optional beg end)
981   "Return position of Visual Block CORNER.
982 CORNER may be one of `upper-left', `upper-right', `lower-left'
983 and `lower-right', or a clockwise number from 0 to 3:
984
985         0---1        upper-left +---+ upper-right
986         |   |                   |   |
987         3---2        lower-left +---+ lower-right
988
989 The rectangle is defined by mark and point, or BEG and END
990 if specified. The CORNER values `upper', `left', `lower'
991 and `right' return one of the defining corners.
992
993         upper P---+                    +---M upper
994          left |   | lower        lower |   | right
995               +---M right         left P---+
996
997 Corners 0 and 3 are returned by their left side, corners 1 and 2
998 by their right side. To place point in one of the corners, use
999 `vimpulse-visual-block-rotate'.
1000
1001 To go the other way, use `vimpulse-visual-block-corner'."
1002   (save-excursion
1003     (setq beg (or beg (vimpulse-visual-beginning 'block))
1004           end (or end (vimpulse-visual-end 'block)))
1005     (when (> beg end) (setq beg (prog1 end (setq end beg))))
1006     (let ((beg-col (progn (goto-char beg)
1007                           (current-column)))
1008           (end-col (progn (goto-char end)
1009                           (current-column)))
1010           (upper beg) (left beg) (lower end) (right end)
1011           (upper-left 0) (upper-right 1)
1012           (lower-left 3) (lower-right 2))
1013       (when (> beg-col end-col)
1014         (setq beg-col (prog1 end-col
1015                         (setq end-col beg-col)))
1016         (setq left (prog1 right
1017                      (setq right left))))
1018       (if (memq corner '(upper left lower right))
1019           (eval corner)
1020         (setq corner (mod (eval corner) 4))
1021         (if (memq corner '(0 1))
1022             (goto-char beg)
1023           (goto-char end))
1024         (if (memq corner '(0 3))
1025             (vimpulse-move-to-column beg-col)
1026           (vimpulse-move-to-column end-col))
1027         (point)))))
1028
1029 (defun vimpulse-visual-block-corner (&optional symbolic pos)
1030   "Return the current Visual Block corner as a number from 0 to 3.
1031 Corners are numbered clockwise, starting with the upper-left corner.
1032 Return as one of `upper-left', `upper-right', `lower-left' and
1033 `lower-right' if SYMBOLIC is non-nil.
1034
1035         0---1        upper-left +---+ upper-right
1036         |   |                   |   |
1037         3---2        lower-left +---+ lower-right
1038
1039 Specify POS to compare that position, rather than point,
1040 against the corners. The result can be passed to functions
1041 like `vimpulse-visual-block-position' and
1042 `vimpulse-visual-block-rotate'."
1043   (let ((upper-left 0)
1044         (upper-right 1)
1045         (lower-left 3)
1046         (lower-right 2)
1047         corner)
1048     (setq pos (or pos (point)))
1049     (or (dolist (i '(upper-left lower-left) corner)
1050           (when (eq (vimpulse-visual-block-position i) pos)
1051             (setq corner i)))
1052         (progn
1053           (unless vimpulse-visual-region-expanded
1054             (setq pos (1+ pos)))
1055           (dolist (i '(upper-right lower-right) corner)
1056             (when (eq (vimpulse-visual-block-position i) pos)
1057               (setq corner i)))))
1058     (if symbolic
1059         corner
1060       (eval corner))))
1061
1062 (defun vimpulse-visual-block-rotate (corner &optional beg end)
1063   "In Visual Block selection, rotate point and mark clockwise.
1064 When called non-interactively, CORNER specifies the corner to
1065 place point in; mark is placed in the opposite corner.
1066
1067         0---1        upper-left +---+ upper-right
1068         |   |                   |   |
1069         3---2        lower-left +---+ lower-right
1070
1071 Corners are numbered clockwise from 0. For better readability,
1072 you may use the symbolic values `upper-left', `upper-right',
1073 `lower-left' and `lower-right'.
1074
1075 This function updates `vimpulse-visual-point' and
1076 `vimpulse-visual-mark' so that \\[vimpulse-visual-restore]
1077 restores the selection with the same rotation."
1078   (interactive
1079    (list (if (< (prefix-numeric-value current-prefix-arg) 0)
1080              (1- (vimpulse-visual-block-corner))
1081            (1+ (vimpulse-visual-block-corner)))))
1082   (let ((upper-left 0) (upper-right 1) (lower-left 3) (lower-right 2)
1083         newmark newpoint newmark-marker newpoint-marker mark-active)
1084     (setq corner (mod (eval corner) 4))
1085     (setq newpoint (vimpulse-visual-block-position corner beg end))
1086     (setq newmark (vimpulse-visual-block-position
1087                    (mod (+ 2 corner) 4) beg end))
1088     (if (memq corner '(0 3))
1089         (setq newmark-marker (1- newmark)
1090               newpoint-marker newpoint)
1091       (setq newpoint-marker (1- newpoint)
1092             newmark-marker newmark))
1093     (unless vimpulse-visual-region-expanded
1094       (setq newpoint newpoint-marker
1095             newmark  newmark-marker))
1096     (set-mark newmark)
1097     (goto-char newpoint)
1098     (vimpulse-visual-dimensions beg end 'block)))
1099
1100 (defun vimpulse-visual-exchange-corners ()
1101   "Rearrange corners in Visual Block mode.
1102
1103         M---+          +---M
1104         |   |    =>    |   |
1105         +---P          P---+
1106
1107 For example, if mark is in the upper left corner and point
1108 in the lower right (see fig.), this function puts mark in
1109 the upper right corner and point in the lower left."
1110   (interactive)
1111   (cond
1112    ((memq vimpulse-visual-mode '(normal line))
1113     (exchange-point-and-mark))
1114    ((eq vimpulse-visual-mode 'block)
1115     (let ((mark-col (save-excursion
1116                       (goto-char (mark t))
1117                       (forward-char)
1118                       (1- (current-column))))
1119           (point-col (current-column)))
1120       (set-mark (save-excursion
1121                   (goto-char (mark t))
1122                   (vimpulse-move-to-column
1123                    point-col (< (current-column) point-col))
1124                   (point)))
1125       (vimpulse-move-to-column
1126        mark-col (< (current-column) mark-col))
1127       (and (eolp) (not (bolp)) (backward-char))))
1128    (t
1129     (error "Not in Visual mode"))))
1130
1131 ;; Insert whitespace into buffer to handle zero-width rectangles.
1132 ;; This isn't ideal and should be replaced with something else.
1133 (defun vimpulse-visual-block-add-whitespace ()
1134   "Ensure rectangle is at least one column wide.
1135 If the Block selection starts and ends on blank lines, the
1136 resulting rectangle has width zero even if intermediate lines
1137 contain characters. This function inserts a space after mark
1138 so that a one-column rectangle can be made. The position of the
1139 space is stored in `vimpulse-visual-whitespace-overlay' so it can be
1140 removed afterwards with `vimpulse-visual-block-cleanup-whitespace'."
1141   (save-excursion
1142     (when (and (eq vimpulse-visual-mode 'block)
1143                (/= (vimpulse-visual-beginning)
1144                    (vimpulse-visual-end))
1145                (save-excursion
1146                  (goto-char (vimpulse-visual-beginning))
1147                  (and (bolp) (eolp)))
1148                (save-excursion
1149                  (goto-char (vimpulse-visual-end))
1150                  (and (bolp) (eolp))))
1151       (goto-char (mark t))
1152       (insert " ")
1153       (setq vimpulse-visual-whitespace-overlay
1154             (vimpulse-make-overlay (mark t) (1+ (mark t))
1155                                    nil t nil)))))
1156
1157 (defun vimpulse-visual-block-cleanup-whitespace ()
1158   "Clean up whitespace inserted by `vimpulse-visual-block-add-whitespace'."
1159   (when (viper-overlay-live-p vimpulse-visual-whitespace-overlay)
1160     (when (= (- (viper-overlay-end
1161                  vimpulse-visual-whitespace-overlay)
1162                 (viper-overlay-start
1163                  vimpulse-visual-whitespace-overlay))
1164              1)
1165       (delete-region
1166        (viper-overlay-start vimpulse-visual-whitespace-overlay)
1167        (viper-overlay-end   vimpulse-visual-whitespace-overlay)))
1168     (vimpulse-delete-overlay vimpulse-visual-whitespace-overlay)
1169     (setq vimpulse-visual-whitespace-overlay nil)))
1170
1171 (defun vimpulse-visual-create-coords
1172   (mode i-com upper-left lower-right)
1173   "Update the list of block insert coordinates with current rectangle.
1174 I-COM should be ?c, ?i, ?a, ?I or ?A; the column for the
1175 insertion will be chosen according to this command.
1176 Returns the insertion point."
1177   (setq vimpulse-visual-insert-coords nil)
1178   (let ((nlines (count-lines upper-left lower-right))
1179         (col 0))               ; for ?I and ?A, trivial -- column is 0
1180     (when (memq i-com '(?a ?c ?i))
1181       ;; For ?i and ?a, choose the left (the right) rectangle column
1182       (let ((beg-col (save-excursion
1183                        (goto-char upper-left)
1184                        (current-column)))
1185             (end-col (save-excursion
1186                        (goto-char lower-right)
1187                        (current-column))))
1188         ;; Decide if we use the left or right column
1189         (setq col (max 0 (if (memq i-com '(?c ?i))
1190                              beg-col
1191                            (1- end-col))))))
1192     ;; Save the information
1193     (setq vimpulse-visual-insert-coords
1194           (list mode i-com upper-left col nlines))
1195     (save-excursion
1196       (goto-char upper-left)
1197       (vimpulse-move-to-column col)
1198       (point))))
1199
1200 ;; Redefinitions of Viper functions to handle Visual block selection,
1201 ;; that is, the "update all lines when we hit ESC" part.
1202 ;; This function is not in viper-functions-redefinitions.el
1203 ;; because its code is closely related to Visual mode.
1204 (defun vimpulse-exit-insert-state ()
1205   (interactive)
1206   (viper-move-marker-locally 'vimpulse-exit-point (point))
1207   (viper-change-state-to-vi)
1208   (when vimpulse-visual-insert-coords
1209     ;; Get the saved info about the Visual selection
1210     (let ((mode   (nth 0 vimpulse-visual-insert-coords))
1211           (i-com  (nth 1 vimpulse-visual-insert-coords))
1212           (pos    (nth 2 vimpulse-visual-insert-coords))
1213           (col    (nth 3 vimpulse-visual-insert-coords))
1214           (nlines (nth 4 vimpulse-visual-insert-coords)))
1215       (goto-char pos)
1216       (save-excursion
1217         (dotimes (i (1- nlines))
1218           (forward-line 1)
1219           (let ((cur-col (vimpulse-move-to-column col)))
1220             ;; If we are in Block mode, this line, but do not hit the
1221             ;; correct column, we check if we should convert tabs
1222             ;; and/or append spaces
1223             (if (and (eq mode 'block)
1224                      (or (/= col cur-col) ; wrong column or
1225                          (eolp)))         ; end of line
1226                 (cond ((> cur-col col)    ; we are inside a tab
1227                        (move-to-column (1+ col) t) ; convert to spaces
1228                        (move-to-column col t) ; this is needed for ?a
1229                        (viper-repeat nil))
1230                       ((and (>= col cur-col) ; we are behind the end
1231                             (eq i-com ?a))   ; and I-COM is ?a
1232                        (move-to-column (1+ col) t) ; append spaces
1233                        (viper-repeat nil)))
1234               (viper-repeat nil)))))
1235       (setq vimpulse-visual-insert-coords nil)))
1236   ;; Update undo-list
1237   (vimpulse-connect-undos))
1238
1239 (fset 'viper-exit-insert-state 'vimpulse-exit-insert-state)
1240
1241 ;;; Key bindings
1242
1243 (define-key vimpulse-visual-basic-map "v" 'vimpulse-visual-toggle-normal)
1244 (define-key vimpulse-visual-basic-map "V" 'vimpulse-visual-toggle-line)
1245 (define-key vimpulse-visual-basic-map "\C-v" 'vimpulse-visual-toggle-block)
1246 (define-key vimpulse-visual-basic-map "x" 'vimpulse-delete)
1247 (define-key vimpulse-visual-basic-map "D" 'vimpulse-delete)
1248 (define-key vimpulse-visual-basic-map "Y" 'vimpulse-yank)
1249 (define-key vimpulse-visual-basic-map "R" 'vimpulse-change)
1250 (define-key vimpulse-visual-basic-map "C" 'vimpulse-change)
1251 (define-key vimpulse-visual-basic-map "s" 'vimpulse-change)
1252 (define-key vimpulse-visual-basic-map "S" 'vimpulse-change)
1253 (define-key vimpulse-visual-basic-map "o" 'exchange-point-and-mark)
1254 (define-key vimpulse-visual-basic-map "O" 'vimpulse-visual-exchange-corners)
1255 (define-key vimpulse-visual-basic-map "I" 'vimpulse-visual-insert)
1256 (define-key vimpulse-visual-basic-map "A" 'vimpulse-visual-append)
1257 (define-key vimpulse-visual-basic-map "U" 'vimpulse-upcase)
1258 (define-key vimpulse-visual-basic-map "u" 'vimpulse-downcase)
1259 (define-key vimpulse-visual-basic-map ":" 'vimpulse-visual-ex)
1260 ;; Keys that have no effect in Visual mode
1261 (vimpulse-visual-remap 'viper-repeat 'viper-nil)
1262
1263 (provide 'vimpulse-visual-mode)