emojify.el (93597B)
1 ;;; emojify.el --- Display emojis in Emacs -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2015-2018 Iqbal Ansari 4 5 ;; Author: Iqbal Ansari <iqbalansari02@yahoo.com> 6 ;; Keywords: multimedia, convenience 7 ;; URL: https://github.com/iqbalansari/emacs-emojify 8 ;; Version: 1.2.1 9 ;; Package-Requires: ((seq "1.11") (ht "2.0") (emacs "24.3")) 10 11 ;; This program is free software; you can redistribute it and/or modify 12 ;; it under the terms of the GNU General Public License as published by 13 ;; the Free Software Foundation, either version 3 of the License, or 14 ;; (at your option) any later version. 15 16 ;; This program is distributed in the hope that it will be useful, 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; GNU General Public License for more details. 20 21 ;; You should have received a copy of the GNU General Public License 22 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 23 24 ;;; Commentary: 25 26 ;; This package displays emojis in Emacs similar to how Github, Slack etc do. It 27 ;; can display plain ascii like ':)' as well as Github style emojis like ':smile:' 28 ;; 29 ;; It provides a minor mode `emojify-mode' to enable display of emojis in a buffer. 30 ;; To enable emojify mode globally use `global-emojify-mode' 31 ;; 32 ;; For detailed documentation see the projects README file at 33 ;; https://github.com/iqbalansari/emacs-emojify 34 35 36 37 ;;; Code: 38 39 (require 'seq) 40 (require 'ht) 41 42 (require 'subr-x nil :no-error) 43 (require 'cl-lib) 44 (require 'json) 45 (require 'regexp-opt) 46 (require 'jit-lock) 47 (require 'pcase) 48 (require 'tar-mode) 49 (require 'apropos) 50 51 52 53 ;; Satisfying the byte-compiler 54 ;; We do not "require" these functions but if `org-mode' is active we use them 55 56 ;; Required to determine point is in an org-list 57 (declare-function org-list-get-item-begin "org-list") 58 (declare-function org-at-heading-p "org") 59 60 ;; Required to determine the context is in an org-src block 61 (declare-function org-element-type "org-element") 62 (declare-function org-element-property "org-element") 63 (declare-function org-element-at-point "org-element") 64 (declare-function org-src-get-lang-mode "org-src") 65 (declare-function org-src--get-lang-mode "org-src") 66 67 ;; Required for integration with company-mode 68 (declare-function company-pseudo-tooltip-unhide "company") 69 70 ;; Shouldn't require 'jit-lock be enough :/ 71 (defvar jit-lock-start) 72 (defvar jit-lock-end) 73 74 ;; Used while inserting emojis using helm 75 (defvar helm-buffer) 76 (defvar helm-after-initialize-hook) 77 78 79 80 ;; Compatibility functions 81 82 (defun emojify-user-error (format &rest args) 83 "Signal a pilot error, making a message by passing FORMAT and ARGS to ‘format-message’." 84 (if (fboundp 'user-error) 85 (apply #'user-error format args) 86 (apply #'error format args))) 87 88 (defun emojify-face-height (face) 89 "Get font height for the FACE." 90 (let ((face-font (face-font face))) 91 (cond 92 ((and (display-multi-font-p) 93 ;; Avoid calling font-info if the frame's default font was 94 ;; not changed since the frame was created. That's because 95 ;; font-info is expensive for some fonts, see bug #14838. 96 (not (string= (frame-parameter nil 'font) face-font))) 97 (aref (font-info face-font) 3)) 98 (t (frame-char-height))))) 99 100 (defun emojify-default-font-height () 101 "Return the height in pixels of the current buffer's default face font. 102 103 `default-font-height' seems to be available only on Emacs versions after 24.3. 104 This provides a compatibility version for previous versions." 105 (if (fboundp 'default-font-height) 106 (default-font-height) 107 (emojify-face-height 'default))) 108 109 (defun emojify-overlays-at (pos &optional sorted) 110 "Return a list of the overlays that contain the character at POS. 111 If SORTED is non-nil, then sort them by decreasing priority. 112 113 The SORTED argument was introduced in Emacs 24.4, along with the incompatible 114 change that overlay priorities can be any Lisp object (earlier they were 115 restricted to integer and nil). This version uses the SORTED argument of 116 `overlays-at' on Emacs version 24.4 onwards and manually sorts the overlays by 117 priority on lower versions." 118 (if (version< emacs-version "24.4") 119 (let ((overlays-at-pos (overlays-at pos))) 120 (if sorted 121 (seq-sort (lambda (overlay1 overlay2) 122 (if (and (overlay-get overlay2 'priority) 123 (overlay-get overlay1 'priority)) 124 ;; If both overlays have priorities compare them 125 (< (overlay-get overlay1 'priority) 126 (overlay-get overlay2 'priority)) 127 ;; Otherwise overlay with nil priority is sorted below 128 ;; the one with integer value otherwise preserve order 129 (not (overlay-get overlay1 'priority)))) 130 overlays-at-pos) 131 overlays-at-pos)) 132 (overlays-at pos sorted))) 133 134 (defun emojify-string-join (strings &optional separator) 135 "Join all STRINGS using SEPARATOR. 136 137 This function is available on Emacs v24.4 and higher, it has been 138 backported here for compatibility with older Emacsen." 139 (if (fboundp 'string-join) 140 (apply #'string-join (list strings separator)) 141 (mapconcat 'identity strings separator))) 142 143 (defun emojify-provided-mode-derived-p (mode &rest modes) 144 "Non-nil if MODE is derived from one of MODES. 145 Uses the `derived-mode-parent' property of the symbol to trace backwards. 146 If you just want to check `major-mode', use `derived-mode-p'." 147 (if (fboundp 'provided-mode-derived-p) 148 (apply #'provided-mode-derived-p mode modes) 149 (while (and (not (memq mode modes)) 150 (setq mode (get mode 'derived-mode-parent)))) 151 mode)) 152 153 (defun emojify-org-src-get-lang-mode (lang) 154 "Return major mode that should be used for LANG. 155 LANG is a string, and the returned major mode is a symbol." 156 (if (fboundp 'org-src-get-lang-mode) 157 (org-src-get-lang-mode lang) 158 (org-src--get-lang-mode lang))) 159 160 161 162 ;; Debugging helpers 163 164 (define-minor-mode emojify-debug-mode 165 "Enable debugging for emojify-mode. 166 167 By default emojify silences any errors during emoji redisplay. This is done 168 since emojis are redisplayed using jit-lock (the same mechanism used for 169 font-lock) as such any bugs in the code can cause other important things to 170 fail. This also turns on jit-debug-mode so that (e)debugging emojify's redisplay 171 functions work." 172 :init-value nil 173 (if emojify-debug-mode 174 (when (fboundp 'jit-lock-debug-mode) 175 (jit-lock-debug-mode +1)) 176 (when (fboundp 'jit-lock-debug-mode) 177 (jit-lock-debug-mode -1)))) 178 179 (defmacro emojify-execute-ignoring-errors-unless-debug (&rest forms) 180 "Execute FORMS ignoring errors unless variable `emojify-debug-mode' is non-nil." 181 (declare (debug t) (indent 0)) 182 `(if emojify-debug-mode 183 (progn 184 ,@forms) 185 (ignore-errors 186 ,@forms))) 187 188 189 190 ;; Utility functions 191 192 ;; These should be bound dynamically by functions calling 193 ;; `emojify--inside-rectangle-selection-p' and 194 ;; `emojify--inside-non-rectangle-selection-p' to region-beginning and 195 ;; region-end respectively. This is needed mark the original region which is 196 ;; impossible to get after point moves during processing. 197 (defvar emojify-region-beg nil) 198 (defvar emojify-region-end nil) 199 200 ;; This should be bound dynamically to the location of point before emojify's 201 ;; display loop, this since getting the point after point moves during 202 ;; processing is impossible 203 (defvar emojify-current-point nil) 204 205 (defmacro emojify-with-saved-buffer-state (&rest forms) 206 "Execute FORMS saving current buffer state. 207 208 This saves point and mark, `match-data' and buffer modification state it also 209 inhibits buffer change, point motion hooks." 210 (declare (debug t) (indent 0)) 211 `(let ((inhibit-point-motion-hooks t) 212 (emojify-current-point (point)) 213 (emojify-region-beg (when (region-active-p) (region-beginning))) 214 (emojify-region-end (when (region-active-p) (region-end)))) 215 (with-silent-modifications 216 (save-match-data 217 (save-excursion 218 (save-restriction 219 (widen) 220 ,@forms)))))) 221 222 (defmacro emojify-do-for-emojis-in-region (beg end &rest forms) 223 "For all emojis between BEG and END, execute the given FORMS. 224 225 During the execution `emoji-start' and `emoji-end' are bound to the start 226 and end of the emoji for which the form is being executed." 227 (declare (debug t) (indent 2)) 228 `(let ((--emojify-loop-current-pos ,beg) 229 (--emojify-loop-end ,end) 230 (--emoji-positions nil) 231 --emoji-start) 232 (while (and (> --emojify-loop-end --emojify-loop-current-pos) 233 (setq --emoji-start (text-property-any --emojify-loop-current-pos --emojify-loop-end 'emojified t))) 234 (let ((--emoji-end (+ --emoji-start 235 (length (get-text-property --emoji-start 'emojify-text))))) 236 (push (cons --emoji-start --emoji-end) --emoji-positions) 237 (setq --emojify-loop-current-pos --emoji-end))) 238 (dolist (--position --emoji-positions) 239 (let ((emoji-start (car --position)) 240 (emoji-end (cdr --position))) 241 ,@forms)))) 242 243 (defun emojify-message (format-string &rest args) 244 "Log debugging messages to buffer named 'emojify-log'. 245 246 This is a substitute to `message' since using it during redisplay causes errors. 247 FORMAT-STRING and ARGS are same as the arguments to `message'." 248 (when emojify-debug-mode 249 (emojify-with-saved-buffer-state 250 (with-current-buffer (get-buffer-create "emojify-log") 251 (goto-char (point-max)) 252 (insert (apply #'format format-string args)) 253 (insert "\n"))))) 254 255 (defun emojify--get-relevant-region () 256 "Try getting region in buffer that completely covers the current window. 257 258 This is used instead of directly using `window-start' and `window-end', since 259 they return the values corresponding buffer in currently selected window, which 260 is incorrect if the buffer where there are called is not actually the buffer 261 visible in the selected window." 262 (let* ((window-size (- (window-end) (window-start))) 263 (start (max (- (point) window-size) (point-min))) 264 (end (min (+ (point) window-size) (point-max)))) 265 (cons start end))) 266 267 (defun emojify-quit-buffer () 268 "Hide the current buffer. 269 There are windows other than the one the current buffer is displayed in quit the 270 current window too." 271 (interactive) 272 (if (= (length (window-list)) 1) 273 (bury-buffer) 274 (quit-window))) 275 276 (defvar emojify-common-mode-map 277 (let ((map (make-sparse-keymap))) 278 (define-key map "q" #'emojify-quit-buffer) 279 (define-key map "n" #'next-line) 280 (define-key map "p" #'previous-line) 281 (define-key map "r" #'isearch-backward) 282 (define-key map "s" #'isearch-forward) 283 (define-key map ">" #'end-of-buffer) 284 (define-key map "<" #'beginning-of-buffer) 285 286 (dolist (key '("?" "h" "H")) 287 (define-key map key #'describe-mode)) 288 289 (dolist (number (number-sequence 0 9)) 290 (define-key map (number-to-string number) #'digit-argument)) 291 292 map) 293 "Common keybindings available in all special emojify buffers.") 294 295 296 297 ;; Customizations for control how emojis are displayed 298 299 (defgroup emojify nil 300 "Customization options for emojify" 301 :group 'display 302 :prefix "emojify-") 303 304 (defcustom emojify-emoji-json 305 (expand-file-name "data/emoji.json" 306 (cond (load-file-name (file-name-directory load-file-name)) 307 ((locate-library "emojify") (file-name-directory (locate-library "emojify"))) 308 (t default-directory))) 309 "The path to JSON file containing the configuration for displaying emojis." 310 :type 'file 311 :group 'emojify) 312 313 (defvar emojify-emoji-set-json 314 (let ((json-array-type 'list) 315 (json-object-type 'hash-table)) 316 (json-read-file (expand-file-name "data/emoji-sets.json" 317 (cond (load-file-name (file-name-directory load-file-name)) 318 ((locate-library "emojify") (file-name-directory (locate-library "emojify"))) 319 (t default-directory)))))) 320 321 (defcustom emojify-emoji-set "emojione-v2.2.6-22" 322 "The emoji set used to display emojis." 323 :type (append '(radio :tag "Emoji set") 324 (mapcar (lambda (set) (list 'const set)) 325 (ht-keys emojify-emoji-set-json))) 326 :group 'emojify) 327 328 (defcustom emojify-emojis-dir 329 (locate-user-emacs-file "emojis") 330 "Path to the directory containing the emoji images." 331 :type 'directory 332 :group 'emojify) 333 334 (defcustom emojify-display-style 335 'image 336 "How the emoji's be displayed. 337 338 Possible values are 339 `image' - Display emojis using images, this requires images are supported by 340 user's Emacs installation 341 `unicode' - Display emojis using unicode characters, this works well on 342 platforms with good emoji fonts. In this case the emoji text 343 ':wink:' will be substituted with 😉. 344 `ascii' - Display emojis as ascii characters, this is simplest and does not 345 require any external dependencies. In this cases emoji text like 346 ':wink:' are substituted with ascii equivalents like ';)'" 347 :type '(radio :tag "Emoji display style" 348 (const :tag "Display emojis as images" image) 349 (const :tag "Display emojis as unicode characters" unicode) 350 (const :tag "Display emojis as ascii string" ascii)) 351 :group 'emojify) 352 353 354 355 ;; Customizations to control the enabling of emojify-mode 356 357 (defcustom emojify-inhibit-major-modes 358 '(dired-mode 359 doc-view-mode 360 debugger-mode 361 pdf-view-mode 362 image-mode 363 help-mode 364 ibuffer-mode 365 magit-popup-mode 366 magit-diff-mode 367 ert-results-mode 368 compilation-mode 369 proced-mode 370 mu4e-headers-mode 371 deft-mode) 372 "Major modes where emojify mode should not be enabled." 373 :type '(repeat symbol) 374 :group 'emojify) 375 376 (defcustom emojify-inhibit-in-buffer-functions 377 '(emojify-minibuffer-p emojify-helm-buffer-p) 378 "Functions used inhibit emojify-mode in a buffer. 379 380 These functions are called with one argument, the buffer where command 381 ‘emojify-mode’ is about to be enabled, emojify is not enabled if any of the 382 functions return a non-nil value." 383 :type 'hook 384 :group 'emojify) 385 386 (defvar emojify-inhibit-emojify-in-current-buffer-p nil 387 "Should emojify be inhibited in current buffer. 388 389 This is a buffer local variable that can be set to inhibit enabling of 390 emojify in a buffer.") 391 (make-variable-buffer-local 'emojify-inhibit-emojify-in-current-buffer-p) 392 393 (defvar emojify-minibuffer-reading-emojis-p nil 394 "Are we currently reading emojis using minibuffer?") 395 396 (defun emojify-ephemeral-buffer-p (buffer) 397 "Determine if BUFFER is an ephemeral/temporary buffer." 398 (and (not (minibufferp)) 399 (string-match-p "^ " (buffer-name buffer)))) 400 401 (defun emojify-inhibit-major-mode-p (buffer) 402 "Determine if user has disabled the `major-mode' enabled for the BUFFER. 403 404 Returns non-nil if the buffer's major mode is part of `emojify-inhibit-major-modes'" 405 (with-current-buffer buffer 406 (apply #'derived-mode-p emojify-inhibit-major-modes))) 407 408 (defun emojify-helm-buffer-p (buffer) 409 "Determine if the current BUFFER is a helm buffer." 410 (unless emojify-minibuffer-reading-emojis-p 411 (string-match-p "\\*helm" (buffer-name buffer)))) 412 413 (defun emojify-minibuffer-p (buffer) 414 "Determine if the current BUFFER is a minibuffer." 415 (unless emojify-minibuffer-reading-emojis-p 416 (minibufferp buffer))) 417 418 (defun emojify-buffer-p (buffer) 419 "Determine if `emojify-mode' should be enabled for given BUFFER. 420 421 `emojify-mode' mode is not enabled in temporary buffers. Additionally user 422 can customize `emojify-inhibit-major-modes' and 423 `emojify-inhibit-in-buffer-functions' to disabled emojify in additional buffers." 424 (not (or emojify-inhibit-emojify-in-current-buffer-p 425 (emojify-ephemeral-buffer-p (current-buffer)) 426 (emojify-inhibit-major-mode-p (current-buffer)) 427 (buffer-base-buffer buffer) 428 (run-hook-with-args-until-success 'emojify-inhibit-in-buffer-functions buffer)))) 429 430 431 432 ;; Obsolete vars 433 434 (define-obsolete-variable-alias 'emojify-emoji-style 'emojify-emoji-styles "0.2") 435 (define-obsolete-function-alias 'emojify-set-emoji-style 'emojify-set-emoji-styles "0.2") 436 437 438 439 ;; Customizations to control display of emojis 440 441 (defvar emojify-emoji-style-change-hook nil 442 "Hooks run when emoji style changes.") 443 444 ;;;###autoload 445 (defun emojify-set-emoji-styles (styles) 446 "Set the type of emojis that should be displayed. 447 448 STYLES is the styles emoji styles that should be used, see `emojify-emoji-styles'" 449 (when (not (listp styles)) 450 (setq styles (list styles)) 451 (warn "`emojify-emoji-style' has been deprecated use `emojify-emoji-styles' instead!")) 452 453 (setq-default emojify-emoji-styles styles) 454 455 (run-hooks 'emojify-emoji-style-change-hook)) 456 457 (defcustom emojify-emoji-styles 458 '(ascii unicode github) 459 "The type of emojis that should be displayed. 460 461 These can have one of the following values 462 463 `ascii' - Display only ascii emojis for example ';)' 464 `unicode' - Display only unicode emojis for example '😉' 465 `github' - Display only github style emojis for example ':wink:'" 466 :type '(set 467 (const :tag "Display only ascii emojis" ascii) 468 (const :tag "Display only github emojis" github) 469 (const :tag "Display only unicode codepoints" unicode)) 470 :set (lambda (_ value) (emojify-set-emoji-styles value)) 471 :group 'emojify) 472 473 (defcustom emojify-program-contexts 474 '(comments string code) 475 "Contexts where emojis can be displayed in programming modes. 476 477 Possible values are 478 `comments' - Display emojis in comments 479 `string' - Display emojis in strings 480 `code' - Display emojis in code (this is applicable only for unicode emojis)" 481 :type '(set :tag "Contexts where emojis should be displayed in programming modes" 482 (const :tag "Display emojis in comments" comments) 483 (const :tag "Display emojis in string" string) 484 (const :tag "Display emojis in code" code)) 485 :group 'emojify) 486 487 (defcustom emojify-inhibit-functions 488 '(emojify-in-org-tags-p emojify-in-org-list-p) 489 "Functions used to determine given emoji should displayed at current point. 490 491 These functions are called with 3 arguments, the text to be emojified, the start 492 of emoji text and the end of emoji text. These functions are called with the 493 buffer where emojis are going to be displayed selected." 494 :type 'hook 495 :group 'emojify) 496 497 (defcustom emojify-completing-read-function #'completing-read 498 "Require same argument with `completing-read'." 499 :type 'function 500 :group 'emojify) 501 502 (defcustom emojify-composed-text-p t 503 "Should composed text be emojified." 504 :type 'boolean 505 :group 'emojify) 506 507 (defcustom emojify-company-tooltips-p t 508 "Should company mode tooltips be emojified." 509 :type 'boolean 510 :group 'emojify) 511 512 (defun emojify-in-org-tags-p (match beg _end) 513 "Determine whether the point is on `org-mode' tag. 514 515 MATCH, BEG and _END are the text currently matched emoji and the start position 516 and end position of emoji text respectively. 517 518 Easiest would have to inspect face at point but unfortunately, there is no 519 way to guarantee that we run after font-lock" 520 (and (memq major-mode '(org-mode org-agenda-mode)) 521 (string-match-p ":[^:]+[:]?" match) 522 (org-at-heading-p) 523 (save-excursion 524 (save-match-data 525 (goto-char beg) 526 ;; Regex for tag picked from https://code.orgmode.org/bzg/org-mode/src/master/lisp/org.el#L589-L590 527 (looking-at ":[[:alnum:]_@#%:]+:[\s-]*$"))))) 528 529 (defun emojify-in-org-list-p (text beg &rest ignored) 530 "Determine whether the point is in `org-mode' list. 531 532 TEXT is the text which is supposed to rendered a an emoji. BEG is the beginning 533 of the emoji text in the buffer. The arguments IGNORED are ignored." 534 (and (eq major-mode 'org-mode) 535 (equal text "8)") 536 (equal (org-list-get-item-begin) beg))) 537 538 (defun emojify-program-context-at-point-per-syntax-table (beg end) 539 "Determine the progamming context between BEG and END using the the syntax table." 540 (let ((syntax-beg (syntax-ppss beg)) 541 (syntax-end (syntax-ppss end))) 542 (cond ((and (nth 3 syntax-beg) (nth 3 syntax-end)) 'string) 543 ((and (nth 4 syntax-beg) (nth 4 syntax-end)) 'comments) 544 (t 'code)))) 545 546 (defun emojify-program-context-at-point-per-face (beg _end) 547 "Determine the progamming context between BEG and END using the the face. 548 549 Used when the major mode for which we need to check the program context is not 550 the same as the current buffer's major mode, currently only used when displaying 551 emojis in org source blocks." 552 (let* ((face-at-point (get-text-property beg 'face)) 553 (faces-at-point (if (listp face-at-point) 554 face-at-point 555 (list face-at-point)))) 556 (cond ((memql 'font-lock-doc-face faces-at-point) 'string) 557 ((memql 'font-lock-string-face faces-at-point) 'string) 558 ((memql 'font-lock-comment-face faces-at-point) 'comments) 559 (t 'code)))) 560 561 562 (defun emojify-valid-program-context-p (emoji beg end &optional use-faces) 563 "Determine if EMOJI should be displayed for text between BEG and END. 564 565 If the optional USE-FACES is true, the programming context is determined using 566 faces. This returns non-nil if the region is valid according to 567 `emojify-program-contexts'" 568 (when emojify-program-contexts 569 (let ((context (if use-faces 570 (emojify-program-context-at-point-per-face beg end) 571 (emojify-program-context-at-point-per-syntax-table beg end)))) 572 (and (memql context emojify-program-contexts) 573 (if (equal context 'code) 574 (and (string= (ht-get emoji "style") "unicode") 575 (memql 'unicode emojify-emoji-styles)) 576 t))))) 577 578 (defun emojify-org-src-lang-at-point (point) 579 "Return the `major-mode' for the org source block at POINT. 580 581 Returns nil if the point is not at an org source block" 582 (when (eq major-mode 'org-mode) 583 (save-excursion 584 (goto-char point) 585 (let ((element (org-element-at-point))) 586 (when (eq (org-element-type element) 'src-block) 587 (emojify-org-src-get-lang-mode (org-element-property :language element))))))) 588 589 (defun emojify-looking-at-end-of-list-maybe (point) 590 "Determine if POINT is end of a list. 591 592 This is not accurate since it restricts the region to scan to 593 the visible area." 594 (let* ((area (emojify--get-relevant-region)) 595 (beg (car area)) 596 (end (cdr area))) 597 (save-restriction 598 (narrow-to-region beg end) 599 (let ((list-start (ignore-errors (scan-sexps point -1)))) 600 (when (and list-start 601 ;; Ignore the starting brace if it is an emoji 602 (not (get-text-property list-start 'emojified))) 603 ;; If we got a list start make sure both start and end 604 ;; belong to same string/comment 605 (let ((syntax-beg (syntax-ppss list-start)) 606 (syntax-end (syntax-ppss point))) 607 (and list-start 608 (eq (nth 8 syntax-beg) 609 (nth 8 syntax-end))))))))) 610 611 (defun emojify-valid-ascii-emoji-context-p (beg end) 612 "Determine if the okay to display ascii emoji between BEG and END." 613 ;; The text is at the start of the buffer 614 (and (or (not (char-before beg)) 615 ;; 32 space since ? (? followed by a space) is not readable 616 ;; 34 is " since?" confuses font-lock 617 ;; 41 is ) since?) (extra paren) confuses most packages 618 (memq (char-syntax (char-before beg)) 619 ;; space 620 '(32 621 ;; start/end of string 622 34 623 ;; whitespace syntax 624 ?- 625 ;; comment start 626 ?< 627 ;; comment end, this handles text at start of line immediately 628 ;; after comment line in a multiline comment 629 ?>))) 630 ;; The text is at the end of the buffer 631 (or (not (char-after end)) 632 (memq (char-syntax (char-after end)) 633 ;; space 634 '(32 635 ;; start/end of string 636 34 637 ;; whitespace syntax 638 ?- 639 ;; punctuation 640 ?. 641 ;; closing braces 642 41 643 ;; comment end 644 ?>))))) 645 646 647 648 ;; Customizations to control the behaviour when point enters emojified text 649 650 (defcustom emojify-point-entered-behaviour 'echo 651 "The behaviour when point enters, an emojified text. 652 653 It can be one of the following 654 `echo' - Echo the underlying text in the minibuffer 655 `uncover' - Display the underlying text while point is on it 656 function - It is called with 2 arguments (the buffer where emoji appears is 657 current during execution) 658 1) starting position of emoji text 659 2) ending position of emoji text 660 661 Does nothing if the value is anything else." 662 ;; TODO: Mention custom function 663 :type '(radio :tag "Behaviour when point enters an emoji" 664 (const :tag "Echo the underlying emoji text in the minibuffer" echo) 665 (const :tag "Uncover (undisplay) the underlying emoji text" uncover)) 666 :group 'emojify) 667 668 (defcustom emojify-reveal-on-isearch t 669 "Should underlying emoji be displayed when point enters emoji while in isearch mode." 670 :type 'boolean 671 :group 'emojify) 672 673 (defcustom emojify-show-help t 674 "If non-nil the underlying text is displayed in a popup when mouse moves over it." 675 :type 'boolean 676 :group 'emojify) 677 678 (defun emojify-on-emoji-enter (beginning end) 679 "Executed when point enters emojified text between BEGINNING and END." 680 (cond ((and (eq emojify-point-entered-behaviour 'echo) 681 ;; Do not echo in isearch-mode 682 (not isearch-mode) 683 (not (active-minibuffer-window)) 684 (not (current-message))) 685 (message (substring-no-properties (get-text-property beginning 'emojify-text)))) 686 ((eq emojify-point-entered-behaviour 'uncover) 687 (put-text-property beginning end 'display nil)) 688 ((functionp 'emojify-point-entered-behaviour) 689 (funcall emojify-point-entered-behaviour beginning end))) 690 691 (when (and isearch-mode emojify-reveal-on-isearch) 692 (put-text-property beginning end 'display nil))) 693 694 (defun emojify-on-emoji-exit (beginning end) 695 "Executed when point exits emojified text between BEGINNING and END." 696 (put-text-property beginning 697 end 698 'display 699 (get-text-property beginning 'emojify-display))) 700 701 (defvar-local emojify--last-emoji-pos nil) 702 703 (defun emojify-detect-emoji-entry/exit () 704 "Detect emoji entry and exit and run appropriate handlers. 705 706 This is inspired by `prettify-symbol-mode's logic for 707 `prettify-symbols-unprettify-at-point'." 708 (emojify-with-saved-buffer-state 709 (when emojify--last-emoji-pos 710 (emojify-on-emoji-exit (car emojify--last-emoji-pos) (cdr emojify--last-emoji-pos))) 711 712 (when (get-text-property (point) 'emojified) 713 (let* ((text-props (text-properties-at (point))) 714 (buffer (plist-get text-props 'emojify-buffer)) 715 (match-beginning (plist-get text-props 'emojify-beginning)) 716 (match-end (plist-get text-props 'emojify-end))) 717 (when (eq buffer (current-buffer)) 718 (emojify-on-emoji-enter match-beginning match-end) 719 (setq emojify--last-emoji-pos (cons match-beginning match-end))))))) 720 721 (defun emojify-help-function (_window _string pos) 722 "Function to get help string to be echoed when point/mouse into the point. 723 724 To understand WINDOW, STRING and POS see the function documentation for 725 `help-echo' text-property." 726 (when (and emojify-show-help 727 (not isearch-mode) 728 (not (active-minibuffer-window)) 729 (not (current-message))) 730 (plist-get (text-properties-at pos) 'emojify-text))) 731 732 733 734 ;; Core functions and macros 735 736 ;; Variables related to user emojis 737 738 (defcustom emojify-user-emojis nil 739 "User specified custom emojis. 740 741 This is an alist where first element of cons is the text to be displayed as 742 emoji, while the second element of the cons is an alist containing data about 743 the emoji. 744 745 The inner alist should have atleast (not all keys are strings) 746 747 `name' - The name of the emoji 748 `style' - This should be one of \"github\", \"ascii\" or \"github\" 749 (see `emojify-emoji-styles') 750 751 The alist should contain one of (see `emojify-display-style') 752 `unicode' - The replacement for the provided emoji for \"unicode\" display style 753 `image' - The replacement for the provided emoji for \"image\" display style. 754 This should be the absolute path to the image 755 `ascii' - The replacement for the provided emoji for \"ascii\" display style 756 757 Example - 758 The following assumes that custom images are at ~/.emacs.d/emojis/trollface.png and 759 ~/.emacs.d/emojis/neckbeard.png 760 761 '((\":troll:\" . ((\"name\" . \"Troll\") 762 (\"image\" . \"~/.emacs.d/emojis/trollface.png\") 763 (\"style\" . \"github\"))) 764 (\":neckbeard:\" . ((\"name\" . \"Neckbeard\") 765 (\"image\" . \"~/.emacs.d/emojis/neckbeard.png\") 766 (\"style\" . \"github\"))))" 767 :type '(alist :key-type string 768 :value-type (alist :key-type string 769 :value-type string)) 770 :group 'emojify) 771 772 (defvar emojify--user-emojis nil 773 "User specified custom emojis.") 774 775 (defvar emojify--user-emojis-regexp nil 776 "Regexp to match user specified custom emojis.") 777 778 ;; Variables related to default emojis 779 (defvar emojify-emojis nil 780 "Data about the emojis, this contains only the emojis that come with emojify.") 781 782 (defvar emojify-regexps nil 783 "List of regexps to match text to be emojified.") 784 785 (defvar emojify--completing-candidates-cache nil 786 "Cached values for completing read candidates calculated for `emojify-completing-read'.") 787 788 ;; Cache for emoji completing read candidates 789 (defun emojify--get-completing-read-candidates () 790 "Get the candidates to be used for `emojify-completing-read'. 791 792 The candidates are calculated according to currently active 793 `emojify-emoji-styles' and cached" 794 (let ((styles (mapcar #'symbol-name emojify-emoji-styles))) 795 (unless (and emojify--completing-candidates-cache 796 (equal styles (car emojify--completing-candidates-cache))) 797 (setq emojify--completing-candidates-cache 798 (cons styles 799 (let ((emojis '())) 800 (emojify-emojis-each (lambda (key value) 801 (when (seq-position styles (ht-get value "style")) 802 (push (format "%s - %s (%s)" 803 key 804 (ht-get value "name") 805 (ht-get value "style")) 806 emojis)))) 807 emojis)))) 808 (cdr emojify--completing-candidates-cache))) 809 810 (defun emojify-create-emojify-emojis (&optional force) 811 "Create `emojify-emojis' if needed. 812 813 The function avoids reading emoji data if it has already been read unless FORCE 814 in which case emoji data is re-read." 815 (when (or force (not emojify-emojis)) 816 (emojify-set-emoji-data))) 817 818 (defun emojify-get-emoji (emoji) 819 "Get data for given EMOJI. 820 821 This first looks for the emoji in `emojify--user-emojis', 822 and then in `emojify-emojis'." 823 (or (when emojify--user-emojis 824 (ht-get emojify--user-emojis emoji)) 825 (ht-get emojify-emojis emoji))) 826 827 (defun emojify-emojis-each (function) 828 "Execute FUNCTION for each emoji. 829 830 This first runs function for `emojify--user-emojis', 831 and then `emojify-emojis'." 832 (when emojify--user-emojis 833 (ht-each function emojify--user-emojis)) 834 (ht-each function emojify-emojis)) 835 836 (defun emojify--verify-user-emojis (emojis) 837 "Verify the EMOJIS in correct user format." 838 (seq-every-p (lambda (emoji) 839 (and (assoc "name" (cdr emoji)) 840 ;; Make sure style is present is only one of 841 ;; "unicode", "ascii" and "github". 842 (assoc "style" (cdr emoji)) 843 (seq-position '("unicode" "ascii" "github") 844 (cdr (assoc "style" (cdr emoji)))) 845 (or (assoc "unicode" (cdr emoji)) 846 (assoc "image" (cdr emoji)) 847 (assoc "ascii" (cdr emoji))))) 848 emojis)) 849 850 (defun emojify-set-emoji-data () 851 "Read the emoji data for STYLES and set the regexp required to search them." 852 (setq-default emojify-emojis (let ((json-array-type 'list) 853 (json-object-type 'hash-table)) 854 (json-read-file emojify-emoji-json))) 855 856 (let (unicode-emojis ascii-emojis) 857 (ht-each (lambda (emoji data) 858 (when (string= (ht-get data "style") "unicode") 859 (push emoji unicode-emojis)) 860 861 (when (string= (ht-get data "style") "ascii") 862 (push emoji ascii-emojis))) 863 emojify-emojis) 864 865 ;; Construct emojify-regexps such that github style are searched first 866 ;; followed by unicode and then ascii emojis. 867 (setq emojify-regexps (list ":[[:alnum:]+_-]+:" 868 (regexp-opt unicode-emojis) 869 (regexp-opt ascii-emojis)))) 870 871 (when emojify-user-emojis 872 (if (emojify--verify-user-emojis emojify-user-emojis) 873 ;; Create entries for user emojis 874 (let ((emoji-pairs (mapcar (lambda (user-emoji) 875 (cons (car user-emoji) 876 (ht-from-alist (cdr user-emoji)))) 877 emojify-user-emojis))) 878 (setq emojify--user-emojis (ht-from-alist emoji-pairs)) 879 (setq emojify--user-emojis-regexp (regexp-opt (mapcar #'car emoji-pairs)))) 880 (message "[emojify] User emojis are not in correct format ignoring them."))) 881 882 (emojify-emojis-each (lambda (emoji data) 883 ;; Add the emoji text to data, this makes the values 884 ;; of the `emojify-emojis' standalone containing all 885 ;; data about the emoji 886 (ht-set! data "emoji" emoji) 887 (ht-set! data "custom" (and emojify--user-emojis 888 (ht-get emojify--user-emojis emoji))))) 889 890 ;; Clear completion candidates cache 891 (setq emojify--completing-candidates-cache nil)) 892 893 (defvar emojify-emoji-keymap 894 (let ((map (make-sparse-keymap))) 895 (define-key map [remap delete-char] #'emojify-delete-emoji-forward) 896 (define-key map [remap delete-forward-char] #'emojify-delete-emoji-forward) 897 (define-key map [remap backward-delete-char] #'emojify-delete-emoji-backward) 898 (define-key map [remap org-delete-backward-char] #'emojify-delete-emoji-backward) 899 (define-key map [remap delete-backward-char] #'emojify-delete-emoji-backward) 900 (define-key map [remap backward-delete-char-untabify] #'emojify-delete-emoji-backward) 901 map)) 902 903 (defun emojify-image-dir () 904 "Get the path to directory containing images for currently selected emoji set." 905 (expand-file-name emojify-emoji-set 906 emojify-emojis-dir)) 907 908 (defun emojify--get-point-col-and-line (point) 909 "Return a cons of containing the column number and line at POINT." 910 (save-excursion 911 (goto-char point) 912 (cons (current-column) (line-number-at-pos)))) 913 914 (defun emojify--get-characters-for-composition (composition) 915 "Extract the characters from COMPOSITION." 916 (if (nth 3 composition) 917 (nth 2 composition) 918 (let ((index -1)) 919 (seq-filter #'identity 920 (seq-map (lambda (elt) 921 (cl-incf index) 922 (when (cl-evenp index) elt)) 923 (nth 2 composition)))))) 924 925 (defun emojify--get-composed-text (point) 926 "Get the text used as composition property at POINT. 927 928 This does not check if there is composition property at point the callers should 929 make sure the point has a composition property otherwise this function will 930 fail." 931 (let* ((composition (find-composition point nil nil t)) 932 (characters (emojify--get-characters-for-composition composition))) 933 (emojify-string-join (seq-map #'char-to-string characters)))) 934 935 (defun emojify--inside-rectangle-selection-p (beg end) 936 "Check if region marked by BEG and END is inside a rectangular selection. 937 938 In addition to explicit the parameters BEG and END, calling functions should 939 also dynamically bind `emojify-region-beg' and `emojify-region-end' to beginning 940 and end of region respectively." 941 (when (and emojify-region-beg 942 (bound-and-true-p rectangle-mark-mode)) 943 (let ((rect-beg (emojify--get-point-col-and-line emojify-region-beg)) 944 (rect-end (emojify--get-point-col-and-line emojify-region-end)) 945 (emoji-start-pos (emojify--get-point-col-and-line beg)) 946 (emoji-end-pos (emojify--get-point-col-and-line end))) 947 (or (and (<= (car rect-beg) (car emoji-start-pos)) 948 (<= (car emoji-start-pos) (car rect-end)) 949 (<= (cdr rect-beg) (cdr emoji-start-pos)) 950 (<= (cdr emoji-start-pos) (cdr rect-end))) 951 (and (<= (car rect-beg) (car emoji-end-pos)) 952 (<= (car emoji-end-pos) (car rect-end)) 953 (<= (cdr rect-beg) (cdr emoji-end-pos)) 954 (<= (cdr emoji-end-pos) (cdr rect-end))))))) 955 956 (defun emojify--inside-non-rectangle-selection-p (beg end) 957 "Check if region marked by BEG and END is inside a non-regular selection. 958 959 In addition to the explicit parameters BEG and END, calling functions should 960 also dynamically bind `emojify-region-beg' and `emojify-region-end' to beginning 961 and end of region respectively." 962 (when (and emojify-region-beg 963 (region-active-p) 964 (not (bound-and-true-p rectangle-mark-mode))) 965 (or (and (< emojify-region-beg beg) 966 (<= beg emojify-region-end)) 967 (and (< emojify-region-beg end) 968 (<= end emojify-region-end))))) 969 970 (defun emojify--region-background-maybe (beg end) 971 "If the BEG and END falls inside an active region return the region face. 972 973 This returns nil if the emojis between BEG and END do not fall in region." 974 ;; `redisplay-highlight-region-function' was not defined in Emacs 24.3 975 (when (and (or (not (boundp 'redisplay-highlight-region-function)) 976 (equal (default-value 'redisplay-highlight-region-function) redisplay-highlight-region-function)) 977 (or (emojify--inside-non-rectangle-selection-p beg end) 978 (emojify--inside-rectangle-selection-p beg end))) 979 (face-background 'region))) 980 981 (defun emojify--get-image-background (beg end) 982 "Get the color to be used as background for emoji between BEG and END." 983 ;; We do a separate check for region since `background-color-at-point' 984 ;; does not always detect background color inside regions properly 985 (or (emojify--region-background-maybe beg end) 986 (save-excursion 987 (goto-char beg) 988 (condition-case nil 989 (background-color-at-point) 990 (wrong-type-argument nil))))) 991 992 (defvar emojify--imagemagick-support-cache (ht-create)) 993 994 (defun emojify--imagemagick-supports-p (format) 995 "Check if imagemagick support given FORMAT. 996 997 This function caches the result of the check since the naive check 998 999 (memq format (imagemagick-types)) 1000 1001 can be expensive if `imagemagick-types' returns a large list, this is 1002 especially problematic since this check is potentially called during 1003 very redisplay. See https://github.com/iqbalansari/emacs-emojify/issues/41" 1004 (when (fboundp 'imagemagick-types) 1005 (when (equal (ht-get emojify--imagemagick-support-cache format 'unset) 'unset) 1006 (ht-set emojify--imagemagick-support-cache format (memq format (imagemagick-types)))) 1007 (ht-get emojify--imagemagick-support-cache format))) 1008 1009 (defun emojify--get-image-display (data buffer beg end &optional target) 1010 "Get the display text property to display the emoji as an image. 1011 1012 DATA holds the emoji data, _BUFFER is the target buffer where the emoji is to be 1013 displayed, BEG and END delimit the region where emoji will be displayed. For 1014 explanation of TARGET see the documentation of `emojify--get-text-display-props'. 1015 1016 TODO: Perhaps TARGET should be generalized to work with overlays, buffers and 1017 other different display constructs, for now this works." 1018 (when (ht-get data "image") 1019 (let* ((image-file (expand-file-name (ht-get data "image") 1020 (emojify-image-dir))) 1021 (image-type (intern (upcase (file-name-extension image-file))))) 1022 (when (file-exists-p image-file) 1023 (create-image image-file 1024 ;; use imagemagick if available and supports PNG images 1025 ;; (allows resizing images) 1026 (when (emojify--imagemagick-supports-p image-type) 1027 'imagemagick) 1028 nil 1029 :ascent 'center 1030 :heuristic-mask t 1031 :background (cond ((equal target 'mode-line) 1032 (face-background 'mode-line nil 'default)) 1033 (t (emojify--get-image-background beg end))) 1034 ;; no-op if imagemagick is not available 1035 :scale 1 1036 :height (cond ((bufferp target) 1037 (with-current-buffer target 1038 (emojify-default-font-height))) 1039 ((equal target 'mode-line) 1040 (emojify-face-height 'mode-line)) 1041 (t (with-current-buffer buffer 1042 (emojify-default-font-height))))))))) 1043 1044 (defun emojify--get-unicode-display (data &rest ignored) 1045 "Get the display text property to display the emoji as an unicode character. 1046 1047 DATA holds the emoji data, rest of the arguments IGNORED are ignored" 1048 (let* ((unicode (ht-get data "unicode")) 1049 (characters (when unicode 1050 (string-to-vector unicode)))) 1051 (when (seq-every-p #'char-displayable-p characters) 1052 unicode))) 1053 1054 (defun emojify--get-ascii-display (data &rest ignored) 1055 "Get the display text property to display the emoji as an ascii characters. 1056 1057 DATA holds the emoji data, rest of the arguments IGNORED are ignored." 1058 (ht-get data "ascii")) 1059 1060 (defun emojify--get-text-display-props (emoji buffer beg end &optional target) 1061 "Get the display property for an EMOJI. 1062 1063 BUFFER is the buffer currently holding the EMOJI, BEG and END delimit the region 1064 containing the emoji. TARGET can either be a buffer object or a special value 1065 mode-line. It is used to indicate where EMOJI would be displayed, properties 1066 like font-height are inherited from TARGET if provided." 1067 (funcall (pcase emojify-display-style 1068 (`image #'emojify--get-image-display) 1069 (`unicode #'emojify--get-unicode-display) 1070 (`ascii #'emojify--get-ascii-display)) 1071 emoji 1072 buffer 1073 beg 1074 end 1075 target)) 1076 1077 (defun emojify--propertize-text-for-emoji (emoji text buffer start end &optional target) 1078 "Display EMOJI for TEXT in BUFFER between START and END. 1079 1080 For explanation of TARGET see the documentation of 1081 `emojify--get-text-display-props'." 1082 (let ((display-prop 1083 (emojify--get-text-display-props emoji buffer start end target)) 1084 (buffer-props (unless target 1085 (list 'emojify-buffer buffer 1086 'emojify-beginning (copy-marker start) 1087 'emojify-end (copy-marker end) 1088 'yank-handler (list nil text) 1089 'keymap emojify-emoji-keymap 1090 'help-echo #'emojify-help-function)))) 1091 (when display-prop 1092 (add-text-properties start 1093 end 1094 (append (list 'emojified t 1095 'emojify-display display-prop 1096 'display display-prop 1097 'emojify-text text) 1098 buffer-props))))) 1099 1100 (defun emojify-display-emojis-in-region (beg end &optional target) 1101 "Display emojis in region. 1102 1103 BEG and END are the beginning and end of the region respectively. TARGET 1104 is used to determine the background color and size of emojis, by default 1105 the current buffer is used to determine these, see 1106 `emojify--get-text-display-props' for more details. 1107 1108 Displaying happens in two phases, first search based phase displays actual text 1109 appearing in buffer as emojis. In the next phase composed text is searched for 1110 emojis and displayed. 1111 1112 A minor problem here is that if the text is composed after this display loop it 1113 would not be displayed as emoji, although in practice the two packages that use 1114 the composition property `prettify-symbol-mode' and `org-bullets' use the 1115 font-lock machinery which runs before emojify's display loop, so hopefully this 1116 should not be a problem 🤞." 1117 (emojify-with-saved-buffer-state 1118 ;; Make sure we halt if displaying emojis takes more than a second (this 1119 ;; might be too large duration) 1120 (with-timeout (1 (emojify-message "Failed to display emojis under 1 second")) 1121 (seq-doseq (regexp (apply #'append 1122 (when emojify--user-emojis-regexp 1123 (list emojify--user-emojis-regexp)) 1124 (list emojify-regexps))) 1125 (let (case-fold-search) 1126 (goto-char beg) 1127 (while (and (> end (point)) 1128 (search-forward-regexp regexp end t)) 1129 (let* ((match-beginning (match-beginning 0)) 1130 (match-end (match-end 0)) 1131 (match (match-string-no-properties 0)) 1132 (buffer (current-buffer)) 1133 (emoji (emojify-get-emoji match)) 1134 (force-display (get-text-property match-beginning 'emojify-force-display))) 1135 (when (and emoji 1136 (not (or (get-text-property match-beginning 'emojify-inhibit) 1137 (get-text-property match-end 'emojify-inhibit))) 1138 (memql (intern (ht-get emoji "style")) emojify-emoji-styles) 1139 ;; Skip displaying this emoji if the its bounds are 1140 ;; already part of an existing emoji. Since the emojis 1141 ;; are searched in descending order of length (see 1142 ;; construction of emojify-regexp in `emojify-set-emoji-data'), 1143 ;; this means larger emojis get precedence over smaller 1144 ;; ones 1145 (not (or (get-text-property match-beginning 'emojified) 1146 (get-text-property (1- match-end) 'emojified))) 1147 1148 ;; Validate the context in a programming major-mode, if 1149 ;; the buffer is in org-mode we determine the major 1150 ;; mode is picked from the language/babel block if any 1151 ;; at point 1152 (let ((major-mode-at-point (if (eq major-mode 'org-mode) 1153 (or (emojify-org-src-lang-at-point match-beginning) 'org-mode) 1154 major-mode))) 1155 ;; Display unconditionally in non-prog mode 1156 (or (not (emojify-provided-mode-derived-p major-mode-at-point 1157 'prog-mode 'tuareg--prog-mode 'comint-mode 'smalltalk-mode)) 1158 ;; In prog mode enable respecting `emojify-program-contexts' 1159 (emojify-valid-program-context-p emoji 1160 match-beginning 1161 match-end 1162 (not (eq major-mode-at-point major-mode))))) 1163 1164 ;; Display ascii emojis conservatively, since they have potential 1165 ;; to be annoying consider d: in head:, except while executing apropos 1166 ;; emoji 1167 (or (not (string= (ht-get emoji "style") "ascii")) 1168 force-display 1169 (emojify-valid-ascii-emoji-context-p match-beginning match-end)) 1170 1171 ;; Inhibit possibly inside a list 1172 ;; 41 is ?) but packages get confused by the extra closing paren :) 1173 ;; TODO Report bugs to such packages 1174 (or force-display 1175 (not (and (eq (char-syntax (char-before match-end)) 41) 1176 (emojify-looking-at-end-of-list-maybe match-end)))) 1177 1178 (not (run-hook-with-args-until-success 'emojify-inhibit-functions match match-beginning match-end))) 1179 (emojify--propertize-text-for-emoji emoji match buffer match-beginning match-end target))) 1180 ;; Stop a bit to let `with-timeout' kick in 1181 (sit-for 0 t)))) 1182 1183 ;; Loop to emojify composed text 1184 (when (and emojify-composed-text-p 1185 ;; Skip this if user has disabled unicode style emojis, since 1186 ;; we display only composed text that are unicode emojis 1187 (memql 'unicode emojify-emoji-styles)) 1188 (goto-char beg) 1189 (let ((compose-start (if (get-text-property beg 'composition) 1190 ;; Check `beg' first for composition property 1191 ;; since `next-single-property-change' will 1192 ;; search for region after `beg' for property 1193 ;; change thus skipping any composed text at 1194 ;; `beg' 1195 beg 1196 (next-single-property-change beg 1197 'composition 1198 nil 1199 end)))) 1200 (while (and (> end (point)) 1201 ;; `end' would be equal to `compose-start' if there was no 1202 ;; text with composition found within `end', this happens 1203 ;; because `next-single-property-change' returns the limit 1204 ;; (and we use `end' as the limit) if no match is found 1205 (> end compose-start) 1206 compose-start) 1207 (let* ((match (emojify--get-composed-text compose-start)) 1208 (emoji (emojify-get-emoji match)) 1209 (compose-end (next-single-property-change compose-start 'composition nil end))) 1210 ;; Display only composed text that is unicode char 1211 (when (and emoji 1212 (string= (ht-get emoji "style") "unicode")) 1213 (emojify--propertize-text-for-emoji emoji match (current-buffer) compose-start compose-end target)) 1214 ;; Setup the next loop 1215 (setq compose-start (and compose-end (next-single-property-change compose-end 1216 'composition 1217 nil 1218 end))) 1219 (goto-char compose-end)) 1220 ;; Stop a bit to let `with-timeout' kick in 1221 (sit-for 0 t))))))) 1222 1223 (defun emojify-undisplay-emojis-in-region (beg end) 1224 "Undisplay the emojis in region. 1225 1226 BEG and END are the beginning and end of the region respectively" 1227 (emojify-with-saved-buffer-state 1228 (while (< beg end) 1229 ;; Get the start of emojified region in the region, the region is marked 1230 ;; with text-property `emojified' whose value is `t'. The region is marked 1231 ;; so that we do not inadvertently remove display or other properties 1232 ;; inserted by other packages. This might fail too if a package adds any 1233 ;; of these properties between an emojified text, but that situation is 1234 ;; hopefully very rare and this is better than blindly removing all text 1235 ;; properties 1236 (let* ((emoji-start (text-property-any beg end 'emojified t)) 1237 ;; Get the end emojified text, if we could not find the start set 1238 ;; emoji-end to region `end', this merely to make looping easier. 1239 (emoji-end (or (and emoji-start 1240 (text-property-not-all emoji-start end 'emojified t)) 1241 ;; If the emojified text is at the end of the region 1242 ;; assume that end is the emojified text. 1243 end))) 1244 ;; Proceed only if we got start of emojified text 1245 (when emoji-start 1246 ;; Remove the properties 1247 (remove-text-properties emoji-start emoji-end (append (list 'emojified t 1248 'display t 1249 'emojify-display t 1250 'emojify-buffer t 1251 'emojify-text t 1252 'emojify-beginning t 1253 'emojify-end t 1254 'yank-handler t 1255 'keymap t 1256 'help-echo t 1257 'rear-nonsticky t)))) 1258 ;; Setup the next iteration 1259 (setq beg emoji-end))))) 1260 1261 (defun emojify-redisplay-emojis-in-region (&optional beg end) 1262 "Redisplay emojis in region between BEG and END. 1263 1264 Redisplay emojis in the visible region if BEG and END are not specified" 1265 (let* ((area (emojify--get-relevant-region)) 1266 (beg (save-excursion 1267 (goto-char (or beg (car area))) 1268 (line-beginning-position))) 1269 (end (save-excursion 1270 (goto-char (or end (cdr area))) 1271 (line-end-position)))) 1272 (unless (> (- end beg) 5000) 1273 (emojify-execute-ignoring-errors-unless-debug 1274 (emojify-undisplay-emojis-in-region beg end) 1275 (emojify-display-emojis-in-region beg end))))) 1276 1277 (defun emojify-after-change-extend-region-function (beg end _len) 1278 "Extend the region to be emojified. 1279 1280 This simply extends the region to be fontified to the start of line at BEG and 1281 end of line at END. _LEN is ignored. 1282 1283 The idea is since an emoji cannot span multiple lines, redisplaying complete 1284 lines ensures that all the possibly affected emojis are redisplayed." 1285 (let ((emojify-jit-lock-start (save-excursion 1286 (goto-char beg) 1287 (line-beginning-position))) 1288 (emojify-jit-lock-end (save-excursion 1289 (goto-char end) 1290 (line-end-position)))) 1291 (setq jit-lock-start (if jit-lock-start 1292 (min jit-lock-start emojify-jit-lock-start) 1293 emojify-jit-lock-start)) 1294 (setq jit-lock-end (if jit-lock-end 1295 (max jit-lock-end emojify-jit-lock-end) 1296 emojify-jit-lock-end)))) 1297 1298 1299 1300 ;; Emojify standalone strings 1301 1302 (defun emojify-string (string &optional styles target) 1303 "Create a propertized version of STRING, to display emojis belonging STYLES. 1304 1305 TARGET can either be a buffer object or a special value mode-line. It is used 1306 to indicate where EMOJI would be displayed, properties like font-height are 1307 inherited from TARGET if provided. See also `emojify--get-text-display-props'." 1308 (emojify-create-emojify-emojis) 1309 (let ((emojify-emoji-styles (or styles emojify-emoji-styles)) 1310 ;; Temporarily disable all `buffer-list-update-hook's, with-temp-buffer 1311 ;; internally calls `get-buffer-create' (and `kill-buffer'), which cause 1312 ;; this hook to be run. This is problematic because EXWM uses 1313 ;; `buffer-list-update-hook' and this temporary buffer confuses EXWM's 1314 ;; tracking code leading to 1315 ;; https://github.com/iqbalansari/emacs-emojify/issues/64 1316 buffer-list-update-hook) 1317 (with-temp-buffer 1318 (insert string) 1319 (emojify-display-emojis-in-region (point-min) (point-max) target) 1320 (buffer-string)))) 1321 1322 1323 1324 ;; Electric delete functionality 1325 1326 (defun emojify--find-key-binding-ignoring-emojify-keymap (key) 1327 "Find the binding for given KEY ignoring the text properties at point. 1328 1329 This is needed since `key-binding' looks up in keymap text property as well 1330 which is not what we want when falling back in `emojify-delete-emoji'" 1331 (let* ((key-binding (or (minor-mode-key-binding key) 1332 (local-key-binding key) 1333 (global-key-binding key)))) 1334 (when key-binding 1335 (or (command-remapping key-binding 1336 nil 1337 (seq-filter (lambda (keymap) 1338 (not (equal keymap emojify-emoji-keymap))) 1339 (current-active-maps))) 1340 key-binding)))) 1341 1342 (defun emojify-delete-emoji (point) 1343 "Delete emoji at POINT." 1344 (if (get-text-property point 'emojified) 1345 (delete-region (get-text-property point 'emojify-beginning) 1346 (get-text-property point 'emojify-end)) 1347 (call-interactively (emojify--find-key-binding-ignoring-emojify-keymap (this-command-keys))))) 1348 1349 (defun emojify-delete-emoji-forward () 1350 "Delete emoji after point." 1351 (interactive) 1352 (emojify-delete-emoji (point))) 1353 1354 (defun emojify-delete-emoji-backward () 1355 "Delete emoji before point." 1356 (interactive) 1357 (emojify-delete-emoji (1- (point)))) 1358 1359 ;; Integrate with delete-selection-mode 1360 ;; Basically instruct delete-selection mode to override our commands 1361 ;; if the region is active. 1362 (put 'emojify-delete-emoji-forward 'delete-selection 'supersede) 1363 (put 'emojify-delete-emoji-backward 'delete-selection 'supersede) 1364 1365 1366 1367 ;; Updating background color on selection 1368 1369 (defun emojify--update-emojis-background-in-region (&optional beg end) 1370 "Update the background color for emojis between BEG and END." 1371 (when (equal emojify-display-style 'image) 1372 (emojify-with-saved-buffer-state 1373 (emojify-do-for-emojis-in-region beg end 1374 (plist-put (cdr (get-text-property emoji-start 'display)) 1375 :background 1376 (emojify--get-image-background emoji-start 1377 emoji-end)))))) 1378 1379 (defun emojify--update-emojis-background-in-region-starting-at (point) 1380 "Update background color for emojis in buffer starting at POINT. 1381 1382 This updates the emojis in the region starting from POINT, the end of region is 1383 determined by product of `frame-height' and `frame-width' which roughly 1384 corresponds to the visible area. POINT usually corresponds to the starting 1385 position of the window, see 1386 `emojify-update-visible-emojis-background-after-command' and 1387 `emojify-update-visible-emojis-background-after-window-scroll' 1388 1389 NOTE: `window-text-height' and `window-text-width' would have been more 1390 appropriate here however they were not defined in Emacs v24.3 and below." 1391 (let* ((region-beginning point) 1392 (region-end (min (+ region-beginning (* (frame-height) 1393 (frame-width))) 1394 (point-max)))) 1395 (emojify--update-emojis-background-in-region region-beginning 1396 region-end))) 1397 1398 (defun emojify-update-visible-emojis-background-after-command () 1399 "Function added to `post-command-hook' when region is active. 1400 1401 This function updates the backgrounds of the emojis in the region changed after 1402 the command. 1403 1404 Ideally this would have been good enough to update emoji backgounds after region 1405 changes, unfortunately this does not work well with commands that scroll the 1406 window specifically `window-start' and `window-end' (sometimes only `window-end') 1407 report incorrect values. 1408 1409 To work around this 1410 `emojify-update-visible-emojis-background-after-window-scroll' is added to 1411 `window-scroll-functions' to update emojis on window scroll." 1412 (emojify--update-emojis-background-in-region-starting-at (window-start))) 1413 1414 (defun emojify-update-visible-emojis-background-after-window-scroll (_window display-start) 1415 "Function added to `window-scroll-functions' when region is active. 1416 1417 This function updates the backgrounds of the emojis in the newly displayed area 1418 of the window. DISPLAY-START corresponds to the new start of the window." 1419 (emojify--update-emojis-background-in-region-starting-at display-start)) 1420 1421 1422 1423 ;; Lazy image downloading 1424 1425 (defcustom emojify-download-emojis-p 'ask 1426 "Should emojify download images, if the selected emoji sets are not available. 1427 1428 Emojify can automatically download the images required to display the selected 1429 emoji set. By default the user will be asked for confirmation before downloading 1430 the image. Set this variable to t to download the images without asking for 1431 confirmation. Setting it to nil will disable automatic download of the images. 1432 1433 Please note that emojify will not download the images if Emacs is running in 1434 non-interactive mode and `emojify-download-emojis-p' is set to `ask'." 1435 :type '(radio :tag "Automatically download required images" 1436 (const :tag "Ask before downloading" ask) 1437 (const :tag "Download without asking" t) 1438 (const :tag "Disable automatic downloads" nil)) 1439 :group 'emojify) 1440 1441 (defvar emojify--refused-image-download-p nil 1442 "Used to remember that user has refused to download images in this session.") 1443 (defvar emojify--download-in-progress-p nil 1444 "Is emoji download in progress used to avoid multiple emoji download prompts.") 1445 1446 (defun emojify--emoji-download-emoji-set (data) 1447 "Download the emoji images according to DATA." 1448 (let ((destination (expand-file-name (make-temp-name "emojify") 1449 temporary-file-directory))) 1450 (url-copy-file (ht-get data "url") 1451 destination) 1452 (let ((downloaded-sha (with-temp-buffer 1453 (insert-file-contents-literally destination) 1454 (secure-hash 'sha256 (current-buffer))))) 1455 (if (string= downloaded-sha (ht-get data "sha256")) 1456 destination 1457 (error "Failed to download emojis from \"%s\", hash does not match %s (expected %s)" 1458 (ht-get data "url") downloaded-sha (ht-get data "sha256")))))) 1459 1460 (defun emojify--extract-emojis (file) 1461 "Extract the tar FILE in emoji directory." 1462 (let* ((default-directory emojify-emojis-dir)) 1463 (with-temp-buffer 1464 (insert-file-contents-literally file) 1465 (let ((emojify-inhibit-emojify-in-current-buffer-p t)) 1466 (tar-mode)) 1467 (tar-untar-buffer)))) 1468 1469 (defun emojify-download-emoji (emoji-set) 1470 "Download the provided EMOJI-SET." 1471 (interactive (list (completing-read "Select the emoji set you want to download: " 1472 (ht-keys emojify-emoji-set-json)))) 1473 (let ((emoji-data (ht-get emojify-emoji-set-json emoji-set))) 1474 (cond ((not emoji-data) 1475 (error "No emoji set named %s found" emoji-set)) 1476 ((and (file-exists-p (expand-file-name emoji-set emojify-emojis-dir)) 1477 (called-interactively-p 'any)) 1478 (message "%s emoji-set already downloaded, not downloading again!" emoji-set)) 1479 (t 1480 (emojify--extract-emojis (emojify--emoji-download-emoji-set (ht-get emojify-emoji-set-json emoji-set))))))) 1481 1482 (defun emojify--confirm-emoji-download () 1483 "Confirm download of emojis. 1484 1485 This takes care of respecting the `emojify-download-emojis-p' and making sure we 1486 do not prompt the user to download emojis multiple times." 1487 (if (not (equal emojify-download-emojis-p 'ask)) 1488 emojify-download-emojis-p 1489 ;; Skip the prompt if we are in noninteractive mode or the user has already 1490 ;; denied us permission to download once 1491 (unless (or noninteractive emojify--refused-image-download-p) 1492 (let ((download-confirmed-p (yes-or-no-p "[emojify] Emoji images not available should I download them now? "))) 1493 (setq emojify--refused-image-download-p (not download-confirmed-p)) 1494 download-confirmed-p)))) 1495 1496 (defun emojify-download-emoji-maybe () 1497 "Download emoji images if needed." 1498 (when (and (equal emojify-display-style 'image) 1499 (not (file-exists-p (emojify-image-dir))) 1500 (not emojify--refused-image-download-p)) 1501 (unwind-protect 1502 ;; Do not prompt for download if download is in progress 1503 (unless emojify--download-in-progress-p 1504 (setq emojify--download-in-progress-p t) 1505 (if (emojify--confirm-emoji-download) 1506 (emojify-download-emoji emojify-emoji-set) 1507 (warn "[emojify] Not downloading emoji images for now. Emojis would 1508 not be displayed since images are not available. If you wish to download emojis, 1509 run the command `emojify-download-emoji'"))) 1510 (setq emojify--download-in-progress-p nil)))) 1511 1512 (defun emojify-ensure-images () 1513 "Ensure that emoji images are downloaded." 1514 (if after-init-time 1515 (emojify-download-emoji-maybe) 1516 (add-hook 'after-init-hook #'emojify-download-emoji-maybe t))) 1517 1518 1519 1520 ;; Minor mode definitions 1521 1522 (defun emojify-turn-on-emojify-mode () 1523 "Turn on `emojify-mode' in current buffer." 1524 1525 ;; Calculate emoji data if needed 1526 (emojify-create-emojify-emojis) 1527 1528 (when (emojify-buffer-p (current-buffer)) 1529 ;; Download images if not available 1530 (emojify-ensure-images) 1531 1532 ;; Install our jit-lock function 1533 (jit-lock-register #'emojify-redisplay-emojis-in-region) 1534 (add-hook 'jit-lock-after-change-extend-region-functions #'emojify-after-change-extend-region-function t t) 1535 1536 ;; Handle point entered behaviour 1537 (add-hook 'post-command-hook #'emojify-detect-emoji-entry/exit t t) 1538 1539 ;; Update emoji backgrounds after each command 1540 (add-hook 'post-command-hook #'emojify-update-visible-emojis-background-after-command t t) 1541 1542 ;; Update emoji backgrounds after mark is deactivated, this is needed since 1543 ;; deactivation can happen outside the command loop 1544 (add-hook 'deactivate-mark-hook #'emojify-update-visible-emojis-background-after-command t t) 1545 1546 ;; Update emoji backgrounds after when window scrolls 1547 (add-hook 'window-scroll-functions #'emojify-update-visible-emojis-background-after-window-scroll t t) 1548 1549 ;; Redisplay emojis after enabling `prettify-symbol-mode' 1550 (add-hook 'prettify-symbols-mode-hook #'emojify-redisplay-emojis-in-region) 1551 1552 ;; Redisplay visible emojis when emoji style changes 1553 (add-hook 'emojify-emoji-style-change-hook #'emojify-redisplay-emojis-in-region))) 1554 1555 (defun emojify-turn-off-emojify-mode () 1556 "Turn off `emojify-mode' in current buffer." 1557 ;; Remove currently displayed emojis 1558 (save-restriction 1559 (widen) 1560 (emojify-undisplay-emojis-in-region (point-min) (point-max))) 1561 1562 ;; Uninstall our jit-lock function 1563 (jit-lock-unregister #'emojify-redisplay-emojis-in-region) 1564 (remove-hook 'jit-lock-after-change-extend-region-functions #'emojify-after-change-extend-region-function t) 1565 1566 (remove-hook 'post-command-hook #'emojify-detect-emoji-entry/exit t) 1567 1568 ;; Disable hooks to update emoji backgrounds 1569 (remove-hook 'post-command-hook #'emojify-update-visible-emojis-background-after-command t) 1570 (remove-hook 'deactivate-mark-hook #'emojify-update-visible-emojis-background-after-command t) 1571 (remove-hook 'window-scroll-functions #'emojify-update-visible-emojis-background-after-window-scroll t) 1572 1573 ;; Remove hook to redisplay emojis after enabling `prettify-symbol-mode' 1574 (remove-hook 'prettify-symbols-mode-hook #'emojify-redisplay-emojis-in-region) 1575 1576 ;; Remove style change hooks 1577 (remove-hook 'emojify-emoji-style-change-hook #'emojify-redisplay-emojis-in-region)) 1578 1579 ;; define a emojify-mode-map to enable defining keys specifically for emojify-mode 1580 (defvar emojify-mode-map (make-sparse-keymap) 1581 "Keymap for `emojify-mode'.") 1582 1583 ;;;###autoload 1584 (define-minor-mode emojify-mode 1585 "Emojify mode" 1586 :keymap emojify-mode-map 1587 :init-value nil 1588 (if emojify-mode 1589 ;; Turn on 1590 (emojify-turn-on-emojify-mode) 1591 ;; Turn off 1592 (emojify-turn-off-emojify-mode))) 1593 1594 ;;;###autoload 1595 (define-globalized-minor-mode global-emojify-mode 1596 emojify-mode emojify-mode 1597 :init-value nil) 1598 1599 (defadvice set-buffer-multibyte (after emojify-disable-for-unibyte-buffers (&rest ignored)) 1600 "Disable emojify when unibyte encoding is enabled for a buffer. 1601 Re-enable it when buffer changes back to multibyte encoding." 1602 (ignore-errors 1603 (if enable-multibyte-characters 1604 (when global-emojify-mode 1605 (emojify-mode +1)) 1606 (emojify-mode -1)))) 1607 1608 (ad-activate #'set-buffer-multibyte) 1609 1610 1611 1612 ;; Displaying emojis in mode-line 1613 1614 (defun emojify--emojified-mode-line (format) 1615 "Return an emojified version of mode-line FORMAT. 1616 1617 The format is converted to the actual string to be displayed using 1618 `format-mode-line' and the unicode characters are replaced by images." 1619 (replace-regexp-in-string "%" 1620 "%%" 1621 (if emojify-mode 1622 ;; Remove "%e" from format since we keep it as first part of the 1623 ;; emojified mode-line, see `emojify-emojify-mode-line' 1624 (emojify-string (format-mode-line (delq "%e" format)) nil 'mode-line) 1625 (format-mode-line format)))) 1626 1627 (defun emojify-mode-line-emojified-p () 1628 "Check if the mode-line is already emojified. 1629 1630 If the `mode-line-format' is of following format 1631 1632 \(\"%e\" (:eval (emojify-emojified-mode-line ... ))) 1633 1634 We can assume the mode-line is already emojified." 1635 (and (consp mode-line-format) 1636 (equal (ignore-errors (cl-caadr mode-line-format)) 1637 :eval) 1638 (equal (ignore-errors (car (cl-cadadr mode-line-format))) 1639 'emojify--emojified-mode-line))) 1640 1641 (defun emojify-emojify-mode-line () 1642 "Emojify unicode characters in the mode-line. 1643 1644 This updates `mode-line-format' to a modified version which emojifies the 1645 mode-line before it is displayed." 1646 (unless (emojify-mode-line-emojified-p) 1647 (setq mode-line-format `("%e" (:eval 1648 (emojify--emojified-mode-line ',mode-line-format)))))) 1649 1650 (defun emojify-unemojify-mode-line () 1651 "Restore `mode-line-format' to unemojified version. 1652 1653 This basically reverses the effect of `emojify-emojify-mode-line'." 1654 (when (emojify-mode-line-emojified-p) 1655 (setq mode-line-format (cl-cadadr (cl-cadadr mode-line-format))))) 1656 1657 ;;;###autoload 1658 (define-minor-mode emojify-mode-line-mode 1659 "Emojify mode line" 1660 :init-value nil 1661 (if emojify-mode-line-mode 1662 ;; Turn on 1663 (emojify-emojify-mode-line) 1664 ;; Turn off 1665 (emojify-unemojify-mode-line))) 1666 1667 ;;;###autoload 1668 (define-globalized-minor-mode global-emojify-mode-line-mode 1669 emojify-mode-line-mode emojify-mode-line-mode 1670 :init-value nil) 1671 1672 1673 1674 ;; Searching emojis 1675 1676 (defvar emojify-apropos-buffer-name "*Apropos Emojis*") 1677 1678 (defun emojify-apropos-quit () 1679 "Delete the window displaying Emoji search results." 1680 (interactive) 1681 (if (= (length (window-list)) 1) 1682 (bury-buffer) 1683 (quit-window))) 1684 1685 (defun emojify-apropos-copy-emoji () 1686 "Copy the emoji being displayed at current line in apropos results." 1687 (interactive) 1688 (save-excursion 1689 (goto-char (line-beginning-position)) 1690 (if (not (get-text-property (point) 'emojified)) 1691 (emojify-user-error "No emoji at point") 1692 (kill-new (get-text-property (point) 'emojify-text)) 1693 (message "Copied emoji (%s) to kill ring!" 1694 (get-text-property (point) 'emojify-text))))) 1695 1696 (defun emojify-apropos-describe-emoji () 1697 "Copy the emoji being displayed at current line in apropos results." 1698 (interactive) 1699 (save-excursion 1700 (goto-char (line-beginning-position)) 1701 (if (not (get-text-property (point) 'emojified)) 1702 (emojify-user-error "No emoji at point") 1703 (emojify-describe-emoji (get-text-property (point) 'emojify-text))))) 1704 1705 (defvar emojify-apropos-mode-map 1706 (let ((map (make-sparse-keymap))) 1707 (set-keymap-parent map emojify-common-mode-map) 1708 (define-key map "c" #'emojify-apropos-copy-emoji) 1709 (define-key map "w" #'emojify-apropos-copy-emoji) 1710 (define-key map "d" #'emojify-apropos-describe-emoji) 1711 (define-key map (kbd "RET") #'emojify-apropos-describe-emoji) 1712 (define-key map "g" #'emojify-apropos-emoji) 1713 map) 1714 "Keymap used in `emojify-apropos-mode'.") 1715 1716 (define-derived-mode emojify-apropos-mode fundamental-mode "Apropos Emojis" 1717 "Mode used to display results of `emojify-apropos-emoji' 1718 1719 \\{emojify-apropos-mode-map}" 1720 (emojify-mode +1) 1721 ;; view mode being a minor mode eats up our bindings avoid it 1722 (let (view-read-only) 1723 (read-only-mode +1))) 1724 1725 (put 'emojify-apropos-mode 'mode-class 'special) 1726 1727 (defvar emojify--apropos-last-query nil) 1728 (make-variable-buffer-local 'emojify--apropos-last-query) 1729 1730 (defun emojify-apropos-read-pattern () 1731 "Read apropos pattern with INITIAL-INPUT as the initial input. 1732 1733 Borrowed from apropos.el" 1734 (let ((pattern (read-string (concat "Search for emoji (word list or regexp): ") 1735 emojify--apropos-last-query))) 1736 (if (string-equal (regexp-quote pattern) pattern) 1737 (or (split-string pattern "[ \t]+" t) 1738 (emojify-user-error "No word list given")) 1739 pattern))) 1740 1741 ;;;###autoload 1742 (defun emojify-apropos-emoji (pattern) 1743 "Show Emojis that match PATTERN." 1744 (interactive (list (emojify-apropos-read-pattern))) 1745 1746 (emojify-create-emojify-emojis) 1747 1748 (let ((in-apropos-buffer-p (equal major-mode 'emojify-apropos-mode)) 1749 matching-emojis 1750 sorted-emojis) 1751 1752 (unless (listp pattern) 1753 (setq pattern (list pattern))) 1754 1755 ;; Convert the user entered text to a regex to match the emoji name or 1756 ;; description 1757 (apropos-parse-pattern pattern) 1758 1759 ;; Collect matching emojis in a list of (list score emoji emoji-data) 1760 ;; elements, where score is the proximity of the emoji to given pattern 1761 ;; calculated using `apropos-score-str' 1762 (emojify-emojis-each (lambda (key value) 1763 (when (or (string-match apropos-regexp key) 1764 (string-match apropos-regexp (ht-get value "name"))) 1765 (push (list (max (apropos-score-str key) 1766 (apropos-score-str (ht-get value "name"))) 1767 key 1768 value) 1769 matching-emojis)))) 1770 1771 ;; Sort the emojis by the proximity score 1772 (setq sorted-emojis (mapcar #'cdr 1773 (sort matching-emojis 1774 (lambda (emoji1 emoji2) 1775 (> (car emoji1) (car emoji2)))))) 1776 1777 ;; Insert result in apropos buffer and display it 1778 (with-current-buffer (get-buffer-create emojify-apropos-buffer-name) 1779 (let ((inhibit-read-only t) 1780 (query (mapconcat 'identity pattern " "))) 1781 (erase-buffer) 1782 (insert (propertize "Emojis matching" 'face 'apropos-symbol)) 1783 (insert (format " - \"%s\"" query)) 1784 (insert "\n\nUse `c' or `w' to copy emoji on current line\nUse `g' to rerun apropos\n\n") 1785 (dolist (emoji sorted-emojis) 1786 (insert (format "%s - %s (%s)" 1787 (car emoji) 1788 (ht-get (cadr emoji) "name") 1789 (ht-get (cadr emoji) "style"))) 1790 (insert "\n")) 1791 (goto-char (point-min)) 1792 (forward-line (1- 6)) 1793 (emojify-apropos-mode) 1794 (setq emojify--apropos-last-query (concat query " ")) 1795 (setq-local line-spacing 7))) 1796 1797 (pop-to-buffer (get-buffer emojify-apropos-buffer-name) 1798 (when in-apropos-buffer-p 1799 (cons #'display-buffer-same-window nil))))) 1800 1801 1802 1803 ;; Inserting emojis 1804 1805 (defun emojify--completing-read-minibuffer-setup-hook () 1806 "Enables `emojify-mode' in minbuffer while inserting emojis. 1807 1808 This ensures `emojify' is enabled even when `global-emojify-mode' is not on." 1809 (emojify-mode +1)) 1810 1811 (defun emojify--completing-read-helm-hook () 1812 "Enables `emojify-mode' in helm buffer. 1813 1814 This ensures `emojify' is enabled in helm buffer displaying completion even when 1815 `global-emojify-mode' is not on." 1816 (with-current-buffer helm-buffer 1817 (emojify-mode +1))) 1818 1819 (defun emojify-completing-read (prompt &optional predicate require-match initial-input hist def inherit-input-method) 1820 "Read emoji from the user and return the selected emoji. 1821 1822 PROMPT is a string to prompt with, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, 1823 HIST, DEF, INHERIT-INPUT-METHOD correspond to the arguments for 1824 `emojify-completing-read-function' and are passed to 1825 ‘emojify-completing-read-function’ without any interpretation. 1826 1827 For each possible emoji PREDICATE is called with a string of the form 1828 '<emoji> - <name> (<style>)', the predicate should return nil if it the emoji should not be 1829 displayed for selection. 1830 1831 For example the following can be used to display only github style emojis for 1832 selection 1833 1834 \(emojify-completing-read \"Select a Github style emoji: \" 1835 (lambda (display-string) 1836 (s-suffix? display-string \"(github)\"))) 1837 1838 This function sets up `ido', `icicles', `helm', `ivy' and vanilla Emacs 1839 completion UI to display properly emojis." 1840 (emojify-create-emojify-emojis) 1841 (let* ((emojify-minibuffer-reading-emojis-p t) 1842 (line-spacing 7) 1843 (completion-ignore-case t) 1844 (candidates (emojify--get-completing-read-candidates)) 1845 ;; Vanilla Emacs completion and Icicles use the completion list mode to display candidates 1846 ;; the following makes sure emojify is enabled in the completion list 1847 (completion-list-mode-hook (cons #'emojify--completing-read-minibuffer-setup-hook 1848 completion-list-mode-hook)) 1849 ;; (Vertical) Ido and Ivy displays candidates in minibuffer this makes sure candidates are emojified 1850 ;; when Ido or Ivy are used 1851 (minibuffer-setup-hook (cons #'emojify--completing-read-minibuffer-setup-hook 1852 minibuffer-setup-hook)) 1853 (helm-after-initialize-hook (cons #'emojify--completing-read-helm-hook 1854 (bound-and-true-p helm-after-initialize-hook)))) 1855 (car (split-string (funcall emojify-completing-read-function 1856 prompt 1857 candidates 1858 predicate 1859 require-match 1860 initial-input 1861 hist 1862 def 1863 inherit-input-method) 1864 " ")))) 1865 1866 ;;;###autoload 1867 (defun emojify-insert-emoji () 1868 "Interactively prompt for Emojis and insert them in the current buffer. 1869 1870 This respects the `emojify-emoji-styles' variable." 1871 (interactive) 1872 (insert (emojify-completing-read "Insert Emoji: "))) 1873 1874 1875 1876 ;; Describing emojis 1877 1878 (defvar emojify-help-buffer-name "*Emoji Help*") 1879 1880 (defvar-local emojify-described-emoji nil) 1881 1882 (defun emojify-description-copy-emoji () 1883 "Copy the emoji being displayed at current line in apropos results." 1884 (interactive) 1885 (save-excursion 1886 (kill-new emojify-described-emoji) 1887 (message "Copied emoji (%s) to kill ring!" emojify-described-emoji))) 1888 1889 (defvar emojify-description-mode-map 1890 (let ((map (make-sparse-keymap))) 1891 (set-keymap-parent map emojify-common-mode-map) 1892 (define-key map "c" #'emojify-description-copy-emoji) 1893 (define-key map "w" #'emojify-description-copy-emoji) 1894 map) 1895 "Keymap used in `emojify-description-mode'.") 1896 1897 (define-derived-mode emojify-description-mode fundamental-mode "Describe Emoji" 1898 "Mode used to display results of description for emojis. 1899 1900 \\{emojify-description-mode-map}" 1901 (emojify-mode +1) 1902 ;; view mode being a minor mode eats up our bindings avoid it 1903 (let (view-read-only) 1904 (read-only-mode +1)) 1905 (goto-address-mode +1)) 1906 1907 (put 'emojify-description-mode 'mode-class 'special) 1908 1909 (defun emojify--display-emoji-description-buffer (emoji) 1910 "Display description for EMOJI." 1911 (with-current-buffer (get-buffer-create emojify-help-buffer-name) 1912 (let ((inhibit-read-only t)) 1913 (erase-buffer) 1914 (save-excursion 1915 (insert (propertize (ht-get emoji "emoji") 'emojify-inhibit t) 1916 " - Displayed as " 1917 (propertize (ht-get emoji "emoji") 'emojify-force-display t) 1918 "\n\n") 1919 (insert (propertize "Name" 'face 'font-lock-keyword-face) 1920 ": " 1921 (ht-get emoji "name") "\n") 1922 (insert (propertize "Style" 'face 'font-lock-keyword-face) 1923 ": " 1924 (ht-get emoji "style") "\n") 1925 (insert (propertize "Image used" 'face 'font-lock-keyword-face) 1926 ": " 1927 (expand-file-name (ht-get emoji "image") 1928 (emojify-image-dir)) 1929 "\n") 1930 (when (and (not (string= (ht-get emoji "style") "unicode")) 1931 (ht-get emoji "unicode")) 1932 (insert (propertize "Unicode representation" 1933 'face 'font-lock-keyword-face) 1934 ": " 1935 (propertize (ht-get emoji "unicode") 'emojify-inhibit t) 1936 "\n")) 1937 (when (and (not (string= (ht-get emoji "style") "ascii")) 1938 (ht-get emoji "ascii")) 1939 (insert (propertize "Ascii representation" 1940 'face 'font-lock-keyword-face) 1941 ": " 1942 (propertize (ht-get emoji "ascii") 'emojify-inhibit t) 1943 "\n")) 1944 (insert (propertize "User defined" 1945 'face 'font-lock-keyword-face) 1946 ": " 1947 (if (ht-get emoji "custom") "Yes" "No") 1948 "\n") 1949 (unless (ht-get emoji "custom") 1950 (when (or (ht-get emoji "unicode") 1951 (string= (ht-get emoji "style") "unicode")) 1952 (insert (propertize "Unicode Consortium" 'face 'font-lock-keyword-face) 1953 ": " 1954 (concat "http://www.unicode.org/emoji/charts-beta/full-emoji-list.html#" 1955 (string-join (mapcar (apply-partially #'format "%x") 1956 (string-to-list (or (ht-get emoji "unicode") 1957 (ht-get emoji "emoji")))) 1958 "_")) 1959 "\n")) 1960 (insert (propertize "Emojipedia" 'face 'font-lock-keyword-face) 1961 ": " 1962 (let* ((tone-stripped (replace-regexp-in-string "- *[Tt]one *\\([0-9]+\\)$" 1963 "- type \\1" 1964 (ht-get emoji "name"))) 1965 (non-alphanumeric-stripped (replace-regexp-in-string "[^0-9a-zA-Z]" 1966 " " 1967 tone-stripped)) 1968 (words (split-string non-alphanumeric-stripped " " t " "))) 1969 (concat "http://emojipedia.org/" 1970 (downcase (emojify-string-join words "-")))) 1971 "\n")))) 1972 (emojify-description-mode) 1973 (setq emojify-described-emoji (ht-get emoji "emoji"))) 1974 (display-buffer (get-buffer emojify-help-buffer-name)) 1975 (get-buffer emojify-help-buffer-name)) 1976 1977 (defun emojify-describe-emoji (emoji-text) 1978 "Display description for EMOJI-TEXT." 1979 (interactive (list (emojify-completing-read "Describe Emoji: "))) 1980 (if (emojify-get-emoji emoji-text) 1981 (emojify--display-emoji-description-buffer (emojify-get-emoji emoji-text)) 1982 (emojify-user-error "No emoji found for '%s'" emoji-text))) 1983 1984 (defun emojify-describe-emoji-at-point () 1985 "Display help for EMOJI displayed at point." 1986 (interactive) 1987 (if (not (get-text-property (point) 'emojified)) 1988 (emojify-user-error "No emoji at point!") 1989 (emojify--display-emoji-description-buffer (emojify-get-emoji (get-text-property (point) 'emojify-text))))) 1990 1991 1992 1993 ;; Listing emojis 1994 1995 (defun emojify-list-copy-emoji () 1996 "Copy the emoji being displayed at current line in apropos results." 1997 (interactive) 1998 (save-excursion 1999 (let ((emoji (get-text-property (point) 'tabulated-list-id))) 2000 (if (not emoji) 2001 (emojify-user-error "No emoji at point") 2002 (kill-new emoji) 2003 (message "Copied emoji (%s) to kill ring!" emoji))))) 2004 2005 (defun emojify-list-describe-emoji () 2006 "Copy the emoji being displayed at current line in apropos results." 2007 (interactive) 2008 (save-excursion 2009 (let ((emoji (get-text-property (point) 'tabulated-list-id))) 2010 (if (not emoji) 2011 (emojify-user-error "No emoji at point") 2012 (emojify-describe-emoji emoji))))) 2013 2014 (defvar-local emojify-list--emojis-displayed nil 2015 "Record that emojis have been successfully displayed in the current buffer. 2016 2017 `emojify-list-emojis' checks to this decide if it should print the entries 2018 again.") 2019 2020 (defun emojify-list-force-refresh () 2021 "Force emoji list to be refreshed." 2022 (interactive) 2023 (setq emojify-list--emojis-displayed nil) 2024 (emojify-list-emojis)) 2025 2026 (defvar emojify-list-mode-map 2027 (let ((map (make-sparse-keymap))) 2028 (set-keymap-parent map emojify-common-mode-map) 2029 (define-key map "c" #'emojify-list-copy-emoji) 2030 (define-key map "w" #'emojify-list-copy-emoji) 2031 (define-key map "d" #'emojify-list-describe-emoji) 2032 (define-key map "g" #'emojify-list-force-refresh) 2033 (define-key map (kbd "RET") #'emojify-list-describe-emoji) 2034 map) 2035 "Keymap used in `emojify-list-mode'.") 2036 2037 (defun emojify-list-printer (id cols) 2038 "Printer used to print the emoji rows in tabulated list. 2039 2040 See `tabulated-list-print-entry' to understand the arguments ID and COLS." 2041 (let ((beg (point)) 2042 (padding (max tabulated-list-padding 0)) 2043 (inhibit-read-only t)) 2044 (when (> tabulated-list-padding 0) 2045 (insert (make-string padding ?\s))) 2046 2047 (tabulated-list-print-col 0 2048 (propertize (aref cols 0) 'emojify-inhibit t) 2049 (current-column)) 2050 2051 ;; Inhibit display of second column ("Text") as emoji 2052 (tabulated-list-print-col 1 2053 (propertize (aref cols 1) 'emojify-inhibit t) 2054 (current-column)) 2055 2056 ;; The type of this emoji 2057 (tabulated-list-print-col 2 2058 (aref cols 2) 2059 (current-column)) 2060 2061 ;; Is this a custom emoji 2062 (tabulated-list-print-col 3 2063 (aref cols 3) 2064 (current-column)) 2065 2066 ;; Force display of last column ("Display") as emoji 2067 (tabulated-list-print-col 4 2068 (propertize (aref cols 4) 'emojify-force-display t) 2069 (current-column)) 2070 2071 (insert ?\n) 2072 (add-text-properties beg 2073 (point) 2074 `(tabulated-list-id ,id tabulated-list-entry ,cols)) 2075 2076 (message "Listing emojis (%d of %d) ..." (1- (line-number-at-pos)) (aref cols 5)))) 2077 2078 (defun emojify-list-entries () 2079 "Return entries to display in tabulated list." 2080 (emojify-create-emojify-emojis) 2081 2082 (let (entries count) 2083 (emojify-emojis-each (lambda (emoji data) 2084 (when (seq-contains emojify-emoji-styles (intern (ht-get data "style"))) 2085 (push (list emoji (vector (ht-get data "name") 2086 emoji 2087 (ht-get data "style") 2088 (if (ht-get data "custom") "Yes" "No") 2089 emoji)) 2090 entries)))) 2091 2092 (setq count (length entries)) 2093 2094 (mapcar (lambda (entry) 2095 (list (car entry) (vconcat (cadr entry) (vector count)))) 2096 entries))) 2097 2098 (define-derived-mode emojify-list-mode tabulated-list-mode "Emoji-List" 2099 "Major mode for listing emojis. 2100 \\{emojify-list-mode-map}" 2101 (setq line-spacing 7 2102 tabulated-list-format [("Name" 30 t) 2103 ("Text" 20 t) 2104 ("Style" 10 t) 2105 ("Custom" 10 t) 2106 ("Display" 20 nil)] 2107 tabulated-list-sort-key (cons "Name" nil) 2108 tabulated-list-padding 2 2109 tabulated-list-entries #'emojify-list-entries 2110 tabulated-list-printer #'emojify-list-printer) 2111 (tabulated-list-init-header)) 2112 2113 (defun emojify-list-emojis () 2114 "List emojis in a tabulated view." 2115 (interactive) 2116 (let ((buffer (get-buffer-create "*Emojis*"))) 2117 (with-current-buffer buffer 2118 (unless emojify-list--emojis-displayed 2119 (emojify-list-mode) 2120 (tabulated-list-print) 2121 (setq emojify-list--emojis-displayed t)) 2122 (pop-to-buffer buffer)))) 2123 2124 2125 2126 ;; Integration with company mode 2127 2128 (defadvice company-pseudo-tooltip-unhide (after emojify-display-emojis-in-company-tooltip (&rest ignored)) 2129 "Advice to display emojis in company mode tooltips. 2130 2131 This function does two things, first it adds text properties to the completion 2132 tooltip to make it display the emojis, secondly it makes company always render 2133 the completion tooltip using `after-string' overlay property rather than 2134 `display' text property. 2135 2136 The second step is needed because emojify displays the emojis using `display' 2137 text property, similarly company-mode in some cases uses `display' overlay 2138 property to render its pop, this results into a `display' property inside 2139 `display' property, however Emacs ignores recursive display text property. 2140 Using `after-string' works as well as `display' while allowing the emojis to be 2141 displayed." 2142 (when (and emojify-mode 2143 emojify-company-tooltips-p 2144 (overlayp (bound-and-true-p company-pseudo-tooltip-overlay))) 2145 (let* ((ov company-pseudo-tooltip-overlay) 2146 (disp (or (overlay-get ov 'display) 2147 (overlay-get ov 'after-string))) 2148 (emojified-display (when disp 2149 (emojify-string disp '(unicode)))) 2150 (emojified-p (when (and (stringp emojified-display) 2151 (not (zerop (length emojified-display)))) 2152 (text-property-any 0 (1- (length emojified-display)) 2153 'emojified t 2154 emojified-display)))) 2155 ;; Do not switch to after-string if menu is not emojified 2156 (when (and disp emojified-p) 2157 (overlay-put ov 'after-string nil) 2158 (overlay-put ov 'display (propertize " " 'invisible t)) 2159 (overlay-put ov 'after-string emojified-display))))) 2160 2161 (ad-activate #'company-pseudo-tooltip-unhide) 2162 2163 2164 2165 ;; Integration with some miscellaneous functionality 2166 2167 (defadvice mouse--drag-set-mark-and-point (after emojify-update-emoji-background (&rest ignored)) 2168 "Advice to update emoji backgrounds after selection is changed using mouse. 2169 2170 Currently there are no hooks run after mouse movements, as such the emoji 2171 backgrounds are updated only after the mouse button is released. This advices 2172 `mouse--drag-set-mark-and-point' which is run after selection changes to trigger 2173 an update of emoji backgrounds. Not the cleanest but the only way I can think of." 2174 (when emojify-mode 2175 (emojify-update-visible-emojis-background-after-command))) 2176 2177 (ad-activate #'mouse--drag-set-mark-and-point) 2178 2179 (defadvice text-scale-increase (after emojify-resize-emojis (&rest ignored)) 2180 "Advice `text-scale-increase' to resize emojis on text resize." 2181 (when emojify-mode 2182 (let ((new-font-height (emojify-default-font-height))) 2183 (emojify-do-for-emojis-in-region (point-min) (point-max) 2184 (plist-put (cdr (get-text-property emoji-start 'display)) 2185 :height 2186 new-font-height))))) 2187 2188 (ad-activate #'text-scale-increase) 2189 2190 2191 2192 (provide 'emojify) 2193 ;;; emojify.el ends here