diff options
| -rw-r--r-- | Makefile | 72 | ||||
| -rw-r--r-- | doc/front.png | bin | 0 -> 3258 bytes | |||
| -rw-r--r-- | doc/logo.png | bin | 0 -> 2147 bytes | |||
| -rw-r--r-- | doc/logo.svg | 110 | ||||
| -rw-r--r-- | ert.el | 91 | ||||
| -rw-r--r-- | evil-common.el | 814 | ||||
| -rw-r--r-- | evil-compatibility.el | 21 | ||||
| -rw-r--r-- | evil-digraphs.el | 1382 | ||||
| -rw-r--r-- | evil-insert.el | 294 | ||||
| -rw-r--r-- | evil-integration.el | 111 | ||||
| -rw-r--r-- | evil-maps.el | 296 | ||||
| -rw-r--r-- | evil-motions.el | 1416 | ||||
| -rw-r--r-- | evil-operators.el | 837 | ||||
| -rw-r--r-- | evil-repeat.el | 432 | ||||
| -rw-r--r-- | evil-replace.el | 64 | ||||
| -rw-r--r-- | evil-search.el | 327 | ||||
| -rw-r--r-- | evil-states.el | 651 | ||||
| -rw-r--r-- | evil-tests.el | 3541 | ||||
| -rw-r--r-- | evil-types.el | 696 | ||||
| -rw-r--r-- | evil-undo.el | 101 | ||||
| -rw-r--r-- | evil-vars.el | 377 | ||||
| -rw-r--r-- | evil-visual.el | 572 | ||||
| -rw-r--r-- | evil-window.el | 473 | ||||
| -rw-r--r-- | evil.el | 63 | ||||
| -rw-r--r-- | undo-tree.el | 3075 |
25 files changed, 15466 insertions, 350 deletions
diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..adf817c --- /dev/null +++ b/Makefile @@ -0,0 +1,72 @@ +SHELL = /bin/bash +EMACS = emacs +FILES = evil*.el +TAG = + +.PHONY: all compile compile-batch clean tests test emacs term terminal indent + +# Byte-compile Evil. +all: compile +compile: clean + for f in ${FILES}; do \ + $(EMACS) --batch -Q -L . -f batch-byte-compile $$f; \ +done + +# Byte-compile all files in one batch. This is faster than +# compiling each file in isolation, but also less stringent. +compile-batch: clean + $(EMACS) --batch -Q -L . -f batch-byte-compile ${FILES} + +# Delete byte-compiled files. +clean: + rm -f *~ + rm -f \#*\# + rm -f *.elc + +# Run tests. +# The TAG variable may specify a test tag or a test name: +# make test TAG=repeat +# This will only run tests pertaining to the repeat system. +test: clean + $(EMACS) --batch -Q -L . -l evil-tests.el \ +--eval "(evil-tests-run '(${TAG}))" + +# Byte-compile Evil and run all tests. +tests: compile-batch + $(EMACS) --batch -Q -L . -l evil-tests.el \ +--eval "(evil-tests-run '(${TAG}))" + rm -f *.elc + +# Load Evil in a fresh instance of Emacs and run all tests. +emacs: clean + $(EMACS) -Q -L . -l evil-tests.el --eval "(evil-mode 1)" \ +--eval "(if (y-or-n-p-with-timeout \"Run tests? \" 2 t) \ +(evil-tests-run '(${TAG}) t) \ +(message \"You can run the tests at any time with \`M-x evil-tests-run\'\"))" & + +# Load Evil in a terminal Emacs and run all tests. +term: terminal +terminal: clean + $(EMACS) -nw -Q -L . -l evil-tests.el --eval "(evil-mode 1)" \ +--eval "(if (y-or-n-p-with-timeout \"Run tests? \" 2 t) \ +(evil-tests-run '(${TAG}) t) \ +(message \"You can run the tests at any time with \`M-x evil-tests-run\'\"))" + +# Re-indent all Evil code. +# Loads Evil into memory in order to indent macros properly. +# Also removes trailing whitespace, tabs and extraneous blank lines. +indent: clean + $(EMACS) --batch ${FILES} -Q -L . -l evil-tests.el \ +--eval "(dolist (buffer (reverse (buffer-list))) \ +(when (buffer-file-name buffer) \ +(set-buffer buffer) \ +(message \"Indenting %s\" (current-buffer)) \ +(setq-default indent-tabs-mode nil) \ +(untabify (point-min) (point-max)) \ +(indent-region (point-min) (point-max)) \ +(delete-trailing-whitespace) \ +(untabify (point-min) (point-max)) \ +(goto-char (point-min)) \ +(while (re-search-forward \"\\n\\\\{3,\\\\}\" nil t) \ +(replace-match \"\\n\\n\")) \ +(when (buffer-modified-p) (save-buffer 0))))" diff --git a/doc/front.png b/doc/front.png Binary files differnew file mode 100644 index 0000000..f79a67e --- /dev/null +++ b/doc/front.png diff --git a/doc/logo.png b/doc/logo.png Binary files differnew file mode 100644 index 0000000..842a49d --- /dev/null +++ b/doc/logo.png diff --git a/doc/logo.svg b/doc/logo.svg new file mode 100644 index 0000000..ff833c2 --- /dev/null +++ b/doc/logo.svg @@ -0,0 +1,110 @@ +<?xml version="1.0" encoding="UTF-8" standalone="no"?> +<!-- Created with Inkscape (http://www.inkscape.org/) --> + +<svg + xmlns:dc="http://purl.org/dc/elements/1.1/" + xmlns:cc="http://creativecommons.org/ns#" + xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" + xmlns:svg="http://www.w3.org/2000/svg" + xmlns="http://www.w3.org/2000/svg" + xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd" + xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape" + width="127.82534" + height="62.426407" + id="svg2" + version="1.1" + inkscape:version="0.48.0 r9654" + sodipodi:docname="evil.svg" + inkscape:export-filename="/home/vegard/evil.png" + inkscape:export-xdpi="150" + inkscape:export-ydpi="150"> + <defs + id="defs4" /> + <sodipodi:namedview + id="base" + pagecolor="#ffffff" + bordercolor="#666666" + borderopacity="1.0" + inkscape:pageopacity="0.0" + inkscape:pageshadow="2" + inkscape:zoom="2.2069466" + inkscape:cx="173.13654" + inkscape:cy="12.652914" + inkscape:document-units="px" + inkscape:current-layer="layer1" + showgrid="false" + inkscape:window-width="1680" + inkscape:window-height="998" + inkscape:window-x="0" + inkscape:window-y="24" + inkscape:window-maximized="1" + fit-margin-left="10" + fit-margin-top="10" + fit-margin-right="10" + fit-margin-bottom="10" + showguides="true" + inkscape:guide-bbox="true" /> + <metadata + id="metadata7"> + <rdf:RDF> + <cc:Work + rdf:about=""> + <dc:format>image/svg+xml</dc:format> + <dc:type + rdf:resource="http://purl.org/dc/dcmitype/StillImage" /> + <dc:title></dc:title> + </cc:Work> + </rdf:RDF> + </metadata> + <g + inkscape:label="Layer 1" + inkscape:groupmode="layer" + id="layer1" + transform="translate(-165.00893,-164.53963)"> + <rect + style="fill:#000000" + id="rect2991" + width="30.809652" + height="42.426407" + x="175.00893" + y="174.53963" /> + <text + xml:space="preserve" + style="font-size:40px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;line-height:125%;letter-spacing:0px;word-spacing:0px;fill:#000000;fill-opacity:1;stroke:none;font-family:Ubuntu;-inkscape-font-specification:Ubuntu" + x="178.15302" + y="209.50504" + id="text2985" + sodipodi:linespacing="125%"><tspan + sodipodi:role="line" + id="tspan2987" + x="178.15302" + y="209.50504" + style="font-weight:bold;letter-spacing:5.28999996px;-inkscape-font-specification:Ubuntu Bold"><tspan + style="letter-spacing:6.60000228999999994px;fill:#ffffff" + id="tspan2989">E</tspan><tspan + style="fill:#333333" + id="tspan2995">VIL</tspan></tspan></text> + <g + style="font-size:40px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;line-height:125%;letter-spacing:0px;word-spacing:0px;fill:#000000;fill-opacity:1;stroke:none;font-family:Ubuntu;-inkscape-font-specification:Ubuntu" + id="text2997" + transform="matrix(0.89694705,0.44213798,-0.44213798,0.89694705,260.2961,-122.4502)"> + <path + d="m 144.8919,272.13985 c 0.57684,-0.24621 1.4908,-0.78829 1.94103,-1.23149 0.46429,-0.46428 0.81251,-0.98134 1.04466,-1.55116 0.23214,-0.5698 0.33721,-0.99165 0.33722,-1.62479 0.0155,-0.43449 -0.28674,-1.22826 -0.57298,-1.8313 -0.26496,-0.55821 -0.52007,-1.02571 -0.52007,-1.02571 l -1.99277,2.29588 0.22983,-5.91917 5.5976,0.45081 -2.34283,1.96492 c 0,0 0.49752,1.04212 0.73633,1.68916 0.23881,0.64704 0.58739,1.34614 0.66973,2.19566 0.0366,0.62546 -0.16181,1.70241 -0.4854,2.4903 -0.33767,0.79493 -0.81956,1.50544 -1.44564,2.13152 -0.59093,0.58389 -1.53465,1.17717 -2.35067,1.54297" + style="fill:#333333" + id="path3002" + inkscape:connector-curvature="0" + sodipodi:nodetypes="ccscsccccczcccc" /> + </g> + <text + xml:space="preserve" + style="font-size:40px;font-style:normal;font-weight:normal;line-height:125%;letter-spacing:0px;word-spacing:0px;fill:#000000;fill-opacity:1;stroke:none;font-family:Sans" + x="309.28571" + y="111.6479" + id="text3011" + sodipodi:linespacing="125%"><tspan + sodipodi:role="line" + id="tspan3013" + x="309.28571" + y="111.6479" /></text> + </g> +</svg> @@ -1,11 +1,11 @@ ;;; ert.el --- Emacs Lisp Regression Testing -;; Copyright (C) 2007, 2008, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2007-2008, 2010-2011 Free Software Foundation, Inc. -;; Author: Christian M. Ohler +;; Author: Christian Ohler <ohler@gnu.org> ;; Keywords: lisp, tools -;; This file is NOT part of GNU Emacs. +;; This file is part of GNU Emacs. ;; This program is free software: you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -219,7 +219,7 @@ Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'." ;; This implementation is inefficient. Rather than making it ;; efficient, let's hope bug 6581 gets fixed so that we can delete ;; it altogether. - (not (ert--explain-not-equal-including-properties a b))) + (not (ert--explain-equal-including-properties a b))) ;;; Defining and locating tests. @@ -571,16 +571,15 @@ failed." (when (and (not firstp) (eq fast slow)) (return nil)))) (defun ert--explain-format-atom (x) - "Format the atom X for `ert--explain-not-equal'." + "Format the atom X for `ert--explain-equal'." (typecase x (fixnum (list x (format "#x%x" x) (format "?%c" x))) (t x))) -(defun ert--explain-not-equal (a b) - "Explainer function for `equal'. +(defun ert--explain-equal-rec (a b) + "Returns a programmer-readable explanation of why A and B are not `equal'. -Returns a programmer-readable explanation of why A and B are not -`equal', or nil if they are." +Returns nil if they are." (if (not (equal (type-of a) (type-of b))) `(different-types ,a ,b) (etypecase a @@ -598,13 +597,13 @@ Returns a programmer-readable explanation of why A and B are not (loop for i from 0 for ai in a for bi in b - for xi = (ert--explain-not-equal ai bi) + for xi = (ert--explain-equal-rec ai bi) do (when xi (return `(list-elt ,i ,xi))) finally (assert (equal a b) t))) - (let ((car-x (ert--explain-not-equal (car a) (car b)))) + (let ((car-x (ert--explain-equal-rec (car a) (car b)))) (if car-x `(car ,car-x) - (let ((cdr-x (ert--explain-not-equal (cdr a) (cdr b)))) + (let ((cdr-x (ert--explain-equal-rec (cdr a) (cdr b)))) (if cdr-x `(cdr ,cdr-x) (assert (equal a b) t) @@ -618,7 +617,7 @@ Returns a programmer-readable explanation of why A and B are not (loop for i from 0 for ai across a for bi across b - for xi = (ert--explain-not-equal ai bi) + for xi = (ert--explain-equal-rec ai bi) do (when xi (return `(array-elt ,i ,xi))) finally (assert (equal a b) t)))) (atom (if (not (equal a b)) @@ -627,7 +626,15 @@ Returns a programmer-readable explanation of why A and B are not `(different-atoms ,(ert--explain-format-atom a) ,(ert--explain-format-atom b))) nil))))) -(put 'equal 'ert-explainer 'ert--explain-not-equal) + +(defun ert--explain-equal (a b) + "Explainer function for `equal'." + ;; Do a quick comparison in C to avoid running our expensive + ;; comparison when possible. + (if (equal a b) + nil + (ert--explain-equal-rec a b))) +(put 'equal 'ert-explainer 'ert--explain-equal) (defun ert--significant-plist-keys (plist) "Return the keys of PLIST that have non-null values, in order." @@ -658,8 +665,8 @@ key/value pairs in each list does not matter." (value-b (plist-get b key))) (assert (not (equal value-a value-b)) t) `(different-properties-for-key - ,key ,(ert--explain-not-equal-including-properties value-a - value-b))))) + ,key ,(ert--explain-equal-including-properties value-a + value-b))))) (cond (keys-in-a-not-in-b (explain-with-key (first keys-in-a-not-in-b))) (keys-in-b-not-in-a @@ -681,13 +688,16 @@ If SUFFIXP is non-nil, returns a suffix of S, otherwise a prefix." (t (substring s 0 len))))) -(defun ert--explain-not-equal-including-properties (a b) +;; TODO(ohler): Once bug 6581 is fixed, rename this to +;; `ert--explain-equal-including-properties-rec' and add a fast-path +;; wrapper like `ert--explain-equal'. +(defun ert--explain-equal-including-properties (a b) "Explainer function for `ert-equal-including-properties'. Returns a programmer-readable explanation of why A and B are not `ert-equal-including-properties', or nil if they are." (if (not (equal a b)) - (ert--explain-not-equal a b) + (ert--explain-equal a b) (assert (stringp a) t) (assert (stringp b) t) (assert (eql (length a) (length b)) t) @@ -713,7 +723,7 @@ Returns a programmer-readable explanation of why A and B are not ))) (put 'ert-equal-including-properties 'ert-explainer - 'ert--explain-not-equal-including-properties) + 'ert--explain-equal-including-properties) ;;; Implementation of `ert-info'. @@ -1244,12 +1254,14 @@ Also changes the counters in STATS to match." (ert-test-passed (incf (ert--stats-passed-expected stats) d)) (ert-test-failed (incf (ert--stats-failed-expected stats) d)) (null) - (ert-test-aborted-with-non-local-exit)) + (ert-test-aborted-with-non-local-exit) + (ert-test-quit)) (etypecase (aref results pos) (ert-test-passed (incf (ert--stats-passed-unexpected stats) d)) (ert-test-failed (incf (ert--stats-failed-unexpected stats) d)) (null) - (ert-test-aborted-with-non-local-exit))))) + (ert-test-aborted-with-non-local-exit) + (ert-test-quit))))) ;; Adjust counters to remove the result that is currently in stats. (update -1) ;; Put new test and result into stats. @@ -1342,7 +1354,8 @@ EXPECTEDP specifies whether the result was expected." (ert-test-passed ".P") (ert-test-failed "fF") (null "--") - (ert-test-aborted-with-non-local-exit "aA")))) + (ert-test-aborted-with-non-local-exit "aA") + (ert-test-quit "qQ")))) (elt s (if expectedp 0 1)))) (defun ert-string-for-test-result (result expectedp) @@ -1353,7 +1366,8 @@ EXPECTEDP specifies whether the result was expected." (ert-test-passed '("passed" "PASSED")) (ert-test-failed '("failed" "FAILED")) (null '("unknown" "UNKNOWN")) - (ert-test-aborted-with-non-local-exit '("aborted" "ABORTED"))))) + (ert-test-aborted-with-non-local-exit '("aborted" "ABORTED")) + (ert-test-quit '("quit" "QUIT"))))) (elt s (if expectedp 0 1)))) (defun ert--pp-with-indentation-and-newline (object) @@ -1478,7 +1492,9 @@ Returns the stats object." (message "%s" (buffer-string)))) (ert-test-aborted-with-non-local-exit (message "Test %S aborted with non-local exit" - (ert-test-name test))))) + (ert-test-name test))) + (ert-test-quit + (message "Quit during %S" (ert-test-name test))))) (let* ((max (prin1-to-string (length (ert--stats-tests stats)))) (format-string (concat "%9s %" (prin1-to-string (length max)) @@ -1495,9 +1511,9 @@ Returns the stats object." "Like `ert-run-tests-batch', but exits Emacs when done. The exit status will be 0 if all test results were as expected, 1 -on unexpected results, or 2 if the framework detected an error -outside of the tests (e.g. invalid SELECTOR or bug in the code -that runs the tests)." +on unexpected results, or 2 if the tool detected an error outside +of the tests (e.g. invalid SELECTOR or bug in the code that runs +the tests)." (unwind-protect (let ((stats (ert-run-tests-batch selector))) (kill-emacs (if (zerop (ert-stats-completed-unexpected stats)) 0 1))) @@ -1853,7 +1869,9 @@ non-nil, returns the face for expected results.." (ert-test-result-with-condition-condition result)) (ert--make-xrefs-region begin (point))))) (ert-test-aborted-with-non-local-exit - (insert " aborted\n"))) + (insert " aborted\n")) + (ert-test-quit + (insert " quit\n"))) (insert "\n"))))) nil) @@ -1874,7 +1892,6 @@ BUFFER-NAME, if non-nil, is the buffer name to use." (unless buffer-name (setq buffer-name "*ert*")) (let ((buffer (get-buffer-create buffer-name))) (with-current-buffer buffer - (setq buffer-read-only t) (let ((inhibit-read-only t)) (buffer-disable-undo) (erase-buffer) @@ -1997,19 +2014,12 @@ and how to display message." ;;; Simple view mode for auxiliary information like stack traces or ;;; messages. Mainly binds "q" for quit. -(define-derived-mode ert-simple-view-mode fundamental-mode "ERT-View" +(define-derived-mode ert-simple-view-mode special-mode "ERT-View" "Major mode for viewing auxiliary information in ERT.") -(loop for (key binding) in - '(("q" quit-window) - ) - do - (define-key ert-simple-view-mode-map key binding)) - - ;;; Commands and button actions for the results buffer. -(define-derived-mode ert-results-mode fundamental-mode "ERT-Results" +(define-derived-mode ert-results-mode special-mode "ERT-Results" "Major mode for viewing results of ERT test runs.") (loop for (key binding) in @@ -2017,7 +2027,6 @@ and how to display message." ("\t" forward-button) ([backtab] backward-button) ("j" ert-results-jump-between-summary-and-result) - ("q" quit-window) ("L" ert-results-toggle-printer-limits-for-test-at-point) ("n" ert-results-next-test) ("p" ert-results-previous-test) @@ -2349,7 +2358,6 @@ To be used in the ERT results buffer." (let ((backtrace (ert-test-result-with-condition-backtrace result)) (buffer (get-buffer-create "*ERT Backtrace*"))) (pop-to-buffer buffer) - (setq buffer-read-only t) (let ((inhibit-read-only t)) (buffer-disable-undo) (erase-buffer) @@ -2375,7 +2383,6 @@ To be used in the ERT results buffer." (result (aref (ert--stats-test-results stats) pos))) (let ((buffer (get-buffer-create "*ERT Messages*"))) (pop-to-buffer buffer) - (setq buffer-read-only t) (let ((inhibit-read-only t)) (buffer-disable-undo) (erase-buffer) @@ -2397,7 +2404,6 @@ To be used in the ERT results buffer." (result (aref (ert--stats-test-results stats) pos))) (let ((buffer (get-buffer-create "*ERT list of should forms*"))) (pop-to-buffer buffer) - (setq buffer-read-only t) (let ((inhibit-read-only t)) (buffer-disable-undo) (erase-buffer) @@ -2451,7 +2457,6 @@ To be used in the ERT results buffer." (setq data (sort data (lambda (a b) (> (second a) (second b))))) (pop-to-buffer buffer) - (setq buffer-read-only t) (let ((inhibit-read-only t)) (buffer-disable-undo) (erase-buffer) diff --git a/evil-common.el b/evil-common.el index 5a25b9f..d87914d 100644 --- a/evil-common.el +++ b/evil-common.el @@ -1,5 +1,10 @@ ;;;; Common functions and utilities +(require 'evil-vars) +(require 'evil-compatibility) + +;;; List functions + (defun evil-add-to-alist (list-var key val &rest elements) "Add the assocation of KEY and VAL to the value of LIST-VAR. If the list already contains an entry for KEY, update that entry; @@ -14,58 +19,108 @@ otherwise add at the end of the list." (apply 'evil-add-to-alist list-var elements) (symbol-value list-var)))) +;; custom version of `delete-if' +(defun evil-filter-list (predicate list &optional pointer) + "Delete by side-effect all items satisfying PREDICATE in LIST. +Stop when reaching POINTER. If the first item satisfies PREDICATE, +there is no way to remove it by side-effect; therefore, write +\(setq foo (evil-delete-if 'predicate foo)) to be sure of +changing the value of `foo'." + (let ((tail list) elt head) + (while (and tail (not (eq tail pointer))) + (setq elt (car tail)) + (cond + ((funcall predicate elt) + (setq tail (cdr tail)) + (if head + (setcdr head tail) + (setq list tail))) + (t + (setq head tail + tail (cdr tail))))) + list)) + (defun evil-concat-lists (&rest sequences) "Concatenate lists, removing duplicates. -The firstmost occurrence of an element is retained. -Cons cells are treated as alist entries." - (let ((result (pop sequences)) - (tail (copy-sequence (pop sequences)))) +The first occurrence is retained. +To concatenate association lists, see `evil-concat-alists'." + (let ((first (pop sequences)) + (tail (copy-sequence (pop sequences))) + result) + ;; remove internal duplicates + (dolist (elt first) + (add-to-list 'result elt t 'eq)) + ;; remove tail duplicates (catch 'empty (dolist (elt result) - (cond - ((null tail) - (throw 'empty t)) - ((consp elt) - (setq tail (assq-delete-all (car elt) tail))) - (t - (setq tail (delq elt tail)))))) + (if tail + (setq tail (delq elt tail)) + (throw 'empty t)))) + (setq result (append result tail)) (if sequences - (apply 'evil-concatenate-lists result sequences) - (append result tail)))) + (apply 'evil-concat-lists result sequences) + result))) -(defun evil-get-property (alist key prop) +(defun evil-concat-alists (&rest sequences) + "Concatenate association lists, removing duplicates. +The first association is retained. +To concatenate regular lists, see `evil-concat-lists'." + (let ((first (pop sequences)) + (tail (copy-sequence (pop sequences))) + result) + ;; remove internal duplicates + (dolist (elt first) + (unless (assq (car-safe elt) result) + (add-to-list 'result elt t 'eq))) + ;; remove tail duplicates + (catch 'empty + (dolist (elt result) + (if tail + (setq tail (assq-delete-all (car-safe elt) tail)) + (throw 'empty t)))) + (setq result (append result tail)) + (if sequences + (apply 'evil-concat-lists result sequences) + result))) + +(defun evil-get-property (alist key &optional prop) "Return property PROP for KEY in ALIST. ALIST is an association list with entries in the form \(KEY . PLIST), where PLIST is a property list. -If KEY is nil, return an association list of states and -their PROP values." - (let (result val) - (unless (keywordp prop) - (setq prop (intern (format ":%s" prop)))) - (if key - (plist-get (cdr (assq key alist)) prop) +If PROP is nil, return all properties for KEY. +If KEY is nil, return an association list of states +and their PROP values." + (unless (or (keywordp prop) (null prop)) + (setq prop (intern (format ":%s" prop)))) + (cond + ((and key prop) + (plist-get (cdr (assq key alist)) prop)) + (key ; PROP is nil + (cdr (assq key alist))) + (prop ; KEY is nil + (let (result val) (dolist (entry alist result) (setq key (car entry) - val (plist-get (cdr entry) prop)) - (when val - (add-to-list 'result (cons key val) t)))))) + val (cdr entry)) + (when (plist-member val prop) + (setq val (plist-get val prop)) + (add-to-list 'result (cons key val) t))))))) (defun evil-put-property (alist-var key prop val &rest properties) "Set PROP to VAL for KEY in ALIST-VAR. ALIST-VAR points to an association list with entries in the form \(KEY . PLIST), where PLIST is a property list storing PROP and VAL." - (let* ((alist (symbol-value alist-var)) - (plist (cdr (assq key alist)))) - (while - (progn - (unless (keywordp prop) - (setq prop (intern (format ":%s" prop)))) - (setq plist (plist-put plist prop val)) - (when properties - (setq prop (pop properties) - val (pop properties))))) - (set alist-var (assq-delete-all key alist)) - (add-to-list alist-var (cons key plist) t))) + (set alist-var + (let* ((alist (symbol-value alist-var)) + (plist (cdr (assq key alist)))) + (while prop + (unless (keywordp prop) + (setq prop (intern (format ":%s" prop)))) + (setq plist (plist-put plist prop val) + prop (pop properties) + val (pop properties))) + (setq alist (assq-delete-all key alist)) + (add-to-list 'alist (cons key plist) t)))) (defmacro evil-swap (this that &rest vars) "Swap the values of variables THIS and THAT. @@ -82,32 +137,687 @@ E.g., (evil-swap A B C) sets A to B, B to C, and C to A." If three or more arguments are given, place the smallest value in the first argument and the largest in the last, sorting in between." - `(let ((sorted (sort (list ,min ,max ,@vars) '<))) - (setq ,min (pop sorted) - ,max (pop sorted) - ,@(let (forms) - (while vars - (add-to-list 'forms (pop vars) t) - (add-to-list 'forms '(pop sorted) t)) - forms)))) + (let ((sorted (make-symbol "sortvar"))) + `(let ((,sorted (sort (list ,min ,max ,@vars) '<))) + (setq ,min (pop ,sorted) + ,max (pop ,sorted) + ,@(apply 'append (mapcar (lambda (var) + (list var `(pop ,sorted))) + vars)))))) + +(defmacro evil-loop (spec &rest body) + "Loop with countdown variable. +Evaluate BODY with VAR counting down from COUNT to 0. +COUNT can be negative, in which case VAR counts up instead. +The return value is the value of VAR when the loop +terminates, which is 0 if the loop completes successfully. +RESULT specifies a variable for storing this value. + +\(fn (VAR COUNT [RESULT]) BODY...)" + (declare (indent defun) + (debug dolist)) + (let* ((i (make-symbol "loopvar")) + (var (pop spec)) + (count (pop spec)) + (result (pop spec))) + (setq var (or (unless (eq var result) var) i) + result (or result var)) + `(let ((,var ,count)) + (setq ,result ,var) + (while (/= ,var 0) + ,@body + (if (> ,var 0) + (setq ,var (1- ,var)) + (setq ,var (1+ ,var))) + (setq ,result ,var)) + ,var))) +;; toggleable version of `with-temp-message' (defmacro evil-save-echo-area (&rest body) "Save the echo area; execute BODY; restore the echo area. Intermittent messages are not logged in the *Messages* buffer." - (declare (indent defun)) - `(let ((oldmsg (current-message)) - message-log-max) + (declare (indent defun) + (debug t)) + `(let (evil-echo-area-message evil-write-echo-area) (unwind-protect - (progn ,@body) - (if oldmsg (message "%s" oldmsg) - (message nil))))) + (progn + (evil-echo-area-save) + ,@body) + (evil-echo-area-restore)))) + +(defun evil-echo-area-save () + "Save the current echo area in `evil-echo-area-message'." + (setq evil-echo-area-message (current-message))) + +(defun evil-echo-area-restore () + "Restore the echo area from `evil-echo-area-message'. +Does not restore if `evil-write-echo-area' is non-nil." + (unless evil-write-echo-area + (if evil-echo-area-message + (message "%s" evil-echo-area-message) + (message nil))) + (setq evil-echo-area-message nil + evil-write-echo-area nil)) -(defun evil-unlogged-message (string &rest args) +(defun evil-echo (string &rest args) "Display an unlogged message in the echo area. That is, the message is not logged in the *Messages* buffer. \(To log the message, just use `message'.)" (let (message-log-max) - (apply 'message string args))) + (unless evil-locked-display + (apply 'message string args)))) + +(defmacro evil-with-locked-display (&rest body) + "Execute BODY with locked display. +State changes will not change the cursor, refresh the modeline +or display a message in the echo area." + (declare (indent defun) + (debug t)) + `(let ((evil-locked-display t)) + ,@body)) + +(defmacro evil-save-state (&rest body) + "Save the current state; execute BODY; restore the state." + (declare (indent defun) + (debug t)) + `(let* ((evil-state evil-state) + (evil-previous-state evil-previous-state) + (evil-next-state evil-next-state) + (old-state evil-state)) + (unwind-protect + (progn ,@body) + (evil-change-state old-state)))) + +(defmacro evil-with-state (state &rest body) + "Change to STATE and execute BODY without refreshing the display. +Restore the previous state afterwards." + (declare (indent defun) + (debug t)) + `(evil-with-locked-display + (evil-save-state + (evil-change-state ',state) + ,@body))) + +(defun evil-set-cursor (specs) + "Change the cursor's apperance according to SPECS. +SPECS may be a cursor type as per `cursor-type', a color +string as passed to `set-cursor-color', a zero-argument +function for changing the cursor, or a list of the above. +If SPECS is nil, make the cursor a black filled box." + (setq cursor-type t) + (evil-set-cursor-color "black") + (unless (and (listp specs) (not (consp specs))) + (setq specs (list specs))) + (dolist (spec specs) + (cond + ((functionp spec) + (condition-case nil + (funcall spec) + (error nil))) + ((stringp spec) + (evil-set-cursor-color spec)) + (t + (setq cursor-type spec))))) + +(defun evil-set-cursor-color (color) + "Set the cursor color to COLOR." + (unless (equal (frame-parameter nil 'cursor-color) color) + ;; `set-cursor-color' forces a redisplay, so only + ;; call it when the color actually changes + (set-cursor-color color))) + +(defmacro evil-save-cursor (&rest body) + "Save the current cursor; execute BODY; restore the cursor." + (declare (indent defun) + (debug t)) + `(let ((cursor cursor-type) + (color (frame-parameter (selected-frame) 'cursor-color))) + (unwind-protect + (progn ,@body) + (evil-set-cursor cursor) + (evil-set-cursor color)))) + +(defun evil-move-to-column (column &optional dir force) + "Move point to column COLUMN in the current line. +Places point at left of the tab character (at the right if DIR +is non-nil) and returns point." + (interactive "p") + (move-to-column column force) + (unless force + (when (or (not dir) (and (numberp dir) (< dir 1))) + (when (> (current-column) column) + (evil-adjust)))) + (point)) + +(defun evil-set-keymap-prompt (map prompt) + "Set the prompt-string of MAP to PROMPT." + (delq (keymap-prompt map) map) + (when prompt + (setcdr map (append (list prompt) (cdr map))))) + +;;; Markers + +(defun evil-global-marker-p (char) + "Whether CHAR denotes a global marker." + (or (and (>= char ?A) (<= char ?Z)) + (assq char (default-value 'evil-markers-alist)))) + +(defun evil-set-marker (char &optional pos advance) + "Set the marker denoted by CHAR to position POS. +POS defaults to the current position of point. +If ADVANCE is t, the marker advances when inserting text at it; +otherwise, it stays behind." + (interactive (list (read-char))) + (let ((marker (evil-get-marker char t)) alist) + (unless (markerp marker) + (cond + ((and marker (symbolp marker) (boundp marker)) + (set marker (or (symbol-value marker) (make-marker))) + (setq marker (symbol-value marker))) + ((functionp marker) + (error "Cannot set special marker `%c'" char)) + ((evil-global-marker-p char) + (setq alist (default-value 'evil-markers-alist) + marker (make-marker)) + (evil-add-to-alist 'alist char marker) + (setq-default evil-markers-alist alist)) + (t + (setq marker (make-marker)) + (evil-add-to-alist 'evil-markers-alist char marker)))) + (add-hook 'kill-buffer-hook 'evil-swap-out-markers nil t) + (set-marker-insertion-type marker advance) + (set-marker marker (or pos (point))))) + +(defun evil-get-marker (char &optional raw) + "Return the marker denoted by CHAR. +This is either a marker object as returned by `make-marker', +a number, a cons cell (FILE . POS) with FILE being a string +and POS a number, or nil. If RAW is non-nil, then the +return value may also be a variable, a movement function, +or a marker object pointing nowhere." + (let ((marker (if (evil-global-marker-p char) + (cdr-safe (assq char (default-value + 'evil-markers-alist))) + (cdr-safe (assq char evil-markers-alist))))) + (save-excursion + (if raw + marker + (when (and (symbolp marker) (boundp marker)) + (setq marker (symbol-value marker))) + (when (functionp marker) + (funcall marker) + (setq marker (point))) + (when (markerp marker) + (if (eq (marker-buffer marker) (current-buffer)) + (setq marker (marker-position marker)) + (setq marker (and (marker-buffer marker) marker)))) + (when (or (numberp marker) + (markerp marker) + (and (consp marker) + (stringp (car marker)) + (numberp (cdr marker)))) + marker))))) + +(defun evil-swap-out-markers () + "Turn markers into file references when the buffer is killed." + (and buffer-file-name + (dolist (entry evil-markers-alist) + (and (markerp (cdr entry)) + (eq (marker-buffer (cdr entry)) (current-buffer)) + (setcdr entry (cons buffer-file-name + (marker-position (cdr entry)))))))) + +(defun evil-set-jump (&optional pos) + "Set jump point at POS." + (unless (region-active-p) + (evil-save-echo-area + (mapc (lambda (marker) + (set-marker marker nil)) + evil-jump-list) + (setq evil-jump-list nil) + (push-mark pos)))) + +(defun evil-get-register (register) + "Return contents of REGISTER. +Signal an error if empty." + (when (characterp register) + (or (get-register register) + (error "Register `%c' is empty" register)))) + +;;; Key sequences + +(defun evil-extract-count (keys) + "Splits the key-sequence KEYS into prefix-argument and the rest. +Returns the list (PREFIX CMD SEQ REST), where PREFIX is the +prefix count, CMD the command to be executed, SEQ the subsequence +calling CMD, and REST is all remaining events in the +key-sequence. PREFIX and REST may be nil if they do not exist. +If a command is bound to some keyboard macro, it is expanded +recursively." + (catch 'done + (let* ((len (length keys)) + (beg 0) + (end 1) + (found-prefix nil)) + (while (and (<= end len)) + (let ((cmd (key-binding (substring keys beg end)))) + (cond + ((memq cmd '(undefined nil)) + (error "No command bound to %s" (substring keys beg end))) + ((arrayp cmd) ; keyboard macro, replace command with macro + (setq keys (vconcat (substring keys 0 beg) + cmd + (substring keys end)) + end (1+ beg) + len (length keys))) + ((functionp cmd) + (if (or (memq cmd '(digit-argument negative-argument)) + (and found-prefix + (evil-get-command-property + cmd :digit-argument-redirection))) + ;; skip those commands + (setq found-prefix t ; found at least one prefix argument + beg end + end (1+ end)) + ;; a real command, finish + (throw 'done + (list (unless (zerop beg) + (string-to-number + (concat (substring keys 0 beg)))) + cmd + (substring keys beg end) + (when (< end len) + (substring keys end)))))) + (t ;; append a further event + (setq end (1+ end)))))) + (error "Key sequence contains no complete binding")))) + +;;; Command properties + +(defmacro evil-define-command (command &rest body) + "Define a command COMMAND. + +\(fn COMMAND (ARGS...) DOC [[KEY VALUE]...] BODY...)" + (declare (indent defun) + (debug (&define name + [&optional lambda-list] + [&optional stringp] + [&rest keywordp sexp] + [&optional ("interactive" interactive)] + def-body))) + (let ((keys (plist-put nil :repeat t)) + arg args doc doc-form key) + ;; collect arguments + (when (listp (car-safe body)) + (setq args (pop body))) + ;; collect docstring + (when (> (length body) 1) + (if (eq (car-safe (car-safe body)) 'format) + (setq doc-form (pop body)) + (when (stringp (car-safe body)) + (setq doc (pop body))))) + ;; collect keywords + (while (keywordp (car-safe body)) + (setq key (pop body) + arg (pop body)) + (unless nil ; TODO: add keyword check + (plist-put keys key arg))) + `(progn + ;; the compiler does not recognize `defun' inside `let' + ,(when (and command body) + `(defun ,command ,args + ,@(when doc `(,doc)) + ,@body)) + ,(when (and command doc-form) + `(put ',command 'function-documentation ,doc-form)) + ;; set command properties for symbol or lambda function + (let ((func ',(if (and (null command) body) + `(lambda ,args ,@body) + command))) + (apply 'evil-set-command-properties func ',keys) + func)))) + +(defun evil-add-command-properties (command &rest properties) + "Add Evil PROPERTIES to COMMAND. +PROPERTIES should be a list of :keywords and values, e.g.: + + (evil-add-command-properties 'my-command :repeat t) + +See also `evil-set-command-properties'." + (apply 'evil-put-property 'evil-command-properties command properties)) + +(defun evil-set-command-properties (command &rest properties) + "Set Evil PROPERTIES of COMMAND. +PROPERTIES should be a list of :keywords and values, e.g.: + + (evil-set-command-properties 'my-command :repeat t) + +This erases all previous properties. To only add properties, +use `evil-add-command-properties'." + (setq evil-command-properties + (assq-delete-all command evil-command-properties)) + (apply #'evil-add-command-properties command properties)) + +;; If no evil-properties are defined for the command, several parts of +;; Evil apply certain default rules, e.g., the repeat-system decides +;; whether the command is repeatable by monitoring buffer changes. +(defun evil-has-properties-p (command) + "Whether Evil properties are defined for COMMAND." + (evil-get-property evil-command-properties command)) + +(defun evil-has-property (command property) + "Whether COMMAND has Evil PROPERTY." + (plist-member (evil-get-property evil-command-properties command) + property)) + +(defun evil-get-command-property (command property) + "Returns the value of Evil PROPERTY of COMMAND." + (evil-get-property evil-command-properties command property)) + +(defmacro evil-redirect-digit-argument (map keys target) + "Bind a wrapper function calling TARGET or `digit-argument'. +MAP is a keymap for binding KEYS to the wrapper for TARGET. +The wrapper only calls `digit-argument' if a prefix-argument +has already been started; otherwise TARGET is called." + (let* ((target (eval target)) + (wrapper (intern (format "evil-digit-argument-or-%s" + target)))) + `(progn + (define-key ,map ,keys ',wrapper) + (evil-define-command ,wrapper () + :digit-argument-redirection ,target + :keep-visual t + :repeat nil + (interactive) + (cond + (current-prefix-arg + (setq this-command 'digit-argument) + (call-interactively 'digit-argument)) + (t + (setq this-command ',target) + (call-interactively ',target))))))) + +(defun evil-yank-handler (&optional motion) + "Return the yank handler for MOTION. +MOTION defaults to the current motion." + (setq motion (or motion evil-this-motion)) + (evil-get-command-property motion :yank-handler)) + +;;; Region + +(defun evil-transient-save () + "Save Transient Mark mode and make the new setup buffer-local. +The variables to save are listed in `evil-transient-vars'. +Their values are stored in `evil-transient-vals'." + (dolist (var evil-transient-vars) + (when (and (boundp var) + (not (assq var evil-transient-vals))) + (add-to-list 'evil-transient-vals + (list var (symbol-value var) + (and (assq var (buffer-local-variables)) t))) + (make-variable-buffer-local var)))) + +(defun evil-transient-restore () + "Restore Transient Mark mode from `evil-transient-vals'." + (let (entry local var val) + (while (setq entry (pop evil-transient-vals)) + (setq var (pop entry) + val (pop entry) + local (pop entry)) + (unless local + (kill-local-variable var)) + (unless (equal (symbol-value var) val) + (if (fboundp var) + (funcall var (if var 1 -1)) + (setq var val)))))) + +;; In theory, an active region implies Transient Mark mode, and +;; disabling Transient Mark mode implies deactivating the region. +;; In practice, Emacs never clears `mark-active' except in Transient +;; Mark mode, so we define our own toggle functions to make things +;; more predictable. +(defun evil-transient-mark (&optional arg) + "Toggle Transient Mark mode. +Ensure that the region is properly deactivated. +Enable with positive ARG, disable with negative ARG." + (unless (numberp arg) + (setq arg (if transient-mark-mode -1 1))) + (cond + ((< arg 1) + (evil-active-region -1) + ;; Transient Mark mode cannot be disabled + ;; while CUA mode is enabled + (when (fboundp 'cua-mode) + (cua-mode -1)) + (when transient-mark-mode + (transient-mark-mode -1))) + (t + (unless transient-mark-mode + (evil-active-region -1) + (transient-mark-mode 1))))) + +(defun evil-active-region (&optional arg) + "Toggle active region. +Ensure that Transient Mark mode is properly enabled. +Enable with positive ARG, disable with negative ARG." + (unless (numberp arg) + (setq arg (if (region-active-p) -1 1))) + (cond + ((and (< arg 1)) + (when (or transient-mark-mode mark-active) + (setq mark-active nil + deactivate-mark nil) + (run-hooks 'deactivate-mark-hook))) + (t + (evil-transient-mark 1) + (when deactivate-mark + (setq deactivate-mark nil)) + (unless (mark t) + (evil-move-mark (point))) + (unless (region-active-p) + (set-mark (mark t)))))) + +(defmacro evil-save-transient-mark (&rest body) + "Save Transient Mark mode; execute BODY; then restore it." + (declare (indent defun) + (debug t)) + `(let (evil-transient-vals) + (unwind-protect + (progn + (evil-transient-save) + ,@body) + (evil-transient-restore)))) + +(defmacro evil-save-region (&rest body) + "Save Transient Mark mode, mark activation, mark and point. +Execute BODY, then restore those things." + (declare (indent defun) + (debug t)) + `(evil-save-transient-mark + (save-excursion + ,@body))) + +(defun evil-normalize-position (pos) + "Return POS if it does not exceed the buffer boundaries. +If POS is less than `point-min', return `point-min'. +Is POS is more than `point-max', return `point-max'." + (cond + ((not (number-or-marker-p pos)) + pos) + ((< pos (point-min)) + (point-min)) + ((> pos (point-max)) + (point-max)) + (t + pos))) + +;; `set-mark' does too much at once +(defun evil-move-mark (pos) + "Set buffer's mark to POS. +If POS is nil, delete the mark." + (when pos + (setq pos (evil-normalize-position pos))) + (set-marker (mark-marker) pos)) + +(evil-define-command evil-exchange-point-and-mark () + "Exchange point and mark without activating the region." + :keep-visual t + :repeat nil + (interactive) + (let* ((point (point)) + (mark (or (mark t) point))) + (set-marker (mark-marker) point) + (goto-char mark))) + +(defun evil-adjust-eol () + "Move (point) one character back if at eol on an non-empty line." + (when (eolp) + (evil-adjust))) + +(defun evil-adjust () + "Move point one character back within the current line." + (unless (bolp) + (backward-char))) + +(defun evil-apply-on-block (func beg end &rest args) + "Call FUNC for each line of Visual Block selection. +The selection may be specified explicitly with BEG and END. +FUNC must take at least two arguments, the beginning and end of +each line. Extra arguments to FUNC may be passed via ARGS." + (let (beg-marker end-marker left right eob) + (save-excursion + (evil-sort beg end) + ;; calculate columns + (goto-char end) + (setq right (current-column)) + (goto-char beg) + (setq left (current-column)) + ;; ensure LEFT < RIGHT + (when (> left right) + (evil-sort left right) + (setq beg (save-excursion + (goto-char beg) + (move-to-column left) + (point)) + end (save-excursion + (goto-char end) + (move-to-column right) + (point)))) + (goto-char beg) + (setq beg-marker (move-marker (make-marker) beg) + end-marker (move-marker (make-marker) end)) + (set-marker-insertion-type beg-marker nil) + (set-marker-insertion-type end-marker t) + ;; apply FUNC on each line + (while (progn + (apply func + (save-excursion + (move-to-column left t) + (point)) + (save-excursion + (move-to-column right t) + (point)) + args) + (forward-line 1) + (and (prog1 (not eob) + (setq eob (eobp))) + (<= (point) end-marker)))) + (set-marker beg-marker nil) + (set-marker end-marker nil)))) + +(defun evil-in-comment-p (&optional pos) + "Whether POS is inside a comment. +POS defaults to the current position of point." + (setq pos (or pos (point))) + (and (nth 4 (parse-partial-sexp + (save-excursion (beginning-of-defun) (point)) + pos)) t)) + +(defun evil-in-string-p (&optional pos) + "Whether POS is inside a string. +POS defaults to the current position of point." + (setq pos (or pos (point))) + (and (nth 3 (parse-partial-sexp + (save-excursion (beginning-of-defun) (point)) + pos)) t)) + +(defun evil-comment-beginning (&optional pos) + "Return beginning of comment containing POS. +POS defaults to the current position of point." + (save-excursion + (goto-char (or pos (point))) + (when (evil-in-comment-p) + (while (and (evil-in-comment-p) (not (bobp))) + (backward-char)) + (point)))) + +(defun evil-comment-end (&optional pos) + "Return end of comment containing POS. +POS defaults to the current position of point." + (save-excursion + (goto-char (or pos (point))) + (when (evil-in-comment-p) + (while (and (evil-in-comment-p) (not (eobp))) + (forward-char)) + (point)))) + +(defun evil-string-beginning (&optional pos) + "Return beginning of string containing POS. +POS defaults to the current position of point." + (save-excursion + (goto-char (or pos (point))) + (when (evil-in-string-p) + (while (and (evil-in-string-p) (not (bobp))) + (backward-char)) + (point)))) + +(defun evil-string-end (&optional pos) + "Return end of string containing POS. +POS defaults to the current position of point." + (save-excursion + (goto-char (or pos (point))) + (when (evil-in-string-p) + (while (and (evil-in-string-p) (not (eobp))) + (forward-char)) + (point)))) + +(defmacro evil-narrow-to-comment (&rest body) + "Narrow to the current comment or docstring, if any." + (declare (indent defun) + (debug t)) + `(save-restriction + (cond + ((evil-in-comment-p) + (narrow-to-region (evil-comment-beginning) (evil-comment-end))) + ((evil-in-string-p) + (narrow-to-region (evil-string-beginning) (evil-string-end)))) + ,@body)) + +;;; Macro helpers + +(eval-and-compile + (defun evil-unquote (exp) + "Return EXP unquoted." + (if (eq (car-safe exp) 'quote) + (cadr exp) + exp))) + +;;; Highlighting + +(when (fboundp 'font-lock-add-keywords) + (font-lock-add-keywords + 'emacs-lisp-mode + ;; Match all `evil-define-' forms except `evil-define-key'. + ;; In the interests of speed, this expression is incomplete + ;; and will not match all three-letter words. + '(("(\\(evil-define-\\(?:[^ k][^ e][^ y]\\|[-[:word:]]\\{4,\\}\\)\\)\ +\\>[ \f\t\n\r\v]*\\(\\sw+\\)?" + (1 font-lock-keyword-face) + (2 font-lock-function-name-face nil t)) + ("(\\(evil-\\(?:narrow\\|save\\|with\\)-[-[:word:]]+\\)\\>" + 1 font-lock-keyword-face) + ("(\\(evil-\\(?:[-[:word:]]\\)*loop\\)\\>" + 1 font-lock-keyword-face)))) (provide 'evil-common) diff --git a/evil-compatibility.el b/evil-compatibility.el new file mode 100644 index 0000000..300b3b8 --- /dev/null +++ b/evil-compatibility.el @@ -0,0 +1,21 @@ +;;;; Compatibility with different Emacs versions + +;; Emacs <23 does not know `characterp' +(unless (fboundp 'characterp) + (defalias 'characterp 'char-valid-p)) + +;; In older versions of Emacs, `called-interactively-p' takes +;; no arguments. In Emacs 23.2 and newer, it takes one argument. +(defmacro evil-called-interactively-p () + (if (version< emacs-version "23.2") + '(called-interactively-p) + '(called-interactively-p 'any))) + +(unless (fboundp 'region-active-p) + (defun region-active-p () + "Returns t iff region and mark are active." + (and transient-mark-mode mark-active))) + +(provide 'evil-compatibility) + +;;; evil-compatibility.el ends here diff --git a/evil-digraphs.el b/evil-digraphs.el new file mode 100644 index 0000000..00414b7 --- /dev/null +++ b/evil-digraphs.el @@ -0,0 +1,1382 @@ +(require 'evil-vars) + +(defgroup evil-digraphs nil + "Digraph support based on RFC 1345." + :group 'evil + :prefix "evil-digraph-") + +(defcustom evil-digraphs-table-user nil + "List of user-defined digraphs. +An element is a cons cell of the digraph and its character replacement, +where the digraph is a list of two characters. +See also `evil-digraphs-table'." + :type '(alist :key-type (list character character) :value-type character) + :require 'evil-digraphs + :group 'evil-digraphs) + +(defconst evil-digraphs-table + '(((?N ?U) . ?\x0a) + ((?S ?H) . ?\x01) + ((?S ?X) . ?\x02) + ((?E ?X) . ?\x03) + ((?E ?T) . ?\x04) + ((?E ?Q) . ?\x05) + ((?A ?K) . ?\x06) + ((?B ?L) . ?\x07) + ((?B ?S) . ?\x08) + ((?H ?T) . ?\x09) + ((?L ?F) . ?\x0a) + ((?V ?T) . ?\x0b) + ((?F ?F) . ?\x0c) + ((?C ?R) . ?\x0d) + ((?S ?O) . ?\x0e) + ((?S ?I) . ?\x0f) + ((?D ?L) . ?\x10) + ((?D ?1) . ?\x11) + ((?D ?2) . ?\x12) + ((?D ?3) . ?\x13) + ((?D ?4) . ?\x14) + ((?N ?K) . ?\x15) + ((?S ?Y) . ?\x16) + ((?E ?B) . ?\x17) + ((?C ?N) . ?\x18) + ((?E ?M) . ?\x19) + ((?S ?B) . ?\x1a) + ((?E ?C) . ?\x1b) + ((?F ?S) . ?\x1c) + ((?G ?S) . ?\x1d) + ((?R ?S) . ?\x1e) + ((?U ?S) . ?\x1f) + ((?S ?P) . ?\x20) + ((?N ?b) . ?\x23) + ((?D ?O) . ?\x24) + ((?A ?t) . ?\x40) + ((?< ?\() . ?\x5b) + ((?/ ?/) . ?\x5c) + ((?\) ?>) . ?\x5d) + ((?\' ?>) . ?\x5e) + ((?\' ?!) . ?\x60) + ((?\( ?!) . ?\x7b) + ((?! ?!) . ?\x7c) + ((?! ?\)) . ?\x7d) + ((?\' ??) . ?\x7e) + ((?D ?T) . ?\x7f) + ((?P ?A) . ?\x80) + ((?H ?O) . ?\x81) + ((?B ?H) . ?\x82) + ((?N ?H) . ?\x83) + ((?I ?N) . ?\x84) + ((?N ?L) . ?\x85) + ((?S ?A) . ?\x86) + ((?E ?S) . ?\x87) + ((?H ?S) . ?\x88) + ((?H ?J) . ?\x89) + ((?V ?S) . ?\x8a) + ((?P ?D) . ?\x8b) + ((?P ?U) . ?\x8c) + ((?R ?I) . ?\x8d) + ((?S ?2) . ?\x8e) + ((?S ?3) . ?\x8f) + ((?D ?C) . ?\x90) + ((?P ?1) . ?\x91) + ((?P ?2) . ?\x92) + ((?T ?S) . ?\x93) + ((?C ?C) . ?\x94) + ((?M ?W) . ?\x95) + ((?S ?G) . ?\x96) + ((?E ?G) . ?\x97) + ((?S ?S) . ?\x98) + ((?G ?C) . ?\x99) + ((?S ?C) . ?\x9a) + ((?C ?I) . ?\x9b) + ((?S ?T) . ?\x9c) + ((?O ?C) . ?\x9d) + ((?P ?M) . ?\x9e) + ((?A ?C) . ?\x9f) + ((?N ?S) . ?\xa0) + ((?! ?I) . ?\xa1) + ((?C ?t) . ?\xa2) + ((?P ?d) . ?\xa3) + ((?C ?u) . ?\xa4) + ((?Y ?e) . ?\xa5) + ((?B ?B) . ?\xa6) + ((?S ?E) . ?\xa7) + ((?\' ?:) . ?\xa8) + ((?C ?o) . ?\xa9) + ((?- ?a) . ?\xaa) + ((?< ?<) . ?\xab) + ((?N ?O) . ?\xac) + ((?- ?-) . ?\xad) + ((?R ?g) . ?\xae) + ((?\' ?m) . ?\xaf) + ((?D ?G) . ?\xb0) + ((?+ ?-) . ?\xb1) + ((?2 ?S) . ?\xb2) + ((?3 ?S) . ?\xb3) + ((?\' ?\') . ?\xb4) + ((?M ?y) . ?\xb5) + ((?P ?I) . ?\xb6) + ((?. ?M) . ?\xb7) + ((?\' ?,) . ?\xb8) + ((?1 ?S) . ?\xb9) + ((?- ?o) . ?\xba) + ((?> ?>) . ?\xbb) + ((?1 ?4) . ?\xbc) + ((?1 ?2) . ?\xbd) + ((?3 ?4) . ?\xbe) + ((?? ?I) . ?\xbf) + ((?A ?!) . ?\xc0) + ((?A ?\') . ?\xc1) + ((?A ?>) . ?\xc2) + ((?A ??) . ?\xc3) + ((?A ?:) . ?\xc4) + ((?A ?A) . ?\xc5) + ((?A ?E) . ?\xc6) + ((?C ?,) . ?\xc7) + ((?E ?!) . ?\xc8) + ((?E ?\') . ?\xc9) + ((?E ?>) . ?\xca) + ((?E ?:) . ?\xcb) + ((?I ?!) . ?\xcc) + ((?I ?\') . ?\xcd) + ((?I ?>) . ?\xce) + ((?I ?:) . ?\xcf) + ((?D ?-) . ?\xd0) + ((?N ??) . ?\xd1) + ((?O ?!) . ?\xd2) + ((?O ?\') . ?\xd3) + ((?O ?>) . ?\xd4) + ((?O ??) . ?\xd5) + ((?O ?:) . ?\xd6) + ((?* ?X) . ?\xd7) + ((?O ?/) . ?\xd8) + ((?U ?!) . ?\xd9) + ((?U ?\') . ?\xda) + ((?U ?>) . ?\xdb) + ((?U ?:) . ?\xdc) + ((?Y ?\') . ?\xdd) + ((?T ?H) . ?\xde) + ((?s ?s) . ?\xdf) + ((?a ?!) . ?\xe0) + ((?a ?\') . ?\xe1) + ((?a ?>) . ?\xe2) + ((?a ??) . ?\xe3) + ((?a ?:) . ?\xe4) + ((?a ?a) . ?\xe5) + ((?a ?e) . ?\xe6) + ((?c ?,) . ?\xe7) + ((?e ?!) . ?\xe8) + ((?e ?\') . ?\xe9) + ((?e ?>) . ?\xea) + ((?e ?:) . ?\xeb) + ((?i ?!) . ?\xec) + ((?i ?\') . ?\xed) + ((?i ?>) . ?\xee) + ((?i ?:) . ?\xef) + ((?d ?-) . ?\xf0) + ((?n ??) . ?\xf1) + ((?o ?!) . ?\xf2) + ((?o ?\') . ?\xf3) + ((?o ?>) . ?\xf4) + ((?o ??) . ?\xf5) + ((?o ?:) . ?\xf6) + ((?- ?:) . ?\xf7) + ((?o ?/) . ?\xf8) + ((?u ?!) . ?\xf9) + ((?u ?\') . ?\xfa) + ((?u ?>) . ?\xfb) + ((?u ?:) . ?\xfc) + ((?y ?\') . ?\xfd) + ((?t ?h) . ?\xfe) + ((?y ?:) . ?\xff) + ((?A ?-) . ?\x0100) + ((?a ?-) . ?\x0101) + ((?A ?\() . ?\x0102) + ((?a ?\() . ?\x0103) + ((?A ?\;) . ?\x0104) + ((?a ?\;) . ?\x0105) + ((?C ?\') . ?\x0106) + ((?c ?\') . ?\x0107) + ((?C ?>) . ?\x0108) + ((?c ?>) . ?\x0109) + ((?C ?.) . ?\x010a) + ((?c ?.) . ?\x010b) + ((?C ?<) . ?\x010c) + ((?c ?<) . ?\x010d) + ((?D ?<) . ?\x010e) + ((?d ?<) . ?\x010f) + ((?D ?/) . ?\x0110) + ((?d ?/) . ?\x0111) + ((?E ?-) . ?\x0112) + ((?e ?-) . ?\x0113) + ((?E ?\() . ?\x0114) + ((?e ?\() . ?\x0115) + ((?E ?.) . ?\x0116) + ((?e ?.) . ?\x0117) + ((?E ?\;) . ?\x0118) + ((?e ?\;) . ?\x0119) + ((?E ?<) . ?\x011a) + ((?e ?<) . ?\x011b) + ((?G ?>) . ?\x011c) + ((?g ?>) . ?\x011d) + ((?G ?\() . ?\x011e) + ((?g ?\() . ?\x011f) + ((?G ?.) . ?\x0120) + ((?g ?.) . ?\x0121) + ((?G ?,) . ?\x0122) + ((?g ?,) . ?\x0123) + ((?H ?>) . ?\x0124) + ((?h ?>) . ?\x0125) + ((?H ?/) . ?\x0126) + ((?h ?/) . ?\x0127) + ((?I ??) . ?\x0128) + ((?i ??) . ?\x0129) + ((?I ?-) . ?\x012a) + ((?i ?-) . ?\x012b) + ((?I ?\() . ?\x012c) + ((?i ?\() . ?\x012d) + ((?I ?\;) . ?\x012e) + ((?i ?\;) . ?\x012f) + ((?I ?.) . ?\x0130) + ((?i ?.) . ?\x0131) + ((?I ?J) . ?\x0132) + ((?i ?j) . ?\x0133) + ((?J ?>) . ?\x0134) + ((?j ?>) . ?\x0135) + ((?K ?,) . ?\x0136) + ((?k ?,) . ?\x0137) + ((?k ?k) . ?\x0138) + ((?L ?\') . ?\x0139) + ((?l ?\') . ?\x013a) + ((?L ?,) . ?\x013b) + ((?l ?,) . ?\x013c) + ((?L ?<) . ?\x013d) + ((?l ?<) . ?\x013e) + ((?L ?.) . ?\x013f) + ((?l ?.) . ?\x0140) + ((?L ?/) . ?\x0141) + ((?l ?/) . ?\x0142) + ((?N ?\') . ?\x0143) + ((?n ?\') . ?\x0144) + ((?N ?,) . ?\x0145) + ((?n ?,) . ?\x0146) + ((?N ?<) . ?\x0147) + ((?n ?<) . ?\x0148) + ((?\' ?n) . ?\x0149) + ((?N ?G) . ?\x014a) + ((?n ?g) . ?\x014b) + ((?O ?-) . ?\x014c) + ((?o ?-) . ?\x014d) + ((?O ?\() . ?\x014e) + ((?o ?\() . ?\x014f) + ((?O ?\") . ?\x0150) + ((?o ?\") . ?\x0151) + ((?O ?E) . ?\x0152) + ((?o ?e) . ?\x0153) + ((?R ?\') . ?\x0154) + ((?r ?\') . ?\x0155) + ((?R ?,) . ?\x0156) + ((?r ?,) . ?\x0157) + ((?R ?<) . ?\x0158) + ((?r ?<) . ?\x0159) + ((?S ?\') . ?\x015a) + ((?s ?\') . ?\x015b) + ((?S ?>) . ?\x015c) + ((?s ?>) . ?\x015d) + ((?S ?,) . ?\x015e) + ((?s ?,) . ?\x015f) + ((?S ?<) . ?\x0160) + ((?s ?<) . ?\x0161) + ((?T ?,) . ?\x0162) + ((?t ?,) . ?\x0163) + ((?T ?<) . ?\x0164) + ((?t ?<) . ?\x0165) + ((?T ?/) . ?\x0166) + ((?t ?/) . ?\x0167) + ((?U ??) . ?\x0168) + ((?u ??) . ?\x0169) + ((?U ?-) . ?\x016a) + ((?u ?-) . ?\x016b) + ((?U ?\() . ?\x016c) + ((?u ?\() . ?\x016d) + ((?U ?0) . ?\x016e) + ((?u ?0) . ?\x016f) + ((?U ?\") . ?\x0170) + ((?u ?\") . ?\x0171) + ((?U ?\;) . ?\x0172) + ((?u ?\;) . ?\x0173) + ((?W ?>) . ?\x0174) + ((?w ?>) . ?\x0175) + ((?Y ?>) . ?\x0176) + ((?y ?>) . ?\x0177) + ((?Y ?:) . ?\x0178) + ((?Z ?\') . ?\x0179) + ((?z ?\') . ?\x017a) + ((?Z ?.) . ?\x017b) + ((?z ?.) . ?\x017c) + ((?Z ?<) . ?\x017d) + ((?z ?<) . ?\x017e) + ((?O ?9) . ?\x01a0) + ((?o ?9) . ?\x01a1) + ((?O ?I) . ?\x01a2) + ((?o ?i) . ?\x01a3) + ((?y ?r) . ?\x01a6) + ((?U ?9) . ?\x01af) + ((?u ?9) . ?\x01b0) + ((?Z ?/) . ?\x01b5) + ((?z ?/) . ?\x01b6) + ((?E ?D) . ?\x01b7) + ((?A ?<) . ?\x01cd) + ((?a ?<) . ?\x01ce) + ((?I ?<) . ?\x01cf) + ((?i ?<) . ?\x01d0) + ((?O ?<) . ?\x01d1) + ((?o ?<) . ?\x01d2) + ((?U ?<) . ?\x01d3) + ((?u ?<) . ?\x01d4) + ((?A ?1) . ?\x01de) + ((?a ?1) . ?\x01df) + ((?A ?7) . ?\x01e0) + ((?a ?7) . ?\x01e1) + ((?A ?3) . ?\x01e2) + ((?a ?3) . ?\x01e3) + ((?G ?/) . ?\x01e4) + ((?g ?/) . ?\x01e5) + ((?G ?<) . ?\x01e6) + ((?g ?<) . ?\x01e7) + ((?K ?<) . ?\x01e8) + ((?k ?<) . ?\x01e9) + ((?O ?\;) . ?\x01ea) + ((?o ?\;) . ?\x01eb) + ((?O ?1) . ?\x01ec) + ((?o ?1) . ?\x01ed) + ((?E ?Z) . ?\x01ee) + ((?e ?z) . ?\x01ef) + ((?j ?<) . ?\x01f0) + ((?G ?\') . ?\x01f4) + ((?g ?\') . ?\x01f5) + ((?\; ?S ) .?\x02bf) + ((?\' ?<) . ?\x02c7) + ((?\' ?\() . ?\x02d8) + ((?\' ?.) . ?\x02d9) + ((?\' ?0) . ?\x02da) + ((?\' ?\;) . ?\x02db) + ((?\' ?\") . ?\x02dd) + ((?A ?%) . ?\x0386) + ((?E ?%) . ?\x0388) + ((?Y ?%) . ?\x0389) + ((?I ?%) . ?\x038a) + ((?O ?%) . ?\x038c) + ((?U ?%) . ?\x038e) + ((?W ?%) . ?\x038f) + ((?i ?3) . ?\x0390) + ((?A ?*) . ?\x0391) + ((?B ?*) . ?\x0392) + ((?G ?*) . ?\x0393) + ((?D ?*) . ?\x0394) + ((?E ?*) . ?\x0395) + ((?Z ?*) . ?\x0396) + ((?Y ?*) . ?\x0397) + ((?H ?*) . ?\x0398) + ((?I ?*) . ?\x0399) + ((?K ?*) . ?\x039a) + ((?L ?*) . ?\x039b) + ((?M ?*) . ?\x039c) + ((?N ?*) . ?\x039d) + ((?C ?*) . ?\x039e) + ((?O ?*) . ?\x039f) + ((?P ?*) . ?\x03a0) + ((?R ?*) . ?\x03a1) + ((?S ?*) . ?\x03a3) + ((?T ?*) . ?\x03a4) + ((?U ?*) . ?\x03a5) + ((?F ?*) . ?\x03a6) + ((?X ?*) . ?\x03a7) + ((?Q ?*) . ?\x03a8) + ((?W ?*) . ?\x03a9) + ((?J ?*) . ?\x03aa) + ((?V ?*) . ?\x03ab) + ((?a ?%) . ?\x03ac) + ((?e ?%) . ?\x03ad) + ((?y ?%) . ?\x03ae) + ((?i ?%) . ?\x03af) + ((?u ?3) . ?\x03b0) + ((?a ?*) . ?\x03b1) + ((?b ?*) . ?\x03b2) + ((?g ?*) . ?\x03b3) + ((?d ?*) . ?\x03b4) + ((?e ?*) . ?\x03b5) + ((?z ?*) . ?\x03b6) + ((?y ?*) . ?\x03b7) + ((?h ?*) . ?\x03b8) + ((?i ?*) . ?\x03b9) + ((?k ?*) . ?\x03ba) + ((?l ?*) . ?\x03bb) + ((?m ?*) . ?\x03bc) + ((?n ?*) . ?\x03bd) + ((?c ?*) . ?\x03be) + ((?o ?*) . ?\x03bf) + ((?p ?*) . ?\x03c0) + ((?r ?*) . ?\x03c1) + ((?* ?s) . ?\x03c2) + ((?s ?*) . ?\x03c3) + ((?t ?*) . ?\x03c4) + ((?u ?*) . ?\x03c5) + ((?f ?*) . ?\x03c6) + ((?x ?*) . ?\x03c7) + ((?q ?*) . ?\x03c8) + ((?w ?*) . ?\x03c9) + ((?j ?*) . ?\x03ca) + ((?v ?*) . ?\x03cb) + ((?o ?%) . ?\x03cc) + ((?u ?%) . ?\x03cd) + ((?w ?%) . ?\x03ce) + ((?\' ?G) . ?\x03d8) + ((?, ?G) . ?\x03d9) + ((?T ?3) . ?\x03da) + ((?t ?3) . ?\x03db) + ((?M ?3) . ?\x03dc) + ((?m ?3) . ?\x03dd) + ((?K ?3) . ?\x03de) + ((?k ?3) . ?\x03df) + ((?P ?3) . ?\x03e0) + ((?p ?3) . ?\x03e1) + ((?\' ?%) . ?\x03f4) + ((?j ?3) . ?\x03f5) + ((?I ?O) . ?\x0401) + ((?D ?%) . ?\x0402) + ((?G ?%) . ?\x0403) + ((?I ?E) . ?\x0404) + ((?D ?S) . ?\x0405) + ((?I ?I) . ?\x0406) + ((?Y ?I) . ?\x0407) + ((?J ?%) . ?\x0408) + ((?L ?J) . ?\x0409) + ((?N ?J) . ?\x040a) + ((?T ?s) . ?\x040b) + ((?K ?J) . ?\x040c) + ((?V ?%) . ?\x040e) + ((?D ?Z) . ?\x040f) + ((?A ?=) . ?\x0410) + ((?B ?=) . ?\x0411) + ((?V ?=) . ?\x0412) + ((?G ?=) . ?\x0413) + ((?D ?=) . ?\x0414) + ((?E ?=) . ?\x0415) + ((?Z ?%) . ?\x0416) + ((?Z ?=) . ?\x0417) + ((?I ?=) . ?\x0418) + ((?J ?=) . ?\x0419) + ((?K ?=) . ?\x041a) + ((?L ?=) . ?\x041b) + ((?M ?=) . ?\x041c) + ((?N ?=) . ?\x041d) + ((?O ?=) . ?\x041e) + ((?P ?=) . ?\x041f) + ((?R ?=) . ?\x0420) + ((?S ?=) . ?\x0421) + ((?T ?=) . ?\x0422) + ((?U ?=) . ?\x0423) + ((?F ?=) . ?\x0424) + ((?H ?=) . ?\x0425) + ((?C ?=) . ?\x0426) + ((?C ?%) . ?\x0427) + ((?S ?%) . ?\x0428) + ((?S ?c) . ?\x0429) + ((?= ?\") . ?\x042a) + ((?Y ?=) . ?\x042b) + ((?% ?\") . ?\x042c) + ((?J ?E) . ?\x042d) + ((?J ?U) . ?\x042e) + ((?J ?A) . ?\x042f) + ((?a ?=) . ?\x0430) + ((?b ?=) . ?\x0431) + ((?v ?=) . ?\x0432) + ((?g ?=) . ?\x0433) + ((?d ?=) . ?\x0434) + ((?e ?=) . ?\x0435) + ((?z ?%) . ?\x0436) + ((?z ?=) . ?\x0437) + ((?i ?=) . ?\x0438) + ((?j ?=) . ?\x0439) + ((?k ?=) . ?\x043a) + ((?l ?=) . ?\x043b) + ((?m ?=) . ?\x043c) + ((?n ?=) . ?\x043d) + ((?o ?=) . ?\x043e) + ((?p ?=) . ?\x043f) + ((?r ?=) . ?\x0440) + ((?s ?=) . ?\x0441) + ((?t ?=) . ?\x0442) + ((?u ?=) . ?\x0443) + ((?f ?=) . ?\x0444) + ((?h ?=) . ?\x0445) + ((?c ?=) . ?\x0446) + ((?c ?%) . ?\x0447) + ((?s ?%) . ?\x0448) + ((?s ?c) . ?\x0449) + ((?= ?\') . ?\x044a) + ((?y ?=) . ?\x044b) + ((?% ?\') . ?\x044c) + ((?j ?e) . ?\x044d) + ((?j ?u) . ?\x044e) + ((?j ?a) . ?\x044f) + ((?i ?o) . ?\x0451) + ((?d ?%) . ?\x0452) + ((?g ?%) . ?\x0453) + ((?i ?e) . ?\x0454) + ((?d ?s) . ?\x0455) + ((?i ?i) . ?\x0456) + ((?y ?i) . ?\x0457) + ((?j ?%) . ?\x0458) + ((?l ?j) . ?\x0459) + ((?n ?j) . ?\x045a) + ((?t ?s) . ?\x045b) + ((?k ?j) . ?\x045c) + ((?v ?%) . ?\x045e) + ((?d ?z) . ?\x045f) + ((?Y ?3) . ?\x0462) + ((?y ?3) . ?\x0463) + ((?O ?3) . ?\x046a) + ((?o ?3) . ?\x046b) + ((?F ?3) . ?\x0472) + ((?f ?3) . ?\x0473) + ((?V ?3) . ?\x0474) + ((?v ?3) . ?\x0475) + ((?C ?3) . ?\x0480) + ((?c ?3) . ?\x0481) + ((?G ?3) . ?\x0490) + ((?g ?3) . ?\x0491) + ((?A ?+) . ?\x05d0) + ((?B ?+) . ?\x05d1) + ((?G ?+) . ?\x05d2) + ((?D ?+) . ?\x05d3) + ((?H ?+) . ?\x05d4) + ((?W ?+) . ?\x05d5) + ((?Z ?+) . ?\x05d6) + ((?X ?+) . ?\x05d7) + ((?T ?j) . ?\x05d8) + ((?J ?+) . ?\x05d9) + ((?K ?%) . ?\x05da) + ((?K ?+) . ?\x05db) + ((?L ?+) . ?\x05dc) + ((?M ?%) . ?\x05dd) + ((?M ?+) . ?\x05de) + ((?N ?%) . ?\x05df) + ((?N ?+) . ?\x05e0) + ((?S ?+) . ?\x05e1) + ((?E ?+) . ?\x05e2) + ((?P ?%) . ?\x05e3) + ((?P ?+) . ?\x05e4) + ((?Z ?j) . ?\x05e5) + ((?Z ?J) . ?\x05e6) + ((?Q ?+) . ?\x05e7) + ((?R ?+) . ?\x05e8) + ((?S ?h) . ?\x05e9) + ((?T ?+) . ?\x05ea) + ((?, ?+) . ?\x060c) + ((?\; ?+) . ?\x061b) + ((?? ?+) . ?\x061f) + ((?H ?\') . ?\x0621) + ((?a ?M) . ?\x0622) + ((?a ?H) . ?\x0623) + ((?w ?H) . ?\x0624) + ((?a ?h) . ?\x0625) + ((?y ?H) . ?\x0626) + ((?a ?+) . ?\x0627) + ((?b ?+) . ?\x0628) + ((?t ?m) . ?\x0629) + ((?t ?+) . ?\x062a) + ((?t ?k) . ?\x062b) + ((?g ?+) . ?\x062c) + ((?h ?k) . ?\x062d) + ((?x ?+) . ?\x062e) + ((?d ?+) . ?\x062f) + ((?d ?k) . ?\x0630) + ((?r ?+) . ?\x0631) + ((?z ?+) . ?\x0632) + ((?s ?+) . ?\x0633) + ((?s ?n) . ?\x0634) + ((?c ?+) . ?\x0635) + ((?d ?d) . ?\x0636) + ((?t ?j) . ?\x0637) + ((?z ?H) . ?\x0638) + ((?e ?+) . ?\x0639) + ((?i ?+) . ?\x063a) + ((?+ ?+) . ?\x0640) + ((?f ?+) . ?\x0641) + ((?q ?+) . ?\x0642) + ((?k ?+) . ?\x0643) + ((?l ?+) . ?\x0644) + ((?m ?+) . ?\x0645) + ((?n ?+) . ?\x0646) + ((?h ?+) . ?\x0647) + ((?w ?+) . ?\x0648) + ((?j ?+) . ?\x0649) + ((?y ?+) . ?\x064a) + ((?: ?+) . ?\x064b) + ((?\" ?+) . ?\x064c) + ((?= ?+) . ?\x064d) + ((?/ ?+) . ?\x064e) + ((?\' ?+) . ?\x064f) + ((?1 ?+) . ?\x0650) + ((?3 ?+) . ?\x0651) + ((?0 ?+) . ?\x0652) + ((?a ?S) . ?\x0670) + ((?p ?+) . ?\x067e) + ((?v ?+) . ?\x06a4) + ((?g ?f) . ?\x06af) + ((?0 ?a) . ?\x06f0) + ((?1 ?a) . ?\x06f1) + ((?2 ?a) . ?\x06f2) + ((?3 ?a) . ?\x06f3) + ((?4 ?a) . ?\x06f4) + ((?5 ?a) . ?\x06f5) + ((?6 ?a) . ?\x06f6) + ((?7 ?a) . ?\x06f7) + ((?8 ?a) . ?\x06f8) + ((?9 ?a) . ?\x06f9) + ((?B ?.) . ?\x1e02) + ((?b ?.) . ?\x1e03) + ((?B ?_) . ?\x1e06) + ((?b ?_) . ?\x1e07) + ((?D ?.) . ?\x1e0a) + ((?d ?.) . ?\x1e0b) + ((?D ?_) . ?\x1e0e) + ((?d ?_) . ?\x1e0f) + ((?D ?,) . ?\x1e10) + ((?d ?,) . ?\x1e11) + ((?F ?.) . ?\x1e1e) + ((?f ?.) . ?\x1e1f) + ((?G ?-) . ?\x1e20) + ((?g ?-) . ?\x1e21) + ((?H ?.) . ?\x1e22) + ((?h ?.) . ?\x1e23) + ((?H ?:) . ?\x1e26) + ((?h ?:) . ?\x1e27) + ((?H ?,) . ?\x1e28) + ((?h ?,) . ?\x1e29) + ((?K ?\') . ?\x1e30) + ((?k ?\') . ?\x1e31) + ((?K ?_) . ?\x1e34) + ((?k ?_) . ?\x1e35) + ((?L ?_) . ?\x1e3a) + ((?l ?_) . ?\x1e3b) + ((?M ?\') . ?\x1e3e) + ((?m ?\') . ?\x1e3f) + ((?M ?.) . ?\x1e40) + ((?m ?.) . ?\x1e41) + ((?N ?.) . ?\x1e44) + ((?n ?.) . ?\x1e45) + ((?N ?_) . ?\x1e48) + ((?n ?_) . ?\x1e49) + ((?P ?\') . ?\x1e54) + ((?p ?\') . ?\x1e55) + ((?P ?.) . ?\x1e56) + ((?p ?.) . ?\x1e57) + ((?R ?.) . ?\x1e58) + ((?r ?.) . ?\x1e59) + ((?R ?_) . ?\x1e5e) + ((?r ?_) . ?\x1e5f) + ((?S ?.) . ?\x1e60) + ((?s ?.) . ?\x1e61) + ((?T ?.) . ?\x1e6a) + ((?t ?.) . ?\x1e6b) + ((?T ?_) . ?\x1e6e) + ((?t ?_) . ?\x1e6f) + ((?V ??) . ?\x1e7c) + ((?v ??) . ?\x1e7d) + ((?W ?!) . ?\x1e80) + ((?w ?!) . ?\x1e81) + ((?W ?\') . ?\x1e82) + ((?w ?\') . ?\x1e83) + ((?W ?:) . ?\x1e84) + ((?w ?:) . ?\x1e85) + ((?W ?.) . ?\x1e86) + ((?w ?.) . ?\x1e87) + ((?X ?.) . ?\x1e8a) + ((?x ?.) . ?\x1e8b) + ((?X ?:) . ?\x1e8c) + ((?x ?:) . ?\x1e8d) + ((?Y ?.) . ?\x1e8e) + ((?y ?.) . ?\x1e8f) + ((?Z ?>) . ?\x1e90) + ((?z ?>) . ?\x1e91) + ((?Z ?_) . ?\x1e94) + ((?z ?_) . ?\x1e95) + ((?h ?_) . ?\x1e96) + ((?t ?:) . ?\x1e97) + ((?w ?0) . ?\x1e98) + ((?y ?0) . ?\x1e99) + ((?A ?2) . ?\x1ea2) + ((?a ?2) . ?\x1ea3) + ((?E ?2) . ?\x1eba) + ((?e ?2) . ?\x1ebb) + ((?E ??) . ?\x1ebc) + ((?e ??) . ?\x1ebd) + ((?I ?2) . ?\x1ec8) + ((?i ?2) . ?\x1ec9) + ((?O ?2) . ?\x1ece) + ((?o ?2) . ?\x1ecf) + ((?U ?2) . ?\x1ee6) + ((?u ?2) . ?\x1ee7) + ((?Y ?!) . ?\x1ef2) + ((?y ?!) . ?\x1ef3) + ((?Y ?2) . ?\x1ef6) + ((?y ?2) . ?\x1ef7) + ((?Y ??) . ?\x1ef8) + ((?y ??) . ?\x1ef9) + ((?\; ?\') . ?\x1f00) + ((?, ?\') . ?\x1f01) + ((?\; ?!) . ?\x1f02) + ((?, ?!) . ?\x1f03) + ((?? ?\;) . ?\x1f04) + ((?? ?,) . ?\x1f05) + ((?! ?:) . ?\x1f06) + ((?? ?:) . ?\x1f07) + ((?1 ?N) . ?\x2002) + ((?1 ?M) . ?\x2003) + ((?3 ?M) . ?\x2004) + ((?4 ?M) . ?\x2005) + ((?6 ?M) . ?\x2006) + ((?1 ?T) . ?\x2009) + ((?1 ?H) . ?\x200a) + ((?- ?1) . ?\x2010) + ((?- ?N) . ?\x2013) + ((?- ?M) . ?\x2014) + ((?- ?3) . ?\x2015) + ((?! ?2) . ?\x2016) + ((?= ?2) . ?\x2017) + ((?\' ?6) . ?\x2018) + ((?\' ?9) . ?\x2019) + ((?. ?9) . ?\x201a) + ((?9 ?\') . ?\x201b) + ((?\" ?6) . ?\x201c) + ((?\" ?9) . ?\x201d) + ((?: ?9) . ?\x201e) + ((?9 ?\") . ?\x201f) + ((?/ ?-) . ?\x2020) + ((?/ ?=) . ?\x2021) + ((?. ?.) . ?\x2025) + ((?% ?0) . ?\x2030) + ((?1 ?\') . ?\x2032) + ((?2 ?\') . ?\x2033) + ((?3 ?\') . ?\x2034) + ((?1 ?\") . ?\x2035) + ((?2 ?\") . ?\x2036) + ((?3 ?\") . ?\x2037) + ((?C ?a) . ?\x2038) + ((?< ?1) . ?\x2039) + ((?> ?1) . ?\x203a) + ((?: ?X) . ?\x203b) + ((?\' ?-) . ?\x203e) + ((?/ ?f) . ?\x2044) + ((?0 ?S) . ?\x2070) + ((?4 ?S) . ?\x2074) + ((?5 ?S) . ?\x2075) + ((?6 ?S) . ?\x2076) + ((?7 ?S) . ?\x2077) + ((?8 ?S) . ?\x2078) + ((?9 ?S) . ?\x2079) + ((?+ ?S) . ?\x207a) + ((?- ?S) . ?\x207b) + ((?= ?S) . ?\x207c) + ((?\( ?S) . ?\x207d) + ((?\) ?S) . ?\x207e) + ((?n ?S) . ?\x207f) + ((?0 ?s) . ?\x2080) + ((?1 ?s) . ?\x2081) + ((?2 ?s) . ?\x2082) + ((?3 ?s) . ?\x2083) + ((?4 ?s) . ?\x2084) + ((?5 ?s) . ?\x2085) + ((?6 ?s) . ?\x2086) + ((?7 ?s) . ?\x2087) + ((?8 ?s) . ?\x2088) + ((?9 ?s) . ?\x2089) + ((?+ ?s) . ?\x208a) + ((?- ?s) . ?\x208b) + ((?= ?s) . ?\x208c) + ((?\( ?s) . ?\x208d) + ((?\) ?s) . ?\x208e) + ((?L ?i) . ?\x20a4) + ((?P ?t) . ?\x20a7) + ((?W ?=) . ?\x20a9) + ((?= ?e) . ?\x20ac) + ((?E ?u) . ?\x20ac) + ((?o ?C) . ?\x2103) + ((?c ?o) . ?\x2105) + ((?o ?F) . ?\x2109) + ((?N ?0) . ?\x2116) + ((?P ?O) . ?\x2117) + ((?R ?x) . ?\x211e) + ((?S ?M) . ?\x2120) + ((?T ?M) . ?\x2122) + ((?O ?m) . ?\x2126) + ((?A ?O) . ?\x212b) + ((?1 ?3) . ?\x2153) + ((?2 ?3) . ?\x2154) + ((?1 ?5) . ?\x2155) + ((?2 ?5) . ?\x2156) + ((?3 ?5) . ?\x2157) + ((?4 ?5) . ?\x2158) + ((?1 ?6) . ?\x2159) + ((?5 ?6) . ?\x215a) + ((?1 ?8) . ?\x215b) + ((?3 ?8) . ?\x215c) + ((?5 ?8) . ?\x215d) + ((?7 ?8) . ?\x215e) + ((?1 ?R) . ?\x2160) + ((?2 ?R) . ?\x2161) + ((?3 ?R) . ?\x2162) + ((?4 ?R) . ?\x2163) + ((?5 ?R) . ?\x2164) + ((?6 ?R) . ?\x2165) + ((?7 ?R) . ?\x2166) + ((?8 ?R) . ?\x2167) + ((?9 ?R) . ?\x2168) + ((?a ?R) . ?\x2169) + ((?b ?R) . ?\x216a) + ((?c ?R) . ?\x216b) + ((?1 ?r) . ?\x2170) + ((?2 ?r) . ?\x2171) + ((?3 ?r) . ?\x2172) + ((?4 ?r) . ?\x2173) + ((?5 ?r) . ?\x2174) + ((?6 ?r) . ?\x2175) + ((?7 ?r) . ?\x2176) + ((?8 ?r) . ?\x2177) + ((?9 ?r) . ?\x2178) + ((?a ?r) . ?\x2179) + ((?b ?r) . ?\x217a) + ((?c ?r) . ?\x217b) + ((?< ?-) . ?\x2190) + ((?- ?!) . ?\x2191) + ((?- ?>) . ?\x2192) + ((?- ?v) . ?\x2193) + ((?< ?>) . ?\x2194) + ((?U ?D) . ?\x2195) + ((?< ?=) . ?\x21d0) + ((?= ?>) . ?\x21d2) + ((?= ?=) . ?\x21d4) + ((?F ?A) . ?\x2200) + ((?d ?P) . ?\x2202) + ((?T ?E) . ?\x2203) + ((?/ ?0) . ?\x2205) + ((?D ?E) . ?\x2206) + ((?N ?B) . ?\x2207) + ((?\( ?-) . ?\x2208) + ((?- ?\)) . ?\x220b) + ((?* ?P) . ?\x220f) + ((?+ ?Z) . ?\x2211) + ((?- ?2) . ?\x2212) + ((?- ?+) . ?\x2213) + ((?* ?-) . ?\x2217) + ((?O ?b) . ?\x2218) + ((?S ?b) . ?\x2219) + ((?R ?T) . ?\x221a) + ((?0 ?\() . ?\x221d) + ((?0 ?0) . ?\x221e) + ((?- ?L) . ?\x221f) + ((?- ?V) . ?\x2220) + ((?P ?P) . ?\x2225) + ((?A ?N) . ?\x2227) + ((?O ?R) . ?\x2228) + ((?\( ?U) . ?\x2229) + ((?\) ?U) . ?\x222a) + ((?I ?n) . ?\x222b) + ((?D ?I) . ?\x222c) + ((?I ?o) . ?\x222e) + ((?. ?:) . ?\x2234) + ((?: ?.) . ?\x2235) + ((?: ?R) . ?\x2236) + ((?: ?:) . ?\x2237) + ((?? ?1) . ?\x223c) + ((?C ?G) . ?\x223e) + ((?? ?-) . ?\x2243) + ((?? ?=) . ?\x2245) + ((?? ?2) . ?\x2248) + ((?= ??) . ?\x224c) + ((?H ?I) . ?\x2253) + ((?! ?=) . ?\x2260) + ((?= ?3) . ?\x2261) + ((?= ?<) . ?\x2264) + ((?> ?=) . ?\x2265) + ((?< ?*) . ?\x226a) + ((?* ?>) . ?\x226b) + ((?! ?<) . ?\x226e) + ((?! ?>) . ?\x226f) + ((?\( ?C) . ?\x2282) + ((?\) ?C) . ?\x2283) + ((?\( ?_) . ?\x2286) + ((?\) ?_) . ?\x2287) + ((?0 ?.) . ?\x2299) + ((?0 ?2) . ?\x229a) + ((?- ?T) . ?\x22a5) + ((?. ?P) . ?\x22c5) + ((?: ?3) . ?\x22ee) + ((?. ?3) . ?\x22ef) + ((?E ?h) . ?\x2302) + ((?< ?7) . ?\x2308) + ((?> ?7) . ?\x2309) + ((?7 ?<) . ?\x230a) + ((?7 ?>) . ?\x230b) + ((?N ?I) . ?\x2310) + ((?\( ?A) . ?\x2312) + ((?T ?R) . ?\x2315) + ((?I ?u) . ?\x2320) + ((?I ?l) . ?\x2321) + ((?< ?/) . ?\x2329) + ((?/ ?>) . ?\x232a) + ((?V ?s) . ?\x2423) + ((?1 ?h) . ?\x2440) + ((?3 ?h) . ?\x2441) + ((?2 ?h) . ?\x2442) + ((?4 ?h) . ?\x2443) + ((?1 ?j) . ?\x2446) + ((?2 ?j) . ?\x2447) + ((?3 ?j) . ?\x2448) + ((?4 ?j) . ?\x2449) + ((?1 ?.) . ?\x2488) + ((?2 ?.) . ?\x2489) + ((?3 ?.) . ?\x248a) + ((?4 ?.) . ?\x248b) + ((?5 ?.) . ?\x248c) + ((?6 ?.) . ?\x248d) + ((?7 ?.) . ?\x248e) + ((?8 ?.) . ?\x248f) + ((?9 ?.) . ?\x2490) + ((?h ?h) . ?\x2500) + ((?H ?H) . ?\x2501) + ((?v ?v) . ?\x2502) + ((?V ?V) . ?\x2503) + ((?3 ?-) . ?\x2504) + ((?3 ?_) . ?\x2505) + ((?3 ?!) . ?\x2506) + ((?3 ?/) . ?\x2507) + ((?4 ?-) . ?\x2508) + ((?4 ?_) . ?\x2509) + ((?4 ?!) . ?\x250a) + ((?4 ?/) . ?\x250b) + ((?d ?r) . ?\x250c) + ((?d ?R) . ?\x250d) + ((?D ?r) . ?\x250e) + ((?D ?R) . ?\x250f) + ((?d ?l) . ?\x2510) + ((?d ?L) . ?\x2511) + ((?D ?l) . ?\x2512) + ((?L ?D) . ?\x2513) + ((?u ?r) . ?\x2514) + ((?u ?R) . ?\x2515) + ((?U ?r) . ?\x2516) + ((?U ?R) . ?\x2517) + ((?u ?l) . ?\x2518) + ((?u ?L) . ?\x2519) + ((?U ?l) . ?\x251a) + ((?U ?L) . ?\x251b) + ((?v ?r) . ?\x251c) + ((?v ?R) . ?\x251d) + ((?V ?r) . ?\x2520) + ((?V ?R) . ?\x2523) + ((?v ?l) . ?\x2524) + ((?v ?L) . ?\x2525) + ((?V ?l) . ?\x2528) + ((?V ?L) . ?\x252b) + ((?d ?h) . ?\x252c) + ((?d ?H) . ?\x252f) + ((?D ?h) . ?\x2530) + ((?D ?H) . ?\x2533) + ((?u ?h) . ?\x2534) + ((?u ?H) . ?\x2537) + ((?U ?h) . ?\x2538) + ((?U ?H) . ?\x253b) + ((?v ?h) . ?\x253c) + ((?v ?H) . ?\x253f) + ((?V ?h) . ?\x2542) + ((?V ?H) . ?\x254b) + ((?F ?D) . ?\x2571) + ((?B ?D) . ?\x2572) + ((?T ?B) . ?\x2580) + ((?L ?B) . ?\x2584) + ((?F ?B) . ?\x2588) + ((?l ?B) . ?\x258c) + ((?R ?B) . ?\x2590) + ((?. ?S) . ?\x2591) + ((?: ?S) . ?\x2592) + ((?? ?S) . ?\x2593) + ((?f ?S) . ?\x25a0) + ((?O ?S) . ?\x25a1) + ((?R ?O) . ?\x25a2) + ((?R ?r) . ?\x25a3) + ((?R ?F) . ?\x25a4) + ((?R ?Y) . ?\x25a5) + ((?R ?H) . ?\x25a6) + ((?R ?Z) . ?\x25a7) + ((?R ?K) . ?\x25a8) + ((?R ?X) . ?\x25a9) + ((?s ?B) . ?\x25aa) + ((?S ?R) . ?\x25ac) + ((?O ?r) . ?\x25ad) + ((?U ?T) . ?\x25b2) + ((?u ?T) . ?\x25b3) + ((?P ?R) . ?\x25b6) + ((?T ?r) . ?\x25b7) + ((?D ?t) . ?\x25bc) + ((?d ?T) . ?\x25bd) + ((?P ?L) . ?\x25c0) + ((?T ?l) . ?\x25c1) + ((?D ?b) . ?\x25c6) + ((?D ?w) . ?\x25c7) + ((?L ?Z) . ?\x25ca) + ((?0 ?m) . ?\x25cb) + ((?0 ?o) . ?\x25ce) + ((?0 ?M) . ?\x25cf) + ((?0 ?L) . ?\x25d0) + ((?0 ?R) . ?\x25d1) + ((?S ?n) . ?\x25d8) + ((?I ?c) . ?\x25d9) + ((?F ?d) . ?\x25e2) + ((?B ?d) . ?\x25e3) + ((?* ?2) . ?\x2605) + ((?* ?1) . ?\x2606) + ((?< ?H) . ?\x261c) + ((?> ?H) . ?\x261e) + ((?0 ?u) . ?\x263a) + ((?0 ?U) . ?\x263b) + ((?S ?U) . ?\x263c) + ((?F ?m) . ?\x2640) + ((?M ?l) . ?\x2642) + ((?c ?S) . ?\x2660) + ((?c ?H) . ?\x2661) + ((?c ?D) . ?\x2662) + ((?c ?C) . ?\x2663) + ((?M ?d) . ?\x2669) + ((?M ?8) . ?\x266a) + ((?M ?2) . ?\x266b) + ((?M ?b) . ?\x266d) + ((?M ?x) . ?\x266e) + ((?M ?X) . ?\x266f) + ((?O ?K) . ?\x2713) + ((?X ?X) . ?\x2717) + ((?- ?X) . ?\x2720) + ((?I ?S) . ?\x3000) + ((?, ?_) . ?\x3001) + ((?. ?_) . ?\x3002) + ((?+ ?\") . ?\x3003) + ((?+ ?_) . ?\x3004) + ((?* ?_) . ?\x3005) + ((?\; ?_) . ?\x3006) + ((?0 ?_) . ?\x3007) + ((?< ?+) . ?\x300a) + ((?> ?+) . ?\x300b) + ((?< ?\') . ?\x300c) + ((?> ?\') . ?\x300d) + ((?< ?\") . ?\x300e) + ((?> ?\") . ?\x300f) + ((?\( ?\") . ?\x3010) + ((?\) ?\") . ?\x3011) + ((?= ?T) . ?\x3012) + ((?= ?_) . ?\x3013) + ((?\( ?\') . ?\x3014) + ((?\) ?\') . ?\x3015) + ((?\( ?I) . ?\x3016) + ((?\) ?I) . ?\x3017) + ((?- ??) . ?\x301c) + ((?A ?5) . ?\x3041) + ((?a ?5) . ?\x3042) + ((?I ?5) . ?\x3043) + ((?i ?5) . ?\x3044) + ((?U ?5) . ?\x3045) + ((?u ?5) . ?\x3046) + ((?E ?5) . ?\x3047) + ((?e ?5) . ?\x3048) + ((?O ?5) . ?\x3049) + ((?o ?5) . ?\x304a) + ((?k ?a) . ?\x304b) + ((?g ?a) . ?\x304c) + ((?k ?i) . ?\x304d) + ((?g ?i) . ?\x304e) + ((?k ?u) . ?\x304f) + ((?g ?u) . ?\x3050) + ((?k ?e) . ?\x3051) + ((?g ?e) . ?\x3052) + ((?k ?o) . ?\x3053) + ((?g ?o) . ?\x3054) + ((?s ?a) . ?\x3055) + ((?z ?a) . ?\x3056) + ((?s ?i) . ?\x3057) + ((?z ?i) . ?\x3058) + ((?s ?u) . ?\x3059) + ((?z ?u) . ?\x305a) + ((?s ?e) . ?\x305b) + ((?z ?e) . ?\x305c) + ((?s ?o) . ?\x305d) + ((?z ?o) . ?\x305e) + ((?t ?a) . ?\x305f) + ((?d ?a) . ?\x3060) + ((?t ?i) . ?\x3061) + ((?d ?i) . ?\x3062) + ((?t ?U) . ?\x3063) + ((?t ?u) . ?\x3064) + ((?d ?u) . ?\x3065) + ((?t ?e) . ?\x3066) + ((?d ?e) . ?\x3067) + ((?t ?o) . ?\x3068) + ((?d ?o) . ?\x3069) + ((?n ?a) . ?\x306a) + ((?n ?i) . ?\x306b) + ((?n ?u) . ?\x306c) + ((?n ?e) . ?\x306d) + ((?n ?o) . ?\x306e) + ((?h ?a) . ?\x306f) + ((?b ?a) . ?\x3070) + ((?p ?a) . ?\x3071) + ((?h ?i) . ?\x3072) + ((?b ?i) . ?\x3073) + ((?p ?i) . ?\x3074) + ((?h ?u) . ?\x3075) + ((?b ?u) . ?\x3076) + ((?p ?u) . ?\x3077) + ((?h ?e) . ?\x3078) + ((?b ?e) . ?\x3079) + ((?p ?e) . ?\x307a) + ((?h ?o) . ?\x307b) + ((?b ?o) . ?\x307c) + ((?p ?o) . ?\x307d) + ((?m ?a) . ?\x307e) + ((?m ?i) . ?\x307f) + ((?m ?u) . ?\x3080) + ((?m ?e) . ?\x3081) + ((?m ?o) . ?\x3082) + ((?y ?A) . ?\x3083) + ((?y ?a) . ?\x3084) + ((?y ?U) . ?\x3085) + ((?y ?u) . ?\x3086) + ((?y ?O) . ?\x3087) + ((?y ?o) . ?\x3088) + ((?r ?a) . ?\x3089) + ((?r ?i) . ?\x308a) + ((?r ?u) . ?\x308b) + ((?r ?e) . ?\x308c) + ((?r ?o) . ?\x308d) + ((?w ?A) . ?\x308e) + ((?w ?a) . ?\x308f) + ((?w ?i) . ?\x3090) + ((?w ?e) . ?\x3091) + ((?w ?o) . ?\x3092) + ((?n ?5) . ?\x3093) + ((?v ?u) . ?\x3094) + ((?\" ?5) . ?\x309b) + ((?0 ?5) . ?\x309c) + ((?* ?5) . ?\x309d) + ((?+ ?5) . ?\x309e) + ((?a ?6) . ?\x30a1) + ((?A ?6) . ?\x30a2) + ((?i ?6) . ?\x30a3) + ((?I ?6) . ?\x30a4) + ((?u ?6) . ?\x30a5) + ((?U ?6) . ?\x30a6) + ((?e ?6) . ?\x30a7) + ((?E ?6) . ?\x30a8) + ((?o ?6) . ?\x30a9) + ((?O ?6) . ?\x30aa) + ((?K ?a) . ?\x30ab) + ((?G ?a) . ?\x30ac) + ((?K ?i) . ?\x30ad) + ((?G ?i) . ?\x30ae) + ((?K ?u) . ?\x30af) + ((?G ?u) . ?\x30b0) + ((?K ?e) . ?\x30b1) + ((?G ?e) . ?\x30b2) + ((?K ?o) . ?\x30b3) + ((?G ?o) . ?\x30b4) + ((?S ?a) . ?\x30b5) + ((?Z ?a) . ?\x30b6) + ((?S ?i) . ?\x30b7) + ((?Z ?i) . ?\x30b8) + ((?S ?u) . ?\x30b9) + ((?Z ?u) . ?\x30ba) + ((?S ?e) . ?\x30bb) + ((?Z ?e) . ?\x30bc) + ((?S ?o) . ?\x30bd) + ((?Z ?o) . ?\x30be) + ((?T ?a) . ?\x30bf) + ((?D ?a) . ?\x30c0) + ((?T ?i) . ?\x30c1) + ((?D ?i) . ?\x30c2) + ((?T ?U) . ?\x30c3) + ((?T ?u) . ?\x30c4) + ((?D ?u) . ?\x30c5) + ((?T ?e) . ?\x30c6) + ((?D ?e) . ?\x30c7) + ((?T ?o) . ?\x30c8) + ((?D ?o) . ?\x30c9) + ((?N ?a) . ?\x30ca) + ((?N ?i) . ?\x30cb) + ((?N ?u) . ?\x30cc) + ((?N ?e) . ?\x30cd) + ((?N ?o) . ?\x30ce) + ((?H ?a) . ?\x30cf) + ((?B ?a) . ?\x30d0) + ((?P ?a) . ?\x30d1) + ((?H ?i) . ?\x30d2) + ((?B ?i) . ?\x30d3) + ((?P ?i) . ?\x30d4) + ((?H ?u) . ?\x30d5) + ((?B ?u) . ?\x30d6) + ((?P ?u) . ?\x30d7) + ((?H ?e) . ?\x30d8) + ((?B ?e) . ?\x30d9) + ((?P ?e) . ?\x30da) + ((?H ?o) . ?\x30db) + ((?B ?o) . ?\x30dc) + ((?P ?o) . ?\x30dd) + ((?M ?a) . ?\x30de) + ((?M ?i) . ?\x30df) + ((?M ?u) . ?\x30e0) + ((?M ?e) . ?\x30e1) + ((?M ?o) . ?\x30e2) + ((?Y ?A) . ?\x30e3) + ((?Y ?a) . ?\x30e4) + ((?Y ?U) . ?\x30e5) + ((?Y ?u) . ?\x30e6) + ((?Y ?O) . ?\x30e7) + ((?Y ?o) . ?\x30e8) + ((?R ?a) . ?\x30e9) + ((?R ?i) . ?\x30ea) + ((?R ?u) . ?\x30eb) + ((?R ?e) . ?\x30ec) + ((?R ?o) . ?\x30ed) + ((?W ?A) . ?\x30ee) + ((?W ?a) . ?\x30ef) + ((?W ?i) . ?\x30f0) + ((?W ?e) . ?\x30f1) + ((?W ?o) . ?\x30f2) + ((?N ?6) . ?\x30f3) + ((?V ?u) . ?\x30f4) + ((?K ?A) . ?\x30f5) + ((?K ?E) . ?\x30f6) + ((?V ?a) . ?\x30f7) + ((?V ?i) . ?\x30f8) + ((?V ?e) . ?\x30f9) + ((?V ?o) . ?\x30fa) + ((?. ?6) . ?\x30fb) + ((?- ?6) . ?\x30fc) + ((?* ?6) . ?\x30fd) + ((?+ ?6) . ?\x30fe) + ((?b ?4) . ?\x3105) + ((?p ?4) . ?\x3106) + ((?m ?4) . ?\x3107) + ((?f ?4) . ?\x3108) + ((?d ?4) . ?\x3109) + ((?t ?4) . ?\x310a) + ((?n ?4) . ?\x310b) + ((?l ?4) . ?\x310c) + ((?g ?4) . ?\x310d) + ((?k ?4) . ?\x310e) + ((?h ?4) . ?\x310f) + ((?j ?4) . ?\x3110) + ((?q ?4) . ?\x3111) + ((?x ?4) . ?\x3112) + ((?z ?h) . ?\x3113) + ((?c ?h) . ?\x3114) + ((?s ?h) . ?\x3115) + ((?r ?4) . ?\x3116) + ((?z ?4) . ?\x3117) + ((?c ?4) . ?\x3118) + ((?s ?4) . ?\x3119) + ((?a ?4) . ?\x311a) + ((?o ?4) . ?\x311b) + ((?e ?4) . ?\x311c) + ((?a ?i) . ?\x311e) + ((?e ?i) . ?\x311f) + ((?a ?u) . ?\x3120) + ((?o ?u) . ?\x3121) + ((?a ?n) . ?\x3122) + ((?e ?n) . ?\x3123) + ((?a ?N) . ?\x3124) + ((?e ?N) . ?\x3125) + ((?e ?r) . ?\x3126) + ((?i ?4) . ?\x3127) + ((?u ?4) . ?\x3128) + ((?i ?u) . ?\x3129) + ((?v ?4) . ?\x312a) + ((?n ?G) . ?\x312b) + ((?g ?n) . ?\x312c) + ((?1 ?c) . ?\x3220) + ((?2 ?c) . ?\x3221) + ((?3 ?c) . ?\x3222) + ((?4 ?c) . ?\x3223) + ((?5 ?c) . ?\x3224) + ((?6 ?c) . ?\x3225) + ((?7 ?c) . ?\x3226) + ((?8 ?c) . ?\x3227) + ((?9 ?c) . ?\x3228) + ((?\s ?\s) . ?\xe000) + ((?/ ?c) . ?\xe001) + ((?U ?A) . ?\xe002) + ((?U ?B) . ?\xe003) + ((?\" ?3) . ?\xe004) + ((?\" ?1) . ?\xe005) + ((?\" ?!) . ?\xe006) + ((?\" ?\') . ?\xe007) + ((?\" ?>) . ?\xe008) + ((?\" ??) . ?\xe009) + ((?\" ?-) . ?\xe00a) + ((?\" ?\() . ?\xe00b) + ((?\" ?.) . ?\xe00c) + ((?\" ?:) . ?\xe00d) + ((?\" ?0) . ?\xe00e) + ((?\" ?\") . ?\xe00f) + ((?\" ?<) . ?\xe010) + ((?\" ?,) . ?\xe011) + ((?\" ?\;) . ?\xe012) + ((?\" ?_) . ?\xe013) + ((?\" ?=) . ?\xe014) + ((?\" ?/) . ?\xe015) + ((?\" ?i) . ?\xe016) + ((?\" ?d) . ?\xe017) + ((?\" ?p) . ?\xe018) + ((?\; ?\;) . ?\xe019) + ((?, ?,) . ?\xe01a) + ((?b ?3) . ?\xe01b) + ((?C ?i) . ?\xe01c) + ((?f ?\() . ?\xe01d) + ((?e ?d) . ?\xe01e) + ((?a ?m) . ?\xe01f) + ((?p ?m) . ?\xe020) + ((?F ?l) . ?\xe023) + ((?G ?F) . ?\xe024) + ((?> ?V) . ?\xe025) + ((?! ?*) . ?\xe026) + ((?? ?*) . ?\xe027) + ((?J ?<) . ?\xe028) + ((?f ?f) . ?\xfb00) + ((?f ?i) . ?\xfb01) + ((?f ?l) . ?\xfb02) + ((?f ?t) . ?\xfb05) + ((?s ?t) . ?\xfb06)) + "Table of digraphs defined in RFC 1345. +An element is a cons cell of a digraph and its character replacement, +where the digraph is a list of two characters. +See also `evil-digraphs-table-user'.") + +(defun evil-digraph (digraph) + "Convert DIGRAPH to character or list representation. +If DIGRAPH is a list (CHAR1 CHAR2), return the corresponding character; +if DIGRAPH is a character, return the corresponding list. +Searches in `evil-digraphs-table-user' and `evil-digraphs-table'." + (if (listp digraph) + (let* ((char1 (car digraph)) + (char2 (cadr digraph))) + (or (cdr (assoc (list char1 char2) evil-digraphs-table-user)) + (cdr (assoc (list char1 char2) evil-digraphs-table)) + (unless (eq char1 char2) + (or (cdr (assoc (list char2 char1) evil-digraphs-table-user)) + (cdr (assoc (list char2 char1) evil-digraphs-table)))))) + (or (car (rassoc digraph evil-digraphs-table-user)) + (car (rassoc digraph evil-digraphs-table))))) + +(provide 'evil-digraphs) + +;;; evil-digraphs.el ends here diff --git a/evil-insert.el b/evil-insert.el new file mode 100644 index 0000000..2b5dc22 --- /dev/null +++ b/evil-insert.el @@ -0,0 +1,294 @@ +;;;; Insert state + +(require 'evil-undo) +(require 'evil-states) +(require 'evil-repeat) +(require 'evil-visual) +(require 'evil-digraphs) + +(evil-define-state insert + "Insert state." + :tag " <I> " + :cursor (bar . 2) + :message "-- INSERT --" + :exit-hook (evil-cleanup-insert-state) + (cond + ((evil-insert-state-p) + (add-hook 'pre-command-hook 'evil-insert-repeat-hook nil t) + (unless evil-want-fine-undo + (evil-start-undo-step))) + (t + (remove-hook 'pre-command-hook 'evil-insert-repeat-hook t) + (setq evil-insert-repeat-info evil-repeat-info) + (evil-set-marker ?^ nil t) + (unless evil-want-fine-undo + (evil-end-undo-step)) + (when evil-move-cursor-back + (evil-adjust))))) + +(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 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)) + (evil-execute-repeat-info (cdr evil-insert-repeat-info)))) + (when evil-insert-vcount + (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)) + (if (numberp col) + (move-to-column col t) + (funcall col)) + (dotimes (i (or evil-insert-count 1)) + (evil-execute-repeat-info + (cdr evil-insert-repeat-info)))))))) + +(defun evil-insert (count &optional vcount) + "Switch to Insert state just before point. +The insertion will be repeated COUNT times and repeated once for +the next VCOUNT-1 lines starting at the same column." + (interactive + (list (prefix-numeric-value current-prefix-arg) + (when (evil-visual-state-p) + (if (eq (evil-visual-type) 'block) + (evil-visual-block-rotate 'upper-left) + (goto-char (evil-visual-beginning))) + (when (eq (evil-visual-type) 'block) + (count-lines (evil-visual-beginning) + (evil-visual-end)))))) + (setq evil-insert-count count + evil-insert-lines nil + evil-insert-vcount (and vcount + (> vcount 1) + (list (line-number-at-pos) + (current-column) + vcount))) + (evil-insert-state 1)) + +(defun evil-append (count &optional vcount) + "Switch to Insert state just after point. +The insertion will be repeated COUNT times." + (interactive + (list (prefix-numeric-value current-prefix-arg) + (when (evil-visual-state-p) + (if (eq (evil-visual-type) 'block) + ;; go to upper-left corner first so that + ;; `count-lines' yields accurate results + (evil-visual-block-rotate 'upper-left) + (goto-char (evil-visual-end))) + (when (eq (evil-visual-type) 'block) + (prog1 (count-lines (evil-visual-beginning) + (evil-visual-end)) + (evil-visual-block-rotate 'upper-right)))))) + (unless (or (eolp) (evil-visual-state-p)) + (forward-char)) + (evil-insert count vcount)) + +(defun evil-insert-resume (count) + "Switch to Insert state at previous insertion point." + (interactive "p") + (when (evil-get-marker ?^) + (goto-char (evil-get-marker ?^))) + (evil-insert count)) + +(defun evil-insert-newline-above () + "Inserts a new line above point and places point in that line +w.r.t. indentation." + (beginning-of-line) + (newline) + (forward-line -1) + (back-to-indentation)) + +(defun evil-insert-newline-below () + "Inserts a new line below point and places point in that line +w.r.t. indentation." + (end-of-line) + (newline) + (back-to-indentation)) + +(defun evil-open-above (count) + "Insert a new line above point and switch to Insert state. +The insertion will be repeated COUNT times." + (interactive "p") + (evil-insert-newline-above) + (setq evil-insert-count count + evil-insert-lines t + evil-insert-vcount nil) + (when evil-auto-indent + (indent-according-to-mode)) + (evil-insert-state 1)) + +(defun evil-open-below (count) + "Insert a new line below point and switch to Insert state. +The insertion will be repeated COUNT times." + (interactive "p") + (evil-insert-newline-below) + (setq evil-insert-count count + evil-insert-lines t + evil-insert-vcount nil) + (when evil-auto-indent + (indent-according-to-mode)) + (evil-insert-state 1)) + +(defun evil-insert-line (count &optional vcount) + "Switch to Insert state just before the first non-blank character +on the current line. The insertion will be repeated COUNT times." + (interactive "p") + (if evil-auto-indent + (back-to-indentation) + (beginning-of-line)) + (setq evil-insert-count count + evil-insert-lines nil + evil-insert-vcount (and vcount + (> vcount 1) + (list (line-number-at-pos) + #'evil-first-non-blank + vcount))) + (evil-insert-state 1)) + +(defun evil-append-line (count &optional vcount) + "Switch to Insert state at the end of the current line. +The insertion will be repeated COUNT times." + (interactive "p") + (end-of-line) + (setq evil-insert-count count + evil-insert-lines nil + evil-insert-vcount (and vcount + (> vcount 1) + (list (line-number-at-pos) + #'end-of-line + vcount))) + (evil-insert-state 1)) + +(defun evil-insert-digraph (count digraph) + "Insert the digraph DIGRAPH. +The insertion is repeated COUNT times." + (interactive + (let (count char1 char2 overlay string) + (unwind-protect + (progn + (setq count (prefix-numeric-value current-prefix-arg) + overlay (make-overlay (point) (point))) + ;; create overlay prompt + (setq string "?") + (put-text-property 0 1 'face 'minibuffer-prompt string) + ;; put cursor at (i.e., right before) the prompt + (put-text-property 0 1 'cursor t string) + (overlay-put overlay 'after-string string) + (setq char1 (read-key)) + (setq string (string char1)) + (put-text-property 0 1 'face 'minibuffer-prompt string) + (put-text-property 0 1 'cursor t string) + (overlay-put overlay 'after-string string) + (setq char2 (read-key))) + (delete-overlay overlay)) + (list count (list char1 char2)))) + (let ((digraph (or (evil-digraph digraph) + ;; use the last character if undefined + (cadr digraph)))) + (dotimes (var count) + (insert digraph)))) + +(defun evil-execute-in-normal-state () + "Execute the next command in Normal state." + (interactive) + (evil-normal-state) + (if (eq this-command 'evil-execute-in-normal-state) + (add-hook 'post-command-hook + 'evil-execute-in-normal-state nil t) + (remove-hook 'post-command-hook + 'evil-execute-in-normal-state t) + (evil-insert-state))) + +(defun evil-copy-from-above (arg) + "Copy characters from preceding non-blank line. +The copied text is inserted before point. +ARG is the number of lines to move backward." + (interactive + (cond + ;; if a prefix argument was given, repeat it for subsequent calls + ((and (null current-prefix-arg) + (eq last-command 'evil-copy-from-above)) + (setq current-prefix-arg last-prefix-arg) + (list (prefix-numeric-value current-prefix-arg))) + (t + (list (prefix-numeric-value current-prefix-arg))))) + (insert (evil-copy-chars-from-line 1 (- arg)))) + +(defun evil-copy-from-below (arg) + "Copy characters from following non-blank line. +The copied text is inserted before point. +ARG is the number of lines to move forward." + (interactive + (cond + ((and (null current-prefix-arg) + (eq last-command 'evil-copy-from-below)) + (setq current-prefix-arg last-prefix-arg) + (list (prefix-numeric-value current-prefix-arg))) + (t + (list (prefix-numeric-value current-prefix-arg))))) + (insert (evil-copy-chars-from-line 1 arg))) + +;; adapted from `copy-from-above-command' in misc.el +(defun evil-copy-chars-from-line (n num &optional col) + "Return N characters from line NUM, starting at column COL. +NUM is relative to the current line and can be negative. +COL defaults to the current column." + (interactive "p") + (let ((col (or col (current-column))) prefix) + (save-excursion + (forward-line num) + (when (looking-at "[[:space:]]*$") + (if (< num 0) + (skip-chars-backward " \t\n") + (skip-chars-forward " \t\n"))) + (beginning-of-line) + (move-to-column col) + ;; if the column winds up in middle of a tab, + ;; return the appropriate number of spaces + (when (< col (current-column)) + (if (eq (preceding-char) ?\t) + (let ((len (min n (- (current-column) col)))) + (setq prefix (make-string len ?\s) + n (- n len))) + ;; if in middle of a control char, return the whole char + (backward-char 1))) + (concat prefix + (buffer-substring (point) + (min (line-end-position) + (+ n (point)))))))) + +;;; Completion + +(evil-define-command evil-complete () + "Complete to the nearest preceding word. +Search forward if a match isn't found." + :repeat change + (interactive) + (if (minibufferp) + (minibuffer-complete) + (dabbrev-expand nil))) + +(evil-define-command evil-complete-line (&optional arg) + "Complete a whole line." + :repeat change + (interactive "P") + (let ((hippie-expand-try-functions-list + '(try-expand-line + try-expand-line-all-buffers))) + (hippie-expand arg))) + +(provide 'evil-insert) + +;;; evil-insert.el ends here diff --git a/evil-integration.el b/evil-integration.el new file mode 100644 index 0000000..bbf5d58 --- /dev/null +++ b/evil-integration.el @@ -0,0 +1,111 @@ +;;;; Integrate Evil with other modules + +(require 'evil-states) +(require 'evil-motions) + +(dolist (cmd evil-motions) + (evil-add-command-properties cmd :keep-visual t :repeat nil)) + +(dolist (cmd '(save-buffer)) + (evil-add-command-properties cmd :repeat nil)) + +(dolist (cmd '(dabbrev-expand hippie-expand)) + (evil-add-command-properties cmd :repeat 'change)) + +;;; Apropos + +(add-to-list 'evil-motion-state-modes 'apropos-mode) + +;;; Buffer-menu + +(add-to-list 'evil-motion-state-modes 'Buffer-menu-mode) +(eval-after-load "buff-menu" + '(evil-define-key 'motion Buffer-menu-mode-map (kbd "RET") + 'Buffer-menu-this-window)) + +;;; Custom + +(add-to-list 'evil-emacs-state-modes 'Custom-mode) + +;;; Debugger + +(add-to-list 'evil-emacs-state-modes 'debugger-mode) + +;;; Dired + +(add-to-list 'evil-emacs-state-modes 'dired-mode) + +;;; ERT + +(add-to-list 'evil-emacs-state-modes 'ert-results-mode) + +;;; Help + +(add-to-list 'evil-motion-state-modes 'help-mode) + +;;; Info + +(add-to-list 'evil-motion-state-modes 'Info-mode) +(eval-after-load 'info + '(progn + (evil-define-key 'motion Info-mode-map "\C-t" + 'Info-history-back) ; l + (evil-define-key 'motion Info-mode-map "\C-o" + 'Info-history-back) + (evil-define-key 'motion Info-mode-map (kbd "\M-h") + 'Info-help) ; h + (evil-define-key 'motion Info-mode-map " " + 'Info-scroll-up) + (evil-define-key 'motion Info-mode-map (kbd "RET") + 'Info-follow-nearest-node) + (evil-define-key 'motion Info-mode-map "\C-]" + 'Info-follow-nearest-node) + (evil-define-key 'motion Info-mode-map [backspace] + 'Info-scroll-down))) + +;;; Undo tree visualizer + +(add-to-list 'evil-motion-state-modes 'undo-tree-visualizer-mode) + +(when (boundp 'undo-tree-visualizer-map) + (define-key undo-tree-visualizer-map [remap evil-backward-char] + 'undo-tree-visualize-switch-branch-left) + (define-key undo-tree-visualizer-map [remap evil-forward-char] + 'undo-tree-visualize-switch-branch-right) + (define-key undo-tree-visualizer-map [remap evil-next-line] + 'undo-tree-visualize-redo) + (define-key undo-tree-visualizer-map [remap evil-previous-line] + 'undo-tree-visualize-undo)) + +(defadvice show-paren-function (around evil) + "Match parentheses in Normal state." + (if (or (evil-insert-state-p) + (evil-replace-state-p) + (evil-emacs-state-p)) + ad-do-it + (let ((pos (point)) syntax) + (setq pos + (catch 'end + (dotimes (var (1+ (* 2 evil-show-paren-range))) + (if (evenp var) + (setq pos (+ pos var)) + (setq pos (- pos var))) + (setq syntax (syntax-class (syntax-after pos))) + (cond + ((eq syntax 4) + (throw 'end pos)) + ((eq syntax 5) + (throw 'end (1+ pos))))))) + (if pos + (save-excursion + (goto-char pos) + ad-do-it) + ;; prevent the preceding pair from being highlighted + (when (overlayp show-paren-overlay) + (delete-overlay show-paren-overlay)) + (when (overlayp show-paren-overlay-1) + (delete-overlay show-paren-overlay-1)))))) + +(provide 'evil-integration) + +;;; evil-integration.el ends here diff --git a/evil-maps.el b/evil-maps.el new file mode 100644 index 0000000..9f7d645 --- /dev/null +++ b/evil-maps.el @@ -0,0 +1,296 @@ +;;;; Default keymaps + +(require 'evil-states) +(require 'evil-visual) +(require 'evil-motions) +(require 'evil-insert) +(require 'evil-operators) +(require 'evil-replace) + +;;; Normal state + +(define-key evil-normal-state-map "a" 'evil-append) +(define-key evil-normal-state-map "A" 'evil-append-line) +(define-key evil-normal-state-map "c" 'evil-change) +(define-key evil-normal-state-map "C" 'evil-change-line) +(define-key evil-normal-state-map "d" 'evil-delete) +(define-key evil-normal-state-map "D" 'evil-delete-line) +(define-key evil-normal-state-map "i" 'evil-insert) +(define-key evil-normal-state-map "I" 'evil-insert-line) +(define-key evil-normal-state-map "J" 'evil-join) +(define-key evil-normal-state-map "m" 'evil-set-marker) +(define-key evil-normal-state-map "o" 'evil-open-below) +(define-key evil-normal-state-map "O" 'evil-open-above) +(define-key evil-normal-state-map "p" 'evil-paste-after) +(define-key evil-normal-state-map "P" 'evil-paste-before) +(define-key evil-normal-state-map "q" 'evil-record-macro) +(define-key evil-normal-state-map "r" 'evil-replace) +(define-key evil-normal-state-map "R" 'evil-replace-state) +(define-key evil-normal-state-map "s" 'evil-substitute) +(define-key evil-normal-state-map "v" 'evil-visual-char) +(define-key evil-normal-state-map "V" 'evil-visual-line) +(define-key evil-normal-state-map "x" 'evil-delete-char) +(define-key evil-normal-state-map "X" 'evil-delete-backward-char) +(define-key evil-normal-state-map "y" 'evil-yank) +(define-key evil-normal-state-map "Y" 'evil-yank-line) +(define-key evil-normal-state-map "g8" 'what-cursor-position) +(define-key evil-normal-state-map "ga" 'what-cursor-position) +(define-key evil-normal-state-map "gi" 'evil-insert-resume) +(define-key evil-normal-state-map "gJ" 'evil-join-whitespace) +(define-key evil-normal-state-map "gq" 'evil-fill) +(define-key evil-normal-state-map "gu" 'evil-downcase) +(define-key evil-normal-state-map "gU" 'evil-upcase) +(define-key evil-normal-state-map "gv" 'evil-visual-restore) +(define-key evil-normal-state-map "g?" 'evil-rot13) +(define-key evil-normal-state-map "g~" 'evil-invert-case) +(define-key evil-normal-state-map "\C-n" 'evil-paste-pop-next) +(define-key evil-normal-state-map "\C-p" 'evil-paste-pop) +(define-key evil-normal-state-map "\C-t" 'pop-tag-mark) +(define-key evil-normal-state-map "\C-v" 'evil-visual-block) +(define-key evil-normal-state-map "\C-w" 'evil-window-map) +(define-key evil-normal-state-map (kbd "C-.") 'evil-repeat-pop) +(define-key evil-normal-state-map (kbd "M-.") 'evil-repeat-pop-next) +(define-key evil-normal-state-map "." 'evil-repeat) +(define-key evil-normal-state-map "@" 'evil-execute-macro) +(define-key evil-normal-state-map "\"" 'evil-use-register) +(define-key evil-normal-state-map "~" 'evil-invert-char) +(define-key evil-normal-state-map "=" 'evil-indent) +(define-key evil-normal-state-map "<" 'evil-shift-left) +(define-key evil-normal-state-map ">" 'evil-shift-right) +(define-key evil-normal-state-map (kbd "<backspace>") 'evil-backward-char) +(define-key evil-normal-state-map (kbd "ESC") 'evil-normal-state) +(define-key evil-normal-state-map [remap cua-paste-pop] 'evil-paste-pop) +(define-key evil-normal-state-map [remap yank-pop] 'evil-paste-pop) + +;; undo +(define-key evil-normal-state-map "u" 'undo) + +(when (fboundp 'undo-tree-undo) + (define-key evil-normal-state-map "u" 'undo-tree-undo) + (define-key evil-normal-state-map "\C-r" 'undo-tree-redo)) + +;; window commands +(define-prefix-command 'evil-window-map) +(define-key evil-window-map "b" 'evil-window-bottom-right) +(define-key evil-window-map "c" 'delete-window) +(define-key evil-window-map "h" 'evil-window-left) +(define-key evil-window-map "H" 'evil-window-move-far-left) +(define-key evil-window-map "j" 'evil-window-down) +(define-key evil-window-map "J" 'evil-window-move-very-bottom) +(define-key evil-window-map "k" 'evil-window-up) +(define-key evil-window-map "K" 'evil-window-move-very-top) +(define-key evil-window-map "l" 'evil-window-right) +(define-key evil-window-map "L" 'evil-window-move-far-right) +(define-key evil-window-map "n" 'evil-window-new) +(define-key evil-window-map "o" 'delete-other-windows) +(define-key evil-window-map "p" 'evil-window-lru) +(define-key evil-window-map "r" 'evil-window-rotate-downwards) +(define-key evil-window-map "R" 'evil-window-rotate-upwards) +(define-key evil-window-map "s" 'split-window-vertically) +(define-key evil-window-map "S" 'split-window-vertically) +(define-key evil-window-map "t" 'evil-window-top-left) +(define-key evil-window-map "v" 'split-window-horizontally) +(define-key evil-window-map "w" 'evil-window-next) +(define-key evil-window-map "W" 'evil-window-prev) +(define-key evil-window-map "+" 'evil-window-increase-height) +(define-key evil-window-map "-" 'evil-window-decrease-height) +(define-key evil-window-map "_" 'evil-window-set-height) +(define-key evil-window-map "<" 'evil-window-decrease-width) +(define-key evil-window-map ">" 'evil-window-increase-width) +(define-key evil-window-map "=" 'balance-windows) +(define-key evil-window-map "|" 'evil-window-set-width) +(define-key evil-window-map "\C-b" 'evil-window-bottom-right) +(define-key evil-window-map "\C-c" 'delete-window) +(define-key evil-window-map "\C-h" 'evil-window-left) +(define-key evil-window-map "\C-H" 'evil-window-move-far-left) +(define-key evil-window-map "\C-j" 'evil-window-down) +(define-key evil-window-map "\C-J" 'evil-window-move-very-bottom) +(define-key evil-window-map "\C-k" 'evil-window-up) +(define-key evil-window-map "\C-K" 'evil-window-move-very-top) +(define-key evil-window-map "\C-l" 'evil-window-right) +(define-key evil-window-map "\C-L" 'evil-window-move-far-right) +(define-key evil-window-map "\C-n" 'evil-window-new) +(define-key evil-window-map "\C-o" 'delete-other-windows) +(define-key evil-window-map "\C-p" 'evil-window-lru) +(define-key evil-window-map "\C-r" 'evil-window-rotate-downwards) +(define-key evil-window-map "\C-R" 'evil-window-rotate-upwards) +(define-key evil-window-map "\C-s" 'split-window-vertically) +(define-key evil-window-map "\C-S" 'split-window-vertically) +(define-key evil-window-map "\C-t" 'evil-window-top-left) +(define-key evil-window-map "\C-v" 'split-window-horizontally) +(define-key evil-window-map "\C-w" 'evil-window-next) +(define-key evil-window-map "\C-W" 'evil-window-prev) +(define-key evil-window-map "\C-_" 'evil-window-set-height) + +;;; Motion state + +;; "0" is a special command when called first +(evil-redirect-digit-argument evil-motion-state-map "0" 'evil-beginning-of-line) +(define-key evil-motion-state-map "1" 'digit-argument) +(define-key evil-motion-state-map "2" 'digit-argument) +(define-key evil-motion-state-map "3" 'digit-argument) +(define-key evil-motion-state-map "4" 'digit-argument) +(define-key evil-motion-state-map "5" 'digit-argument) +(define-key evil-motion-state-map "6" 'digit-argument) +(define-key evil-motion-state-map "7" 'digit-argument) +(define-key evil-motion-state-map "8" 'digit-argument) +(define-key evil-motion-state-map "9" 'digit-argument) +(define-key evil-motion-state-map "b" 'evil-backward-word-begin) +(define-key evil-motion-state-map "B" 'evil-backward-WORD-begin) +(define-key evil-motion-state-map "e" 'evil-forward-word-end) +(define-key evil-motion-state-map "E" 'evil-forward-WORD-end) +(define-key evil-motion-state-map "f" 'evil-find-char) +(define-key evil-motion-state-map "F" 'evil-find-char-backward) +(define-key evil-motion-state-map "G" 'evil-goto-line) +(define-key evil-motion-state-map "h" 'evil-backward-char) +(define-key evil-motion-state-map "H" 'evil-window-top) +(define-key evil-motion-state-map "j" 'evil-next-line) +(define-key evil-motion-state-map "k" 'evil-previous-line) +(define-key evil-motion-state-map "l" 'evil-forward-char) +(define-key evil-motion-state-map "L" 'evil-window-bottom) +(define-key evil-motion-state-map "M" 'evil-window-middle) +(define-key evil-motion-state-map "n" 'evil-search-next) +(define-key evil-motion-state-map "N" 'evil-search-previous) +(define-key evil-motion-state-map "t" 'evil-find-char-to) +(define-key evil-motion-state-map "T" 'evil-find-char-to-backward) +(define-key evil-motion-state-map "w" 'evil-forward-word-begin) +(define-key evil-motion-state-map "W" 'evil-forward-WORD-begin) +(define-key evil-motion-state-map "gd" 'evil-goto-definition) +(define-key evil-motion-state-map "ge" 'evil-backward-word-end) +(define-key evil-motion-state-map "gE" 'evil-backward-WORD-end) +(define-key evil-motion-state-map "gg" 'evil-goto-first-line) +(define-key evil-motion-state-map "gj" 'evil-next-visual-line) +(define-key evil-motion-state-map "gk" 'evil-previous-visual-line) +(define-key evil-motion-state-map "g0" 'evil-beginning-of-visual-line) +(define-key evil-motion-state-map "g_" 'evil-last-non-blank) +(define-key evil-motion-state-map "g^" 'evil-first-non-blank-of-visual-line) +(define-key evil-motion-state-map "g$" 'evil-end-of-visual-line) +(define-key evil-motion-state-map "{" 'evil-backward-paragraph) +(define-key evil-motion-state-map "}" 'evil-forward-paragraph) +(define-key evil-motion-state-map "#" 'evil-search-symbol-backward) +(define-key evil-motion-state-map "$" 'evil-end-of-line) +(define-key evil-motion-state-map "%" 'evil-jump-item) +(define-key evil-motion-state-map "`" 'evil-goto-mark) +(define-key evil-motion-state-map "'" 'evil-goto-mark-line) +(define-key evil-motion-state-map "(" 'evil-backward-sentence) +(define-key evil-motion-state-map ")" 'evil-forward-sentence) +(define-key evil-motion-state-map "*" 'evil-search-symbol-forward) +(define-key evil-motion-state-map "," 'evil-repeat-find-char-reverse) +(define-key evil-motion-state-map "/" 'evil-search-forward) +(define-key evil-motion-state-map ";" 'evil-repeat-find-char) +(define-key evil-motion-state-map "?" 'evil-search-backward) +(define-key evil-motion-state-map "|" 'evil-goto-column) +(define-key evil-motion-state-map "^" 'evil-first-non-blank) +(define-key evil-motion-state-map "+" 'evil-next-line-first-non-blank) +(define-key evil-motion-state-map "_" 'evil-next-line-first-non-blank) +(define-key evil-motion-state-map "-" 'evil-previous-line-first-non-blank) +(define-key evil-motion-state-map "\C-]" 'evil-jump-to-tag) +(define-key evil-motion-state-map "aw" 'evil-a-word) +(define-key evil-motion-state-map "iw" 'evil-inner-word) +(define-key evil-motion-state-map "aW" 'evil-a-WORD) +(define-key evil-motion-state-map "iW" 'evil-inner-WORD) +(define-key evil-motion-state-map "as" 'evil-a-sentence) +(define-key evil-motion-state-map "is" 'evil-inner-sentence) +(define-key evil-motion-state-map "ap" 'evil-a-paragraph) +(define-key evil-motion-state-map "ip" 'evil-inner-paragraph) +(define-key evil-motion-state-map "ab" 'evil-a-paren) +(define-key evil-motion-state-map "a(" 'evil-a-paren) +(define-key evil-motion-state-map "a)" 'evil-a-paren) +(define-key evil-motion-state-map "ib" 'evil-inner-paren) +(define-key evil-motion-state-map "i(" 'evil-inner-paren) +(define-key evil-motion-state-map "i)" 'evil-inner-paren) +(define-key evil-motion-state-map "a[" 'evil-a-bracket) +(define-key evil-motion-state-map "a]" 'evil-a-bracket) +(define-key evil-motion-state-map "i[" 'evil-inner-bracket) +(define-key evil-motion-state-map "i]" 'evil-inner-bracket) +(define-key evil-motion-state-map "aB" 'evil-a-curly) +(define-key evil-motion-state-map "a{" 'evil-a-curly) +(define-key evil-motion-state-map "a}" 'evil-a-curly) +(define-key evil-motion-state-map "iB" 'evil-inner-curly) +(define-key evil-motion-state-map "i{" 'evil-inner-curly) +(define-key evil-motion-state-map "i}" 'evil-inner-curly) +(define-key evil-motion-state-map "a<" 'evil-an-angle) +(define-key evil-motion-state-map "a>" 'evil-an-angle) +(define-key evil-motion-state-map "i<" 'evil-inner-angle) +(define-key evil-motion-state-map "i>" 'evil-inner-angle) +(define-key evil-motion-state-map "a'" 'evil-a-single-quote) +(define-key evil-motion-state-map "i'" 'evil-inner-single-quote) +(define-key evil-motion-state-map "a\"" 'evil-a-double-quote) +(define-key evil-motion-state-map "i\"" 'evil-inner-double-quote) +(define-key evil-motion-state-map "a`" 'evil-a-back-quote) +(define-key evil-motion-state-map "i`" 'evil-inner-back-quote) +(define-key evil-motion-state-map "at" 'evil-a-tag) +(define-key evil-motion-state-map "it" 'evil-inner-tag) +(define-key evil-motion-state-map (kbd "C-b") 'evil-scroll-page-up) +(define-key evil-motion-state-map (kbd "C-d") 'evil-scroll-down) +(define-key evil-motion-state-map (kbd "C-e") 'evil-scroll-line-down) +(define-key evil-motion-state-map (kbd "C-f") 'evil-scroll-page-down) +(define-key evil-motion-state-map (kbd "C-o") 'evil-jump-backward) +(define-key evil-motion-state-map (kbd "C-y") 'evil-scroll-line-up) +(define-key evil-motion-state-map (kbd "C-z") 'evil-emacs-state) +(define-key evil-motion-state-map (kbd "RET") 'evil-ret) +(define-key evil-motion-state-map "z^" 'evil-scroll-top-line-to-bottom) +(define-key evil-motion-state-map "z+" 'evil-scroll-bottom-line-to-top) +(define-key evil-motion-state-map "zt" 'evil-scroll-line-to-top) +;; TODO: z RET has an advanced form taking an count before the RET +;; but this requires again a special state with a single command +;; bound to RET +(define-key evil-motion-state-map (vconcat "z" [return]) "zt^") +(define-key evil-motion-state-map (kbd "z RET") (vconcat "z" [return])) +(define-key evil-motion-state-map "zz" 'evil-scroll-line-to-center) +(define-key evil-motion-state-map "z." "zz^") +(define-key evil-motion-state-map "zb" 'evil-scroll-line-to-bottom) +(define-key evil-motion-state-map "z-" "zb^") + +(when evil-want-C-i-jump + (define-key evil-motion-state-map (kbd "C-i") 'evil-jump-forward)) + +(when evil-want-C-u-scroll + (define-key evil-motion-state-map (kbd "C-u") 'evil-scroll-up)) + +;;; Visual state + +(define-key evil-visual-state-map "A" 'evil-append) +(define-key evil-visual-state-map "C" 'evil-change) +(define-key evil-visual-state-map "D" 'evil-delete) +(define-key evil-visual-state-map "I" 'evil-insert) +(define-key evil-visual-state-map "o" 'exchange-point-and-mark) +(define-key evil-visual-state-map "O" 'evil-visual-exchange-corners) +(define-key evil-visual-state-map "R" 'evil-change) +(define-key evil-visual-state-map "S" 'evil-change) +(define-key evil-visual-state-map "u" 'evil-downcase) +(define-key evil-visual-state-map "U" 'evil-upcase) +(define-key evil-visual-state-map (kbd "ESC") 'evil-normal-state) + +;;; Insert state + +(define-key evil-insert-state-map "\C-k" 'evil-insert-digraph) +(define-key evil-insert-state-map "\C-o" 'evil-execute-in-normal-state) +(define-key evil-insert-state-map "\C-y" 'evil-copy-from-above) +(define-key evil-insert-state-map "\C-e" 'evil-copy-from-below) +(define-key evil-insert-state-map "\C-p" 'evil-complete) +(define-key evil-insert-state-map "\C-n" 'evil-complete) +(define-key evil-insert-state-map "\C-x\C-p" 'evil-complete-line) +(define-key evil-insert-state-map "\C-x\C-n" 'evil-complete-line) +(define-key evil-insert-state-map (kbd "RET") 'evil-ret) +(define-key evil-insert-state-map (kbd "ESC") 'evil-normal-state) + +;;; Replace state + +(define-key evil-replace-state-map [backspace] 'evil-replace-backspace) +(define-key evil-replace-state-map (kbd "ESC") 'evil-normal-state) + +;;; Emacs state + +(define-key evil-emacs-state-map "\C-z" 'evil-change-to-default-state) + +;;; Minibuffer + +(define-key minibuffer-local-map "\C-p" 'evil-complete) +(define-key minibuffer-local-map "\C-n" 'evil-complete) +(define-key minibuffer-local-map "\C-x\C-p" 'evil-complete) +(define-key minibuffer-local-map "\C-x\C-n" 'evil-complete) + +(provide 'evil-maps) + +;;; evil-maps.el ends here diff --git a/evil-motions.el b/evil-motions.el new file mode 100644 index 0000000..36bf78d --- /dev/null +++ b/evil-motions.el @@ -0,0 +1,1416 @@ +;;;; Motions + +(require 'evil-common) +(require 'evil-visual) +(require 'evil-operators) + +(evil-define-state motion + "Motion state" + :tag " <M> ") + +(defmacro evil-define-motion (motion args &rest body) + "Define an motion command MOTION. + +\(fn MOTION (COUNT ARGS...) DOC [[KEY VALUE]...] BODY...)" + (declare (indent defun) + (debug (&define name lambda-list + [&optional stringp] + [&rest keywordp sexp] + [&optional ("interactive" interactive)] + def-body))) + (let (arg doc interactive jump key keys type) + (when args + (setq args `(&optional ,@(delq '&optional args)) + interactive + ;; the count is either numerical or nil + '(list (when current-prefix-arg + (prefix-numeric-value + current-prefix-arg))))) + ;; collect docstring + (when (and (> (length body) 1) + (or (eq (car-safe (car-safe body)) 'format) + (stringp (car-safe body)))) + (setq doc (pop body))) + ;; collect keywords + (while (keywordp (car-safe body)) + (setq key (pop body) + arg (pop body)) + (cond + ((eq key :jump) + (setq jump arg)) + (t + (setq keys (append keys (list key arg)))))) + ;; collect `interactive' specification + (when (eq (car-safe (car-safe body)) 'interactive) + (setq interactive `(append ,interactive ,@(cdr (pop body))))) + ;; macro expansion + `(progn + ;; refresh echo area in Eldoc mode + (when ',motion + (eval-after-load 'eldoc + '(eldoc-add-command ',motion))) + (evil-define-command ,motion (,@args) + ,@(when doc `(,doc)) ; avoid nil before `interactive' + ,@keys + :keep-visual t + :repeat nil + (interactive + ,@(when (or jump interactive) + `((progn + ,(when jump + '(unless (or (evil-visual-state-p) + (evil-operator-state-p)) + (evil-set-jump))) + ,interactive)))) + ,@body)))) + +(defmacro evil-motion-loop (spec &rest body) + "Loop a certain number of times. +Evaluate BODY repeatedly COUNT times with VAR bound to 1 or -1, +depending on the sign of COUNT. RESULT, if specified, holds +the number of unsuccessful iterations, which is 0 if the loop +completes successfully. This is also the return value. + +Each iteration must move point; if point does not change, +the loop immediately quits. See also `evil-loop'. + +\(fn (VAR COUNT [RESULT]) BODY...)" + (declare (indent defun) + (debug ((symbolp form &optional symbolp) body))) + (let* ((var (or (pop spec) (make-symbol "unitvar"))) + (countval (or (pop spec) 0)) + (result (pop spec)) + (i (make-symbol "loopvar")) + (count (make-symbol "countvar")) + (done (make-symbol "donevar")) + (orig (make-symbol "origvar"))) + `(let* ((,count ,countval) + (,var (if (< ,count 0) -1 1))) + (catch ',done + (evil-loop (,i ,count ,result) + (let ((,orig (point))) + ,@body + (when (= (point) ,orig) + (throw ',done ,i)))))))) + +(defmacro evil-signal-without-movement (&rest body) + "Catches errors provided point moves within this scope." + (declare (indent defun) + (debug t)) + `(let ((p (point))) + (condition-case err + (progn ,@body) + (error + (when (= p (point)) + (signal (car err) (cdr err))))))) + +(defmacro evil-narrow-to-line (&rest body) + "Narrow to the current line." + (declare (indent defun) + (debug t)) + `(save-restriction + (narrow-to-region + (line-beginning-position) + (if (evil-normal-state-p) + (max (line-beginning-position) + (1- (line-end-position))) + (line-end-position))) + (evil-signal-without-movement + (condition-case nil + (progn ,@body) + (beginning-of-buffer + (error "Beginning of line")) + (end-of-buffer + (error "End of line")))))) + +(defun evil-goto-min (&rest positions) + "Go to the smallest position in POSITIONS. +Non-numerical elements are ignored. +See also `evil-goto-max'." + (when (setq positions (evil-filter-list + (lambda (elt) + (not (number-or-marker-p elt))) + positions)) + (goto-char (apply #'min positions)))) + +(defun evil-goto-max (&rest positions) + "Go to the largest position in POSITIONS. +Non-numerical elements are ignored. +See also `evil-goto-min'." + (when (setq positions (evil-filter-list + (lambda (elt) + (not (number-or-marker-p elt))) + positions)) + (goto-char (apply #'max positions)))) + +(defun evil-eobp () + "Whether point is at end-of-buffer w.r.t. end-of-line." + (or (eobp) + (and (not (evil-visual-state-p)) + (= (point) (1- (point-max))) + (not (eolp))))) + +(evil-define-motion evil-forward-char (count) + "Move cursor to the right by COUNT characters." + :type exclusive + (evil-narrow-to-line (forward-char (or count 1)))) + +(evil-define-motion evil-backward-char (count) + "Move cursor to the left by COUNT characters." + :type exclusive + (evil-narrow-to-line (backward-char (or count 1)))) + +;; The purpose of this function is the provide line motions which +;; preserve the column. This is how `previous-line' and `next-line' +;; work, but unfortunately the behaviour is hard-coded: if and only if +;; the last command was `previous-line' or `next-line', the column is +;; preserved. Furthermore, in contrast to Vim, when we cannot go +;; further, those motions move point to the beginning resp. the end of +;; the line (we never want point to leave its column). The code here +;; comes from simple.el, and I hope it will work in future. +(defun evil-line-move (count) + "A wrapper for line motions which conserves the column." + (evil-signal-without-movement + (setq this-command 'next-line) + (let ((opoint (point))) + (unwind-protect + (with-no-warnings + (next-line count)) + (cond + ((> count 0) + (line-move-finish (or goal-column temporary-goal-column) + opoint nil)) + ((< count 0) + (line-move-finish (or goal-column temporary-goal-column) + opoint t))))))) + +(evil-define-command evil-goto-mark (char) + "Go to marker denoted by CHAR." + :keep-visual t + :repeat nil + :type exclusive + (interactive (list (read-char))) + (let ((marker (evil-get-marker char))) + (cond + ((markerp marker) + (switch-to-buffer (marker-buffer marker)) + (goto-char (marker-position marker))) + ((numberp marker) + (goto-char marker)) + ((consp marker) + (when (or (find-buffer-visiting (car marker)) + (and (y-or-n-p (format "Visit file %s again? " + (car marker))) + (find-file (car marker)))) + (goto-char (cdr marker)))) + (t + (error "Marker `%c' is not set%s" char + (if (evil-global-marker-p char) "" + " in this buffer")))))) + +(evil-define-command evil-goto-mark-line (char) + "Go to line of marker denoted by CHAR." + :keep-visual t + :repeat nil + :type line + (interactive (list (read-char))) + (evil-goto-mark char) + (evil-first-non-blank)) + +(evil-define-motion evil-jump-backward (count) + "Go to older position in jump list. +To go the other way, press \ +\\<evil-motion-state-map>\\[evil-jump-forward]." + (let ((current-pos (make-marker)) + (count (or count 1)) i) + (unless evil-jump-list + (move-marker current-pos (point)) + (add-to-list 'evil-jump-list current-pos)) + (evil-motion-loop (nil count) + (setq current-pos (make-marker)) + ;; skip past duplicate entries in the mark ring + (setq i (length mark-ring)) + (while (progn (move-marker current-pos (point)) + (set-mark-command 0) + (setq i (1- i)) + (and (= (point) current-pos) (> i 0)))) + ;; Already there? + (move-marker current-pos (point)) + (unless (= current-pos (car-safe evil-jump-list)) + (add-to-list 'evil-jump-list current-pos))))) + +(evil-define-motion evil-jump-forward (count) + "Go to newer position in jump list. +To go the other way, press \ +\\<evil-motion-state-map>\\[evil-jump-backward]." + (let ((count (or count 1)) + current-pos next-pos) + (evil-motion-loop (nil count) + (setq current-pos (car-safe evil-jump-list) + next-pos (car (cdr-safe evil-jump-list))) + (when next-pos + (push-mark current-pos t nil) + (unless (eq (marker-buffer next-pos) (current-buffer)) + (switch-to-buffer (marker-buffer next-pos))) + (goto-char next-pos) + (pop evil-jump-list))))) + +(evil-define-motion evil-previous-line (count) + "Move the cursor COUNT lines up." + :type line + (let (line-move-visual) + (evil-line-move (- (or count 1))))) + +(evil-define-motion evil-next-line (count) + "Move the cursor COUNT lines down." + :type line + (let (line-move-visual) + (evil-line-move (or count 1)))) + +(evil-define-motion evil-ret (count) + "Move the cursor COUNT lines down. +If point is on a widget or a button, click on it. +In Insert state, insert a newline." + :type line + (let* ((field (get-char-property (point) 'field)) + (button (get-char-property (point) 'button)) + (doc (get-char-property (point) 'widget-doc)) + (widget (or field button doc))) + (cond + ((and widget + (fboundp 'widget-type) + (fboundp 'widget-button-press) + (or (and (symbolp widget) + (get widget 'widget-type)) + (and (consp widget) + (get (widget-type widget) 'widget-type)))) + (when (evil-operator-state-p) + (setq evil-inhibit-operator t)) + (widget-button-press (point))) + ((and (fboundp 'button-at) + (fboundp 'push-button) + (button-at (point))) + (when (evil-operator-state-p) + (setq evil-inhibit-operator t)) + (push-button)) + ((and (evil-insert-state-p) + (not buffer-read-only)) + (if (not evil-auto-indent) + (newline count) + (delete-horizontal-space t) + (newline count) + (indent-according-to-mode))) + (t + (evil-next-line count))))) + +;; used for repeated commands like "dd" +(evil-define-motion evil-line (count) + "Move COUNT - 1 lines down." + :type line + (let (line-move-visual) + (evil-line-move (1- (or count 1))))) + +(evil-define-motion evil-previous-visual-line (count) + "Move the cursor COUNT screen lines down." + :type exclusive + (let ((line-move-visual t)) + (evil-line-move (- (or count 1))))) + +(evil-define-motion evil-next-visual-line (count) + "Move the cursor COUNT screen lines up." + :type exclusive + (let ((line-move-visual t)) + (evil-line-move (or count 1)))) + +(evil-define-motion evil-window-top (count) + "Move the cursor to line COUNT from the top of the window +on the first non-blank character." + :jump t + :type line + (move-to-window-line (or count 0)) + (back-to-indentation)) + +(evil-define-motion evil-window-middle () + "Move the cursor to the middle line of the current window +on the first non-blank character." + :jump t + :type line + (move-to-window-line (/ (window-body-height) 2)) + (back-to-indentation)) + +(evil-define-motion evil-window-bottom (count) + "Move the cursor to line COUNT from the bottom of the window +on the first non-blank character." + :jump t + :type line + (move-to-window-line (- (or count 1))) + (back-to-indentation)) + +(evil-define-motion evil-beginning-of-line () + "Move the cursor to the beginning of the current line." + :type exclusive + (beginning-of-line)) + +(evil-define-motion evil-beginning-of-line-or-digit-argument () + "Move the cursor to the beginning of the current line. +This function passes its command to `digit-argument' (usually a 0) +if it is not the first event." + :type exclusive + (cond + (current-prefix-arg + (setq this-command 'digit-argument) + (call-interactively 'digit-argument)) + (t + (setq this-command 'evil-beginning-of-line) + (call-interactively 'evil-beginning-of-line)))) + +(evil-define-motion evil-first-non-blank () + "Move the cursor to the first non-blank character of the current line." + :type exclusive + (evil-narrow-to-line (back-to-indentation))) + +(evil-define-motion evil-end-of-line (count) + "Move the cursor to the end of the current line. +If COUNT is given, move COUNT - 1 lines downward first." + :type inclusive + (end-of-line count) + (unless (evil-visual-state-p) + (evil-adjust-eol) + (when (eolp) + ;; prevent "c$" and "d$" from deleting blank lines + (setq evil-this-type 'exclusive)))) + +(evil-define-motion evil-last-non-blank (count) + "Move the cursor to the last non-blank character of the current line. +If COUNT is given, move COUNT - 1 lines downward first." + :type inclusive + (goto-char + (save-excursion + (beginning-of-line count) + (if (re-search-forward "[ \t]*$") + (max (line-beginning-position) + (1- (match-beginning 0))) + (line-beginning-position))))) + +(evil-define-motion evil-previous-line-first-non-blank (count) + "Move the cursor COUNT lines up on the first non-blank character." + :type line + (evil-previous-line (or count 1)) + (evil-first-non-blank)) + +(evil-define-motion evil-next-line-first-non-blank (count) + "Move the cursor COUNT lines down on the first non-blank character." + :type line + (evil-next-line (or count 1)) + (evil-first-non-blank)) + +(evil-define-motion evil-goto-first-line (count) + "Go to the first non-blank character of line COUNT. +By default the first line." + :jump t + :type line + (evil-goto-line (or count 1))) + +(evil-define-motion evil-goto-line (count) + "Go to the first non-blank character of line COUNT. +By default the last line." + :jump t + :type line + (if (null count) + (goto-char (point-max)) + (goto-char (point-min)) + (forward-line (1- count))) + (evil-first-non-blank)) + +(evil-define-motion evil-beginning-of-visual-line () + "Move the cursor to the first character of the current screen line." + :type exclusive + (beginning-of-visual-line)) + +(evil-define-motion evil-first-non-blank-of-visual-line () + "Move the cursor to the first non blank character +of the current screen line." + :type exclusive + (evil-beginning-of-visual-line) + (skip-chars-forward " \t\r")) + +(evil-define-motion evil-end-of-visual-line (count) + "Move the cursor to the last character of the current screen line. +If COUNT is given, move COUNT - 1 screen lines downward first." + :type inclusive + (end-of-visual-line count) + (unless (evil-visual-state-p) + (evil-adjust-eol))) + +(evil-define-motion evil-jump-to-tag () + "Jump to tag under point." + :jump t + (let ((tag (thing-at-point 'word))) + (find-tag tag))) + +;;; Text object and movement framework + +;; Usual text objects like words, WORDS, paragraphs and sentences are +;; defined via a corresponding move-function. This function must have +;; the following properties: +;; +;; 1. Take exactly one argument, the count. +;; 2. When the count is positive, move point forward to the first +;; character after the end of the next count-th object. +;; 3. When the count is negative, move point backward to the first +;; character of the count-th previous object. +;; 4. If point is placed on the first character of an object, the +;; backward motion does NOT count that object. +;; 5. If point is placed on the last character of an object, the +;; forward motion DOES count that object. +;; 6. The return value is "count left", i.e., in forward direction +;; count is decreased by one for each successful move and in +;; backward direction count is increased by one for each +;; successful move, returning the final value of count. +;; Therefore, if the complete move is successful, the return +;; value is 0. +;; +;; A useful macro in this regard is `evil-motion-loop', which quits +;; when point does not move further and returns the count difference. +;; It also provides a "unit value" of 1 or -1 for use in each +;; iteration. For example, a hypothetical "foo-bar" move could be +;; written as such: +;; +;; (defun foo-bar (count) +;; (evil-motion-loop (var count) +;; (forward-foo var) ; `var' is 1 or -1 depending on COUNT +;; (forward-bar var))) +;; +;; If "forward-foo" and "-bar" didn't accept negative arguments, +;; we could choose their backward equivalents by inspecting `var': +;; +;; (defun foo-bar (count) +;; (evil-motion-loop (var count) +;; (cond +;; ((< var 0) +;; (backward-foo 1) +;; (backward-bar 1)) +;; (t +;; (forward-foo 1) +;; (forward-bar 1))))) +;; +;; After a forward motion, point has to be placed on the first +;; character after some object, unless no motion was possible at all. +;; Similarly, after a backward motion, point has to be placed on the +;; first character of some object. This implies that point should +;; NEVER be moved to eob or bob, unless an object ends or begins at +;; eob or bob. (Usually, Emacs motions always move as far as possible. +;; But we want to use the motion-function to identify certain objects +;; in the buffer, and thus exact movement to object boundaries is +;; required.) + +(defmacro evil-define-union-move (name args &rest moves) + "Create a movement function named NAME. +The function moves to the nearest object boundary defined by one +of the movement function in MOVES, which is a list where each +element has the form \(FUNC PARAMS... COUNT). + +COUNT is a variable which is bound to 1 or -1, depending on the +direction. In each iteration, the function calls each move in +isolation and settles for the nearest position. If unable to move +further, the return value is the number of iterations that could +not be performed. + +\(fn NAME (COUNT) MOVES...)" + (declare (indent defun) + (debug (&define name lambda-list + [&optional stringp] + def-body))) + (let* ((var (or (car-safe args) 'var)) + (doc (when (stringp (car-safe moves)) + (pop moves))) + (moves (mapcar #'(lambda (move) + `(save-excursion + ;; don't include failing moves + (when (zerop ,move) + (point)))) + moves))) + `(evil-define-motion ,name (count) + ,@(when doc `(,doc)) + (let (bounds) + (evil-motion-loop (,var (or count 1)) + (if (> , var 0) + (evil-goto-min ,@moves) + (evil-goto-max ,@moves))))))) + +(defun evil-move-chars (chars count) + "Move point to the end or beginning of a sequence of CHARS. +CHARS is a character set as inside [...] in a regular expression." + (let ((regexp (format "[%s]" chars))) + (evil-motion-loop (var count) + (cond + ((< var 0) + (re-search-backward regexp nil t) + (skip-chars-backward chars)) + (t + (re-search-forward regexp nil t) + (skip-chars-forward chars)))))) + +(defun evil-move-beginning (count forward &optional backward) + "Move to the beginning of the COUNT next object. +If COUNT is negative, move to the COUNT previous object. +FORWARD is a function which moves to the end of the object, and +BACKWARD is a function which moves to the beginning. +If one is unspecified, the other is used with a negative argument." + (let* ((count (or count 1)) + (backward (or backward + (lambda (count) + (funcall forward (- count))))) + (forward (or forward + (lambda (count) + (funcall backward (- count))))) + (opoint (point))) + (cond + ((< count 0) + (when (bobp) + (signal 'beginning-of-buffer nil)) + (unwind-protect + (evil-motion-loop (nil count count) + (funcall backward 1)) + (unless (zerop count) + (goto-char (point-min))))) + ((> count 0) + (when (evil-eobp) + (signal 'end-of-buffer nil)) + ;; Do we need to move past the current object? + (when (<= (save-excursion + (funcall forward 1) + (funcall backward 1) + (point)) + opoint) + (setq count (1+ count))) + (unwind-protect + (evil-motion-loop (nil count count) + (funcall forward 1)) + (if (zerop count) + ;; go back to beginning of object + (funcall backward 1) + (goto-char (point-max))))) + (t + count)))) + +(defun evil-move-end (count forward &optional backward inclusive) + "Move to the end of the COUNT next object. +If COUNT is negative, move to the COUNT previous object. +FORWARD is a function which moves to the end of the object, and +BACKWARD is a function which moves to the beginning. +If one is unspecified, the other is used with a negative argument. +If INCLUSIVE is non-nil, then point is placed at the last character +of the object; otherwise it is placed at the end of the object." + (let* ((count (or count 1)) + (backward (or backward + (lambda (count) + (funcall forward (- count))))) + (forward (or forward + (lambda (count) + (funcall backward (- count))))) + (opoint (point))) + (cond + ((< count 0) + (when (bobp) + (signal 'beginning-of-buffer nil)) + ;; Do we need to move past the current object? + (when (>= (save-excursion + (funcall backward 1) + (funcall forward 1) + (point)) + (if inclusive + (1+ opoint) + opoint)) + (setq count (1- count))) + (unwind-protect + (evil-motion-loop (nil count count) + (funcall backward 1)) + (if (not (zerop count)) + (goto-char (point-min)) + ;; go to end of object + (funcall forward 1) + (when inclusive + (unless (bobp) (backward-char))) + (evil-adjust-eol)))) + ((> count 0) + (when (evil-eobp) + (signal 'end-of-buffer nil)) + (when inclusive + (forward-char)) + (unwind-protect + (evil-motion-loop (nil count count) + (funcall forward 1)) + (if (not (zerop count)) + (goto-char (point-max)) + (when inclusive + (unless (bobp) (backward-char))) + (evil-adjust-eol)))) + (t + count)))) + +(evil-define-motion evil-move-empty-lines (count) + "Move to the next or previous empty line, repeated COUNT times." + :type exclusive + (catch 'done + (evil-motion-loop (var (or count 1)) + (cond + ((< var 0) + (goto-char + (or (save-excursion + (unless (bobp) + (backward-char) + (re-search-backward "^$" nil t))) + (point)))) + (t + (when (and (re-search-forward "^$" nil t) + (not (eobp))) + (forward-char))))))) + +(evil-define-union-move evil-move-word (count) + "Move by words." + (evil-move-chars evil-word count) + (evil-move-chars (concat "^ \t\r\n" evil-word) count) + (evil-move-empty-lines count)) + +(evil-define-union-move evil-move-WORD (count) + "Move by WORDs." + (evil-move-chars "^ \t\r\n" count) + (evil-move-empty-lines count)) + +(evil-define-motion evil-forward-word-begin (count bigword) + "Move the cursor to the beginning of the COUNT-th next word. +If BIGWORD is non-nil, move by WORDS." + :type exclusive + (setq bigword (if bigword #'evil-move-WORD #'evil-move-word)) + (if (eq evil-this-operator 'evil-change) + (evil-move-end count bigword) + (evil-move-beginning count bigword))) + +(evil-define-motion evil-forward-word-end (count bigword) + "Move the cursor to the end of the COUNT-th next word. +If BIGWORD is non-nil, move by WORDS." + :type inclusive + (setq bigword (if bigword #'evil-move-WORD #'evil-move-word)) + (if (evil-operator-state-p) + ;; if changing a one-letter word, don't move point at all + (prog1 (evil-move-end count bigword) + (unless (bobp) (backward-char))) + (evil-move-end count bigword nil t))) + +(evil-define-motion evil-backward-word-begin (count bigword) + "Move the cursor to the beginning of the COUNT-th previous word. +If BIGWORD is non-nil, move by WORDS." + :type exclusive + (setq bigword (if bigword #'evil-move-WORD #'evil-move-word)) + (evil-move-beginning (- (or count 1)) bigword)) + +(evil-define-motion evil-backward-word-end (count bigword) + "Move the cursor to the end of the COUNT-th previous word. +If BIGWORD is non-nil, move by WORDS." + :type inclusive + (setq bigword (if bigword #'evil-move-WORD #'evil-move-word)) + (evil-move-end (- (or count 1)) bigword nil t)) + +(evil-define-motion evil-forward-WORD-begin (count) + "Move the cursor to the beginning of the COUNT-th next WORD." + :type exclusive + (evil-forward-word-begin count t)) + +(evil-define-motion evil-forward-WORD-end (count) + "Move the cursor to the end of the COUNT-th next WORD." + :type inclusive + (evil-forward-word-end count t)) + +(evil-define-motion evil-backward-WORD-begin (count) + "Move the cursor to the beginning of the COUNT-th previous WORD." + :type exclusive + (evil-backward-word-begin count t)) + +(evil-define-motion evil-backward-WORD-end (count) + "Move the cursor to the end of the COUNT-th previous WORD." + :type inclusive + (evil-backward-word-end count t)) + +;; this function is slightly adapted from paragraphs.el +(defun evil-move-sentence (count) + "Move by sentence." + (let ((count (or count 1)) + (opoint (point)) + (sentence-end (sentence-end)) + pos par-beg par-end) + (evil-motion-loop (var count) + (cond + ;; backward + ((< var 0) + (setq pos (point) + par-beg (save-excursion + (and (zerop (evil-move-paragraph -1)) + (point)))) + (if (and (re-search-backward sentence-end par-beg t) + (or (< (match-end 0) pos) + (re-search-backward sentence-end par-beg t))) + (goto-char (match-end 0)) + (goto-char (or par-beg pos)))) + ;; forward + (t + (setq par-end (save-excursion + (and (zerop (evil-move-paragraph 1)) + (point)))) + (if (re-search-forward sentence-end par-end t) + (skip-chars-backward " \t\n") + (goto-char (or par-end (point))))))))) + +(defun evil-move-paragraph (count) + "Move by paragraph." + (let ((count (or count 1)) + npoint opoint) + (evil-motion-loop (var count) + (setq opoint (point)) + (cond + ((< var 0) + (forward-paragraph -1) + (setq npoint (point)) + (skip-chars-forward " \t\n") + (when (and (>= (point) opoint) (< npoint opoint)) + (goto-char npoint) + (forward-paragraph -1) + (skip-chars-forward " \t\n") + (when (and (>= (point) opoint) (< npoint opoint)) + (goto-char opoint)))) + (t + (forward-paragraph 1) + (setq npoint (point)) + (skip-chars-backward " \t\n") + (when (<= (point) opoint) + (goto-char npoint) + (forward-paragraph 1) + (skip-chars-backward " \t\n") + (when (<= (point) opoint) + (goto-char opoint)))))))) + +(evil-define-motion evil-forward-sentence (count) + :type exclusive + "Move to the next COUNT-th beginning of a sentence or end of a paragraph." + (let ((count (or count 1)) + beg-sentence end-paragraph) + (when (evil-eobp) + (signal 'end-of-buffer nil)) + (evil-motion-loop (nil count) + (unless (eobp) + (setq beg-sentence + (save-excursion + (and (zerop (evil-move-beginning 1 #'evil-move-sentence)) + (point))) + end-paragraph + (save-excursion + (forward-paragraph) + (point))) + (evil-goto-min beg-sentence end-paragraph))))) + +(evil-define-motion evil-backward-sentence (count) + :type exclusive + "Move to the previous COUNT-th beginning of a sentence or paragraph." + (let ((count (or count 1)) + beg-sentence beg-paragraph) + (when (bobp) + (signal 'beginning-of-buffer nil)) + (evil-motion-loop (nil count) + (unless (bobp) + (setq beg-sentence + (save-excursion + (and (zerop (evil-move-beginning -1 #'evil-move-sentence)) + (point))) + beg-paragraph + (save-excursion + (backward-paragraph) + (point))) + (evil-goto-max beg-sentence beg-paragraph))))) + +(evil-define-motion evil-forward-paragraph (count) + "Move to the end of the COUNT-th next paragraph." + :jump t + :type exclusive + (evil-move-end count 'forward-paragraph 'backward-paragraph)) + +(evil-define-motion evil-backward-paragraph (count) + "Move to the beginning of the COUNT-th previous paragraph." + :jump t + :type exclusive + (evil-move-beginning (- (or count 1)) + 'forward-paragraph 'backward-paragraph)) + +(evil-define-motion evil-find-char (count char) + "Move to the next COUNT'th occurrence of CHAR." + :jump t + :type inclusive + (interactive (list (read-char))) + (setq count (or count 1)) + (let ((fwd (> count 0))) + (setq evil-last-find (list #'evil-find-char char fwd)) + (when fwd (forward-char)) + (let ((case-fold-search nil)) + (unless (prog1 + (search-forward (char-to-string char) + (unless evil-find-skip-newlines + (if fwd + (line-end-position) + (line-beginning-position))) + t count) + (when fwd (backward-char))) + (error "Can't find %c" char))))) + +(evil-define-motion evil-find-char-backward (count char) + "Move to the previous COUNT'th occurrence of CHAR." + :jump t + :type exclusive + (interactive (list (read-char))) + (evil-find-char (- (or count 1)) char)) + +(evil-define-motion evil-find-char-to (count char) + "Move before the next COUNT'th occurence of CHAR." + :jump t + :type inclusive + (interactive (list (read-char))) + (unwind-protect + (progn + (evil-find-char count char) + (if (> (or count 1) 0) + (backward-char) + (forward-char))) + (setcar evil-last-find #'evil-find-char-to))) + +(evil-define-motion evil-find-char-to-backward (count char) + "Move before the previous COUNT'th occurence of CHAR." + :jump t + :type exclusive + (interactive (list (read-char))) + (evil-find-char-to (- (or count 1)) char)) + +(evil-define-motion evil-repeat-find-char (count) + "Repeat the last find COUNT times." + :jump t + :type inclusive + (setq count (or count 1)) + (if evil-last-find + (let ((cmd (car evil-last-find)) + (char (nth 1 evil-last-find)) + (fwd (nth 2 evil-last-find)) + evil-last-find) + (funcall cmd (if fwd count (- count)) char) + (unless (nth 2 evil-last-find) + (setq evil-this-type 'exclusive))) + (error "No previous search"))) + +(evil-define-motion evil-repeat-find-char-reverse (count) + "Repeat the last find COUNT times in the opposite direction." + :jump t + :type inclusive + (evil-repeat-find-char (- (or count 1)))) + +;; ceci n'est pas une pipe +(evil-define-motion evil-goto-column (count) + "Go to column COUNT on the current line. +Columns are counted from zero." + :type exclusive + (move-to-column (or count 0))) + +;; TODO: this is a very basic implementation considering only +;; (), [], {}, and not blocks like #if ... #endif +(evil-define-motion evil-jump-item (count) + "Find the next item in this line after or under the cursor +and jump to the corresponding one." + :jump t + :type inclusive + (cond + ;; COUNT% jumps to a line COUNT percentage down the file + (count + (goto-char + (evil-normalize-position + (let ((size (- (point-max) (point-min)))) + (+ (point-min) + (if (> size 80000) + (* count (/ size 100)) + (/ (* count size) 100)))))) + (back-to-indentation) + (setq evil-this-type 'line)) + (t + (let* ((next-open + (condition-case err + (1- (scan-lists (point) 1 -1)) + (error + (point-max)))) + (next-close + (condition-case nil + (1- (scan-lists (point) 1 1)) + (error (point-max)))) + (pos (min next-open next-close))) + (cond + ((>= pos (line-end-position)) + (error "No matching item found on the current line")) + ((= pos next-open) + (goto-char pos) + (forward-list) + (backward-char)) + (t + (goto-char (1+ pos)) + (backward-list))))))) + +(defmacro evil-define-text-object (object args &rest body) + "Define a text object command OBJECT. +BODY should return a range (BEG END) to the right of point +if COUNT is positive, and to the left of it if negative. + +\(fn OBJECT (COUNT) DOC [[KEY VALUE]...] BODY...)" + (declare (indent defun) + (debug (&define name lambda-list + [&optional stringp] + [&rest keywordp sexp] + def-body))) + (let* ((args (delq '&optional args)) + (count (or (pop args) 'count)) + (args (when args `(&optional ,@args))) + arg doc key keys type) + ;; collect docstring + (when (stringp (car-safe body)) + (setq doc (pop body))) + ;; collect keywords + (while (keywordp (car-safe body)) + (setq key (pop body) + arg (pop body)) + (cond + ((eq key :type) + (setq type arg)) + (t + (setq keys (append keys (list key arg)))))) + ;; macro expansion + `(evil-define-motion ,object (,count ,@args) + ,@(when doc `(,doc)) + ,@keys + :type ,type + (setq ,count (or ,count 1)) + (when (/= ,count 0) + (let* ((dir (evil-visual-direction)) + (type (or ',type evil-visual-char)) + mark point range region selection temp) + (cond + ((and (evil-visual-state-p) + (evil-called-interactively-p)) + ;; if we are at the beginning of the Visual selection, + ;; go to the left (negative COUNT); if at the end, + ;; go to the right (positive COUNT) + (setq dir (evil-visual-direction) + ,count (* ,count dir) + range (evil-range (point) (point) type) + region (evil-range (mark t) (point)) + selection (evil-range (evil-visual-beginning) + (evil-visual-end))) + ;; expand Visual selection so that point + ;; is outside already selected text + (evil-visual-make-selection (mark t) (point) type) + (evil-visual-expand-region) + (setq selection (evil-range (evil-visual-beginning) + (evil-visual-end))) + ;; the preceding selection should contain + ;; at least one object; if not, add it now + (let ((,count (- dir))) + (setq temp (progn ,@body))) + (when (and (evil-range-p temp) + (not (evil-subrange-p temp selection)) + (if (< dir 0) + (= (evil-range-beginning temp) + (evil-range-beginning selection)) + (= (evil-range-end temp) + (evil-range-end selection)))) + ;; found an unselected preceding object: + ;; decrease COUNT and adjust selection boundaries + (setq ,count (if (< ,count 0) (1+ ,count) (1- ,count)) + range (evil-range-union temp range))) + (when (/= ,count 0) + ;; main attempt: find range from current position + (setq temp (progn ,@body)) + (when (evil-range-p temp) + (setq range (evil-range-union temp range)))) + (cond + ((evil-subrange-p range selection) + ;; Visual fall-back: enlarge selection by one character + (if (< ,count 0) + (evil-visual-select (1- (evil-visual-beginning)) + (evil-visual-end) + type) + (evil-visual-select (evil-visual-beginning) + (1+ (evil-visual-end)) + type))) + (t + ;; Find the union of the range and the selection. + ;; Actually, this uses the region (point and mark) + ;; rather than the selection to prevent the object + ;; from unnecessarily overwriting the position of + ;; the mark at the other end of the selection. + (setq range (evil-contract-range range) + range (evil-range-union range region)) + ;; the beginning is mark and the end is point + ;; unless the selection goes the other way + (setq mark (evil-range-beginning range) + point (evil-range-end range) + type (evil-type range type)) + (when (< dir 0) + (evil-swap mark point)) + ;; select the range + (evil-visual-make-selection mark point type)))) + (t + (setq selection (evil-range (point) (point) type) + range (progn ,@body)) + (when (evil-range-p range) + (evil-range-union range selection))))))))) + +(defun evil-inner-object-range (count forward &optional backward type) + "Return an inner text object range (BEG END) of COUNT objects. +If COUNT is positive, return objects following point; +if COUNT is negative, return objects preceding point. +FORWARD is a function which moves to the end of an object, and +BACKWARD is a function which moves to the beginning. +If one is unspecified, the other is used with a negative argument." + (let* ((count (or count 1)) + (forward-func forward) + (backward-func backward) + (forward (or forward + (lambda (count) + (funcall backward-func (- count))))) + (backward (or backward + (lambda (count) + (funcall forward-func (- count))))) + beg end) + (when (< count 0) + (evil-swap forward backward) + (setq count (abs count))) + (setq beg (save-excursion + (funcall forward 1) + (funcall backward 1) + (point)) + end (save-excursion + (funcall forward 1) + (point))) + (evil-range beg end type))) + +(defun evil-an-object-range (count forward &optional backward type newlines) + "Return a text object range (BEG END) of COUNT objects with whitespace. +See `evil-inner-object-range' for more details." + (let ((range (evil-inner-object-range count forward backward type))) + (if newlines + (evil-add-whitespace-to-range range count) + (save-restriction + (narrow-to-region + (save-excursion + (goto-char (evil-range-beginning range)) + (line-beginning-position)) + (save-excursion + (goto-char (evil-range-end range)) + (line-end-position))) + (evil-add-whitespace-to-range range count))))) + +(defun evil-paren-range (count open close &optional exclusive) + "Return a range (BEG END) of COUNT delimited text objects. +OPEN is an opening character and CLOSE is a closing character. +If EXCLUSIVE is non-nil, OPEN and CLOSE are excluded from +the range; otherwise they are included. + +This function uses Emacs' syntax table and can therefore only +handle single-character delimiters. To match whole strings, +use `evil-regexp-range'." + (let ((open-regexp (regexp-quote (string open))) + (close-regexp (regexp-quote (string close))) + (count (or count 1)) + level beg end range) + (if (or (evil-in-comment-p) + (and (evil-in-string-p) (not (eq open close)))) + ;; if inside a comment, don't use the syntax table + (evil-regexp-range count open-regexp close-regexp exclusive) + (save-excursion + (with-syntax-table (copy-syntax-table (syntax-table)) + (cond + ((= count 0)) + ;; if OPEN is equal to CLOSE, handle as string delimiters + ((eq open close) + (modify-syntax-entry open "\"") + (while (not (or (eobp) (evil-in-string-p))) + (forward-char)) + (when (evil-in-string-p) + (setq range (evil-range + (if exclusive + (1+ (evil-string-beginning)) + (evil-string-beginning)) + (if exclusive + (1- (evil-string-end)) + (evil-string-end)))))) + (t + ;; otherwise handle as open and close parentheses + (modify-syntax-entry open (format "(%c" close)) + (modify-syntax-entry close (format ")%c" open)) + ;; handle edge cases + (if (< count 0) + (when (if exclusive (looking-back open-regexp) + (looking-back close-regexp)) + (backward-char)) + (when (if exclusive (looking-at close-regexp) + (looking-at open-regexp)) + (forward-char))) + ;; find OPEN + (evil-motion-loop (nil count level) + (condition-case nil + (while (progn + (backward-up-list 1) + (not (looking-at open-regexp)))) + (error nil))) + (when (/= level count) + (setq beg (if exclusive (1+ (point)) (point))) + ;; find CLOSE + (forward-sexp) + (setq end (if exclusive (1- (point)) (point))) + (setq range (evil-range beg end)) + (when exclusive + (evil-adjust-whitespace-inside-range + range (not (eq evil-this-operator 'evil-delete))))))) + range))))) + +;; This simpler, but more general function can be used when +;; `evil-paren-range' is insufficient. Note that as it doesn't use +;; the syntax table, it is unaware of escaped characters (unless +;; such a check is built into the regular expressions). +(defun evil-regexp-range (count open close &optional exclusive) + "Return a range (BEG END) of COUNT delimited text objects. +OPEN is a regular expression matching the opening sequence, +and CLOSE is a regular expression matching the closing sequence. +If EXCLUSIVE is non-nil, OPEN and CLOSE are excluded from +the range; otherwise they are included. See also `evil-paren-range'." + (let ((either (format "\\(%s\\)\\|\\(%s\\)" open close)) + (count (or count 1)) + (level 0) + beg end range) + (save-excursion + (save-match-data + (evil-narrow-to-comment + ;; find beginning of range: handle edge cases + (if (< count 0) + (when (if exclusive (looking-back open) (looking-back close)) + (goto-char (match-beginning 0))) + (when (if exclusive (looking-at close) (looking-at open)) + (goto-char (match-end 0)))) + ;; then loop over remainder + (while (and (< level (abs count)) + (re-search-backward either nil t)) + (if (looking-at open) + (setq level (1+ level)) + ;; found a CLOSE, so need to find another OPEN first + (setq level (1- level)))) + ;; find end of range + (when (> level 0) + (forward-char) + (setq level 1 + beg (if exclusive + (match-end 0) + (match-beginning 0))) + (while (and (> level 0) + (re-search-forward either nil t)) + (if (looking-back close) + (setq level (1- level)) + ;; found an OPEN, so need to find another CLOSE first + (setq level (1+ level)))) + (when (= level 0) + (setq end (if exclusive + (match-beginning 0) + (match-end 0))) + (setq range (evil-range beg end)))) + range))))) + +(defun evil-add-whitespace-to-range (range &optional dir pos regexp) + "Add whitespace at one side of RANGE, depending on POS. +If POS is before the range, add trailing whitespace; +if POS is after the range, add leading whitespace. +If POS is inside the range, add trailing if DIR is positive +and leading if DIR is negative. If there is no trailing whitespace, +add leading whitespace and vice versa. POS defaults to point. +REGEXP is a regular expression for matching whitespace; +the default is \"[ \\f\\t\\n\\r\\v]+\"." + (let* ((pos (or pos (point))) + (dir (or (when (<= pos (evil-range-beginning range)) 1) + (when (>= pos (evil-range-end range)) -1) + dir 1)) + (regexp (or regexp "[ \f\t\n\r\v]+"))) + (save-excursion + (save-match-data + (goto-char pos) + (cond + ((< dir 0) + (if (looking-back regexp) + (evil-add-whitespace-after-range range regexp) + (or (evil-add-whitespace-before-range range regexp) + (evil-add-whitespace-after-range range regexp)))) + (t + (if (looking-at regexp) + (evil-add-whitespace-before-range range regexp) + (or (evil-add-whitespace-after-range range regexp) + (evil-add-whitespace-before-range range regexp))))) + range)))) + +(defun evil-add-whitespace-before-range (range &optional regexp) + "Add whitespace at the beginning of RANGE. +REGEXP is a regular expression for matching whitespace; +the default is \"[ \\f\\t\\n\\r\\v]+\". +Returns t if RANGE was successfully increased and nil otherwise." + (let ((orig (evil-copy-range range)) + (regexp (or regexp "[ \f\t\n\r\v]+"))) + (save-excursion + (save-match-data + (goto-char (evil-range-beginning range)) + (when (looking-back regexp nil t) + ;; exclude the newline on the preceding line + (goto-char (match-beginning 0)) + (when (eolp) (forward-char)) + (evil-set-range range (point))) + (not (evil-subrange-p range orig)))))) + +(defun evil-add-whitespace-after-range (range &optional regexp) + "Add whitespace at the end of RANGE. +REGEXP is a regular expression for matching whitespace; +the default is \"[ \\f\\t\\n\\r\\v]+\". +Returns t if RANGE was successfully increased and nil otherwise." + (let ((orig (evil-copy-range range)) + (regexp (or regexp "[ \f\t\n\r\v]+"))) + (save-excursion + (save-match-data + (goto-char (evil-range-end range)) + (when (looking-at regexp) + (evil-set-range range nil (match-end 0))) + (not (evil-subrange-p range orig)))))) + +(defun evil-adjust-whitespace-inside-range (range &optional shrink regexp) + "Adjust whitespace inside RANGE. +Leading whitespace at the end of the line is excluded. +If SHRINK is non-nil, indentation may also be excluded, +and the trailing whitespace is adjusted as well. +REGEXP is a regular expression for matching whitespace; +the default is \"[ \\f\\t\\n\\r\\v]*\". +Returns t if RANGE was successfully adjusted and nil otherwise." + (let ((orig (evil-copy-range range)) + (regexp (or regexp "[ \f\t\n\r\v]*"))) + (save-excursion + (goto-char (evil-range-beginning range)) + (when (looking-at (concat regexp "$")) + (forward-line) + (if (and shrink evil-auto-indent) + (back-to-indentation) + (beginning-of-line)) + (evil-set-range range (point) nil)) + (goto-char (evil-range-end range)) + (when (and shrink (looking-back (concat "^" regexp))) + (evil-set-range range nil (line-end-position 0))) + (not (evil-subrange-p orig range))))) + +(evil-define-text-object evil-a-word (count bigword) + "Select a word. +If BIGWORD is non-nil, select a WORD." + (evil-an-object-range count (if bigword + 'evil-move-WORD + 'evil-move-word))) + +(evil-define-text-object evil-inner-word (count bigword) + "Select inner word. +If BIGWORD is non-nil, select inner WORD." + (evil-inner-object-range count (if bigword + 'evil-move-WORD + 'evil-move-word))) + +(evil-define-text-object evil-a-WORD (count) + "Select a WORD." + (evil-a-word count t)) + +(evil-define-text-object evil-inner-WORD (count) + "Select inner WORD." + (evil-inner-word count t)) + +(evil-define-text-object evil-a-sentence (count) + "Select a sentence." + (evil-an-object-range count 'evil-move-sentence nil nil t)) + +(evil-define-text-object evil-inner-sentence (count) + "Select inner sentence." + (evil-inner-object-range count 'evil-move-sentence)) + +(evil-define-text-object evil-a-paragraph (count) + "Select a paragraph." + :type line + (evil-an-object-range count 'evil-move-paragraph nil nil t)) + +(evil-define-text-object evil-inner-paragraph (count) + "Select inner paragraph." + :type line + (evil-inner-object-range count 'evil-move-paragraph)) + +(evil-define-text-object evil-a-paren (count) + "Select a parenthesis." + (evil-paren-range count ?\( ?\))) + +(evil-define-text-object evil-inner-paren (count) + "Select inner parenthesis." + (evil-paren-range count ?\( ?\) t)) + +(evil-define-text-object evil-a-bracket (count) + "Select a square bracket." + (evil-paren-range count ?\[ ?\])) + +(evil-define-text-object evil-inner-bracket (count) + "Select inner square bracket." + (evil-paren-range count ?\[ ?\] t)) + +(evil-define-text-object evil-a-curly (count) + "Select a curly bracket (\"brace\")." + (evil-paren-range count ?{ ?})) + +(evil-define-text-object evil-inner-curly (count) + "Select inner curly bracket (\"brace\")." + (evil-paren-range count ?{ ?} t)) + +(evil-define-text-object evil-an-angle (count) + "Select an angle bracket." + (evil-paren-range count ?< ?> t)) + +(evil-define-text-object evil-inner-angle (count) + "Select inner angle bracket." + (evil-paren-range count ?< ?>)) + +(evil-define-text-object evil-a-single-quote (count) + "Select a single-quoted expression." + (evil-paren-range count ?' ?')) + +(evil-define-text-object evil-inner-single-quote (count) + "Select inner single-quoted expression." + (evil-paren-range count ?' ?' t)) + +(evil-define-text-object evil-a-double-quote (count) + "Select a double-quoted expression." + (evil-paren-range count ?\" ?\")) + +(evil-define-text-object evil-inner-double-quote (count) + "Select inner double-quoted expression." + (evil-paren-range count ?\" ?\" t)) + +(evil-define-text-object evil-a-back-quote (count) + "Select a back-quoted expression." + (evil-paren-range count ?\` ?\`)) + +(evil-define-text-object evil-inner-back-quote (count) + "Select inner back-quoted expression." + (evil-paren-range count ?\` ?\` t)) + +(evil-define-text-object evil-a-tag (count) + "Select a tag block." + (evil-regexp-range count "<[^/>]+?>" "</[^/>]+?>")) + +(evil-define-text-object evil-inner-tag (count) + "Select inner tag block." + (evil-regexp-range count "<[^/>]+?>" "</[^/>]+?>" t)) + +(provide 'evil-motions) + +;;; evil-motions.el ends here diff --git a/evil-operators.el b/evil-operators.el index 6f6e2f5..37fd850 100644 --- a/evil-operators.el +++ b/evil-operators.el @@ -1,11 +1,844 @@ ;;;; Operator-Pending state +(require 'evil-undo) (require 'evil-states) +(require 'evil-visual) +(require 'evil-insert) + +(require 'rect) (evil-define-state operator "Operator-Pending state" - :tag "<O>" - :enable (normal)) + :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-refresh-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) + ;; make `window-line-height' reliable + (redisplay) + (setq height (window-line-height)) + (setq height (+ (nth 0 height) (nth 3 height))) + ;; cut cursor height in half + (setq height (/ height 2)) + (setq cursor-type (cons 'hbar height)) + ;; ensure the cursor is redisplayed + (force-window-update (selected-window)) + (redisplay))) + +(defmacro evil-define-operator (operator args &rest body) + "Define an operator command OPERATOR. + +\(fn OPERATOR (BEG END ARGS...) DOC [[KEY VALUE]...] BODY...)" + (declare (indent defun) + (debug (&define name lambda-list + [&optional stringp] + [&rest keywordp sexp] + [&optional ("interactive" interactive)] + def-body))) + (let ((move-point t) + (keep-visual nil) + (whole-lines nil) + (motion nil) + arg doc beg end interactive key keys overriding-type type) + ;; collect BEG, END and TYPE + (setq args (delq '&optional args) + beg (or (pop args) 'beg) + end (or (pop args) 'end) + type (pop args) + args (when type `(&optional ,type ,@args)) + type (or type 'type)) + ;; collect docstring + (when (and (> (length body) 1) + (or (eq (car-safe (car-safe body)) 'format) + (stringp (car-safe body)))) + (setq doc (pop body))) + ;; collect keywords + (while (keywordp (car-safe body)) + (setq key (pop body) + arg (pop body)) + (cond + ((eq key :motion) + (setq motion arg) + (unless motion + (setq motion 'undefined))) + ((eq key :keep-visual) + (setq keep-visual arg)) + ((eq key :move-point) + (setq move-point arg)) + ((eq key :type) + (setq overriding-type arg)) + (t + (setq keys (append keys (list key arg)))))) + ;; collect `interactive' specification + (when (eq (car-safe (car-safe body)) 'interactive) + (setq interactive (cdr (pop body)))) + ;; macro expansion + `(evil-define-command ,operator (,beg ,end ,@args) + ,@(when doc `(,doc)) + ,@keys + :keep-visual t + (interactive + (let* ((orig (point)) + (,beg orig) + (,end orig) + (state evil-state) + range ,type) + (unwind-protect + (setq evil-this-operator this-command + range (evil-operator-range + ',args ',motion ',overriding-type) + ,beg (evil-range-beginning range) + ,end (evil-range-end range) + ,type (evil-type range) + range (append (evil-range ,beg ,end ,type) + (progn ,@interactive))) + (setq orig (point)) + (if ,keep-visual + (when (evil-visual-state-p) + (evil-visual-expand-region)) + (when (evil-visual-state-p) + (evil-normal-state)) + (when (region-active-p) + (evil-active-region -1))) + (if (or ,move-point + (evil-visual-state-p state)) + (if (eq ,type 'block) + (evil-visual-block-rotate 'upper-left ,beg ,end) + (goto-char ,beg)) + (goto-char orig))) + range)) + (unwind-protect + (unless (and evil-inhibit-operator + (evil-called-interactively-p)) + ,@body) + (setq evil-inhibit-operator nil))))) + +;; this is used in the `interactive' specification of an operator command +(defun evil-operator-range (&optional return-type motion type) + "Read a motion from the keyboard and return its buffer positions. +The return value is a list (BEG END) or (BEG END TYPE), +depending on RETURN-TYPE. Insteaf of reading from the keyboard, +a predefined motion may be specified with MOTION. Likewise, +a predefined type may be specified with TYPE." + (let ((range (evil-range (point) (point))) + command count modifier) + (evil-save-echo-area + (cond + ;; Visual selection + ((evil-visual-state-p) + (setq range (evil-range (evil-visual-beginning) + (evil-visual-end) + (evil-visual-type)))) + ;; active region + ((region-active-p) + (setq range (evil-range (region-beginning) + (region-end) + (or evil-this-type 'exclusive)))) + (t + ;; motion + (evil-save-state + (unless motion + (evil-operator-state) + ;; Make linewise operator shortcuts. E.g., "d" yields the + ;; shortcut "dd", and "g?" yields shortcuts "g??" and "g?g?". + (let ((keys (nth 2 (evil-extract-count (this-command-keys))))) + (setq keys (listify-key-sequence keys)) + (dotimes (var (length keys)) + (define-key evil-operator-shortcut-map + (vconcat (nthcdr var keys)) 'evil-line))) + ;; read motion from keyboard + (setq command (evil-read-motion motion) + motion (nth 0 command) + count (nth 1 command) + type (or type (nth 2 command)))) + (cond + ((null motion) + (setq quit-flag t)) + ((eq motion 'undefined) + (setq motion nil)) + (evil-repeat-count + (setq count evil-repeat-count + ;; only the first operator's count is overwritten + evil-repeat-count nil)) + ((or count current-prefix-arg) + ;; multiply operator count and motion count together + (setq count + (* (prefix-numeric-value count) + (prefix-numeric-value current-prefix-arg))))) + (when motion + (evil-with-state operator + ;; calculate motion range + (setq range (evil-motion-range + motion + count + type)) + (evil-set-marker ?. (evil-range-end range) t))) + ;; update global variables + (setq evil-this-motion motion + evil-this-motion-count count + type (evil-type range type) + evil-this-type type)))) + (unless (or (null type) (eq (evil-type range) type)) + (evil-set-type range type) + (evil-expand-range range) + (evil-set-range-properties range nil)) + (unless return-type + (evil-set-type range nil)) + range))) + +(defun evil-motion-range (motion &optional count type) + "Execute a motion and return the buffer positions. +The return value is a list (BEG END TYPE)." + (let ((opoint (point)) + (omark (mark t)) + (omactive (and (boundp 'mark-active) mark-active)) + (obuffer (current-buffer)) + (evil-motion-marker (move-marker (make-marker) (point))) + range) + (evil-save-transient-mark + (evil-transient-mark 1) + (unwind-protect + (let ((current-prefix-arg count) + ;; Store the type in global variable `evil-this-type'. + ;; Motions can change their type during execution + ;; by setting this variable. + (evil-this-type (or type + (evil-type motion 'exclusive)))) + (condition-case err + (setq range (call-interactively motion)) + (error (prog1 nil + (setq evil-this-type 'exclusive + evil-write-echo-area t) + (message (error-message-string err))))) + (cond + ;; the motion returned a range + ((evil-range-p range)) + ;; the motion made a Visual selection + ((evil-visual-state-p) + (setq range (evil-range (evil-visual-beginning) + (evil-visual-end) + (evil-visual-type)))) + ;; the motion made an active region + ((region-active-p) + (setq range (evil-range (region-beginning) + (region-end) + evil-this-type))) + ;; default case: range from previous position to current + (t + (setq range (evil-expand-range + (evil-normalize + evil-motion-marker (point) evil-this-type))))) + (unless (or (null type) (eq (evil-type range) type)) + (evil-set-type range type) + (evil-expand-range range) + (evil-set-range-properties range nil)) + range) + ;; restore point and mark like `save-excursion', + ;; but only if the motion hasn't disabled the operator + (unless evil-inhibit-operator + (set-buffer obuffer) + (evil-move-mark omark) + (goto-char opoint)) + ;; delete marker so it doesn't slow down editing + (move-marker evil-motion-marker nil))))) + +(defun evil-read-motion (&optional motion count type modifier) + "Read a MOTION, motion COUNT and motion TYPE from the keyboard. +The type may be overridden with MODIFIER, which may be a type +or a Visual selection as defined by `evil-define-visual-selection'. +Return a list (MOTION COUNT [TYPE])." + (let ((modifiers '((evil-visual-char . char) + (evil-visual-line . line) + (evil-visual-block . block))) + command prefix) + (unless motion + (while (progn + (setq command (evil-keypress-parser) + motion (pop command) + prefix (pop command)) + (when prefix + (if count + (setq count (string-to-number + (concat (number-to-string count) + (number-to-string prefix)))) + (setq count prefix))) + ;; if the command is a type modifier, read more + (when (rassq motion evil-visual-alist) + (setq modifier + (or modifier + (car (rassq motion evil-visual-alist)))))))) + (when modifier + (setq type (or type (evil-type motion 'exclusive))) + (cond + ((eq modifier 'char) + ;; TODO: this behavior could be less hard-coded + (if (eq type 'exclusive) + (setq type 'inclusive) + (setq type 'exclusive))) + (t + (setq type modifier)))) + (list motion count type))) + +(defun evil-keypress-parser (&optional input) + "Read from keyboard or INPUT and build a command description. +Returns (CMD COUNT), where COUNT is the numeric prefix argument. +Both COUNT and CMD may be nil." + (let ((input (append input nil)) + (inhibit-quit t) + char cmd count digit seq) + (while (progn + (setq char (or (pop input) (read-event))) + (when (symbolp char) + (setq char (or (get char 'ascii-character) char))) + ;; this trick from simple.el's `digit-argument' + ;; converts keystrokes like C-0 and C-M-1 to digits + (if (or (characterp char) (integerp char)) + (setq digit (- (logand char ?\177) ?0)) + (setq digit nil)) + (if (keymapp cmd) + (setq seq (append seq (list char))) + (setq seq (list char))) + (setq cmd (key-binding (vconcat seq) t)) + (cond + ;; if CMD is a keymap, we need to read more + ((keymapp cmd) + t) + ;; numeric prefix argument + ((or (memq cmd '(digit-argument)) + (and (eq (length seq) 1) + (not (keymapp cmd)) + count + (memq digit '(0 1 2 3 4 5 6 7 8 9)))) + ;; store digits in a string, which is easily converted + ;; to a number afterwards + (setq count (concat (or count "") + (number-to-string digit))) + t) + ;; catch middle digits like "da2w" + ((and (not cmd) + (> (length seq) 1) + (memq digit '(0 1 2 3 4 5 6 7 8 9))) + (setq count (concat (or count "") + (number-to-string digit))) + ;; remove the digit from the key sequence + ;; so we can see if the previous one goes anywhere + (setq seq (nbutlast seq 1)) + (setq cmd (key-binding (vconcat seq))) + t) + ((eq cmd 'negative-argument) + (unless count + (setq count "-"))) + ;; user pressed C-g, so return nil for CMD + ((memq cmd '(keyboard-quit undefined)) + (setq cmd nil))))) + ;; determine COUNT + (when (stringp count) + (if (string= count "-") + (setq count nil) + (setq count (string-to-number count)))) + ;; return command description + (list cmd count))) + +;;; Operator commands + +(evil-define-operator evil-yank (beg end type register yank-handler) + "Saves the characters in motion into the kill-ring." + :move-point nil + :repeat nil + (interactive (list evil-this-register (evil-yank-handler))) + (cond + ((eq type 'block) + (evil-yank-rectangle beg end register yank-handler)) + ((eq type 'line) + (evil-yank-lines beg end register yank-handler)) + (t + (evil-yank-characters beg end register yank-handler)))) + +(evil-define-operator evil-yank-line (beg end type register) + "Saves whole lines into the kill-ring." + :motion evil-line + :move-point nil + (interactive (list evil-this-register)) + (evil-yank beg end type register)) + +(defun evil-yank-characters (beg end &optional register yank-handler) + "Saves the characters defined by the region BEG and END in the kill-ring." + (let ((text (buffer-substring beg end))) + (when yank-handler + (setq text (propertize text 'yank-handler (list yank-handler)))) + (when register + (set-register register text)) + (kill-new text))) + +(defun evil-yank-lines (beg end &optional register yank-handler) + "Saves the lines in the region BEG and END into the kill-ring." + (let* ((text (buffer-substring beg end)) + (yank-handler (list (or yank-handler + #'evil-yank-line-handler)))) + ;; Ensure the text ends with a newline. This is required + ;; if the deleted lines were the last lines in the buffer. + (when (or (zerop (length text)) + (/= (aref text (1- (length text))) ?\n)) + (setq text (concat text "\n"))) + (setq text (propertize text 'yank-handler yank-handler)) + (when register + (set-register register text)) + (kill-new text))) + +(defun evil-yank-rectangle (beg end &optional register yank-handler) + "Stores the rectangle defined by region BEG and END into the kill-ring." + (let ((lines (list nil))) + (apply-on-rectangle #'extract-rectangle-line beg end lines) + ;; We remove spaces from the beginning and the end of the next. + ;; Spaces are inserted explicitly in the yank-handler in order to + ;; NOT insert lines full of spaces. + (setq lines (nreverse (cdr lines))) + ;; `text' is used as default insert text when pasting this rectangle + ;; in another program, e.g., using the X clipboard. + (let* ((yank-handler (list (or yank-handler + #'evil-yank-block-handler) + lines + nil + #'evil-delete-yanked-rectangle)) + (text (propertize (mapconcat #'identity lines "\n") + 'yank-handler yank-handler))) + (when register + (set-register register text)) + (kill-new text)))) + +(defun evil-yank-line-handler (text) + "Inserts the current text linewise." + (let ((text (apply #'concat (make-list (or evil-paste-count 1) text))) + (opoint (point))) + (remove-list-of-text-properties + 0 (length text) yank-excluded-properties text) + (cond + ((eq this-command 'evil-paste-after) + (end-of-line) + (evil-move-mark (point)) + (newline) + (insert text) + (delete-char -1) ; delete the last newline + (setq evil-last-paste + (list 'evil-paste-after + evil-paste-count + opoint + (mark t) + (point))) + (evil-move-mark (1+ (mark t)))) + (t + (beginning-of-line) + (evil-move-mark (point)) + (insert text) + (setq evil-last-paste + (list 'evil-paste-before + evil-paste-count + opoint + (mark t) + (point))))) + (evil-exchange-point-and-mark) + (back-to-indentation))) + +(defun evil-yank-block-handler (lines) + "Inserts the current text as block." + (let ((count (or evil-paste-count 1)) + (col (if (eq this-command 'evil-paste-after) + (1+ (current-column)) + (current-column))) + (current-line (line-number-at-pos (point))) + (opoint (point))) + (dolist (line lines) + ;; concat multiple copies according to count + (setq line (apply #'concat (make-list count line))) + ;; strip whitespaces at beginning and end + (string-match "^ *\\(.*?\\) *$" line) + (let ((text (match-string 1 line)) + (begextra (match-beginning 1)) + (endextra (- (match-end 0) (match-end 1)))) + ;; maybe we have to insert a new line at eob + (while (< (line-number-at-pos (point)) + current-line) + (goto-char (point-max)) + (newline)) + (setq current-line (1+ current-line)) + ;; insert text unless we insert an empty line behind eol + (unless (and (< (save-excursion + (goto-char (line-end-position)) + (current-column)) + col) ; nothing in this line + (zerop (length text))) ; and nothing to insert + ;; if we paste behind eol, it may be sufficient to insert tabs + (if (< (save-excursion + (goto-char (line-end-position)) + (current-column)) + col) + (move-to-column (+ col begextra) t) + (move-to-column col t) + (insert (make-string begextra ? ))) + (remove-list-of-text-properties 0 (length text) + yank-excluded-properties text) + (insert text) + (unless (eolp) + ;; text follows, so we have to insert spaces + (insert (make-string endextra ? )))) + (forward-line 1))) + (setq evil-last-paste + (list this-command + evil-paste-count + opoint + (length lines) ; number of rows + (* count (length (car lines))))) ; number of colums + (goto-char opoint) + (when (and (eq this-command 'evil-paste-after) + (not (eolp))) + (forward-char)))) + +(defun evil-delete-yanked-rectangle (nrows ncols) + "Special function to delete the block yanked by a previous paste command." + (let ((opoint (point)) + (col (if (eq last-command 'evil-paste-after) + (1+ (current-column)) + (current-column)))) + (dotimes (i nrows) + (delete-region (save-excursion + (move-to-column col) + (point)) + (save-excursion + (move-to-column (+ col ncols)) + (point))) + (unless (eobp) (forward-line))) + (goto-char opoint))) + +(defun evil-paste-before (count &optional register) + "Pastes the latest yanked text before the cursor position." + (interactive (list current-prefix-arg evil-this-register)) + (if (evil-visual-state-p) + (evil-visual-paste count register) + (evil-with-undo + (let* ((text (if register + (get-register register) + (current-kill 0))) + (yank-handler (car-safe (get-text-property + 0 'yank-handler text)))) + (if (memq yank-handler '(evil-yank-line-handler + evil-yank-block-handler)) + (let ((evil-paste-count count) + (this-command 'evil-paste-before)) ; for non-interactive use + (insert-for-yank text)) + ;; no yank-handler, default + (let ((opoint (point))) + (dotimes (i (or count 1)) + (insert-for-yank text)) + (evil-move-mark opoint) + (setq evil-last-paste + (list 'evil-paste-before + count + opoint + opoint ; beg + (point))) ; end + (evil-exchange-point-and-mark))) + ;; no paste pop after pasting a register + (when register + (setq evil-last-paste nil)))))) + +(defun evil-paste-after (count &optional register) + "Pastes the latest yanked text behind point." + (interactive (list current-prefix-arg evil-this-register)) + (if (evil-visual-state-p) + (evil-visual-paste count register) + (evil-with-undo + (let* ((text (if register + (get-register register) + (current-kill 0))) + (yank-handler (car-safe (get-text-property + 0 'yank-handler text)))) + (if (memq yank-handler '(evil-yank-line-handler + evil-yank-block-handler)) + (let ((evil-paste-count count) + (this-command 'evil-paste-after)) ; for non-interactive use + (insert-for-yank text)) + ;; no yank-handler, default + (let ((opoint (point))) + ;; TODO: Perhaps it is better to collect a list of all + ;; (point . mark) pairs to undo the yanking for count > 1. + ;; The reason is that this yanking could very well use + ;; `yank-handler'. + (unless (eolp) (forward-char)) + (let ((beg (point))) + (dotimes (i (or count 1)) + (insert-for-yank text)) + (setq evil-last-paste + (list 'evil-paste-after + count + opoint + beg ; beg + (point))) ; end + (backward-char)))) + (when register + (setq evil-last-paste nil)))))) + +(defun evil-visual-paste (count &optional register) + "Paste over Visual selection." + (interactive (list current-prefix-arg evil-this-register)) + (let* ((text (if register + (get-register register) + (current-kill 0))) + (yank-handler (car-safe (get-text-property + 0 'yank-handler text)))) + (evil-with-undo + (when (evil-visual-state-p) + ;; add replaced text to the kill-ring + (unless register + ;; if pasting from the kill-ring, + ;; add replaced text before the current kill + (setq kill-ring (delete text kill-ring))) + (setq kill-ring-yank-pointer kill-ring) + (if (eq (evil-visual-type) 'block) + (evil-visual-block-rotate 'upper-left) + (goto-char (evil-visual-beginning))) + (evil-delete (evil-visual-beginning) + (evil-visual-end) + (evil-visual-type)) + (unless register + (kill-new text)) + (when (and (eq yank-handler 'evil-yank-line-handler) + (not (eq (evil-visual-type) 'line))) + (newline)) + (evil-normal-state)) + (evil-paste-before count register)))) + +;; TODO: if undoing is disabled in the current buffer paste pop won't +;; work. Although this is probably not a big problem because usually +;; buffers for editing where `evil-paste-pop' may be useful have +;; undoing enabled. A solution would be to temporarily enable undo +;; when pasting and storing the undo-information in a special variable +;; that does not interfere with buffer-undo-list +(defun evil-paste-pop (count) + "Replace the just-yanked stretch of killed text with a different stretch. +This command is allowed only immediatly after a `yank', +`evil-paste-before', `evil-paste-after' or `evil-paste-pop'. +This command uses the same paste command as before, i.e., when +used after `evil-paste-after' the new text is also yanked using +`evil-paste-after', used with the same paste-count argument. + +The COUNT argument inserts the COUNTth previous kill. If COUNT +is negative this is a more recent kill." + (interactive "p") + (unless (memq last-command + '(evil-paste-after + evil-paste-before)) + (error "Previous command was not an evil-paste: %s" last-command)) + (unless evil-last-paste + (error "Previous paste command used a register")) + (evil-undo-pop) + (goto-char (nth 2 evil-last-paste)) + (current-kill count) + (setq this-command (nth 0 evil-last-paste)) + (funcall (nth 0 evil-last-paste) (nth 1 evil-last-paste))) + +(defun evil-paste-pop-next (count) + "Same as `evil-paste-pop' but with negative argument." + (interactive "p") + (evil-paste-pop (- count))) + +(evil-define-operator evil-delete (beg end type register yank-handler) + "Delete and save in kill-ring or REGISTER." + (interactive (list evil-this-register (evil-yank-handler))) + (evil-yank beg end type register yank-handler) + (cond + ((eq type 'block) + (delete-rectangle beg end)) + ((and (eq type 'line) + (= (point-max) end) + (/= (point-min) beg)) + (delete-region (1- beg) end)) + (t + (delete-region beg end)))) + +(evil-define-operator evil-delete-line (beg end type register) + "Delete to end of line." + :motion evil-end-of-line + (interactive (list evil-this-register)) + (evil-delete beg end type register)) + +(evil-define-operator evil-delete-char (beg end type register) + "Delete next character." + :motion evil-forward-char + (interactive (list evil-this-register)) + (evil-delete beg end type register)) + +(evil-define-operator evil-delete-backward-char (beg end type register) + "Delete previous character." + :motion evil-backward-char + (interactive (list evil-this-register)) + (evil-delete beg end type register)) + +(evil-define-operator evil-change (beg end type register yank-handler) + "Delete region and change to insert state. +If the region is linewise insertion starts on an empty line. +If region is a block, the inserted text in inserted at each line +of the block." + (interactive (list evil-this-register (evil-yank-handler))) + (let ((nlines (1+ (- (line-number-at-pos end) + (line-number-at-pos beg)))) + (bop (= beg (buffer-end -1))) + (eob (= end (buffer-end 1)))) + (evil-delete beg end type register yank-handler) + (cond + ((eq type 'line) + (if (and eob (not bop)) + (evil-open-below 1) + (evil-open-above 1))) + ((eq type 'block) + (evil-insert 1 nlines)) + (t + (evil-insert 1))))) + +(evil-define-operator evil-change-line (beg end type register) + "Change to end of line." + :motion evil-end-of-line + (interactive (list evil-this-register)) + (evil-change beg end type register)) + +(evil-define-operator evil-substitute (beg end type register) + "Change a character." + :motion evil-forward-char + (interactive (list evil-this-register)) + (evil-change beg end type register)) + +(evil-define-command evil-use-register (register) + "Use REGISTER for the next command." + :keep-visual t + (interactive (list (read-char))) + (setq evil-this-register register)) + +(evil-define-command evil-record-macro (register) + "Record a keyboard macro into REGISTER." + :keep-visual t + (interactive (list (unless evil-this-macro + (or evil-this-register (read-char))))) + (cond + (evil-this-macro + (end-kbd-macro) + (when last-kbd-macro + (set-register evil-this-macro last-kbd-macro)) + (setq evil-this-macro nil)) + (t + (setq evil-this-macro register) + (start-kbd-macro nil)))) + +(evil-define-command evil-execute-macro (count macro) + "Execute keyboard macro MACRO, COUNT times. +When called interactively, MACRO is read from a register." + :keep-visual t + (interactive + (let (count macro register) + (setq count (prefix-numeric-value current-prefix-arg) + register (or evil-this-register (read-char))) + (if (eq register ?@) + (setq macro last-kbd-macro) + (setq macro (evil-get-register register))) + (list count macro))) + (if (member macro '("" [] nil)) + (error "No previous macro") + (execute-kbd-macro macro count))) + +(evil-define-operator evil-upcase (beg end type) + "Convert text to upper case." + (if (eq type 'block) + (evil-apply-on-block 'evil-upcase beg end) + (upcase-region beg end))) + +(evil-define-operator evil-downcase (beg end type) + "Convert text to lower case." + (if (eq type 'block) + (evil-apply-on-block 'evil-downcase beg end) + (downcase-region beg end))) + +(evil-define-operator evil-invert-case (beg end type) + "Invert case of text." + (let (char) + (if (eq type 'block) + (evil-apply-on-block 'evil-invert-case beg end) + (save-excursion + (goto-char beg) + (while (< beg end) + (setq char (following-char)) + (delete-char 1 nil) + (if (eq (upcase char) char) + (insert-char (downcase char) 1) + (insert-char (upcase char) 1)) + (setq beg (1+ beg))))))) + +(evil-define-operator evil-invert-char (beg end type) + "Invert case of character." + :motion evil-forward-char + (evil-invert-case beg end type)) + +(evil-define-operator evil-rot13 (beg end type) + "ROT13 encrypt text." + (if (eq type 'block) + (evil-apply-on-block 'evil-rot13 beg end) + (rot13-region beg end))) + +(evil-define-operator evil-join (beg end) + "Join the selected lines." + :motion evil-line + (let ((count (count-lines beg end))) + (when (> count 1) + (setq count (1- count))) + (dotimes (var count) + (join-line 1)))) + +(evil-define-operator evil-join-whitespace (beg end) + "Join the selected lines without changing whitespace. +\\<evil-normal-state-map>Like \\[evil-join], \ +but doesn't insert or remove any spaces." + :motion evil-line + (let ((count (count-lines beg end))) + (when (> count 1) + (setq count (1- count))) + (dotimes (var count) + (move-end-of-line 1) + (unless (eobp) + (delete-char 1))))) + +(evil-define-operator evil-fill (beg end) + "Fill text." + :move-point nil + :type line + (save-excursion + (condition-case nil + (fill-region beg end) + (error nil)))) + +(evil-define-operator evil-indent (beg end) + "Indent text." + :type line + (indent-region beg end) + (back-to-indentation)) + +(evil-define-operator evil-shift-left (beg end) + "Shift text to the left." + :type line + (indent-rigidly beg end (- evil-shift-width))) + +(evil-define-operator evil-shift-right (beg end) + "Shift text to the right." + :type line + (indent-rigidly beg end evil-shift-width)) (provide 'evil-operators) diff --git a/evil-repeat.el b/evil-repeat.el new file mode 100644 index 0000000..9635928 --- /dev/null +++ b/evil-repeat.el @@ -0,0 +1,432 @@ +;;;; Repeat system + +;; A repeat begins when leaving Normal state; it ends when re-entering +;; Normal state. The diagram below shows possible routes between +;; Normal state (N), Insert state (I), Visual state (V), +;; Operator-Pending state (O) and Replace state (R). (Emacs state +;; is an exception: nothing is repeated in that state.) +;; ___ +;; / \ +;; | R | +;; \___/ +;; ^ | +;; | | +;; ___ |___V ___ +;; / \ <------- / \ -------> / \ +;; | V | | N | | O | +;; \___/ -------> \___/ <------- \___/ +;; | | ^ | +;; | | | | +;; | V___| | +;; | / \ | +;; +--------> | I | <--------+ +;; \___/ +;; +;; Normally, a repeat is triggered whenever a command leaves Normal +;; state, or when it changes the buffer in Normal state (thereby +;; running the `after-change-functions' hook). A command may also +;; trigger a repeat with the :repeat command property. When executed +;; in Normal state, a command with :repeat t will always be repeated; +;; a command with :repeat nil will never be repeated. (Command +;; properties may be set with `evil-add-command-properties'.) +;; +;; When a repeat is being recorded, each command is stored in +;; `evil-repeat-info' from `post-command-hook'. When the repeat ends, +;; the accumulated changes in `evil-repeat-info' are inserted into +;; `evil-repeat-ring'. The dot command, "." (`evil-repeat'), +;; replays the most recent entry in the ring. +;; +;; In most cases, a command is recorded as the key-presses that +;; invoked it. In special cases, it may be recorded as a buffer +;; change. A repeat is represented as a list where each element +;; is either +;; +;; - an array, which corresponds to a key-sequence, or +;; - a list (FUNCTION PARAMS...), which will be called as +;; (apply FUNCTION PARAMS). +;; +;; This information is executed with `evil-execute-repeat-info', +;; which passes key-sequence elements to `execute-kbd-macro' and +;; executes other elements as defined above. +;; +;; A special version is `evil-execute-repeat-info-with-count'. +;; This function works as `evil-execute-repeat-info', but replaces +;; the count of the first command. This is done by parsing the +;; key-sequence, ignoring all calls to `digit-prefix-argument' and +;; `negative-argument', and prepending the count as a string to the +;; vector of the remaining key-sequence. + +(require 'evil-undo) +(require 'evil-states) + +(defun evil-repeat-start () + "Start recording a new repeat into `evil-repeat-info'." + (unless evil-recording-repeat + (evil-repeat-reset t) + (evil-repeat-record-position) + (evil-repeat-record-buffer))) + +(defun evil-repeat-stop () + "Stop recording a repeat. +Update `evil-repeat-ring' with the accumulated changes +in `evil-repeat-info' and clear variables." + (unwind-protect + (progn + (setq evil-repeat-info + (evil-normalize-repeat-info evil-repeat-info)) + (when evil-repeat-info + (ring-insert evil-repeat-ring evil-repeat-info))) + (evil-repeat-reset))) + +(defun evil-repeat-reset (&optional flag) + "Clear all repeat recording variables. +Set `evil-recording-repeat' to FLAG." + (when (markerp evil-repeat-marker) + (set-marker evil-repeat-marker nil)) + (setq evil-repeat-marker nil + evil-recording-repeat flag + evil-repeat-info nil + evil-repeat-changes nil + evil-repeat-keys nil + evil-repeat-buffer nil)) + +(defun evil-repeat-type (command &optional default) + "Return the :repeat property of COMMAND. +If COMMAND doesn't have this property, return DEFAULT." + (if (evil-has-property command :repeat) + (evil-get-command-property command :repeat) + default)) + +;; called from `evil-normal-state-exit-hook' +(defun evil-repeat-start-hook () + "Record a new repeat when exiting Normal state. +Does not record in Emacs state or if the current command +has :repeat nil." + (when (and (eq (evil-repeat-type this-command t) t) + (not (evil-emacs-state-p))) + (evil-repeat-start))) + +;; called from `pre-command-hook' +(defun evil-repeat-pre-hook () + "Record new repeat if the current command has :repeat t. +Disallow repeat if the command specifies :repeat nil." + (cond + ;; abort the repeat if the buffer changes, if in + ;; Emacs state or the command specifies :repeat abort + ((or (evil-repeat-different-buffer-p) + (evil-emacs-state-p) + (eq (evil-repeat-type this-command) 'abort)) + (evil-repeat-reset 'abort)) + ;; Already in repeat? + (evil-recording-repeat + (when (eq evil-recording-repeat 'abort) + (evil-repeat-reset))) + ;; Start a repeat from Normal state? + ((evil-normal-state-p) + (cond + ;; :repeat t, start repeat + ((eq (evil-repeat-type this-command) t) + (evil-repeat-start)) + ;; :repeat nil, prevent repeat + ((eq (evil-repeat-type this-command t) nil) + (evil-repeat-reset 'abort)) + ;; no :repeat, but the command may change the buffer + (t + (evil-repeat-record-buffer))))) + ;; refresh current repeat + (when evil-recording-repeat + (evil-repeat-record-keys) + (evil-repeat-record-position) + (evil-repeat-record-buffer) + (setq evil-repeat-changes nil))) + +;; called from `post-command-hook' +(defun evil-repeat-post-hook () + "Refresh `evil-repeat-info' while recording a repeat." + (cond + ((not evil-recording-repeat)) + ;; abort the repeat + ((or (eq evil-recording-repeat 'abort) + (evil-repeat-different-buffer-p) + (evil-emacs-state-p)) + (evil-repeat-reset)) + ;; finish the repeat + ((evil-normal-state-p) + (evil-repeat-record-command) + (evil-repeat-stop)) + (t + ;; refresh the repeat + (when evil-recording-repeat + (evil-repeat-record-command) + (evil-repeat-record-position))))) + +;; called from the `after-change-functions' hook +(defun evil-repeat-change-hook (beg end length) + "Record change information for current command." + (unless (or (eq evil-recording-repeat 'abort) + (evil-repeat-different-buffer-p t) + (null (evil-repeat-type this-command t)) + (evil-emacs-state-p) + (null evil-state)) + (unless evil-recording-repeat + (evil-repeat-start)) + (when (and (eq (evil-repeat-type this-command) 'change) + evil-repeat-marker) + (evil-repeat-record-change + (list (- beg evil-repeat-marker) + (buffer-substring beg end) + length))))) + +(defun evil-repeat-record-command () + "Record the current command into `evil-repeat-info'." + (unless evil-recording-repeat + (evil-repeat-start)) + (cond + ((not (functionp this-command))) ; ignore macros + ;; prefix arguments always preceed the actual commands and they + ;; are part of the key sequence of the actual command, therefore + ;; they can be safely ignored + ((memq this-command + '(digit-argument + negative-argument + universal-argument + universal-argument-minus + universal-argument-other-key))) + ;; check if the command is change-based + ((eq (evil-repeat-type this-command) 'change) + (evil-repeat-record `(evil-execute-change + ,evil-repeat-changes + ,(- (point) evil-repeat-marker)))) + ;; usual command: record by key-sequence + (t + (evil-repeat-record (if (> (length (this-command-keys)) 0) + (this-command-keys) + evil-repeat-keys))))) + +(defun evil-repeat-record (info) + "Add INFO to the end of `evil-repeat-info'." + (unless evil-recording-repeat + (evil-repeat-start)) + (setq evil-repeat-info (nconc evil-repeat-info (list info)))) + +(defun evil-repeat-record-change (change) + "Add CHANGE to the end of `evil-repeat-changes'." + (unless evil-recording-repeat + (evil-repeat-start)) + (setq evil-repeat-changes (nconc evil-repeat-changes (list change)))) + +(defun evil-repeat-record-position (&optional pos) + "Set `evil-repeat-marker' to POS or point." + (unless evil-recording-repeat + (evil-repeat-start)) + (unless (markerp evil-repeat-marker) + (setq evil-repeat-marker (make-marker))) + (set-marker evil-repeat-marker (or pos (point)))) + +(defun evil-repeat-record-buffer () + "Set `evil-repeat-buffer' to the current buffer." + (unless evil-recording-repeat + (evil-repeat-start)) + (setq evil-repeat-buffer (current-buffer))) + +;; Some functions, such as `execute-kbd-macro', may irrevocably +;; clear `this-command-keys'. Therefore, make a backup from +;; `pre-command-hook'. +(defun evil-repeat-record-keys (&optional pos) + "Set `evil-repeat-keys' to the current value of `this-command-keys'." + (unless evil-recording-repeat + (evil-repeat-start)) + (setq evil-repeat-keys (this-command-keys))) + +(defmacro evil-save-repeat-info (&rest body) + "Execute BODY, protecting the values of repeat variables." + (declare (indent defun) + (debug t)) + `(let ((evil-repeat-ring (ring-copy evil-repeat-ring)) + evil-repeating-command + evil-recording-repeat + evil-repeat-info + evil-repeat-changes + evil-repeat-marker + evil-repeat-keys + evil-repeat-buffer + this-command + last-command) + ,@body)) + +(defun evil-repeat-different-buffer-p (&optional strict) + "Whether the buffer has changed in a repeat. +If STRICT is non-nil, returns t if the previous buffer +is unknown; otherwise returns t only if the previous +buffer is known and different from the current buffer." + (and (or (buffer-live-p evil-repeat-buffer) strict) + (not (eq (current-buffer) evil-repeat-buffer)))) + +(defun evil-normalize-repeat-info (repeat-info) + "Concatenate consecutive arrays in REPEAT-INFO. +Returns a single array." + (let* ((result (cons nil nil)) + (result-last result) + cur cur-last) + (dolist (rep repeat-info) + (cond + ((arrayp rep) + (setq rep (listify-key-sequence rep)) + (cond + (cur + (setcdr cur-last (cons rep nil)) + (setq cur-last (cdr cur-last))) + (t + (setq cur (cons rep nil)) + (setq cur-last cur)))) + (t + (when cur + (setcdr result-last (cons (apply #'vconcat cur) nil)) + (setq result-last (cdr result-last)) + (setq cur nil)) + (setcdr result-last (cons rep nil)) + (setq result-last (cdr result-last))))) + (when cur + (setcdr result-last (cons (apply #'vconcat cur) nil))) + (cdr result))) + +(defun evil-execute-change (changes rel-point) + "Executes as list of changes. + +CHANGES is a list of triples (REL-BEG INSERT-TEXT NDEL). +REL-BEG is the relative position (to point) where the change +takes place. INSERT-TEXT is the text to be inserted at that +position and NDEL the number of characters to be deleted at that +position before insertion. + +REL-POINT is the relative position to point before the changed +where point should be placed after all changes." + (evil-save-repeat-info + (let ((p (point))) + (dolist (change changes) + (goto-char (+ p (nth 0 change))) + (delete-char (nth 2 change)) + (insert (nth 1 change))) + (goto-char (+ p rel-point))))) + +(defun evil-execute-repeat-info (repeat-info) + "Executes a repeat-information REPEAT-INFO." + (let ((evil-repeating-command t)) + (evil-save-repeat-info + (dolist (rep (copy-sequence repeat-info)) + (cond + ((arrayp rep) + (execute-kbd-macro rep)) + ((consp rep) + (apply (car rep) (cdr rep))) + (t + (error "Unexpected repeat-info: %S" rep))))))) + +;; TODO: currently we prepend the replacing count before the +;; key-sequence that calls the command. Can we use direct +;; modification of prefix-arg instead? Does it work in +;; conjunction with execute-kbd-macro? +(defun evil-execute-repeat-info-with-count (count repeat-info) + "Repeat the repeat-information REPEAT-INFO with the count of +the first command replaced by COUNT. The count is replaced if +and only if COUNT is non-nil." + (let ((evil-repeating-command t)) + (evil-save-repeat-info + (cond + ;; do nothing (zero repeating) + ((and count (zerop count))) + ;; replace count + (count + (let ((evil-repeat-count count) + done) + (while (and repeat-info + (arrayp (car repeat-info)) + (not done)) + (let* ((count-and-cmd (evil-extract-count (pop repeat-info)))) + (push (vconcat (number-to-string count) + (nth 2 count-and-cmd) + (nth 3 count-and-cmd)) + repeat-info) + (setq done t))) + (evil-execute-repeat-info repeat-info))) + ;; repeat with original count + (t + (evil-execute-repeat-info repeat-info)))))) + +(evil-define-command evil-repeat (count &optional save-point) + "Repeat the last editing command with count replaced by COUNT. +If SAVE-POINT is non-nil, do not move point." + :repeat nil + (interactive (list current-prefix-arg + (not evil-repeat-move-cursor))) + (cond + (evil-repeating-command + (error "Already executing repeat")) + (save-point + (save-excursion + (evil-repeat count))) + (t + (let ((confirm-kill-emacs t) + (kill-buffer-hook + (cons #'(lambda () + (error "Cannot delete buffer in repeat command")) + kill-buffer-hook))) + (setq evil-last-repeat (list (point) count)) + (evil-save-repeat-info + (evil-with-undo + (evil-execute-repeat-info-with-count + count (ring-ref evil-repeat-ring 0)))))))) + +;; TODO: the same issue concering disabled undos as for `evil-paste-pop' +(defun evil-repeat-pop (count) + "Replace the just repeated command with a previously executed command. +This command is allowed only immediately after a `evil-repeat', +`evil-repeat-pop' or `evil-repeat-pop-next'. This command uses +the same repeat count that was used for the first repeat. + +The COUNT argument inserts the COUNT-th previous kill. If COUNT +is negative this is a more recent kill." + (interactive "p") + (unless (and (eq last-command 'evil-repeat) + evil-last-repeat) + (error "Previous command was not evil-repeat: %s" last-command)) + (evil-undo-pop) + (goto-char (car evil-last-repeat)) + ;; rotate the repeat-ring + (while (> count 0) + (ring-insert-at-beginning evil-repeat-ring + (ring-remove evil-repeat-ring 0)) + (setq count (1- count))) + (setq this-command 'evil-repeat) + (evil-repeat (cadr evil-last-repeat))) + +(defun evil-repeat-pop-next (count) + "Same as `evil-repeat-pop' with negative COUNT." + (interactive "p") + (evil-repeat-pop (- count))) + +;; updates `evil-repeat-info' properly +(defun evil-read-key (&optional prompt) + "Read a key from the keyboard. +Translates it according to the input method." + (let ((old-global-map (current-global-map)) + (new-global-map (make-sparse-keymap)) + (overriding-terminal-local-map (make-sparse-keymap)) + overriding-local-map) + (unwind-protect + (progn + (define-key new-global-map [menu-bar] + (lookup-key global-map [menu-bar])) + (define-key new-global-map [tool-bar] + (lookup-key global-map [tool-bar])) + (add-to-list 'new-global-map + (make-char-table 'display-table + 'self-insert-command) t) + (use-global-map new-global-map) + (evil-repeat-record (this-command-keys)) + (aref (read-key-sequence prompt nil t) 0)) + (use-global-map old-global-map)))) + +(provide 'evil-repeat) + +;;; evil-repeat.el ends here diff --git a/evil-replace.el b/evil-replace.el new file mode 100644 index 0000000..a25e983 --- /dev/null +++ b/evil-replace.el @@ -0,0 +1,64 @@ +;;;; Replace state + +(require 'evil-states) +(require 'evil-repeat) +(require 'evil-operators) + +(evil-define-state replace + "Replace state." + :tag " <R> " + :cursor hbar + :message "-- REPLACE --" + (cond + ((evil-replace-state-p) + (overwrite-mode 1) + (add-hook 'pre-command-hook 'evil-replace-pre-command nil t)) + (t + (overwrite-mode -1) + (remove-hook 'pre-command-hook 'evil-replace-pre-command t) + (when evil-move-cursor-back + (evil-adjust)))) + (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))) + 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)))))) + +(evil-define-operator evil-replace (beg end type char) + "Replace text from BEG to END with CHAR." + :motion evil-forward-char + (interactive (list (evil-save-cursor + (evil-set-cursor evil-replace-state-cursor) + (evil-read-key)))) + (if (eq type 'block) + (save-excursion + (evil-apply-on-block 'evil-replace beg end nil char)) + (goto-char beg) + (while (< (point) end) + (if (eq (char-after) ?\n) + (forward-char) + (delete-char 1) + (insert-char char 1))) + (goto-char (max beg (1- end))))) + +(provide 'evil-replace) + +;;; evil-replace.el ends here diff --git a/evil-search.el b/evil-search.el new file mode 100644 index 0000000..997d1b5 --- /dev/null +++ b/evil-search.el @@ -0,0 +1,327 @@ +;;;; Search + +(require 'evil-common) +(require 'evil-motions) + +(evil-define-motion evil-search-forward () + (format "Search forward for user-entered text. +Searches for regular expression if `evil-regexp-search' is t.%s" + (if (and (fboundp 'isearch-forward) + (documentation 'isearch-forward)) + (format "\n\nBelow is the documentation string \ +for `isearch-forward',\nwhich lists available keys:\n\n%s" + (documentation 'isearch-forward)) "")) + :type exclusive + (evil-search-incrementally t evil-regexp-search)) + +(evil-define-motion evil-search-backward () + (format "Search backward for user-entered text. +Searches for regular expression if `evil-regexp-search' is t.%s" + (if (and (fboundp 'isearch-forward) + (documentation 'isearch-forward)) + (format "\n\nBelow is the documentation string \ +for `isearch-forward',\nwhich lists available keys:\n\n%s" + (documentation 'isearch-forward)) "")) + :jump t + :type exclusive + (evil-search-incrementally nil evil-regexp-search)) + +(evil-define-motion evil-search-next (count) + "Repeat the last search." + :jump t + :type exclusive + (dotimes (var (or count 1)) + (evil-search (if evil-regexp-search + (car-safe regexp-search-ring) + (car-safe search-ring)) + isearch-forward evil-regexp-search))) + +(evil-define-motion evil-search-previous (count) + "Repeat the last search in the opposite direction." + :jump t + :type exclusive + (dotimes (var (or count 1)) + (evil-search (if evil-regexp-search + (car-safe regexp-search-ring) + (car-safe search-ring)) + (not isearch-forward) evil-regexp-search))) + +(evil-define-motion evil-search-symbol-backward (count) + "Search backward for symbol under point." + :jump t + :type exclusive + (dotimes (var (or count 1)) + (evil-search-symbol nil))) + +(evil-define-motion evil-search-symbol-forward (count) + "Search forward for symbol under point." + :jump t + :type exclusive + (dotimes (var (or count 1)) + (evil-search-symbol t))) + +(evil-define-motion evil-goto-definition () + "Go to definition or first occurrence of symbol under point." + :jump t + :type exclusive + (let* ((string (evil-find-symbol t)) + (search (if evil-regexp-search (regexp-quote string) string)) + ientry ipos) + ;; load imenu if available + (unless (featurep 'imenu) + (condition-case nil + (require 'imenu) + (error nil))) + (if (null string) + (error "No symbol under cursor") + (setq isearch-forward t) + ;; if imenu is available, try it + (cond + ((fboundp 'imenu--make-index-alist) + (condition-case nil + (setq ientry (imenu--make-index-alist)) + (error nil)) + (setq ientry (assoc string ientry)) + (setq ipos (cdr ientry)) + (unless (markerp ipos) + (setq ipos (cadr ientry))) + (cond + ;; imenu found a position, so go there and + ;; highlight the occurrence + ((and (markerp ipos) + (eq (marker-buffer ipos) (current-buffer))) + (evil-search search t evil-regexp-search ipos)) + ;; imenu failed, so just go to first occurrence in buffer + (t + (evil-search search t evil-regexp-search (point-min))))) + ;; no imenu, so just go to first occurrence in buffer + (t + (evil-search search t evil-regexp-search (point-min))))))) + +(defun evil-search-incrementally (forward regexp-p) + "Search incrementally for user-entered text." + (let ((evil-search-prompt (evil-search-prompt forward)) + (isearch-search-fun-function 'evil-isearch-function) + (point (point)) + search-nonincremental-instead) + (setq isearch-forward forward) + (evil-save-echo-area + (if forward + (isearch-forward regexp-p) + (isearch-backward regexp-p)) + (when (and (eq point (point)) + (not (string= isearch-string ""))) + (if forward + (isearch-repeat-forward) + (isearch-repeat-backward)) + (isearch-exit)) + ;; always position point at the beginning of the match + (when (and forward isearch-other-end) + (goto-char isearch-other-end)) + (evil-flash-search-pattern + (evil-search-message isearch-string forward))))) + +(defun evil-flash-search-pattern (string &optional all) + "Flash last search matches for duration of `evil-flash-delay'. +If ALL is non-nil, flash all matches. STRING is a string +to display in the echo area." + (let ((lazy-highlight-initial-delay 0) + (isearch-search-fun-function 'evil-isearch-function) + (isearch-case-fold-search case-fold-search) + (disable (lambda (&optional arg) (evil-flash-hook t)))) + (when evil-flash-timer + (cancel-timer evil-flash-timer)) + (unless (or (null string) + (string= string "")) + (evil-echo-area-save) + (evil-echo string) + (isearch-highlight (match-beginning 0) (match-end 0)) + (when all + (setq isearch-lazy-highlight-wrapped nil + isearch-lazy-highlight-start (point) + isearch-lazy-highlight-end (point)) + (isearch-lazy-highlight-new-loop) + (unless isearch-lazy-highlight-overlays + (isearch-lazy-highlight-update))) + (add-hook 'pre-command-hook 'evil-flash-hook) + (add-hook 'pre-command-hook 'evil-clean-isearch-overlays) + (setq evil-flash-timer + (run-at-time evil-flash-delay nil disable))))) + +(defun evil-clean-isearch-overlays () + "Clean isearch overlays unless `this-command' is search." + (remove-hook 'pre-command-hook 'evil-clean-isearch-overlays) + (unless (memq this-command + '(evil-search-backward + evil-search-forward + evil-search-next + evil-search-previous + evil-search-symbol-backward + evil-search-symbol-forward)) + (isearch-clean-overlays))) + +(defun evil-flash-hook (&optional force) + "Disable hightlighting if `this-command' is not search. +Disable anyway if FORCE is t." + (when (or force + ;; to avoid flicker, don't disable highlighting + ;; if the next command is also a search command + (not (memq this-command + '(evil-search-backward + evil-search-forward + evil-search-next + evil-search-previous + evil-search-symbol-backward + evil-search-symbol-forward)))) + (evil-echo-area-restore) + (isearch-dehighlight) + (setq isearch-lazy-highlight-last-string nil) + (lazy-highlight-cleanup t) + (when evil-flash-timer + (cancel-timer evil-flash-timer))) + (remove-hook 'pre-command-hook 'evil-flash-hook)) + +(defun evil-search-function (&optional forward regexp-p wrap) + "Return a search function. +If FORWARD is nil, search backward, otherwise forward. +If REGEXP-P is non-nil, the input is a regular expression. +If WRAP is non-nil, the search wraps around the top or bottom +of the buffer." + `(lambda (string &optional bound noerror count) + (let ((start (point)) + (search-fun ',(if regexp-p + (if forward + 're-search-forward + 're-search-backward) + (if forward + 'search-forward + 'search-backward))) + result) + (setq result (funcall search-fun string bound + ,(if wrap t 'noerror) count)) + (when (and ,wrap (null result)) + (goto-char ,(if forward '(point-min) '(point-max))) + (unwind-protect + (setq result (funcall search-fun string bound noerror count)) + (unless result + (goto-char start)))) + result))) + +(defun evil-isearch-function () + "Return a search function for use with isearch. +Based on `isearch-regexp' and `isearch-forward'." + (evil-search-function isearch-forward evil-regexp-search evil-search-wrap)) + +(defun evil-search (string forward &optional regexp-p start) + "Search for STRING and highlight matches. +If FORWARD is nil, search backward, otherwise forward. +If REGEXP-P is non-nil, STRING is taken to be a regular expression. +START is the position to search from; if unspecified, it is +one more than the current position." + (when (and (stringp string) + (not (string= string ""))) + (let* ((orig (point)) + (start (or start + (if forward + (min (point-max) (1+ orig)) + orig))) + (isearch-regexp regexp-p) + (isearch-forward forward) + (search-func (evil-search-function + forward regexp-p evil-search-wrap))) + ;; no text properties, thank you very much + (set-text-properties 0 (length string) nil string) + ;; position to search from + (goto-char start) + (condition-case nil + (funcall search-func string) + (search-failed + (goto-char orig) + (error "\"%s\": %s not found" + string (if regexp-p "pattern" "string")))) + (setq isearch-string string) + (isearch-update-ring string regexp-p) + ;; handle opening and closing of invisible area + (funcall isearch-filter-predicate + (match-beginning 0) (match-end 0)) + ;; always position point at the beginning of the match + (goto-char (match-beginning 0)) + ;; determine message for echo area + (cond + ((and forward (< (point) start)) + (setq string "Search wrapped around BOTTOM of buffer")) + ((and (not forward) (> (point) start)) + (setq string "Search wrapped around TOP of buffer")) + (t + (setq string (evil-search-message string forward)))) + (evil-flash-search-pattern string t)))) + +(defun evil-search-symbol (forward) + "Search for symbol near point. +If FORWARD is nil, search backward, otherwise forward." + (let ((string (car-safe regexp-search-ring)) + (move (if forward 'forward-char 'backward-char)) + (end (if forward 'eobp 'bobp))) + (setq isearch-forward forward) + (cond + ((and (memq last-command + '(evil-search-symbol-forward + evil-search-symbol-backward)) + (stringp string) + (not (string= string ""))) + (evil-search string forward evil-search-wrap)) + (t + (setq string (evil-find-symbol forward)) + (if (null string) + (error "No symbol under point") + (setq string (format "\\_<%s\\_>" (regexp-quote string)))) + (evil-search string forward evil-search-wrap))))) + +(defun evil-find-symbol (forward) + "Return symbol near point as a string. +If FORWARD is nil, search backward, otherwise forward. +Returns nil if nothing is found." + (let ((move (if forward 'forward-char 'backward-char)) + (end (if forward 'eobp 'bobp)) + string) + (save-excursion + (setq string (thing-at-point 'symbol)) + ;; if there's nothing under point, go forwards + ;; (or backwards) to find it + (while (and (null string) (not (funcall end))) + (funcall move) + (setq string (thing-at-point 'symbol))) + (when (stringp string) + (set-text-properties 0 (length string) nil string)) + (when (> (length string) 0) + string)))) + +(defun evil-search-prompt (forward) + "Return the search prompt for the given direction." + (if forward "/" "?")) + +(defun evil-search-message (string forward) + "Prefix STRING with the search prompt." + (format "%s%s" (evil-search-prompt forward) string)) + +(defadvice isearch-message-prefix (around evil activate) + "Use `evil-search-prompt'." + (if evil-search-prompt + (setq ad-return-value evil-search-prompt) + ad-do-it)) + +(defadvice isearch-delete-char (around evil activate) + "Exit search if no search string." + (if (and evil-search-prompt + (string= isearch-string "")) + (isearch-exit) + ad-do-it)) + +(defadvice isearch-lazy-highlight-search (around evil activate) + "Never wrap the search in this context." + (let (evil-search-wrap) + ad-do-it)) + +(provide 'evil-search) + +;;; evil-search.el ends here diff --git a/evil-states.el b/evil-states.el index 9e3f45f..4688be8 100644 --- a/evil-states.el +++ b/evil-states.el @@ -46,33 +46,64 @@ (require 'evil-common) -(defun evil-enable () - "Enable Evil in the current buffer, if appropriate. -To enable Evil globally, do (evil-mode 1)." - ;; TODO: option for enabling vi keys in the minibuffer - (unless (minibufferp) - (evil-local-mode 1))) - (define-minor-mode evil-local-mode "Minor mode for setting up Evil in a single buffer." :init-value nil (cond (evil-local-mode (setq emulation-mode-map-alists - (evil-concat-lists '(evil-mode-map-alist) - emulation-mode-map-alists)) - (evil-refresh-local-maps) + (evil-concat-alists '(evil-mode-map-alist) + emulation-mode-map-alists)) + (evil-refresh-local-keymaps) (unless (memq 'evil-modeline-tag global-mode-string) (setq global-mode-string - (append '(" " evil-modeline-tag " ") + (append '("" evil-modeline-tag) global-mode-string))) - (evil-normal-state)) + (ad-enable-advice 'show-paren-function 'around 'evil) + (ad-activate 'show-paren-function) + ;; restore the proper value of `major-mode' in Fundamental buffers + (when (eq major-mode 'evil-local-mode) + (setq major-mode 'fundamental-mode)) + ;; determine and enable the initial state + (evil-initialize-state) + ;; re-determine the initial state in `post-command-hook' since the + ;; major mode may not be initialized yet, and some modes neglect + ;; to run `after-change-major-mode-hook' + (add-hook 'post-command-hook 'evil-initialize-state t t) + (add-hook 'after-change-functions 'evil-repeat-change-hook nil t) + (add-hook 'pre-command-hook 'evil-repeat-pre-hook nil t) + (add-hook 'post-command-hook 'evil-repeat-post-hook nil t)) (t - (when evil-state - (funcall (evil-state-func) -1))))) + (let (new-global-mode-string) + (while global-mode-string + (let ((next (pop global-mode-string))) + (if (eq next 'evil-modeline-tag) + (pop new-global-mode-string) ;; remove the "" + (push next new-global-mode-string)))) + (setq global-mode-string (nreverse new-global-mode-string))) + (ad-disable-advice 'show-paren-function 'around 'evil) + (ad-activate 'show-paren-function) + (evil-change-state nil)))) + +(defun evil-initialize () + "Enable Evil in the current buffer, if appropriate. +To enable Evil globally, do (evil-mode 1)." + ;; TODO: option for enabling vi keys in the minibuffer + (unless (minibufferp) + (evil-local-mode 1) + (remove-hook 'post-command-hook 'evil-initialize-state t))) (define-globalized-minor-mode evil-mode - evil-local-mode evil-enable) + evil-local-mode evil-initialize) + +;; to ensure that Fundamental buffers come up in Normal state, +;; initialize `fundamental-mode' via `evil-local-mode' +(defadvice evil-mode (after evil activate) + "Enable Evil in Fundamental mode." + (if evil-mode + ;; this is changed back when initializing `evil-local-mode' + (setq-default major-mode 'evil-local-mode) + (setq-default major-mode 'fundamental-mode))) (put 'evil-mode 'function-documentation "Toggle Evil in all buffers. @@ -82,124 +113,311 @@ current buffer only.") (defun evil-state-property (state prop) "Return property PROP for STATE." - (evil-get-property evil-states-alist state prop)) + (evil-get-property evil-state-properties state prop)) (defun evil-state-p (sym) "Whether SYM is the name of a state." - (assq sym evil-states-alist)) + (assq sym evil-state-properties)) + +(defun evil-initialize-state (&optional buffer) + "Initialize Evil state in BUFFER." + (with-current-buffer (or buffer (current-buffer)) + (evil-change-to-default-state buffer) + (remove-hook 'post-command-hook 'evil-initialize-state t))) + +(defun evil-change-to-default-state (&optional buffer) + "Change state to the default state for BUFFER. +This is the state the buffer initially comes up in." + (interactive) + (with-current-buffer (or buffer (current-buffer)) + (evil-change-state (evil-buffer-state buffer 'normal)))) + +(defun evil-change-to-previous-state (&optional buffer) + "Change the state of BUFFER to its previous state." + (interactive) + (with-current-buffer (or buffer (current-buffer)) + (evil-change-state (or evil-previous-state evil-state 'normal)))) -(defun evil-state-func (&optional state) - "Return the toggle function for STATE." - (setq state (or state evil-state)) - (evil-state-property state :mode)) +(defun evil-change-state (state) + "Change state to STATE. +Disable all states if nil." + (let ((func (evil-state-property (or state evil-state) :toggle))) + (when (and (functionp func) + (not (eq state evil-state))) + (funcall func (unless state -1))))) (defun evil-state-keymaps (state &rest excluded) - "Return an ordered list of keymaps activated by STATE." + "Return an ordered list of keymaps activated by STATE. +Skip states listed in EXCLUDED." (let* ((state (or state evil-state)) (map (symbol-value (evil-state-property state :keymap))) (local-map (symbol-value (evil-state-property state :local-keymap))) (aux-maps (evil-state-auxiliary-keymaps state)) (enable (evil-state-property state :enable)) - (excluded (add-to-list 'excluded state)) - ;; the keymaps for STATE - (result (append (list local-map) aux-maps (list map)))) + result) + (unless (memq state enable) + (add-to-list 'enable state)) ;; the keymaps for other states and modes enabled by STATE (dolist (entry enable result) (cond + ((memq entry excluded)) + ((eq entry state) + (setq result + (evil-concat-lists + result + (list local-map) aux-maps (list map))) + (add-to-list 'excluded state)) ((evil-state-p entry) - (unless (memq entry excluded) - (dolist (mode (evil-state-keymaps entry excluded)) - (add-to-list 'result mode t)))) + (setq result (evil-concat-lists + result + (apply 'evil-state-keymaps entry excluded)))) + ((keymapp entry) + (add-to-list 'result entry t 'eq)) + ((keymapp (symbol-value entry)) + (add-to-list 'result (symbol-value entry) t 'eq)) (t - (add-to-list 'result entry t)))))) - -(defun evil-state-auxiliary-keymaps (state) - "Return an ordered list of auxiliary keymaps for STATE." - (let* ((state (or state evil-state)) - (alist (symbol-value (evil-state-property state :aux))) - result) - (dolist (map (current-active-maps) result) - (when (keymapp (setq map (cdr (assq map alist)))) - (add-to-list 'result map t))))) + (setq map (evil-mode-keymap entry)) + (when map + (add-to-list 'result map t 'eq))))))) (defun evil-normalize-keymaps (&optional state) "Create a buffer-local value for `evil-mode-map-alist'. Its order reflects the state in the current buffer." - (let ((state (or state evil-state)) alist mode) - ;; initialize a buffer-local value - (setq evil-mode-map-alist - (copy-sequence (default-value 'evil-mode-map-alist))) - ;; update references to buffer-local keymaps - (evil-refresh-local-maps) + (let ((state (or state evil-state)) + alist mode) + (evil-refresh-global-keymaps) + (evil-refresh-local-keymaps) ;; disable all modes - (dolist (entry evil-mode-map-alist) - (set (car entry) nil)) + (dolist (mode (mapcar 'car (append evil-mode-map-alist + evil-local-keymaps-alist))) + (when (fboundp mode) + (funcall mode -1)) + (set mode nil)) ;; enable modes for current state - (unless (null state) + (when state (dolist (map (evil-state-keymaps state)) - (setq mode (or (car (rassq map evil-mode-map-alist)) - (car (rassq map minor-mode-map-alist)))) - (when mode - (set mode t) - (add-to-list 'alist (cons mode map) t))) - ;; move the enabled modes to the front of the list - (setq evil-mode-map-alist - (evil-concat-lists - alist evil-mode-map-alist))))) + (if (evil-auxiliary-keymap-p map) + (add-to-list 'alist (cons t map) t) + (when (setq mode (evil-keymap-mode map)) + (when (fboundp mode) + (funcall mode 1)) + (set mode t) + ;; refresh the keymap in case it has changed + ;; (e.g., `evil-operator-shortcut-map' is + ;; reset on toggling) + (setq map (or (evil-mode-keymap mode) map)) + (evil-add-to-alist 'alist mode map))))) + ;; move the enabled modes to the front of the list + (setq evil-mode-map-alist + (evil-filter-list (lambda (elt) + (assq (car-safe elt) alist)) + evil-mode-map-alist)) + (setq evil-mode-map-alist (append alist evil-mode-map-alist)))) + +(defun evil-refresh-global-keymaps () + "Refresh the global value of `evil-mode-map-alist'. +Update its entries if keymaps change." + (let ((temp (default-value 'evil-mode-map-alist)) + mode map) + (dolist (entry evil-global-keymaps-alist) + (setq mode (car entry) + map (cdr entry)) + (evil-add-to-alist 'temp mode (symbol-value map))) + (setq-default evil-mode-map-alist temp))) ;; Local keymaps are implemented using buffer-local variables. ;; However, unless a buffer-local value already exists, ;; `define-key' acts on the variable's default (global) value. ;; So we need to initialize the variable whenever we enter a ;; new buffer or when the buffer-local values are reset. -(defun evil-refresh-local-maps () - "Initialize a buffer-local value for all local keymaps." - (let ((modes (evil-state-property nil :local-mode)) - (maps (evil-state-property nil :local-keymap)) - map mode state) - (dolist (entry maps) - (setq state (car entry) - map (cdr entry) - mode (cdr (assq state modes))) - ;; initalize the variable - (unless (symbol-value map) +(defun evil-refresh-local-keymaps () + "Refresh the buffer-local value of `evil-mode-map-alist'. +Initialize a buffer-local value for all local keymaps +and update their list entries." + (setq evil-mode-map-alist + (copy-sequence (default-value 'evil-mode-map-alist))) + (dolist (entry evil-local-keymaps-alist) + (let ((mode (car entry)) + (map (cdr entry))) + (unless (and (keymapp (symbol-value map)) + (assq map (buffer-local-variables))) (set map (make-sparse-keymap))) - ;; refresh the keymap's entry in `evil-mode-map-alist' - (setq evil-mode-map-alist - (copy-sequence evil-mode-map-alist)) - (evil-add-to-alist 'evil-mode-map-alist mode - (symbol-value map))))) - -(defun evil-set-cursor (specs) - "Change the cursor's apperance according to SPECS. -SPECS may be a cursor type as per `cursor-type', a color -string as passed to `set-cursor-color', a zero-argument -function for changing the cursor, or a list of the above. -If SPECS is nil, make the cursor a black box." - (set-cursor-color "black") - (setq cursor-type 'box) - (unless (and (listp specs) (not (consp specs))) - (setq specs (list specs))) - (dolist (spec specs) - (cond - ((functionp spec) - (funcall spec)) - ((stringp spec) - (set-cursor-color spec)) - (t - (setq cursor-type spec)))) - (redisplay)) + (evil-add-to-alist 'evil-mode-map-alist + mode (symbol-value map))))) + +(defun evil-keymap-mode (keymap) + "Return minor mode for KEYMAP. +See also `evil-mode-keymap'." + (let ((map (if (keymapp keymap) keymap (symbol-value keymap))) + (var (when (symbolp keymap) keymap))) + (or (when var + (or (car (rassq var evil-global-keymaps-alist)) + (car (rassq var evil-local-keymaps-alist)))) + (car (rassq map (mapcar (lambda (e) + ;; from (MODE-VAR . MAP-VAR) + ;; to (MODE-VAR . MAP) + (cons (car-safe e) + (symbol-value (cdr-safe e)))) + (append evil-global-keymaps-alist + evil-local-keymaps-alist)))) + (car (rassq map minor-mode-map-alist))))) + +(defun evil-mode-keymap (mode &optional variable) + "Return keymap for minor MODE. +Return the keymap variable if VARIABLE is non-nil. +See also `evil-keymap-mode'." + (let* ((var (or (cdr (assq mode evil-global-keymaps-alist)) + (cdr (assq mode evil-local-keymaps-alist)))) + (map (or (symbol-value var) + (cdr (assq mode minor-mode-map-alist))))) + (if variable var map))) -(defun evil-change-state (state) - "Change state to STATE. -Disable all states if nil." - (let ((func (evil-state-property - (or state evil-state 'emacs) :mode))) - (funcall func (if state 1 -1)))) +(defun evil-state-auxiliary-keymaps (state) + "Return an ordered list of auxiliary keymaps for STATE." + (let* ((state (or state evil-state)) + aux result) + (dolist (map (current-active-maps) result) + (when (setq aux (evil-get-auxiliary-keymap map state)) + (add-to-list 'result aux t 'eq))))) + +(defun evil-set-auxiliary-keymap (map state &optional aux) + "Set the auxiliary keymap for MAP in STATE to AUX. +If AUX is nil, create a new auxiliary keymap." + (unless (keymapp aux) + (setq aux (make-sparse-keymap + (format "Auxiliary keymap for %s state" state)))) + (define-key map + (vconcat (list (intern (format "%s-state" state)))) aux) + aux) + +(defun evil-get-auxiliary-keymap (map state) + "Get the auxiliary keymap for MAP in STATE." + (lookup-key map (vconcat (list (intern (format "%s-state" state)))))) + +(defun evil-auxiliary-keymap-p (map) + "Whether MAP is an auxiliary keymap." + (and (keymapp map) + (string-match "Auxiliary keymap" (or (keymap-prompt map) "")) t)) + +(defun evil-define-key (state keymap key def) + "Create a STATE binding from KEY to DEF for KEYMAP. +The syntax is equivalent to that of `define-key'. For example: + + (evil-define-key 'normal foo-mode-map \"a\" 'bar) + +This will create a binding from \"a\" to `bar' in Normal state, +which will be active whenever `foo-mode-map' is active." + (let ((aux (if state + (or (evil-get-auxiliary-keymap keymap state) + (evil-set-auxiliary-keymap keymap state)) + keymap))) + (define-key aux key def) + ;; ensure the prompt string comes first + (evil-set-keymap-prompt aux (keymap-prompt aux)))) + +(put 'evil-define-key 'lisp-indent-function 'defun) + +;; these may be useful for programmatic purposes +(defun evil-global-set-key (state key def) + "Bind KEY to DEF in STATE." + (define-key (symbol-value (evil-state-property state :keymap)) + key def)) + +(defun evil-local-set-key (state key def) + "Bind KEY to DEF in STATE in the current buffer." + (define-key (symbol-value (evil-state-property state :local-keymap)) + key def)) + +(defun evil-mode-state (mode &optional default) + "Return Evil state to use for MODE, or DEFAULT if none." + (let (state modes) + (or (catch 'loop + (dolist (entry (evil-state-property nil :modes)) + (setq state (car entry) + modes (symbol-value (cdr entry))) + (when (memq mode modes) + (throw 'loop state)))) + default))) + +(defun evil-buffer-state (&optional buffer default) + "Return Evil state to use for BUFFER, or DEFAULT if none." + (let (state) + (with-current-buffer (or buffer (current-buffer)) + (or (catch 'loop + (dolist (mode (append (mapcar 'car minor-mode-map-alist) + (list major-mode))) + (when (setq state (evil-mode-state mode)) + (throw 'loop state)))) + default)))) + +(defmacro evil-define-keymap (keymap doc &rest body) + "Define a keymap KEYMAP listed in `evil-mode-map-alist'. +That means it will have precedence over regular keymaps. + +DOC is the documentation for the variable. BODY, if specified, +is executed after toggling the mode. Optional keyword arguments +may be specified before the body code: + +:mode VAR Mode variable. If unspecified, the variable + is based on the keymap name. +:local BOOLEAN Whether the keymap should be buffer-local, that is, + reinitialized for each buffer. +:func BOOLEAN Create a toggle function even if BODY is empty. + +\(fn KEYMAP DOC [[KEY VAL]...] BODY...)" + (declare (indent defun) + (debug (&define name + [&optional stringp] + [&rest [keywordp sexp]] + def-body))) + (let (arg func key local mode) + (while (keywordp (car-safe body)) + (setq key (pop body) + arg (pop body)) + (cond + ((eq key :mode) + (setq mode arg)) + ((eq key :local) + (setq local arg)) + ((eq key :func) + (setq func arg)))) + (setq mode (or mode + (intern (replace-regexp-in-string + "\\(?:-\\(?:mode-\\)?\\(?:key\\)?map\\)?$" + "-mode" + (symbol-name keymap))))) + `(progn + (defvar ,keymap ,(unless local '(make-sparse-keymap))) + (unless (get ',keymap 'variable-documentation) + (put ',keymap 'variable-documentation ,doc)) + (defvar ,mode nil) + (unless (get ',mode 'variable-documentation) + (put ',mode 'variable-documentation ,doc)) + (make-variable-buffer-local ',mode) + ,@(if local + `((make-variable-buffer-local ',keymap) + (evil-add-to-alist 'evil-local-keymaps-alist + ',mode ',keymap)) + `((evil-add-to-alist 'evil-global-keymaps-alist + ',mode ',keymap) + (evil-add-to-alist 'evil-mode-map-alist + ',mode ,keymap))) + (evil-refresh-global-keymaps) + ,(when (or body func) + `(defun ,mode (&optional arg) + ,@(when doc `(,doc)) + (interactive) + (cond + ((numberp arg) + (setq ,mode (> arg 0))) + (t + (setq ,mode (not ,mode)))) + ,@body)) + ',keymap))) (defmacro evil-define-state (state doc &rest body) - "Define a Evil state STATE. + "Define an Evil state STATE. DOC is a general description and shows up in all docstrings. Then follows one or more optional keywords: @@ -210,9 +428,9 @@ Then follows one or more optional keywords: :exit-hook LIST Hooks run when changing from STATE. :enable LIST List of other states and modes enabled by STATE. :suppress-keymap FLAG If FLAG is non-nil, makes - evil-suppress-map the parent of the - global map of STATE effectively disabling - bindings to self-insert-command. + `evil-suppress-map' the parent of the + global map of STATE, effectively disabling + bindings to `self-insert-command'. Following the keywords is optional code to be executed each time the state is enabled or disabled. @@ -224,50 +442,55 @@ For example: :tag \"<T> \") The basic keymap of this state will then be -`evil-test-state-map', and so on." - (declare (debug (&define name +`evil-test-state-map', and so on. + +\(fn STATE DOC [[KEY VAL]...] BODY...)" + (declare (indent defun) + (debug (&define name [&optional stringp] [&rest [keywordp sexp]] - def-body)) - (indent defun)) - (let ((mode (intern (format "evil-%s-state" state))) - (keymap (intern (format "evil-%s-state-map" state))) - (local-mode (intern (format "evil-%s-state-local" state))) - (local-keymap (intern (format "evil-%s-state-local-map" state))) - (aux (intern (format "evil-%s-state-auxiliary-maps" state))) - (predicate (intern (format "evil-%s-state-p" state))) - (tag (intern (format "evil-%s-state-tag" state))) - (message (intern (format "evil-%s-state-message" state))) - (cursor (intern (format "evil-%s-state-cursor" state))) - (entry-hook (intern (format "evil-%s-state-entry-hook" state))) - (exit-hook (intern (format "evil-%s-state-exit-hook" state))) - cursor-value enable entry-hook-value exit-hook-value keyword - message-value tag-value suppress-keymap) + def-body))) + (let* ((toggle (intern (format "evil-%s-state" state))) + (mode (intern (format "%s-minor-mode" toggle))) + (keymap (intern (format "%s-map" toggle))) + (local (intern (format "%s-local-minor-mode" toggle))) + (local-keymap (intern (format "%s-local-map" toggle))) + (tag (intern (format "%s-tag" toggle))) + (message (intern (format "%s-message" toggle))) + (cursor (intern (format "%s-cursor" toggle))) + (entry-hook (intern (format "%s-entry-hook" toggle))) + (exit-hook (intern (format "%s-exit-hook" toggle))) + (modes (intern (format "%s-modes" toggle))) + (predicate (intern (format "%s-p" toggle))) + arg cursor-value enable entry-hook-value exit-hook-value + key message-value suppress-keymap tag-value) ;; collect keywords (while (keywordp (car-safe body)) - (setq keyword (pop body)) + (setq key (pop body) + arg (pop body)) (cond - ((eq keyword :tag) - (setq tag-value (pop body))) - ((eq keyword :message) - (setq message-value (pop body))) - ((eq keyword :cursor) - (setq cursor-value (pop body))) - ((eq keyword :entry-hook) - (setq entry-hook-value (pop body))) - ((eq keyword :exit-hook) - (setq exit-hook-value (pop body))) - ((eq keyword :enable) - (setq enable (pop body))) - ((eq keyword :suppress-keymap) - (setq suppress-keymap (pop body))) - (t - (pop body)))) + ((eq key :tag) + (setq tag-value arg)) + ((eq key :message) + (setq message-value arg)) + ((eq key :cursor) + (setq cursor-value arg)) + ((eq key :entry-hook) + (setq entry-hook-value arg) + (unless (listp entry-hook-value) + (setq entry-hook-value (list entry-hook-value)))) + ((eq key :exit-hook) + (setq exit-hook-value arg) + (unless (listp exit-hook-value) + (setq exit-hook-value (list entry-hook-value)))) + ((eq key :enable) + (setq enable arg)) + ((eq key :suppress-keymap) + (setq suppress-keymap arg)))) ;; macro expansion - `(let ((mode-map-alist (default-value 'evil-mode-map-alist))) - - ;; Save the state's properties in `evil-states-alist' for + `(progn + ;; Save the state's properties in `evil-state-properties' for ;; runtime lookup. Among other things, this information is used ;; to determine what keymaps should be activated by the state ;; (and, when processing :enable, what keymaps are activated by @@ -276,100 +499,132 @@ The basic keymap of this state will then be ;; (to which we may have assigned state bindings), as well as ;; states whose definitions may not have been processed yet. (evil-put-property - 'evil-states-alist ',state + 'evil-state-properties ',state + :toggle ',toggle + :mode (defvar ,mode nil + ,(format "Non-nil if %s state is enabled. +Use the command `%s' to change this variable.\n\n%s" state toggle doc)) + :keymap (defvar ,keymap (make-sparse-keymap) + ,(format "Keymap for %s state.\n\n%s" state doc)) + :local (defvar ,local nil + ,(format "Non-nil if %s state is enabled. +Use the command `%s' to change this variable.\n\n%s" state toggle doc)) + :local-keymap (defvar ,local-keymap nil + ,(format "Buffer-local keymap for %s state.\n\n%s" + state doc)) :tag (defvar ,tag ,tag-value ,(format "Modeline tag for %s state.\n\n%s" state doc)) :message (defvar ,message ,message-value ,(format "Echo area indicator for %s state.\n\n%s" state doc)) - :cursor (defvar ,cursor ,cursor-value + :cursor (defvar ,cursor ',cursor-value ,(format "Cursor for %s state. May be a cursor type as per `cursor-type', a color string as passed to `set-cursor-color', a zero-argument function for changing the cursor, or a list of the above.\n\n%s" state doc)) - :entry-hook (defvar ,entry-hook ,entry-hook-value + :entry-hook (defvar ,entry-hook nil ,(format "Hooks to run when entering %s state.\n\n%s" state doc)) - :exit-hook (defvar ,exit-hook ,exit-hook-value + :exit-hook (defvar ,exit-hook nil ,(format "Hooks to run when exiting %s state.\n\n%s" state doc)) - :mode (defvar ,mode nil - ,(format "Non-nil if %s state is enabled. -Use the command `%s' to change this variable." state mode)) - :keymap (defvar ,keymap (make-sparse-keymap) - ,(format "Keymap for %s state.\n\n%s" state doc)) - :local-mode (defvar ,local-mode nil - ,(format "Non-nil if %s state is enabled. -Use the command `%s' to change this variable." state mode)) - :local-keymap (defvar ,local-keymap nil - ,(format "Buffer-local keymap for %s state.\n\n%s" - state doc)) - :aux (defvar ,aux nil - ,(format "Association list of auxiliary keymaps for %s state. -Elements have the form (KEYMAP . AUX-MAP), where AUX-MAP contains state -bindings to be activated whenever KEYMAP and %s state are active." - state state)) - :predicate (defun ,predicate () - ,(format "Whether the current state is %s." state) - (eq evil-state ',state)) + :modes (defvar ,modes nil + ,(format "Modes that require %s state." state)) + :predicate ',predicate :enable ',enable) ,@(when suppress-keymap `((set-keymap-parent ,keymap evil-suppress-map))) - (evil-add-to-alist 'mode-map-alist - ',local-mode ,local-keymap - ',mode ,keymap) - (setq-default evil-mode-map-alist mode-map-alist) + (dolist (func ',entry-hook-value) + (add-hook ',entry-hook func)) - (make-variable-buffer-local ',mode) - (make-variable-buffer-local ',local-mode) - (make-variable-buffer-local ',local-keymap) + (dolist (func ',exit-hook-value) + (add-hook ',exit-hook func)) + + (defun ,predicate (&optional state) + ,(format "Whether the current STATE is %s." state) + (eq (or state evil-state) ',state)) ;; define state function - (defun ,mode (&optional arg) - ,(format "Enable %s state. Disable with negative ARG.\n\n%s" + (evil-define-command ,toggle (&optional arg) + :keep-visual t + ,(format "Enable %s state. Disable with negative ARG. +If ARG is nil, don't display a message in the echo area.\n\n%s" state doc) - (interactive) + (interactive "p") (cond ((and (numberp arg) (< arg 1)) - (unwind-protect - (let (evil-state) - (evil-normalize-keymaps) - (run-hooks ',exit-hook) - ,@body) - (setq evil-state nil))) + (setq evil-previous-state evil-state + evil-state nil) + (let ((evil-state ',state)) + (run-hooks ',exit-hook) + (setq evil-state nil) + (evil-normalize-keymaps) + ,@body)) (t (unless evil-local-mode - (evil-enable)) - (when evil-state - (funcall (evil-state-func) -1)) - (unwind-protect - (let ((evil-state ',state)) - (evil-normalize-keymaps) - (setq evil-modeline-tag ,tag) - (force-mode-line-update) - (evil-set-cursor ,cursor) - ,@body - (run-hooks ',entry-hook) - (when ,message (evil-unlogged-message ,message))) - (setq evil-state ',state))))) + (evil-initialize)) + (evil-change-state nil) + (setq evil-state ',state) + (let ((evil-state ',state) + (evil-next-state ',state)) + (evil-normalize-keymaps) + (unless evil-locked-display + (setq evil-modeline-tag ,tag) + (evil-set-cursor ,cursor) + (force-mode-line-update) + (when (evil-called-interactively-p) + (redisplay))) + ,@body + (run-hooks ',entry-hook) + (when (and arg (not evil-locked-display) ,message) + (if (functionp ,message) + (funcall ,message) + (evil-echo ,message))))))) + + (evil-define-keymap ,keymap nil + :mode ,mode) + + (evil-define-keymap ,local-keymap nil + :mode ,local + :local t) ',state))) -;; Define states +;;; Define Normal state and Emacs state (evil-define-state normal "Normal state, AKA \"Command\" state." - :tag "<N>" - :suppress-keymap t) + :tag " <N> " + :suppress-keymap t + :enable (motion) + :exit-hook (evil-repeat-start-hook) + (cond + ((evil-normal-state-p) + (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 () + "Prevent point from reaching the end of the line." + (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) + (unless (eq this-command 'evil-use-register) + (setq evil-this-register nil)) + (evil-adjust-eol) + (when (region-active-p) + (and (fboundp 'evil-visual-state) + (evil-visual-state))))) (evil-define-state emacs "Emacs state." - :tag "<E>") - -(define-key evil-normal-state-map "\C-z" 'evil-emacs-state) -(define-key evil-emacs-state-map "\C-z" 'evil-normal-state) + :tag " <E> " + :message "-- EMACS --") (provide 'evil-states) diff --git a/evil-tests.el b/evil-tests.el index a93e50b..3e7e5ab 100644 --- a/evil-tests.el +++ b/evil-tests.el @@ -1,8 +1,10 @@ ;; evil-tests.el --- unit tests for Evil -*- coding: utf-8 -*- -;; This file is for developers. It runs some unit tests on Evil. -;; To load it, add the following line to .emacs: +;; This file is for developers. It runs some tests on Evil. +;; To load it, add the following lines to .emacs: ;; +;; (setq evil-tests-run t) ; run tests immediately +;; (global-set-key [f12] 'evil-tests-run) ; hotkey ;; (require 'evil-tests) ;; ;; This file is NOT part of Evil itself. @@ -10,38 +12,335 @@ (require 'ert) (require 'evil) -;; ERT bug: The explainer function for `equal' hangs when passed -;; a keymap with a char-table. The bug can be reproduced with: -;; -;; (should (equal (make-keymap) (make-keymap))) -;; -;; TODO (Vegard): This should be forwarded to Christian Ohler. -;; For the time being, we remove the explainer. -(put 'equal 'ert-explainer nil) +(defvar evil-tests-run nil + "*Run Evil tests.") -(defvar evil-tests-run t - "Run Evil tests.") +(defun evil-tests-run (&optional tests interactive) + "Run Evil tests." + (interactive '(nil t)) + (setq tests + (or (null tests) + `(or ,@(mapcar (lambda (test) + (or (null test) + (and (memq test '(evil t)) t) + `(or (tag ,test) + ,(format "^%s$" test)))) + tests)))) + (if interactive + (ert-run-tests-interactively tests) + (ert-run-tests-batch-and-exit tests))) + +(defvar evil-test-point nil + "Marker for point.") +(make-variable-buffer-local 'evil-test-point) +(defvar evil-test-visual-start nil + "Marker for Visual beginning.") +(make-variable-buffer-local 'evil-test-visual-start) +(defvar evil-test-visual-end nil + "Marker for Visual end.") +(make-variable-buffer-local 'evil-test-visual-end) (defmacro evil-test-buffer (&rest body) - "Execute BODY in a temporary buffer. -The buffer contains the familiar *scratch* message." - (declare (indent defun) - (debug t)) - `(let ((kill-ring kill-ring) - (kill-ring-yank-pointer kill-ring-yank-pointer) - x-select-enable-clipboard - message-log-max) - (save-window-excursion - (with-temp-buffer - (switch-to-buffer-other-window (current-buffer)) - (buffer-enable-undo) - (evil-local-mode 1) - (insert ";; This buffer is for notes you don't want to save, \ -and for Lisp evaluation.\n;; If you want to create a file, visit \ -that file with C-x C-f,\n;; then enter the text in that file's own \ -buffer.\n") - (goto-char (point-min)) - ,@body)))) + "Execute FORMS in a temporary buffer. +The following optional keywords specify the buffer's properties: + +:state STATE The initial state, defaults to `normal'. +:visual TYPE The Visual type, defaults to + `evil-visual-char'. +:point-start STRING String for matching beginning of point, + defaults to \"[\". +:point-end STRING String for matching end of point, + defaults to \"]\". +:visual-start STRING String for matching beginning of + Visual selection, defaults to \"<\". +:visual-end STRING String for matching end of + Visual selection, defaults to \">\". + +Then follows one or more forms. If the first form is a string, +it is taken to be a buffer description as passed to +`evil-test-buffer-from-string', and initializes the buffer. +Subsequent string forms validate the buffer. + +If a form is a list of strings or vectors, it is taken +to be a key sequence and is passed to `execute-kbd-macro'. +Remaining forms are used as-is. + +\(fn [[KEY VALUE]...] FORMS...)" + (declare (indent defun)) + (let ((state 'normal) + arg key point-start point-end string + visual visual-start visual-end) + ;; collect keywords + (while (keywordp (car-safe body)) + (setq key (pop body) + arg (pop body)) + (cond + ((eq key :point-start) + (setq point-start (or arg ""))) + ((eq key :point-end) + (setq point-end (or arg ""))) + ((eq key :state) + (setq state arg)) + ((eq key :visual) + (setq visual arg)) + ((eq key :visual-start) + (setq visual-start (or arg ""))) + ((eq key :visual-end) + (setq visual-end (or arg ""))))) + ;; collect buffer initialization + (when (stringp (car-safe body)) + (setq string (pop body))) + ;; macro expansion + `(let ((kill-ring kill-ring) + (kill-ring-yank-pointer kill-ring-yank-pointer) + x-select-enable-clipboard + message-log-max) + (save-window-excursion + (with-current-buffer (evil-test-buffer-from-string + ,string ',state + ,point-start ,point-end + ',visual ,visual-start ,visual-end) + ;; necessary for keyboard macros to work + (switch-to-buffer-other-window (current-buffer)) + (buffer-enable-undo) + ;; parse remaining forms + ,@(mapcar + (lambda (form) + (cond + ((stringp form) + `(evil-test-buffer-string + ,form + ',point-start ',point-end + ',visual-start ',visual-end)) + ((or (stringp (car-safe form)) + (vectorp (car-safe form)) + (memq (car-safe (car-safe form)) + '(kbd vconcat))) + ;; list of strings and vectors: + ;; it would be more intuitive to do + ;; (mapc 'execute-kbd-macro form), + ;; but we need to execute everything + ;; as a single sequence for hooks + ;; to work properly + `(execute-kbd-macro + (apply 'vconcat + (mapcar 'listify-key-sequence + (mapcar 'eval ',form))))) + ((memq (car-safe form) '(kbd vconcat)) + `(execute-kbd-macro ,form)) + (t + form))) + body)))))) + +(when (fboundp 'font-lock-add-keywords) + (font-lock-add-keywords 'emacs-lisp-mode + '(("(\\(evil-test-buffer\\)\\>" + 1 font-lock-keyword-face)))) + +(defun evil-test-buffer-string + (string &optional point-start point-end visual-start visual-end) + "Validate the current buffer according to STRING. +If STRING contains an occurrence of POINT-START immediately +followed by POINT-END, that position is compared against point. +If STRING contains an occurrence of VISUAL-START followed by +VISUAL-END, those positions are compared against the Visual selection. +POINT-START and POINT-END default to [ and ]. +VISUAL-START and VISUAL-END default to < and >." + (let ((actual-buffer (current-buffer)) + (marker-buffer (evil-test-marker-buffer-from-string + string + point-start point-end + visual-start visual-end)) + before-point after-point string selection) + (unwind-protect + (with-current-buffer marker-buffer + (setq string (buffer-string)) + (when evil-test-point + (setq before-point (buffer-substring (point-min) evil-test-point) + after-point (buffer-substring evil-test-point (point-max)))) + (when (and evil-test-visual-start evil-test-visual-end) + (setq selection (buffer-substring + evil-test-visual-start evil-test-visual-end))) + (with-current-buffer actual-buffer + (if (or before-point after-point) + (evil-test-text before-point after-point) + ;; if the cursor isn't specified, just test the whole buffer + (save-excursion + (goto-char (point-min)) + (evil-test-text nil string 'bobp 'eobp))) + (when selection + (evil-test-selection selection)))) + (kill-buffer marker-buffer)))) + +(defun evil-test-buffer-from-string + (string &optional state point-start point-end + visual visual-start visual-end) + "Create a new buffer according to STRING. +If STRING contains an occurrence of POINT-START immediately +followed by POINT-END, then point is moved to that position. +If STRING contains an occurrence of VISUAL-START followed by +VISUAL-END, then a Visual selection is created with those boundaries. +POINT-START and POINT-END default to [ and ]. +VISUAL-START and VISUAL-END default to < and >. +STATE is the initial state; it defaults to `normal'. +VISUAL is the Visual selection: it defaults to `evil-visual-char'." + (let ((buffer (evil-test-marker-buffer-from-string + string point-start point-end + visual-start visual-end))) + (with-current-buffer buffer + (prog1 buffer + (evil-change-state state) + (when (and (markerp evil-test-visual-start) + (markerp evil-test-visual-end)) + (evil-visual-select + evil-test-visual-start evil-test-visual-end visual) + (when evil-test-point + (goto-char evil-test-point) + (evil-visual-refresh) + (unless (and (= (evil-visual-beginning) + evil-test-visual-start) + (= (evil-visual-end) + evil-test-visual-end)) + (evil-visual-select + evil-test-visual-start evil-test-visual-end visual -1) + (goto-char evil-test-point) + (evil-visual-refresh)))) + (when (markerp evil-test-point) + (goto-char evil-test-point)))))) + +(defun evil-test-marker-buffer-from-string + (string &optional point-start point-end visual-start visual-end) + "Create a new marker buffer according to STRING. +If STRING contains an occurrence of POINT-START immediately +followed by POINT-END, that position is stored in the +buffer-local variable `evil-test-point'. Similarly, +if STRING contains an occurrence of VISUAL-START followed by +VISUAL-END, those positions are stored in the variables +`evil-test-visual-beginning' and `evil-test-visual-end'. +POINT-START and POINT-END default to [ and ]. +VISUAL-START and VISUAL-END default to < and >." + (let ((string (or string "")) + (point-start (regexp-quote + (if (characterp point-start) + (string point-start) + (or point-start "[")))) + (point-end (regexp-quote + (if (characterp point-end) + (string point-end) + (or point-end "]")))) + (visual-start (regexp-quote + (if (characterp visual-start) + (string visual-start) + (or visual-start "<")))) + (visual-end (regexp-quote + (if (characterp visual-end) + (string visual-end) + (or visual-end ">"))))) + (with-current-buffer (generate-new-buffer " *test*") + (prog1 (current-buffer) + (save-excursion + (insert string)) + (save-excursion + (when (> (length point-start) 0) + (if (> (length point-end) 0) + (when (re-search-forward + (format "\\(%s\\)[^%s]?\\(%s\\)" + point-start point-end point-end) nil t) + (goto-char (match-beginning 0)) + (delete-region (match-beginning 2) (match-end 2)) + (delete-region (match-beginning 1) (match-end 1)) + (setq evil-test-point + (move-marker (make-marker) (point)))) + (when (re-search-forward point-start nil t) + (goto-char (match-beginning 0)) + (delete-region (match-beginning 0) (match-end 0)) + (setq evil-test-point + (move-marker (make-marker) (point))))))) + (save-excursion + (when (and (> (length visual-start) 0) + (> (length visual-end) 0)) + (when (re-search-forward visual-start nil t) + (goto-char (match-beginning 0)) + (delete-region (match-beginning 0) (match-end 0)) + (setq evil-test-visual-start + (move-marker (make-marker) (point)))) + (when (re-search-forward visual-end nil t) + (goto-char (match-beginning 0)) + (delete-region (match-beginning 0) (match-end 0)) + (setq evil-test-visual-end + (move-marker (make-marker) (point)))))))))) + +(defun evil-test-text + (before after &optional before-predicate after-predicate) + "Verify the text around point. +BEFORE is the expected text before point, and AFTER is +the text after point. BEFORE-PREDICATE is a predicate function +to execute at the beginning of the text, and AFTER-PREDICATE +is executed at the end." + (when before + (if (functionp before) + (setq before-predicate before + before nil) + (should (string= (buffer-substring + (max (point-min) (- (point) (length before))) + (point)) + before)))) + (when after + (if (functionp after) + (setq after-predicate after + after nil) + (should (string= (buffer-substring + (point) + (min (point-max) (+ (point) (length after)))) + after)))) + (when before-predicate + (ert-info ((format "Expect `%s' at the beginning" before-predicate)) + (save-excursion + (backward-char (length before)) + (should (funcall before-predicate))))) + (when after-predicate + (ert-info ((format "Expect `%s' at the end" after-predicate)) + (save-excursion + (forward-char (length after)) + (should (funcall after-predicate)))))) + +(defmacro evil-test-selection + (string &optional end-string before-predicate after-predicate) + "Verify that the Visual selection corresponds to STRING." + (declare (indent defun)) + `(progn + (save-excursion + (goto-char (or (evil-visual-beginning) (region-beginning))) + (evil-test-text nil (or ,string ,end-string) ,before-predicate)) + (save-excursion + (goto-char (or (evil-visual-end) (region-end))) + (evil-test-text (or ,end-string ,string) nil nil ,after-predicate)))) + +(defmacro evil-test-region + (string &optional end-string before-predicate after-predicate) + "Verify that the region corresponds to STRING." + (declare (indent defun)) + `(progn + (save-excursion + (goto-char (region-beginning)) + (evil-test-text nil (or ,string ,end-string) ,before-predicate)) + (save-excursion + (goto-char (region-end)) + (evil-test-text (or ,end-string ,string) nil nil ,after-predicate)))) + +(defmacro evil-test-overlay + (overlay string &optional end-string before-predicate after-predicate) + "Verify that OVERLAY corresponds to STRING." + (declare (indent defun)) + `(progn + (save-excursion + (goto-char (overlay-start ,overlay)) + (evil-test-text nil (or ,string ,end-string) ,before-predicate)) + (save-excursion + (goto-char (overlay-end ,overlay)) + (evil-test-text (or ,end-string ,string) nil nil ,after-predicate)))) + +;;; States (defun evil-test-local-mode-enabled () "Verify that `evil-local-mode' is enabled properly" @@ -79,11 +378,11 @@ buffer.\n") (ert-info ("Set `evil-state' to nil") (should-not evil-state)) (ert-info ("Disable all state keymaps") - (dolist (state (mapcar 'car evil-states-alist) t) + (dolist (state (mapcar 'car evil-state-properties) t) (should-not (symbol-value (evil-state-property state :mode))) (should-not (memq (symbol-value (evil-state-property state :keymap)) (current-active-maps))) - (should-not (symbol-value (evil-state-property state :local-mode))) + (should-not (symbol-value (evil-state-property state :local))) (should-not (memq (symbol-value (evil-state-property state :local-keymap)) (current-active-maps))) (dolist (map (evil-state-auxiliary-keymaps state)) @@ -91,7 +390,7 @@ buffer.\n") (ert-deftest evil-test-toggle-local-mode () "Toggle `evil-local-mode'" - :tags '(evil) + :tags '(evil state) (with-temp-buffer (ert-info ("Enable `evil-local-mode'") (evil-local-mode 1) @@ -107,7 +406,7 @@ buffer.\n") (setq mode (evil-state-property state :mode) keymap (symbol-value (evil-state-property state :keymap)) - local-mode (evil-state-property state :local-mode) + local-mode (evil-state-property state :local) local-keymap (symbol-value (evil-state-property state :local-keymap)) tag (symbol-value (evil-state-property @@ -120,16 +419,38 @@ buffer.\n") (should (symbol-value mode)) (should (symbol-value local-mode))) (ert-info ("Push state keymaps to the top") - (should (equal (nth 0 evil-mode-map-alist) - (cons local-mode local-keymap))) - (should (equal (nth 1 evil-mode-map-alist) - (cons mode keymap)))) + (evil-test-state-keymaps state)) (ert-info ("Refresh modeline tag") (should (equal evil-modeline-tag tag))))) +(defun evil-test-state-keymaps (state) + "Verify that STATE's keymaps are pushed to the top" + (let ((actual (evil-state-keymaps state)) + (expected (list (symbol-value (evil-state-property + state :local-keymap)) + (symbol-value (evil-state-property + state :keymap))))) + ;; additional keymaps inherited with :enable + (cond + ((eq state 'operator) + (setq expected + (list evil-operator-shortcut-map + evil-operator-state-local-map + evil-operator-state-map + evil-motion-state-local-map + evil-motion-state-map + evil-normal-state-local-map + evil-normal-state-map)))) + (dotimes (i (length expected)) + (should (keymapp (nth i expected))) + (should (eq (nth i actual) (nth i expected))) + (should (memq (nth i expected) (current-active-maps))) + (should (eq (cdr (nth i evil-mode-map-alist)) + (nth i expected)))))) + (ert-deftest evil-test-exit-normal-state () "Enter Normal state and then disable all states" - :tags '(evil) + :tags '(evil state) (with-temp-buffer (evil-test-change-state 'normal) (evil-normal-state -1) @@ -137,18 +458,20 @@ buffer.\n") (ert-deftest evil-test-change-states () "Change between Normal state, Emacs state and Operator-Pending state" - :tags '(evil) + :tags '(evil state) (with-temp-buffer (evil-test-change-state 'normal) (evil-test-change-state 'emacs) (evil-test-change-state 'normal) (evil-test-change-state 'operator) (evil-test-change-state 'normal) - (evil-test-change-state 'emacs))) + (evil-test-change-state 'emacs) + (evil-test-change-state 'replace) + (evil-test-change-state 'normal))) (ert-deftest evil-test-enter-normal-state-disabled () "Enter Normal state even if `evil-local-mode' is disabled" - :tags '(evil) + :tags '(evil state) (with-temp-buffer (evil-local-mode -1) (evil-test-local-mode-disabled) @@ -157,29 +480,3143 @@ buffer.\n") (defun evil-test-suppress-keymap (state) "Verify that `self-insert-command' is suppressed in STATE" (evil-test-buffer + ";; This buffer is for notes." (evil-test-change-state state) - (should-error (execute-kbd-macro "abc")) - (should (string= ";; " (buffer-substring - (point-min) (+ (point-min) 3)))))) + ;; TODO: this should be done better + (ert-info ("Disable the state's own keymaps so that the +suppression keymap comes first") + (setq evil-motion-state-minor-mode nil + evil-motion-state-local-minor-mode nil + evil-operator-state-minor-mode nil + evil-operator-state-local-minor-mode nil)) + (should (eq (key-binding "Q") 'undefined)) + (ert-info ("Don't insert text") + ;; may or may not signal an error, depending on batch mode + (condition-case nil + (execute-kbd-macro "QQQ") + (error nil)) + (should (string= (buffer-substring 1 4) ";; "))))) (ert-deftest evil-test-emacs-state-suppress-keymap () - "`self-insert-command' works in emacs-state" - :tags '(evil) + "`self-insert-command' works in Emacs state" + :tags '(evil state) (should-error (evil-test-suppress-keymap 'emacs))) (ert-deftest evil-test-normal-state-suppress-keymap () - "No `self-insert-command' in normal-state" - :tags '(evil) + "No `self-insert-command' in Normal state" + :tags '(evil state) (evil-test-suppress-keymap 'normal)) (ert-deftest evil-test-operator-state-suppress-keymap () "Operator-Pending state should inherit suppression of `self-insert-command' from Normal state" - :tags '(evil) + :tags '(evil state) (evil-test-suppress-keymap 'operator)) +(ert-deftest evil-test-operator-state-shortcut-keymap () + "Enable shortcut keymap in Operator-Pending state" + :tags '(evil state) + (evil-test-buffer + (ert-info ("Activate `evil-operator-shortcut-map' in \ +Operator-Pending state") + (evil-test-change-state 'operator) + (should (memq evil-operator-shortcut-map + (evil-state-keymaps 'operator))) + (should (keymapp evil-operator-shortcut-map)) + (should evil-operator-shortcut-mode) + (should (memq evil-operator-shortcut-map + (current-active-maps)))) + (ert-info ("Deactivate `evil-operator-shortcut-map' \ +outside Operator-Pending state") + (evil-test-change-state 'emacs) + (should-not evil-operator-shortcut-mode) + (should-not (memq evil-operator-shortcut-map + (current-active-maps)))) + (ert-info ("Reset `evil-operator-shortcut-map' \ +when entering Operator-Pending state") + (define-key evil-operator-shortcut-map "f" 'foo) + (should (eq (lookup-key evil-operator-shortcut-map "f") + 'foo)) + (evil-test-change-state 'operator) + (should-not (eq (lookup-key evil-operator-shortcut-map "f") + 'foo))) + (ert-info ("Reset `evil-operator-shortcut-map' \ +when exiting Operator-Pending state") + (define-key evil-operator-shortcut-map "b" 'bar) + (should (eq (lookup-key evil-operator-shortcut-map "b") + 'bar)) + (evil-test-change-state 'emacs) + (should-not (eq (lookup-key evil-operator-shortcut-map "b") + 'bar))))) + +(ert-deftest evil-test-auxiliary-maps () + "Test auxiliary keymaps" + :tags '(evil state) + (let ((map (make-sparse-keymap)) aux) + (ert-info ("Create a new auxiliary keymap") + (evil-define-key 'normal map "f" 'foo) + (setq aux (evil-get-auxiliary-keymap map 'normal)) + (should (evil-auxiliary-keymap-p aux)) + (should (eq (lookup-key aux "f") 'foo))) + (ert-info ("Add to auxiliary keymap") + (evil-define-key 'normal map "b" 'bar) + (should (eq (lookup-key aux "f") 'foo)) + (should (eq (lookup-key aux "b") 'bar))))) + +;;; Type system + +(ert-deftest evil-test-exclusive-type () + "Expand and contract the `line' type" + :tags '(evil type) + (evil-test-buffer + ";; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (let* ((first-line 1) + (second-line (progn + (forward-line) + (point))) + (third-line (progn + (forward-line) + (point))) + (overlay (make-overlay 1 1))) + (ert-info ("Return the beginning and end unchanged \ +if they are the same") + (should (equal (evil-normalize 1 1 'exclusive) + (list 1 1 'exclusive)))) + (ert-info ("expand to `inclusive' if the end position \ +is at the beginning of a line") + (should (equal (evil-normalize (1+ first-line) second-line 'exclusive) + (list (1+ first-line) (1- second-line) 'inclusive + :expanded t)))) + (ert-info ("expand to `line' if both the beginning and end \ +are at the beginning of a line") + (should (equal (evil-normalize first-line second-line 'exclusive) + (list first-line second-line 'line + :expanded t)))) + (ert-info ("Measure as the strict difference between the end \ +and the beginning") + (should (string= (evil-describe 1 1 'exclusive) + "0 characters")) + (should (string= (evil-describe 1 2 'exclusive) + "1 character")) + (should (string= (evil-describe 5 2 'exclusive) + "3 characters"))) + (ert-info ("Expand and measure overlay") + (evil-set-type overlay 'exclusive) + (should (string= (evil-describe-overlay overlay) + "0 characters")) + (move-overlay overlay 1 3) + (evil-expand-overlay overlay) + (should (string= (evil-describe-overlay overlay) + "2 characters")) + (evil-contract-overlay overlay) + (should (string= (evil-describe-overlay overlay) + "2 characters")) + (ert-info ("Normalize overlay") + (move-overlay overlay (1+ first-line) second-line) + (evil-normalize-overlay overlay) + (should (= (overlay-start overlay) (1+ first-line))) + (should (= (overlay-end overlay) (1- second-line))) + (should (eq (evil-type overlay) 'inclusive)) + (should (overlay-get overlay :expanded))) + (ert-info ("Contract overlay") + (evil-contract-overlay overlay) + (should-not (overlay-get overlay :expanded))))))) + +(ert-deftest evil-test-inclusive-type () + "Expand and contract the `inclusive' type" + :tags '(evil type) + (evil-test-buffer + ";; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (let ((overlay (make-overlay 1 1))) + (ert-info ("Include the ending character") + (should (equal (evil-expand 1 1 'inclusive) + '(1 2 inclusive :expanded t)))) + (ert-info ("Don't mind if positions are in wrong order") + (should (equal (evil-expand 5 2 'inclusive) + '(2 6 inclusive :expanded t)))) + (ert-info ("Exclude the ending character when contracting") + (should (equal (evil-contract 1 2 'inclusive) + '(1 1 inclusive :expanded nil)))) + (ert-info ("Don't mind positions' order when contracting") + (should (equal (evil-contract 6 2 'inclusive) + '(2 5 inclusive :expanded nil)))) + (ert-info ("Measure as one more than the difference") + (should (string= (evil-describe 1 1 'inclusive) + "1 character")) + (should (string= (evil-describe 5 2 'inclusive) + "4 characters"))) + (ert-info ("Expand overlay") + (evil-set-type overlay 'inclusive) + (evil-expand-overlay overlay) + (should (= (overlay-start overlay) 1)) + (should (= (overlay-end overlay) 2)) + (should (overlay-get overlay :expanded))) + (ert-info ("Contract overlay") + (move-overlay overlay 1 4) + (evil-contract-overlay overlay) + (should (= (overlay-start overlay) 1)) + (should (= (overlay-end overlay) 3)) + (should-not (overlay-get overlay :expanded)))))) + +(ert-deftest evil-test-line-type () + "Expand the `line' type" + :tags '(evil type) + (evil-test-buffer + ";; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (let* ((first-line 1) + (second-line (progn + (forward-line) + (point))) + (third-line (progn + (forward-line) + (point))) + (overlay (make-overlay 1 1))) + (ert-info ("Expand to the whole first line") + (should (equal (evil-expand first-line first-line 'line) + (list first-line second-line 'line :expanded t))) + (should (string= (evil-describe first-line first-line 'line) + "1 line"))) + (ert-info ("Expand to the two first lines") + (should (equal (evil-expand first-line second-line 'line) + (list first-line third-line 'line :expanded t))) + (should (string= (evil-describe first-line second-line 'line) + "2 lines"))) + (ert-info ("Expand overlay") + (evil-set-type overlay 'line) + (evil-expand-overlay overlay) + (should (= (overlay-start overlay) first-line)) + (should (= (overlay-end overlay) second-line)) + (should (overlay-get overlay :expanded))) + (ert-info ("Restore overlay") + (evil-contract-overlay overlay) + (should (= (overlay-start overlay) 1)) + (should (= (overlay-end overlay) 1)) + (should-not (overlay-get overlay :expanded)))))) + +(ert-deftest evil-test-block-type () + "Expand and contract the `block' type" + :tags '(evil type) + (evil-test-buffer + ";; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (let* ((first-line 1) + (second-line (progn + (forward-line) + (point))) + (third-line (progn + (forward-line) + (point)))) + (ert-info ("Expand to a 1x1 block") + (should (equal (evil-expand 1 1 'block) + (list 1 2 'block :expanded t))) + (should (string= (evil-describe 1 1 'block) + "1 row and 1 column"))) + (ert-info ("Expand to a 2x1 block") + (should (equal (evil-expand first-line second-line 'block) + (list first-line (1+ second-line) 'block :expanded t))) + (should (string= (evil-describe first-line second-line 'block) + "2 rows and 1 column"))) + (ert-info ("Expand to a 3x2 block") + (should (equal (evil-expand first-line (1+ third-line) 'block) + (list first-line (1+ (1+ third-line)) + 'block :expanded t))) + (should (string= (evil-describe first-line (1+ third-line) 'block) + "3 rows and 2 columns"))) + (ert-info ("Contract to a 0x0 rectangle") + (should (equal (evil-contract 1 2 'block) + (list 1 1 'block :expanded nil)))) + (ert-info ("Contract to a 2x0 rectangle") + (should (equal (evil-contract first-line (1+ second-line) 'block) + (list first-line second-line 'block :expanded nil)))) + (ert-info ("Contract to a 3x1 rectangle") + (should (equal (evil-contract first-line (1+ (1+ third-line)) 'block) + (list first-line (1+ third-line) + 'block :expanded nil))))))) + +(ert-deftest evil-test-type-transform () + "Test `evil-transform'" + :tags '(evil type) + (evil-test-buffer + ";; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (ert-info ("Return positions unchanged when passed nil \ +for TYPE or TRANSFORM") + (should (equal (evil-transform nil 1 2 'block) + '(1 2 block))) + (should (equal (evil-transform 'expand 1 2 nil) + '(1 2))) + (should (equal (evil-transform nil 1 2 nil) + '(1 2)))) + (ert-info ("Accept markers, but return positions") + (should (equal (evil-transform 'expand + (move-marker (make-marker) 1) 1 + 'inclusive) + '(1 2 inclusive :expanded t))) + (should (equal (evil-transform nil (move-marker (make-marker) 1) 2 + nil) + '(1 2)))))) + +(ert-deftest evil-test-type-modifiers () + "Test type modifiers like \"dv}\"" + :tags '(evil type) + (ert-info ("Change `inclusive' motions to `exclusive'") + (evil-test-buffer + "[A]bove some line" + ("dve") + "[e] some line")) + (ert-info ("Change `exclusive' motions to `inclusive'") + (evil-test-buffer + "Above [s]ome line + +Below some empty line" + ("dv}") + "Above[ ] +Below some empty line")) + (ert-info ("Change type to `line'") + (evil-test-buffer + "Above [s]ome line + +Below some empty line" + ("dV}") + "[B]elow some empty line"))) + +;;; Insertion + +(ert-deftest evil-test-insert () + "Test `evil-insert'" + :tags '(evil insert) + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save" + ("ievil rulz " (kbd "ESC")) + ";; evil rulz[ ]This buffer is for notes you don't want to save")) + +(ert-deftest evil-test-append () + "Test `evil-append'" + :tags '(evil insert) + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save" + ("aevil rulz " (kbd "ESC")) + ";; Tevil rulz[ ]his buffer is for notes you don't want to save")) + +(ert-deftest evil-test-open-above () + "Test `evil-open-above'" + :tags '(evil insert) + (evil-test-buffer + ";; This buffer is for notes you don't want to save, +\[;]; and for Lisp evaluation." + ("Oabc\ndef" (kbd "ESC")) + ";; This buffer is for notes you don't want to save, +abc +de[f] +;; and for Lisp evaluation.")) + +(ert-deftest evil-test-open-below () + "Test `evil-open-below'" + :tags '(evil insert) + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("oabc\ndef" (kbd "ESC")) + ";; This buffer is for notes you don't want to save, +abc +de[f] +;; and for Lisp evaluation.")) + +(ert-deftest evil-test-insert-line () + "Test `evil-insert-line'" + :tags '(evil insert) + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save" + ("Ievil rulz " (kbd "ESC")) + "evil rulz[ ];; This buffer is for notes you don't want to save")) + +(ert-deftest evil-test-append-line () + "Test `evil-append-line'" + :tags '(evil insert) + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save" + ("Aevil rulz " (kbd "ESC")) + ";; This buffer is for notes you don't want to saveevil rulz[ ]")) + +(ert-deftest evil-test-insert-digraph () + "Test `evil-insert-digraph'" + :tags '(evil insert) + (ert-info ("Predefined digraph") + (evil-test-buffer + ("i\C-kae") + "æ[]")) + (ert-info ("Custom digraph") + (let ((evil-digraphs-table-user '(((?a ?o) . ?å)))) + (evil-test-buffer + ("i\C-kao") + "å[]")))) + +;;; Repeat system + +(ert-deftest evil-test-normalize-repeat-info () + "Test `evil-normalize-repeat-info'" + :tags '(evil repeat) + (ert-info ("Single array") + (should (equal (evil-normalize-repeat-info + '("abc")) + '([?a ?b ?c]))) + (should (equal (evil-normalize-repeat-info + '("\M-f")) + (list (kbd "M-f"))))) + (ert-info ("Single symbol") + (should (equal (evil-normalize-repeat-info + '(SYM)) + '(SYM)))) + (ert-info ("Arrays only") + (should (equal (evil-normalize-repeat-info + '("abc" [XX YY] "def")) + '([?a ?b ?c XX YY ?d ?e ?f])))) + (ert-info ("Several symbols") + (should (equal (evil-normalize-repeat-info + '(BEG MID END)) + '(BEG MID END)))) + (ert-info ("Arrays with symbol at the beginning") + (should (equal (evil-normalize-repeat-info + '(BEG "abc" [XX YY] "def")) + '(BEG [?a ?b ?c XX YY ?d ?e ?f])))) + (ert-info ("Arrays with symbol at the end") + (should (equal (evil-normalize-repeat-info + '("abc" [XX YY] "def" END)) + '([?a ?b ?c XX YY ?d ?e ?f] END)))) + (ert-info ("Arrays with symbol in the middle") + (should (equal (evil-normalize-repeat-info + '("abc" [XX YY] MID "def" )) + '([?a ?b ?c XX YY] MID [?d ?e ?f])))) + (ert-info ("Concatenate arrays with several symbols") + (should (equal (evil-normalize-repeat-info + '(BEG "abc" [XX YY] MID "def" END)) + '(BEG [?a ?b ?c XX YY] MID [?d ?e ?f] END))))) + +(defun evil-test-repeat-info (keys &optional recorded) + "Execute a sequence of keys and verify that `evil-repeat-ring' +records them correctly. KEYS is the sequence of keys to execute. +RECORDED is the expected sequence of recorded events. +If nil, KEYS is used." + (execute-kbd-macro keys) + (should (equal (evil-normalize-repeat-info (ring-ref evil-repeat-ring 0)) + (list (vconcat (or recorded keys)))))) + +(ert-deftest evil-test-normal-repeat-info-simple-command () + "Save key-sequence after simple editing command in Normal state" + :tags '(evil repeat) + (evil-test-buffer + (ert-info ("Call simple command without count") + (evil-test-repeat-info "x")) + (ert-info ("Call simple command with count 3") + (evil-test-repeat-info "3x")))) + +(ert-deftest evil-test-normal-repeat-info-char-command () + "Save key-sequence after editing command with character in Normal state" + :tags '(evil repeat) + (evil-test-buffer + (ert-info ("Call command with character argument without count") + (evil-test-repeat-info "r5")) + (ert-info ("Call command with character argument with count 12") + (evil-test-repeat-info "12rX")))) + +(ert-deftest evil-test-insert-repeat-info () + "Save key-sequence after Insert state" + :tags '(evil repeat) + (evil-test-buffer + (ert-info ("Insert text without count") + (evil-test-repeat-info (vconcat "iABC" (kbd "ESC")))) + (ert-info ("Insert text with count 42") + (evil-test-repeat-info (vconcat "42iABC" (kbd "ESC")))))) + +(ert-deftest evil-test-repeat () + "Repeat several editing commands" + :tags '(evil repeat) + (ert-info ("Repeat replace") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save" + ("rX") + "[X]; This buffer is for notes you don't want to save" + ([right right] ".") + "X;[X]This buffer is for notes you don't want to save")) + (ert-info ("Repeat replace with count") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save" + ("2rX") + "X[X] This buffer is for notes you don't want to save" + ([right right] ".") + "XX X[X]is buffer is for notes you don't want to save")) + (ert-info ("Repeat replace without count with a new count") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save" + ("rX") + "[X]; This buffer is for notes you don't want to save" + ([right right] "13.") + "X;XXXXXXXXXXXX[X]is for notes you don't want to save")) + (ert-info ("Repeat replace with count replacing original count") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save" + ("10rX") + "XXXXXXXXX[X]ffer is for notes you don't want to save" + ([right right] "20.") + "XXXXXXXXXXfXXXXXXXXXXXXXXXXXXX[X] don't want to save")) + (ert-info ("Repeat movement in Insert state") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save" + ("i(\M-f)" (kbd "ESC")) + ";; (This[)] buffer is for notes you don't want to save" + ("w.") + ";; (This) (buffer[)] is for notes you don't want to save"))) + +(ert-deftest evil-test-cmd-replace-char () + "Calling `evil-replace-char' should replace characters" + :tags '(evil repeat) + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save" + ("r5") + "[5]; This buffer is for notes you don't want to save" + ("3rX") + "XX[X]This buffer is for notes you don't want to save")) + +(ert-deftest evil-test-insert-with-count () + "Test `evil-insert' with repeat count" + :tags '(evil repeat) + (evil-test-buffer + ";; [T]his buffer is for notes" + ("2ievil rulz " (kbd "ESC")) + ";; evil rulz evil rulz[ ]This buffer is for notes")) + +(ert-deftest evil-test-repeat-insert () + "Test repeating of `evil-insert'" + :tags '(evil repeat) + (ert-info ("Repeat insert") + (evil-test-buffer + "[;]; This buffer is for notes" + ("iABC" (kbd "ESC")) + "AB[C];; This buffer is for notes" + ("..") + "ABABAB[C]CC;; This buffer is for notes")) + (ert-info ("Repeat insert with count") + (evil-test-buffer + "[;]; This buffer is for notes" + ("2iABC" (kbd "ESC")) + "ABCAB[C];; This buffer is for notes" + ("..") + "ABCABABCABABCAB[C]CC;; This buffer is for notes")) + (ert-info ("Repeat insert with repeat count") + (evil-test-buffer + "[;]; This buffer is for notes" + ("iABC" (kbd "ESC")) + "AB[C];; This buffer is for notes" + ("11.") + "ABABCABCABCABCABCABCABCABCABCABCAB[C]C;; This buffer is for notes")) + (ert-info ("Repeat insert with count with repeat with count") + (evil-test-buffer + "[;]; This buffer is for notes" + ("10iABC" (kbd "ESC")) + "ABCABCABCABCABCABCABCABCABCAB[C];; This buffer is for notes" + ("11.") + "ABCABCABCABCABCABCABCABCABCABABCABCABCABCABCABCABCABCABCABCAB[C]C;; \ +This buffer is for notes"))) + +(ert-deftest evil-test-insert-vcount () + "Test `evil-insert' with vertical repeating" + :tags '(evil repeat) + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer. + +;; Below the empty line." + (define-key evil-normal-state-local-map "i" + #'(lambda (count) + (interactive "p") + (evil-insert count 5))) + ("2iABC" (kbd "ESC")) + "\ +;; ABCAB[C]This buffer is for notes you don't want to save. +;; ABCABCIf you want to create a file, visit that file with C-x C-f, +;; ABCABCthen enter the text in that file's own buffer. + ABCABC +;; ABCABCBelow the empty line.")) + +(ert-deftest evil-test-append-with-count () + "Test `evil-append' with repeat count" + :tags '(evil repeat) + (evil-test-buffer + ";; [T]his buffer is for notes" + ("2aevil rulz " (kbd "ESC")) + ";; Tevil rulz evil rulz[ ]his buffer is for notes")) + +(ert-deftest evil-test-repeat-append () + "Test repeating of `evil-append'" + :tags '(evil repeat) + (ert-info ("Repeat insert") + (evil-test-buffer + "[;]; This buffer is for notes" + ("aABC" (kbd "ESC")) + ";AB[C]; This buffer is for notes" + ("..") + ";ABCABCAB[C]; This buffer is for notes")) + (ert-info ("Repeat insert with count") + (evil-test-buffer + "[;]; This buffer is for notes" + ("2aABC" (kbd "ESC")) + ";ABCAB[C]; This buffer is for notes" + ("..") + ";ABCABCABCABCABCAB[C]; This buffer is for notes")) + (ert-info ("Repeat insert with repeat count") + (evil-test-buffer + "[;]; This buffer is for notes" + ("aABC" (kbd "ESC")) + ";AB[C]; This buffer is for notes" + ("11.") + ";ABCABCABCABCABCABCABCABCABCABCABCAB[C]; This buffer is for notes")) + (ert-info ("Repeat insert with count with repeat with count") + (evil-test-buffer + "[;]; This buffer is for notes" + ("10aABC" (kbd "ESC")) + ";ABCABCABCABCABCABCABCABCABCAB[C]; This buffer is for notes" + ("11.") + ";ABCABCABCABCABCABCABCABCABCABCABCABCABCABCABCABCABCABCABCABCAB[C]; \ +This buffer is for notes"))) + +(ert-deftest evil-test-append-vcount () + "Test `evil-append' with vertical repeating" + :tags '(evil repeat) + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer. + +;; Below the empty line." + (define-key evil-normal-state-local-map "a" + #'(lambda (count) + (interactive "p") + (evil-append count 5))) + ("2aABC" (kbd "ESC")) + "\ +;; TABCAB[C]his buffer is for notes you don't want to save. +;; IABCABCf you want to create a file, visit that file with C-x C-f, +;; tABCABChen enter the text in that file's own buffer. + ABCABC +;; BABCABCelow the empty line.")) + +(ert-deftest evil-test-open-above-with-count () + "Test `evil-open-above' with repeat count" + :tags '(evil repeat) + (evil-test-buffer + ";; This buffer is for notes you don't want to save, +\[;]; and for Lisp evaluation." + ("2Oevil\nrulz" (kbd "ESC")) + ";; This buffer is for notes you don't want to save, +evil\nrulz\nevil\nrul[z] +;; and for Lisp evaluation.")) + +(ert-deftest evil-test-repeat-open-above () + "Test repeating of `evil-open-above'" + :tags '(evil repeat) + (ert-info ("Repeat insert") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save." + ("Oevil\nrulz" (kbd "ESC")) + "evil\nrul[z] +;; This buffer is for notes you don't want to save." + ("..") + "evil\nevil\nevil\nrul[z]\nrulz\nrulz +;; This buffer is for notes you don't want to save.")) + (ert-info ("Repeat insert with count") + (evil-test-buffer + ";; This buffer is for notes you don't want to save." + ("2Oevil\nrulz" (kbd "ESC")) + "evil\nrulz\nevil\nrul[z] +;; This buffer is for notes you don't want to save." + ("..") + "evil\nrulz\nevil\nevil\nrulz\nevil\nevil\nrulz\nevil\nrul[z]\nrulz\nrulz +;; This buffer is for notes you don't want to save.")) + (ert-info ("Repeat insert with repeat count") + (evil-test-buffer + ";; This buffer is for notes you don't want to save." + ("Oevil\nrulz" (kbd "ESC")) + "evil\nrul[z]\n;; This buffer is for notes you don't want to save." + ("2.") + "evil\nevil\nrulz\nevil\nrul[z]\nrulz +;; This buffer is for notes you don't want to save.")) + (ert-info ("Repeat insert with count with repeat with count") + (evil-test-buffer + ";; This buffer is for notes you don't want to save." + ("2Oevil\nrulz" (kbd "ESC")) + "evil\nrulz\nevil\nrul[z] +;; This buffer is for notes you don't want to save." + ("3.") + "evil\nrulz\nevil\nevil\nrulz\nevil\nrulz\nevil\nrul[z]\nrulz +;; This buffer is for notes you don't want to save."))) + +(ert-deftest evil-test-open-below-with-count () + "Test insertion of `evil-open-below' with repeat count" + :tags '(evil repeat) + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("2oevil\nrulz" (kbd "ESC")) + ";; This buffer is for notes you don't want to save, +evil\nrulz\nevil\nrul[z] +;; and for Lisp evaluation.")) + +(ert-deftest evil-test-repeat-open-below () + "Test repeating `evil-open-below'" + :tags '(evil repeat) + (ert-info ("Repeat insert") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("oevil\nrulz" (kbd "ESC")) + ";; This buffer is for notes you don't want to save, +evil\nrul[z]\n;; and for Lisp evaluation." + ("..") + ";; This buffer is for notes you don't want to save, +evil\nrulz\nevil\nrulz\nevil\nrul[z] +;; and for Lisp evaluation.")) + (ert-info ("Repeat insert with count") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("2oevil\nrulz" (kbd "ESC")) + ";; This buffer is for notes you don't want to save, +evil\nrulz\nevil\nrul[z] +;; and for Lisp evaluation." + ("..") + ";; This buffer is for notes you don't want to save, +evil\nrulz\nevil\nrulz\nevil\nrulz\nevil\nrulz\nevil\nrulz\nevil\nrul[z] +;; and for Lisp evaluation.")) + (ert-info ("Repeat insert with repeat count") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("oevil\nrulz" (kbd "ESC")) + ";; This buffer is for notes you don't want to save, +evil\nrul[z]\n;; and for Lisp evaluation." + ("2.") + ";; This buffer is for notes you don't want to save, +evil\nrulz\nevil\nrulz\nevil\nrul[z] +;; and for Lisp evaluation.")) + (ert-info ("Repeat insert with count with repeat with count") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("2oevil\nrulz" (kbd "ESC")) + ";; This buffer is for notes you don't want to save, +evil\nrulz\nevil\nrul[z] +;; and for Lisp evaluation." + ("3.") + ";; This buffer is for notes you don't want to save, +evil\nrulz\nevil\nrulz\nevil\nrulz\nevil\nrulz\nevil\nrul[z] +;; and for Lisp evaluation."))) + +(ert-deftest evil-test-insert-line-with-count () + "Test `evil-insert-line' with repeat count" + :tags '(evil repeat) + (evil-test-buffer + ";; [T]his buffer is for notes" + ("2Ievil rulz " (kbd "ESC")) + "evil rulz evil rulz[ ];; This buffer is for notes")) + +(ert-deftest evil-test-repeat-insert-line () + "Test repeating of `evil-insert-line'" + :tags '(evil repeat) + (ert-info ("Repeat insert") + (evil-test-buffer + ";; This buffer is for note[s]" + ("IABC" (kbd "ESC")) + "AB[C];; This buffer is for notes" + ("..") + "AB[C]ABCABC;; This buffer is for notes")) + (ert-info ("Repeat insert with count") + (evil-test-buffer + ";; This buffer is for note[s]" + ("2IABC" (kbd "ESC")) + "ABCAB[C];; This buffer is for notes" + ("..") + "ABCAB[C]ABCABCABCABC;; This buffer is for notes")) + (ert-info ("Repeat insert with repeat count") + (evil-test-buffer + ";; This buffer is for note[s]" + ("IABC" (kbd "ESC")) + "AB[C];; This buffer is for notes" + ("11.") + "ABCABCABCABCABCABCABCABCABCABCAB[C]ABC;; This buffer is for notes")) + (ert-info ("Repeat insert with count with repeat with count") + (evil-test-buffer + ";; This buffer is for note[s]" + ("10IABC" (kbd "ESC")) + "ABCABCABCABCABCABCABCABCABCAB[C];; This buffer is for notes" + ("11.") + "ABCABCABCABCABCABCABCABCABCABCAB[C]ABCABCABCABCABCABCABCABCABCABC;; This buffer is for notes"))) + +(ert-deftest evil-test-insert-line-vcount () + "Test `evil-insert-line' with vertical repeating" + :tags '(evil repeat) + (evil-test-buffer + "int[ ]main(int argc, char** argv) +{ + printf(\"Hello world\\n\"); + return EXIT_SUCCESS; +}" + (define-key evil-normal-state-local-map "I" + #'(lambda (count) + (interactive "p") + (evil-insert-line count 4))) + ("2IABC" (kbd "ESC")) + "ABCABCint main(int argc, char** argv) +ABCABC{ + ABCABCprintf(\"Hello world\\n\"); + ABCABCreturn EXIT_SUCCESS; +}")) + +(ert-deftest evil-test-append-line-with-count () + "Test `evil-append-line' with repeat count" + :tags '(evil repeat) + (evil-test-buffer + ";; [T]his buffer is for notes." + ("2Aevil rulz " (kbd "ESC")) + ";; This buffer is for notes.evil rulz evil rulz[ ]")) + +(ert-deftest evil-test-repeat-append-line () + "Test repeating of `evil-append-line'" + :tags '(evil repeat) + (ert-info ("Repeat insert") + (evil-test-buffer + ";; [T]his buffer is for notes." + ("AABC" (kbd "ESC")) + ";; This buffer is for notes.AB[C]" + ("..") + ";; This buffer is for notes.ABCABCAB[C]")) + (ert-info ("Repeat insert with count") + (evil-test-buffer + ";; [T]his buffer is for notes." + ("2AABC" (kbd "ESC")) + ";; This buffer is for notes.ABCAB[C]" + ("..") + ";; This buffer is for notes.ABCABCABCABCABCAB[C]")) + (ert-info ("Repeat insert with repeat count") + (evil-test-buffer + ";; [T]his buffer is for notes." + ("AABC" (kbd "ESC")) + ";; This buffer is for notes.ABC" + ("11.") + ";; This buffer is for notes.ABCABCABCABCABCABCABCABCABCABCABCAB[C]")) + (ert-info ("Repeat insert with count with repeat with count") + (evil-test-buffer + ";; [T]his buffer is for notes." + ("10AABC" (kbd "ESC")) + ";; This buffer is for notes.ABCABCABCABCABCABCABCABCABCAB[C]" + ("11.") + ";; This buffer is for notes.ABCABCABCABCABCABCABCABCABCABCABCABCABCABCABCABCABCABCABCABCAB[C]"))) + +(ert-deftest evil-test-append-line-vcount () + "Test `evil-append-line' with vertical repeating" + :tags '(evil repeat) + (evil-test-buffer + "int[ ]main(int argc, char** argv) +{ + printf(\"Hello world\\n\"); + return EXIT_SUCCESS; +}" + (define-key evil-normal-state-local-map "A" + #'(lambda (count) + (interactive "p") + (evil-append-line count 4))) + ("2AABC" (kbd "ESC")) + "int main(int argc, char** argv)ABCAB[C] +{ABCABC + printf(\"Hello world\\n\");ABCABC + return EXIT_SUCCESS;ABCABC +}")) + +(ert-deftest evil-test-repeat-by-change () + "Test repeating by tracking changes for completion commands" + :tags '(evil repeat) + (let ((line-move-visual nil) + (change (evil-define-command nil () + :repeat change + (interactive) + (delete-char 5) + (insert "BEGIN\n") + (save-excursion + (insert "\nEND\n"))))) + (evil-test-buffer + ";; [T]his buffer is for notes." + (define-key evil-insert-state-local-map (kbd "C-c C-p") change) + ("iABC " (kbd "C-c C-p") "BODY" (kbd "ESC")) + ";; ABC BEGIN +BOD[Y] +END +buffer is for notes." + (".") + ";; ABC BEGIN +BODABC BEGIN +BOD[Y] +END + +buffer is for notes."))) + +(ert-deftest evil-test-repeat-kill-buffer () + "Test safe-guard preventing buffers from being deleted +when repeating a command" + :tags '(evil repeat) + (ert-info ("Test killing works for direct calls \ +to `evil-execute-repeat-info'") + (evil-test-buffer + "[;]; This buffer is for notes." + (setq evil-repeat-ring (make-ring 10)) + (ring-insert evil-repeat-ring '((kill-buffer nil))) + (evil-execute-repeat-info (ring-ref evil-repeat-ring 0)) + (should-not (looking-at ";; This")))) + (ert-info ("Verify an error is raised when using \ +the `evil-repeat' command") + (evil-test-buffer + "[;]; This buffer is for notes." + (setq evil-repeat-ring (make-ring 10)) + (ring-insert evil-repeat-ring '((kill-buffer nil))) + (evil-execute-repeat-info (ring-ref evil-repeat-ring 0)) + (should-error (call-interactively 'evil-repeat))))) + +;;; Operators + +(ert-deftest evil-test-keypress-parser () + "Test `evil-keypress-parser'" + :tags '(evil operator) + (evil-test-buffer + :state operator + (ert-info ("Read from the keyboard unless INPUT is given") + (evil-test-buffer + :state operator + (let ((unread-command-events '(?d))) + (should (equal (evil-keypress-parser) + '(evil-delete nil))) + (should (equal (evil-keypress-parser '(?d)) + '(evil-delete nil)))))) + (ert-info ("Read remainder from the keyboard if INPUT is incomplete") + (let ((unread-command-events '(?d))) + (should (equal (evil-keypress-parser '(?2)) + '(evil-delete 2))))) + (ert-info ("Handle counts not starting with zero") + (should (equal (evil-keypress-parser '(?2 ?d)) + '(evil-delete 2))) + (should (equal (evil-keypress-parser '(?2 ?0 ?d)) + '(evil-delete 20))) + (should (equal (evil-keypress-parser '(?2 ?0 ?2 ?d)) + '(evil-delete 202))) + (should (equal (evil-keypress-parser '(?4 ?0 ?4 ?g ??)) + '(evil-rot13 404)))) + (ert-info ("Treat 0 as a motion") + (should (equal + (evil-keypress-parser '(?0)) + '(evil-digit-argument-or-evil-beginning-of-line nil)))))) + +(ert-deftest evil-test-rot13 () + "Test `evil-rot13'" + :tags '(evil operator) + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save." + ("g?" [M-right]) + ";; [G]uvf buffer is for notes you don't want to save.")) + +(ert-deftest evil-test-rot13-with-count () + "Test `evil-rot13' with count argument" + :tags '(evil operator) + (ert-info ("Count before operator") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save." + ("2g?" [M-right]) + ";; [G]uvf ohssre is for notes you don't want to save.")) + (ert-info ("Count before motion") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save." + ("g?2" [M-right]) + ";; [G]uvf ohssre is for notes you don't want to save.")) + (ert-info ("Count before operator and motion") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save." + ("3g?2" [M-right]) + ";; [G]uvf ohssre vf sbe abgrf lbh don't want to save.")) + (ert-info ("Count exceeding buffer boundaries") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save." + ("g?200" [right]) + ";; [G]uvf ohssre vf sbe abgrf lbh qba'g jnag gb fnir."))) + +(ert-deftest evil-test-rot13-repeat () + "Test repeating of `evil-rot13'" + :tags '(evil operator) + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save." + ("g?" [M-right] [M-right]) + ";; Guvf[ ]buffer is for notes you don't want to save." + (".") + ";; Guvf[ ]ohssre is for notes you don't want to save.")) + +(ert-deftest evil-test-rot13-repeat-with-count () + "Test repeating of `evil-rot13' with new count" + :tags '(evil operator) + (ert-info ("Count before operator") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save." + ("2g?" [M-right]) + ";; [G]uvf ohssre is for notes you don't want to save." + ("3.") + ";; [T]his buffer vf for notes you don't want to save.")) + (ert-info ("Count before motion") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save." + ("g?2" [M-right]) + ";; [G]uvf ohssre is for notes you don't want to save." + ("3.") + ";; [T]his buffer vf for notes you don't want to save.")) + (ert-info ("Count before operator and motion") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save." + ("3g?2" [M-right]) + ";; [G]uvf ohssre vf sbe abgrf lbh don't want to save." + ("4.") + ";; [T]his buffer is for abgrf lbh don't want to save."))) + +(ert-deftest evil-test-operator-delete () + "Test deleting text" + :tags '(evil operator) + (ert-info ("Delete characters") + (evil-test-buffer + ";; [T]his buffer is for notes." + ("dl") + ";; [h]is buffer is for notes." + ("d1l") + ";; [i]s buffer is for notes." + ("1dl") + ";; [s] buffer is for notes." + ("1d1l") + ";; [ ]buffer is for notes." + ("d2l") + ";; [u]ffer is for notes." + ("2dl") + ";; [f]er is for notes." + ("d4l") + ";; [i]s for notes." + ("4dl") + ";; [o]r notes." + ("2d2l") + ";; [o]tes.")) + (ert-info ("Delete current line") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("dd") + "[;]; and for Lisp evaluation.") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("d1d") + "[;]; and for Lisp evaluation.") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("1dd") + "[;]; and for Lisp evaluation.") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("1d1d") + "[;]; and for Lisp evaluation.")) + (ert-info ("Delete two lines") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + ("d2d") + "[;]; then enter the text in that file's own buffer.") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + ("2dd") + "[;]; then enter the text in that file's own buffer.") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + ("dj") + "[;]; then enter the text in that file's own buffer.") + (evil-test-buffer + ";; This buffer is for notes you don't want to save. +;; [I]f you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + ("dk") + "[;]; then enter the text in that file's own buffer."))) + +(evil-define-motion evil-test-square-motion (count) + "Test motion for selecting a square." + :type block + (let ((column (current-column))) + (forward-line (1- count)) + (move-to-column (+ column count -1)))) + +(ert-deftest evil-test-yank () + "Test `evil-yank'" + :tags '(evil operator) + (ert-info ("Yank characters") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save." + ("y2e") + (should (string= (current-kill 0) "This buffer")))) + (ert-info ("Yank lines") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + ("yj") + (should (string= (current-kill 0) + (buffer-substring (point-min) + (1+ (line-end-position 2))))) + (should (eq (car-safe (get-text-property 0 'yank-handler + (current-kill 0))) + 'evil-yank-line-handler))) + (evil-test-buffer + ";; This buffer is for notes you don't want to save. +\[;]; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + ("y5j") + (should + (string= (current-kill 0) + (concat (buffer-substring (line-beginning-position 1) + (point-max)) + "\n"))) + (should (eq (car-safe (get-text-property 0 'yank-handler + (current-kill 0))) + 'evil-yank-line-handler)))) + (ert-info ("Yank rectangle") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("y3s") + (should (string= (current-kill 0) "Thi\nIf \nthe")) + (should (eq (car-safe (get-text-property 0 'yank-handler + (current-kill 0))) + 'evil-yank-block-handler))))) + +(ert-deftest evil-test-delete () + "Test `evil-delete'" + :tags '(evil operator) + (ert-info ("Delete characters") + (evil-test-buffer + ";; This buffer is for notes you don't want to save[.]" + ("x") + ";; This buffer is for notes you don't want to sav[e]" + (goto-char 4) + ";; [T]his buffer is for notes you don't want to save" + ("d2e") + ";; [ ]is for notes you don't want to save" + (should (string= (current-kill 0) "This buffer")) + ("P") + ";; [T]his buffer is for notes you don't want to save")) + (ert-info ("Delete lines") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + ("2dd") + "[;]; then enter the text in that file's own buffer." + ("P") + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer.")) + (ert-info ("Delete last line") + (evil-test-buffer + ";; This buffer is for notes you don't want to save. +;; [I]f you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + ("2dd") + ";; This buffer is for notes you don't want to save[.]")) + (ert-info ("Delete rectangle") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("d3s") + "[T]his buffer is for notes you don't want to save. +If you want to create a file, visit that file with C-x C-f, +then enter the text in that file's own buffer."))) + +(ert-deftest evil-test-change () + "Test `evil-change'" + :tags '(evil operator) + (ert-info ("Change characters") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save." + ("c2eABC" (kbd "ESC")) + ";; AB[C] is for notes you don't want to save." + (should (string= (current-kill 0) "This buffer")) + ("p") + ";; ABCThis buffe[r] is for notes you don't want to save.")) + (ert-info ("Change lines") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + ("2ccABCLINE\nDEFLINE" (kbd "ESC")) + "ABCLINE +DEFLIN[E] +;; then enter the text in that file's own buffer." + ("p") + "ABCLINE +DEFLINE +\[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer.")) + (ert-info ("Change last line") + (evil-test-buffer + ";; This buffer is for notes you don't want to save. +;; [I]f you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + ("2ccABC" (kbd "ESC")) + ";; This buffer is for notes you don't want to save. +AB[C]")) + (ert-info ("Change rectangle") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("c3sABC" (kbd "ESC")) + "AB[C]This buffer is for notes you don't want to save. +ABCIf you want to create a file, visit that file with C-x C-f, +ABCthen enter the text in that file's own buffer."))) + +(ert-deftest evil-test-change-word () + "Test changing words" + :tags '(evil operator) + (ert-info ("Non-word") + (evil-test-buffer + "[;]; This buffer is for notes." + ("cwABC" (kbd "ESC")) + "AB[C] This buffer is for notes.")) + (ert-info ("Word") + (evil-test-buffer + ";; [T]his buffer is for notes." + ("cwABC" (kbd "ESC")) + ";; AB[C] buffer is for notes.")) + (ert-info ("Single character") + (evil-test-buffer + "[;] This buffer is for notes." + ("cwABC" (kbd "ESC")) + "AB[C] This buffer is for notes."))) + +(ert-deftest evil-test-join () + "Test `evil-join'" + :tags '(evil operator) + (ert-info ("Simple") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f." + ("J") + ";; This buffer is for notes you don't want to save.[ ]\ +;; If you want to create a file, visit that file with C-x C-f.")) + (ert-info ("Visual") + (evil-test-buffer + :visual line + "<;; [T]his buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f.>" + ("J") + ";; This buffer is for notes you don't want to save.[ ]\ +;; If you want to create a file, visit that file with C-x C-f."))) + +(ert-deftest evil-test-substitute () + "Test `evil-substitute'" + :tags '(evil operator) + (ert-info ("Simple") + (evil-test-buffer + ";; [T]his buffer is for notes." + ("5sABC" (kbd "ESC")) + ";; AB[C]buffer is for notes.")) + (ert-info ("On empty line") + (evil-test-buffer + "Above some line +\[] +Below some empty line" + ("5sABC" (kbd "ESC")) + "Above some line +AB[C] +Below some empty line"))) + +;;; Paste + +(ert-deftest evil-test-paste-before () + "Test `evil-paste-before'" + :tags '(evil operator) + (ert-info ("Paste characters") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("y2ej0") + ";; This buffer is for notes you don't want to save, +\[;]; and for Lisp evaluation." + ("P") + ";; This buffer is for notes you don't want to save, +\[T]his buffer;; and for Lisp evaluation.")) + (ert-info ("Paste characters with count") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("y2ej0") + ";; This buffer is for notes you don't want to save, +\[;]; and for Lisp evaluation." + ("3P") + ";; This buffer is for notes you don't want to save, +\[T]his bufferThis bufferThis buffer;; and for Lisp evaluation.")) + (ert-info ("Paste characters at end-of-buffer") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("y2eG$") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation[.]" + ("2P") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation[T]his bufferThis buffer.")) + (ert-info ("Paste characters at end-of-buffer on empty line") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation.\n" + ("y2eG") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. +\[]" + ("2P") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. +\[T]his bufferThis buffer")) + (ert-info ("Paste lines") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("2yyP") + "[;]; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. +;; This buffer is for notes you don't want to save, +;; and for Lisp evaluation.")) + (ert-info ("Paste lines with count") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("2yy2P") + "[;]; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. +;; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. +;; This buffer is for notes you don't want to save, +;; and for Lisp evaluation.")) + (ert-info ("Paste lines at end-of-buffer") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation.\n" + ("2yyG") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. +\[]" + ("2P") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. +\[;]; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. +;; This buffer is for notes you don't want to save, +;; and for Lisp evaluation.\n")) + (ert-info ("Paste block") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("3ysP") + "[;]; ;; This buffer is for notes you don't want to save. +;; ;; If you want to create a file, visit that file with C-x C-f, +;; ;; then enter the text in that file's own buffer.")) + (ert-info ("Paste block with count") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("3ys2P") + "[;]; ;; ;; This buffer is for notes you don't want to save. +;; ;; ;; If you want to create a file, visit that file with C-x C-f, +;; ;; ;; then enter the text in that file's own buffer.")) + (ert-info ("Paste block with empty line") + (evil-test-buffer + "[;]; Above some line + +;; Below some empty line" + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("3ys2P") + "[;]; ;; ;; Above some line + \n\ +;; ;; ;; Below some empty line")) + (ert-info ("Paste block crossing end of buffer") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("3ysj") + ";; This buffer is for notes you don't want to save. +\[;]; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + ("P") + ";; This buffer is for notes you don't want to save. +\[;]; ;; If you want to create a file, visit that file with C-x C-f, +;; ;; then enter the text in that file's own buffer. +;;")) + (ert-info ("Paste block at end-of-line") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("3ys$") + ";; This buffer is for notes you don't want to save[.] +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + ("p") + ";; This buffer is for notes you don't want to save.[;]; +;; If you want to create a file, visit that file wi;; th C-x C-f, +;; then enter the text in that file's own buffer. ;;"))) + +(ert-deftest evil-test-paste-after () + "Test `evil-paste-after'" + :tags '(evil operator) + (ert-info ("Paste characters") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("y2ej0") + ";; This buffer is for notes you don't want to save, +\[;]; and for Lisp evaluation." + ("p") + ";; This buffer is for notes you don't want to save, +;This buffe[r]; and for Lisp evaluation.")) + (ert-info ("Paste characters with count") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("y2ej0") + ";; This buffer is for notes you don't want to save, +\[;]; and for Lisp evaluation." + ("3p") + ";; This buffer is for notes you don't want to save, +;This bufferThis bufferThis buffe[r]; and for Lisp evaluation.")) + (ert-info ("Paste characters at end-of-buffer") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("y2eG$") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation[.]" + ("2p") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation.This bufferThis buffe[r]")) + (ert-info ("Paste characters at end-of-buffer on empty line") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation.\n" + ("y2eG") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. +\[]" + ("2p") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. +This bufferThis buffe[r]")) + (ert-info ("Paste lines") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("2yyp") + ";; This buffer is for notes you don't want to save, +\[;]; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. +;; and for Lisp evaluation.")) + (ert-info ("Paste lines with count") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("2yy2p") + ";; This buffer is for notes you don't want to save, +\[;]; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. +;; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. +;; and for Lisp evaluation.")) + (ert-info ("Paste lines at end-of-buffer") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation.\n" + ("2yyG") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. +\[]" + ("2p") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. + +\[;]; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. +;; This buffer is for notes you don't want to save, +;; and for Lisp evaluation.")) + (ert-info ("Paste block") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("3ysp") + ";[;]; ; This buffer is for notes you don't want to save. +;;; ; If you want to create a file, visit that file with C-x C-f, +;;; ; then enter the text in that file's own buffer.")) + (ert-info ("Paste block with count") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("3ys2p") + ";[;]; ;; ; This buffer is for notes you don't want to save. +;;; ;; ; If you want to create a file, visit that file with C-x C-f, +;;; ;; ; then enter the text in that file's own buffer.")) + (ert-info ("Paste block with empty line") + (evil-test-buffer + "[;]; Above some line + +;; Below some empty line" + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("3ys2p") + ";;; ;; ; Above some line + +;;; ;; ; Below some empty line")) + (ert-info ("Paste block crossing end of buffer") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("3ysj") + ";; This buffer is for notes you don't want to save. +\[;]; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + ("p") + ";; This buffer is for notes you don't want to save. +;;; ; If you want to create a file, visit that file with C-x C-f, +;;; ; then enter the text in that file's own buffer. + ;;")) + (ert-info ("Paste block at end-of-line") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("3ys$") + ";; This buffer is for notes you don't want to save[.] +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + ("p") + ";; This buffer is for notes you don't want to save.;; +;; If you want to create a file, visit that file wi;; th C-x C-f, +;; then enter the text in that file's own buffer. ;;"))) + +(ert-deftest evil-test-paste-pop-before () + "Test `evil-paste-pop' after `evil-paste-before'" + :tags '(evil operator) + (ert-info ("Paste") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("y2e2yyy3sj") + ";; This buffer is for notes you don't want to save. +\[;]; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + ("P") + ";; This buffer is for notes you don't want to save. +\[;]; ;; If you want to create a file, visit that file with C-x C-f, +;; ;; then enter the text in that file's own buffer. +;;")) + (ert-info ("Single pop") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("y2e2yyy3sjP\C-p") + ";; This buffer is for notes you don't want to save. +\[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer.")) + (ert-info ("Two pops") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("y2e2yyy3sjP\C-p\C-p") + ";; This buffer is for notes you don't want to save. +\[;]; This;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer.")) + (ert-info ("Pop with count") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("y2e2yyy3sjP2\C-p") + ";; This buffer is for notes you don't want to save. +\[;]; This;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer.")) + (ert-info ("Single pop-next") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("y2e2yyy3sjP2\C-p\C-n") + ";; This buffer is for notes you don't want to save. +\[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer.")) + (ert-info ("Pop-next with count") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("y2e2yyy3sjP\C-p\C-p2\C-n") + ";; This buffer is for notes you don't want to save. +\[;]; ;; If you want to create a file, visit that file with C-x C-f, +;; ;; then enter the text in that file's own buffer. +;;"))) + +(ert-deftest evil-test-paste-pop-after () + "Test `evil-paste-pop' after `evil-paste-after'" + :tags '(evil operator) + (ert-info ("Paste") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("y2e2yyy3sj") + ";; This buffer is for notes you don't want to save. +\[;]; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + ("p") + ";; This buffer is for notes you don't want to save. +;[;]; ; If you want to create a file, visit that file with C-x C-f, +;;; ; then enter the text in that file's own buffer. + ;;")) + (ert-info ("Single pop") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("y2e2yyy3sjp\C-p") + ";; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +\[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer.")) + (ert-info ("Two pops") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("y2e2yyy3sjp\C-p\C-p") + ";; This buffer is for notes you don't want to save. +;;; Thi[s]; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer.")) + (ert-info ("Pop with count") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("y2e2yyy3sjp2\C-p") + ";; This buffer is for notes you don't want to save. +;;; Thi[s]; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer.")) + (ert-info ("Single pop-next") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("y2e2yyy3sjp2\C-p\C-n") + ";; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +\[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer.")) + (ert-info ("Pop-next with count") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("y2e2yyy3sjp\C-p\C-p2\C-n") + ";; This buffer is for notes you don't want to save. +;[;]; ; If you want to create a file, visit that file with C-x C-f, +;;; ; then enter the text in that file's own buffer. + ;;"))) + +(ert-deftest evil-test-paste-pop-without-undo () + "Text `evil-paste-pop' with undo disabled" + :tags '(evil operator) + (ert-info ("Pop-next with count without undo") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (setq buffer-undo-list t) + (define-key evil-operator-state-local-map "s" 'evil-test-square-motion) + ("y2e2yyy3sjP\C-p\C-p2\C-n") + ";; This buffer is for notes you don't want to save. +\[;]; ;; If you want to create a file, visit that file with C-x C-f, +;; ;; then enter the text in that file's own buffer. +;;"))) + +;;; Motions + +(ert-deftest evil-test-forward-char () + "Test `evil-forward-char' motion" + :tags '(evil motion) + (ert-info ("Simple") + (evil-test-buffer + "[;]; This buffer is for notes." + ("l") + ";[;] This buffer is for notes.")) + (ert-info ("With count") + (evil-test-buffer + "[;]; This buffer is for notes." + ("12l") + ";; This buff[e]r is for notes.")) + (ert-info ("End of line") + (evil-test-buffer + ";; This buffer is for notes[.]" + (should-error (execute-kbd-macro "l")) + (should-error (execute-kbd-macro "10l")))) + (ert-info ("Until end-of-line") + (evil-test-buffer + "[;]; This buffer is for notes." + ("100l") + ";; This buffer is for notes[.]")) + (ert-info ("On empty line") + (evil-test-buffer + "Above some line +\[] +Below some empty line" + (should-error (execute-kbd-macro "l")) + (should-error (execute-kbd-macro "42l"))))) + +(ert-deftest evil-test-backward-char () + "Test `evil-backward-char' motion" + :tags '(evil motion) + (ert-info ("Simple") + (evil-test-buffer + ";; This[ ]buffer is for notes." + ("h") + ";; Thi[s] buffer is for notes.")) + (ert-info ("With count") + (evil-test-buffer + ";; This[ ]buffer is for notes." + ("3h") + ";; T[h]is buffer is for notes.")) + (ert-info ("Beginning of line") + (evil-test-buffer + "[;]; This buffer is for notes." + (should-error (execute-kbd-macro "h")) + (should-error (execute-kbd-macro "10h")))) + (ert-info ("Until beginning-of-line") + (evil-test-buffer + ";; This[ ]buffer is for notes." + ("100h") + "[;]; This buffer is for notes.")) + (ert-info ("On empty line") + (evil-test-buffer + "Above some line +\[] +Below some empty line" + (should-error (execute-kbd-macro "h")) + (should-error (execute-kbd-macro "42h"))))) + +(ert-deftest evil-test-previous-line () + "Test `evil-previous-line' motion" + :tags '(evil motion) + (ert-info ("Simple") + (evil-test-buffer + ";; This buffer is for notes you don't want to save, +;; [a]nd for Lisp evaluation." + ("k") + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation.")) + (ert-info ("With count") + (evil-test-buffer + ";; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; [t]hen enter the text in that file's own buffer." + ("2k") + ";; [T]his buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer.")) + (ert-info ("Until beginning of buffer") + (evil-test-buffer + ";; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; [t]hen enter the text in that file's own buffer." + ("100k") + ";; [T]his buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer.")) + (ert-info ("At beginning of buffer") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save." + (should-error (execute-kbd-macro "k")) + (should-error (execute-kbd-macro "42k"))))) + +(ert-deftest evil-test-next-line () + "Test `evil-next-line' motion" + :tags '(evil motion) + (ert-info ("Simple") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("j") + ";; This buffer is for notes you don't want to save, +;; [a]nd for Lisp evaluation.")) + (ert-info ("With count") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + ("2j") + ";; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; [t]hen enter the text in that file's own buffer.")) + (ert-info ("Until end of buffer") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + ("100j") + ";; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; [t]hen enter the text in that file's own buffer.")) + (ert-info ("At end of buffer") + (evil-test-buffer + ";; This buffer is for notes you don't want to [s]ave." + (should-error (execute-kbd-macro "j")) + (should-error (execute-kbd-macro "42j"))))) + +(ert-deftest evil-test-beginning-of-line () + "Test `evil-beginning-of-line' motion" + :tags '(evil motion) + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save." + ("0") + "[;]; This buffer is for notes you don't want to save." + ("0") + "[;]; This buffer is for notes you don't want to save.")) + +(ert-deftest evil-test-end-of-line () + "Test `evil-end-of-line' motion" + :tags '(evil motion) + (ert-info ("Simple") + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save." + ("$") + ";; This buffer is for notes you don't want to save[.]" + ("$") + ";; This buffer is for notes you don't want to save[.]")) + (ert-info ("Don't delete blank lines") + (evil-test-buffer + "Above some line +\[] +Below some empty line" + ("d$") + "Above some line +\[] +Below some empty line"))) + +(ert-deftest evil-test-first-non-blank () + "Test `evil-first-non-blank' motion" + :tags '(evil motion) + (evil-test-buffer + "\ + printf(\"Hello world\\n\")[;] + return EXIT_SUCCESS;" + ("^") + "\ + [p]rintf(\"Hello world\\n\"); + return EXIT_SUCCESS;" + ("j^") + "\ + printf(\"Hello world\\n\"); + [r]eturn EXIT_SUCCESS;")) + +(ert-deftest evil-test-last-non-blank () + "Test `evil-last-non-blank' motion" + :tags '(evil motion) + (evil-test-buffer + "[i]nt main(int argc, char** argv) \n\ +{ + printf(\"Hello world\\n\"); + return EXIT_SUCCESS; +}" + ("g_") + "int main(int argc, char** argv[)] \n\ +{ + printf(\"Hello world\\n\"); + return EXIT_SUCCESS; +}" + ("jjg_") + "int main(int argc, char** argv) \n\ +{ + printf(\"Hello world\\n\")[;] + return EXIT_SUCCESS; +}")) + +(ert-deftest evil-test-goto-first-line () + "Test `evil-goto-first-line' motion" + :tags '(evil motion) + (evil-test-buffer + "[i]nt main(int argc, char** argv) +{ + printf(\"Hello world\\n\"); + return EXIT_SUCCESS; +}" + ("3gg") + "int main(int argc, char** argv) +{ + [p]rintf(\"Hello world\\n\"); + return EXIT_SUCCESS; +}" + ("gg") + "[i]nt main(int argc, char** argv) +{ + printf(\"Hello world\\n\"); + return EXIT_SUCCESS; +}" + ("100gg") + "int main(int argc, char** argv) +{ + printf(\"Hello world\\n\"); + return EXIT_SUCCESS; +\[}]")) + +(ert-deftest evil-test-goto-line () + "Test `evil-goto-line' motion" + :tags '(evil motion) + (evil-test-buffer + "[i]nt main(int argc, char** argv) +{ + printf(\"Hello world\\n\"); + return EXIT_SUCCESS; +}" + ("G") + "int main(int argc, char** argv) +{ + printf(\"Hello world\\n\"); + return EXIT_SUCCESS; +\[}]" + ("3G") + "int main(int argc, char** argv) +{ + [p]rintf(\"Hello world\\n\"); + return EXIT_SUCCESS; +}" + ("100G") + "int main(int argc, char** argv) +{ + printf(\"Hello world\\n\"); + return EXIT_SUCCESS; +\[}]")) + +(ert-deftest evil-test-operator-0 () + "Test motion \"0\" with an operator." + :tags '(evil motion) + (evil-test-buffer + ";; [T]his buffer is for notes." + ("d0") + "[T]his buffer is for notes.")) + +;; TODO: test Visual motions and window motions +(ert-deftest evil-test-move-chars () + "Test `evil-move-chars'" + :tags '(evil motion) + (ert-info ("Simple forward") + (evil-test-buffer + "[i]nt main(int argc, char** argv) +{ + printf(\"Hello world\\n\"); + return EXIT_SUCCESS; +}" + (evil-move-chars "{" 1) + "int main(int argc, char** argv) +{[] + printf(\"Hello world\\n\"); + return EXIT_SUCCESS; +}" + (evil-move-chars "a-z" 1) + "int main(int argc, char** argv) +{ + printf[(]\"Hello world\\n\"); + return EXIT_SUCCESS; +}" + (evil-move-chars "a-z" 1) + "int main(int argc, char** argv) +{ + printf(\"Hello[ ]world\\n\"); + return EXIT_SUCCESS; +}")) + (ert-info ("No match") + (evil-test-buffer + "[i]nt main(int argc, char** argv) +{ + printf(\"Hello world\\n\"); + return EXIT_SUCCESS; +}" + (should (eq (evil-move-chars "Q" 1) 1)))) + (ert-info ("Simple backward") + (evil-test-buffer + "int main(int argc, char** argv) +{ + printf(\"Hello world\\n\"); + return EXIT_SUCCESS; +\[}]") + (evil-move-chars "*" -1) + "int main(int argc, char[*]* argv) +{ + printf(\"Hello world\\n\"); + return EXIT_SUCCESS; +}" + (evil-move-chars "*" -1) + "int main(int argc, char[*]* argv) +{ + printf(\"Hello world\\n\"); + return EXIT_SUCCESS; +}") + (ert-info ("Beginning of buffer") + (evil-test-buffer + "int[ ]main(int argc, char** argv) +{ + printf(\"Hello world\\n\"); + return EXIT_SUCCESS; +}" + (should (= -1 (evil-move-chars "Q" -1)))))) + +(ert-deftest evil-test-forward-word-begin () + "Test `evil-forward-word-begin'" + :tags '(evil motion) + (ert-info ("Non-word") + (evil-test-buffer + "[;]; This buffer is for notes." + ("w") + ";; [T]his buffer is for notes.")) + (ert-info ("Simple") + (evil-test-buffer + ";; [T]his buffer is for notes." + ("w") + ";; This [b]uffer is for notes.")) + (ert-info ("With count") + (evil-test-buffer + ";; [T]his buffer is for notes." + ("3w") + ";; This buffer is [f]or notes.")) + (ert-info ("With count on whitespace") + (evil-test-buffer + ";;[ ]This buffer is for notes." + ("3w") + ";; This buffer [i]s for notes.")) + (ert-info ("Empty line") + (evil-test-buffer + "Above some line +\[] +Below some empty line" + ("w") + "Above some line + +\[B]elow some empty line")) + (ert-info ("End of buffer") + (evil-test-buffer + ";; [T]his buffer is for notes." + ("100w") + ";; This buffer is for notes[.]" + (should-error (execute-kbd-macro "w")) + (should-error (execute-kbd-macro "10w"))))) + +(ert-deftest evil-test-forward-word-end () + "Test `evil-forward-word-end'" + :tags '(evil motion) + (ert-info ("Non-word") + (evil-test-buffer + "[;]; This buffer is for notes." + ("e") + ";[;] This buffer is for notes.")) + (ert-info ("Simple") + (evil-test-buffer + ";; [T]his buffer is for notes." + ("e") + ";; Thi[s] buffer is for notes.")) + (ert-info ("With count") + (evil-test-buffer + ";; [T]his buffer is for notes." + ("3e") + ";; This buffer i[s] for notes.")) + (ert-info ("With count on whitespace") + (evil-test-buffer + ";;[ ]This buffer is for notes." + ("3e") + ";; This buffer i[s] for notes.")) + (ert-info ("Empty line") + (evil-test-buffer + "Above some line +\[] +Below some empty line" + ("e") + "Above some line + +Belo[w] some empty line")) + (ert-info ("End of buffer") + (evil-test-buffer + ";; [T]his buffer is for notes." + ("100e") + ";; This buffer is for notes[.]" + (should-error (execute-kbd-macro "e")) + (should-error (execute-kbd-macro "10e")))) + ;; In Vim, "de" may delete two words rather than one + ;; if the first word is only one letter. In Evil, + ;; "de" always deletes one word. + (ert-info ("Delete a single-letter word") + (evil-test-buffer + "a [b] c" + ("de") + "a [ ]c"))) + +(ert-deftest evil-test-backward-word-begin () + "Test `evil-backward-word-begin'" + :tags '(evil motion) + (ert-info ("Simple") + (evil-test-buffer + ";; This buffer is for notes[.]" + ("b") + ";; This buffer is for [n]otes.")) + (ert-info ("With count") + (evil-test-buffer + ";; This buffer is for notes[.]" + ("2b") + ";; This buffer is [f]or notes.")) + (ert-info ("Empty line") + (evil-test-buffer + "Above some line +\[] +Below some empty line" + ("b") + "Above some [l]ine + +Below some empty line")) + (ert-info ("With count on whitespace") + (evil-test-buffer + ";; This buffer is for[ ]notes." + ("2b") + ";; This buffer [i]s for notes.")) + (ert-info ("Beginning of buffer") + (evil-test-buffer + ";; This buffer is for notes[.]" + ("100b") + "[;]; This buffer is for notes." + (should-error (execute-kbd-macro "b")) + (should-error (execute-kbd-macro "10b"))))) + +(ert-deftest evil-test-backward-word-end () + "Test `evil-backward-word-end'" + :tags '(evil motion) + (ert-info ("Simple") + (evil-test-buffer + ";; This buffer is for notes[.]" + ("ge") + ";; This buffer is for note[s].")) + (ert-info ("With count") + (evil-test-buffer + ";; This buffer is for notes[.]" + ("2ge") + ";; This buffer is fo[r] notes.")) + (ert-info ("Empty line") + (evil-test-buffer + "Above some line +\[] +Below some empty line" + ("ge") + "Above some lin[e] + +Below some empty line")) + (ert-info ("With count on whitespace") + (evil-test-buffer + ";; This buffer is for[ ]notes." + ("2ge") + ";; This buffer i[s] for notes.")) + (ert-info ("Beginning of buffer") + (evil-test-buffer + ";; This buffer is for notes[.]" + ("100ge") + "[;]; This buffer is for notes." + (should-error (execute-kbd-macro "ge")) + (should-error (execute-kbd-macro "10ge"))))) + +(ert-deftest evil-test-move-paragraph () + "Test `evil-move-paragraph'" + :tags '(evil motion) + (ert-info ("Simple forward") + (evil-test-buffer + "[A]bove some line + +Below some empty line" + (should (= (evil-move-paragraph 1) 0)) + "Above some line[] + +Below some empty line" + (should (= (evil-move-paragraph 1) 0)) + "Above some line + +Below some empty line[]")) + (ert-info ("Forward with count") + (evil-test-buffer + "[A]bove some line + +Below some empty line" + (should (= (evil-move-paragraph 2) 0)) + "Above some line + +Below some empty line[]")) + (ert-info ("End of buffer without newline") + (evil-test-buffer + "[B]elow some empty line" + (should (= (evil-move-paragraph 2) 1)) + "Below some empty line[]" + (should (= (evil-move-paragraph 1) 1)) + "Below some empty line[]")) + (ert-info ("End of buffer with newline") + (evil-test-buffer + "[B]elow some empty line\n\n" + (should (= (evil-move-paragraph 2) 1)) + "Below some empty line[]\n\n" + (should (= (evil-move-paragraph 1) 1)) + "Below some empty line[]\n\n")) + (ert-info ("Simple backward") + (evil-test-buffer + "Above some line + +Below some empty line[]" + (should (= (evil-move-paragraph -1) 0)) + "Above some line + +\[]Below some empty line" + (should (= (evil-move-paragraph -1) 0)) + "[A]bove some line + +Below some empty line")) + (ert-info ("Backward with count") + (evil-test-buffer + "Above some line + +Below some empty line[]" + (should (= (evil-move-paragraph -2) 0)) + "[A]bove some line + +Below some empty line")) + (ert-info ("Beginning of buffer without newline") + (evil-test-buffer + "Above some line[]" + (should (= (evil-move-paragraph -2) -1)) + "[A]bove some line" + (should (= (evil-move-paragraph -1) -1)) + "[A]bove some line")) + (ert-info ("Beginning of buffer with newline") + (evil-test-buffer + "\n\nAbove some line[]" + (should (= (evil-move-paragraph -2) -1)) + "\n\n[A]bove some line" + (should (= (evil-move-paragraph -1) -1)) + "\n\n[A]bove some line"))) + +(ert-deftest evil-test-forward-paragraph () + "Test `evil-forward-paragraph'" + :tags '(evil motion) + (ert-info ("Simple") + (evil-test-buffer + "[A]bove some line + +Below some empty line" + ("}") + "Above some line +\[] +Below some empty line")) + (ert-info ("With count") + (evil-test-buffer + "[A]bove some line + +Below some empty line" + ("2}") + "Above some line + +Below some empty lin[e]")) + (ert-info ("End of buffer") + (evil-test-buffer + "[B]elow some empty line" + ("100}") + "Below some empty lin[e]" + (should-error (execute-kbd-macro "}")) + (should-error (execute-kbd-macro "42}")))) + (ert-info ("End of buffer with newline") + (evil-test-buffer + "[B]elow some empty line\n\n" + ("100}") + "Below some empty line\n\n[]" + (should-error (execute-kbd-macro "}")) + (should-error (execute-kbd-macro "42}"))))) + +(ert-deftest evil-test-backward-paragraph () + "Test `evil-backward-paragraph'" + :tags '(evil motion) + (ert-info ("Simple") + (evil-test-buffer + "Above some line + +Below some empty lin[e]" + ("{") + "Above some line +\[] +Below some empty line")) + (ert-info ("With count") + (evil-test-buffer + "Above some line + +Below some empty lin[e]" + ("2{") + "[A]bove some line + +Below some empty line")) + (ert-info ("Beginning of buffer") + (evil-test-buffer + "Above some line + +Below some empty lin[e]" + ("100{") + "[A]bove some line + +Below some empty line" + (should-error (execute-kbd-macro "{")) + (should-error (execute-kbd-macro "42{")))) + (ert-info ("Beginning of buffer with newlines") + (evil-test-buffer + "\n\nAbove some line + +Below some empty lin[e]" + ("100{") + "[]\n\nAbove some line + +Below some empty line" + (should-error (execute-kbd-macro "{")) + (should-error (execute-kbd-macro "42{"))))) + +(ert-deftest evil-test-forward-sentence () + "Test `evil-forward-sentence'" + :tags '(evil motion) + (ert-info ("Simple") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. If you want to create a file, +;; visit that file with C-x C-f. + +Below some empty line." + (")") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. [I]f you want to create a file, +;; visit that file with C-x C-f. + +Below some empty line." + (")") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. If you want to create a file, +;; visit that file with C-x C-f. +\[] +Below some empty line." + (")") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. If you want to create a file, +;; visit that file with C-x C-f. + +\[B]elow some empty line.")) + (ert-info ("With count") + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. If you want to create a file, +;; visit that file with C-x C-f. + +Below some empty line." + ("2)") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. If you want to create a file, +;; visit that file with C-x C-f. +\[] +Below some empty line." + ("2)") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. If you want to create a file, +;; visit that file with C-x C-f. + +Below some empty line[.]")) + (ert-info ("End of buffer") + (evil-test-buffer + "[B]elow some empty line." + ("100)") + "Below some empty line[.]" + (should-error (execute-kbd-macro ")")) + (should-error (execute-kbd-macro "42)")))) + (ert-info ("End of buffer with newline") + (evil-test-buffer + "[B]elow some empty line.\n\n" + ("100)") + "Below some empty line.\n\n[]" + (should-error (execute-kbd-macro ")")) + (should-error (execute-kbd-macro "42)"))))) + +(ert-deftest evil-test-backward-sentence () + "Test `evil-backward-sentence'" + :tags '(evil motion) + (ert-info ("Simple") + (evil-test-buffer + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. If you want to create a file, +;; visit that file with C-x C-f. + +Below some empty line[.]" + ("(") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. If you want to create a file, +;; visit that file with C-x C-f. + +\[B]elow some empty line." + ("(") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. If you want to create a file, +;; visit that file with C-x C-f. +\[] +Below some empty line." + ("(") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. [I]f you want to create a file, +;; visit that file with C-x C-f. + +Below some empty line." + ("(") + "[;]; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. If you want to create a file, +;; visit that file with C-x C-f. + +Below some empty line.")) + (ert-info ("With count") + (evil-test-buffer + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. If you want to create a file, +;; visit that file with C-x C-f. + +Below some empty line[.]" + ("2(") + ";; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. If you want to create a file, +;; visit that file with C-x C-f. +\[] +Below some empty line." + ("2(") + "[;]; This buffer is for notes you don't want to save, +;; and for Lisp evaluation. If you want to create a file, +;; visit that file with C-x C-f. + +Below some empty line.")) + (ert-info ("Beginning of buffer") + (evil-test-buffer + ";; This buffer is for notes you don't want to save[.]" + ("100(") + "[;]; This buffer is for notes you don't want to save." + (should-error (execute-kbd-macro "(")) + (should-error (execute-kbd-macro "42(")))) + (ert-info ("Beginning of buffer with newlines") + (evil-test-buffer + "\n\n;; This buffer is for notes you don't want to save[.]" + ("100(") + "[]\n\n;; This buffer is for notes you don't want to save." + (should-error (execute-kbd-macro "(")) + (should-error (execute-kbd-macro "42("))))) + +(ert-deftest evil-test-find-char () + "Test `evil-find-char'" + :tags '(evil motion) + (ert-info ("Simple") + (evil-test-buffer + "[;]; This buffer is for notes." + ("fT") + ";; [T]his buffer is for notes.")) + (ert-info ("With count") + (evil-test-buffer + "[;]; This buffer is for notes." + ("2fe") + ";; This buffer is for not[e]s.")) + (ert-info ("Repeat") + (evil-test-buffer + "[;]; This buffer is for notes." + ("fe;") + ";; This buffer is for not[e]s.")) + (ert-info ("Repeat backward") + (evil-test-buffer + "[;]; This buffer is for notes." + ("2fe,") + ";; This buff[e]r is for notes.")) + (ert-info ("No match") + (evil-test-buffer + "[;]; This buffer is for notes." + (should-error (execute-kbd-macro "fL")))) + (ert-info ("End of line") + (let ((evil-find-skip-newlines t)) + (evil-test-buffer + "[;]; This buffer is for notes, +;; and for Lisp evaluation." + ("fL") + ";; This buffer is for notes, +;; and for [L]isp evaluation.")))) + +(ert-deftest evil-test-find-char-backward () + "Test `evil-find-char-backward'" + :tags '(evil motion) + (ert-info ("Simple") + (evil-test-buffer + ";; This buffer is for notes[.]" + ("FT") + ";; [T]his buffer is for notes.")) + (ert-info ("With count") + (evil-test-buffer + ";; This buffer is for notes[.]" + ("2Fe") + ";; This buff[e]r is for notes.")) + (ert-info ("Repeat") + (evil-test-buffer + ";; This buffer is for notes[.]" + ("Fe;") + ";; This buff[e]r is for notes.")) + (ert-info ("Repeat backward") + (evil-test-buffer + ";; This buffer is for notes[.]" + ("2Fe,") + ";; This buffer is for not[e]s.")) + (ert-info ("No match") + (evil-test-buffer + ";; This buffer is for notes[.]" + (should-error (execute-kbd-macro "FL")))) + (ert-info ("End of line") + (let ((evil-find-skip-newlines t)) + (evil-test-buffer + ";; This buffer is for notes, +;; and for Lisp evaluation[.]" + ("FT") + ";; [T]his buffer is for notes, +;; and for Lisp evaluation.")))) + +(ert-deftest evil-test-find-char-to () + "Test `evil-find-char-to'" + :tags '(evil motion) + (ert-info ("Simple") + (evil-test-buffer + "[;]; This buffer is for notes." + ("tT") + ";;[ ]This buffer is for notes.")) + (ert-info ("With count") + (evil-test-buffer + "[;]; This buffer is for notes." + ("2te") + ";; This buffer is for no[t]es.")) + (ert-info ("Repeat") + (evil-test-buffer + "[;]; This buffer is for notes." + ("tel;") + ";; This buffer is for no[t]es.")) + (ert-info ("Repeat backward") + (evil-test-buffer + "[;]; This buffer is for notes." + ("2te,") + ";; This buffe[r] is for notes.")) + (ert-info ("No match") + (evil-test-buffer + "[;]; This buffer is for notes." + (should-error (execute-kbd-macro "tL")))) + (ert-info ("End of line") + (let ((evil-find-skip-newlines t)) + (evil-test-buffer + "[;]; This buffer is for notes, +;; and for Lisp evaluation." + ("tL") + ";; This buffer is for notes, +;; and for[ ]Lisp evaluation.")))) + +(ert-deftest evil-test-find-char-to-backward () + "Test `evil-find-char-to-backward'" + :tags '(evil motion) + (ert-info ("Simple") + (evil-test-buffer + ";; This buffer is for notes[.]" + ("TT") + ";; T[h]is buffer is for notes.")) + (ert-info ("With count") + (evil-test-buffer + ";; This buffer is for notes[.]" + ("2Te") + ";; This buffe[r] is for notes.")) + (ert-info ("Repeat") + (evil-test-buffer + ";; This buffer is for notes[.]" + ("Teh;") + ";; This buffe[r] is for notes.")) + (ert-info ("Repeat backward") + (evil-test-buffer + ";; This buffer is for notes[.]" + ("2Te,") + ";; This buffer is for no[t]es.")) + (ert-info ("No match") + (evil-test-buffer + ";; This buffer is for notes[.]" + (should-error (execute-kbd-macro "TL")))) + (ert-info ("End of line") + (let ((evil-find-skip-newlines t)) + (evil-test-buffer + ";; This buffer is for notes, +;; and for Lisp evaluation[.]" + ("TT") + ";; T[h]is buffer is for notes, +;; and for Lisp evaluation.")))) + +(ert-deftest evil-test-jump-item () + "Test `evil-jump-item'" + :tags '(evil motion) + (ert-info ("Simple") + (evil-test-buffer + "int main[(]int argc, char** argv)" + ("%") + "int main(int argc, char** argv[)]" + ("%") + "int main[(]int argc, char** argv)")) + (ert-info ("Before parenthesis") + (evil-test-buffer + "[i]nt main(int argc, char** argv)" + ("%") + "int main(int argc, char** argv[)]" + ("5h") + "int main(int argc, char**[ ]argv)" + ("%") + "int main[(]int argc, char** argv)")) + (ert-info ("Over several lines") + (evil-test-buffer + "int main(int argc, char** argv) +\[{] + printf(\"Hello world\\n\"); + return EXIT_SUCCESS; +}" + ("%") + "int main(int argc, char** argv) +{ + printf(\"Hello world\\n\"); + return EXIT_SUCCESS; +\[}]")) + (ert-info ("On line without parenthesis") + (evil-test-buffer + "[#]include <stdio.h>" + (should-error (execute-kbd-macro "%"))))) + +;;; Text objects + +(ert-deftest evil-test-text-object () + "Test `evil-define-text-object'" + :tags '(evil text-object) + (let ((object (evil-define-text-object nil (count) + (if (< count 0) + (list (- (point) 3) (point)) + (list (point) (+ (point) 3)))))) + (ert-info ("Select three characters after point") + (evil-test-buffer + :state operator + ";; [T]his buffer is for notes." + (should (equal (funcall object 1) '(4 7 inclusive))))) + (ert-info ("Select three characters before point") + (evil-test-buffer + :state operator + ";; [T]his buffer is for notes." + (should (equal (funcall object -1) '(1 4 inclusive))))) + (ert-info ("Select three characters after selection") + (evil-test-buffer + ";; <Thi[s]> buffer is for notes." + (call-interactively object) + ";; <This b[u]>ffer is for notes.")) + (ert-info ("Select three characters before selection") + (evil-test-buffer + ";; <[T]his> buffer is for notes." + (call-interactively object) + "<[;]; This> buffer is for notes.")) + (ert-info ("Delete three characters after point") + (evil-test-buffer + "[;]; This buffer is for notes." + (define-key evil-operator-state-local-map "io" object) + ("dio") + "[T]his buffer is for notes.")))) + +(ert-deftest evil-test-word-objects () + "Test `evil-inner-word' and `evil-a-word'" + :tags '(evil text-object) + (ert-info ("Select a word") + (evil-test-buffer + ";; [T]his buffer is for notes." + ("viw") + ";; <Thi[s]> buffer is for notes.") + (evil-test-buffer + ";; [T]his buffer is for notes." + ("vaw") + ";; <This[ ]>buffer is for notes.")) + (ert-info ("Select two words") + (ert-info ("Include whitespace on this side") + (evil-test-buffer + ";;< Thi[s]> buffer is for notes." + ("aw") + ";;< This buffe[r]> is for notes.") + (evil-test-buffer + ";; This <[b]uffer >is for notes." + ("aw") + ";; <[T]his buffer >is for notes.")) + (ert-info ("Include whitespace on the other side") + (evil-test-buffer + ";; <This[ ]>buffer is for notes." + ("aw") + ";; <This buffer[ ]>is for notes.") + (evil-test-buffer + ";; This<[ ]buffer> is for notes." + ("aw") + ";;<[ ]This buffer> is for notes.")))) + +(ert-deftest evil-test-paren-range () + "Test `evil-paren-range'" + :tags '(evil text-object) + (ert-info ("Select a single block") + (ert-info ("Inside the parentheses") + (evil-test-buffer + "(2[3]4)" + (should (equal (evil-paren-range 1 ?\( ?\)) '(1 6))) + (should (equal (evil-paren-range 1 ?\( ?\) t) '(2 5))) + (should-not (evil-paren-range 0 ?\( ?\))) + (should-not (evil-paren-range 0 ?\( ?\) t)))) + (ert-info ("Before opening parenthesis") + (evil-test-buffer + "[(]234)" + (should (equal (evil-paren-range 1 ?\( ?\)) '(1 6))) + (should-not (evil-paren-range 1 ?\( ?\) t)) + (should-not (evil-paren-range -1 ?\( ?\))) + (should-not (evil-paren-range -1 ?\( ?\) t)) + (should-not (evil-paren-range 0 ?\( ?\))) + (should-not (evil-paren-range 0 ?\( ?\) t)))) + (ert-info ("After opening parenthesis") + (evil-test-buffer + "([2]34)" + (should (equal (evil-paren-range 1 ?\( ?\)) '(1 6))) + (should (equal (evil-paren-range 1 ?\( ?\) t) '(2 5))) + (should (equal (evil-paren-range -1 ?\( ?\)) '(1 6))) + (should-not (evil-paren-range -1 ?\( ?\) t)) + (should-not (evil-paren-range 0 ?\( ?\))) + (should-not (evil-paren-range 0 ?\( ?\) t)))) + (ert-info ("Before closing parenthesis") + (evil-test-buffer + "(234[)]" + (should (equal (evil-paren-range 1 ?\( ?\)) '(1 6))) + (should-not (evil-paren-range 1 ?\( ?\) t)) + (should (equal (evil-paren-range -1 ?\( ?\)) '(1 6))) + (should (equal (evil-paren-range -1 ?\( ?\) t) '(2 5))) + (should-not (evil-paren-range 0 ?\( ?\))) + (should-not (evil-paren-range 0 ?\( ?\) t)))) + (ert-info ("After closing parenthesis") + (evil-test-buffer + "(234)[]" + (should-not (evil-paren-range 1 ?\( ?\))) + (should-not (evil-paren-range 1 ?\( ?\) t)) + (should (equal (evil-paren-range -1 ?\( ?\)) '(1 6))) + (should-not (evil-paren-range -1 ?\( ?\) t)) + (should-not (evil-paren-range 0 ?\( ?\))) + (should-not (evil-paren-range 0 ?\( ?\) t))))) + (ert-info ("Select two blocks") + (evil-test-buffer + "((34567)([0]1234))" + (should (equal (evil-paren-range 1 ?\( ?\)) '(9 16))) + (should (equal (evil-paren-range 2 ?\( ?\)) '(1 17)))))) + +(ert-deftest evil-test-regexp-range () + "Test `evil-regexp-range'" + :tags '(evil text-object) + (ert-info ("Select a single block") + (ert-info ("Inside the parentheses") + (evil-test-buffer + "(2[3]4)" + (should (equal (evil-regexp-range 1 "(" ")") '(1 6))) + (should (equal (evil-regexp-range 1 "(" ")" t) '(2 5))) + (should-not (evil-regexp-range 0 "(" ")")) + (should-not (evil-regexp-range 0 "(" ")" t)))) + (ert-info ("Before opening parenthesis") + (evil-test-buffer + "[(]234)" + (should (equal (evil-regexp-range 1 "(" ")") '(1 6))) + (should-not (evil-regexp-range 1 "(" ")" t)) + (should-not (evil-regexp-range -1 "(" ")")) + (should-not (evil-regexp-range -1 "(" ")" t)) + (should-not (evil-regexp-range 0 "(" ")")) + (should-not (evil-regexp-range 0 "(" ")" t)))) + (ert-info ("After opening parenthesis") + (evil-test-buffer + "([2]34)" + (should (equal (evil-regexp-range 1 "(" ")") '(1 6))) + (should (equal (evil-regexp-range 1 "(" ")" t) '(2 5))) + (should (equal (evil-regexp-range -1 "(" ")") '(1 6))) + (should-not (evil-regexp-range -1 "(" ")" t)) + (should-not (evil-regexp-range 0 "(" ")")) + (should-not (evil-regexp-range 0 "(" ")" t)))) + (ert-info ("Before closing parenthesis") + (evil-test-buffer + "(234[)]" + (should (equal (evil-regexp-range 1 "(" ")") '(1 6))) + (should-not (evil-regexp-range 1 "(" ")" t)) + (should (equal (evil-regexp-range -1 "(" ")") '(1 6))) + (should (equal (evil-regexp-range -1 "(" ")" t) '(2 5))) + (should-not (evil-regexp-range 0 "(" ")")) + (should-not (evil-regexp-range 0 "(" ")" t)))) + (ert-info ("After closing parenthesis") + (evil-test-buffer + "(234)[]" + (should-not (evil-regexp-range 1 "(" ")")) + (should-not (evil-regexp-range 1 "(" ")" t)) + (should (equal (evil-regexp-range -1 "(" ")") '(1 6))) + (should-not (evil-regexp-range -1 "(" ")" t)) + (should-not (evil-regexp-range 0 "(" ")")) + (should-not (evil-regexp-range 0 "(" ")" t))))) + (ert-info ("Select two blocks") + (evil-test-buffer + "((34567)([0]1234))" + (should (equal (evil-regexp-range 1 "(" ")") '(9 16))) + (should (equal (evil-regexp-range 2 "(" ")") '(1 17))))) + (ert-info ("Select a quoted block") + (evil-test-buffer + "'q[u]ote'" + (should (equal (evil-regexp-range 1 "'" "'") '(1 8)))))) + +;;; Visual state + +(defun evil-test-visual-select (type &optional mark point) + "Verify that TYPE is selected correctly" + (evil-visual-make-selection mark point type) + (ert-info ("Activate region unless TYPE is `block'") + (cond + ((eq type 'block) + (should (mark t)) + (should-not (region-active-p)) + (should-not transient-mark-mode)) + (t + (should (mark)) + (should (region-active-p))))) + (ert-info ("Refresh `evil-visual-overlay'") + (should (overlayp evil-visual-overlay)) + (should (= (overlay-start evil-visual-overlay) + (car (evil-expand (point) (mark) type)))) + (should (= (overlay-end evil-visual-overlay) + (cadr (evil-expand (point) (mark) type)))) + (should (eq (evil-type evil-visual-overlay) type)) + (should (eq (overlay-get evil-visual-overlay :direction) + (if (< (point) (mark)) -1 1))) + (should (eq (overlay-get evil-visual-overlay :expanded) t)))) + +(ert-deftest evil-test-visual-char () + "Test Visual character selection" + :tags '(evil visual) + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation." + (evil-test-visual-select evil-visual-char) + ";; <[T]>his buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("e") + ";; <Thi[s]> buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("o") + ";; <[T]his> buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("d") + ";; [ ]buffer is for notes you don't want to save, +;; and for Lisp evaluation." + ("vV") + "<;; [ ]buffer is for notes you don't want to save,\n>\ +;; and for Lisp evaluation.")) + +(ert-deftest evil-test-visual-line () + "Test Visual line selection" + :tags '(evil visual) + (evil-test-buffer + ";; [T]his buffer is for notes you don't want to save, +;; and for Lisp evaluation." + (evil-test-visual-select evil-visual-line) + "<;; [T]his buffer is for notes you don't want to save,\n>\ +;; and for Lisp evaluation." + ("e") + "<;; Thi[s] buffer is for notes you don't want to save,\n>\ +;; and for Lisp evaluation." + ("o") + "<;; [T]his buffer is for notes you don't want to save,\n>\ +;; and for Lisp evaluation." + ("d") + "[;]; and for Lisp evaluation.")) + +(ert-deftest evil-test-visual-block () + "Test Visual block selection" + :tags '(evil visual) + (evil-test-buffer + "[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + (evil-test-visual-select evil-visual-block) + "<[;]>; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; then enter the text in that file's own buffer." + ("jjll") + "<;; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;;[ ]>then enter the text in that file's own buffer." + ("O") + ";; <This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +>[;]; then enter the text in that file's own buffer." + ("o") + ";;[ ]<This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +>;; then enter the text in that file's own buffer." + ("O") + "<[;]; This buffer is for notes you don't want to save. +;; If you want to create a file, visit that file with C-x C-f, +;; >then enter the text in that file's own buffer." + ("d") + "This buffer is for notes you don't want to save. +If you want to create a file, visit that file with C-x C-f, +then enter the text in that file's own buffer.")) + +(ert-deftest evil-test-visual-restore () + "Test restoring a previous selection" + :tags '(evil visual) + (ert-info ("Start a characterwise selection \ +if no previous selection") + (evil-test-buffer + ";; [T]his buffer is for notes." + ("gv") + ";; <[T]>his buffer is for notes.")) + (ert-info ("Restore characterwise selection") + (evil-test-buffer + ";; <[T]his> buffer is for notes." + ((kbd "ESC") "gv") + ";; <[T]his> buffer is for notes.")) + (ert-info ("Restore linewise selection") + (evil-test-buffer + :visual line + "<;; [T]his buffer is for notes.>" + ((kbd "ESC") "gv") + "<;; [T]his buffer is for notes.>")) + (ert-info ("Restore blockwise selection") + (evil-test-buffer + :visual block + "<;; This buffer is for notes, +;;[ ]>and for Lisp evaluation." + ((kbd "ESC") "gv") + "<;; This buffer is for notes, +;;[ ]>and for Lisp evaluation."))) + +;;; Utilities + +(ert-deftest evil-test-properties () + "Test `evil-get-property' and `evil-put-property'" + :tags '(evil util) + (let (alist) + (ert-info ("Set properties") + (evil-put-property 'alist 'wibble :foo t) + (should (equal alist '((wibble . (:foo t))))) + (evil-put-property 'alist 'wibble 'bar nil) + (should (equal alist '((wibble . (:foo t :bar nil))))) + (evil-put-property 'alist 'wobble :foo nil :bar nil :baz t) + (should (equal alist '((wibble . (:foo t :bar nil)) + (wobble . (:foo nil :bar nil :baz t)))))) + (ert-info ("Get properties") + (should (evil-get-property alist 'wibble 'foo)) + (should-not (evil-get-property alist 'wibble :bar)) + (should-not (evil-get-property alist 'wobble :foo)) + (should-not (evil-get-property alist 'wibble :baz)) + (should (equal (evil-get-property alist nil :foo) + '((wibble . t) (wobble . nil)))) + (should (equal (evil-get-property alist nil :bar) + '((wibble . nil) (wobble . nil)))) + (should (equal (evil-get-property alist nil :baz) + '((wobble . t))))))) + +(ert-deftest evil-test-filter-list () + "Test `evil-filter-list'" + :tags '(evil util) + (ert-info ("Return filtered list") + (should (equal (evil-filter-list 'null '(nil)) nil)) + (should (equal (evil-filter-list 'null '(nil 1)) '(1))) + (should (equal (evil-filter-list 'null '(nil 1 2 nil)) '(1 2))) + (should (equal (evil-filter-list 'null '(nil nil 1)) '(1))) + (should (equal (evil-filter-list 'null '(nil 1 nil 2 nil 3)) + '(1 2 3)))) + (ert-info ("Remove matches by side-effect when possible") + (let (list) + (setq list '(1 nil)) + (evil-filter-list 'null list) + (should (equal list '(1))) + + (setq list '(1 nil nil)) + (evil-filter-list 'null list) + (should (equal list '(1))) + + (setq list '(1 nil nil 2)) + (evil-filter-list 'null list) + (should (equal list '(1 2))) + + (setq list '(1 nil 2 nil 3)) + (evil-filter-list 'null list) + (should (equal list '(1 2 3)))))) + +(ert-deftest evil-test-concat-lists () + "Test `evil-concat-lists' and `evil-concat-alists'" + :tags '(evil util) + (ert-info ("Remove duplicates across lists") + (should (equal (evil-concat-lists + nil '(a b) '(b c)) + '(a b c)))) + (ert-info ("Remove duplicates inside lists") + (should (equal (evil-concat-lists + '(a a b) nil '(b c) nil) + '(a b c)))) + (ert-info ("Remove duplicate associations") + (should (equal (evil-concat-alists + '((a . b)) '((a . c))) + '((a . b)))) + (should-not (equal (evil-concat-lists + '((a . b)) '((a . c))) + '((a . b)))))) + +(ert-deftest evil-test-sort () + "Test `evil-sort' and `evil-swap'" + :tags '(evil util) + (let (a b c d) + (ert-info ("Two elements") + (setq a 2 b 1) + (evil-sort a b) + (should (= a 1)) + (should (= b 2)) + (evil-swap a b) + (should (= a 2)) + (should (= b 1))) + (ert-info ("Three elements") + (setq a 3 b 1 c 2) + (evil-sort a b c) + (should (= a 1)) + (should (= b 2)) + (should (= c 3))) + (ert-info ("Four elements") + (setq a 4 b 3 c 2 d 1) + (evil-sort a b c d) + (should (= a 1)) + (should (= b 2)) + (should (= c 3)) + (should (= d 4))))) + +(ert-deftest evil-test-read-key () + "Test `evil-read-key'" + :tags '(evil util) + (let ((unread-command-events '(?A))) + (ert-info ("Prevent downcasing in `this-command-keys'") + (should (eq (evil-read-key) ?A)) + (should (equal (this-command-keys) "A"))))) + +(ert-deftest evil-test-extract-count () + "Test `evil-extract-count'" + :tags '(evil util) + (evil-test-buffer + (ert-info ("Exact without count") + (should (equal (evil-extract-count "x") + (list nil 'evil-delete-char "x" nil))) + (should (equal (evil-extract-count "g0") + (list nil 'evil-beginning-of-visual-line "g0" nil)))) + + (ert-info ("Exact with count") + (should (equal (evil-extract-count "420x") + (list 420 'evil-delete-char "x" nil))) + (should (equal (evil-extract-count "420\M-f") + (list 420 'forward-word "\M-f" nil))) + (should (equal (evil-extract-count "2301g0") + (list 2301 'evil-beginning-of-visual-line "g0" nil)))) + + (ert-info ("Extra elements without count") + (should (equal (evil-extract-count "xAB") + (list nil 'evil-delete-char "x" "AB"))) + (should (equal (evil-extract-count "g0CD") + (list nil 'evil-beginning-of-visual-line "g0" "CD")))) + + (ert-info ("Extra elements with count") + (should (equal (evil-extract-count "420xAB") + (list 420 'evil-delete-char "x" "AB"))) + (should (equal (evil-extract-count "2301g0CD") + (list 2301 'evil-beginning-of-visual-line "g0" "CD")))) + + (ert-info ("Exact \"0\" count") + (should (equal (evil-extract-count "0") + (list nil 'evil-digit-argument-or-evil-beginning-of-line + "0" nil)))) + + (ert-info ("Extra elements and \"0\"") + (should (equal (evil-extract-count "0XY") + (list nil 'evil-digit-argument-or-evil-beginning-of-line + "0" "XY")))) + + (ert-info ("Count only") + (should-error (evil-extract-count "1230"))) + + (ert-info ("Unknown command") + (should-error (evil-extract-count "°")) + (should-error (evil-extract-count "12°"))))) + (when evil-tests-run - (ert-run-tests-batch '(tag evil))) + (evil-tests-run)) (provide 'evil-tests) diff --git a/evil-types.el b/evil-types.el new file mode 100644 index 0000000..bc169cd --- /dev/null +++ b/evil-types.el @@ -0,0 +1,696 @@ +;;;; Type system + +;; 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 its line and the last position +;; to the end of its 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 (assuming the expansion is one-to-one). The +;; `inclusive' type, which increases the last position by one, is +;; one-to-one and contractable. The `line' type is not one-to-one +;; as it may expand multiple positions to the same lines, so it +;; has no contraction procedure. +;; +;; 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) + +(defun evil-type (object &optional default) + "Return the type of OBJECT, or DEFAULT if none." + (let (type) + (cond + ((overlayp object) + (setq type (overlay-get object :type))) + ((evil-range-p object) + (setq type (nth 2 object))) + ((listp object) + (setq type (plist-get object :type))) + ;; command + ((commandp object) + (setq type (evil-get-command-property object :type))) + ((symbolp object) + (setq type (get object 'type)))) + (setq type (or type default)) + (and (evil-type-p type) type))) + +(defun evil-set-type (object type) + "Set the type of OBJECT to TYPE. +For example, (evil-set-type 'next-line 'line) +will make `line' the type of the `next-line' command." + (cond + ((overlayp object) + (overlay-put object :type type)) + ((evil-range-p object) + (evil-set-range-type object type)) + ((listp object) + (plist-put object :type type)) + ((commandp object) + (evil-add-command-properties object :type type)) + ((symbolp object) + (put object 'type type))) + object) + +(defun evil-type-property (type prop) + "Return property PROP for TYPE." + (evil-get-property evil-type-properties type prop)) + +(defun evil-type-p (sym) + "Whether SYM is the name of a type." + (assq sym evil-type-properties)) + +(defun evil-range (beg end &optional type &rest properties) + "Return a list (BEG END [TYPE] PROPERTIES...). +BEG and END are buffer positions (numbers or markers), +TYPE is a type as per `evil-type-p', and PROPERTIES is +a property list." + (let ((beg (if (markerp beg) (marker-position beg) beg)) + (end (if (markerp end) (marker-position end) end)) + (point-min (point-min)) + (point-max (point-max))) + ;; BEG and END may not exceed the buffer boundaries + (evil-sort point-min beg end point-max) + (append (list beg end) + (when (evil-type-p type) + (list type)) + properties))) + +(defun evil-range-p (object) + "Whether OBJECT is a range." + (and (listp object) + (>= (length object) 2) + (numberp (nth 0 object)) + (numberp (nth 1 object)))) + +(defun evil-range-beginning (range) + "Return beginning of RANGE." + (when (evil-range-p range) + (let ((beg (nth 0 range)) + (end (nth 1 range)) + (point-min (point-min)) + (point-max (point-max))) + ;; `beg' may not exceed the buffer boundaries + (evil-sort point-min beg end point-max) + beg))) + +(defun evil-range-end (range) + "Return end of RANGE." + (when (evil-range-p range) + (let ((beg (nth 0 range)) + (end (nth 1 range)) + (point-min (point-min)) + (point-max (point-max))) + ;; `end' may not exceed the buffer boundaries + (evil-sort point-min beg end point-max) + end))) + +(defun evil-range-properties (range) + "Return properties of RANGE." + (when (evil-range-p range) + (if (evil-type range) + (nthcdr 3 range) + (nthcdr 2 range)))) + +(defun evil-copy-range (range) + "Return a copy of RANGE." + (copy-sequence range)) + +(defun evil-set-range (range &optional beg end type &rest properties) + "Set RANGE to have beginning BEG and end END. +The TYPE and additional PROPERTIES may also be specified. +If an argument is nil, it's not used; the previous value is retained. +See also `evil-set-range-beginning', `evil-set-range-end', +`evil-set-range-type' and `evil-set-range-properties'." + (when (evil-range-p range) + (let ((beg (or beg (evil-range-beginning range))) + (end (or end (evil-range-end range))) + (type (or type (evil-type range))) + (plist (evil-range-properties range)) + (point-min (point-min)) + (point-max (point-max))) + (evil-sort point-min beg end point-max) + (while properties + (setq plist (plist-put plist (pop properties) (pop properties)))) + (evil-set-range-beginning range beg) + (evil-set-range-end range end) + (evil-set-range-type range type) + (evil-set-range-properties range plist) + range))) + +(defun evil-set-range-beginning (range beg &optional copy) + "Set RANGE's beginning to BEG. +If COPY is non-nil, return a copy of RANGE." + (when copy + (setq range (evil-copy-range range))) + (setcar range beg) + range) + +(defun evil-set-range-end (range end &optional copy) + "Set RANGE's end to END. +If COPY is non-nil, return a copy of RANGE." + (when copy + (setq range (evil-copy-range range))) + (setcar (cdr range) end) + range) + +(defun evil-set-range-type (range type &optional copy) + "Set RANGE's type to TYPE. +If COPY is non-nil, return a copy of RANGE." + (when copy + (setq range (evil-copy-range range))) + (if type + (setcdr (cdr range) + (append (list type) (evil-range-properties range))) + (setcdr (cdr range) (evil-range-properties range))) + range) + +(defun evil-set-range-properties (range properties &optional copy) + "Set RANGE's properties to PROPERTIES. +If COPY is non-nil, return a copy of RANGE." + (when copy + (setq range (evil-copy-range range))) + (if (evil-type range) + (setcdr (cdr (cdr range)) properties) + (setcdr (cdr range) properties)) + range) + +(defun evil-range-union (range1 range2 &optional type) + "Return the union of the ranges RANGE1 and RANGE2. +If the ranges have conflicting types, use RANGE1's type. +This can be overridden with TYPE." + (when (and (evil-range-p range1) + (evil-range-p range2)) + (evil-range (min (evil-range-beginning range1) + (evil-range-beginning range2)) + (max (evil-range-end range1) + (evil-range-end range2)) + (or type + (evil-type range1) + (evil-type range2))))) + +(defun evil-subrange-p (range1 range2) + "Whether RANGE1 is contained within RANGE2." + (and (evil-range-p range1) + (evil-range-p range2) + (<= (evil-range-beginning range2) + (evil-range-beginning range1)) + (>= (evil-range-end range2) + (evil-range-end range1)))) + +(defun evil-expand (beg end type &rest properties) + "Expand BEG and END as TYPE with PROPERTIES. +Returns a list (BEG END TYPE PROPERTIES ...), where the tail +may contain a property list. + +The overlay equivalent is `evil-expand-overlay'." + (apply 'evil-transform + ;; don't expand if already expanded + (unless (plist-get properties :expanded) :expand) + beg end type properties)) + +(defun evil-contract (beg end type &rest properties) + "Contract BEG and END as TYPE with PROPERTIES. +Returns a list (BEG END TYPE PROPERTIES ...), where the tail +may contain a property list. + +The overlay equivalent is `evil-contract-overlay'." + (apply 'evil-transform 'contract beg end type properties)) + +(defun evil-normalize (beg end type &rest properties) + "Normalize BEG and END as TYPE with PROPERTIES. +Returns a list (BEG END TYPE PROPERTIES ...), where the tail +may contain a property list. + +The overlay equivalent is `evil-normalize-overlay'." + (apply 'evil-transform 'normalize beg end type properties)) + +(defun evil-transform + (transform beg end type &rest properties) + "Apply TRANSFORM on BEG and END with PROPERTIES. +Returns a list (BEG END TYPE PROPERTIES ...), where the tail +may contain a property list. If TRANSFORM is undefined, +return positions unchanged. + +The overlay equivalent is `evil-transform-overlay'." + (let* ((type (or type (evil-type properties))) + (transform (when (and type transform) + (evil-type-property type transform)))) + (if transform + (apply transform beg end properties) + (apply 'evil-range beg end type properties)))) + +(defun evil-describe (beg end type &rest properties) + "Return description of BEG and END with PROPERTIES. +If no description is available, return the empty string. + +The overlay equivalent is `evil-describe-overlay'." + (let* ((type (or type (evil-type properties))) + (properties (plist-put properties :type type)) + (describe (evil-type-property type :string))) + (or (when describe + (apply describe beg end properties)) + ""))) + +(defun evil-expand-range (range &optional copy) + "Expand RANGE according to its type. +Return a new range if COPY is non-nil." + (evil-transform-range :expand range copy)) + +(defun evil-contract-range (range &optional copy) + "Contract RANGE according to its type. +Return a new range if COPY is non-nil." + (evil-transform-range 'contract range copy)) + +(defun evil-normalize-range (range &optional copy) + "Normalize RANGE according to its type. +Return a new range if COPY is non-nil." + (evil-transform-range 'normalize range copy)) + +(defun evil-transform-range (transform range &optional copy) + "Apply TRANSFORM to RANGE according to its type. +Return a new range if COPY is non-nil." + (when copy + (setq range (evil-copy-range range))) + (when (evil-type range) + (apply 'evil-set-range range + (apply 'evil-transform transform range))) + range) + +(defun evil-describe-range (range) + "Return description of RANGE. +If no description is available, return the empty string." + (apply 'evil-describe range)) + +(defun evil-expand-overlay (overlay &optional copy) + "Expand OVERLAY according to its `type' property. +Return a new overlay if COPY is non-nil." + (let ((type (evil-type overlay))) + (when copy + (setq overlay (copy-overlay overlay))) + (unless (overlay-get overlay :expanded) + (when (and type (evil-type-property type :expand)) + ;; explicitly set :expanded to nil before expanding, + ;; so that it is guaranteed to change back to nil + ;; if the overlay is restored + (overlay-put overlay :expanded nil) + (setq overlay (evil-backup-overlay overlay) + overlay (evil-transform-overlay :expand overlay)))) + overlay)) + +(defun evil-contract-overlay (overlay &optional copy) + "Contract OVERLAY according to its `type' property. +If the type isn't injective, restore original positions. +Return a new overlay if COPY is non-nil." + (let ((type (evil-type overlay))) + (if (and type (evil-type-property type :injective)) + (setq overlay (evil-reset-overlay overlay copy) + overlay (evil-transform-overlay 'contract overlay)) + (setq overlay (evil-restore-overlay overlay copy))) + overlay)) + +(defun evil-normalize-overlay (overlay &optional copy) + "Normalize OVERLAY according to its `type' property. +Return a new overlay if COPY is non-nil." + (evil-transform-overlay 'normalize overlay copy)) + +(defun evil-transform-overlay (transform overlay &optional copy) + "Apply TRANSFORM to OVERLAY according to its `type' property. +Return a new overlay if COPY is non-nil." + (let* ((beg (overlay-start overlay)) + (end (overlay-end overlay)) + (type (evil-type overlay)) + (buffer (overlay-buffer overlay)) + (properties (overlay-properties overlay)) + (range (save-excursion + (with-current-buffer (or buffer (current-buffer)) + (apply 'evil-transform + transform beg end type properties)))) + (beg (pop range)) + (end (pop range)) + (type (if (evil-type-p (car-safe range)) (pop range) type))) + (when copy + (setq overlay (copy-overlay overlay))) + (while range + (overlay-put overlay (pop range) (pop range))) + (evil-set-type overlay type) + (move-overlay overlay beg end buffer) + overlay)) + +(defun evil-backup-overlay (overlay &optional copy) + "Back up current OVERLAY positions and properties. +The information is stored in a :backup property. +Return a new overlay if COPY is non-nil." + (let* ((beg (overlay-start overlay)) + (end (overlay-end overlay)) + (buffer (overlay-buffer overlay)) + (beg-marker (move-marker (make-marker) beg buffer)) + (end-marker (move-marker (make-marker) end buffer)) + (properties (overlay-properties overlay))) + (setq overlay (evil-reset-overlay overlay copy)) + (set-marker-insertion-type beg-marker t) + (set-marker-insertion-type end-marker nil) + (overlay-put overlay :backup + (append (list beg-marker end-marker) properties)) + overlay)) + +(defun evil-restore-overlay (overlay &optional copy) + "Restore previous OVERLAY positions and properties. +The information is retrieved from the :backup property. +Return a new overlay if COPY is non-nil." + (let ((backup (overlay-get overlay :backup)) + beg end beg-marker end-marker properties buffer) + (when copy + (setq overlay (copy-overlay overlay))) + (when backup + (setq beg-marker (pop backup) + end-marker (pop backup) + properties backup + beg (or (marker-position beg-marker) + (overlay-start overlay)) + end (or (marker-position end-marker) + (overlay-end overlay)) + buffer (or (marker-buffer beg-marker) + (marker-buffer end-marker) + (overlay-buffer overlay)) + overlay (evil-reset-overlay overlay copy)) + (move-overlay overlay beg end buffer) + (while properties + (overlay-put overlay (pop properties) (pop properties)))) + overlay)) + +(defun evil-reset-overlay (overlay &optional copy) + "Reset back-up information for OVERLAY. +Return a new overlay if COPY is non-nil." + (let* ((backup (overlay-get overlay :backup)) + (beg (pop backup)) + (end (pop backup))) + (cond + (copy + (setq overlay (copy-overlay overlay))) + ;; unless we're making a copy, delete old markers + ;; so they don't slow down editing + (backup + (set-marker beg nil) + (set-marker end nil))) + (overlay-put overlay :backup nil) + overlay)) + +(defun evil-describe-overlay (overlay) + "Return description of OVERLAY. +If no description is available, return the empty string." + (let ((beg (overlay-start overlay)) + (end (overlay-end overlay)) + (type (evil-type overlay)) + (buffer (overlay-buffer overlay)) + (properties (overlay-properties overlay))) + (save-excursion + (with-current-buffer (or buffer (current-buffer)) + (apply 'evil-describe + beg end type properties))))) + +(defmacro evil-define-type (type doc &rest body) + "Define type TYPE. +DOC is a general description and shows up in all docstrings. +It is followed by a list of keywords and functions: + +:expand FUNC Expansion function. This function should accept + two positions in the current buffer, BEG and END, + and return a pair of expanded buffer positions. +:contract FUNC The opposite of :expand, optional. +:injective BOOL Whether expansion is one-to-one. This means that + :expand followed by :contract always returns the + original range. +:normalize FUNC Normalization function, optional. This function should + accept two unexpanded positions and adjust them before + expansion. May be used to deal with buffer boundaries. +:string FUNC Description function. This takes two buffer positions + and returns a human-readable string, for example, + \"2 lines\". + +Further keywords and functions may be specified. These are assumed to +be transformations on buffer positions, like :expand and :contract. + +\(fn TYPE DOC [[KEY FUNC]...])" + (declare (indent defun) + (debug (&define name + [&optional stringp] + [&rest [keywordp function-form]]))) + (let (args defun-forms func key name plist string sym val) + ;; standard values + (setq plist (plist-put plist :injective t)) + ;; keywords + (while (keywordp (car-safe body)) + (setq key (pop body) + val (pop body)) + (if (plist-member plist key) ; not a function + (setq plist (plist-put plist key val)) + (setq func val + sym (intern (replace-regexp-in-string + "^:" "" (symbol-name key))) + name (intern (format "evil-%s-%s" type sym)) + args (car (cdr-safe func)) + string (car (cdr (cdr-safe func))) + string (if (stringp string) + (format "%s\n\n" string) "") + plist (plist-put plist key `',name)) + (add-to-list + 'defun-forms + (cond + ((eq key :string) + `(defun ,name (beg end &rest properties) + ,(format "Return size of %s from BEG to END \ +with PROPERTIES.\n\n%s%s" type string doc) + (let (type range) + (when (and beg end) + (save-excursion + (evil-sort beg end) + (unless (plist-get properties :expanded) + (setq range (evil-expand + beg end ',type properties) + beg (or (pop range) beg) + end (or (pop range) end) + type (if (evil-type-p (car-safe range)) + (pop range) type)) + (while range + (setq properties + (plist-put properties + (pop range) (pop range))))) + (or (apply ',func beg end + (when ,(> (length args) 2) + properties)) + "")))))) + (t + `(defun ,name (beg end &rest properties) + ,(format "Perform %s transformation on %s from BEG to END \ +with PROPERTIES.\n\n%s%s" sym type string doc) + (let ((type ',type) range) + (when (and beg end) + (save-excursion + (when (memq ,key '(:expand :contract)) + (setq properties + (plist-put properties + :expanded + ,(eq key :expand)))) + (setq range (apply 'evil-range beg end type properties) + beg (car range) + end (cadr range)) + (setq range (or (apply ',func beg end + (when ,(> (length args) 2) + properties)) + range) + beg (or (pop range) beg) + end (or (pop range) end) + type (if (evil-type-p (car-safe range)) + (pop range) type)) + (while range + (setq properties + (plist-put properties + (pop range) (pop range)))) + (apply 'evil-range beg end type properties))))))) + t))) + ;; :injective presupposes both or neither of :expand and :contract + (when (plist-get plist :expand) + (setq plist (plist-put plist :injective + (and (plist-get plist :contract) + (plist-get plist :injective))))) + `(progn + (evil-put-property 'evil-type-properties ',type ,@plist) + ,@defun-forms + ',type))) + +;;; 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]*")) + (evil-expand beg end 'line)) + (t + (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." + :expand (lambda (beg end) + (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." + :injective nil + :expand (lambda (beg end) + (evil-range + (progn + (goto-char beg) + (line-beginning-position)) + (progn + (goto-char end) + (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 block + "Like `inclusive', but for rectangles: +the last column is included." + :expand (lambda (beg end &rest properties) + (let* ((beg-col (progn + (goto-char beg) + (current-column))) + (end-col (progn + (goto-char end) + (current-column))) + (corner (plist-get properties :corner))) + ;; Because 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 increase the upper + ;; corner beyond the lower corner, or increase the lower + ;; beyond the upper), so we try out both possibilities + ;; when we encounter 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 (progn + (goto-char beg) + (current-column))) + (end-col (progn + (goto-char end) + (current-column)))) + (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 (- (progn + (goto-char beg) + (current-column)) + (progn + (goto-char end) + (current-column)))))) + (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 (progn + (goto-char beg) + (current-column))) + (right (progn + (goto-char end) + (current-column))) + (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)))) + +(provide 'evil-types) + +;;; evil-types.el ends here diff --git a/evil-undo.el b/evil-undo.el new file mode 100644 index 0000000..2cacdc2 --- /dev/null +++ b/evil-undo.el @@ -0,0 +1,101 @@ +;;;; Undo + +(require 'evil-common) + +;; load undo-tree.el if available +(unless (featurep 'undo-tree) + (condition-case nil + (require 'undo-tree) + (error nil))) + +(when (fboundp 'global-undo-tree-mode) + (global-undo-tree-mode 1)) + +(defmacro evil-single-undo (&rest body) + "Execute BODY as a single undo step." + (declare (indent defun) + (debug t)) + `(unwind-protect + (progn + (evil-start-undo-step) + ,@body) + (evil-end-undo-step))) + +(defun evil-start-undo-step () + "Start a undo step. +All following buffer modifications are grouped together +as a single action. The step is terminated with `evil-end-undo-step' +or by exiting to Normal state." + (when (listp buffer-undo-list) + (unless (null (car-safe buffer-undo-list)) + (add-to-list 'buffer-undo-list nil)) + (setq evil-undo-list-pointer buffer-undo-list) + ;; continually refresh the undo entries for the step, + ;; ensuring proper synchronization between `buffer-undo-list' + ;; and undo-tree.el's `buffer-undo-tree' + (add-hook 'post-command-hook 'evil-refresh-undo-step nil t))) + +(defun evil-end-undo-step () + "End a undo step started with `evil-start-undo-step'." + (when (memq 'evil-refresh-undo-step post-command-hook) + (evil-refresh-undo-step) + (undo-boundary) + (remove-hook 'post-command-hook 'evil-refresh-undo-step t))) + +;; TODO: This destroys undo information during an undo step. +;; Ideally, we'd like to postpone it until the step is ended, +;; so that "C-_" works reliably in Insert state. +(defun evil-refresh-undo-step () + "Refresh `buffer-undo-list' entries for current undo step. +Undo boundaries until `evil-undo-list-pointer' are removed +to make the entries undoable as a single action. +See `evil-start-undo-step'." + (setq buffer-undo-list + (evil-filter-list 'null buffer-undo-list + evil-undo-list-pointer) + evil-undo-list-pointer buffer-undo-list)) + +;;; Undo ring + +(defmacro evil-with-undo (&rest body) + "Executes the body with enabled undo. If undo is disabled in +the current buffer, the undo information is stored in +`evil-temporary-undo' instead of `buffer-undo-list'." + (declare (indent defun) + (debug t)) + `(let ((orig-buffer-undo-list t)) + (let (buffer-undo-list) + ,@body + (setq evil-temporary-undo (cons nil buffer-undo-list))) + (unless (eq buffer-undo-list t) + ;; undo is enabled, so update the global buffer undo list + (setq buffer-undo-list (append evil-temporary-undo buffer-undo-list) + evil-temporary-undo nil)))) + +(defun evil-undo-pop () + "Undos the last buffer change and removes the last undo +information from `buffer-undo-list'. If undo is disabled in the +current buffer, use the information in `evil-temporary-undo' +instead." + (let ((paste-undo (list nil))) + (let ((undo-list (if (eq buffer-undo-list t) + evil-temporary-undo + buffer-undo-list))) + (when (or (not undo-list) (car undo-list)) + (error "Can't undo previous paste")) + (pop undo-list) ; remove nil + (while (and undo-list + (car undo-list)) + (push (pop undo-list) paste-undo)) + (let ((buffer-undo-list (nreverse paste-undo)) + (orig-message (symbol-function 'message))) + (fset 'message #'(lambda (&rest rest))) + (undo) + (fset 'message orig-message)) + (if (eq buffer-undo-list t) + (setq evil-temporary-undo nil) + (setq buffer-undo-list undo-list))))) + +(provide 'evil-undo) + +;;; evil-undo.el ends here diff --git a/evil-vars.el b/evil-vars.el index ee69e90..0428a31 100644 --- a/evil-vars.el +++ b/evil-vars.el @@ -1,16 +1,184 @@ ;;;; Settings and variables +(defgroup evil nil + "Extensible vi layer." + :group 'emulations + :prefix 'evil-) + +(defcustom evil-auto-indent t + "Whether to auto-indent when entering Insert state." + :type 'boolean + :group 'evil) +(make-variable-buffer-local 'evil-auto-indent) + +(defcustom evil-shift-width 4 + "The offset used by \\<evil-normal-state-map>\\[evil-shift-right] \ +and \\[evil-shift-left]." + :type 'integer + :group 'evil) + +(defcustom evil-repeat-move-cursor t + "Whether \"\\<evil-normal-state-map>\\[evil-repeat]\" \ +moves the cursor." + :type 'boolean + :group 'evil) + +(defcustom evil-find-skip-newlines nil + "Whether \"f\", \"F\", \"t\" and \"T\" skip over newlines." + :type 'boolean + :group 'evil) + +(defcustom evil-move-cursor-back t + "Whether the cursor is moved backwards when exiting Insert state." + :type 'boolean + :group 'evil) + +(defcustom evil-want-fine-undo nil + "Whether actions like \"cw\" are undone in several steps." + :type 'boolean + :group 'evil) + +(defcustom evil-regexp-search t + "Whether to use regular expressions for searching." + :type 'boolean + :group 'evil) + +(defcustom evil-search-wrap t + "Whether search wraps around." + :type 'boolean + :group 'evil) + +(defcustom evil-flash-delay 2 + "Number of seconds to flash search matches." + :type 'integer + :group 'evil) + +(defcustom evil-show-paren-range 0 + "The minimal distance between point and a parenthesis +which causes the parenthesis to be highlighted." + :type 'integer + :group 'evil) + +(defcustom evil-want-C-i-jump t + "Whether \"C-i\" jumps forward like in Vim." + :type 'boolean + :group 'evil) + +(defcustom evil-want-C-u-scroll nil + "Whether \"C-u\" scrolls like in Vim." + :type 'boolean + :group 'evil) + +(defcustom evil-motions + '(backward-char + backward-list + backward-paragraph + backward-sentence + backward-sexp + backward-up-list + backward-word + beginning-of-buffer + beginning-of-defun + beginning-of-line + beginning-of-visual-line + digit-argument + down-list + end-of-buffer + end-of-defun + end-of-line + end-of-visual-line + exchange-point-and-mark + forward-char + forward-list + forward-paragraph + forward-sentence + forward-sexp + forward-word + isearch-abort + isearch-cancel + isearch-complete + isearch-del-char + isearch-delete-char + isearch-edit-string + isearch-exit + isearch-highlight-regexp + isearch-occur + isearch-other-control-char + isearch-other-meta-char + isearch-printing-char + isearch-query-replace + isearch-query-replace-regexp + isearch-quote-char + isearch-repeat-backward + isearch-repeat-forward + isearch-ring-advance + isearch-ring-retreat + isearch-toggle-case-fold + isearch-toggle-input-method + isearch-toggle-regexp + isearch-toggle-specified-input-method + isearch-toggle-word + isearch-yank-char + isearch-yank-kill + isearch-yank-line + isearch-yank-word-or-char + keyboard-quit + mouse-drag-region + mouse-save-then-kill + mouse-set-point + mouse-set-region + move-beginning-of-line + move-end-of-line + next-line + previous-line + redo + scroll-down + scroll-up + undo + undo-tree-redo + undo-tree-undo + universal-argument + universal-argument-minus + universal-argument-more + universal-argument-other-key + up-list) + "Non-Evil commands to initialize to motions." + :type '(repeat symbol) + :group 'evil) + +;;; Variables + (defvar evil-state nil "The current Evil state. To change the state, use `evil-change-state' or call the state function (e.g., `evil-normal-state').") (make-variable-buffer-local 'evil-state) +;; these may be used inside `evil-define-state' +(defvar evil-next-state nil + "The Evil state being switched to.") +(make-variable-buffer-local 'evil-next-state) + +(defvar evil-previous-state nil + "The Evil state being switched from.") +(make-variable-buffer-local 'evil-previous-state) + (defvar evil-modeline-tag nil "Modeline indicator for the current state.") (make-variable-buffer-local 'evil-modeline-tag) -(defvar evil-states-alist nil +(defvar evil-global-keymaps-alist nil + "Association list of keymap variables. +Entries have the form (MODE . KEYMAP), where KEYMAP +is the variable containing the keymap for MODE.") + +(defvar evil-local-keymaps-alist nil + "Association list of keymap variables that must be +reinitialized in each buffer. Entries have the form +\(MODE . KEYMAP), where KEYMAP is the variable containing +the keymap for MODE.") + +(defvar evil-state-properties nil "Specifications made by `evil-define-state'. Entries have the form (STATE . PLIST), where PLIST is a property list specifying various aspects of the state. To access a property, @@ -22,9 +190,212 @@ Elements have the form (MODE . KEYMAP), with the first keymaps having higher priority.") (make-variable-buffer-local 'evil-mode-map-alist) +(defvar evil-command-properties nil + "Specifications made by `evil-define-command'.") + +(defvar evil-transient-vars '(cua-mode transient-mark-mode) + "List of variables pertaining to Transient Mark mode.") + +(defvar evil-transient-vals nil + "Association list of old values for Transient Mark mode variables. +Entries have the form (VARIABLE VALUE LOCAL), where LOCAL is +whether the variable was previously buffer-local.") + +(defvar evil-locked-display nil + "If non-nil, state changes are invisible. +Don't set this directly; use the macro +`evil-with-locked-display' instead.") +(make-variable-buffer-local 'evil-locked-display) + +(defvar evil-type-properties nil + "Specifications made by `evil-define-type'. +Entries have the form (TYPE . PLIST), where PLIST is a property +list specifying functions for handling the type: expanding it, +describing it, etc.") + +(defvar evil-motion-marker nil + "Marker for storing the starting position of a motion.") +(make-variable-buffer-local 'evil-motion-marker) + +(defvar evil-this-type nil + "Current motion type.") +(make-variable-buffer-local 'evil-this-type) + +(defvar evil-this-register nil + "Current register.") +(make-variable-buffer-local 'evil-this-register) + +(defvar evil-this-macro nil + "Current macro register.") +(make-variable-buffer-local 'evil-this-macro) + +(defvar evil-this-operator nil + "Current operator.") +(make-variable-buffer-local 'evil-this-operator) + +(defvar evil-this-motion nil + "Current motion.") +(make-variable-buffer-local 'evil-this-motion) + +(defvar evil-this-motion-count nil + "Current motion count.") +(make-variable-buffer-local 'evil-this-motion-count) + +(defvar evil-inhibit-operator nil + "Inhibit current operator. +If an operator calls a motion and the motion sets this variable +to t, the operator code is not executed.") + +(defvar evil-markers-alist + '((?\( . evil-backward-sentence) + (?\) . evil-forward-sentence) + (?{ . evil-backward-paragraph) + (?} . evil-forward-paragraph) + (?' . evil-jump-backward) + (?` . evil-jump-backward)) + "Association list for markers. +Entries have the form (CHAR . DATA), where CHAR is the marker's +name and DATA is either a marker object as returned by +`make-marker', a movement function, or a cons cell (STRING NUMBER), +where STRING is a file path and NUMBER is a buffer position. +The global value of this variable holds markers available from every +buffer, while the buffer-local value holds markers available only +in the current buffer.") +(make-variable-buffer-local 'evil-markers-alist) + +(defvar evil-jump-list nil + "Jump list.") +(make-variable-buffer-local 'evil-jump-list) + (defconst evil-suppress-map (make-keymap) - "Full keymap disabling default bindings to self-insert-command.") -(suppress-keymap evil-suppress-map) + "Full keymap disabling default bindings to `self-insert-command'.") +(suppress-keymap evil-suppress-map t) + +;; TODO: customize size of ring +(defvar evil-repeat-ring (make-ring 10) + "A ring of repeat-informations to repeat the last command.") + +(defvar evil-recording-repeat nil + "Whether we are recording a repeat.") + +(defvar evil-repeating-command nil + "Whether a command is currently being repeated.") + +(defvar evil-repeat-changes nil + "Accumulated buffer changes for changed-based commands.") + +(defvar evil-repeat-info nil + "Information accumulated during current repeat.") + +(defvar evil-repeat-buffer nil + "The buffer in which the repeat started. +If the buffer is changed, the repeat is cancelled.") + +(defvar evil-repeat-marker nil + "The position of point at the beginning of an change-tracking + editing command.") + +(defvar evil-repeat-keys nil + "The keys that invoked the current command.") + +(defvar evil-last-repeat nil + "Information about the latest repeat command. +This is a list of two elements (POINT COUNT), where POINT is +the position of point before the latest repeat, and COUNT +the count-argument of the latest repeat command.") + +(defvar evil-repeat-count nil + "The explicit count when repeating a command.") + +(defvar evil-insert-count nil + "The explicit count passed to an command starting Insert state.") +(make-variable-buffer-local 'evil-insert-count) + +(defvar evil-insert-vcount nil + "The information about the number of following lines the +insertion should be repeated. This is list (LINE COLUMN COUNT) +where LINE is the line-number where the original insertion +started and COLUMN is either a number of function determining the +column where the repeated insertions should take place. COUNT is +number of repeats (including the original insertion).") +(make-variable-buffer-local 'evil-insert-vcount) + +(defvar evil-insert-lines nil + "Non-nil if the current insertion command is a line-insertion +command o or O.") +(make-variable-buffer-local 'evil-insert-lines) + +(defvar evil-insert-repeat-info nil + "Repeat information accumulated during an insertion.") +(make-variable-buffer-local 'evil-insert-repeat-info) + +(defvar evil-replace-alist nil + "Association list of characters overwritten in Replace state. +The format is (POS . CHAR).") +(make-variable-buffer-local 'evil-replace-alist) + +(defvar evil-echo-area-message nil + "Previous value of `current-message'.") +(make-variable-buffer-local 'evil-echo-area-message) + +(defvar evil-write-echo-area nil + "If set to t inside `evil-save-echo-area', then the echo area +is not restored.") + +(defvar evil-word "a-zA-Z0-9_" + "The characters to be considered as a word.") + +(defvar evil-last-find nil + "A pair (FUNCTION . CHAR) describing the lastest character + search command.") + +(defvar evil-last-paste nil + "Information about the latest paste. +This should be a list (CMD POINT BEG END) where CMD is the last +paste-command (either `evil-paste-before' or `evil-paste-after'), +POINT is the position of point before the paste, +BEG end END are the region of the inserted text.") + +(defvar evil-paste-count nil + "The count argument of the current paste command.") + +(defvar evil-temporary-undo nil + "When undo is disabled in current buffer, certain commands +depending on undo use the variable instead of +`buffer-undo-list'.") + +(defvar evil-visual-alist nil + "Association list of Visual selections. +Elements have the form (NAME . FUNCTION).") + +(defvar evil-visual-overlay nil + "Overlay for Visual selection. +This stores the boundaries of the selection and its type. +It is also used for highlighting, unless the type is `block', +in which case see `evil-visual-block-overlays'.") +(make-variable-buffer-local 'evil-visual-overlay) + +(defvar evil-visual-block-overlays nil + "Overlays for Visual Block selection, one for each line. +They are reused to prevent flicker.") +(make-variable-buffer-local 'evil-visual-block-overlays) + +(defvar evil-visual-region-expanded nil + "Whether the region matches the Visual selection.") +(make-variable-buffer-local 'evil-visual-region-expanded) + +(defvar evil-undo-list-pointer nil + "Everything up to this mark is united in the undo-list.") +(make-variable-buffer-local 'evil-undo-list-pointer) + +(defvar evil-flash-timer nil + "Timer for flashing search results.") + +(defvar evil-search-prompt nil + "String to use for search prompt.") + +(defvar evil-window-map (make-sparse-keymap) + "Keymap for window-related commands.") (defconst evil-version "0.1" "The current version of Evil") diff --git a/evil-visual.el b/evil-visual.el new file mode 100644 index 0000000..c2417db --- /dev/null +++ b/evil-visual.el @@ -0,0 +1,572 @@ +;;;; 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. +;; +;; 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. + +(require 'evil-types) +(require 'evil-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 ,doc) + (defvar ,message ,string ,doc) + (evil-define-command ,name (&optional mark point type message) + ,@(when doc `(,doc)) + :keep-visual t + (interactive (list nil nil nil t)) + (let ((type (or type ,name))) + (if (and (evil-called-interactively-p) + (eq (evil-visual-type) type)) + (evil-normal-state) + (unless (stringp message) + (setq message (and message ,message))) + (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) + (overlay-put evil-visual-overlay :corner + (evil-visual-block-corner 'upper-left))) + +(evil-define-state visual + "Visual state." + :tag " <V> " + :enable (motion normal) + (cond + ((evil-visual-state-p) + (evil-transient-save) + (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-region (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)) + (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-type t) evil-visual-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) + (evil-visual-highlight -1)))) + +(defun evil-visual-pre-command () + "Run before each command in Visual state. +Unless `this-command' is a motion, expand the region +to the selection." + (when (evil-visual-state-p) + (unless (evil-get-command-property + this-command :keep-visual) + (evil-visual-expand-region + ;; exclude final newline from linewise selection + ;; unless the command has real need of it + (and (eq (evil-visual-type) 'line) + (not (evil-get-command-property + this-command :include-newline))))))) + +(defun evil-visual-post-command () + "Run after each command in Visual state. +If `this-command' was a motion, refresh the selection; +otherwise exit Visual state." + (when (evil-visual-state-p) + (cond + ((or quit-flag + (eq this-command 'keyboard-quit) + evil-visual-region-expanded) + (evil-visual-contract-region) + (evil-normal-state)) + (t + (evil-visual-refresh) + (evil-visual-highlight))))) + +(defun evil-visual-deactivate-hook () + "Deactivate the region and restore Transient Mark mode." + (evil-active-region -1) + (evil-transient-restore) + (remove-hook 'evil-normal-state-entry-hook + 'evil-visual-deactivate-hook t)) + +(defun evil-visual-select (beg end &optional type dir) + "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* ((type (or (evil-visual-selection-type type) + evil-visual-char)) + (dir (or dir 1)) + (range (evil-contract beg end type)) + (beg (evil-range-beginning range)) + (end (evil-range-end range)) + (type (evil-type range type))) + (when (< dir 0) + (evil-swap beg end)) + (evil-visual-make-selection beg end type))) + +(defun evil-visual-make-selection (mark point &optional type) + "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* ((visual-type (prog1 (evil-visual-type) + (unless (evil-visual-state-p) + (evil-visual-state)))) + (type (or type (evil-visual-type) evil-visual-char))) + ;; if there exists a specific selection function for TYPE, + ;; use that, otherwise use `evil-visual-make-region' + (funcall (evil-visual-selection-function type) + mark point type + (or (evil-normal-state-p) + (not (eq type visual-type)))))) + +;; the generic selection function, on which all other +;; selections are based +(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 type mark point) + (when (stringp message) + (evil-echo message)))) + +(defun evil-visual-expand-region (&optional no-trailing-newline) + "Expand the region to the Visual selection. +If NO-TRAILING-NEWLINE is t 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 no-trailing-newline + (save-excursion + (goto-char point) + (when (and (bolp) (not (bobp))) + (setq point (max mark (1- (point))))))) + (when (< (evil-visual-direction) 0) + (evil-swap mark point)) + (setq evil-visual-region-expanded t) + (evil-visual-refresh nil mark point)))) + +(defun evil-visual-contract-region () + "The inverse of `evil-visual-expand-region'." + (let ((overlay (copy-overlay evil-visual-overlay)) + mark point dir) + (unwind-protect + (progn + (when (overlay-get overlay :expanded) + (evil-contract-overlay overlay)) + (setq mark (overlay-start overlay) + point (overlay-end overlay) + dir (overlay-get overlay :direction)) + (when (< dir 0) + (evil-swap mark point)) + (setq evil-visual-region-expanded nil) + (evil-visual-refresh nil mark point)) + (delete-overlay overlay)))) + +(defun evil-visual-refresh (&optional type mark point &rest properties) + "Refresh mark, point and `evil-visual-overlay'." + (let* ((point (or point (point))) + (mark (or mark (mark t) point)) + (dir (evil-visual-direction)) + (type (or type (evil-visual-type) evil-visual-char)) + (properties (plist-put properties :direction dir))) + (evil-move-mark mark) + (goto-char point) + (unless evil-visual-overlay + (setq evil-visual-overlay (make-overlay mark point nil nil t))) + (unless evil-visual-region-expanded + (evil-contract-overlay evil-visual-overlay) + (move-overlay evil-visual-overlay mark point)) + (while properties + (overlay-put evil-visual-overlay + (pop properties) (pop properties))) + (evil-set-type evil-visual-overlay type) + (setq evil-this-type (evil-visual-type)) + (if evil-visual-region-expanded + (move-overlay evil-visual-overlay mark point) + (evil-expand-overlay evil-visual-overlay)) + (evil-set-marker ?< (evil-visual-beginning)) + (evil-set-marker ?> (evil-visual-end) t))) + +(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)) + (overlay-put evil-visual-overlay 'face nil) + (mapc 'delete-overlay evil-visual-block-overlays) + (setq evil-visual-block-overlays nil)) + ((eq (evil-visual-type) 'block) + (overlay-put evil-visual-overlay 'face nil) + (evil-visual-highlight-block + (evil-visual-beginning) + (evil-visual-end))) + (t + (evil-visual-highlight -1) + (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)) + beg-col end-col new nlines overlay window-beg window-end) + ;; 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 + (save-excursion + (setq beg-col (save-excursion (goto-char beg) + (current-column)) + end-col (save-excursion (goto-char end) + (current-column))) + (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) + (point)) + end (save-excursion (goto-char end) + (evil-move-to-column end-col 1) + (point)))) + ;; 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)) ?\ ) + 'face + (or (get-text-property (1- (point)) 'face) + 'default)))) + (setq row-beg (point)) + ;; end of row + (evil-move-to-column end-col) + (when (< (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))) + ?\ ) '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-beginning (&optional force) + "Return beginning of Visual selection. +FORCE returns the previous beginning if not in Visual state." + (when (or force (evil-visual-state-p)) + (and (overlayp evil-visual-overlay) + (overlay-start evil-visual-overlay)))) + +(defun evil-visual-end (&optional force) + "Return end of Visual selection. +FORCE returns the previous end if not in Visual state." + (when (or force (evil-visual-state-p)) + (and (overlayp evil-visual-overlay) + (overlay-end evil-visual-overlay)))) + +(defun evil-visual-type (&optional force) + "Return current Visual type, nil if not in Visual state. +FORCE returns the previous Visual type if not in Visual state." + (when (or force (evil-visual-state-p)) + (evil-type evil-visual-overlay))) + +(defun evil-visual-direction () + "Return direction of Visual selection. +The direction is -1 if point precedes mark and 1 otherwise." + (let* ((point (point)) + (mark (or (mark t) point))) + (if (< point mark) -1 1))) + +;; recognizes user changes, e.g., customizing +;; `evil-visual-char' to `exclusive' +(defun evil-visual-alist () + "Return an association list from types to selection functions." + (mapcar (lambda (e) + (cons (symbol-value (cdr-safe e)) (cdr-safe e))) + evil-visual-alist)) + +(defun evil-visual-selection-type (selection) + "Return the type of SELECTION." + (or (symbol-value (cdr-safe (assq selection evil-visual-alist))) + selection)) + +(defun evil-visual-selection-function (type) + "Return a selection function for TYPE. +For example, `evil-visual-make-region'." + (or (cdr (assq type evil-visual-alist)) + (cdr (assq type (evil-visual-alist))) + ;; generic selection function + 'evil-visual-make-region)) + +(evil-define-command evil-visual-restore () + "Restore previous selection." + :keep-visual t + (interactive) + (let* ((point (point)) + (mark (or (mark t) point)) + (type (evil-visual-type t)) + dir) + (unless (evil-visual-state-p) + (when evil-visual-overlay + (evil-contract-overlay evil-visual-overlay) + (setq mark (evil-visual-beginning t) + point (evil-visual-end t) + dir (overlay-get evil-visual-overlay :direction)) + (when (< dir 0) + (evil-swap mark point))) + (evil-visual-make-selection mark point type)))) + +(evil-define-command evil-visual-exchange-corners () + "Rearrange corners in Visual Block mode. + + M---+ +---M + | | <=> | | + +---P P---+ + +For example, if mark is in the upper left corner and point +in the lower right, this function puts mark in the upper right +corner and point in the lower left." + :keep-visual t + (interactive) + (cond + ((eq (evil-visual-type) evil-visual-block) + (let* ((point (point)) + (mark (or (mark t) point)) + (point-col (current-column)) + (mark-col (save-excursion + (goto-char mark) + (current-column))) + (mark (save-excursion + (goto-char mark) + (evil-move-to-column point-col) + (point))) + (point (save-excursion + (goto-char point) + (evil-move-to-column mark-col) + (point)))) + (evil-visual-refresh evil-visual-block mark point))) + (t + (evil-exchange-point-and-mark) + (evil-visual-refresh)))) + +(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 (save-excursion + (goto-char point) + (current-column))) + (mark-col (save-excursion + (goto-char mark) + (current-column))) + 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)))) + +(evil-define-command evil-visual-block-rotate (corner &optional beg end) + "In Visual Block selection, put point in CORNER. +Corner may be one of `upper-left', `upper-right', `lower-left' +and `lower-right': + + upper-left +---+ upper-right + | | + lower-left +---+ lower-right + +When called interactively, the selection is rotated blockwise." + :keep-visual t + (interactive + (let ((corners '(upper-left upper-right lower-right lower-left))) + (list (or (cadr (memq (evil-visual-block-corner) corners)) + 'upper-left)))) + (let* ((beg (or beg (point))) + (end (or end (mark t) beg)) + (range (evil-block-rotate beg end :corner corner))) + (setq beg (pop range) + end (pop range)) + (unless (eq corner (evil-visual-block-corner corner beg end)) + (evil-swap beg end)) + (goto-char beg) + (evil-move-mark end) + (when (evil-visual-state-p) + (evil-visual-refresh evil-visual-block nil nil :corner corner)))) + +(provide 'evil-visual) + +;;; evil-visual.el ends here diff --git a/evil-window.el b/evil-window.el new file mode 100644 index 0000000..9516a0f --- /dev/null +++ b/evil-window.el @@ -0,0 +1,473 @@ +;;;; Window and scrolling commands + +(require 'evil-common) +(require 'evil-states) +(require 'evil-motions) + +(condition-case nil + (require 'windmove) + (error + (message "evil: Could not load 'windmove', window-commands not available.") + nil)) + +;;; Utility function +(defun evil-num-visible-lines () + "Returns the number of currently visible lines." + (- (window-height) 1)) + +(defun evil-max-scroll-up () + "Returns the maximal number of lines that can be scrolled up." + (1- (line-number-at-pos (window-start)))) + +(defun evil-max-scroll-down () + "Returns the maximal number of lines that can be scrolled down." + (if (pos-visible-in-window-p (window-end)) + 0 + (1+ (- (line-number-at-pos (point-max)) + (line-number-at-pos (window-end)))))) + +(defmacro evil-save-column (&rest body) + "Restores the column after execution of BODY." + (declare (indent defun) + (debug t)) + `(let ((ocolumn (current-column))) + ,@body + (move-to-column ocolumn))) + +;;; Scrolling + +(evil-define-command evil-scroll-line-up (count) + "Scrolls the window COUNT lines upwards." + :repeat nil + :keep-visual t + (interactive "p") + (scroll-down count)) + +(evil-define-command evil-scroll-line-down (count) + "Scrolls the window COUNT lines downwards." + :repeat nil + :keep-visual t + (interactive "p") + (scroll-up count)) + +(evil-define-command evil-scroll-up (count) + "Scrolls the window and the cursor COUNT lines upwards, default half of the screen." + :repeat nil + :keep-visual t + (interactive "P") + (evil-save-column + (let ((p (point)) + (c (or count (/ (evil-num-visible-lines) 2)))) + (save-excursion + (scroll-down (min (evil-max-scroll-up) c))) + (forward-line (- c)) + (when (= (line-number-at-pos p) + (line-number-at-pos (point))) + (signal 'beginning-of-buffer nil))))) + +(evil-define-command evil-scroll-down (count) + "Scrolls the window and the cursor COUNT lines downwards, default half of the screen." + :repeat nil + :keep-visual t + (interactive "P") + (evil-save-column + (let ((p (point)) + (c (or count (/ (evil-num-visible-lines) 2)))) + (save-excursion + (scroll-up (min (evil-max-scroll-down) c))) + (forward-line c) + (when (= (line-number-at-pos p) + (line-number-at-pos (point))) + (signal 'end-of-buffer nil))))) + +(evil-define-command evil-scroll-page-up (count) + "Scrolls the window COUNT pages upwards." + :repeat nil + :keep-visual t + (interactive "p") + (evil-save-column + (dotimes (i count) + (scroll-down nil)))) + +(evil-define-command evil-scroll-page-down (count) + "Scrolls the window COUNT pages upwards." + :repeat nil + :keep-visual t + (interactive "p") + (evil-save-column + (dotimes (i count) + (scroll-up nil)))) + +(evil-define-command evil-scroll-line-to-top (count) + "Scrolls line number COUNT (or the cursor line) to the top of the window." + :repeat nil + :keep-visual t + (interactive "P") + (evil-save-column + (let ((line (or count (line-number-at-pos (point))))) + (goto-char (point-min)) + (forward-line (1- line))) + (recenter 0))) + +(evil-define-command evil-scroll-line-to-center (count) + "Scrolls line number COUNT (or the cursor line) to the center of the window." + :repeat nil + :keep-visual t + (interactive "P") + (evil-save-column + (let ((line (or count (line-number-at-pos (point))))) + (goto-char (point-min)) + (forward-line (1- line))) + (recenter nil))) + +(evil-define-command evil-scroll-line-to-bottom (count) + "Scrolls line number COUNT (or the cursor line) to the bottom of the window." + :repeat nil + :keep-visual t + (interactive "P") + (evil-save-column + (let ((line (or count (line-number-at-pos (point))))) + (goto-char (point-min)) + (forward-line (1- line))) + (recenter -1))) + +(evil-define-command evil-scroll-bottom-line-to-top (count) + "Scrolls the line right below the window or line COUNT to the top of the window." + :repeat nil + :keep-visual t + (interactive "P") + (if count + (progn + (goto-char (point-min)) + (forward-line (1- count))) + (goto-char (window-end)) + (evil-adjust)) + (recenter 0) + (evil-first-non-blank)) + +(evil-define-command evil-scroll-top-line-to-bottom (count) + "Scrolls the line right below the window or line COUNT to the top of the window." + :repeat nil + :keep-visual t + (interactive "P") + (if count + (progn + (goto-char (point-min)) + (forward-line (1- count))) + (goto-char (window-start))) + (recenter -1) + (evil-first-non-blank)) + +;;; Window + +(defun evil-resize-window (new-size &optional horizontal) + "Sets the current window's with or height to `new-size'." + (let ((wincfg (current-window-configuration)) + (nwins (length (window-list))) + (count (if horizontal + (- new-size (window-width)) + (- new-size (window-height))))) + (catch 'done + (save-window-excursion + (while (not (zerop count)) + (if (> count 0) + (progn + (enlarge-window 1 horizontal) + (setq count (1- count))) + (progn + (shrink-window 1 horizontal) + (setq count (1+ count)))) + (if (= nwins (length (window-list))) + (setq wincfg (current-window-configuration)) + (throw 'done t))))) + (set-window-configuration wincfg))) + +(defun evil-get-buffer-tree (wintree) + "Extracts the buffer tree from a given window-tree." + (if (consp wintree) + (cons (car wintree) (mapcar #'evil-get-buffer-tree (cddr wintree))) + (window-buffer wintree))) + +(defun evil-restore-window-tree (win tree) + "Restores the given buffer-tree layout as subwindows of win." + (cond + ((and (consp tree) (cddr tree)) + (let ((newwin (split-window win nil (not (car tree))))) + (evil-restore-window-tree win (cadr tree)) + (evil-restore-window-tree newwin (cons (car tree) (cddr tree))))) + ((consp tree) + (set-window-buffer win (cadr tree))) + (t + (set-window-buffer win tree)))) + +;; TODO: window-split, window-new functions may take an file-argument +;; when called from ex-mode + +;; (defun evil-window-split (count (argument:file file) nonrepeatable) +;; "Splits the current window horizontally, COUNT lines height, editing a certain `file'." +;; (let ((new-win (split-window (selected-window) count))) +;; (when file +;; (evil-cmd-edit :argument file)))) + +;; (defun evil-window-vsplit (count (argument:file file) nonrepeatable) +;; "Splits the current window vertically, COUNT columns width, editing a certain `file'." +;; (let ((new-win (split-window (selected-window) count t))) +;; (when file +;; (evil-cmd-edit :argument file)))) + +;; TODO: the following commands should be unrepeatable: +;; * split-window-vertically +;; * split-window-horizontally +;; * delete-window +;; * delete-other-windows + +(evil-define-command evil-window-left (count) + "Move the cursor to new COUNT-th window left of the current one." + :repeat nil + (interactive "p") + (dotimes (i count) + (windmove-left))) + +(evil-define-command evil-window-right (count) + "Move the cursor to new COUNT-th window right of the current one." + :repeat nil + (interactive "p") + (dotimes (i count) + (windmove-right))) + +(evil-define-command evil-window-up (count) + "Move the cursor to new COUNT-th window above the current one." + :repeat nil + (interactive "p") + (dotimes (i (or count 1)) + (windmove-up))) + +(evil-define-command evil-window-down (count) + "Move the cursor to new COUNT-th window below the current one." + :repeat nil + (interactive "p") + (dotimes (i (or count 1)) + (windmove-down))) + +(evil-define-command evil-window-bottom-right () + "Move the cursor to bottom-right window." + :repeat nil + (interactive) + (while (let (success) + (condition-case nil + (progn + (windmove-right) + (setq success t)) + (error nil)) + (condition-case nil + (progn + (windmove-down) + (setq success t)) + (error nil)) + success))) + +(evil-define-command evil-window-top-left () + "Move the cursor to top-left window." + :repeat nil + (interactive) + (while (let (success) + (condition-case nil + (progn + (windmove-left) + (setq success t)) + (error nil)) + (condition-case nil + (progn + (windmove-up) + (setq success t)) + (error nil)) + success))) + +(evil-define-command evil-window-lru () + "Move the cursor to the previous (last accessed) window." + :repeat nil + (interactive) + (select-window (get-lru-window))) + +(evil-define-command evil-window-next (count) + "Move the cursor to the next window in the cyclic order. +With COUNT go to the count-th window in the order starting from +top-left." + :repeat nil + (interactive "P") + (if (not count) + (select-window (next-window)) + (evil-window-top-left) + (other-window (1- count)))) + +(evil-define-command evil-window-prev (count) + "Move the cursor to the previous window in the cyclic order. +With COUNT go to the count-th window in the order starting from +top-left." + :repeat nil + (interactive "P") + (if (not count) + (select-window (previous-window)) + (evil-window-top-left) + (other-window (1- count)))) + +;; (defun evil-window-new (count (argument:file file) nonrepeatable) +;; "Splits the current window horizontally and opens a new buffer or edits a certain `file'." +;; (split-window (selected-window) count) +;; (if file +;; (evil-cmd-edit :argument file) +;; (let ((buffer (generate-new-buffer "*new*"))) +;; (set-window-buffer (selected-window) buffer) +;; (with-current-buffer buffer (normal-mode))))) +(evil-define-command evil-window-new (count) + "Splits the current window horizontally and opens a new buffer or edits a certain `file'." + (interactive "P") + :repeat nil + (split-window (selected-window) count) + (let ((buffer (generate-new-buffer "*new*"))) + (set-window-buffer (selected-window) buffer) + (with-current-buffer buffer + (evil-normal-state)))) + +;; (defun evil-window-vnew (count (argument:file file) nonrepeatable) +;; "Splits the current window vertically and opens a new buffer name or edits a certain `file'." +;; (split-window (selected-window) count t) +;; (if file +;; (evil-cmd-edit :argument file) +;; (let ((buffer (generate-new-buffer "*new*"))) +;; (set-window-buffer (selected-window) buffer) +;; (with-current-buffer buffer (normal-mode))))) + +(evil-define-command evil-window-increase-height (count) + "Increase current window height by COUNT." + :repeat nil + (interactive "p") + (evil-resize-window (+ (window-height) count))) + +(evil-define-command evil-window-decrease-height (count) + "Decrease current window height by COUNT." + :repeat nil + (interactive "p") + (evil-resize-window (- (window-height) count))) + +(evil-define-command evil-window-increase-width (count) + "Increase current window width by COUNT." + :repeat nil + (interactive "p") + (evil-resize-window (+ (window-width) count) t)) + +(evil-define-command evil-window-decrease-width (count) + "Decrease current window width by COUNT." + :repeat nil + (interactive "p") + (evil-resize-window (- (window-width) count) t)) + +(evil-define-command evil-window-set-height (count) + "Sets the height of the current window to COUNT." + :repeat nil + (interactive "P") + (evil-resize-window (or count (frame-height)) nil)) + +(evil-define-command evil-window-set-width (count) + "Sets the width of the current window to COUNT." + :repeat nil + (interactive "P") + (evil-resize-window (or count (frame-width)) t)) + +(evil-define-command evil-window-rotate-upwards () + "Rotates the windows according to the currenty cyclic ordering." + :repeat nil + (interactive) + (let ((wlist (window-list)) + (blist (mapcar #'(lambda (w) (window-buffer w)) + (window-list)))) + (setq blist (append (cdr blist) (list (car blist)))) + (while (and wlist blist) + (set-window-buffer (car wlist) (car blist)) + (setq wlist (cdr wlist) + blist (cdr blist))) + (select-window (car (last (window-list)))))) + +(evil-define-command evil-window-rotate-downwards () + "Rotates the windows according to the currenty cyclic ordering." + :repeat nil + (interactive) + (let ((wlist (window-list)) + (blist (mapcar #'(lambda (w) (window-buffer w)) + (window-list)))) + (setq blist (append (last blist) blist)) + (while (and wlist blist) + (set-window-buffer (car wlist) (car blist)) + (setq wlist (cdr wlist) + blist (cdr blist))) + (select-window (cadr (window-list))))) + +(evil-define-command evil-window-move-very-top () + "Closes the current window, splits the upper-left one horizontally +and redisplays the current buffer there." + :repeat nil + (interactive) + (unless (one-window-p) + (let ((b (current-buffer))) + (delete-window) + (let ((btree (evil-get-buffer-tree (car (window-tree))))) + (delete-other-windows) + (let ((newwin (selected-window)) + (subwin (split-window))) + (evil-restore-window-tree subwin btree) + (set-window-buffer newwin b) + (select-window newwin)))) + (balance-windows))) + +(evil-define-command evil-window-move-far-left () + "Closes the current window, splits the upper-left one vertically +and redisplays the current buffer there." + :repeat nil + (interactive) + (unless (one-window-p) + (let ((b (current-buffer))) + (delete-window) + (let ((btree (evil-get-buffer-tree (car (window-tree))))) + (delete-other-windows) + (let ((newwin (selected-window)) + (subwin (split-window-horizontally))) + (evil-restore-window-tree subwin btree) + (set-window-buffer newwin b) + (select-window newwin)))) + (balance-windows))) + +(evil-define-command evil-window-move-far-right () + "Closes the current window, splits the lower-right one vertically +and redisplays the current buffer there." + :repeat nil + (interactive) + (unless (one-window-p) + (let ((b (current-buffer))) + (delete-window) + (let ((btree (evil-get-buffer-tree (car (window-tree))))) + (delete-other-windows) + (let ((subwin (selected-window)) + (newwin (split-window-horizontally))) + (evil-restore-window-tree subwin btree) + (set-window-buffer newwin b) + (select-window newwin)))) + (balance-windows))) + +(evil-define-command evil-window-move-very-bottom () + "Closes the current window, splits the lower-right one horizontally +and redisplays the current buffer there." + :repeat nil + (interactive) + (unless (one-window-p) + (let ((b (current-buffer))) + (delete-window) + (let ((btree (evil-get-buffer-tree (car (window-tree))))) + (delete-other-windows) + (let ((subwin (selected-window)) + (newwin (split-window))) + (evil-restore-window-tree subwin btree) + (set-window-buffer newwin b) + (select-window newwin)))) + (balance-windows))) + +(provide 'evil-window) @@ -1,7 +1,70 @@ +;;; evil.el --- extensible vi layer + +;; Author: Frank Fischer <frank.fischer at mathematik.tu-chemnitz.de> +;; Vegard Øye <vegard_oye at hotmail.com> +;; Nikolai Weibull <now at bitwi.se> +;; Maintainer: <implementations-list at lists.ourproject.org> +;; Created: 2011-03-01 +;; Version: 0.1 +;; Keywords: emulation, vim +;; URL: http://gitorious.org/evil +;; +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Evil is an extensible vi layer for Emacs. It emulates the main +;; features of Vim, and provides facilities for writing custom +;; extensions. +;; +;; Evil lives in a Git repository. To obtain Evil, do +;; +;; git clone git://gitorious.org/evil/evil.git +;; +;; Evil is discussed at <implementations-list at lists.ourproject.org>, +;; a mailing list to which you can subscribe at: +;; +;; http://lists.ourproject.org/cgi-bin/mailman/listinfo/implementations-list +;; +;; Subscription is not required; we usually reply within a few days +;; and CC our replies back to you. + +;;; License: + +;; This program 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 2 of the +;; License, or any later version. +;; +;; This program 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 this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Code: + (require 'evil-vars) +(require 'evil-compatibility) (require 'evil-common) +(require 'evil-types) +(require 'evil-undo) (require 'evil-states) +(require 'evil-repeat) +(require 'evil-visual) +(require 'evil-search) +(require 'evil-window) +(require 'evil-digraphs) +(require 'evil-insert) (require 'evil-operators) +(require 'evil-motions) +(require 'evil-replace) +(require 'evil-integration) +(require 'evil-maps) (provide 'evil) diff --git a/undo-tree.el b/undo-tree.el new file mode 100644 index 0000000..4edfa9d --- /dev/null +++ b/undo-tree.el @@ -0,0 +1,3075 @@ + +;;; undo-tree.el --- Treat undo history as a tree + + +;; Copyright (C) 2009-2011 Toby Cubitt + +;; Author: Toby Cubitt <toby-undo-tree@dr-qubit.org> +;; Version: 0.3 +;; Keywords: undo, redo, history, tree +;; URL: http://www.dr-qubit.org/emacs.php +;; Git Repository: http://www.dr-qubit.org/git/undo-tree.git + +;; This file is NOT part of Emacs. +;; +;; This file 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. +;; +;; This program 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + + +;;; Commentary: +;; +;; Emacs has a powerful undo system. Unlike the standard undo/redo system in +;; most software, it allows you to recover *any* past state of a buffer +;; (whereas the standard undo/redo system can lose past states as soon as you +;; redo). However, this power comes at a price: many people find Emacs' undo +;; system confusing and difficult to use, spawning a number of packages that +;; replace it with the less powerful but more intuitive undo/redo system. +;; +;; Both the loss of data with standard undo/redo, and the confusion of Emacs' +;; undo, stem from trying to treat undo history as a linear sequence of +;; changes. It's not. The `undo-tree-mode' provided by this package replaces +;; Emacs' undo system with a system that treats undo history as what it is: a +;; branching tree of changes. This simple idea allows the more intuitive +;; behaviour of the standard undo/redo system to be combined with the power of +;; never losing any history. An added side bonus is that undo history can in +;; some cases be stored more efficiently, allowing more changes to accumulate +;; before Emacs starts discarding history. +;; +;; The only downside to this more advanced yet simpler undo system is that it +;; was inspired by Vim. But, after all, most successful religions steal the +;; best ideas from their competitors! +;; +;; +;; Installation +;; ============ +;; +;; This package has only been tested with Emacs versions 22, 23 and CVS. It +;; will not work without modifications in earlier versions of Emacs. +;; +;; To install `undo-tree-mode', make sure this file is saved in a directory in +;; your `load-path', and add the line: +;; +;; (require 'undo-tree) +;; +;; to your .emacs file. Byte-compiling undo-tree.el is recommended (e.g. using +;; "M-x byte-compile-file" from within emacs). +;; +;; If you want to replace the standard Emacs' undo system with the +;; `undo-tree-mode' system in all buffers, you can enable it globally by +;; adding: +;; +;; (global-undo-tree-mode) +;; +;; to your .emacs file. +;; +;; +;; Quick-Start +;; =========== +;; +;; If you're the kind of person who likes jump in the car and drive, without +;; bothering to first figure out whether the button on the left dips the +;; headlights or operates the ejector seat (after all, you'll soon figure it +;; out when you push it), then here's the minimum you need to know: +;; +;; `undo-tree-mode' and `global-undo-tree-mode' +;; Enable undo-tree mode (either in the current buffer or globally). +;; +;; C-_ C-/ (`undo-tree-undo') +;; Undo changes. +;; +;; M-_ C-? (`undo-tree-redo') +;; Redo changes. +;; +;; `undo-tree-switch-branch' +;; Switch undo-tree branch. +;; (What does this mean? Better press the button and see!) +;; +;; C-x u (`undo-tree-visualize') +;; Visualize the undo tree. +;; (Better try pressing this button too!) +;; +;; C-x r u (`undo-tree-save-state-to-register') +;; Save current buffer state to register. +;; +;; C-x r U (`undo-tree-restore-state-from-register') +;; Restore buffer state from register. +;; +;; +;; In the undo-tree visualizer: +;; +;; <up> p C-p (`undo-tree-visualize-undo') +;; Undo changes. +;; +;; <down> n C-n (`undo-tree-visualize-redo') +;; Redo changes. +;; +;; <left> b C-b (`undo-tree-visualize-switch-branch-left') +;; Switch to previous undo-tree branch. +;; +;; <right> f C-f (`undo-tree-visualize-switch-branch-right') +;; Switch to next undo-tree branch. +;; +;; t (`undo-tree-visualizer-toggle-timestamps') +;; Toggle display of time-stamps. +;; +;; q C-q (`undo-tree-visualizer-quit') +;; Quit undo-tree-visualizer. +;; +;; , < +;; Scroll left. +;; +;; . > +;; Scroll right. +;; +;; <pgup> +;; Scroll up. +;; +;; <pgdown> +;; Scroll down. +;; +;; +;; +;; Undo Systems +;; ============ +;; +;; To understand the different undo systems, it's easiest to consider an +;; example. Imagine you make a few edits in a buffer. As you edit, you +;; accumulate a history of changes, which we might visualize as a string of +;; past buffer states, growing downwards: +;; +;; o (initial buffer state) +;; | +;; | +;; o (first edit) +;; | +;; | +;; o (second edit) +;; | +;; | +;; x (current buffer state) +;; +;; +;; Now imagine that you undo the last two changes. We can visualize this as +;; rewinding the current state back two steps: +;; +;; o (initial buffer state) +;; | +;; | +;; x (current buffer state) +;; | +;; | +;; o +;; | +;; | +;; o +;; +;; +;; However, this isn't a good representation of what Emacs' undo system +;; does. Instead, it treats the undos as *new* changes to the buffer, and adds +;; them to the history: +;; +;; o (initial buffer state) +;; | +;; | +;; o (first edit) +;; | +;; | +;; o (second edit) +;; | +;; | +;; x (buffer state before undo) +;; | +;; | +;; o (first undo) +;; | +;; | +;; x (second undo) +;; +;; +;; Actually, since the buffer returns to a previous state after an undo, +;; perhaps a better way to visualize it is to imagine the string of changes +;; turning back on itself: +;; +;; (initial buffer state) o +;; | +;; | +;; (first edit) o x (second undo) +;; | | +;; | | +;; (second edit) o o (first undo) +;; | / +;; |/ +;; o (buffer state before undo) +;; +;; Treating undos as new changes might seem a strange thing to do. But the +;; advantage becomes clear as soon as we imagine what happens when you edit +;; the buffer again. Since you've undone a couple of changes, new edits will +;; branch off from the buffer state that you've rewound to. Conceptually, it +;; looks like this: +;; +;; o (initial buffer state) +;; | +;; | +;; o +;; |\ +;; | \ +;; o x (new edit) +;; | +;; | +;; o +;; +;; The standard undo/redo system only lets you go backwards and forwards +;; linearly. So as soon as you make that new edit, it discards the old +;; branch. Emacs' undo just keeps adding changes to the end of the string. So +;; the undo history in the two systems now looks like this: +;; +;; Undo/Redo: Emacs' undo +;; +;; o o +;; | | +;; | | +;; o o o +;; .\ | |\ +;; . \ | | \ +;; . x (new edit) o o | +;; (discarded . | / | +;; branch) . |/ | +;; . o | +;; | +;; | +;; x (new edit) +;; +;; Now, what if you change your mind about those undos, and decide you did +;; like those other changes you'd made after all? With the standard undo/redo +;; system, you're lost. There's no way to recover them, because that branch +;; was discarded when you made the new edit. +;; +;; However, in Emacs' undo system, those old buffer states are still there in +;; the undo history. You just have to rewind back through the new edit, and +;; back through the changes made by the undos, until you reach them. Of +;; course, since Emacs treats undos (even undos of undos!) as new changes, +;; you're really weaving backwards and forwards through the history, all the +;; time adding new changes to the end of the string as you go: +;; +;; o +;; | +;; | +;; o o o (undo new edit) +;; | |\ |\ +;; | | \ | \ +;; o o | | o (undo the undo) +;; | / | | | +;; |/ | | | +;; (trying to get o | | x (undo the undo) +;; to this state) | / +;; |/ +;; o +;; +;; So far, this is still reasonably intuitive to use. It doesn't behave so +;; differently to standard undo/redo, except that by going back far enough you +;; can access changes that would be lost in standard undo/redo. +;; +;; However, imagine that after undoing as just described, you decide you +;; actually want to rewind right back to the initial state. If you're lucky, +;; and haven't invoked any command since the last undo, you can just keep on +;; undoing until you get back to the start: +;; +;; (trying to get o x (got there!) +;; to this state) | | +;; | | +;; o o o o (keep undoing) +;; | |\ |\ | +;; | | \ | \ | +;; o o | | o o (keep undoing) +;; | / | | | / +;; |/ | | |/ +;; (already undid o | | o (got this far) +;; to this state) | / +;; |/ +;; o +;; +;; But if you're unlucky, and you happen to have moved the point (say) after +;; getting to the state labelled "got this far", then you've "broken the undo +;; chain". Hold on to something solid, because things are about to get +;; hairy. If you try to undo now, Emacs thinks you're trying to undo the +;; undos! So to get back to the initial state you now have to rewind through +;; *all* the changes, including the undos you just did: +;; +;; (trying to get o x (finally got there!) +;; to this state) | | +;; | | +;; o o o o o o +;; | |\ |\ |\ |\ | +;; | | \ | \ | \ | \ | +;; o o | | o o o | o o +;; | / | | | / | | | / +;; |/ | | |/ | | |/ +;; (already undid o | | o<. | | o +;; to this state) | / : | / +;; |/ : |/ +;; o : o +;; : +;; (got this far, but +;; broke the undo chain) +;; +;; Confused? +;; +;; In practice you can just hold down the undo key until you reach the buffer +;; state that you want. But whatever you do, don't move around in the buffer +;; to *check* that you've got back to where you want! Because you'll break the +;; undo chain, and then you'll have to traverse the entire string of undos +;; again, just to get back to the point at which you broke the +;; chain. Undo-in-region and commands such as `undo-only' help to make using +;; Emacs' undo a little easier, but nonetheless it remains confusing for many +;; people. +;; +;; +;; So what does `undo-tree-mode' do? Remember the diagram we drew to represent +;; the history we've been discussing (make a few edits, undo a couple of them, +;; and edit again)? The diagram that conceptually represented our undo +;; history, before we started discussing specific undo systems? It looked like +;; this: +;; +;; o (initial buffer state) +;; | +;; | +;; o +;; |\ +;; | \ +;; o x (current state) +;; | +;; | +;; o +;; +;; Well, that's *exactly* what the undo history looks like to +;; `undo-tree-mode'. It doesn't discard the old branch (as standard undo/redo +;; does), nor does it treat undos as new changes to be added to the end of a +;; linear string of buffer states (as Emacs' undo does). It just keeps track +;; of the tree of branching changes that make up the entire undo history. +;; +;; If you undo from this point, you'll rewind back up the tree to the previous +;; state: +;; +;; o +;; | +;; | +;; x (undo) +;; |\ +;; | \ +;; o o +;; | +;; | +;; o +;; +;; If you were to undo again, you'd rewind back to the initial state. If on +;; the other hand you redo the change, you'll end up back at the bottom of the +;; most recent branch: +;; +;; o (undo takes you here) +;; | +;; | +;; o (start here) +;; |\ +;; | \ +;; o x (redo takes you here) +;; | +;; | +;; o +;; +;; So far, this is just like the standard undo/redo system. But what if you +;; want to return to a buffer state located on a previous branch of the +;; history? Since `undo-tree-mode' keeps the entire history, you simply need +;; to tell it to switch to a different branch, and then redo the changes you +;; want: +;; +;; o +;; | +;; | +;; o (start here, but switch +;; |\ to the other branch) +;; | \ +;; (redo) o o +;; | +;; | +;; (redo) x +;; +;; Now you're on the other branch, if you undo and redo changes you'll stay on +;; that branch, moving up and down through the buffer states located on that +;; branch. Until you decide to switch branches again, of course. +;; +;; Real undo trees might have multiple branches and sub-branches: +;; +;; o +;; ____|______ +;; / \ +;; o o +;; ____|__ __| +;; / | \ / \ +;; o o o o x +;; | | +;; / \ / \ +;; o o o o +;; +;; Trying to imagine what Emacs' undo would do as you move about such a tree +;; will likely frazzle your brain circuits! But in `undo-tree-mode', you're +;; just moving around this undo history tree. Most of the time, you'll +;; probably only need to stay on the most recent branch, in which case it +;; behaves like standard undo/redo, and is just as simple to understand. But +;; if you ever need to recover a buffer state on a different branch, the +;; possibility of switching between branches and accessing the full undo +;; history is still there. +;; +;; +;; +;; The Undo-Tree Visualizer +;; ======================== +;; +;; Actually, it gets better. You don't have to imagine all these tree +;; diagrams, because `undo-tree-mode' includes an undo-tree visualizer which +;; draws them for you! In fact, it draws even better diagrams: it highlights +;; the node representing the current buffer state, it highlights the current +;; branch, and (by hitting "t") you can toggle the display of +;; time-stamps. (There's one other tiny difference: the visualizer puts the +;; most recent branch on the left rather than the right.) +;; +;; In the visualizer, the usual keys for moving up and down a buffer instead +;; move up and down the undo history tree (e.g. the up and down arrow keys, or +;; "C-n" and "C-p"). The state of the "parent" buffer (the buffer whose undo +;; history you are visualizing) is updated as you move around the undo tree in +;; the visualizer. If you reach a branch point in the visualizer, the usual +;; keys for moving forward and backward in a buffer instead switch branch +;; (e.g. the left and right arrow keys, or "C-f" and "C-b"). And clicking with +;; the mouse on any node in the visualizer will take you directly to that +;; node, resetting the state of the parent buffer to the state represented by +;; that node. +;; +;; It can be useful to see how long ago the parent buffer was in the state +;; represented by a particular node in the visualizer. Hitting "t" in the +;; visualizer toggles the display of time-stamps for all the nodes. (Note +;; that, because of the way `undo-tree-mode' works, these time-stamps may be +;; somewhat later than the true times, especially if it's been a long time +;; since you last undid any changes.) +;; +;; Finally, hitting "q" will quit the visualizer, leaving the parent buffer in +;; whatever state you ended at. +;; +;; +;; +;; Undo-in-Region +;; ============== +;; +;; Emacs allows a very useful and powerful method of undoing only selected +;; changes: when a region is active, only changes that affect the text within +;; that region will are undone. With the standard Emacs undo system, changes +;; produced by undoing-in-region naturally get added onto the end of the +;; linear undo history: +;; +;; o +;; | +;; | x (second undo-in-region) +;; o | +;; | | +;; | o (first undo-in-region) +;; o | +;; | / +;; |/ +;; o +;; +;; You can of course redo these undos-in-region as usual, by undoing the +;; undos: +;; +;; o +;; | +;; | o_ +;; o | \ +;; | | | +;; | o o (undo the undo-in-region) +;; o | | +;; | / | +;; |/ | +;; o x (undo the undo-in-region) +;; +;; +;; In `undo-tree-mode', undo-in-region works similarly: when there's an active +;; region, undoing only undoes changes that affect that region. However, the +;; way these undos-in-region are recorded in the undo history is quite +;; different. In `undo-tree-mode', undo-in-region creates a new branch in the +;; undo history. The new branch consists of an undo step that undoes some of +;; the changes that affect the current region, and another step that undoes +;; the remaining changes needed to rejoin the previous undo history. +;; +;; Previous undo history Undo-in-region +;; +;; o o +;; | | +;; | | +;; o o +;; | |\ +;; | | \ +;; o o x (undo-in-region) +;; | | | +;; | | | +;; x o o +;; +;; As long as you don't change the active region after undoing-in-region, +;; continuing to undo-in-region extends the new branch, pulling more changes +;; that affect the current region into an undo step immediately above your +;; current location in the undo tree, and pushing the point at which the new +;; branch is attached further up the tree: +;; +;; First undo-in-region Second undo-in-region +;; +;; o o +;; | |\ +;; | | \ +;; o o x (undo-in-region) +;; |\ | | +;; | \ | | +;; o x o o +;; | | | | +;; | | | | +;; o o o o +;; +;; Redoing takes you back down the undo tree, as usual (as long as you haven't +;; changed the active region after undoing-in-region, it doesn't matter if it +;; is still active): +;; +;; o +;; |\ +;; | \ +;; o o +;; | | +;; | | +;; o o (redo) +;; | | +;; | | +;; o x (redo) +;; +;; +;; What about redo-in-region? Obviously, this only makes sense if you have +;; already undone some changes, so that there are some changes to redo! +;; Redoing-in-region splits off a new branch of the undo history below your +;; current location in the undo tree. This time, the new branch consists of a +;; redo step that redoes some of the redo changes that affect the current +;; region, followed by all the remaining redo changes. +;; +;; Previous undo history Redo-in-region +;; +;; o o +;; | | +;; | | +;; x o +;; | |\ +;; | | \ +;; o o x (redo-in-region) +;; | | | +;; | | | +;; o o o +;; +;; As long as you don't change the active region after redoing-in-region, +;; continuing to redo-in-region extends the new branch, pulling more redo +;; changes into a redo step immediately below your current location in the +;; undo tree. +;; +;; First redo-in-region Second redo-in-region +;; +;; o o +;; | | +;; | | +;; o o +;; |\ |\ +;; | \ | \ +;; o x (redo-in-region) o o +;; | | | | +;; | | | | +;; o o o x (redo-in-region) +;; | +;; | +;; o +;; +;; Note that undo-in-region and redo-in-region only ever add new changes to +;; the undo tree, they *never* modify existing undo history. So you can always +;; return to previous buffer states by switching to a previous branch of the +;; tree. + + + +;;; Change Log: +;; +;; Version 0.3 +;; * implemented undo-in-region +;; * fixed bugs in `undo-list-transfer-to-tree' and +;; `undo-list-rebuild-from-tree' which caused errors when undo history was +;; empty or disabled +;; * defun `region-active-p' if not already defined, for compatibility with +;; older Emacsen +;; +;; Version 0.2.1 +;; * modified `undo-tree-node' defstruct and macros to allow arbitrary +;; meta-data to be stored in a plist associated with a node, and +;; reimplemented storage of visualizer data on top of this +;; * display registers storing undo-tree state in visualizer +;; * implemented keyboard selection in visualizer +;; * rebuild `buffer-undo-list' from tree when disabling `undo-tree-mode' +;; +;; Version 0.2 +;; * added support for marker undo entries +;; +;; Version 0.1.7 +;; * pass null argument to `kill-buffer' call in `undo-tree-visualizer-quit', +;; since the argument's not optional in earlier Emacs versions +;; * added match for "No further redo information" to +;; `debug-ignored-errors' to prevent debugger being called on this error +;; * made `undo-tree-visualizer-quit' select the window displaying the +;; visualizer's parent buffer, or switch to the parent buffer if no window +;; is displaying it +;; * fixed bug in `undo-tree-switch-branch' +;; * general code tidying and reorganisation +;; * fixed bugs in history-discarding logic +;; * fixed bug in `undo-tree-insert' triggered by `undo-tree-visualizer-set' +;; by ensuring mark is deactivated +;; +;; Version 0.1.6 +;; * added `undo-tree-mode-lighter' customization option to allow the +;; mode-line lighter to be changed +;; * bug-fix in `undo-tree-discard-node' +;; * added `undo-tree-save-state-to-register' and +;; `undo-tree-restore-state-from-register' commands and keybindings for +;; saving/restoring undo-tree states using registers +;; +;; Version 0.1.5 +;; * modified `undo-tree-visualize' to mark the visualizer window as +;; soft-dedicated, and changed `undo-tree-visualizer-quit' to use +;; `kill-buffer', so that the visualizer window is deleted along with its +;; buffer if the visualizer buffer was displayed in a new window, but not if +;; it was displayed in an existing window. +;; +;; Version 0.1.4 +;; * modified `undo-tree-undo' and `undo-tree-redo' to always replace +;; redo/undo entries with new ones generated by `primitive-undo', as the new +;; changesets will restore the point more reliably +;; +;; Version 0.1.3 +;; * fixed `undo-tree-visualizer-quit' to remove `after-change-functions' +;; hook there, rather than in `undo-tree-kill-visualizer' +;; +;; Version 0.1.2 +;; * fixed keybindings +;; * renamed `undo-tree-visualizer-switch-previous-branch' and +;; `undo-tree-visualizer-switch-next-branch' to +;; `undo-tree-visualizer-switch-branch-left' and +;; `undo-tree-visualizer-switch-branch-right' +;; +;; Version 0.1.1 +;; * prevented `undo-tree-kill-visualizer' from killing visualizer when +;; undoing/redoing from the visualizer, which completely broke the +;; visualizer! +;; * changed one redo binding, so that at least one set of undo/redo bindings +;; works in a terminal +;; * bound vertical scrolling commands in `undo-tree-visualizer-map', in case +;; they aren't bound globally +;; * added missing :group argument to `defface's +;; +;; Version 0.1 +;; * initial release + + + +;;; Code: + +(eval-when-compile (require 'cl)) + +;; `characterp' isn't defined in Emacs versions <= 22 +(unless (fboundp 'characterp) + (defalias 'characterp 'char-valid-p)) + +;; `region-active-p' isn't defined in Emacs versions <= 22 +(unless (fboundp 'region-active-p) + (defun region-active-p () (and transient-mark-mode mark-active))) + + + +;;; ===================================================================== +;;; Global variables and customization options + +(defvar buffer-undo-tree nil + "Tree of undo entries in current buffer.") +(make-variable-buffer-local 'buffer-undo-tree) + + +(defgroup undo-tree nil + "Tree undo/redo." + :group 'undo) + +(defcustom undo-tree-mode-lighter " Undo-Tree" + "Lighter displayed in mode line +when `undo-tree-mode' is enabled." + :group 'undo-tree + :type 'string) + +(defcustom undo-tree-visualizer-spacing 3 + "Horizontal spacing in undo-tree visualization. +Must be a postivie odd integer." + :group 'undo-tree + :type '(integer + :match (lambda (w n) (and (integerp n) (> n 0) (= (mod n 2) 1))))) +(make-variable-buffer-local 'undo-tree-visualizer-spacing) + +(defvar undo-tree-map nil + "Keymap used in undo-tree-mode.") + + +(defface undo-tree-visualizer-default-face + '((((class color)) :foreground "gray")) + "*Face used to draw undo-tree in visualizer." + :group 'undo-tree) + +(defface undo-tree-visualizer-current-face + '((((class color)) :foreground "red")) + "*Face used to highlight current undo-tree node in visualizer." + :group 'undo-tree) + +(defface undo-tree-visualizer-active-branch-face + '((((class color) (background dark)) + (:foreground "white" :weight bold)) + (((class color) (background light)) + (:foreground "black" :weight bold))) + "*Face used to highlight active undo-tree branch +in visualizer." + :group 'undo-tree) + +(defface undo-tree-visualizer-register-face + '((((class color)) :foreground "yellow")) + "*Face used to highlight undo-tree nodes saved to a register +in visualizer." + :group 'undo-tree) + +(defvar undo-tree-visualizer-map nil + "Keymap used in undo-tree visualizer.") + +(defvar undo-tree-visualizer-selection-map nil + "Keymap used in undo-tree visualizer selection mode.") + + +(defvar undo-tree-visualizer-parent-buffer nil + "Parent buffer in visualizer.") +(make-variable-buffer-local 'undo-tree-visualizer-parent-buffer) + +(defvar undo-tree-visualizer-timestamps nil + "Non-nil when visualizer is displaying time-stamps.") +(make-variable-buffer-local 'undo-tree-visualizer-timestamps) + +(defconst undo-tree-visualizer-buffer-name " *undo-tree*") + +;; prevent debugger being called on "No further redo information" +(add-to-list 'debug-ignored-errors "^No further redo information") + + + + +;;; ================================================================= +;;; Setup default keymaps + +(unless undo-tree-map + (setq undo-tree-map (make-sparse-keymap)) + ;; remap `undo' and `undo-only' to `undo-tree-undo' + (define-key undo-tree-map [remap undo] 'undo-tree-undo) + (define-key undo-tree-map [remap undo-only] 'undo-tree-undo) + ;; bind standard undo bindings (since these match redo counterparts) + (define-key undo-tree-map (kbd "C-/") 'undo-tree-undo) + (define-key undo-tree-map "\C-_" 'undo-tree-undo) + ;; redo doesn't exist normally, so define our own keybindings + (define-key undo-tree-map (kbd "C-?") 'undo-tree-redo) + (define-key undo-tree-map (kbd "M-_") 'undo-tree-redo) + ;; just in case something has defined `redo'... + (define-key undo-tree-map [remap redo] 'undo-tree-redo) + ;; we use "C-x u" for the undo-tree visualizer + (define-key undo-tree-map (kbd "\C-x u") 'undo-tree-visualize) + ;; bind register commands + (define-key undo-tree-map (kbd "C-x r u") + 'undo-tree-save-state-to-register) + (define-key undo-tree-map (kbd "C-x r U") + 'undo-tree-restore-state-from-register)) + + +(unless undo-tree-visualizer-map + (setq undo-tree-visualizer-map (make-keymap)) + ;; vertical motion keys undo/redo + (define-key undo-tree-visualizer-map [remap previous-line] + 'undo-tree-visualize-undo) + (define-key undo-tree-visualizer-map [remap next-line] + 'undo-tree-visualize-redo) + (define-key undo-tree-visualizer-map [up] + 'undo-tree-visualize-undo) + (define-key undo-tree-visualizer-map "p" + 'undo-tree-visualize-undo) + (define-key undo-tree-visualizer-map "\C-p" + 'undo-tree-visualize-undo) + (define-key undo-tree-visualizer-map [down] + 'undo-tree-visualize-redo) + (define-key undo-tree-visualizer-map "n" + 'undo-tree-visualize-redo) + (define-key undo-tree-visualizer-map "\C-n" + 'undo-tree-visualize-redo) + ;; horizontal motion keys switch branch + (define-key undo-tree-visualizer-map [remap forward-char] + 'undo-tree-visualize-switch-branch-right) + (define-key undo-tree-visualizer-map [remap backward-char] + 'undo-tree-visualize-switch-branch-left) + (define-key undo-tree-visualizer-map [right] + 'undo-tree-visualize-switch-branch-right) + (define-key undo-tree-visualizer-map "f" + 'undo-tree-visualize-switch-branch-right) + (define-key undo-tree-visualizer-map "\C-f" + 'undo-tree-visualize-switch-branch-right) + (define-key undo-tree-visualizer-map [left] + 'undo-tree-visualize-switch-branch-left) + (define-key undo-tree-visualizer-map "b" + 'undo-tree-visualize-switch-branch-left) + (define-key undo-tree-visualizer-map "\C-b" + 'undo-tree-visualize-switch-branch-left) + ;; mouse sets buffer state to node at click + (define-key undo-tree-visualizer-map [mouse-1] + 'undo-tree-visualizer-mouse-set) + ;; toggle timestamps + (define-key undo-tree-visualizer-map "t" + 'undo-tree-visualizer-toggle-timestamps) + ;; selection mode + (define-key undo-tree-visualizer-map "s" + 'undo-tree-visualizer-selection-mode) + ;; horizontal scrolling may be needed if the tree is very wide + (define-key undo-tree-visualizer-map "," + 'undo-tree-visualizer-scroll-left) + (define-key undo-tree-visualizer-map "." + 'undo-tree-visualizer-scroll-right) + (define-key undo-tree-visualizer-map "<" + 'undo-tree-visualizer-scroll-left) + (define-key undo-tree-visualizer-map ">" + 'undo-tree-visualizer-scroll-right) + ;; vertical scrolling may be needed if the tree is very tall + (define-key undo-tree-visualizer-map [next] 'scroll-up) + (define-key undo-tree-visualizer-map [prior] 'scroll-down) + ;; quit visualizer + (define-key undo-tree-visualizer-map "q" + 'undo-tree-visualizer-quit) + (define-key undo-tree-visualizer-map "\C-q" + 'undo-tree-visualizer-quit)) + + +(unless undo-tree-visualizer-selection-map + (setq undo-tree-visualizer-selection-map (make-keymap)) + ;; vertical motion keys move up and down tree + (define-key undo-tree-visualizer-selection-map [remap previous-line] + 'undo-tree-visualizer-select-previous) + (define-key undo-tree-visualizer-selection-map [remap next-line] + 'undo-tree-visualizer-select-next) + (define-key undo-tree-visualizer-selection-map [up] + 'undo-tree-visualizer-select-previous) + (define-key undo-tree-visualizer-selection-map "p" + 'undo-tree-visualizer-select-previous) + (define-key undo-tree-visualizer-selection-map "\C-p" + 'undo-tree-visualizer-select-previous) + (define-key undo-tree-visualizer-selection-map [down] + 'undo-tree-visualizer-select-next) + (define-key undo-tree-visualizer-selection-map "n" + 'undo-tree-visualizer-select-next) + (define-key undo-tree-visualizer-selection-map "\C-n" + 'undo-tree-visualizer-select-next) + ;; vertical scroll keys move up and down quickly + (define-key undo-tree-visualizer-selection-map [next] + (lambda () (interactive) (undo-tree-visualizer-select-next 10))) + (define-key undo-tree-visualizer-selection-map [prior] + (lambda () (interactive) (undo-tree-visualizer-select-previous 10))) + ;; horizontal motion keys move to left and right siblings + (define-key undo-tree-visualizer-selection-map [remap forward-char] + 'undo-tree-visualizer-select-right) + (define-key undo-tree-visualizer-selection-map [remap backward-char] + 'undo-tree-visualizer-select-left) + (define-key undo-tree-visualizer-selection-map [right] + 'undo-tree-visualizer-select-right) + (define-key undo-tree-visualizer-selection-map "f" + 'undo-tree-visualizer-select-right) + (define-key undo-tree-visualizer-selection-map "\C-f" + 'undo-tree-visualizer-select-right) + (define-key undo-tree-visualizer-selection-map [left] + 'undo-tree-visualizer-select-left) + (define-key undo-tree-visualizer-selection-map "b" + 'undo-tree-visualizer-select-left) + (define-key undo-tree-visualizer-selection-map "\C-b" + 'undo-tree-visualizer-select-left) + ;; horizontal scroll keys move left or right quickly + (define-key undo-tree-visualizer-selection-map "," + (lambda () (interactive) (undo-tree-visualizer-select-left 10))) + (define-key undo-tree-visualizer-selection-map "." + (lambda () (interactive) (undo-tree-visualizer-select-right 10))) + (define-key undo-tree-visualizer-selection-map "<" + (lambda () (interactive) (undo-tree-visualizer-select-left 10))) + (define-key undo-tree-visualizer-selection-map ">" + (lambda () (interactive) (undo-tree-visualizer-select-right 10))) + ;; mouse or <enter> sets buffer state to node at point/click + (define-key undo-tree-visualizer-selection-map "\r" + 'undo-tree-visualizer-set) + (define-key undo-tree-visualizer-selection-map [mouse-1] + 'undo-tree-visualizer-mouse-set) + ;; toggle timestamps + (define-key undo-tree-visualizer-selection-map "t" + 'undo-tree-visualizer-toggle-timestamps) + ;; quit visualizer selection mode + (define-key undo-tree-visualizer-selection-map "s" + 'undo-tree-visualizer-mode) + ;; quit visualizer + (define-key undo-tree-visualizer-selection-map "q" + 'undo-tree-visualizer-quit) + (define-key undo-tree-visualizer-selection-map "\C-q" + 'undo-tree-visualizer-quit)) + + + + +;;; ===================================================================== +;;; Undo-tree data structure + +(defstruct + (undo-tree + :named + (:constructor nil) + (:constructor make-undo-tree + (&aux + (root (make-undo-tree-node nil nil)) + (current root) + (size 0) + (object-pool (make-hash-table :test 'eq :weakness 'value)))) + (:copier nil)) + root current size object-pool) + + + +(defstruct + (undo-tree-node + (:type vector) ; create unnamed struct + (:constructor nil) + (:constructor make-undo-tree-node + (previous undo + &optional redo + &aux + (timestamp (current-time)) + (branch 0))) + (:constructor make-undo-tree-node-backwards + (next-node undo + &optional redo + &aux + (next (list next-node)) + (timestamp (current-time)) + (branch 0))) + (:copier nil)) + previous next undo redo timestamp branch meta-data) + + +(defmacro undo-tree-node-p (n) + (let ((len (length (make-undo-tree-node nil nil)))) + `(and (vectorp ,n) (= (length ,n) ,len)))) + + + +(defstruct + (undo-tree-region-data + (:type vector) ; create unnamed struct + (:constructor nil) + (:constructor make-undo-tree-region-data + (&optional undo-beginning undo-end + redo-beginning redo-end)) + (:constructor make-undo-tree-undo-region-data + (undo-beginning undo-end)) + (:constructor make-undo-tree-redo-region-data + (redo-beginning redo-end)) + (:copier nil)) + undo-beginning undo-end redo-beginning redo-end) + + +(defmacro undo-tree-region-data-p (r) + (let ((len (length (make-undo-tree-region-data)))) + `(and (vectorp ,r) (= (length ,r) ,len)))) + +(defmacro undo-tree-node-clear-region-data (node) + `(setf (undo-tree-node-meta-data ,node) + (delq nil + (delq :region + (plist-put (undo-tree-node-meta-data ,node) + :region nil))))) + + +(defmacro undo-tree-node-undo-beginning (node) + `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region))) + (when (undo-tree-region-data-p r) + (undo-tree-region-data-undo-beginning r)))) + +(defmacro undo-tree-node-undo-end (node) + `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region))) + (when (undo-tree-region-data-p r) + (undo-tree-region-data-undo-end r)))) + +(defmacro undo-tree-node-redo-beginning (node) + `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region))) + (when (undo-tree-region-data-p r) + (undo-tree-region-data-redo-beginning r)))) + +(defmacro undo-tree-node-redo-end (node) + `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region))) + (when (undo-tree-region-data-p r) + (undo-tree-region-data-redo-end r)))) + + +(defsetf undo-tree-node-undo-beginning (node) (val) + `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region))) + (unless (undo-tree-region-data-p r) + (setf (undo-tree-node-meta-data ,node) + (plist-put (undo-tree-node-meta-data ,node) :region + (setq r (make-undo-tree-region-data))))) + (setf (undo-tree-region-data-undo-beginning r) ,val))) + +(defsetf undo-tree-node-undo-end (node) (val) + `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region))) + (unless (undo-tree-region-data-p r) + (setf (undo-tree-node-meta-data ,node) + (plist-put (undo-tree-node-meta-data ,node) :region + (setq r (make-undo-tree-region-data))))) + (setf (undo-tree-region-data-undo-end r) ,val))) + +(defsetf undo-tree-node-redo-beginning (node) (val) + `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region))) + (unless (undo-tree-region-data-p r) + (setf (undo-tree-node-meta-data ,node) + (plist-put (undo-tree-node-meta-data ,node) :region + (setq r (make-undo-tree-region-data))))) + (setf (undo-tree-region-data-redo-beginning r) ,val))) + +(defsetf undo-tree-node-redo-end (node) (val) + `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region))) + (unless (undo-tree-region-data-p r) + (setf (undo-tree-node-meta-data ,node) + (plist-put (undo-tree-node-meta-data ,node) :region + (setq r (make-undo-tree-region-data))))) + (setf (undo-tree-region-data-redo-end r) ,val))) + + + +(defstruct + (undo-tree-visualizer-data + (:type vector) ; create unnamed struct + (:constructor nil) + (:constructor make-undo-tree-visualizer-data + (&optional lwidth cwidth rwidth marker)) + (:copier nil)) + lwidth cwidth rwidth marker) + + +(defmacro undo-tree-visualizer-data-p (v) + (let ((len (length (make-undo-tree-visualizer-data)))) + `(and (vectorp ,v) (= (length ,v) ,len)))) + +(defmacro undo-tree-node-clear-visualizer-data (node) + `(setf (undo-tree-node-meta-data ,node) + (delq nil + (delq :visualizer + (plist-put (undo-tree-node-meta-data ,node) + :visualizer nil))))) + + +(defmacro undo-tree-node-lwidth (node) + `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer))) + (when (undo-tree-visualizer-data-p v) + (undo-tree-visualizer-data-lwidth v)))) + +(defmacro undo-tree-node-cwidth (node) + `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer))) + (when (undo-tree-visualizer-data-p v) + (undo-tree-visualizer-data-cwidth v)))) + +(defmacro undo-tree-node-rwidth (node) + `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer))) + (when (undo-tree-visualizer-data-p v) + (undo-tree-visualizer-data-rwidth v)))) + +(defmacro undo-tree-node-marker (node) + `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer))) + (when (undo-tree-visualizer-data-p v) + (undo-tree-visualizer-data-marker v)))) + + +(defsetf undo-tree-node-lwidth (node) (val) + `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer))) + (unless (undo-tree-visualizer-data-p v) + (setf (undo-tree-node-meta-data ,node) + (plist-put (undo-tree-node-meta-data ,node) :visualizer + (setq v (make-undo-tree-visualizer-data))))) + (setf (undo-tree-visualizer-data-lwidth v) ,val))) + +(defsetf undo-tree-node-cwidth (node) (val) + `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer))) + (unless (undo-tree-visualizer-data-p v) + (setf (undo-tree-node-meta-data ,node) + (plist-put (undo-tree-node-meta-data ,node) :visualizer + (setq v (make-undo-tree-visualizer-data))))) + (setf (undo-tree-visualizer-data-cwidth v) ,val))) + +(defsetf undo-tree-node-rwidth (node) (val) + `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer))) + (unless (undo-tree-visualizer-data-p v) + (setf (undo-tree-node-meta-data ,node) + (plist-put (undo-tree-node-meta-data ,node) :visualizer + (setq v (make-undo-tree-visualizer-data))))) + (setf (undo-tree-visualizer-data-rwidth v) ,val))) + +(defsetf undo-tree-node-marker (node) (val) + `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer))) + (unless (undo-tree-visualizer-data-p v) + (setf (undo-tree-node-meta-data ,node) + (plist-put (undo-tree-node-meta-data ,node) :visualizer + (setq v (make-undo-tree-visualizer-data))))) + (setf (undo-tree-visualizer-data-marker v) ,val))) + + + +(defmacro undo-tree-node-register (node) + `(plist-get (undo-tree-node-meta-data ,node) :register)) + +(defsetf undo-tree-node-register (node) (val) + `(setf (undo-tree-node-meta-data ,node) + (plist-put (undo-tree-node-meta-data ,node) :register ,val))) + + + + +;;; ===================================================================== +;;; Basic undo-tree data structure functions + +(defun undo-tree-grow (undo) + "Add an UNDO node to current branch of `buffer-undo-tree'." + (let* ((current (undo-tree-current buffer-undo-tree)) + (new (make-undo-tree-node current undo))) + (push new (undo-tree-node-next current)) + (setf (undo-tree-current buffer-undo-tree) new))) + + +(defun undo-tree-grow-backwards (node undo &optional redo) + "Add new node *above* undo-tree NODE, and return new node. +Note that this will overwrite NODE's \"previous\" link, so should +only be used on a detached NODE, never on nodes that are already +part of `buffer-undo-tree'." + (let ((new (make-undo-tree-node-backwards node undo redo))) + (setf (undo-tree-node-previous node) new) + new)) + + +(defun undo-tree-splice-node (node splice) + "Splice NODE into undo tree, below node SPLICE. +Note that this will overwrite NODE's \"next\" and \"previous\" +links, so should only be used on a detached NODE, never on nodes +that are already part of `buffer-undo-tree'." + (setf (undo-tree-node-next node) (undo-tree-node-next splice) + (undo-tree-node-branch node) (undo-tree-node-branch splice) + (undo-tree-node-previous node) splice + (undo-tree-node-next splice) (list node) + (undo-tree-node-branch splice) 0) + (dolist (n (undo-tree-node-next node)) + (setf (undo-tree-node-previous n) node))) + + +(defun undo-tree-snip-node (node) + "Snip NODE out of undo tree." + (let* ((parent (undo-tree-node-previous node)) + position p) + ;; if NODE is only child, replace parent's next links with NODE's + (if (= (length (undo-tree-node-next parent)) 0) + (setf (undo-tree-node-next parent) (undo-tree-node-next node) + (undo-tree-node-branch parent) (undo-tree-node-branch node)) + ;; otherwise... + (setq position (undo-tree-position node (undo-tree-node-next parent))) + (cond + ;; if active branch used do go via NODE, set parent's branch to active + ;; branch of NODE + ((= (undo-tree-node-branch parent) position) + (setf (undo-tree-node-branch parent) + (+ position (undo-tree-node-branch node)))) + ;; if active branch didn't go via NODE, update parent's branch to point + ;; to same node as before + ((> (undo-tree-node-branch parent) position) + (incf (undo-tree-node-branch parent) + (1- (length (undo-tree-node-next node)))))) + ;; replace NODE in parent's next list with NODE's entire next list + (if (= position 0) + (setf (undo-tree-node-next parent) + (nconc (undo-tree-node-next node) + (cdr (undo-tree-node-next parent)))) + (setq p (nthcdr (1- position) (undo-tree-node-next parent))) + (setcdr p (nconc (undo-tree-node-next node) (cddr p))))) + ;; update previous links of NODE's children + (dolist (n (undo-tree-node-next node)) + (setf (undo-tree-node-previous n) parent)))) + + +(defun undo-tree-mapc (--undo-tree-mapc-function-- undo-tree) + ;; Apply FUNCTION to each node in UNDO-TREE. + (let ((stack (list (undo-tree-root undo-tree))) + node) + (while stack + (setq node (pop stack)) + (funcall --undo-tree-mapc-function-- node) + (setq stack (append (undo-tree-node-next node) stack))))) + + +(defmacro undo-tree-num-branches () + "Return number of branches at current undo tree node." + '(length (undo-tree-node-next (undo-tree-current buffer-undo-tree)))) + + +(defun undo-tree-position (node list) + "Find the first occurrence of NODE in LIST. +Return the index of the matching item, or nil of not found. +Comparison is done with 'eq." + (let ((i 0)) + (catch 'found + (while (progn + (when (eq node (car list)) (throw 'found i)) + (incf i) + (setq list (cdr list)))) + nil))) + + +(defvar *undo-tree-id-counter* 0) +(make-variable-buffer-local '*undo-tree-id-counter*) + +(defmacro undo-tree-generate-id () + ;; Generate a new, unique id (uninterned symbol). + ;; The name is made by appending a number to "undo-tree-id". + ;; (Copied from CL package `gensym'.) + `(let ((num (prog1 *undo-tree-id-counter* (incf *undo-tree-id-counter*)))) + (make-symbol (format "undo-tree-id%d" num)))) + + + + +;;; ===================================================================== +;;; Utility functions for handling `buffer-undo-list' and changesets + +(defmacro undo-list-marker-elt-p (elt) + `(markerp (car-safe ,elt))) + +(defmacro undo-list-GCd-marker-elt-p (elt) + `(and (symbolp (car-safe ,elt)) (numberp (cdr-safe ,elt)))) + + +(defun undo-tree-move-GC-elts-to-pool (elt) + ;; Move elements that can be garbage-collected into `buffer-undo-tree' + ;; object pool, substituting a unique id that can be used to retrieve them + ;; later. (Only markers require this treatment currently.) + (when (undo-list-marker-elt-p elt) + (let ((id (undo-tree-generate-id))) + (puthash id (car elt) (undo-tree-object-pool buffer-undo-tree)) + (setcar elt id)))) + + +(defun undo-tree-restore-GC-elts-from-pool (elt) + ;; Replace object id's in ELT with corresponding objects from + ;; `buffer-undo-tree' object pool and return modified ELT, or return nil if + ;; any object in ELT has been garbage-collected. + (if (undo-list-GCd-marker-elt-p elt) + (when (setcar elt (gethash (car elt) + (undo-tree-object-pool buffer-undo-tree))) + elt) + elt)) + + +(defun undo-list-clean-GCd-elts (undo-list) + ;; Remove object id's from UNDO-LIST that refer to elements that have been + ;; garbage-collected. UNDO-LIST is modified by side-effect. + (while (undo-list-GCd-marker-elt-p (car undo-list)) + (unless (gethash (caar undo-list) + (undo-tree-object-pool buffer-undo-tree)) + (setq undo-list (cdr undo-list)))) + (let ((p undo-list)) + (while (cdr p) + (when (and (undo-list-GCd-marker-elt-p (cadr p)) + (null (gethash (car (cadr p)) + (undo-tree-object-pool buffer-undo-tree)))) + (setcdr p (cddr p))) + (setq p (cdr p)))) + undo-list) + + +(defun undo-list-pop-changeset () + ;; Pop changeset from `buffer-undo-list'. + ;; discard undo boundaries at head of list + (while (null (car buffer-undo-list)) + (setq buffer-undo-list (cdr buffer-undo-list))) + ;; pop elements up to next undo boundary + (unless (eq (car buffer-undo-list) 'undo-tree-canary) + (let* ((changeset (list (pop buffer-undo-list))) + (p changeset)) + (while (progn + (undo-tree-move-GC-elts-to-pool (car p)) + (car buffer-undo-list)) + (setcdr p (list (pop buffer-undo-list))) + (setq p (cdr p))) + changeset))) + + +(defun undo-tree-copy-list (undo-list) + ;; Return a deep copy of first changeset in `undo-list'. Object id's are + ;; replaced by corresponding objects from `buffer-undo-tree' object-pool. + (when undo-list + (let (copy p) + ;; if first element contains an object id, replace it with object from + ;; pool, discarding element entirely if it's been GC'd + (while (null copy) + (setq copy + (undo-tree-restore-GC-elts-from-pool (pop undo-list)))) + (setq copy (list copy) + p copy) + ;; copy remaining elements, replacing object id's with objects from + ;; pool, or discarding them entirely if they've been GC'd + (while undo-list + (when (setcdr p (undo-tree-restore-GC-elts-from-pool + (undo-copy-list-1 (pop undo-list)))) + (setcdr p (list (cdr p))) + (setq p (cdr p)))) + copy))) + + + +(defun undo-list-transfer-to-tree () + ;; Transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'. + + ;; if `buffer-undo-tree' is empty, create initial undo-tree + (when (null buffer-undo-tree) (setq buffer-undo-tree (make-undo-tree))) + ;; make sure there's a canary at end of `buffer-undo-list' + (if (null buffer-undo-list) + (setq buffer-undo-list '(nil undo-tree-canary)) + (let ((elt (last buffer-undo-list))) + (unless (eq (car elt) 'undo-tree-canary) + (setcdr elt '(nil undo-tree-canary))))) + + (unless (eq (cadr buffer-undo-list) 'undo-tree-canary) + ;; create new node from first changeset in `buffer-undo-list', save old + ;; `buffer-undo-tree' current node, and make new node the current node + (let* ((node (make-undo-tree-node nil (undo-list-pop-changeset))) + (splice (undo-tree-current buffer-undo-tree)) + (size (undo-list-byte-size (undo-tree-node-undo node)))) + (setf (undo-tree-current buffer-undo-tree) node) + ;; grow tree fragment backwards using `buffer-undo-list' changesets + (while (and buffer-undo-list + (not (eq (cadr buffer-undo-list) 'undo-tree-canary))) + (setq node + (undo-tree-grow-backwards node (undo-list-pop-changeset))) + (incf size (undo-list-byte-size (undo-tree-node-undo node)))) + ;; if no undo history has been discarded from `buffer-undo-list' since + ;; last transfer, splice new tree fragment onto end of old + ;; `buffer-undo-tree' current node + (if (eq (cadr buffer-undo-list) 'undo-tree-canary) + (progn + (setf (undo-tree-node-previous node) splice) + (push node (undo-tree-node-next splice)) + (setf (undo-tree-node-branch splice) 0) + (incf (undo-tree-size buffer-undo-tree) size)) + ;; if undo history has been discarded, replace entire + ;; `buffer-undo-tree' with new tree fragment + (setq node (undo-tree-grow-backwards node nil)) + (setf (undo-tree-root buffer-undo-tree) node) + (setq buffer-undo-list '(nil undo-tree-canary)) + (setf (undo-tree-size buffer-undo-tree) size))) + ;; discard undo history if necessary + (undo-tree-discard-history))) + + +(defun undo-list-byte-size (undo-list) + ;; Return size (in bytes) of UNDO-LIST + (let ((size 0) (p undo-list)) + (while p + (incf size 8) ; cons cells use up 8 bytes + (when (and (consp (car p)) (stringp (caar p))) + (incf size (string-bytes (caar p)))) + (setq p (cdr p))) + size)) + + + +(defun undo-list-rebuild-from-tree () + "Rebuild `buffer-undo-list' from information in `buffer-undo-tree'." + (unless (eq buffer-undo-list t) + (undo-list-transfer-to-tree) + (setq buffer-undo-list nil) + (when buffer-undo-tree + (let ((stack (list (list (undo-tree-root buffer-undo-tree))))) + (push (sort (mapcar 'identity (undo-tree-node-next (caar stack))) + (lambda (a b) + (time-less-p (undo-tree-node-timestamp a) + (undo-tree-node-timestamp b)))) + stack) + ;; Traverse tree in depth-and-oldest-first order, but add undo records + ;; on the way down, and redo records on the way up. + (while (or (car stack) + (not (eq (car (nth 1 stack)) + (undo-tree-current buffer-undo-tree)))) + (if (car stack) + (progn + (setq buffer-undo-list + (append (undo-tree-node-undo (caar stack)) + buffer-undo-list)) + (undo-boundary) + (push (sort (mapcar 'identity + (undo-tree-node-next (caar stack))) + (lambda (a b) + (time-less-p (undo-tree-node-timestamp a) + (undo-tree-node-timestamp b)))) + stack)) + (pop stack) + (setq buffer-undo-list + (append (undo-tree-node-redo (caar stack)) + buffer-undo-list)) + (undo-boundary) + (pop (car stack)))))))) + + + + +;;; ===================================================================== +;;; History discarding functions + +(defun undo-tree-oldest-leaf (node) + ;; Return oldest leaf node below NODE. + (while (undo-tree-node-next node) + (setq node + (car (sort (mapcar 'identity (undo-tree-node-next node)) + (lambda (a b) + (time-less-p (undo-tree-node-timestamp a) + (undo-tree-node-timestamp b))))))) + node) + + +(defun undo-tree-discard-node (node) + ;; Discard NODE from `buffer-undo-tree', and return next in line for + ;; discarding. + + ;; don't discard current node + (unless (eq node (undo-tree-current buffer-undo-tree)) + + ;; discarding root node... + (if (eq node (undo-tree-root buffer-undo-tree)) + (cond + ;; should always discard branches before root + ((> (length (undo-tree-node-next node)) 1) + (error "Trying to discard undo-tree root which still\ + has multiple branches")) + ;; don't discard root if current node is only child + ((eq (car (undo-tree-node-next node)) + (undo-tree-current buffer-undo-tree)) + nil) + ;; discard root + (t + ;; make child of root into new root + (setq node (setf (undo-tree-root buffer-undo-tree) + (car (undo-tree-node-next node)))) + ;; update undo-tree size + (decf (undo-tree-size buffer-undo-tree) + (+ (undo-list-byte-size (undo-tree-node-undo node)) + (undo-list-byte-size (undo-tree-node-redo node)))) + ;; discard new root's undo data + (setf (undo-tree-node-undo node) nil + (undo-tree-node-redo node) nil) + ;; if new root has branches, or new root is current node, next node + ;; to discard is oldest leaf, otherwise it's new root + (if (or (> (length (undo-tree-node-next node)) 1) + (eq (car (undo-tree-node-next node)) + (undo-tree-current buffer-undo-tree))) + (undo-tree-oldest-leaf node) + node))) + + ;; discarding leaf node... + (let* ((parent (undo-tree-node-previous node)) + (current (nth (undo-tree-node-branch parent) + (undo-tree-node-next parent)))) + ;; update undo-tree size + (decf (undo-tree-size buffer-undo-tree) + (+ (undo-list-byte-size (undo-tree-node-undo node)) + (undo-list-byte-size (undo-tree-node-redo node)))) + (setf (undo-tree-node-next parent) + (delq node (undo-tree-node-next parent)) + (undo-tree-node-branch parent) + (undo-tree-position current (undo-tree-node-next parent))) + ;; if parent has branches, or parent is current node, next node to + ;; discard is oldest leaf, otherwise it's parent + (if (or (eq parent (undo-tree-current buffer-undo-tree)) + (and (undo-tree-node-next parent) + (or (not (eq parent (undo-tree-root buffer-undo-tree))) + (> (length (undo-tree-node-next parent)) 1)))) + (undo-tree-oldest-leaf parent) + parent))))) + + + +(defun undo-tree-discard-history () + "Discard undo history until we're within memory usage limits +set by `undo-limit', `undo-strong-limit' and `undo-outer-limit'." + + (when (> (undo-tree-size buffer-undo-tree) undo-limit) + ;; if there are no branches off root, first node to discard is root; + ;; otherwise it's leaf node at botom of oldest branch + (let ((node (if (> (length (undo-tree-node-next + (undo-tree-root buffer-undo-tree))) 1) + (undo-tree-oldest-leaf (undo-tree-root buffer-undo-tree)) + (undo-tree-root buffer-undo-tree)))) + + ;; discard nodes until memory use is within `undo-strong-limit' + (while (and node + (> (undo-tree-size buffer-undo-tree) undo-strong-limit)) + (setq node (undo-tree-discard-node node))) + + ;; discard nodes until next node to discard would bring memory use + ;; within `undo-limit' + (while (and node + ;; check first if last discard has brought us within + ;; `undo-limit', in case we can avoid more expensive + ;; `undo-strong-limit' calculation + ;; Note: this assumes undo-strong-limit > undo-limit; + ;; if not, effectively undo-strong-limit = undo-limit + (> (undo-tree-size buffer-undo-tree) undo-limit) + (> (- (undo-tree-size buffer-undo-tree) + ;; if next node to discard is root, the memory we + ;; free-up comes from discarding changesets from its + ;; only child... + (if (eq node (undo-tree-root buffer-undo-tree)) + (+ (undo-list-byte-size + (undo-tree-node-undo + (car (undo-tree-node-next node)))) + (undo-list-byte-size + (undo-tree-node-redo + (car (undo-tree-node-next node))))) + ;; ...otherwise, it comes from discarding changesets + ;; from along with the node itself + (+ (undo-list-byte-size (undo-tree-node-undo node)) + (undo-list-byte-size (undo-tree-node-redo node))) + )) + undo-limit)) + (setq node (undo-tree-discard-node node))) + + ;; if we're still over the `undo-outer-limit', discard entire history + (when (> (undo-tree-size buffer-undo-tree) undo-outer-limit) + ;; query first if `undo-ask-before-discard' is set + (if undo-ask-before-discard + (when (yes-or-no-p + (format + "Buffer `%s' undo info is %d bytes long; discard it? " + (buffer-name) (undo-tree-size buffer-undo-tree))) + (setq buffer-undo-tree nil)) + ;; otherwise, discard and display warning + (display-warning + '(undo discard-info) + (concat + (format "Buffer `%s' undo info was %d bytes long.\n" + (buffer-name) (undo-tree-size buffer-undo-tree)) + "The undo info was discarded because it exceeded\ + `undo-outer-limit'. + +This is normal if you executed a command that made a huge change +to the buffer. In that case, to prevent similar problems in the +future, set `undo-outer-limit' to a value that is large enough to +cover the maximum size of normal changes you expect a single +command to make, but not so large that it might exceed the +maximum memory allotted to Emacs. + +If you did not execute any such command, the situation is +probably due to a bug and you should report it. + +You can disable the popping up of this buffer by adding the entry +\(undo discard-info) to the user option `warning-suppress-types', +which is defined in the `warnings' library.\n") + :warning) + (setq buffer-undo-tree nil))) + ))) + + + + +;;; ===================================================================== +;;; Visualizer-related functions + +(defun undo-tree-compute-widths (undo-tree) + "Recursively compute widths for all UNDO-TREE's nodes." + (let ((stack (list (undo-tree-root undo-tree))) + res) + (while stack + ;; try to compute widths for node at top of stack + (if (undo-tree-node-p + (setq res (undo-tree-node-compute-widths (car stack)))) + ;; if computation fails, it returns a node whose widths still need + ;; computing, which we push onto the stack + (push res stack) + ;; otherwise, store widths and remove it from stack + (setf (undo-tree-node-lwidth (car stack)) (aref res 0) + (undo-tree-node-cwidth (car stack)) (aref res 1) + (undo-tree-node-rwidth (car stack)) (aref res 2)) + (pop stack))))) + + +(defun undo-tree-node-compute-widths (node) + ;; Compute NODE's left-, centre-, and right-subtree widths. Returns widths + ;; (in a vector) if successful. Otherwise, returns a node whose widths need + ;; calculating before NODE's can be calculated. + (let ((num-children (length (undo-tree-node-next node))) + (lwidth 0) (cwidth 0) (rwidth 0) + p w) + (catch 'need-widths + (cond + ;; leaf nodes have 0 width + ((= 0 num-children) + (setf cwidth 1 + (undo-tree-node-lwidth node) 0 + (undo-tree-node-cwidth node) 1 + (undo-tree-node-rwidth node) 0)) + + ;; odd number of children + ((= (mod num-children 2) 1) + (setq p (undo-tree-node-next node)) + ;; compute left-width + (dotimes (i (/ num-children 2)) + (if (undo-tree-node-lwidth (car p)) + (incf lwidth (+ (undo-tree-node-lwidth (car p)) + (undo-tree-node-cwidth (car p)) + (undo-tree-node-rwidth (car p)))) + ;; if child's widths haven't been computed, return that child + (throw 'need-widths (car p))) + (setq p (cdr p))) + (if (undo-tree-node-lwidth (car p)) + (incf lwidth (undo-tree-node-lwidth (car p))) + (throw 'need-widths (car p))) + ;; centre-width is inherited from middle child + (setf cwidth (undo-tree-node-cwidth (car p))) + ;; compute right-width + (incf rwidth (undo-tree-node-rwidth (car p))) + (setq p (cdr p)) + (dotimes (i (/ num-children 2)) + (if (undo-tree-node-lwidth (car p)) + (incf rwidth (+ (undo-tree-node-lwidth (car p)) + (undo-tree-node-cwidth (car p)) + (undo-tree-node-rwidth (car p)))) + (throw 'need-widths (car p))) + (setq p (cdr p)))) + + ;; even number of children + (t + (setq p (undo-tree-node-next node)) + ;; compute left-width + (dotimes (i (/ num-children 2)) + (if (undo-tree-node-lwidth (car p)) + (incf lwidth (+ (undo-tree-node-lwidth (car p)) + (undo-tree-node-cwidth (car p)) + (undo-tree-node-rwidth (car p)))) + (throw 'need-widths (car p))) + (setq p (cdr p))) + ;; centre-width is 0 when number of children is even + (setq cwidth 0) + ;; compute right-width + (dotimes (i (/ num-children 2)) + (if (undo-tree-node-lwidth (car p)) + (incf rwidth (+ (undo-tree-node-lwidth (car p)) + (undo-tree-node-cwidth (car p)) + (undo-tree-node-rwidth (car p)))) + (throw 'need-widths (car p))) + (setq p (cdr p))))) + + ;; return left-, centre- and right-widths + (vector lwidth cwidth rwidth)))) + + +(defun undo-tree-clear-visualizer-data (undo-tree) + ;; Clear visualizer data from UNDO-TREE. + (undo-tree-mapc + (lambda (node) (undo-tree-node-clear-visualizer-data node)) + undo-tree)) + + + + +;;; ===================================================================== +;;; Undo-in-region functions + +(defun undo-tree-pull-undo-in-region-branch (start end) + ;; Pull out entries from undo changesets to create a new undo-in-region + ;; branch, which undoes changeset entries lying between START and END first, + ;; followed by remaining entries from the changesets, before rejoining the + ;; existing undo tree history. Repeated calls will, if appropriate, extend + ;; the current undo-in-region branch rather than creating a new one. + + ;; if we're just reverting the last redo-in-region, we don't need to + ;; manipulate the undo tree at all + (if (undo-tree-reverting-redo-in-region-p start end) + t ; return t to indicate success + + ;; We build the `region-changeset' and `delta-list' lists forwards, using + ;; pointers `r' and `d' to the penultimate element of the list. So that we + ;; don't have to treat the first element differently, we prepend a dummy + ;; leading nil to the lists, and have the pointers point to that + ;; initially. + ;; Note: using '(nil) instead of (list nil) in the `let*' results in + ;; bizarre errors when the code is byte-compiled, where parts of the + ;; lists appear to survive across different calls to this function. + ;; An obscure byte-compiler bug, perhaps? + (let* ((region-changeset (list nil)) + (r region-changeset) + (delta-list (list nil)) + (d delta-list) + (node (undo-tree-current buffer-undo-tree)) + (repeated-undo-in-region + (undo-tree-repeated-undo-in-region-p start end)) + undo-adjusted-markers ; `undo-elt-in-region' expects this + fragment splice original-fragment original-splice original-current + got-visible-elt undo-list elt) + + ;; --- initialisation --- + (cond + ;; if this is a repeated undo in the same region, start pulling changes + ;; from NODE at which undo-in-region branch iss attached, and detatch + ;; the branch, using it as initial FRAGMENT of branch being constructed + (repeated-undo-in-region + (setq original-current node + fragment (car (undo-tree-node-next node)) + splice node) + ;; undo up to node at which undo-in-region branch is attached + ;; (recognizable as first node with more than one branch) + (let ((mark-active nil)) + (while (= (length (undo-tree-node-next node)) 1) + (undo-tree-undo) + (setq fragment node + node (undo-tree-current buffer-undo-tree)))) + (when (eq splice node) (setq splice nil)) + ;; detatch undo-in-region branch + (setf (undo-tree-node-next node) + (delq fragment (undo-tree-node-next node)) + (undo-tree-node-previous fragment) nil + original-fragment fragment + original-splice node)) + + ;; if this is a new undo-in-region, initial FRAGMENT is a copy of all + ;; nodes below the current one in the active branch + ((undo-tree-node-next node) + (setq fragment (make-undo-tree-node nil nil) + splice fragment) + (while (setq node (nth (undo-tree-node-branch node) + (undo-tree-node-next node))) + (push (make-undo-tree-node + splice + (undo-copy-list (undo-tree-node-undo node)) + (undo-copy-list (undo-tree-node-redo node))) + (undo-tree-node-next splice)) + (setq splice (car (undo-tree-node-next splice)))) + (setq fragment (car (undo-tree-node-next fragment)) + splice nil + node (undo-tree-current buffer-undo-tree)))) + + + ;; --- pull undo-in-region elements into branch --- + ;; work backwards up tree, pulling out undo elements within region until + ;; we've got one that undoes a visible change (insertion or deletion) + (catch 'abort + (while (and (not got-visible-elt) node (undo-tree-node-undo node)) + ;; we cons a dummy nil element on the front of the changeset so that + ;; we can conveniently remove the first (real) element from the + ;; changeset if we need to; the leading nil is removed once we're + ;; done with this changeset + (setq undo-list (cons nil (undo-copy-list (undo-tree-node-undo node))) + elt (cadr undo-list)) + (if fragment + (progn + (setq fragment (undo-tree-grow-backwards fragment undo-list)) + (unless splice (setq splice fragment))) + (setq fragment (make-undo-tree-node nil undo-list)) + (setq splice fragment)) + + (while elt + (cond + ;; keep elements within region + ((undo-elt-in-region elt start end) + ;; set flag if kept element is visible (insertion or deletion) + (when (and (consp elt) + (or (stringp (car elt)) (integerp (car elt)))) + (setq got-visible-elt t)) + ;; adjust buffer positions in elements previously undone before + ;; kept element, as kept element will now be undone first + (undo-tree-adjust-elements-to-elt splice elt) + ;; move kept element to undo-in-region changeset, adjusting its + ;; buffer position as it will now be undone first + (setcdr r (list (undo-tree-apply-deltas elt (cdr delta-list)))) + (setq r (cdr r)) + (setcdr undo-list (cddr undo-list))) + + ;; discard "was unmodified" elements + ;; FIXME: deal properly with these + ((and (consp elt) (eq (car elt) t)) + (setcdr undo-list (cddr undo-list))) + + ;; if element crosses region, we can't pull any more elements + ((undo-elt-crosses-region elt start end) + ;; if we've found a visible element, it must be earlier in + ;; current node's changeset; stop pulling elements (null + ;; `undo-list' and non-nil `got-visible-elt' cause loop to exit) + (if got-visible-elt + (setq undo-list nil) + ;; if we haven't found a visible element yet, pulling + ;; undo-in-region branch has failed + (setq region-changeset nil) + (throw 'abort t))) + + ;; if rejecting element, add its delta (if any) to the list + (t + (let ((delta (undo-delta elt))) + (when (/= 0 (cdr delta)) + (setcdr d (list delta)) + (setq d (cdr d)))) + (setq undo-list (cdr undo-list)))) + + ;; process next element of current changeset + (setq elt (cadr undo-list))) + + ;; if there are remaining elements in changeset, remove dummy nil + ;; from front + (if (cadr (undo-tree-node-undo fragment)) + (pop (undo-tree-node-undo fragment)) + ;; otherwise, if we've kept all elements in changeset, discard + ;; empty changeset + (when (eq splice fragment) (setq splice nil)) + (setq fragment (car (undo-tree-node-next fragment)))) + ;; process changeset from next node up the tree + (setq node (undo-tree-node-previous node)))) + + ;; pop dummy nil from front of `region-changeset' + (pop region-changeset) + + + ;; --- integrate branch into tree --- + ;; if no undo-in-region elements were found, restore undo tree + (if (null region-changeset) + (when original-current + (push original-fragment (undo-tree-node-next original-splice)) + (setf (undo-tree-node-branch original-splice) 0 + (undo-tree-node-previous original-fragment) original-splice) + (let ((mark-active nil)) + (while (not (eq (undo-tree-current buffer-undo-tree) + original-current)) + (undo-tree-redo))) + nil) ; return nil to indicate failure + + ;; otherwise... + ;; need to undo up to node where new branch will be attached, to + ;; ensure redo entries are populated, and then redo back to where we + ;; started + (let ((mark-active nil) + (current (undo-tree-current buffer-undo-tree))) + (while (not (eq (undo-tree-current buffer-undo-tree) node)) + (undo-tree-undo)) + (while (not (eq (undo-tree-current buffer-undo-tree) current)) + (undo-tree-redo))) + + (cond + ;; if there's no remaining fragment, just create undo-in-region node + ;; and attach it to parent of last node from which elements were + ;; pulled + ((null fragment) + (setq fragment (make-undo-tree-node node region-changeset)) + (push fragment (undo-tree-node-next node)) + (setf (undo-tree-node-branch node) 0) + ;; set current node to undo-in-region node + (setf (undo-tree-current buffer-undo-tree) fragment)) + + ;; if no splice point has been set, add undo-in-region node to top of + ;; fragment and attach it to parent of last node from which elements + ;; were pulled + ((null splice) + (setq fragment (undo-tree-grow-backwards fragment region-changeset)) + (push fragment (undo-tree-node-next node)) + (setf (undo-tree-node-branch node) 0 + (undo-tree-node-previous fragment) node) + ;; set current node to undo-in-region node + (setf (undo-tree-current buffer-undo-tree) fragment)) + + ;; if fragment contains nodes, attach fragment to parent of last node + ;; from which elements were pulled, and splice in undo-in-region node + (t + (setf (undo-tree-node-previous fragment) node) + (push fragment (undo-tree-node-next node)) + (setf (undo-tree-node-branch node) 0) + ;; if this is a repeated undo-in-region, then we've left the current + ;; node at the original splice-point; we need to set the current + ;; node to the equivalent node on the undo-in-region branch and redo + ;; back to where we started + (when repeated-undo-in-region + (setf (undo-tree-current buffer-undo-tree) + (undo-tree-node-previous original-fragment)) + (let ((mark-active nil)) + (while (not (eq (undo-tree-current buffer-undo-tree) splice)) + (undo-tree-redo nil 'preserve-undo)))) + ;; splice new undo-in-region node into fragment + (setq node (make-undo-tree-node nil region-changeset)) + (undo-tree-splice-node node splice) + ;; set current node to undo-in-region node + (setf (undo-tree-current buffer-undo-tree) node))) + + ;; update undo-tree size + (setq node (undo-tree-node-previous fragment)) + (while (progn + (and (setq node (car (undo-tree-node-next node))) + (not (eq node original-fragment)) + (incf (undo-tree-size buffer-undo-tree) + (undo-list-byte-size (undo-tree-node-undo node))) + (when (undo-tree-node-redo node) + (incf (undo-tree-size buffer-undo-tree) + (undo-list-byte-size (undo-tree-node-redo node)))) + ))) + t) ; indicate undo-in-region branch was successfully pulled + ))) + + + +(defun undo-tree-pull-redo-in-region-branch (start end) + ;; Pull out entries from redo changesets to create a new redo-in-region + ;; branch, which redoes changeset entries lying between START and END first, + ;; followed by remaining entries from the changesets. Repeated calls will, + ;; if appropriate, extend the current redo-in-region branch rather than + ;; creating a new one. + + ;; if we're just reverting the last undo-in-region, we don't need to + ;; manipulate the undo tree at all + (if (undo-tree-reverting-undo-in-region-p start end) + t ; return t to indicate success + + ;; We build the `region-changeset' and `delta-list' lists forwards, using + ;; pointers `r' and `d' to the penultimate element of the list. So that we + ;; don't have to treat the first element differently, we prepend a dummy + ;; leading nil to the lists, and have the pointers point to that + ;; initially. + ;; Note: using '(nil) instead of (list nil) in the `let*' causes bizarre + ;; errors when the code is byte-compiled, where parts of the lists + ;; appear to survive across different calls to this function. An + ;; obscure byte-compiler bug, perhaps? + (let* ((region-changeset (list nil)) + (r region-changeset) + (delta-list (list nil)) + (d delta-list) + (node (undo-tree-current buffer-undo-tree)) + (repeated-redo-in-region + (undo-tree-repeated-redo-in-region-p start end)) + undo-adjusted-markers ; `undo-elt-in-region' expects this + fragment splice got-visible-elt redo-list elt) + + ;; --- inisitalisation --- + (cond + ;; if this is a repeated redo-in-region, detach fragment below current + ;; node + (repeated-redo-in-region + (when (setq fragment (car (undo-tree-node-next node))) + (setf (undo-tree-node-previous fragment) nil + (undo-tree-node-next node) + (delq fragment (undo-tree-node-next node))))) + ;; if this is a new redo-in-region, initial fragment is a copy of all + ;; nodes below the current one in the active branch + ((undo-tree-node-next node) + (setq fragment (make-undo-tree-node nil nil) + splice fragment) + (while (setq node (nth (undo-tree-node-branch node) + (undo-tree-node-next node))) + (push (make-undo-tree-node + splice nil + (undo-copy-list (undo-tree-node-redo node))) + (undo-tree-node-next splice)) + (setq splice (car (undo-tree-node-next splice)))) + (setq fragment (car (undo-tree-node-next fragment))))) + + + ;; --- pull redo-in-region elements into branch --- + ;; work down fragment, pulling out redo elements within region until + ;; we've got one that redoes a visible change (insertion or deletion) + (setq node fragment) + (catch 'abort + (while (and (not got-visible-elt) node (undo-tree-node-redo node)) + ;; we cons a dummy nil element on the front of the changeset so that + ;; we can conveniently remove the first (real) element from the + ;; changeset if we need to; the leading nil is removed once we're + ;; done with this changeset + (setq redo-list (push nil (undo-tree-node-redo node)) + elt (cadr redo-list)) + (while elt + (cond + ;; keep elements within region + ((undo-elt-in-region elt start end) + ;; set flag if kept element is visible (insertion or deletion) + (when (and (consp elt) + (or (stringp (car elt)) (integerp (car elt)))) + (setq got-visible-elt t)) + ;; adjust buffer positions in elements previously redone before + ;; kept element, as kept element will now be redone first + (undo-tree-adjust-elements-to-elt fragment elt t) + ;; move kept element to redo-in-region changeset, adjusting its + ;; buffer position as it will now be redone first + (setcdr r (list (undo-tree-apply-deltas elt (cdr delta-list) -1))) + (setq r (cdr r)) + (setcdr redo-list (cddr redo-list))) + + ;; discard "was unmodified" elements + ;; FIXME: deal properly with these + ((and (consp elt) (eq (car elt) t)) + (setcdr redo-list (cddr redo-list))) + + ;; if element crosses region, we can't pull any more elements + ((undo-elt-crosses-region elt start end) + ;; if we've found a visible element, it must be earlier in + ;; current node's changeset; stop pulling elements (null + ;; `redo-list' and non-nil `got-visible-elt' cause loop to exit) + (if got-visible-elt + (setq redo-list nil) + ;; if we haven't found a visible element yet, pulling + ;; redo-in-region branch has failed + (setq region-changeset nil) + (throw 'abort t))) + + ;; if rejecting element, add its delta (if any) to the list + (t + (let ((delta (undo-delta elt))) + (when (/= 0 (cdr delta)) + (setcdr d (list delta)) + (setq d (cdr d)))) + (setq redo-list (cdr redo-list)))) + + ;; process next element of current changeset + (setq elt (cadr redo-list))) + + ;; if there are remaining elements in changeset, remove dummy nil + ;; from front + (if (cadr (undo-tree-node-redo node)) + (pop (undo-tree-node-undo node)) + ;; otherwise, if we've kept all elements in changeset, discard + ;; empty changeset + (if (eq fragment node) + (setq fragment (car (undo-tree-node-next fragment))) + (undo-tree-snip-node node))) + ;; process changeset from next node in fragment + (setq node (car (undo-tree-node-next node))))) + + ;; pop dummy nil from front of `region-changeset' + (pop region-changeset) + + + ;; --- integrate branch into tree --- + (setq node (undo-tree-current buffer-undo-tree)) + ;; if no redo-in-region elements were found, restore undo tree + (if (null (car region-changeset)) + (when (and repeated-redo-in-region fragment) + (push fragment (undo-tree-node-next node)) + (setf (undo-tree-node-branch node) 0 + (undo-tree-node-previous fragment) node) + nil) ; return nil to indicate failure + + ;; otherwise, add redo-in-region node to top of fragment, and attach + ;; it below current node + (setq fragment + (if fragment + (undo-tree-grow-backwards fragment nil region-changeset) + (make-undo-tree-node nil nil region-changeset))) + (push fragment (undo-tree-node-next node)) + (setf (undo-tree-node-branch node) 0 + (undo-tree-node-previous fragment) node) + ;; update undo-tree size + (unless repeated-redo-in-region + (setq node fragment) + (while (progn + (and (setq node (car (undo-tree-node-next node))) + (incf (undo-tree-size buffer-undo-tree) + (undo-list-byte-size + (undo-tree-node-redo node))))))) + (incf (undo-tree-size buffer-undo-tree) + (undo-list-byte-size (undo-tree-node-redo fragment))) + t) ; indicate undo-in-region branch was successfully pulled + ))) + + + +(defun undo-tree-adjust-elements-to-elt (node undo-elt &optional below) + "Adjust buffer positions of undo elements, starting at NODE's +and going up the tree (or down the active branch if BELOW is +non-nil) and through the nodes' undo elements until we reach +UNDO-ELT. UNDO-ELT must appear somewhere in the undo changeset +of either NODE itself or some node above it in the tree." + (let ((delta (list (undo-delta undo-elt))) + (undo-list (undo-tree-node-undo node))) + ;; adjust elements until we reach UNDO-ELT + (while (and (car undo-list) + (not (eq (car undo-list) undo-elt))) + (setcar undo-list + (undo-tree-apply-deltas (car undo-list) delta -1)) + ;; move to next undo element in list, or to next node if we've run out + ;; of elements + (unless (car (setq undo-list (cdr undo-list))) + (if below + (setq node (nth (undo-tree-node-branch node) + (undo-tree-node-next node))) + (setq node (undo-tree-node-previous node))) + (setq undo-list (undo-tree-node-undo node)))))) + + + +(defun undo-tree-apply-deltas (undo-elt deltas &optional sgn) + ;; Apply DELTAS in order to UNDO-ELT, multiplying deltas by SGN + ;; (only useful value for SGN is -1). + (let (position offset) + (dolist (delta deltas) + (setq position (car delta) + offset (* (cdr delta) (or sgn 1))) + (cond + ;; POSITION + ((integerp undo-elt) + (when (>= undo-elt position) + (setq undo-elt (- undo-elt offset)))) + ;; nil (or any other atom) + ((atom undo-elt)) + ;; (TEXT . POSITION) + ((stringp (car undo-elt)) + (let ((text-pos (abs (cdr undo-elt))) + (point-at-end (< (cdr undo-elt) 0))) + (if (>= text-pos position) + (setcdr undo-elt (* (if point-at-end -1 1) + (- text-pos offset)))))) + ;; (BEGIN . END) + ((integerp (car undo-elt)) + (when (>= (car undo-elt) position) + (setcar undo-elt (- (car undo-elt) offset)) + (setcdr undo-elt (- (cdr undo-elt) offset)))) + ;; (nil PROPERTY VALUE BEG . END) + ((null (car undo-elt)) + (let ((tail (nthcdr 3 undo-elt))) + (when (>= (car tail) position) + (setcar tail (- (car tail) offset)) + (setcdr tail (- (cdr tail) offset))))) + )) + undo-elt)) + + + +(defun undo-tree-repeated-undo-in-region-p (start end) + ;; Return non-nil if undo-in-region between START and END is a repeated + ;; undo-in-region + (let ((node (undo-tree-current buffer-undo-tree))) + (and (setq node + (nth (undo-tree-node-branch node) (undo-tree-node-next node))) + (eq (undo-tree-node-undo-beginning node) start) + (eq (undo-tree-node-undo-end node) end)))) + + +(defun undo-tree-repeated-redo-in-region-p (start end) + ;; Return non-nil if undo-in-region between START and END is a repeated + ;; undo-in-region + (let ((node (undo-tree-current buffer-undo-tree))) + (and (eq (undo-tree-node-redo-beginning node) start) + (eq (undo-tree-node-redo-end node) end)))) + + +;; Return non-nil if undo-in-region between START and END is simply +;; reverting the last redo-in-region +(defalias 'undo-tree-reverting-undo-in-region-p + 'undo-tree-repeated-undo-in-region-p) + + +;; Return non-nil if redo-in-region between START and END is simply +;; reverting the last undo-in-region +(defalias 'undo-tree-reverting-redo-in-region-p + 'undo-tree-repeated-redo-in-region-p) + + + + +;;; ===================================================================== +;;; Undo-tree commands + +(define-minor-mode undo-tree-mode + "Toggle undo-tree mode. +With no argument, this command toggles the mode. +A positive prefix argument turns the mode on. +A negative prefix argument turns it off. + +Undo-tree-mode replaces Emacs' standard undo feature with a more +powerful yet easier to use version, that treats the undo history +as what it is: a tree. + +The following keys are available in `undo-tree-mode': + + \\{undo-tree-map} + +Within the undo-tree visualizer, the following keys are available: + + \\{undo-tree-visualizer-map}" + + nil ; init value + undo-tree-mode-lighter ; lighter + undo-tree-map ; keymap + ;; if disabling `undo-tree-mode', rebuild `buffer-undo-list' from tree so + ;; Emacs undo can work + (unless undo-tree-mode + (undo-list-rebuild-from-tree) + (setq buffer-undo-tree nil))) + + +(defun turn-on-undo-tree-mode () + "Enable undo-tree-mode." + (undo-tree-mode 1)) + + +(define-globalized-minor-mode global-undo-tree-mode + undo-tree-mode turn-on-undo-tree-mode) + + + +(defun undo-tree-undo (&optional arg preserve-redo) + "Undo changes. +Repeat this command to undo more changes. +A numeric ARG serves as a repeat count. + +In Transient Mark mode when the mark is active, only undo changes +within the current region. Similarly, when not in Transient Mark +mode, just \\[universal-argument] as an argument limits undo to +changes within the current region. + +A non-nil PRESERVE-REDO causes the existing redo record to be +preserved, rather than replacing it with the new one generated by +undoing." + (interactive "*P") + ;; throw error if undo is disabled in buffer + (when (eq buffer-undo-list t) (error "No undo information in this buffer")) + + (let ((undo-in-progress t) + (undo-in-region (or (region-active-p) (and arg (not (numberp arg))))) + pos current) + ;; transfer entries accumulated in `buffer-undo-list' to + ;; `buffer-undo-tree' + (undo-list-transfer-to-tree) + + (dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1)) + ;; check if at top of undo tree + (unless (undo-tree-node-previous (undo-tree-current buffer-undo-tree)) + (error "No further undo information")) + + ;; if region is active, or a non-numeric prefix argument was supplied, + ;; try to pull out a new branch of changes affecting the region + (when (and undo-in-region + (not (undo-tree-pull-undo-in-region-branch + (region-beginning) (region-end)))) + (error "No further undo information for region")) + + ;; remove any GC'd elements from node's undo list + (setq current (undo-tree-current buffer-undo-tree)) + (decf (undo-tree-size buffer-undo-tree) + (undo-list-byte-size (undo-tree-node-undo current))) + (setf (undo-tree-node-undo current) + (undo-list-clean-GCd-elts (undo-tree-node-undo current))) + (incf (undo-tree-size buffer-undo-tree) + (undo-list-byte-size (undo-tree-node-undo current))) + ;; undo one record from undo tree + (when undo-in-region + (setq pos (set-marker (make-marker) (point))) + (set-marker-insertion-type pos t)) + (primitive-undo 1 (undo-tree-copy-list (undo-tree-node-undo current))) + (undo-boundary) + + ;; if preserving old redo record, discard new redo entries that + ;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd + ;; elements from node's redo list + (if preserve-redo + (progn + (undo-list-pop-changeset) + (decf (undo-tree-size buffer-undo-tree) + (undo-list-byte-size (undo-tree-node-redo current))) + (setf (undo-tree-node-redo current) + (undo-list-clean-GCd-elts (undo-tree-node-redo current))) + (incf (undo-tree-size buffer-undo-tree) + (undo-list-byte-size (undo-tree-node-redo current)))) + ;; otherwise, record redo entries that `primitive-undo' has added to + ;; `buffer-undo-list' in current node's redo record, replacing + ;; existing entry if one already exists + (when (undo-tree-node-redo current) + (decf (undo-tree-size buffer-undo-tree) + (undo-list-byte-size (undo-tree-node-redo current)))) + (setf (undo-tree-node-redo current) (undo-list-pop-changeset)) + (incf (undo-tree-size buffer-undo-tree) + (undo-list-byte-size (undo-tree-node-redo current)))) + + ;; rewind current node and update timestamp + (setf (undo-tree-current buffer-undo-tree) + (undo-tree-node-previous (undo-tree-current buffer-undo-tree)) + (undo-tree-node-timestamp (undo-tree-current buffer-undo-tree)) + (current-time)) + + ;; if undoing-in-region, record current node, region and direction so we + ;; can tell if undo-in-region is repeated, and re-activate mark if in + ;; `transient-mark-mode'; if not, erase any leftover data + (if (not undo-in-region) + (undo-tree-node-clear-region-data current) + (goto-char pos) + ;; note: we deliberately want to store the region information in the + ;; node *below* the now current one + (setf (undo-tree-node-undo-beginning current) (region-beginning) + (undo-tree-node-undo-end current) (region-end)) + (set-marker pos nil))) + + ;; undo deactivates mark unless undoing-in-region + (setq deactivate-mark (not undo-in-region)) + ;; inform user if at branch point + (when (> (undo-tree-num-branches) 1) (message "Undo branch point!")))) + + + +(defun undo-tree-redo (&optional arg preserve-undo) + "Redo changes. A numeric ARG serves as a repeat count. + +In Transient Mark mode when the mark is active, only redo changes +within the current region. Similarly, when not in Transient Mark +mode, just \\[universal-argument] as an argument limits redo to +changes within the current region. + +A non-nil PRESERVE-UNDO causes the existing undo record to be +preserved, rather than replacing it with the new one generated by +redoing." + (interactive "p") + ;; throw error if undo is disabled in buffer + (when (eq buffer-undo-list t) (error "No undo information in this buffer")) + + (let ((undo-in-progress t) + (redo-in-region (or (region-active-p) (and arg (not (numberp arg))))) + pos current) + ;; transfer entries accumulated in `buffer-undo-list' to + ;; `buffer-undo-tree' + (undo-list-transfer-to-tree) + + (dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1)) + ;; check if at bottom of undo tree + (when (null (undo-tree-node-next (undo-tree-current buffer-undo-tree))) + (error "No further redo information")) + + ;; if region is active, or a non-numeric prefix argument was supplied, + ;; try to pull out a new branch of changes affecting the region + (when (and redo-in-region + (not (undo-tree-pull-redo-in-region-branch + (region-beginning) (region-end)))) + (error "No further redo information for region")) + + ;; advance current node + (setq current (undo-tree-current buffer-undo-tree) + current (setf (undo-tree-current buffer-undo-tree) + (nth (undo-tree-node-branch current) + (undo-tree-node-next current)))) + ;; remove any GC'd elements from node's redo list + (decf (undo-tree-size buffer-undo-tree) + (undo-list-byte-size (undo-tree-node-redo current))) + (setf (undo-tree-node-redo current) + (undo-list-clean-GCd-elts (undo-tree-node-redo current))) + (incf (undo-tree-size buffer-undo-tree) + (undo-list-byte-size (undo-tree-node-redo current))) + ;; redo one record from undo tree + (when redo-in-region + (setq pos (set-marker (make-marker) (point))) + (set-marker-insertion-type pos t)) + (primitive-undo 1 (undo-tree-copy-list (undo-tree-node-redo current))) + (undo-boundary) + + ;; if preserving old undo record, discard new undo entries that + ;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd + ;; elements from node's redo list + (if preserve-undo + (progn + (undo-list-pop-changeset) + (decf (undo-tree-size buffer-undo-tree) + (undo-list-byte-size (undo-tree-node-undo current))) + (setf (undo-tree-node-undo current) + (undo-list-clean-GCd-elts (undo-tree-node-undo current))) + (incf (undo-tree-size buffer-undo-tree) + (undo-list-byte-size (undo-tree-node-undo current)))) + ;; otherwise, record undo entries that `primitive-undo' has added to + ;; `buffer-undo-list' in current node's undo record, replacing + ;; existing entry if one already exists + (when (undo-tree-node-undo current) + (decf (undo-tree-size buffer-undo-tree) + (undo-list-byte-size (undo-tree-node-undo current)))) + (setf (undo-tree-node-undo current) (undo-list-pop-changeset)) + (incf (undo-tree-size buffer-undo-tree) + (undo-list-byte-size (undo-tree-node-undo current)))) + + ;; update timestamp + (setf (undo-tree-node-timestamp current) (current-time)) + + ;; if redoing-in-region, record current node, region and direction so we + ;; can tell if redo-in-region is repeated, and re-activate mark if in + ;; `transient-mark-mode' + (if (not redo-in-region) + (undo-tree-node-clear-region-data current) + (goto-char pos) + (setf (undo-tree-node-redo-beginning current) (region-beginning) + (undo-tree-node-redo-end current) (region-end)) + (set-marker pos nil))) + + ;; redo deactivates the mark unless redoing-in-region + (setq deactivate-mark (not redo-in-region)) + ;; inform user if at branch point + (when (> (undo-tree-num-branches) 1) (message "Undo branch point!")))) + + + +(defun undo-tree-switch-branch (branch) + "Switch to a different BRANCH of the undo tree. +This will affect which branch to descend when *redoing* changes +using `undo-tree-redo'." + (interactive (list (or (and prefix-arg (prefix-numeric-value prefix-arg)) + (and (not (eq buffer-undo-list t)) + (or (undo-list-transfer-to-tree) t) + (> (undo-tree-num-branches) 1) + (read-number + (format "Branch (0-%d): " + (1- (undo-tree-num-branches)))))))) + ;; throw error if undo is disabled in buffer + (when (eq buffer-undo-list t) (error "No undo information in this buffer")) + ;; sanity check branch number + (when (<= (undo-tree-num-branches) 1) (error "Not at undo branch point")) + (when (or (< branch 0) (> branch (1- (undo-tree-num-branches)))) + (error "Invalid branch number")) + ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree' + (undo-list-transfer-to-tree) + ;; switch branch + (setf (undo-tree-node-branch (undo-tree-current buffer-undo-tree)) + branch)) + + +(defun undo-tree-set (node) + ;; Set buffer to state corresponding to NODE. Returns intersection point + ;; between path back from current node and path back from selected NODE. + (let ((path (make-hash-table :test 'eq)) + (n node)) + (puthash (undo-tree-root buffer-undo-tree) t path) + ;; build list of nodes leading back from selected node to root, updating + ;; branches as we go to point down to selected node + (while (progn + (puthash n t path) + (when (undo-tree-node-previous n) + (setf (undo-tree-node-branch (undo-tree-node-previous n)) + (undo-tree-position + n (undo-tree-node-next (undo-tree-node-previous n)))) + (setq n (undo-tree-node-previous n))))) + ;; work backwards from current node until we intersect path back from + ;; selected node + (setq n (undo-tree-current buffer-undo-tree)) + (while (not (gethash n path)) + (setq n (undo-tree-node-previous n))) + ;; ascend tree until intersection node + (while (not (eq (undo-tree-current buffer-undo-tree) n)) + (undo-tree-undo)) + ;; descend tree until selected node + (while (not (eq (undo-tree-current buffer-undo-tree) node)) + (undo-tree-redo)) + n)) ; return intersection node + + + +(defun undo-tree-save-state-to-register (register) + "Store current undo-tree state to REGISTER. +The saved state can be restored using +`undo-tree-restore-state-from-register'. +Argument is a character, naming the register." + (interactive "cUndo-tree state to register: ") + ;; throw error if undo is disabled in buffer + (when (eq buffer-undo-list t) (error "No undo information in this buffer")) + ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree' + (undo-list-transfer-to-tree) + ;; save current node to REGISTER + (set-register register (undo-tree-current buffer-undo-tree)) + ;; record REGISTER in current node, for visualizer + (setf (undo-tree-node-register (undo-tree-current buffer-undo-tree)) + register)) + + + +(defun undo-tree-restore-state-from-register (register) + "Restore undo-tree state from REGISTER. +The state must be saved using `undo-tree-save-state-to-register'. +Argument is a character, naming the register." + (interactive "cRestore undo-tree state from register: ") + ;; throw error if undo is disabled in buffer, or if register doesn't contain + ;; an undo-tree node + (let ((node (get-register register))) + (cond + ((eq buffer-undo-list t) + (error "No undo information in this buffer")) + ((not (undo-tree-node-p node)) + (error "Register doesn't contain undo-tree state"))) + ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree' + (undo-list-transfer-to-tree) + ;; restore buffer state corresponding to saved node + (undo-tree-set node))) + + + + +;;; ===================================================================== +;;; Undo-tree visualizer + +(defun undo-tree-visualize () + "Visualize the current buffer's undo tree." + (interactive) + (deactivate-mark) + ;; throw error if undo is disabled in buffer + (when (eq buffer-undo-list t) (error "No undo information in this buffer")) + ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree' + (undo-list-transfer-to-tree) + ;; add hook to kill visualizer buffer if original buffer is changed + (add-hook 'before-change-functions 'undo-tree-kill-visualizer nil t) + ;; prepare *undo-tree* buffer, then draw tree in it + (let ((undo-tree buffer-undo-tree) + (buff (current-buffer)) + (display-buffer-mark-dedicated 'soft)) + (switch-to-buffer-other-window undo-tree-visualizer-buffer-name) + (undo-tree-visualizer-mode) + (setq undo-tree-visualizer-parent-buffer buff) + (setq buffer-undo-tree undo-tree) + (setq buffer-read-only nil) + (undo-tree-draw-tree undo-tree) + (setq buffer-read-only t))) + + +(defun undo-tree-kill-visualizer (&rest dummy) + ;; Kill visualizer. Added to `before-change-functions' hook of original + ;; buffer when visualizer is invoked. + (unless undo-in-progress + (unwind-protect + (with-current-buffer undo-tree-visualizer-buffer-name + (undo-tree-visualizer-quit))))) + + + +(defun undo-tree-draw-tree (undo-tree) + ;; Draw UNDO-TREE in current buffer. + (erase-buffer) + (undo-tree-move-down 1) ; top margin + (undo-tree-clear-visualizer-data undo-tree) + (undo-tree-compute-widths undo-tree) + (undo-tree-move-forward + (max (/ (window-width) 2) + (+ (undo-tree-node-char-lwidth (undo-tree-root undo-tree)) + ;; add space for left part of left-most time-stamp + (if undo-tree-visualizer-timestamps 4 0) + 2))) ; left margin + ;; draw undo-tree + (let ((undo-tree-insert-face 'undo-tree-visualizer-default-face) + (stack (list (undo-tree-root undo-tree))) + (n (undo-tree-root undo-tree))) + ;; link root node to its representation in visualizer + (unless (markerp (undo-tree-node-marker n)) + (setf (undo-tree-node-marker n) (make-marker)) + (set-marker-insertion-type (undo-tree-node-marker n) nil)) + (move-marker (undo-tree-node-marker n) (point)) + ;; draw nodes from stack until stack is empty + (while stack + (setq n (pop stack)) + (goto-char (undo-tree-node-marker n)) + (setq n (undo-tree-draw-subtree n nil)) + (setq stack (append stack n)))) + ;; highlight active branch + (goto-char (undo-tree-node-marker (undo-tree-root undo-tree))) + (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)) + (undo-tree-highlight-active-branch (undo-tree-root undo-tree))) + ;; highlight current node + (undo-tree-draw-node (undo-tree-current undo-tree) 'current)) + + +(defun undo-tree-highlight-active-branch (node) + ;; Draw highlighted active branch below NODE in current buffer. + (let ((stack (list node))) + ;; link node to its representation in visualizer + (unless (markerp (undo-tree-node-marker node)) + (setf (undo-tree-node-marker node) (make-marker)) + (set-marker-insertion-type (undo-tree-node-marker node) nil)) + (move-marker (undo-tree-node-marker node) (point)) + ;; draw active branch + (while stack + (setq node (pop stack)) + (goto-char (undo-tree-node-marker node)) + (setq node (undo-tree-draw-subtree node 'active)) + (setq stack (append stack node))))) + + +(defun undo-tree-draw-node (node &optional current) + ;; Draw symbol representing NODE in visualizer. + (goto-char (undo-tree-node-marker node)) + ;; if displaying timestamps, represent node by timestamp + (if undo-tree-visualizer-timestamps + (progn + (backward-char 4) + (if current (undo-tree-insert ?*) (undo-tree-insert ? )) + (undo-tree-insert + (undo-tree-timestamp-to-string (undo-tree-node-timestamp node))) + (backward-char 5) + (move-marker (undo-tree-node-marker node) (point)) + (put-text-property (- (point) 3) (+ (point) 5) + 'undo-tree-node node)) + ;; represent node by differentl symbols, depending on whether it's the + ;; current node or is saved in a register + (let ((register (undo-tree-node-register node))) + (cond + (current + (let ((undo-tree-insert-face + (cons 'undo-tree-visualizer-current-face + (and (boundp 'undo-tree-insert-face) + (or (and (consp undo-tree-insert-face) + undo-tree-insert-face) + (list undo-tree-insert-face)))))) + (undo-tree-insert ?x))) + ((and register (eq node (get-register register))) + (let ((undo-tree-insert-face + (cons 'undo-tree-visualizer-register-face + (and (boundp 'undo-tree-insert-face) + (or (and (consp undo-tree-insert-face) + undo-tree-insert-face) + (list undo-tree-insert-face)))))) + (undo-tree-insert register))) + (t (undo-tree-insert ?o)))) + (backward-char 1) + (put-text-property (point) (1+ (point)) 'undo-tree-node node))) + + +(defun undo-tree-draw-subtree (node &optional active-branch) + ;; Draw subtree rooted at NODE. The subtree will start from point. + ;; If ACTIVE-BRANCH is non-nil, just draw active branch below NODE. + ;; If TIMESTAP is non-nil, draw time-stamps instead of "o" at nodes. + (let ((num-children (length (undo-tree-node-next node))) + node-list pos trunk-pos n) + ;; draw node itself + (undo-tree-draw-node node) + + (cond + ;; if we're at a leaf node, we're done + ((= num-children 0)) + + ;; if node has only one child, draw it (not strictly necessary to deal + ;; with this case separately, but as it's by far the most common case + ;; this makes the code clearer and more efficient) + ((= num-children 1) + (undo-tree-move-down 1) + (undo-tree-insert ?|) + (backward-char 1) + (undo-tree-move-down 1) + (undo-tree-insert ?|) + (backward-char 1) + (undo-tree-move-down 1) + (setq n (car (undo-tree-node-next node))) + ;; link next node to its representation in visualizer + (unless (markerp (undo-tree-node-marker n)) + (setf (undo-tree-node-marker n) (make-marker)) + (set-marker-insertion-type (undo-tree-node-marker n) nil)) + (move-marker (undo-tree-node-marker n) (point)) + ;; add next node to list of nodes to draw next + (push n node-list)) + + ;; if node had multiple children, draw branches + (t + (undo-tree-move-down 1) + (undo-tree-insert ?|) + (backward-char 1) + (setq trunk-pos (point)) + ;; left subtrees + (backward-char + (- (undo-tree-node-char-lwidth node) + (undo-tree-node-char-lwidth + (car (undo-tree-node-next node))))) + (setq pos (point)) + (setq n (cons nil (undo-tree-node-next node))) + (dotimes (i (/ num-children 2)) + (setq n (cdr n)) + (when (or (null active-branch) + (eq (car n) + (nth (undo-tree-node-branch node) + (undo-tree-node-next node)))) + (undo-tree-move-forward 2) + (undo-tree-insert ?_ (- trunk-pos pos 2)) + (goto-char pos) + (undo-tree-move-forward 1) + (undo-tree-move-down 1) + (undo-tree-insert ?/) + (backward-char 2) + (undo-tree-move-down 1) + ;; link node to its representation in visualizer + (unless (markerp (undo-tree-node-marker (car n))) + (setf (undo-tree-node-marker (car n)) (make-marker)) + (set-marker-insertion-type (undo-tree-node-marker (car n)) nil)) + (move-marker (undo-tree-node-marker (car n)) (point)) + ;; add node to list of nodes to draw next + (push (car n) node-list)) + (goto-char pos) + (undo-tree-move-forward + (+ (undo-tree-node-char-rwidth (car n)) + (undo-tree-node-char-lwidth (cadr n)) + undo-tree-visualizer-spacing 1)) + (setq pos (point))) + ;; middle subtree (only when number of children is odd) + (when (= (mod num-children 2) 1) + (setq n (cdr n)) + (when (or (null active-branch) + (eq (car n) + (nth (undo-tree-node-branch node) + (undo-tree-node-next node)))) + (undo-tree-move-down 1) + (undo-tree-insert ?|) + (backward-char 1) + (undo-tree-move-down 1) + ;; link node to its representation in visualizer + (unless (markerp (undo-tree-node-marker (car n))) + (setf (undo-tree-node-marker (car n)) (make-marker)) + (set-marker-insertion-type (undo-tree-node-marker (car n)) nil)) + (move-marker (undo-tree-node-marker (car n)) (point)) + ;; add node to list of nodes to draw next + (push (car n) node-list)) + (goto-char pos) + (undo-tree-move-forward + (+ (undo-tree-node-char-rwidth (car n)) + (if (cadr n) (undo-tree-node-char-lwidth (cadr n)) 0) + undo-tree-visualizer-spacing 1)) + (setq pos (point))) + ;; right subtrees + (incf trunk-pos) + (dotimes (i (/ num-children 2)) + (setq n (cdr n)) + (when (or (null active-branch) + (eq (car n) + (nth (undo-tree-node-branch node) + (undo-tree-node-next node)))) + (goto-char trunk-pos) + (undo-tree-insert ?_ (- pos trunk-pos 1)) + (goto-char pos) + (backward-char 1) + (undo-tree-move-down 1) + (undo-tree-insert ?\\) + (undo-tree-move-down 1) + ;; link node to its representation in visualizer + (unless (markerp (undo-tree-node-marker (car n))) + (setf (undo-tree-node-marker (car n)) (make-marker)) + (set-marker-insertion-type (undo-tree-node-marker (car n)) nil)) + (move-marker (undo-tree-node-marker (car n)) (point)) + ;; add node to list of nodes to draw next + (push (car n) node-list)) + (when (cdr n) + (goto-char pos) + (undo-tree-move-forward + (+ (undo-tree-node-char-rwidth (car n)) + (if (cadr n) (undo-tree-node-char-lwidth (cadr n)) 0) + undo-tree-visualizer-spacing 1)) + (setq pos (point)))) + )) + ;; return list of nodes to draw next + (nreverse node-list))) + + + +(defun undo-tree-node-char-lwidth (node) + ;; Return left-width of NODE measured in characters. + (if (= (length (undo-tree-node-next node)) 0) 0 + (- (* (+ undo-tree-visualizer-spacing 1) (undo-tree-node-lwidth node)) + (if (= (undo-tree-node-cwidth node) 0) + (1+ (/ undo-tree-visualizer-spacing 2)) 0)))) + + +(defun undo-tree-node-char-rwidth (node) + ;; Return right-width of NODE measured in characters. + (if (= (length (undo-tree-node-next node)) 0) 0 + (- (* (+ undo-tree-visualizer-spacing 1) (undo-tree-node-rwidth node)) + (if (= (undo-tree-node-cwidth node) 0) + (1+ (/ undo-tree-visualizer-spacing 2)) 0)))) + + +(defun undo-tree-insert (str &optional arg) + ;; Insert character or string STR ARG times, overwriting, and using + ;; `undo-tree-insert-face'. + (unless arg (setq arg 1)) + (when (characterp str) + (setq str (make-string arg str)) + (setq arg 1)) + (dotimes (i arg) (insert str)) + (setq arg (* arg (length str))) + (undo-tree-move-forward arg) + ;; make sure mark isn't active, otherwise `backward-delete-char' might + ;; delete region instead of single char if transient-mark-mode is enabled + (setq mark-active nil) + (backward-delete-char arg) + (when (boundp 'undo-tree-insert-face) + (put-text-property (- (point) arg) (point) 'face undo-tree-insert-face))) + + +(defun undo-tree-move-down (&optional arg) + ;; Move down, extending buffer if necessary. + (let ((row (line-number-at-pos)) + (col (current-column)) + line) + (unless arg (setq arg 1)) + (forward-line arg) + (setq line (line-number-at-pos)) + ;; if buffer doesn't have enough lines, add some + (when (/= line (+ row arg)) + (insert (make-string (- arg (- line row)) ?\n))) + (undo-tree-move-forward col))) + + +(defun undo-tree-move-forward (&optional arg) + ;; Move forward, extending buffer if necessary. + (unless arg (setq arg 1)) + (let ((n (- (line-end-position) (point)))) + (if (> n arg) + (forward-char arg) + (end-of-line) + (insert (make-string (- arg n) ? ))))) + + +(defun undo-tree-timestamp-to-string (timestamp) + ;; Convert TIMESTAMP to hh:mm:ss string. + (let ((time (decode-time timestamp))) + (format "%02d:%02d:%02d" (nth 2 time) (nth 1 time) (nth 0 time)))) + + + + +;;; ===================================================================== +;;; Visualizer mode commands + +(defun undo-tree-visualizer-mode () + "Major mode used in undo-tree visualizer. + +The undo-tree visualizer can only be invoked from a buffer in +which `undo-tree-mode' is enabled. The visualizer displays the +undo history tree graphically, and allows you to browse around +the undo history, undoing or redoing the corresponding changes in +the parent buffer. + +Within the undo-tree visualizer, the following keys are available: + + \\{undo-tree-visualizer-map}" + (interactive) + (setq major-mode 'undo-tree-visualizer-mode) + (setq mode-name "undo-tree-visualizer-mode") + (use-local-map undo-tree-visualizer-map) + (setq truncate-lines t) + (setq cursor-type nil) + (setq buffer-read-only t)) + + + +(defun undo-tree-visualize-undo (&optional arg) + "Undo changes. A numeric ARG serves as a repeat count." + (interactive "p") + (setq buffer-read-only nil) + (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)) + (undo-tree-draw-node (undo-tree-current buffer-undo-tree))) + (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer) + (deactivate-mark) + (unwind-protect + (undo-tree-undo arg) + (switch-to-buffer-other-window undo-tree-visualizer-buffer-name) + (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current) + (setq buffer-read-only t))) + + +(defun undo-tree-visualize-redo (&optional arg) + "Redo changes. A numeric ARG serves as a repeat count." + (interactive "p") + (setq buffer-read-only nil) + (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)) + (undo-tree-draw-node (undo-tree-current buffer-undo-tree))) + (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer) + (deactivate-mark) + (unwind-protect + (undo-tree-redo arg) + (switch-to-buffer-other-window undo-tree-visualizer-buffer-name) + (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree))) + (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current) + (setq buffer-read-only t))) + + +(defun undo-tree-visualize-switch-branch-right (arg) + "Switch to next branch of the undo tree. +This will affect which branch to descend when *redoing* changes +using `undo-tree-redo' or `undo-tree-visualizer-redo'." + (interactive "p") + ;; un-highlight old active branch below current node + (setq buffer-read-only nil) + (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree))) + (let ((undo-tree-insert-face 'undo-tree-visualizer-default-face)) + (undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree))) + ;; increment branch + (let ((branch (undo-tree-node-branch (undo-tree-current buffer-undo-tree)))) + (setf (undo-tree-node-branch (undo-tree-current buffer-undo-tree)) + (cond + ((>= (+ branch arg) (undo-tree-num-branches)) + (1- (undo-tree-num-branches))) + ((<= (+ branch arg) 0) 0) + (t (+ branch arg)))) + ;; highlight new active branch below current node + (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree))) + (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)) + (undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree))) + ;; re-highlight current node + (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current) + (setq buffer-read-only t))) + + +(defun undo-tree-visualize-switch-branch-left (arg) + "Switch to previous branch of the undo tree. +This will affect which branch to descend when *redoing* changes +using `undo-tree-redo' or `undo-tree-visualizer-redo'." + (interactive "p") + (undo-tree-visualize-switch-branch-right (- arg))) + + +(defun undo-tree-visualizer-quit () + "Quit the undo-tree visualizer." + (interactive) + (undo-tree-clear-visualizer-data buffer-undo-tree) + ;; remove kill visualizer hook from parent buffer + (unwind-protect + (with-current-buffer undo-tree-visualizer-parent-buffer + (remove-hook 'before-change-functions 'undo-tree-kill-visualizer t)) + (let ((parent undo-tree-visualizer-parent-buffer) + window) + (kill-buffer nil) + (if (setq window (get-buffer-window parent)) + (select-window window) + (switch-to-buffer parent))))) + + +(defun undo-tree-visualizer-set (&optional pos) + "Set buffer to state corresponding to undo tree node +at POS, or point if POS is nil." + (interactive) + (unless pos (setq pos (point))) + (let ((node (get-text-property pos 'undo-tree-node))) + (when node + ;; set parent buffer to state corresponding to node at POS + (set-buffer undo-tree-visualizer-parent-buffer) + (undo-tree-set node) + (set-buffer undo-tree-visualizer-buffer-name) + (setq buffer-read-only nil) + ;; re-draw undo tree + (undo-tree-draw-tree buffer-undo-tree) + (setq buffer-read-only t)))) + + +(defun undo-tree-visualizer-mouse-set (pos) + "Set buffer to state corresponding to undo tree node +at mouse event POS." + (interactive "@e") + (undo-tree-visualizer-set (event-start (nth 1 pos)))) + + +(defun undo-tree-visualizer-toggle-timestamps () + "Toggle display of time-stamps." + (interactive) + (setq undo-tree-visualizer-spacing + (if (setq undo-tree-visualizer-timestamps + (not undo-tree-visualizer-timestamps)) + ;; need sufficient space if TIMESTAMP is set + (max 9 (default-value 'undo-tree-visualizer-spacing)) + (default-value 'undo-tree-visualizer-spacing))) + ;; redraw tree + (setq buffer-read-only nil) + (undo-tree-draw-tree buffer-undo-tree) + (setq buffer-read-only t)) + + +(defun undo-tree-visualizer-scroll-left (&optional arg) + (interactive "p") + (scroll-right (or arg 1) t)) + + +(defun undo-tree-visualizer-scroll-right (&optional arg) + (interactive "p") + (scroll-left (or arg 1) t)) + + + + +;;; ===================================================================== +;;; Visualizer selection mode + +(defun undo-tree-visualizer-selection-mode () + "Major mode used to select nodes in undo-tree visualizer." + (interactive) + (setq major-mode 'undo-tree-visualizer-selection-mode) + (setq mode-name "undo-tree-visualizer-selection-mode") + (use-local-map undo-tree-visualizer-selection-map) + (setq cursor-type 'box)) + + +(defun undo-tree-visualizer-select-previous (&optional arg) + "Move to previous node." + (interactive "p") + (let ((node (get-text-property (point) 'undo-tree-node))) + (catch 'top + (dotimes (i arg) + (unless (undo-tree-node-previous node) (throw 'top t)) + (setq node (undo-tree-node-previous node)))) + (goto-char (undo-tree-node-marker node)))) + + +(defun undo-tree-visualizer-select-next (&optional arg) + "Move to next node." + (interactive "p") + (let ((node (get-text-property (point) 'undo-tree-node))) + (catch 'bottom + (dotimes (i arg) + (unless (nth (undo-tree-node-branch node) (undo-tree-node-next node)) + (throw 'bottom t)) + (setq node + (nth (undo-tree-node-branch node) (undo-tree-node-next node))))) + (goto-char (undo-tree-node-marker node)))) + + +(defun undo-tree-visualizer-select-right (&optional arg) + "Move right to a sibling node." + (interactive "p") + (let ((pos (point)) + (end (line-end-position)) + node) + (catch 'end + (dotimes (i arg) + (while (not node) + (forward-char) + (setq node (get-text-property (point) 'undo-tree-node)) + (when (= (point) end) (throw 'end t))))) + (goto-char (if node (undo-tree-node-marker node) pos)))) + + +(defun undo-tree-visualizer-select-left (&optional arg) + "Move left to a sibling node." + (interactive "p") + (let ((pos (point)) + (beg (line-beginning-position)) + node) + (catch 'beg + (dotimes (i arg) + (while (not node) + (backward-char) + (setq node (get-text-property (point) 'undo-tree-node)) + (when (= (point) beg) (throw 'beg t))))) + (goto-char (if node (undo-tree-node-marker node) pos)))) + + + +(provide 'undo-tree) + +;;; undo-tree.el ends here |
