commit 450b0f08e508f01c8fa38b440e1a382781f9fd48
parent bb69b1fc71aeab7f4780576b77d61553f97b4e5f
Author: Iqbal Ansari <iqbalansari02@yahoo.com>
Date: Tue, 27 Sep 2016 23:29:04 +0530
Merge branch 'bugfix/uncover-25.1' into develop
Diffstat:
| M | .travis.yml | | | 1 | + |
| M | emojify.el | | | 146 | ++++++++++++++++++++++++++++++++++--------------------------------------------- |
| M | test/emojify-test.el | | | 97 | ++++++++++++++++++++++++++++++++++++------------------------------------------- |
| M | test/test-helper.el | | | 63 | +++++++++++++++++++++++++++++---------------------------------- |
4 files changed, 137 insertions(+), 170 deletions(-)
diff --git a/.travis.yml b/.travis.yml
@@ -1,6 +1,7 @@
language: generic
sudo: false
env:
+ - EVM_EMACS=emacs-25.1
- EVM_EMACS=emacs-24.5
- EVM_EMACS=emacs-24.4
- EVM_EMACS=emacs-24.3
diff --git a/emojify.el b/emojify.el
@@ -532,11 +532,10 @@ the visible area."
It can be one of the following
`echo' - Echo the underlying text in the minibuffer
`uncover' - Display the underlying text while point is on it
-function - It is called with 4 arguments
- 1) buffer where emoji text is
- 2) the emoji text
- 3) starting position of emoji text
- 4) ending position of emoji text
+function - It is called with 2 arguments (the buffer where emoji appears is
+ current during execution)
+ 1) starting position of emoji text
+ 2) ending position of emoji text
Does nothing if the value is anything else."
;; TODO: Mention custom function
@@ -545,60 +544,54 @@ Does nothing if the value is anything else."
(const :tag "Uncover (undisplay) the underlying emoji text" uncover))
:group 'emojify)
+(defcustom emojify-reveal-on-isearch t
+ "Should underlying emoji be displayed when point enters emoji while in isearch mode.")
+
(defcustom emojify-show-help t
"If non-nil the underlying text is displayed in a popup when mouse moves over it."
:type 'boolean
:group 'emojify)
-(defun emojify-point-left-function (old-point _new-point)
- "Function to be executed when point enters an emojified text.
-
-OLD-POINT and _NEW-POINT are the point before leaving and after leaving."
- (let ((match-beginning (get-text-property old-point 'emojify-beginning))
- (match-end (get-text-property old-point 'emojify-end))
- (buffer (get-text-property old-point 'emojify-buffer)))
- (when (and (equal buffer (current-buffer))
- match-beginning)
- (emojify-with-saved-buffer-state
- (let ((current-display (get-text-property match-beginning 'emojify-display)))
- (add-text-properties match-beginning match-end (list 'display current-display
- 'point-left nil
- 'point-entered #'emojify-point-entered-function)))))))
-
-(defun emojify--uncover-emoji (match-beginning match-end)
- "Uncover emoji in BUFFER between MATCH-BEGINNING and MATCH-END."
- (emojify-with-saved-buffer-state
- (add-text-properties match-end
- match-beginning
- (list 'display nil
- 'point-left #'emojify-point-left-function
- 'point-entered nil))))
-
-(defun emojify-point-entered-function (_old-point new-point)
- "Function to be executed when point enters an emojified text.
-
-_OLD-POINT and NEW-POINT are the point before entering and after entering."
- (let* ((text-props (text-properties-at new-point))
- (buffer (plist-get text-props 'emojify-buffer))
- (match (plist-get text-props 'emojify-text))
- (match-beginning (plist-get text-props 'emojify-beginning))
- (match-end (plist-get text-props 'emojify-end)))
- (when (eq buffer (current-buffer))
- (cond ((and (eq emojify-point-entered-behaviour 'echo)
- ;; Do not echo in isearch-mode
- (not isearch-mode)
- (not (active-minibuffer-window))
- (not (current-message)))
- (message (substring-no-properties match)))
- ((eq emojify-point-entered-behaviour 'uncover)
- (emojify--uncover-emoji match-beginning match-end))
- ((functionp 'emojify-point-entered-behaviour)
- (funcall emojify-point-entered-behaviour buffer match match-beginning match-end)))
-
- ;; Uncover at point anyway in isearch-mode
- (when (and isearch-mode
- (not (eq emojify-point-entered-behaviour 'uncover)))
- (emojify--uncover-emoji match-beginning match-end)))))
+(defun emojify-on-emoji-enter (beginning end)
+ "Executed when point enters emojified text between BEGINNING and END."
+ (cond ((and (eq emojify-point-entered-behaviour 'echo)
+ ;; Do not echo in isearch-mode
+ (not isearch-mode)
+ (not (active-minibuffer-window))
+ (not (current-message)))
+ (message (substring-no-properties (get-text-property beginning 'emojify-text))))
+ ((eq emojify-point-entered-behaviour 'uncover)
+ (put-text-property beginning end 'display nil))
+ ((functionp 'emojify-point-entered-behaviour)
+ (funcall emojify-point-entered-behaviour beginning end)))
+
+ (when (and isearch-mode emojify-reveal-on-isearch)
+ (put-text-property beginning end 'display nil)))
+
+(defun emojify-on-emoji-exit (beginning end)
+ "Executed when point exits emojified text between BEGINNING and END."
+ (put-text-property beginning
+ end
+ 'display
+ (get-text-property beginning 'emojify-display)))
+
+(defvar-local emojify--last-emoji-pos nil)
+
+(defun emojify-detect-emoji-entry/exit ()
+ "Detect emoji entry and exit and run appropriate handlers."
+ (while-no-input
+ (emojify-with-saved-buffer-state
+ (when emojify--last-emoji-pos
+ (emojify-on-emoji-exit (car emojify--last-emoji-pos) (cdr emojify--last-emoji-pos)))
+
+ (when (get-text-property (point) 'emojified)
+ (let* ((text-props (text-properties-at (point)))
+ (buffer (plist-get text-props 'emojify-buffer))
+ (match-beginning (plist-get text-props 'emojify-beginning))
+ (match-end (plist-get text-props 'emojify-end)))
+ (when (eq buffer (current-buffer))
+ (emojify-on-emoji-enter match-beginning match-end)
+ (setq emojify--last-emoji-pos (cons match-beginning match-end))))))))
(defun emojify-help-function (_window _string pos)
"Function to get help string to be echoed when point/mouse into the point.
@@ -931,7 +924,6 @@ region containing the emoji."
'emojify-end (copy-marker end)
'yank-handler (list nil text)
'keymap emojify-emoji-keymap
- 'point-entered #'emojify-point-entered-function
'help-echo #'emojify-help-function)))))
(defun emojify-display-emojis-in-region (beg end)
@@ -1067,8 +1059,6 @@ BEG and END are the beginning and end of the region respectively"
(remove-text-properties emoji-start emoji-end (append (list 'emojified t
'display t
'emojify-display t
- 'point-entered t
- 'point-left t
'emojify-buffer t
'emojify-text t
'emojify-beginning t
@@ -1085,8 +1075,15 @@ BEG and END are the beginning and end of the region respectively"
Redisplay emojis in the visible region if BEG and END are not specified"
(let* ((area (emojify--get-relevant-region))
- (beg (or beg (car area)))
- (end (or end (cdr area))))
+ (beg (save-excursion
+ (goto-char (or beg (car area)))
+ (line-beginning-position)))
+ (end (save-excursion
+ (goto-char (or end (cdr area)))
+ (line-end-position))))
+ (save-excursion
+ (goto-char 1)
+ (line-beginning-position))
(emojify-execute-ignoring-errors-unless-debug
(emojify-undisplay-emojis-in-region beg end)
(emojify-display-emojis-in-region beg end))))
@@ -1204,14 +1201,14 @@ report incorrect values.
To work around this
`emojify-update-visible-emojis-background-after-window-scroll' is added to
`window-scroll-functions' to update emojis on window scroll."
- (emojify--update-emojis-background-in-region-starting-at (window-start)))
+ (while-no-input (emojify--update-emojis-background-in-region-starting-at (window-start))))
(defun emojify-update-visible-emojis-background-after-window-scroll (_window display-start)
"Function added to `window-scroll-functions' when region is active.
This function updates the backgrounds of the emojis in the newly displayed area
of the window. DISPLAY-START corresponds to the new start of the window."
- (emojify--update-emojis-background-in-region-starting-at display-start))
+ (while-no-input (emojify--update-emojis-background-in-region-starting-at display-start)))
@@ -1296,6 +1293,9 @@ run the command `emojify-download-emoji'")))
(jit-lock-register #'emojify-redisplay-emojis-in-region)
(add-hook 'jit-lock-after-change-extend-region-functions #'emojify-after-change-extend-region-function t t)
+ ;; Handle point entered behaviour
+ (add-hook 'post-command-hook #'emojify-detect-emoji-entry/exit t t)
+
;; Update emoji backgrounds after each command
(add-hook 'post-command-hook #'emojify-update-visible-emojis-background-after-command t t)
@@ -1323,6 +1323,8 @@ run the command `emojify-download-emoji'")))
(jit-lock-unregister #'emojify-redisplay-emojis-in-region)
(remove-hook 'jit-lock-after-change-extend-region-functions #'emojify-after-change-extend-region-function t)
+ (remove-hook 'post-command-hook #'emojify-detect-emoji-entry/exit t)
+
;; Disable hooks to update emoji backgrounds
(remove-hook 'post-command-hook #'emojify-update-visible-emojis-background-after-command t)
(remove-hook 'deactivate-mark-hook #'emojify-update-visible-emojis-background-after-command t)
@@ -1540,28 +1542,6 @@ an update of emoji backgrounds. Not the cleanest but the only way I can think o
(ad-activate #'mouse--drag-set-mark-and-point)
-(defadvice isearch-repeat (around emojify-redisplay-after-isearch-left (direction))
- "Advice `isearch-repeat' to run emojify's point motion hooks.
-
-By default isearch disables point-motion hooks while repeating (see
-`isearch-invisible') breaking emojify's uncovering logic, this advice explicitly
-runs (only emojify's) point motion hooks."
- (let ((old-pos (point)))
- (prog1 ad-do-it
- (when emojify-mode
- (let ((old-pos-props (text-properties-at old-pos))
- (new-pos-props (text-properties-at (point))))
- (unless (equal old-pos (point))
- (when (and (plist-get old-pos-props 'emojified)
- (plist-get old-pos-props 'point-left))
- (funcall (plist-get old-pos-props 'point-left) old-pos (point)))
- (when (and (plist-get new-pos-props 'emojified)
- (plist-get new-pos-props 'point-entered))
- (funcall (plist-get new-pos-props 'point-entered) old-pos (point)))))))))
-
-
-(ad-activate #'isearch-repeat)
-
(defadvice text-scale-increase (after emojify-resize-emojis (&rest ignored))
"Advice `text-scale-increase' to resize emojis on text resize."
(when emojify-mode
diff --git a/test/emojify-test.el b/test/emojify-test.el
@@ -7,8 +7,7 @@
;;; Code:
;; For interactive testing
-(unless noninteractive
- (require 'test-helper (expand-file-name "test-helper.el")))
+(require 'test-helper (expand-file-name "test-helper.el"))
;; Used for testing integration with programming modes
(require 'org)
@@ -96,7 +95,7 @@
:tags '(behaviour point-motion)
(emojify-tests-with-emojified-buffer " :)"
(setq emojify-point-entered-behaviour 'uncover)
- (goto-char (1+ (point-min)))
+ (execute-kbd-macro (kbd "C-f") 2)
(emojify-tests-should-be-uncovered (point))))
(ert-deftest emojify-tests-emoji-echoing ()
@@ -107,11 +106,10 @@
;; before echoing the emoji, we need to stub out current-message
;; too otherwise emojify does not echo the message since messages
;; from other tests are being displayed
- (unless noninteractive
- (stub current-message => nil))
+ (stub current-message => nil)
(mock (message ":)"))
(setq emojify-point-entered-behaviour 'echo)
- (goto-char (1+ (point-min)))
+ (execute-kbd-macro (kbd "C-f"))
(emojify-tests-should-be-emojified (point)))))
(ert-deftest emojify-tests-custom-point-entered-function ()
@@ -133,13 +131,16 @@
(github-emoji-pos (+ (point-min) (length ":) 😄 ")))
(prettify-emoji-pos (+ (point-min) (length ":) 😄 :smile: "))))
+ (setq emojify-composed-text-p t)
(setq prettify-symbols-alist
'(("return" . ?↪)))
(setq emojify-composed-text-p t)
(when (fboundp 'prettify-symbols-mode)
- (prettify-symbols-mode +1))
+ (prettify-symbols-mode +1)
+ ;; On Emacs 25.1 fontification does not happen automatically
+ (when (fboundp 'font-lock-ensure) (font-lock-ensure)))
(emojify-set-emoji-styles '(ascii))
(emojify-tests-should-be-emojified ascii-emoji-pos)
@@ -396,49 +397,27 @@
:tags '(isearch)
(emojify-tests-with-emojified-buffer "Testing isearch\n:books:"
(with-mock
+ (setq emojify-reveal-on-isearch t)
;; We do not want to be bothered with isearch messages
(stub message => nil)
(emojify-tests-should-be-emojified (line-beginning-position 2))
(isearch-mode +1)
- (execute-kbd-macro ":book")
+ (execute-kbd-macro "boo")
;; Emoji should be uncovered when point enters it in isearch-mode
(emojify-tests-should-be-uncovered (line-beginning-position))
- (isearch-exit)
;; Emoji should be restored on leaving the underlying text
- (goto-char (point-min))
- (emojify-tests-should-be-emojified (line-beginning-position 2)))))
+ (execute-kbd-macro "")
+ (emojify-tests-should-be-emojified (line-beginning-position 2))
-(ert-deftest emojify-tests-uncover-on-isearch-multiple-matches ()
- :tags '(isearch)
- (emojify-tests-with-emojified-buffer "Testing isearch\n:book:\n:books:"
- (let ((first-emoji-pos (line-beginning-position 2))
- (second-emoji-pos (line-beginning-position 3)))
- (with-mock
- ;; We do not want to be bothered with isearch messages
- (stub message => nil)
- (emojify-tests-should-be-emojified first-emoji-pos)
- (emojify-tests-should-be-emojified second-emoji-pos)
-
- (isearch-mode +1)
- ;; isearch-printing-char in Emacs 24.3 did not accept
- ;; any arguments
- (let ((last-command-event ?b)) (isearch-printing-char))
- (let ((last-command-event ?o)) (isearch-printing-char))
-
- ;; TODO: For some reason first one actually repeats backwards when
- ;; called non-interactively As such 2 more repeats are needed first to
- ;; go back to first match and second to actually search forward
- (isearch-repeat 'forward)
- (isearch-repeat 'forward)
- (isearch-repeat 'forward)
-
- (emojify-tests-should-be-emojified first-emoji-pos)
- (emojify-tests-should-be-uncovered second-emoji-pos)
- (isearch-exit)
- ;; Emoji should be restored on leaving the underlying text
- (goto-char (point-min))
- (emojify-tests-should-be-emojified first-emoji-pos)
- (emojify-tests-should-be-emojified second-emoji-pos)))))
+ ;; Turn off revealing on isearch
+ (setq emojify-reveal-on-isearch nil)
+ ;; We do not want to be bothered with isearch messages
+ (stub message => nil)
+ (emojify-tests-should-be-emojified (line-beginning-position 2))
+ (isearch-mode +1)
+ (execute-kbd-macro "boo")
+ ;; Emoji should be uncovered when point enters it in isearch-mode
+ (emojify-tests-should-be-emojified (line-beginning-position)))))
(ert-deftest emojify-tests-electric-delete ()
:tags '(electric-delete)
@@ -510,11 +489,11 @@ return 4
(setq emojify-composed-text-p t)
(emojify-set-emoji-styles '(ascii unicode github))
(python-mode)
- (setq prettify-symbols-alist
- '(("return" . ?↪)
- ("try" . ?😱)
- ("except" . ?⛐)
- ("raise" . ?💥)))
+ (setq-local prettify-symbols-alist
+ '(("return" . ?↪)
+ ("try" . ?😱)
+ ("except" . ?⛐)
+ ("raise" . ?💥)))
(emojify-tests-should-not-be-emojified (point-min))
(emojify-tests-should-not-be-emojified (line-beginning-position 3))
(emojify-tests-should-not-be-emojified (+ (line-beginning-position 4) 5))
@@ -523,6 +502,10 @@ return 4
(emojify-tests-should-not-be-emojified (line-beginning-position 7))
(emojify-tests-should-not-be-emojified (line-beginning-position 8))
(prettify-symbols-mode +1)
+ ;; On Emacs 25.1 fontification does not happen automatically
+ (when (fboundp 'font-lock-ensure)
+ (font-lock-ensure)
+ (emojify-redisplay-emojis-in-region))
(emojify-tests-should-be-emojified (point-min))
(should (equal (get-text-property (point-min) 'emojify-text) "😱"))
(emojify-tests-should-not-be-emojified (line-beginning-position 3))
@@ -534,6 +517,10 @@ return 4
(emojify-tests-should-be-emojified (line-beginning-position 8))
(should (equal (get-text-property (line-beginning-position 8) 'emojify-text) "↪"))
(prettify-symbols-mode -1)
+ ;; On Emacs 25.1 fontification does not happen automatically
+ (when (fboundp 'font-lock-ensure)
+ (font-lock-ensure)
+ (emojify-redisplay-emojis-in-region))
(emojify-tests-should-not-be-emojified (point-min))
(emojify-tests-should-not-be-emojified (line-beginning-position 3))
(emojify-tests-should-not-be-emojified (+ (line-beginning-position 4) 5))
@@ -558,14 +545,18 @@ return 4
(setq emojify-composed-text-p t)
(emojify-set-emoji-styles '(ascii unicode github))
(python-mode)
- (setq prettify-symbols-alist
- '(("return" . ?↪)
- ("try" . ?😱)
- ("except" . ?⛐)
- ("lambda" . ?λ)
- ("raise" . ?💥)))
+ (setq-local prettify-symbols-alist
+ '(("return" . ?↪)
+ ("try" . ?😱)
+ ("except" . ?⛐)
+ ("lambda" . ?λ)
+ ("raise" . ?💥)))
(emojify-tests-should-not-be-emojified (+ (line-beginning-position 2) 5))
(prettify-symbols-mode +1)
+ ;; On Emacs 25.1 fontification does not happen automatically
+ (when (fboundp 'font-lock-ensure)
+ (font-lock-ensure)
+ (emojify-redisplay-emojis-in-region))
(emojify-tests-should-be-emojified (point-min))
(emojify-tests-should-be-emojified (+ (line-beginning-position 2) 5))
(emojify-tests-should-not-be-emojified (line-beginning-position 3))
diff --git a/test/test-helper.el b/test/test-helper.el
@@ -22,6 +22,8 @@
;; Libs required for tests
(require 'ert)
(require 'el-mock)
+(eval-when-compile
+ (require 'cl))
(require 'cl-lib)
(require 'noflet)
@@ -56,6 +58,7 @@ Helps isolate tests from each other's customizations."
(emojify-saved-inhibit-functions emojify-inhibit-functions)
(emojify-saved-point-entered-behaviour emojify-point-entered-behaviour)
(emojify-saved-show-help emojify-show-help)
+ (emojify-saved-reveal-on-isearch emojify-reveal-on-isearch)
(emojify-saved-composed-text-p emojify-composed-text-p))
(unwind-protect
(progn
@@ -75,6 +78,7 @@ Helps isolate tests from each other's customizations."
emojify-inhibit-functions emojify-saved-inhibit-functions
emojify-point-entered-behaviour emojify-saved-point-entered-behaviour
emojify-show-help emojify-saved-show-help
+ emojify-reveal-on-isearch emojify-saved-reveal-on-isearch
emojify-composed-text-p emojify-saved-composed-text-p)
(emojify-set-emoji-styles emojify-saved-emoji-style))))
@@ -117,43 +121,34 @@ All kinds of dynamic behaviour on buffer are disabled. See
(emojify-with-saved-buffer-state
,@forms)))
-(defmacro emojify-tests-should-be-emojified (point)
+(defun emojify-tests-should-be-emojified (point)
"Assert there is an emoji at POINT."
- `(progn
- (should-not (get-text-property ,point 'point-left))
- (should (get-text-property ,point 'emojified))
- (should (get-text-property ,point 'emojify-display))
- (should (get-text-property ,point 'emojify-buffer))
- (should (get-text-property ,point 'emojify-beginning))
- (should (get-text-property ,point 'emojify-end))
- (should (get-text-property ,point 'emojify-text))
- (should (get-text-property ,point 'display))
- (should (get-text-property ,point 'point-entered))))
-
-(defmacro emojify-tests-should-not-be-emojified (point)
+ (should (get-text-property point 'emojified))
+ (should (get-text-property point 'emojify-display))
+ (should (get-text-property point 'emojify-buffer))
+ (should (get-text-property point 'emojify-beginning))
+ (should (get-text-property point 'emojify-end))
+ (should (get-text-property point 'emojify-text))
+ (should (get-text-property point 'display)))
+
+(defun emojify-tests-should-not-be-emojified (point)
"Assert there is not emoji at POINT."
- `(progn
- (should-not (get-text-property ,point 'point-left))
- (should-not (get-text-property ,point 'emojified))
- (should-not (get-text-property ,point 'emojify-display))
- (should-not (get-text-property ,point 'emojify-buffer))
- (should-not (get-text-property ,point 'emojify-beginning))
- (should-not (get-text-property ,point 'emojify-end))
- (should-not (get-text-property ,point 'emojify-text))
- (should-not (get-text-property ,point 'display))
- (should-not (get-text-property ,point 'point-entered))))
-
-(defmacro emojify-tests-should-be-uncovered (point)
+ (should-not (get-text-property point 'emojified))
+ (should-not (get-text-property point 'emojify-display))
+ (should-not (get-text-property point 'emojify-buffer))
+ (should-not (get-text-property point 'emojify-beginning))
+ (should-not (get-text-property point 'emojify-end))
+ (should-not (get-text-property point 'emojify-text))
+ (should-not (get-text-property point 'display)))
+
+(defun emojify-tests-should-be-uncovered (point)
"Assert the emoji at POINT is uncovered."
- `(progn
- (should (get-text-property ,point 'point-left))
- (should (get-text-property ,point 'emojified))
- (should (get-text-property ,point 'emojify-buffer))
- (should (get-text-property ,point 'emojify-beginning))
- (should (get-text-property ,point 'emojify-end))
- (should (get-text-property ,point 'emojify-text))
- (should-not (get-text-property ,point 'point-entered))
- (should-not (get-text-property ,point 'display))))
+ (should (get-text-property point 'emojified))
+ (should (get-text-property point 'emojify-buffer))
+ (should (get-text-property point 'emojify-beginning))
+ (should (get-text-property point 'emojify-end))
+ (should (get-text-property point 'emojify-text))
+ (should-not (get-text-property point 'display)))
(provide 'test-helper)
;;; test-helper.el ends here
