[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/evil-goggles d3ad932a1c 208/225: Merge branch 'use-before-
From: |
ELPA Syncer |
Subject: |
[nongnu] elpa/evil-goggles d3ad932a1c 208/225: Merge branch 'use-before-advice' |
Date: |
Wed, 12 Jan 2022 08:59:09 -0500 (EST) |
branch: elpa/evil-goggles
commit d3ad932a1cb9a494d2b3b50ffb7451b7d55ad219
Merge: 57f45c2582 77a8bb1785
Author: Evgeni Kolev <evgenysw@gmail.com>
Commit: Evgeni Kolev <evgenysw@gmail.com>
Merge branch 'use-before-advice'
---
.travis.yml | 1 +
Makefile | 3 +
README.md | 4 +-
evil-goggles.el | 717 +++++++++++++++-------------------------------------
test/elpa.el | 3 +
test/make-update.el | 2 +-
6 files changed, 207 insertions(+), 523 deletions(-)
diff --git a/.travis.yml b/.travis.yml
index 659b84c42a..5f10473d1b 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -22,4 +22,5 @@ script:
- emacs=$EMACS make update
- emacs=$EMACS make compile
- emacs=$EMACS make test
+ - emacs=$EMACS make package-lint
- emacs=$EMACS make evil-test
diff --git a/Makefile b/Makefile
index 4d25017409..a73a3e08c9 100644
--- a/Makefile
+++ b/Makefile
@@ -12,6 +12,9 @@ compile: clean
test:
$(bemacs) -l test/make-test.el
+package-lint:
+ $(bemacs) -f package-lint-batch-and-exit evil-goggles.el
+
clean:
rm -f *.elc test/evil-tests.el test/evil-tests.el
diff --git a/README.md b/README.md
index 2e02975494..0dffb24a0b 100644
--- a/README.md
+++ b/README.md
@@ -60,7 +60,6 @@ try for example `yy`, `p`, `dd` in normal state.
- delete
- change
-- substitue
- yank
- paste
- indent (`=` operator)
@@ -113,7 +112,6 @@ evil-goggles-default-face - inherits from `region` by
default
evil-goggles-delete-face - this, and the others below, inherit from
`evil-goggles-default-face`
evil-goggles-change-face
-evil-goggles-substitute-face
evil-goggles-indent-face
evil-goggles-yank-face
evil-goggles-join-face
@@ -161,7 +159,6 @@ evil-goggles-record-macro-face
;;
;; evil-goggles-enable-delete
;; evil-goggles-enable-change
-;; evil-goggles-enable-substitute
;; evil-goggles-enable-indent
;; evil-goggles-enable-yank
;; evil-goggles-enable-join
@@ -180,6 +177,7 @@ evil-goggles-record-macro-face
## NEWS - Recent Significant Changes
+- [Jun 01, 2018] Refactor code to not use :around advice-s, which was a source
of edge-case-issues
- [Feb 05, 2018] Show hint on start/stop macro recording
- [Dec 02, 2017] Pulsing hints is no longer experimental
- [Nov 03, 2017] Add options `evil-goggles-async-duration` and
`evil-goggles-blocking-duration`
diff --git a/evil-goggles.el b/evil-goggles.el
index 5c228250a0..8741cc2e20 100644
--- a/evil-goggles.el
+++ b/evil-goggles.el
@@ -34,15 +34,6 @@
;;
;; (evil-goggles-mode)
;;
-;;; Internal APIs:
-;;
-;; These functions should be used for displaying hints:
-;;
-;; - evil-goggles--with-async-hint
-;; - evil-goggles--with-blocking-hint
-;; - evil-goggles--with-disabled-hint
-;; - evil-goggles--show-hint
-;;
;;; Code:
(require 'evil)
@@ -137,20 +128,6 @@ background of 'evil-goggles-default-face, then 'region."
(overlay-put ov (pop properties) (pop properties)))
ov))
-(defvar evil-goggles--on nil
- "When non-nil, the goggles overlay must not be displayed.
-
-Used to prevent displaying multiple overlays for the same command. For
-example, when the user executes `evil-delete', the overlay should be
-displayed, but when `evil-delete' calls internally `evil-yank', the
-overlay must not be re-displayed.")
-
-(defvar evil-goggles--force-block nil
- "When non-nil, force the hint about to be shown to be a block.")
-
-(defvar evil-goggles--hint-on-empty-lines nil
- "When nil, the default, function `evil-goggles--show-p' will not return t
for whitespace-only regions.")
-
(defun evil-goggles--show-p (beg end)
"Return t if the overlay should be displayed in region BEG to END."
(and (not evil-inhibit-operator-value)
@@ -166,10 +143,8 @@ overlay must not be re-displayed.")
(not (evil-insert-state-p))
;; don't show overlay when evil-mc has active cursors
(not (and (fboundp 'evil-mc-has-cursors-p) (evil-mc-has-cursors-p)))
- ;; don't show hint when the region has nothing but whitespace, but skip
this check if `evil-goggles--hint-on-empty-lines' is t
- (if evil-goggles--hint-on-empty-lines
- t
- (not (null (string-match-p "[^ \t\n]" (buffer-substring-no-properties
beg end)))))))
+ ;; don't show overlay when the region has only whitespace
+ (not (null (string-match-p "[^ \t\n]" (buffer-substring-no-properties
beg end))))))
(defun evil-goggles--overlay-insert-behind-hook (ov afterp beg end &optional
len)
"Function which grows/shriks the overlay OV when its text changes.
@@ -183,20 +158,6 @@ convention for the insert-behind-hooks overlay property."
(move-overlay ov (overlay-start ov) (+ len (overlay-end ov))))
(move-overlay ov (overlay-start ov) (- (overlay-end ov) len) ))))
-(defmacro evil-goggles--with-async-hint (beg end face &rest body)
- "Show hint from BEG to END with face FACE, do BODY with hint on.
-
-BODY is executed after the hint is displayed but before it's
-removed. As a result any changes BODY does on the text will be
-visualized by the hint.
-
-The hint is displayed for `evil-goggles-async-duration' seconds if
-non-nil, else for `evil-goggles-duration' seconds."
- (declare (indent 3) (debug t))
- `(evil-goggles--if-can-show-hint ,beg ,end (progn ,@body)
- (evil-goggles--show-overlay ,beg ,end ,face (or
evil-goggles-async-duration evil-goggles-duration)
- ,@body)))
-
(defun evil-goggles--show-or-pulse-overlay (ov face dur)
"Show or pulse overlay OV with face FACE.
@@ -237,38 +198,6 @@ This function returns a list - either ('blink face) or
('pulse bg)."
(t
`(blink ,face)))))
-(defmacro evil-goggles--if-can-show-hint (beg end body1 &rest body2)
- "Run one block of code if hint is visible, run the other if not.
-
-If hint is visible, check it's ok to display it from BEG to END. If
-it's not, do BODY1, else BODY2."
- (declare (indent 3) (debug t)) ;; TODO indent like `if'
- `(if (and (not evil-goggles--on) (evil-goggles--show-p ,beg ,end)
(called-interactively-p 'any))
- (let ((evil-goggles--on t))
- ,@body2)
- ,body1))
-
-(defmacro evil-goggles--with-disabled-hint (&rest body)
- "Do BODY with hints disabled."
- (declare (indent 0) (debug t))
- `(let ((evil-goggles--on t))
- ,@body))
-
-(defmacro evil-goggles--with-blocking-hint (beg end face &rest body)
- "Show hint from BEG to END with face FACE, hide it, then do BODY.
-
-BODY is executed after the hint has been removed, hence the hint is
-\"blocking\" because BODY won't run until the hint has disappeared.
-
-The hint is displayed for `evil-goggles-blocking-duration' seconds if
-non-nil, else for `evil-goggles-duration' seconds."
- (declare (indent 3) (debug t))
- `(evil-goggles--if-can-show-hint ,beg ,end (progn ,@body)
- (if (or (eq evil-this-type 'block) evil-goggles--force-block)
- (evil-goggles--show-block-overlay ,beg ,end ,face (or
evil-goggles-blocking-duration evil-goggles-duration))
- (evil-goggles--show-overlay ,beg ,end ,face (or
evil-goggles-blocking-duration evil-goggles-duration)))
- ,@body))
-
(defmacro evil-goggles--show-overlay (beg end face dur &rest body)
"Show overlay from BEG to END with face FACE for DUR seconds.
@@ -283,19 +212,6 @@ will be adjusted if BODY modifies the text in it."
(sit-for ,dur))
(delete-overlay ov))))
-(defun evil-goggles--show-hint (beg end face &optional force-vertical-hint
blocking)
- "Show hint from BEG to END with face FACE for DUR sec.
-
-The hint will be a vertical block if FORCE-VERTICAL-HINT is non-nil.
-If BLOCKING is non-nil, the hint will be treated like a blocking
-hint, i.e. it will be displayed for `evil-goggles-blocking-duration'
-rather than `evil-goggles-async-duration'"
- (if (or blocking force-vertical-hint)
- (let ((evil-goggles--force-block force-vertical-hint))
- ;; use blocking hint for vertial blocks, async hint doesn't support
vertial blocks
- (evil-goggles--with-blocking-hint beg end face))
- (evil-goggles--with-async-hint beg end face)))
-
(defun evil-goggles--show-block-overlay (beg end face dur)
"Show overlay from BEG to END with face FACE for DUR seconds.
@@ -316,20 +232,6 @@ Running code while the hint is on isn't supported."
(sit-for dur))
(mapcar 'delete-overlay ovs))))
-(defun evil-goggles--funcall-interactively (f &rest args)
- "Call F with ARGS interactively.
-
-This function mimics `funcall-interactively', available in Emacs 25,
-so this package can work with Emacs 24"
- (cl-letf (((symbol-function 'called-interactively-p) (lambda (_) t)))
- (apply f args)))
-
-(defmacro evil-goggles--funcall-preserve-interactive (fun &rest args)
- "Call FUN with ARGS with `funcall' or `funcall-interactively'."
- `(if (called-interactively-p 'any)
- (evil-goggles--funcall-interactively ,fun ,@args)
- (funcall ,fun ,@args)))
-
(defmacro evil-goggles--define-switch-and-face (switch-name switch-doc
face-name face-doc &optional off-by-default)
"Helper macro defining an on/off var, a face, and duration var.
@@ -339,7 +241,7 @@ FACE-NAME is the name of the custom face.
FACE-DOC is the docstring for FACE-NAME.
DUR-NAME is the name of the duration variable.
DUR-DOC is the docstring for DUR-NAME.
-OFF-BY-DEFAULT if non-nil will set the switch to `nil'"
+OFF-BY-DEFAULT if non-nil will set the switch to nil"
(declare (indent 7) (debug t))
`(progn
(defcustom ,switch-name ,(if off-by-default nil t)
@@ -391,56 +293,93 @@ OFF-BY-DEFAULT if non-nil will set the switch to `nil'"
'(evil-goggles-undo-redo-remove-face ((t (:inherit magit-diff-removed))))
'(evil-goggles-undo-redo-add-face ((t (:inherit magit-diff-added))))))
+;;; generic blocking advice
+
+(defun evil-goggles--show-blocking-hint (beg end &optional force-block)
+ "Show blocking hint from BEG to END.
+
+The hint will be a vertical block if `evil-this-type' is `block'. If
+FORCE-BLOCK is non-nil, the hint will always be a vertical block,
+regardless of the value of `evil-this-type'."
+ (let ((dur (or evil-goggles-blocking-duration evil-goggles-duration))
+ (face (evil-goggles--get-face this-command)))
+ (if (or (eq evil-this-type 'block) force-block)
+ (evil-goggles--show-block-overlay beg end face dur)
+ (evil-goggles--show-overlay beg end face dur))))
+
+(defun evil-goggles--generic-blocking-advice (beg end &rest _)
+ "Advice for interactive functions, show a blocing hint.
+
+This function is intended to be used as advice for interactive funs
+which take BEG and END as their first and second arguments."
+ (when (and (called-interactively-p 'interactive)
+ (evil-goggles--show-p beg end))
+ (evil-goggles--show-blocking-hint beg end)))
+
+;;; generic async advice
+
+(defvar evil-goggles--timer nil)
+(defvar evil-goggles--async-ov nil)
+
+(defun evil-goggles--vanish (&rest _)
+ "Remove the async overlay and cancel the timer."
+ (when (timerp evil-goggles--timer)
+ (cancel-timer evil-goggles--timer)
+ (setq evil-goggles--timer nil))
+ (when evil-goggles--async-ov
+ (delete-overlay evil-goggles--async-ov)
+ (setq evil-goggles--async-ov nil)))
+
+(defun evil-goggles--show-async-hint (beg end)
+ "Show blocking hint from BEG to END."
+ (let ((ov (evil-goggles--make-overlay beg end 'insert-behind-hooks
'(evil-goggles--overlay-insert-behind-hook)))
+ (dur (or evil-goggles-async-duration evil-goggles-duration))
+ (face (evil-goggles--get-face this-command)))
+ (unwind-protect
+ ;; show the overlay
+ (evil-goggles--show-or-pulse-overlay ov face dur)
+ ;; remove the overlay with a timer
+ (setq
+ evil-goggles--async-ov ov
+ evil-goggles--timer (run-at-time dur
+ nil
+ #'evil-goggles--vanish)))))
+
+(defun evil-goggles--generic-async-advice (beg end &rest _)
+ "Advice for interactive functions, show an async hint.
+
+This function is intended to be used as advice for interactive funs
+which take BEG and END as their first and second arguments."
+ (when (and (called-interactively-p 'interactive)
+ (evil-goggles--show-p beg end))
+ (evil-goggles--show-async-hint beg end)))
+
+(defun evil-goggles--generic-async-advice-1 (_ beg end &rest _rest)
+ "Advice for interactive functions, show an async hint.
+
+This function is intended to be used as advice for interactive funs
+which take BEG and END as their second and third arguments."
+ (when (and (called-interactively-p 'interactive)
+ (evil-goggles--show-p beg end))
+ (evil-goggles--show-async-hint beg end)))
+
;;; delete
(evil-goggles--define-switch-and-face
evil-goggles-enable-delete "If non-nil, enable delete support"
evil-goggles-delete-face "Face for delete action")
-(defun evil-goggles--evil-delete-advice (orig-fun beg end &optional type
register yank-handler)
- "Around-advice for function `evil-delete`.
+;;; yank
-ORIG-FUN is the original function.
-BEG END &OPTIONAL TYPE REGISTER YANK-HANDLER are the arguments of the original
function."
- (evil-goggles--with-blocking-hint beg end 'evil-goggles-delete-face
- (evil-goggles--funcall-preserve-interactive orig-fun beg end type register
yank-handler)))
+(evil-goggles--define-switch-and-face
+ evil-goggles-enable-yank "If non-nil, enable yank support"
+ evil-goggles-yank-face "Face for yank action")
;;; change
(evil-goggles--define-switch-and-face
evil-goggles-enable-change "If non-nil, enable change support"
- evil-goggles-change-face "Face for change action"
- :off-by-default)
-
-(defun evil-goggles--evil-change-advice (orig-fun beg end &optional type
register yank-handler delete-func)
- "Around-advice for function `evil-change`.
-
-ORIG-FUN is the original function.
-BEG END TYPE REGISTER YANK-HANDLER DELETE-FUNC are the arguments of the
original function."
- (evil-goggles--with-blocking-hint beg end 'evil-goggles-change-face
- (funcall orig-fun beg end type register yank-handler delete-func)))
-
-(defun evil-goggles--evil-change-line-advice (orig-fun beg end &optional type
register yank-handler)
- "Around-advice for function `evil-change-line`.
-
-ORIG-FUN is the original function.
-BEG END TYPE REGISTER YANK-HANDLER are the arguments of the original function."
- (evil-goggles--with-blocking-hint beg end 'evil-goggles-change-face
- (funcall orig-fun beg end type register yank-handler)))
-
-;;; substitute
-
-(evil-goggles--define-switch-and-face
- evil-goggles-enable-substitute "If non-nil, enable substitute support"
- evil-goggles-substitute-face "Face for substitute action")
-
-(defun evil-goggles--evil-change-whole-line-advice (orig-fun beg end &optional
type register yank-handler)
- "Around-advice for function `evil-change-whole-line`.
-
-ORIG-FUN is the original function.
-BEG END TYPE REGISTER YANK-HANDLER are the arguments of the original function."
- (evil-goggles--with-blocking-hint beg end 'evil-goggles-substitute-face
- (funcall orig-fun beg end type register yank-handler)))
+ evil-goggles-change-face "Face for change action")
;;; indent
@@ -448,252 +387,73 @@ BEG END TYPE REGISTER YANK-HANDLER are the arguments of
the original function."
evil-goggles-enable-indent "If non-nil, enable indent support"
evil-goggles-indent-face "Face for indent action")
-(defun evil-goggles--evil-indent-advice (orig-fun beg end)
- "Around-advice for function `evil-indent'.
-
-ORIG-FUN is the original function.
-BEG END are the arguments of the original function."
- (evil-goggles--with-async-hint beg end 'evil-goggles-indent-face
- (evil-goggles--funcall-preserve-interactive orig-fun beg end)))
-
-;;; yank
-
-(evil-goggles--define-switch-and-face
- evil-goggles-enable-yank "If non-nil, enable yank support"
- evil-goggles-yank-face "Face for yank action")
-
-(defun evil-goggles--evil-yank-advice (orig-fun beg end &optional type
register yank-handler)
- "Around-advice for function `evil-yank'.
-
-ORIG-FUN is the original function.
-BEG END &OPTIONAL TYPE REGISTER YANK-HANDLER are the arguments of the original
function."
- (evil-goggles--with-async-hint beg end 'evil-goggles-yank-face
- (evil-goggles--funcall-preserve-interactive orig-fun beg end type register
yank-handler)))
-
-;;; undo & redo
-
-(defcustom evil-goggles-enable-undo t
- "If non-nil, enable undo support.
-This variable must be set before `evil-goggles-mode' is enabled"
- :type 'boolean :group 'evil-goggles)
-
-(defcustom evil-goggles-enable-redo t
- "If non-nil, enable redo support.
-This variable must be set before `evil-goggles-mode' is enabled"
- :type 'boolean :group 'evil-goggles)
-
-(defface evil-goggles-undo-redo-add-face
- '((t
- (:inherit evil-goggles-default-face)))
- "Face for undo/redo add action" :group 'evil-goggles-faces)
-
-(defface evil-goggles-undo-redo-remove-face
- '((t
- (:inherit evil-goggles-default-face)))
- "Face for undo/redo remove action" :group 'evil-goggles-faces)
-
-(defface evil-goggles-undo-redo-change-face
- '((t
- (:inherit evil-goggles-default-face)))
- "Face for undo/redo change action" :group 'evil-goggles-faces)
-
-(defun evil-goggles--undo-tree-undo-advice (orig-fun &optional arg)
- "Advice for function `undo-tree-undo` and function `undo-tree-redo`.
-
-ORIG-FUN is the original function.
-ARG is the arguments of the original function."
- (unwind-protect
- (progn
- (advice-add 'primitive-undo :around
'evil-goggles--primitive-undo-advice)
- (funcall orig-fun arg))
- (advice-remove 'primitive-undo 'evil-goggles--primitive-undo-advice)))
-
-(defun evil-goggles--primitive-undo-advice (orig-fun n list)
- "Advice for function `primitive-undo`.
-
-ORIG-FUN is the original function.
-N and LIST are the arguments of the original function."
- (let ((undo-item (evil-goggles--get-undo-item list)))
- ;; show hint on the text which will be removed before undo/redo removes it
- (pcase undo-item
- (`(text-added ,beg ,end)
- (evil-goggles--show-hint beg end 'evil-goggles-undo-redo-remove-face
nil t)))
-
- ;; call the undo/redo function
- (funcall orig-fun n list)
-
- ;; show hint on the text which will be added after undo/redo addes it
- (pcase undo-item
- (`(text-removed ,beg ,end)
- (evil-goggles--show-hint beg end 'evil-goggles-undo-redo-add-face))
- (`(text-changed ,beg ,end)
- (evil-goggles--show-hint beg end
'evil-goggles-undo-redo-change-face)))))
-
-(defun evil-goggles--get-undo-item (list)
- "Process LIST.
-
-The LIST is the input variable to function `primitive-undo'.
-
-This function tries to return a single list, either:
- ('text-added beg end), or:
- ('text-removed beg end)"
- (let* ((processed-list
- (evil-goggles--combine-undo-list (cl-remove-if #'null (mapcar
#'evil-goggles--undo-elt list)))))
- ;; if there's only item in the list, return it; otherwise - nil
- (when (eq 1 (length processed-list))
- (car processed-list))))
-
-(defun evil-goggles--combine-undo-list (input)
- "Combine elements in INPUT list.
-
-Each element is expected to be either '(text-added BEG END) or
-'(text-removed BEG END)."
- (let* ((last (car input))
- (result (list last)))
- (dolist (this (cdr input) (nreverse result))
- (cond ((and (eq (car last) (car this)) ;; both are either text-added or
text-removed
- (eq (nth 1 last) (nth 1 this)))
- ;; combine 2 overlapping elements
- (setcar result (list
- (car this)
- (nth 1 this)
- (+ (nth 2 last) (abs (- (nth 1 this) (nth 2
this)))))))
- ((and (eq (car last) (car this))
- (or
- (eq (nth 1 last) (nth 2 this))
- (eq (nth 2 last) (nth 1 this))))
- ;; combine 2 connecting text-added/text-deleted elements
- (setcar result (list
- (car this)
- (min (nth 1 this) (nth 2 this) (nth 1 last) (nth
2 last))
- (max (nth 1 this) (nth 2 this) (nth 1 last) (nth
2 last)))))
- ((and
- (eq (car last) 'text-added)
- (eq (car this) 'text-removed)
- (eq (nth 1 last) (nth 1 this)))
- ;; combine overlapping text-added with text-removed which start
at the same point
- (setcar result (list
- 'text-changed
- (nth 1 last)
- (if (< (nth 2 last) (nth 2 this))
- (max (nth 2 last) (nth 2 this))
- (min (nth 2 last) (nth 2 this))))))
- (t (push this result)))
- (setq last (car result)))))
-
-(defun evil-goggles--undo-elt (undo-elt)
- "Process UNDO-ELT.
-
-Return a list: either ('text-added beg end) or ('text-removed beg end)"
- (pcase undo-elt
- ;; (BEG . END) means text added
- (`(,(and beg (pred integerp)) . ,(and end (pred integerp)))
- `(text-added ,beg ,end))
- ;; (TEXT . POSITION) means text inserted
- (`(,(and text (pred stringp)) . ,(and pos (pred integerp)))
- (list 'text-removed pos (+ pos (length text))))
- ;; All others return nil
- (_ nil)))
-
;;; join
(evil-goggles--define-switch-and-face
evil-goggles-enable-join "If non-nil, enable join support"
evil-goggles-join-face "Face for join action")
-(defun evil-goggles--evil-join-advice (orig-fun beg end)
- "Around-advice for function `evil-join'.
+(defun evil-goggles--join-advice (beg end &rest _)
+ "Advice for `evil-join' and `evil-join-whitespace'.
-ORIG-FUN is the original function.
-BEG END are the arguments of the original function."
- (let* ((beg-line (line-number-at-pos beg))
- (end-line (line-number-at-pos end))
- (line-count (- end-line beg-line)))
- (if (> line-count 1) ;; don't show goggles for single lines ("J"/"gJ"
without count)
- (evil-goggles--with-blocking-hint beg end 'evil-goggles-join-face
- (evil-goggles--funcall-preserve-interactive orig-fun beg end))
- (evil-goggles--funcall-preserve-interactive orig-fun beg end))))
+BEG and END are the argumenets to the original functions."
+ (when (and (called-interactively-p 'interactive)
+ (evil-goggles--show-p beg end)
+ ;; don't show goggles for single lines ("J"/"gJ" without count)
+ (< 1 (- (line-number-at-pos end) (line-number-at-pos beg))))
+ (evil-goggles--show-blocking-hint beg end)))
-;;; reformat (fill and move)
+;;; fill
(evil-goggles--define-switch-and-face
- evil-goggles-enable-fill-and-move "If non-nil, enable fill and move
(reformat) support"
- evil-goggles-fill-and-move-face "Face for fill and move (reformat) action")
-
-(defun evil-goggles--evil-fill-and-move-advice (orig-fun beg end)
- "Around-advice for function `evil-fill-and-move'.
+ evil-goggles-enable-fill-and-move "If non-nil, enable fill-and-move
support"
+ evil-goggles-fill-and-move-face "Face for fill-and-move action")
-ORIG-FUN is the original function.
-BEG END are arguments of the original function."
- (evil-goggles--with-async-hint beg end 'evil-goggles-fill-and-move-face
- (evil-goggles--funcall-preserve-interactive orig-fun beg end)))
-
-;;; paste before and after
+;;; shift
(evil-goggles--define-switch-and-face
- evil-goggles-enable-paste "If non-nil, enable paste support"
- evil-goggles-paste-face "Face for paste action")
+ evil-goggles-enable-shift "If non-nil, enable shift support"
+ evil-goggles-shift-face "Face for shift action")
-(defun evil-goggles--evil-paste-advice (orig-fun count &optional register
yank-handler)
- "Around-advice for functions `evil-paste-after' and `evil-paste-before'.
+;;; evil-surround
-ORIG-FUN is the original function.
-COUNT REGISTER YANK-HANDLER are the arguments of the original function."
- (prog1
- (evil-goggles--funcall-preserve-interactive orig-fun count register
yank-handler)
- (when (evil-normal-state-p)
- (let* ((beg (save-excursion (evil-goto-mark ?\[) (if (eolp) (1+ (point))
(point))))
- (end (save-excursion (evil-goto-mark ?\]) (if (eolp) (1+ (point))
(point))))
- (use-block-hint (evil-goggles--evil-paste-block-p register
yank-handler)))
- (evil-goggles--show-hint beg end 'evil-goggles-paste-face
use-block-hint)))))
+(evil-goggles--define-switch-and-face
+ evil-goggles-enable-surround "If non-nil, enable surround support"
+ evil-goggles-surround-face "Face for surround action")
-(defun evil-goggles--evil-paste-block-p (register yank-handler)
- "Return t if the paste was a vertical block.
+;;; evil-commentary
-Argument REGISTER is the evil register.
-Argument YANK-HANDLER is the yank hanler."
- (let* ((text (if register
- (evil-get-register register)
- (current-kill 0)))
- (yh (or yank-handler
- (when (stringp text)
- (car-safe (get-text-property
- 0 'yank-handler text))))))
- (eq yh 'evil-yank-block-handler)))
+(evil-goggles--define-switch-and-face
+ evil-goggles-enable-commentary "If non-nil, enable commentary support"
+ evil-goggles-commentary-face "Face for commentary action")
-;;; shift left & right
+;;; evil-nerd-commenter
(evil-goggles--define-switch-and-face
- evil-goggles-enable-shift "If non-nil, enable shift left/right support"
- evil-goggles-shift-face "Face for paste action")
+ evil-goggles-enable-nerd-commenter "If non-nil, enable nerd-commenter
support"
+ evil-goggles-nerd-commenter-face "Face for nerd-commenter action")
-(defun evil-goggles--evil-shift-advice (orig-fun beg end &optional count
preserve-empty)
- "Around-advice for function `evil-shift-left` and `evil-shift-right`.
+;;; evil-replace-with-register
-ORIG-FUN is the original function.
-BEG END &OPTIONAL COUNT PRESERVE-EMPTY are the arguments of the original
function."
- (evil-goggles--with-async-hint beg end 'evil-goggles-shift-face
- (evil-goggles--funcall-preserve-interactive orig-fun beg end count
preserve-empty)))
+(evil-goggles--define-switch-and-face
+ evil-goggles-enable-replace-with-register "If non-nil, enable replace with
register support"
+ evil-goggles-replace-with-register-face "Face for replace with register
action")
;;; set mark
(evil-goggles--define-switch-and-face
- evil-goggles-enable-set-marker "If non-nil, enable set mark support"
- evil-goggles-set-marker-face "Face for set mark action")
-
-(defun evil-goggles--evil-set-marker-advice (orig-fun char &optional pos
advance)
- "Around-advice for function `evil-set-marker`.
-
-ORIG-FUN is the original function.
-CHAR POS ADVANCE are the arguments of the original function."
- ;; call orig-fun
- (evil-goggles--funcall-preserve-interactive orig-fun char pos advance)
- ;; maybe show the goggles overlay
- (when (<= ?a char ?z)
+ evil-goggles-enable-set-marker "If non-nil, enable replace with register
support"
+ evil-goggles-set-marker-face "Face for replace with register action")
+
+(defun evil-goggles--set-marker-advice (char &rest _)
+ "Advice for `evil-set-marker'.
+
+CHAR is an argument for the advice-d function."
+ (when (and (called-interactively-p 'interactive)
+ (<= ?a char ?z))
(let ((beg (line-beginning-position))
- (end (1+ (line-end-position)))
- (evil-goggles--hint-on-empty-lines t))
- (evil-goggles--with-async-hint beg end 'evil-goggles-set-marker-face))))
+ (end (1+ (line-end-position))))
+ (evil-goggles--show-async-hint beg end))))
;;; record macro
@@ -701,94 +461,87 @@ CHAR POS ADVANCE are the arguments of the original
function."
evil-goggles-enable-record-macro "If non-nil, enable record macro support"
evil-goggles-record-macro-face "Face for record macro action")
-(defun evil-goggles--evil-record-macro-advice (orig-fun register)
- "Around-advice for function `evil-record-macro'.
-
-ORIG-FUN is the original function.
-REGISTER is the argument of the original function."
+(defun evil-goggles--record-macro-advice (&rest _)
+ "Advice for `evil-record-macro'."
(let ((beg (line-beginning-position))
(end (1+ (line-end-position)))
- (was-defining-kbd-macro defining-kbd-macro)
- (evil-goggles--hint-on-empty-lines t))
+ (was-defining-kbd-macro defining-kbd-macro))
;; show hint before starting to record a macro
(unless was-defining-kbd-macro
- (evil-goggles--show-hint beg end 'evil-goggles-record-macro-face))
-
- (evil-goggles--funcall-preserve-interactive orig-fun register)
+ (evil-goggles--show-async-hint beg end))
;; show hint when done defining the macro
(when was-defining-kbd-macro
- (evil-goggles--show-hint beg end 'evil-goggles-record-macro-face))))
-
+ (evil-goggles--show-async-hint beg end))))
-;;; ex global
-
-(defun evil-goggles--evil-ex-global-advice (orig-fun beg end pattern command
&optional invert)
- "Around-advice for function `evil-ex-global'.
-
-ORIG-FUN is the original function.
-BEG END PATTERN COMMAND &OPTIONAL INVERT are the arguments of the original
function."
- (evil-goggles--with-disabled-hint
- (evil-goggles--funcall-preserve-interactive orig-fun beg end pattern
command invert)))
-
-;;; surround
+;;; paste
(evil-goggles--define-switch-and-face
- evil-goggles-enable-surround "If non-nil, enable surround support"
- evil-goggles-surround-face "Face for surround action")
-
-(defun evil-goggles--evil-surround-region-advice (orig-fun beg end &optional
type char force-new-line)
- "Around-advice for function `evil-surround-region'.
-
-ORIG-FUN is the original function.
-BEG END &OPTIONAL TYPE CHAR FORCE-NEW-LINE are the arguments of the original
function."
- (evil-goggles--with-async-hint beg end 'evil-goggles-surround-face
- (evil-goggles--funcall-preserve-interactive orig-fun beg end type char
force-new-line)))
-
-;;; commentary
-
-(evil-goggles--define-switch-and-face
- evil-goggles-enable-commentary "If non-nil, enable commentary support"
- evil-goggles-commentary-face "Face for commentary action")
-
-(defun evil-goggles--evil-commentary-advice (orig-fun beg end &optional type)
- "Around-advice for function `evil-commentary'.
-
-ORIG-FUN is the original function.
-BEG END &OPTIONAL TYPE are the arguments of the original function."
- (evil-goggles--with-async-hint beg end 'evil-goggles-commentary-face
- (evil-goggles--funcall-preserve-interactive orig-fun beg end type)))
-
-;;; nerd-commenter
-
-(evil-goggles--define-switch-and-face
- evil-goggles-enable-nerd-commenter "If non-nil, enable nerd-commenter
support"
- evil-goggles-nerd-commenter-face "Face for nerd-commenter action")
+ evil-goggles-enable-paste "If non-nil, enable paste support"
+ evil-goggles-paste-face "Face for paste action")
-(defun evil-goggles--evil-nerd-commenter-advice (orig-fun beg end &optional
type)
- "Around-advice for function `evilnc-comment-operator'.
+(defun evil-goggles--paste-advice (_ &optional register yank-handler)
+ "Advice for `evil-paste-before' and `evil-paste-after'.
-ORIG-FUN is the original function.
-BEG END &OPTIONAL TYPE are the arguments of the original function."
- (evil-goggles--with-async-hint beg end 'evil-goggles-nerd-commenter-face
- (evil-goggles--funcall-preserve-interactive orig-fun beg end type)))
+REGISTER and YANK-HANDLER are the argumenets to the original functions."
+ (when (and (called-interactively-p 'interactive)
+ (evil-normal-state-p))
+ (let* ((beg (save-excursion (evil-goto-mark ?\[) (if (eolp) (1+ (point))
(point))))
+ (end (save-excursion (evil-goto-mark ?\]) (if (eolp) (1+ (point))
(point))))
+ (is-vertical-block-pasted (evil-goggles--paste-vert-block-p
register yank-handler)))
+ (if is-vertical-block-pasted
+ ;; XXX the async hint can't show vertical block hints - use a
blocking hint if a vert block is pasted
+ ;; XXX without the `(1+ end)', the vertical block hint is off by one
+ (evil-goggles--show-blocking-hint beg (1+ end)
is-vertical-block-pasted)
+ (evil-goggles--show-async-hint beg end)))))
-;;; replace with register
-(evil-goggles--define-switch-and-face
- evil-goggles-enable-replace-with-register "If non-nil, enable replace with
register support"
- evil-goggles-replace-with-register-face "Face for replace with register
action")
+(defun evil-goggles--paste-vert-block-p (register yank-handler)
+ "Return t if the paste is a vertical block.
-(defun evil-goggles--evil-replace-with-register-advice (orig-fun count beg
&optional end type register)
- "Around-advice for function `evil-replace-with-register'.
+Argument REGISTER is the evil register.
+Argument YANK-HANDLER is the yank hanler."
+ (let* ((text (if register
+ (evil-get-register register)
+ (current-kill 0)))
+ (yh (or yank-handler
+ (when (stringp text)
+ (car-safe (get-text-property
+ 0 'yank-handler text))))))
+ (eq yh 'evil-yank-block-handler)))
-ORIG-FUN is the original function.
-COUNT BEG &OPTIONAL END TYPE REGISTER are the arguments of the original
function."
- (evil-goggles--with-async-hint beg end 'evil-goggles-nerd-commenter-face
- (evil-goggles--funcall-preserve-interactive orig-fun count beg end type
register)))
-;;; mode defined below ;;;
+;;; assosiation list with faces
+
+(defvar evil-goggles--commands
+ '((evil-delete :face evil-goggles-delete-face
:switch evil-goggles-enable-delete :advice
evil-goggles--generic-blocking-advice)
+ (evil-yank :face evil-goggles-yank-face
:switch evil-goggles-enable-yank :advice
evil-goggles--generic-async-advice)
+ (evil-change :face evil-goggles-change-face
:switch evil-goggles-enable-change :advice
evil-goggles--generic-blocking-advice)
+ (evil-change-line :face evil-goggles-change-face
:switch evil-goggles-enable-change :advice
evil-goggles--generic-blocking-advice)
+ (evil-change-whole-line :face evil-goggles-change-face
:switch evil-goggles-enable-change :advice
evil-goggles--generic-blocking-advice)
+ (evil-indent :face evil-goggles-indent-face
:switch evil-goggles-enable-indent :advice
evil-goggles--generic-async-advice)
+ (evil-join :face evil-goggles-join-face
:switch evil-goggles-enable-join :advice
evil-goggles--join-advice)
+ (evil-join-whitespace :face evil-goggles-join-face
:switch evil-goggles-enable-join :advice
evil-goggles--join-advice)
+ (evil-fill-and-move :face evil-goggles-fill-and-move-face
:switch evil-goggles-enable-fill-and-move :advice
evil-goggles--generic-async-advice)
+ (evil-shift-left :face evil-goggles-shift-face
:switch evil-goggles-enable-shift :advice
evil-goggles--generic-async-advice)
+ (evil-shift-right :face evil-goggles-shift-face
:switch evil-goggles-enable-shift :advice
evil-goggles--generic-async-advice)
+ (evil-surround-region :face evil-goggles-surround-face
:switch evil-goggles-enable-surround :advice
evil-goggles--generic-async-advice)
+ (evil-commentary :face evil-goggles-commentary-face
:switch evil-goggles-enable-commentary :advice
evil-goggles--generic-async-advice)
+ (evilnc-comment-operator :face evil-goggles-nerd-commenter-face
:switch evil-goggles-enable-nerd-commenter :advice
evil-goggles--generic-async-advice)
+ (evil-replace-with-register :face evil-goggles-replace-with-register-face
:switch evil-goggles-enable-replace-with-register :advice
evil-goggles--generic-async-advice-1)
+ (evil-set-marker :face evil-goggles-set-marker-face
:switch evil-goggles-enable-set-marker :advice
evil-goggles--set-marker-advice)
+ (evil-record-macro :face evil-goggles-record-macro-face
:switch evil-goggles-enable-record-macro :advice
evil-goggles--record-macro-advice)
+ (evil-paste-before :face evil-goggles-paste-face
:switch evil-goggles-enable-paste :advice
evil-goggles--paste-advice :after t)
+ (evil-paste-after :face evil-goggles-paste-face
:switch evil-goggles-enable-paste :advice
evil-goggles--paste-advice :after t)))
+
+(defun evil-goggles--get-face (command)
+ "Lookup face for COMMAND in `evil-goggles--commands'."
+ (or
+ (plist-get (cdr (assoc command evil-goggles--commands)) :face)
+ 'evil-goggles-default-face))
+
+;;; minor mode defined below ;;;
(defcustom evil-goggles-lighter
" EG"
@@ -802,97 +555,23 @@ COUNT BEG &OPTIONAL END TYPE REGISTER are the arguments
of the original function
:lighter evil-goggles-lighter
:global t
:require 'evil-goggles
- (cond
- (evil-goggles-mode
-
- ;; evil core functions
-
- (when evil-goggles-enable-delete
- (advice-add 'evil-delete :around 'evil-goggles--evil-delete-advice))
-
- ;; `c' and `C' normal state keys
- (when evil-goggles-enable-change
- (advice-add 'evil-change :around 'evil-goggles--evil-change-advice)
- (advice-add 'evil-change-line :around
'evil-goggles--evil-change-line-advice))
-
- ;; `s' and `S' normal state keys
- (when evil-goggles-enable-substitute
- (advice-add 'evil-change-whole-line :around
'evil-goggles--evil-change-whole-line-advice))
-
- (when evil-goggles-enable-indent
- (advice-add 'evil-indent :around 'evil-goggles--evil-indent-advice))
-
- (when evil-goggles-enable-yank
- (advice-add 'evil-yank :around 'evil-goggles--evil-yank-advice))
-
- (when evil-goggles-enable-undo
- (advice-add 'undo-tree-undo :around
'evil-goggles--undo-tree-undo-advice))
- (when evil-goggles-enable-redo
- (advice-add 'undo-tree-redo :around
'evil-goggles--undo-tree-undo-advice))
-
- (when evil-goggles-enable-join
- (advice-add 'evil-join :around 'evil-goggles--evil-join-advice)
- (advice-add 'evil-join-whitespace :around
'evil-goggles--evil-join-advice))
-
- (when evil-goggles-enable-fill-and-move
- (advice-add 'evil-fill-and-move :around
'evil-goggles--evil-fill-and-move-advice))
-
- (when evil-goggles-enable-paste
- (advice-add 'evil-paste-after :around 'evil-goggles--evil-paste-advice)
- (advice-add 'evil-paste-before :around 'evil-goggles--evil-paste-advice))
-
- (when evil-goggles-enable-shift
- (advice-add 'evil-shift-left :around 'evil-goggles--evil-shift-advice)
- (advice-add 'evil-shift-right :around 'evil-goggles--evil-shift-advice))
-
- (when evil-goggles-enable-set-marker
- (advice-add 'evil-set-marker :around
'evil-goggles--evil-set-marker-advice))
-
- (when evil-goggles-enable-record-macro
- (advice-add 'evil-record-macro :around
'evil-goggles--evil-record-macro-advice))
-
- ;; make sure :global and :v don't show the goggles overlay
- (advice-add 'evil-ex-global :around 'evil-goggles--evil-ex-global-advice)
-
- ;; evil non-core functions
-
- (when evil-goggles-enable-surround
- (advice-add 'evil-surround-region :around
'evil-goggles--evil-surround-region-advice))
-
- (when evil-goggles-enable-commentary
- (advice-add 'evil-commentary :around
'evil-goggles--evil-commentary-advice))
-
- (when evil-goggles-enable-nerd-commenter
- (advice-add 'evilnc-comment-operator :around
'evil-goggles--evil-nerd-commenter-advice))
-
- (when evil-goggles-enable-replace-with-register
- (advice-add 'evil-replace-with-register :around
'evil-goggles--evil-replace-with-register-advice)))
- (t
- (advice-remove 'evil-delete 'evil-goggles--evil-delete-advice)
- (advice-remove 'evil-change 'evil-goggles--evil-change-advice)
- (advice-remove 'evil-change-line 'evil-goggles--evil-change-line-advice)
- (advice-remove 'evil-change-whole-line
'evil-goggles--evil-change-whole-line-advice)
- (advice-remove 'evil-indent 'evil-goggles--evil-indent-advice)
- (advice-remove 'evil-yank 'evil-goggles--evil-yank-advice)
- (advice-remove 'undo-tree-undo 'evil-goggles--undo-tree-undo-advice)
- (advice-remove 'undo-tree-redo 'evil-goggles--undo-tree-undo-advice)
- (advice-remove 'evil-join 'evil-goggles--evil-join-advice)
- (advice-remove 'evil-join-whitespace 'evil-goggles--evil-join-advice)
- (advice-remove 'evil-fill-and-move
'evil-goggles--evil-fill-and-move-advice)
- (advice-remove 'evil-paste-after 'evil-goggles--evil-paste-advice)
- (advice-remove 'evil-paste-before 'evil-goggles--evil-paste-advice)
- (advice-remove 'evil-shift-left 'evil-goggles--evil-shift-advice)
- (advice-remove 'evil-shift-right 'evil-goggles--evil-shift-advice)
- (advice-remove 'evil-set-marker 'evil-goggles--evil-set-marker-advice)
- (advice-remove 'evil-record-macro 'evil-goggles--evil-record-macro-advice)
-
- (advice-remove 'evil-ex-global 'evil-goggles--evil-ex-global-advice)
-
- ;; evil non-core functions
- (advice-remove 'evil-surround-region
'evil-goggles--evil-surround-region-advice)
- (advice-remove 'evil-commentary 'evil-goggles--evil-commentary-advice)
- (advice-remove 'evilnc-comment-operator
'evil-goggles--evil-nerd-commenter-advice)
- (advice-remove 'evil-replace-with-register
'evil-goggles--evil-replace-with-register-advice))))
+ (if evil-goggles-mode
+ (progn
+ (add-hook 'pre-command-hook #'evil-goggles--vanish)
+ ;; add advice
+ (dolist (command-cfg evil-goggles--commands)
+ (let ((cmd (car command-cfg))
+ (advice (plist-get (cdr command-cfg) :advice))
+ (switch (plist-get (cdr command-cfg) :switch))
+ (after (plist-get (cdr command-cfg) :after)))
+ (when (symbol-value switch)
+ (advice-add cmd (if after :after :before) advice)))))
+ ;; remove advice
+ (remove-hook 'pre-command-hook 'evil-goggles--vanish)
+ (dolist (command-cfg evil-goggles--commands)
+ (let ((cmd (car command-cfg))
+ (advice (plist-get (cdr command-cfg) :advice)))
+ (advice-remove cmd advice)))))
(provide 'evil-goggles)
diff --git a/test/elpa.el b/test/elpa.el
index f501af1537..fbc7ec9194 100644
--- a/test/elpa.el
+++ b/test/elpa.el
@@ -2,3 +2,6 @@
(expand-file-name (format ".elpa/%s/elpa" emacs-version)))
(package-initialize)
(add-to-list 'load-path default-directory)
+(setq package-archives
+ '(("melpa" . "http://melpa.org/packages/")
+ ("gnu" . "http://elpa.gnu.org/packages/")))
diff --git a/test/make-update.el b/test/make-update.el
index 1c884b4bee..a527ada064 100644
--- a/test/make-update.el
+++ b/test/make-update.el
@@ -8,7 +8,7 @@
(package-refresh-contents)
(defconst dev-packages
- '(evil evil-test-helpers))
+ '(evil evil-test-helpers package-lint))
(dolist (package dev-packages)
(unless (package-installed-p package)
- [nongnu] elpa/evil-goggles df26adb069 153/225: Use async hints for paste, undo/redo, set mark, (continued)
- [nongnu] elpa/evil-goggles df26adb069 153/225: Use async hints for paste, undo/redo, set mark, ELPA Syncer, 2022/01/12
- [nongnu] elpa/evil-goggles 692f276434 158/225: Indentation, ELPA Syncer, 2022/01/12
- [nongnu] elpa/evil-goggles 9626b143e1 171/225: Always use `evaporate` overlay property, ELPA Syncer, 2022/01/12
- [nongnu] elpa/evil-goggles 56691c6e65 132/225: Rename functions, ELPA Syncer, 2022/01/12
- [nongnu] elpa/evil-goggles 48feeba6f0 180/225: Update README, ELPA Syncer, 2022/01/12
- [nongnu] elpa/evil-goggles bc318ad4b7 184/225: `require` pulse, rather than create an autoload for one of its functions, ELPA Syncer, 2022/01/12
- [nongnu] elpa/evil-goggles 580b219de6 192/225: Add `S` hint, ELPA Syncer, 2022/01/12
- [nongnu] elpa/evil-goggles 2739529221 198/225: Add hint for evil-replace-with-register, ELPA Syncer, 2022/01/12
- [nongnu] elpa/evil-goggles 13bcbda8a4 195/225: Add hind for `C`, ELPA Syncer, 2022/01/12
- [nongnu] elpa/evil-goggles e89110cd92 206/225: Fix docstrings reported by `checkdoc`, ELPA Syncer, 2022/01/12
- [nongnu] elpa/evil-goggles d3ad932a1c 208/225: Merge branch 'use-before-advice',
ELPA Syncer <=
- [nongnu] elpa/evil-goggles dc0d65911e 209/225: Update README.md, ELPA Syncer, 2022/01/12
- [nongnu] elpa/evil-goggles d3222f8b07 219/225: speedup: count-lines instead of substracting line-number-at-pos's, ELPA Syncer, 2022/01/12
- [nongnu] elpa/evil-goggles 1b66053ea5 225/225: Merge pull request #31 from skangas/bump-version, ELPA Syncer, 2022/01/12
- [nongnu] elpa/evil-goggles 7801d9204c 224/225: Bump version to 0.0.2, ELPA Syncer, 2022/01/12