diff options
Diffstat (limited to 'elpa/evil-20220503.1314/evil-types.el')
| -rw-r--r-- | elpa/evil-20220503.1314/evil-types.el | 460 |
1 files changed, 460 insertions, 0 deletions
diff --git a/elpa/evil-20220503.1314/evil-types.el b/elpa/evil-20220503.1314/evil-types.el new file mode 100644 index 0000000..a230b3c --- /dev/null +++ b/elpa/evil-20220503.1314/evil-types.el @@ -0,0 +1,460 @@ +;;; evil-types.el --- Type system -*- 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/>. + +;;; Commentary: + +;; A type defines a transformation on a pair of buffer positions. +;; Types are used by Visual state (character/line/block selection) +;; and Operator-Pending state (character/line/block motions). +;; +;; The basic transformation is "expansion". For example, the `line' +;; type "expands" a pair of positions to whole lines by moving the +;; first position to the beginning of the line and the last position +;; to the end of the line. That expanded selection is what the rest +;; of Emacs sees and acts on. +;; +;; An optional transformation is "contraction", which is the opposite +;; of expansion. If the transformation is one-to-one, expansion +;; followed by contraction always returns the original range. +;; (The `line' type is not one-to-one, as it may expand multiple +;; positions to the same lines.) +;; +;; Another optional transformation is "normalization", which takes +;; two unexpanded positions and adjusts them before expansion. +;; This is useful for cleaning up "invalid" positions. +;; +;; Types are defined at the end of this file using the macro +;; `evil-define-type'. + +(require 'evil-common) +(require 'evil-macros) + +;;; Code: + +;;; Type definitions + +(evil-define-type exclusive + "Return the positions unchanged, with some exceptions. +If the end position is at the beginning of a line, then: + +* If the beginning position is at or before the first non-blank + character on the line, return `line' (expanded). + +* Otherwise, move the end position to the end of the previous + line and return `inclusive' (expanded)." + :normalize (lambda (beg end) + (cond + ((progn + (goto-char end) + (and (/= beg end) (bolp))) + (setq end (max beg (1- end))) + (cond + ((progn + (goto-char beg) + (looking-back "^[ \f\t\v]*" (line-beginning-position))) + (evil-expand beg end 'line)) + (t + (unless evil-cross-lines + (setq end (max beg (1- end)))) + (evil-expand beg end 'inclusive)))) + (t + (evil-range beg end)))) + :string (lambda (beg end) + (let ((width (- end beg))) + (format "%s character%s" width + (if (= width 1) "" "s"))))) + +(evil-define-type inclusive + "Include the character under point. +Handling for `evil-want-visual-char-semi-exclusive' is deprecated, +and will be removed in a future version." + :expand (lambda (beg end) + (if (and evil-want-visual-char-semi-exclusive + (evil-visual-state-p) + (< beg end) + (save-excursion + (goto-char end) + (or (bolp) (eolp)))) + (evil-range beg end 'exclusive) + (evil-range beg (1+ end)))) + :contract (lambda (beg end) + (evil-range beg (max beg (1- end)))) + :normalize (lambda (beg end) + (goto-char end) + (when (eq (char-after) ?\n) + (setq end (max beg (1- end)))) + (evil-range beg end)) + :string (lambda (beg end) + (let ((width (- end beg))) + (format "%s character%s" width + (if (= width 1) "" "s"))))) + +(evil-define-type line + "Include whole lines." + :one-to-one nil + :expand (lambda (beg end) + (evil-range + (progn + (goto-char beg) + (min (line-beginning-position) + (progn + ;; move to beginning of line as displayed + (evil-move-beginning-of-line) + (line-beginning-position)))) + (progn + (goto-char end) + (max (line-beginning-position 2) + (progn + ;; move to end of line as displayed + (evil-move-end-of-line) + (line-beginning-position 2)))))) + :contract (lambda (beg end) + (evil-range beg (max beg (1- end)))) + :string (lambda (beg end) + (let ((height (count-lines beg end))) + (format "%s line%s" height + (if (= height 1) "" "s"))))) + +(evil-define-type screen-line + "Include whole lines, being aware of `visual-line-mode' +when `evil-respect-visual-line-mode' is non-nil." + :one-to-one nil + :expand (lambda (beg end) + (if (or (not evil-respect-visual-line-mode) + (not visual-line-mode)) + (evil-line-expand beg end) + (evil-range + (progn + (goto-char beg) + (save-excursion + (beginning-of-visual-line))) + (progn + (goto-char end) + (save-excursion + ;; `beginning-of-visual-line' reverts to the beginning of the + ;; last visual line if the end of the last line is the end of + ;; the buffer. This would prevent selecting the last screen + ;; line. + (if (= (line-beginning-position 2) (point-max)) + (point-max) + (beginning-of-visual-line 2))))))) + :contract (lambda (beg end) + (evil-range beg (max beg (1- end)))) + :string (lambda (beg end) + (let ((height (count-screen-lines beg end))) + (format "%s screen line%s" height + (if (= height 1) "" "s"))))) + +(evil-define-type block + "Like `inclusive', but for rectangles: +the last column is included." + :expand (lambda (beg end &rest properties) + (let ((beg-col (evil-column beg)) + (end-col (evil-column end)) + (corner (plist-get properties :corner))) + ;; Since blocks are implemented as a pair of buffer + ;; positions, expansion is restricted to what the buffer + ;; allows. In the case of a one-column block, there are + ;; two ways to expand it (either move the upper corner + ;; beyond the lower corner, or the lower beyond the + ;; upper), so try out both possibilities when + ;; encountering the end of the line. + (cond + ((= beg-col end-col) + (goto-char end) + (cond + ((eolp) + (goto-char beg) + (if (eolp) + (evil-range beg end) + (evil-range (1+ beg) end))) + ((memq corner '(lower-right upper-right right)) + (evil-range (1+ beg) end)) + (t + (evil-range beg (1+ end))))) + ((< beg-col end-col) + (goto-char end) + (if (eolp) + (evil-range beg end) + (evil-range beg (1+ end)))) + (t + (goto-char beg) + (if (eolp) + (evil-range beg end) + (evil-range (1+ beg) end)))))) + :contract (lambda (beg end) + (let ((beg-col (evil-column beg)) + (end-col (evil-column end))) + (if (> beg-col end-col) + (evil-range (1- beg) end) + (evil-range beg (max beg (1- end)))))) + :string (lambda (beg end) + (let ((height (count-lines + beg + (progn + (goto-char end) + (if (and (bolp) (not (eobp))) + (1+ end) + end)))) + (width (abs (- (evil-column beg) + (evil-column end))))) + (format "%s row%s and %s column%s" + height + (if (= height 1) "" "s") + width + (if (= width 1) "" "s")))) + :rotate (lambda (beg end &rest properties) + "Rotate block according to :corner property. +:corner can be one of `upper-left',``upper-right', `lower-left' +and `lower-right'." + (let ((left (evil-column beg)) + (right (evil-column end)) + (corner (or (plist-get properties :corner) + 'upper-left))) + (evil-sort left right) + (goto-char beg) + (if (memq corner '(upper-right lower-left)) + (move-to-column right) + (move-to-column left)) + (setq beg (point)) + (goto-char end) + (if (memq corner '(upper-right lower-left)) + (move-to-column left) + (move-to-column right)) + (setq end (point)) + (setq properties (plist-put properties + :corner corner)) + (apply #'evil-range beg end properties)))) + +(evil-define-type rectangle + "Like `exclusive', but for rectangles: +the last column is excluded." + :expand (lambda (beg end) + ;; select at least one column + (if (= (evil-column beg) (evil-column end)) + (evil-expand beg end 'block) + (evil-range beg end 'block)))) + +;;; Standard interactive codes + +(evil-define-interactive-code "*" + "Signal error if the buffer is read-only." + (when buffer-read-only + (signal 'buffer-read-only nil))) + +(evil-define-interactive-code "b" (prompt) + "Name of existing buffer." + (list (read-buffer prompt (current-buffer) t))) + +(evil-define-interactive-code "c" + "Read character." + (list (read-char))) + +(evil-define-interactive-code "p" + "Prefix argument converted to number." + (list (prefix-numeric-value current-prefix-arg))) + +(evil-define-interactive-code "P" + "Prefix argument in raw form." + (list current-prefix-arg)) + +;;; Custom interactive codes + +(evil-define-interactive-code "<c>" + "Count." + (list (when current-prefix-arg + (prefix-numeric-value + current-prefix-arg)))) + +(evil-define-interactive-code "<vc>" + "Count, but only in visual state. +This should be used by an operator taking a count. In normal +state the count should not be handled by the operator but by the +motion that defines the operator's range. In visual state the +range is specified by the visual region and the count is not used +at all. Thus in the case the operator may use the count +directly." + (list (when (and (evil-visual-state-p) current-prefix-arg) + (prefix-numeric-value + current-prefix-arg)))) + +(evil-define-interactive-code "<C>" + "Character read through `evil-read-key'." + (list + (if (evil-operator-state-p) + (evil-without-restriction (evil-read-key)) + (evil-read-key)))) + +(evil-define-interactive-code "<r>" + "Untyped motion range (BEG END)." + (evil-operator-range)) + +(evil-define-interactive-code "<R>" + "Typed motion range (BEG END TYPE)." + (evil-operator-range t)) + +(evil-define-interactive-code "<v>" + "Typed motion range of visual range(BEG END TYPE). +If visual state is inactive then those values are nil." + (if (evil-visual-state-p) + (let ((range (evil-visual-range))) + (list (car range) + (cadr range) + (evil-type range))) + (list nil nil nil))) + +(evil-define-interactive-code "<x>" + "Current register." + (list evil-this-register)) + +(evil-define-interactive-code "<y>" + "Current yank-handler." + (list (evil-yank-handler))) + +(evil-define-interactive-code "<a>" + "Ex argument." + :ex-arg t + (list (when (evil-ex-p) evil-ex-argument))) + +(evil-define-interactive-code "<N>" () + "Prefix argument or ex-arg, converted to number" + (list (cond + (current-prefix-arg (prefix-numeric-value current-prefix-arg)) + ((and evil-ex-argument (evil-ex-p)) (string-to-number evil-ex-argument)) + ((evil-ex-p) nil) + (t 1)))) + +(evil-define-interactive-code "<f>" + "Ex file argument." + :ex-arg file + (list (when (evil-ex-p) (evil-ex-file-arg)))) + +(evil-define-interactive-code "<b>" + "Ex buffer argument." + :ex-arg buffer + (list (when (evil-ex-p) evil-ex-argument))) + +(evil-define-interactive-code "<sh>" + "Ex shell command argument." + :ex-arg shell + (list (when (evil-ex-p) evil-ex-argument))) + +(evil-define-interactive-code "<fsh>" + "Ex file or shell command argument." + :ex-arg file-or-shell + (list (when (evil-ex-p) evil-ex-argument))) + +(evil-define-interactive-code "<sym>" + "Ex symbolic argument." + :ex-arg sym + (list (when (and (evil-ex-p) evil-ex-argument) + (intern evil-ex-argument)))) + +(evil-define-interactive-code "<addr>" + "Ex line number." + (list + (and (evil-ex-p) + (let ((expr (evil-ex-parse evil-ex-argument))) + (if (eq (car expr) 'evil-goto-line) + (save-excursion + (goto-char evil-ex-point) + (eval (cadr expr))) + (user-error "Invalid address")))))) + +(evil-define-interactive-code "<!>" + "Ex bang argument." + :ex-bang t + (list (when (evil-ex-p) evil-ex-bang))) + +(evil-define-interactive-code "</>" + "Ex delimited argument." + (when (evil-ex-p) + (evil-delimited-arguments evil-ex-argument))) + +(evil-define-interactive-code "<g/>" + "Ex global argument." + (when (evil-ex-p) + (evil-ex-parse-global evil-ex-argument))) + +(evil-define-interactive-code "<s/>" + "Ex substitution argument." + :ex-arg substitution + (when (evil-ex-p) + (evil-ex-get-substitute-info evil-ex-argument t))) + +(evil-define-interactive-code "<xc/>" + "Ex register and count argument, both optional. +Can be used for commands such as :delete [REGISTER] [COUNT] where the +command can be called with either zero, one or two arguments. When the +argument is one, if it's numeric it's treated as a COUNT, otherwise - +REGISTER" + (when (evil-ex-p) + (evil-ex-get-optional-register-and-count evil-ex-argument))) + +(defun evil-ex-get-optional-register-and-count (string) + "Parse STRING as an ex arg with both optional REGISTER and COUNT. +Returns a list (REGISTER COUNT)." + (let* ((split-args (split-string (or string ""))) + (arg-count (length split-args)) + (arg0 (car split-args)) + (arg1 (cadr split-args)) + (number-regex "^-?[1-9][0-9]*$") + (register nil) + (count nil)) + (cond + ;; :command REGISTER or :command COUNT + ((= arg-count 1) + (if (string-match-p number-regex arg0) + (setq count arg0) + (setq register arg0))) + ;; :command REGISTER COUNT + ((eq arg-count 2) + (setq register arg0 + count arg1)) + ;; more than 2 args aren't allowed + ((> arg-count 2) + (user-error "Invalid use"))) + + ;; if register is given, check it's valid + (when register + (unless (= (length register) 1) + (user-error "Invalid register")) + (setq register (string-to-char register))) + + ;; if count is given, check it's valid + (when count + (unless (string-match-p number-regex count) + (user-error "Invalid count")) + (setq count (string-to-number count)) + (unless (> count 0) + (user-error "Invalid count"))) + + (list register count))) + +(provide 'evil-types) + +;;; evil-types.el ends here |