diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/evil-20180912.957/evil-states.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/evil-20180912.957/evil-states.el | 903 |
1 files changed, 0 insertions, 903 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/evil-20180912.957/evil-states.el b/configs/shared/emacs/.emacs.d/elpa/evil-20180912.957/evil-states.el deleted file mode 100644 index c91d673c70..0000000000 --- a/configs/shared/emacs/.emacs.d/elpa/evil-20180912.957/evil-states.el +++ /dev/null @@ -1,903 +0,0 @@ -;;; evil-states.el --- States - -;; Author: Vegard Øye <vegard_oye at hotmail.com> -;; Maintainer: Vegard Øye <vegard_oye at hotmail.com> - -;; Version: 1.2.13 - -;; -;; 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 - 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 evil-move-cursor-back - (when (or (evil-normal-state-p evil-next-state) - (evil-motion-state-p evil-next-state)) - (evil-move-cursor-back)))))) - -(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 (i (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 (i (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) - (debug (&define name stringp - [&rest keywordp sexp] - def-body))) - (let* ((name (intern (format "evil-visual-%s" selection))) - (message (intern (format "%s-message" name))) - (type selection) - 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)))) - ;; macro expansion - `(progn - (add-to-list 'evil-visual-alist (cons ',selection ',name)) - (defvar ,name ',type ,(format "*%s" doc)) - (defvar ,message ,string ,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 --") - -(evil-define-visual-selection line - "Linewise selection." - :message "-- VISUAL LINE --") - -(evil-define-visual-selection block - "Blockwise selection." - :message "-- VISUAL BLOCK --" - (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 " <V> " - :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." - (let ((buf (or buffer (current-buffer)))) - (when (buffer-live-p buf) - (with-current-buffer buf - (when (and (evil-visual-state-p) - (display-selections-p) - (not (eq evil-visual-selection 'block))) - (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-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)) - (mark (or (mark t) 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 (i 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)) - (when evil-move-cursor-back - (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)))))) - -;;; 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 |