summaryrefslogtreecommitdiff
path: root/elpa/evil-20220510.2302/evil-states.el
diff options
context:
space:
mode:
authormattkae <mattkae@protonmail.com>2022-06-07 08:23:47 -0400
committermattkae <mattkae@protonmail.com>2022-06-07 08:23:47 -0400
commitbd18a38c2898548a3664a9ddab9f79c84f2caf4a (patch)
tree95b9933376770381bd8859782ae763be81c2d72b /elpa/evil-20220510.2302/evil-states.el
parentb07628dddf418d4f47b858e6c35fd3520fbaeed2 (diff)
parentef160dea332af4b4fe5e2717b962936c67e5fe9e (diff)
Merge conflict
Diffstat (limited to 'elpa/evil-20220510.2302/evil-states.el')
-rw-r--r--elpa/evil-20220510.2302/evil-states.el937
1 files changed, 0 insertions, 937 deletions
diff --git a/elpa/evil-20220510.2302/evil-states.el b/elpa/evil-20220510.2302/evil-states.el
deleted file mode 100644
index a2e0e6e..0000000
--- a/elpa/evil-20220510.2302/evil-states.el
+++ /dev/null
@@ -1,937 +0,0 @@
-;;; evil-states.el --- States -*- lexical-binding: t -*-
-
-;; Author: Vegard Øye <vegard_oye at hotmail.com>
-;; Maintainer: Vegard Øye <vegard_oye at hotmail.com>
-
-;; Version: 1.15.0
-
-;;
-;; This file is NOT part of GNU Emacs.
-
-;;; License:
-
-;; This file is part of Evil.
-;;
-;; Evil 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.
-;;
-;; Evil 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 Evil. If not, see <http://www.gnu.org/licenses/>.
-
-(require 'evil-core)
-
-;;; Code:
-
-;;; Normal state
-
-(evil-define-state normal
- "Normal state.
-AKA \"Command\" state."
- :tag " <N> "
- :enable (motion)
- :exit-hook (evil-repeat-start-hook)
- (cond
- ((evil-normal-state-p)
- (overwrite-mode -1)
- (add-hook 'post-command-hook #'evil-normal-post-command nil t))
- (t
- (remove-hook 'post-command-hook #'evil-normal-post-command t))))
-
-(defun evil-normal-post-command (&optional command)
- "Reset command loop variables in Normal state.
-Also prevent point from reaching the end of the line.
-If the region is activated, enter Visual state."
- (unless (or (evil-initializing-p)
- (null this-command))
- (setq command (or command this-command))
- (when (evil-normal-state-p)
- (setq evil-this-type nil
- evil-this-operator nil
- evil-this-motion nil
- evil-this-motion-count nil
- evil-inhibit-operator nil
- evil-inhibit-operator-value nil)
- (unless (memq command '(evil-use-register
- digit-argument
- negative-argument
- universal-argument
- universal-argument-minus
- universal-argument-more
- universal-argument-other-key))
- (setq evil-this-register nil))
- (evil-adjust-cursor))))
-(put 'evil-normal-post-command 'permanent-local-hook t)
-
-;;; Insert state
-
-(defun evil-maybe-remove-spaces (&optional do-remove)
- "Remove space from newly opened empty line.
-This function removes (indentation) spaces that have been
-inserted by opening a new empty line. The behavior depends on the
-variable `evil-maybe-remove-spaces'. If this variable is nil the
-function does nothing. Otherwise the behavior depends on
-DO-REMOVE. If DO-REMOVE is non-nil the spaces are
-removed. Otherwise `evil-maybe-remove-spaces' is set to nil
-unless the last command opened yet another new line.
-
-This function should be added as a post-command-hook to track
-commands opening a new line."
- (cond
- ((not evil-maybe-remove-spaces)
- (remove-hook 'post-command-hook #'evil-maybe-remove-spaces))
- (do-remove
- (when (save-excursion
- (beginning-of-line)
- (looking-at "^\\s-*$"))
- (delete-region (line-beginning-position)
- (line-end-position)))
- (setq evil-maybe-remove-spaces nil)
- (remove-hook 'post-command-hook #'evil-maybe-remove-spaces))
- ((not (memq this-command
- '(evil-open-above
- evil-open-below
- evil-append
- evil-append-line
- evil-change-whole-line
- newline
- newline-and-indent
- indent-and-newline)))
- (setq evil-maybe-remove-spaces nil)
- (remove-hook 'post-command-hook #'evil-maybe-remove-spaces))))
-
-(evil-define-state insert
- "Insert state."
- :tag " <I> "
- :cursor (bar . 2)
- :message "-- INSERT --"
- :entry-hook (evil-start-track-last-insertion)
- :exit-hook (evil-cleanup-insert-state evil-stop-track-last-insertion)
- :input-method t
- (cond
- ((evil-insert-state-p)
- (add-hook 'post-command-hook #'evil-maybe-remove-spaces)
- (add-hook 'pre-command-hook #'evil-insert-repeat-hook)
- (setq evil-maybe-remove-spaces t)
- (unless (eq evil-want-fine-undo t)
- (evil-start-undo-step)))
- (t
- (remove-hook 'post-command-hook #'evil-maybe-remove-spaces)
- (remove-hook 'pre-command-hook #'evil-insert-repeat-hook)
- (evil-maybe-remove-spaces t)
- (setq evil-insert-repeat-info evil-repeat-info)
- (evil-set-marker ?^ nil t)
- (unless (eq evil-want-fine-undo t)
- (evil-end-undo-step))
- (when (or (evil-normal-state-p evil-next-state)
- (evil-motion-state-p evil-next-state))
- (evil-move-cursor-back
- (and (eolp) (not evil-move-beyond-eol)))))))
-
-(defun evil-insert-repeat-hook ()
- "Record insertion keys in `evil-insert-repeat-info'."
- (setq evil-insert-repeat-info (last evil-repeat-info))
- (remove-hook 'pre-command-hook #'evil-insert-repeat-hook))
-(put 'evil-insert-repeat-hook 'permanent-local-hook t)
-
-(defun evil-cleanup-insert-state ()
- "Called when Insert state is about to be exited.
-Handles the repeat-count of the insertion command."
- (when evil-insert-count
- (dotimes (_ (1- evil-insert-count))
- (when evil-insert-lines
- (evil-insert-newline-below)
- (when evil-auto-indent
- (indent-according-to-mode)))
- (when (fboundp 'evil-execute-repeat-info)
- (evil-execute-repeat-info
- (cdr evil-insert-repeat-info)))))
- (when evil-insert-vcount
- (let ((buffer-invisibility-spec buffer-invisibility-spec))
- ;; make all lines hidden by hideshow temporarily visible
- (when (listp buffer-invisibility-spec)
- (setq buffer-invisibility-spec
- (evil-filter-list
- #'(lambda (x)
- (or (eq x 'hs)
- (eq (car-safe x) 'hs)))
- buffer-invisibility-spec)))
- (let ((line (nth 0 evil-insert-vcount))
- (col (nth 1 evil-insert-vcount))
- (vcount (nth 2 evil-insert-vcount)))
- (save-excursion
- (dotimes (v (1- vcount))
- (goto-char (point-min))
- (forward-line (+ line v))
- (when (or (not evil-insert-skip-empty-lines)
- (not (integerp col))
- (save-excursion
- (evil-move-end-of-line)
- (>= (current-column) col)))
- (if (integerp col)
- (move-to-column col t)
- (funcall col))
- (dotimes (_ (or evil-insert-count 1))
- (when (fboundp 'evil-execute-repeat-info)
- (evil-execute-repeat-info
- (cdr evil-insert-repeat-info)))))))))))
-
-;;; Visual state
-
-;; Visual selections are implemented in terms of types, and are
-;; compatible with the Emacs region. This is achieved by "translating"
-;; the region to the selected text right before a command is executed.
-;; If the command is a motion, the translation is postponed until a
-;; non-motion command is invoked (distinguished by the :keep-visual
-;; command property).
-;;
-;; Visual state activates the region, enabling Transient Mark mode if
-;; not already enabled. This is only temporay: if Transient Mark mode
-;; was disabled before entering Visual state, it is disabled when
-;; exiting Visual state. This allows Visual state to harness the
-;; "transient" behavior of many commands without overriding the user's
-;; preferences in other states.
-
-(defmacro evil-define-visual-selection (selection doc &rest body)
- "Define a Visual selection SELECTION.
-Creates a command evil-visual-SELECTION for enabling the selection.
-DOC is the function's documentation string. The following keywords
-may be specified in BODY:
-
-:message STRING Status message when enabling the selection.
-:type TYPE Type to use (defaults to SELECTION).
-
-Following the keywords is optional code which is executed each time
-the selection is enabled.
-
-\(fn SELECTION DOC [[KEY VAL]...] BODY...)"
- (declare (indent defun)
- (doc-string 2)
- (debug (&define name stringp
- [&rest keywordp sexp]
- def-body)))
- (let* ((name (intern (format "evil-visual-%s" selection)))
- (message (intern (format "%s-message" name)))
- (tagvar (intern (format "%s-tag" name)))
- (type selection)
- (tag " <V> ")
- arg key string)
- ;; collect keywords
- (while (keywordp (car-safe body))
- (setq key (pop body)
- arg (pop body))
- (cond
- ((eq key :message)
- (setq string arg))
- ((eq key :type)
- (setq type arg))
- ((eq key :tag)
- (setq tag arg))))
- ;; macro expansion
- `(progn
- (add-to-list 'evil-visual-alist (cons ',selection ',name))
- (defvar ,name ',type ,(format "*%s" doc))
- (defvar ,message ,string ,doc)
- (defvar ,tagvar ,tag ,doc)
- (evil-define-command ,name (&optional mark point type message)
- ,@(when doc `(,doc))
- :keep-visual t
- :repeat nil
- (interactive
- (list nil nil
- (if (and (evil-visual-state-p)
- (eq evil-visual-selection ',selection))
- 'exit ,name) t))
- (if (eq type 'exit)
- (evil-exit-visual-state)
- (setq type (or type ,name)
- evil-visual-selection ',selection)
- (evil-visual-make-region mark point type message)
- ,@body))
- ',selection)))
-
-(evil-define-visual-selection char
- "Characterwise selection."
- :type inclusive
- :message "-- VISUAL --"
- :tag " <V> ")
-
-(evil-define-visual-selection line
- "Linewise selection."
- :message "-- VISUAL LINE --"
- :tag " <Vl> ")
-
-(evil-define-visual-selection screen-line
- "Linewise selection in `visual-line-mode'."
- :message "-- SCREEN LINE --"
- :tag " <Vs> ")
-
-(evil-define-visual-selection block
- "Blockwise selection."
- :message "-- VISUAL BLOCK --"
- :tag " <Vb> "
- (evil-transient-mark -1)
- ;; refresh the :corner property
- (setq evil-visual-properties
- (plist-put evil-visual-properties :corner
- (evil-visual-block-corner 'upper-left))))
-
-(evil-define-state visual
- "Visual state."
- :tag 'evil-visual-tag
- :enable (motion normal)
- :message 'evil-visual-message
- (cond
- ((evil-visual-state-p)
- (evil-save-transient-mark-mode)
- (setq select-active-regions nil)
- (cond
- ((region-active-p)
- (if (< (evil-visual-direction) 0)
- (evil-visual-select (region-beginning) (region-end)
- evil-visual-char
- (evil-visual-direction))
- (evil-visual-make-selection (mark t) (point)
- evil-visual-char))
- (evil-visual-highlight))
- (t
- (evil-visual-make-region (point) (point) evil-visual-char)))
- (add-hook 'pre-command-hook #'evil-visual-pre-command nil t)
- (add-hook 'post-command-hook #'evil-visual-post-command nil t)
- (add-hook 'deactivate-mark-hook #'evil-visual-deactivate-hook nil t))
- (t
- ;; Postpone deactivation of region if next state is Insert.
- ;; This gives certain insertion commands (auto-pairing characters,
- ;; for example) an opportunity to access the region.
- (if (and (eq evil-next-state 'insert)
- (eq evil-visual-selection 'char))
- (add-hook 'evil-normal-state-entry-hook
- #'evil-visual-deactivate-hook nil t)
- (evil-visual-deactivate-hook))
- (setq evil-visual-region-expanded nil)
- (remove-hook 'pre-command-hook #'evil-visual-pre-command t)
- (remove-hook 'post-command-hook #'evil-visual-post-command t)
- (remove-hook 'deactivate-mark-hook #'evil-visual-deactivate-hook t)
- (evil-visual-highlight -1))))
-
-(defun evil-visual-pre-command (&optional command)
- "Run before each COMMAND in Visual state.
-Expand the region to the selection unless COMMAND is a motion."
- (when (evil-visual-state-p)
- (setq command (or command this-command))
- (when evil-visual-x-select-timer
- (cancel-timer evil-visual-x-select-timer))
- (unless (evil-get-command-property command :keep-visual)
- (evil-visual-update-x-selection)
- (evil-visual-expand-region
- ;; exclude final newline from linewise selection
- ;; unless the command has real need of it
- (and (eq (evil-visual-type) 'line)
- (evil-get-command-property command :exclude-newline))))))
-
-(put 'evil-visual-pre-command 'permanent-local-hook t)
-
-(defun evil-visual-post-command (&optional command)
- "Run after each COMMAND in Visual state.
-If COMMAND is a motion, refresh the selection;
-otherwise exit Visual state."
- (when (evil-visual-state-p)
- (setq command (or command this-command))
- (if (or quit-flag
- (eq command #'keyboard-quit)
- ;; Is `mark-active' nil for an unexpanded region?
- deactivate-mark
- (and (not evil-visual-region-expanded)
- (not (region-active-p))
- (not (eq evil-visual-selection 'block))))
- (progn
- (evil-exit-visual-state)
- (evil-adjust-cursor))
- (if evil-visual-region-expanded
- (evil-visual-contract-region)
- (evil-visual-refresh))
- (setq evil-visual-x-select-timer
- (run-with-idle-timer evil-visual-x-select-timeout nil
- #'evil-visual-update-x-selection
- (current-buffer)))
- (evil-visual-highlight))))
-(put 'evil-visual-post-command 'permanent-local-hook t)
-
-(defun evil-visual-update-x-selection (&optional buffer)
- "Update the X selection with the current visual region of BUFFER."
- (let ((buf (or buffer (current-buffer))))
- (when (and evil-visual-update-x-selection-p
- (buffer-live-p buf)
- (evil-visual-state-p)
- (display-selections-p)
- (not (eq evil-visual-selection 'block)))
- (with-current-buffer buf
- (evil-set-selection 'PRIMARY (buffer-substring-no-properties
- evil-visual-beginning
- evil-visual-end))))))
-
-(defun evil-visual-activate-hook (&optional _command)
- "Enable Visual state if the region is activated."
- (unless (evil-visual-state-p)
- (evil-delay nil
- ;; the activation may only be momentary, so re-check
- ;; in `post-command-hook' before entering Visual state
- '(unless (or (evil-visual-state-p)
- (evil-insert-state-p)
- (evil-emacs-state-p))
- (when (and (region-active-p)
- (not deactivate-mark))
- (evil-visual-state)))
- 'post-command-hook nil t
- "evil-activate-visual-state")))
-(put 'evil-visual-activate-hook 'permanent-local-hook t)
-
-(defun evil-visual-deactivate-hook (&optional command)
- "Deactivate the region and restore Transient Mark mode."
- (setq command (or command this-command))
- (remove-hook 'deactivate-mark-hook
- #'evil-visual-deactivate-hook t)
- (remove-hook 'evil-normal-state-entry-hook
- #'evil-visual-deactivate-hook t)
- (cond
- ((and (evil-visual-state-p) command
- (not (evil-get-command-property command :keep-visual)))
- (setq evil-visual-region-expanded nil)
- (evil-exit-visual-state))
- ((not (evil-visual-state-p))
- (evil-active-region -1)
- (evil-restore-transient-mark-mode))))
-(put 'evil-visual-deactivate-hook 'permanent-local-hook t)
-
-(evil-define-command evil-exit-visual-state (&optional later buffer)
- "Exit from Visual state to the previous state.
-If LATER is non-nil, exit after the current command."
- :keep-visual t
- :repeat abort
- (with-current-buffer (or buffer (current-buffer))
- (when (evil-visual-state-p)
- (if later
- (setq deactivate-mark t)
- (when evil-visual-region-expanded
- (evil-visual-contract-region))
- (evil-change-to-previous-state)))))
-
-(defun evil-visual-tag (&optional selection)
- "Return a mode-line tag for SELECTION.
-SELECTION is a kind of selection as defined by
-`evil-define-visual-selection', such as `char', `line'
-or `block'."
- (setq selection (or selection evil-visual-selection))
- (when selection
- (symbol-value (intern (format "evil-visual-%s-tag" selection)))))
-
-(defun evil-visual-message (&optional selection)
- "Create an echo area message for SELECTION.
-SELECTION is a kind of selection as defined by
-`evil-define-visual-selection', such as `char', `line'
-or `block'."
- (let (message)
- (setq selection (or selection evil-visual-selection))
- (when selection
- (setq message
- (symbol-value (intern (format "evil-visual-%s-message"
- selection))))
- (cond
- ((functionp message)
- (funcall message))
- ((stringp message)
- (evil-echo "%s" message))))))
-
-(defun evil-visual-select (beg end &optional type dir message)
- "Create a Visual selection of type TYPE from BEG to END.
-Point and mark are positioned so that the resulting selection
-has the specified boundaries. If DIR is negative, point precedes mark,
-otherwise it succedes it. To specify point and mark directly,
-use `evil-visual-make-selection'."
- (let* ((range (evil-contract beg end type))
- (mark (evil-range-beginning range))
- (point (evil-range-end range))
- (dir (or dir 1)))
- (when (< dir 0)
- (evil-swap mark point))
- (evil-visual-make-selection mark point type message)))
-
-(defun evil-visual-make-selection (mark point &optional type message)
- "Create a Visual selection with point at POINT and mark at MARK.
-The boundaries of the selection are inferred from these
-and the current TYPE. To specify the boundaries and infer
-mark and point, use `evil-visual-select' instead."
- (let* ((selection (evil-visual-selection-for-type type))
- (func (evil-visual-selection-function selection))
- (prev (and (evil-visual-state-p) evil-visual-selection))
- (mark (evil-normalize-position mark))
- (point (evil-normalize-position point))
- (state evil-state))
- (unless (evil-visual-state-p)
- (evil-visual-state))
- (setq evil-visual-selection selection)
- (funcall func mark point type
- ;; signal a message when changing the selection
- (when (or (not (evil-visual-state-p state))
- (not (eq selection prev)))
- message))))
-
-(defun evil-visual-make-region (mark point &optional type message)
- "Create an active region from MARK to POINT.
-If TYPE is given, also set the Visual type.
-If MESSAGE is given, display it in the echo area."
- (interactive)
- (let* ((point (evil-normalize-position
- (or point (point))))
- (mark (evil-normalize-position
- (or mark
- (when (or (evil-visual-state-p)
- (region-active-p))
- (mark t))
- point))))
- (unless (evil-visual-state-p)
- (evil-visual-state))
- (evil-active-region 1)
- (setq evil-visual-region-expanded nil)
- (evil-visual-refresh mark point type)
- (cond
- ((null evil-echo-state))
- ((stringp message)
- (evil-echo "%s" message))
- (message
- (cond
- ((stringp evil-visual-state-message)
- (evil-echo "%s" evil-visual-state-message))
- ((functionp evil-visual-state-message)
- (funcall evil-visual-state-message)))))))
-
-(defun evil-visual-expand-region (&optional exclude-newline)
- "Expand the region to the Visual selection.
-If EXCLUDE-NEWLINE is non-nil and the selection ends with a newline,
-exclude that newline from the region."
- (when (and (evil-visual-state-p)
- (not evil-visual-region-expanded))
- (let ((mark evil-visual-beginning)
- (point evil-visual-end))
- (when (< evil-visual-direction 0)
- (evil-swap mark point))
- (setq evil-visual-region-expanded t)
- (evil-visual-refresh mark point)
- (when (and exclude-newline
- (save-excursion
- (goto-char evil-visual-end)
- (and (bolp) (not (bobp)))))
- (if (< evil-visual-direction 0)
- (evil-move-mark (max point (1- (mark))))
- (goto-char (max mark (1- (point)))))))))
-
-(defun evil-visual-contract-region ()
- "The inverse of `evil-visual-expand-region'.
-Create a Visual selection that expands to the current region."
- (evil-visual-refresh)
- (setq evil-visual-region-expanded nil)
- (evil-visual-refresh evil-visual-mark evil-visual-point))
-
-(defun evil-visual-refresh (&optional mark point type &rest properties)
- "Refresh point, mark and Visual variables.
-Refreshes `evil-visual-beginning', `evil-visual-end',
-`evil-visual-mark', `evil-visual-point', `evil-visual-selection',
-`evil-visual-direction', `evil-visual-properties' and `evil-this-type'."
- (let* ((point (or point (point)))
- (mark (or mark (mark t) point))
- (dir (evil-visual-direction))
- (type (or type (evil-visual-type evil-visual-selection)
- (evil-visual-type)))
- range)
- (evil-move-mark mark)
- (goto-char point)
- (setq evil-visual-beginning
- (or evil-visual-beginning
- (let ((marker (make-marker)))
- (move-marker marker (min point mark))))
- evil-visual-end
- (or evil-visual-end
- (let ((marker (make-marker)))
- (set-marker-insertion-type marker t)
- (move-marker marker (max point mark))))
- evil-visual-mark
- (or evil-visual-mark
- (let ((marker (make-marker)))
- (move-marker marker mark)))
- evil-visual-point
- (or evil-visual-point
- (let ((marker (make-marker)))
- (move-marker marker point))))
- (setq evil-visual-properties
- (evil-concat-plists evil-visual-properties properties))
- (cond
- (evil-visual-region-expanded
- (setq type (or (evil-visual-type) type))
- (move-marker evil-visual-beginning (min point mark))
- (move-marker evil-visual-end (max point mark))
- ;; if the type is one-to-one, we can safely refresh
- ;; the unexpanded positions as well
- (when (evil-type-property type :one-to-one)
- (setq range (apply #'evil-contract point mark type
- evil-visual-properties)
- mark (evil-range-beginning range)
- point (evil-range-end range))
- (when (< dir 0)
- (evil-swap mark point))
- (move-marker evil-visual-mark mark)
- (move-marker evil-visual-point point)))
- (t
- (setq range (apply #'evil-expand point mark type
- evil-visual-properties)
- type (evil-type range type))
- (move-marker evil-visual-beginning (evil-range-beginning range))
- (move-marker evil-visual-end (evil-range-end range))
- (move-marker evil-visual-mark mark)
- (move-marker evil-visual-point point)))
- (setq evil-visual-direction dir
- evil-this-type type)))
-
-(defun evil-visual-highlight (&optional arg)
- "Highlight Visual selection, depending on the Visual type.
-With negative ARG, disable highlighting."
- (cond
- ((and (numberp arg) (< arg 1))
- (when evil-visual-overlay
- (delete-overlay evil-visual-overlay)
- (setq evil-visual-overlay nil))
- (when evil-visual-block-overlays
- (mapc #'delete-overlay evil-visual-block-overlays)
- (setq evil-visual-block-overlays nil)))
- ((eq evil-visual-selection 'block)
- (when evil-visual-overlay
- (evil-visual-highlight -1))
- (evil-visual-highlight-block
- evil-visual-beginning
- evil-visual-end))
- (t
- (when evil-visual-block-overlays
- (evil-visual-highlight -1))
- (if evil-visual-overlay
- (move-overlay evil-visual-overlay
- evil-visual-beginning evil-visual-end)
- (setq evil-visual-overlay
- (make-overlay evil-visual-beginning evil-visual-end)))
- (overlay-put evil-visual-overlay 'face 'region)
- (overlay-put evil-visual-overlay 'priority 99))))
-
-(defun evil-visual-highlight-block (beg end &optional overlays)
- "Highlight rectangular region from BEG to END.
-Do this by putting an overlay on each line within the rectangle.
-Each overlay extends across all the columns of the rectangle.
-Reuse overlays where possible to prevent flicker."
- (let* ((point (point))
- (overlays (or overlays 'evil-visual-block-overlays))
- (old (symbol-value overlays))
- (eol-col (and (memq this-command '(next-line previous-line))
- (numberp temporary-goal-column)
- (1+ (min (round temporary-goal-column)
- (1- most-positive-fixnum)))))
- beg-col end-col new nlines overlay window-beg window-end)
- (save-excursion
- ;; calculate the rectangular region represented by BEG and END,
- ;; but put BEG in the upper-left corner and END in the
- ;; lower-right if not already there
- (setq beg-col (evil-column beg)
- end-col (evil-column end))
- (when (>= beg-col end-col)
- (if (= beg-col end-col)
- (setq end-col (1+ end-col))
- (evil-sort beg-col end-col))
- (setq beg (save-excursion
- (goto-char beg)
- (evil-move-to-column beg-col))
- end (save-excursion
- (goto-char end)
- (evil-move-to-column end-col 1))))
- ;; update end column with eol-col (extension to eol).
- (when (and eol-col (> eol-col end-col))
- (setq end-col eol-col))
- ;; force a redisplay so we can do reliable window
- ;; BEG/END calculations
- (sit-for 0)
- (setq window-beg (max (window-start) beg)
- window-end (min (window-end) (1+ end))
- nlines (count-lines window-beg
- (min window-end (point-max))))
- ;; iterate over those lines of the rectangle which are
- ;; visible in the currently selected window
- (goto-char window-beg)
- (dotimes (_ nlines)
- (let (before after row-beg row-end)
- ;; beginning of row
- (evil-move-to-column beg-col)
- (when (< (current-column) beg-col)
- ;; prepend overlay with virtual spaces if unable to
- ;; move directly to the first column
- (setq before
- (propertize
- (make-string
- (- beg-col (current-column)) ?\s)
- 'face
- (or (get-text-property (1- (point)) 'face)
- 'default))))
- (setq row-beg (point))
- ;; end of row
- (evil-move-to-column end-col)
- (when (and (not (eolp))
- (< (current-column) end-col))
- ;; append overlay with virtual spaces if unable to
- ;; move directly to the last column
- (setq after
- (propertize
- (make-string
- (if (= (point) row-beg)
- (- end-col beg-col)
- (- end-col (current-column)))
- ?\s) 'face 'region))
- ;; place cursor on one of the virtual spaces
- (if (= point row-beg)
- (put-text-property
- 0 (min (length after) 1)
- 'cursor t after)
- (put-text-property
- (max 0 (1- (length after))) (length after)
- 'cursor t after)))
- (setq row-end (min (point) (line-end-position)))
- ;; trim old leading overlays
- (while (and old
- (setq overlay (car old))
- (< (overlay-start overlay) row-beg)
- (/= (overlay-end overlay) row-end))
- (delete-overlay overlay)
- (setq old (cdr old)))
- ;; reuse an overlay if possible, otherwise create one
- (cond
- ((and old (setq overlay (car old))
- (or (= (overlay-start overlay) row-beg)
- (= (overlay-end overlay) row-end)))
- (move-overlay overlay row-beg row-end)
- (overlay-put overlay 'before-string before)
- (overlay-put overlay 'after-string after)
- (setq new (cons overlay new)
- old (cdr old)))
- (t
- (setq overlay (make-overlay row-beg row-end))
- (overlay-put overlay 'before-string before)
- (overlay-put overlay 'after-string after)
- (setq new (cons overlay new)))))
- (forward-line 1))
- ;; display overlays
- (dolist (overlay new)
- (overlay-put overlay 'face 'region)
- (overlay-put overlay 'priority 99))
- ;; trim old overlays
- (dolist (overlay old)
- (delete-overlay overlay))
- (set overlays (nreverse new)))))
-
-(defun evil-visual-range ()
- "Return the Visual selection as a range.
-This is a list (BEG END TYPE PROPERTIES...), where BEG is the
-beginning of the selection, END is the end of the selection,
-TYPE is the selection's type, and PROPERTIES is a property list
-of miscellaneous selection attributes."
- (apply #'evil-range
- evil-visual-beginning evil-visual-end
- (evil-visual-type)
- :expanded t
- evil-visual-properties))
-
-(defun evil-visual-direction ()
- "Return direction of Visual selection.
-The direction is -1 if point precedes mark and 1 otherwise.
-See also the variable `evil-visual-direction', which holds
-the direction of the last selection."
- (let* ((point (point))
- (mark (or (mark t) point)))
- (if (< point mark) -1 1)))
-
-(defun evil-visual-type (&optional selection)
- "Return the type of the Visual selection.
-If SELECTION is specified, return the type of that instead."
- (if (and (null selection) (evil-visual-state-p))
- (or evil-this-type (evil-visual-type evil-visual-selection))
- (setq selection (or selection evil-visual-selection))
- (symbol-value (cdr-safe (assq selection evil-visual-alist)))))
-
-(defun evil-visual-goto-end ()
- "Go to the last line of the Visual selection.
-This position may differ from `evil-visual-end' depending on
-the selection type, and is contained in the selection."
- (let ((range (evil-contract-range (evil-visual-range))))
- (goto-char (evil-range-end range))))
-
-(defun evil-visual-alist ()
- "Return an association list from types to selection symbols."
- (mapcar #'(lambda (e)
- (cons (symbol-value (cdr-safe e)) (cdr-safe e)))
- evil-visual-alist))
-
-(defun evil-visual-selection-function (selection)
- "Return a selection function for TYPE.
-Default to `evil-visual-make-region'."
- (or (cdr-safe (assq selection evil-visual-alist))
- ;; generic selection function
- 'evil-visual-make-region))
-
-(defun evil-visual-selection-for-type (type)
- "Return a Visual selection for TYPE."
- (catch 'done
- (dolist (selection evil-visual-alist)
- (when (eq (symbol-value (cdr selection)) type)
- (throw 'done (car selection))))))
-
-(defun evil-visual-block-corner (&optional corner point mark)
- "Block corner corresponding to POINT, with MARK in opposite corner.
-Depending on POINT and MARK, the return value is `upper-left',
-`upper-right', `lower-left' or `lower-right':
-
- upper-left +---+ upper-right
- | |
- lower-left +---+ lower-right
-
-One-column or one-row blocks are ambiguous. In such cases,
-the horizontal or vertical component of CORNER is used.
-CORNER defaults to `upper-left'."
- (let* ((point (or point (point)))
- (mark (or mark (mark t)))
- (corner (symbol-name
- (or corner
- (and (overlayp evil-visual-overlay)
- (overlay-get evil-visual-overlay
- :corner))
- 'upper-left)))
- (point-col (evil-column point))
- (mark-col (evil-column mark))
- horizontal vertical)
- (cond
- ((= point-col mark-col)
- (setq horizontal
- (or (and (string-match "left\\|right" corner)
- (match-string 0 corner))
- "left")))
- ((< point-col mark-col)
- (setq horizontal "left"))
- ((> point-col mark-col)
- (setq horizontal "right")))
- (cond
- ((= (line-number-at-pos point)
- (line-number-at-pos mark))
- (setq vertical
- (or (and (string-match "upper\\|lower" corner)
- (match-string 0 corner))
- "upper")))
- ((< point mark)
- (setq vertical "upper"))
- ((> point mark)
- (setq vertical "lower")))
- (intern (format "%s-%s" vertical horizontal))))
-
-;;; Operator-Pending state
-
-(evil-define-state operator
- "Operator-Pending state."
- :tag " <O> "
- :cursor evil-half-cursor
- :enable (evil-operator-shortcut-map operator motion normal))
-
-(evil-define-keymap evil-operator-shortcut-map
- "Keymap for Operator-Pending shortcuts like \"dd\" and \"gqq\"."
- :local t
- (setq evil-operator-shortcut-map (make-sparse-keymap))
- (evil-initialize-local-keymaps))
-
-;; the half-height "Operator-Pending cursor" cannot be specified
-;; as a static `cursor-type' value, since its height depends on
-;; the current font size
-(defun evil-half-cursor ()
- "Change cursor to a half-height box.
-\(This is really just a thick horizontal bar.)"
- (let ((height (/ (window-pixel-height) (* (window-height) 2))))
- (setq cursor-type (cons 'hbar height))))
-
-;;; Replace state
-
-(evil-define-state replace
- "Replace state."
- :tag " <R> "
- :cursor hbar
- :message "-- REPLACE --"
- :input-method t
- (cond
- ((evil-replace-state-p)
- (overwrite-mode 1)
- (add-hook 'pre-command-hook #'evil-replace-pre-command nil t)
- (unless (eq evil-want-fine-undo t)
- (evil-start-undo-step)))
- (t
- (overwrite-mode -1)
- (remove-hook 'pre-command-hook #'evil-replace-pre-command t)
- (unless (eq evil-want-fine-undo t)
- (evil-end-undo-step))
- (evil-move-cursor-back)))
- (setq evil-replace-alist nil))
-
-(defun evil-replace-pre-command ()
- "Remember the character under point."
- (when (evil-replace-state-p)
- (unless (assq (point) evil-replace-alist)
- (add-to-list 'evil-replace-alist
- (cons (point)
- (unless (eolp)
- (char-after)))))))
-(put 'evil-replace-pre-command 'permanent-local-hook t)
-
-(defun evil-replace-backspace ()
- "Restore character under cursor."
- (interactive)
- (let (char)
- (backward-char)
- (when (assq (point) evil-replace-alist)
- (setq char (cdr (assq (point) evil-replace-alist)))
- (save-excursion
- (delete-char 1)
- (when char
- (insert char))))))
-
-(defun evil-update-replace-alist (opoint count chars-to-delete &optional offset)
- "Add CHARS-TO-DELETE chars to evil-replace-alist, starting at OPOINT.
-If COUNT is greater than CHARS-TO-DELETE, pad the alist with nils.
-Decrement recorded position by optional offset, or 0."
- (when (evil-replace-state-p)
- (dotimes (c count)
- (let ((pos (+ c opoint)))
- (add-to-list 'evil-replace-alist
- (cons (- pos (or offset 0)) (when (< c chars-to-delete)
- (char-after pos))))))))
-
-;;; Motion state
-
-(evil-define-state motion
- "Motion state."
- :tag " <M> "
- :suppress-keymap t)
-
-;;; Emacs state
-
-(evil-define-state emacs
- "Emacs state."
- :tag " <E> "
- :message "-- EMACS --"
- :input-method t
- :intercept-esc nil)
-
-(provide 'evil-states)
-
-;;; evil-states.el ends here