-
Notifications
You must be signed in to change notification settings - Fork 40
/
emojify.el
2192 lines (1804 loc) · 91.5 KB
/
emojify.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; emojify.el --- Display emojis in Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2018 Iqbal Ansari
;; Author: Iqbal Ansari <iqbalansari02@yahoo.com>
;; Keywords: multimedia, convenience
;; URL: https://github.com/iqbalansari/emacs-emojify
;; Version: 1.2.1
;; Package-Requires: ((seq "1.11") (ht "2.0") (emacs "24.3"))
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This package displays emojis in Emacs similar to how Github, Slack etc do. It
;; can display plain ascii like ':)' as well as Github style emojis like ':smile:'
;;
;; It provides a minor mode `emojify-mode' to enable display of emojis in a buffer.
;; To enable emojify mode globally use `global-emojify-mode'
;;
;; For detailed documentation see the projects README file at
;; https://github.com/iqbalansari/emacs-emojify
;;; Code:
(require 'seq)
(require 'ht)
(require 'subr-x nil :no-error)
(require 'cl-lib)
(require 'json)
(require 'regexp-opt)
(require 'jit-lock)
(require 'pcase)
(require 'tar-mode)
(require 'apropos)
;; Satisfying the byte-compiler
;; We do not "require" these functions but if `org-mode' is active we use them
;; Required to determine point is in an org-list
(declare-function org-list-get-item-begin "org-list")
(declare-function org-at-heading-p "org")
;; Required to determine the context is in an org-src block
(declare-function org-element-type "org-element")
(declare-function org-element-property "org-element")
(declare-function org-element-at-point "org-element")
(declare-function org-src-get-lang-mode "org-src")
(declare-function org-src--get-lang-mode "org-src")
;; Required for integration with company-mode
(declare-function company-pseudo-tooltip-unhide "company")
;; Shouldn't require 'jit-lock be enough :/
(defvar jit-lock-start)
(defvar jit-lock-end)
;; Used while inserting emojis using helm
(defvar helm-buffer)
(defvar helm-after-initialize-hook)
;; Compatibility functions
(defun emojify-user-error (format &rest args)
"Signal a pilot error, making a message by passing FORMAT and ARGS to ‘format-message’."
(if (fboundp 'user-error)
(apply #'user-error format args)
(apply #'error format args)))
(defun emojify-face-height (face)
"Get font height for the FACE."
(let ((face-font (face-font face)))
(cond
((and (display-multi-font-p)
;; Avoid calling font-info if the frame's default font was
;; not changed since the frame was created. That's because
;; font-info is expensive for some fonts, see bug #14838.
(not (string= (frame-parameter nil 'font) face-font)))
(aref (font-info face-font) 3))
(t (frame-char-height)))))
(defun emojify-default-font-height ()
"Return the height in pixels of the current buffer's default face font.
`default-font-height' seems to be available only on Emacs versions after 24.3.
This provides a compatibility version for previous versions."
(if (fboundp 'default-font-height)
(default-font-height)
(emojify-face-height 'default)))
(defun emojify-overlays-at (pos &optional sorted)
"Return a list of the overlays that contain the character at POS.
If SORTED is non-nil, then sort them by decreasing priority.
The SORTED argument was introduced in Emacs 24.4, along with the incompatible
change that overlay priorities can be any Lisp object (earlier they were
restricted to integer and nil). This version uses the SORTED argument of
`overlays-at' on Emacs version 24.4 onwards and manually sorts the overlays by
priority on lower versions."
(if (version< emacs-version "24.4")
(let ((overlays-at-pos (overlays-at pos)))
(if sorted
(seq-sort (lambda (overlay1 overlay2)
(if (and (overlay-get overlay2 'priority)
(overlay-get overlay1 'priority))
;; If both overlays have priorities compare them
(< (overlay-get overlay1 'priority)
(overlay-get overlay2 'priority))
;; Otherwise overlay with nil priority is sorted below
;; the one with integer value otherwise preserve order
(not (overlay-get overlay1 'priority))))
overlays-at-pos)
overlays-at-pos))
(overlays-at pos sorted)))
(defun emojify-string-join (strings &optional separator)
"Join all STRINGS using SEPARATOR.
This function is available on Emacs v24.4 and higher, it has been
backported here for compatibility with older Emacsen."
(if (fboundp 'string-join)
(apply #'string-join (list strings separator))
(mapconcat 'identity strings separator)))
(defun emojify-provided-mode-derived-p (mode &rest modes)
"Non-nil if MODE is derived from one of MODES.
Uses the `derived-mode-parent' property of the symbol to trace backwards.
If you just want to check `major-mode', use `derived-mode-p'."
(if (fboundp 'provided-mode-derived-p)
(apply #'provided-mode-derived-p mode modes)
(while (and (not (memq mode modes))
(setq mode (get mode 'derived-mode-parent))))
mode))
(defun emojify-org-src-get-lang-mode (lang)
"Return major mode that should be used for LANG.
LANG is a string, and the returned major mode is a symbol."
(if (fboundp 'org-src-get-lang-mode)
(org-src-get-lang-mode lang)
(org-src--get-lang-mode lang)))
;; Debugging helpers
(define-minor-mode emojify-debug-mode
"Enable debugging for emojify-mode.
By default emojify silences any errors during emoji redisplay. This is done
since emojis are redisplayed using jit-lock (the same mechanism used for
font-lock) as such any bugs in the code can cause other important things to
fail. This also turns on jit-debug-mode so that (e)debugging emojify's redisplay
functions work."
:init-value nil
(if emojify-debug-mode
(when (fboundp 'jit-lock-debug-mode)
(jit-lock-debug-mode +1))
(when (fboundp 'jit-lock-debug-mode)
(jit-lock-debug-mode -1))))
(defmacro emojify-execute-ignoring-errors-unless-debug (&rest forms)
"Execute FORMS ignoring errors unless variable `emojify-debug-mode' is non-nil."
(declare (debug t) (indent 0))
`(if emojify-debug-mode
(progn
,@forms)
(ignore-errors
,@forms)))
;; Utility functions
;; These should be bound dynamically by functions calling
;; `emojify--inside-rectangle-selection-p' and
;; `emojify--inside-non-rectangle-selection-p' to region-beginning and
;; region-end respectively. This is needed mark the original region which is
;; impossible to get after point moves during processing.
(defvar emojify-region-beg nil)
(defvar emojify-region-end nil)
;; This should be bound dynamically to the location of point before emojify's
;; display loop, this since getting the point after point moves during
;; processing is impossible
(defvar emojify-current-point nil)
(defmacro emojify-with-saved-buffer-state (&rest forms)
"Execute FORMS saving current buffer state.
This saves point and mark, `match-data' and buffer modification state it also
inhibits buffer change, point motion hooks."
(declare (debug t) (indent 0))
`(let ((inhibit-point-motion-hooks t)
(emojify-current-point (point))
(emojify-region-beg (when (region-active-p) (region-beginning)))
(emojify-region-end (when (region-active-p) (region-end))))
(with-silent-modifications
(save-match-data
(save-excursion
(save-restriction
(widen)
,@forms))))))
(defmacro emojify-do-for-emojis-in-region (beg end &rest forms)
"For all emojis between BEG and END, execute the given FORMS.
During the execution `emoji-start' and `emoji-end' are bound to the start
and end of the emoji for which the form is being executed."
(declare (debug t) (indent 2))
`(let ((--emojify-loop-current-pos ,beg)
(--emojify-loop-end ,end)
(--emoji-positions nil)
--emoji-start)
(while (and (> --emojify-loop-end --emojify-loop-current-pos)
(setq --emoji-start (text-property-any --emojify-loop-current-pos --emojify-loop-end 'emojified t)))
(let ((--emoji-end (+ --emoji-start
(length (get-text-property --emoji-start 'emojify-text)))))
(push (cons --emoji-start --emoji-end) --emoji-positions)
(setq --emojify-loop-current-pos --emoji-end)))
(dolist (--position --emoji-positions)
(let ((emoji-start (car --position))
(emoji-end (cdr --position)))
,@forms))))
(defun emojify-message (format-string &rest args)
"Log debugging messages to buffer named 'emojify-log'.
This is a substitute to `message' since using it during redisplay causes errors.
FORMAT-STRING and ARGS are same as the arguments to `message'."
(when emojify-debug-mode
(emojify-with-saved-buffer-state
(with-current-buffer (get-buffer-create "emojify-log")
(goto-char (point-max))
(insert (apply #'format format-string args))
(insert "\n")))))
(defun emojify--get-relevant-region ()
"Try getting region in buffer that completely covers the current window.
This is used instead of directly using `window-start' and `window-end', since
they return the values corresponding buffer in currently selected window, which
is incorrect if the buffer where there are called is not actually the buffer
visible in the selected window."
(let* ((window-size (- (window-end) (window-start)))
(start (max (- (point) window-size) (point-min)))
(end (min (+ (point) window-size) (point-max))))
(cons start end)))
(defun emojify-quit-buffer ()
"Hide the current buffer.
There are windows other than the one the current buffer is displayed in quit the
current window too."
(interactive)
(if (= (length (window-list)) 1)
(bury-buffer)
(quit-window)))
(defvar emojify-common-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "q" #'emojify-quit-buffer)
(define-key map "n" #'next-line)
(define-key map "p" #'previous-line)
(define-key map "r" #'isearch-backward)
(define-key map "s" #'isearch-forward)
(define-key map ">" #'end-of-buffer)
(define-key map "<" #'beginning-of-buffer)
(dolist (key '("?" "h" "H"))
(define-key map key #'describe-mode))
(dolist (number (number-sequence 0 9))
(define-key map (number-to-string number) #'digit-argument))
map)
"Common keybindings available in all special emojify buffers.")
;; Customizations for control how emojis are displayed
(defgroup emojify nil
"Customization options for emojify"
:group 'display
:prefix "emojify-")
(defcustom emojify-emoji-json
(expand-file-name "data/emoji.json"
(cond (load-file-name (file-name-directory load-file-name))
((locate-library "emojify") (file-name-directory (locate-library "emojify")))
(t default-directory)))
"The path to JSON file containing the configuration for displaying emojis."
:type 'file
:group 'emojify)
(defvar emojify-emoji-set-json
(let ((json-array-type 'list)
(json-object-type 'hash-table))
(json-read-file (expand-file-name "data/emoji-sets.json"
(cond (load-file-name (file-name-directory load-file-name))
((locate-library "emojify") (file-name-directory (locate-library "emojify")))
(t default-directory))))))
(defcustom emojify-emoji-set "emojione-v2.2.6-22"
"The emoji set used to display emojis."
:type (append '(radio :tag "Emoji set")
(mapcar (lambda (set) (list 'const set))
(ht-keys emojify-emoji-set-json)))
:group 'emojify)
(defcustom emojify-emojis-dir
(locate-user-emacs-file "emojis")
"Path to the directory containing the emoji images."
:type 'directory
:group 'emojify)
(defcustom emojify-display-style
'image
"How the emoji's be displayed.
Possible values are
`image' - Display emojis using images, this requires images are supported by
user's Emacs installation
`unicode' - Display emojis using unicode characters, this works well on
platforms with good emoji fonts. In this case the emoji text
':wink:' will be substituted with 😉.
`ascii' - Display emojis as ascii characters, this is simplest and does not
require any external dependencies. In this cases emoji text like
':wink:' are substituted with ascii equivalents like ';)'"
:type '(radio :tag "Emoji display style"
(const :tag "Display emojis as images" image)
(const :tag "Display emojis as unicode characters" unicode)
(const :tag "Display emojis as ascii string" ascii))
:group 'emojify)
;; Customizations to control the enabling of emojify-mode
(defcustom emojify-inhibit-major-modes
'(dired-mode
doc-view-mode
debugger-mode
pdf-view-mode
image-mode
help-mode
ibuffer-mode
magit-popup-mode
magit-diff-mode
ert-results-mode
compilation-mode
proced-mode
mu4e-headers-mode
deft-mode)
"Major modes where emojify mode should not be enabled."
:type '(repeat symbol)
:group 'emojify)
(defcustom emojify-inhibit-in-buffer-functions
'(emojify-minibuffer-p emojify-helm-buffer-p)
"Functions used inhibit emojify-mode in a buffer.
These functions are called with one argument, the buffer where command
‘emojify-mode’ is about to be enabled, emojify is not enabled if any of the
functions return a non-nil value."
:type 'hook
:group 'emojify)
(defvar emojify-inhibit-emojify-in-current-buffer-p nil
"Should emojify be inhibited in current buffer.
This is a buffer local variable that can be set to inhibit enabling of
emojify in a buffer.")
(make-variable-buffer-local 'emojify-inhibit-emojify-in-current-buffer-p)
(defvar emojify-minibuffer-reading-emojis-p nil
"Are we currently reading emojis using minibuffer?")
(defun emojify-ephemeral-buffer-p (buffer)
"Determine if BUFFER is an ephemeral/temporary buffer."
(and (not (minibufferp))
(string-match-p "^ " (buffer-name buffer))))
(defun emojify-inhibit-major-mode-p (buffer)
"Determine if user has disabled the `major-mode' enabled for the BUFFER.
Returns non-nil if the buffer's major mode is part of `emojify-inhibit-major-modes'"
(with-current-buffer buffer
(apply #'derived-mode-p emojify-inhibit-major-modes)))
(defun emojify-helm-buffer-p (buffer)
"Determine if the current BUFFER is a helm buffer."
(unless emojify-minibuffer-reading-emojis-p
(string-match-p "\\*helm" (buffer-name buffer))))
(defun emojify-minibuffer-p (buffer)
"Determine if the current BUFFER is a minibuffer."
(unless emojify-minibuffer-reading-emojis-p
(minibufferp buffer)))
(defun emojify-buffer-p (buffer)
"Determine if `emojify-mode' should be enabled for given BUFFER.
`emojify-mode' mode is not enabled in temporary buffers. Additionally user
can customize `emojify-inhibit-major-modes' and
`emojify-inhibit-in-buffer-functions' to disabled emojify in additional buffers."
(not (or emojify-inhibit-emojify-in-current-buffer-p
(emojify-ephemeral-buffer-p (current-buffer))
(emojify-inhibit-major-mode-p (current-buffer))
(buffer-base-buffer buffer)
(run-hook-with-args-until-success 'emojify-inhibit-in-buffer-functions buffer))))
;; Obsolete vars
(define-obsolete-variable-alias 'emojify-emoji-style 'emojify-emoji-styles "0.2")
(define-obsolete-function-alias 'emojify-set-emoji-style 'emojify-set-emoji-styles "0.2")
;; Customizations to control display of emojis
(defvar emojify-emoji-style-change-hook nil
"Hooks run when emoji style changes.")
;;;###autoload
(defun emojify-set-emoji-styles (styles)
"Set the type of emojis that should be displayed.
STYLES is the styles emoji styles that should be used, see `emojify-emoji-styles'"
(when (not (listp styles))
(setq styles (list styles))
(warn "`emojify-emoji-style' has been deprecated use `emojify-emoji-styles' instead!"))
(setq-default emojify-emoji-styles styles)
(run-hooks 'emojify-emoji-style-change-hook))
(defcustom emojify-emoji-styles
'(ascii unicode github)
"The type of emojis that should be displayed.
These can have one of the following values
`ascii' - Display only ascii emojis for example ';)'
`unicode' - Display only unicode emojis for example '😉'
`github' - Display only github style emojis for example ':wink:'"
:type '(set
(const :tag "Display only ascii emojis" ascii)
(const :tag "Display only github emojis" github)
(const :tag "Display only unicode codepoints" unicode))
:set (lambda (_ value) (emojify-set-emoji-styles value))
:group 'emojify)
(defcustom emojify-program-contexts
'(comments string code)
"Contexts where emojis can be displayed in programming modes.
Possible values are
`comments' - Display emojis in comments
`string' - Display emojis in strings
`code' - Display emojis in code (this is applicable only for unicode emojis)"
:type '(set :tag "Contexts where emojis should be displayed in programming modes"
(const :tag "Display emojis in comments" comments)
(const :tag "Display emojis in string" string)
(const :tag "Display emojis in code" code))
:group 'emojify)
(defcustom emojify-inhibit-functions
'(emojify-in-org-tags-p emojify-in-org-list-p)
"Functions used to determine given emoji should displayed at current point.
These functions are called with 3 arguments, the text to be emojified, the start
of emoji text and the end of emoji text. These functions are called with the
buffer where emojis are going to be displayed selected."
:type 'hook
:group 'emojify)
(defcustom emojify-completing-read-function #'completing-read
"Require same argument with `completing-read'."
:type 'function
:group 'emojify)
(defcustom emojify-composed-text-p t
"Should composed text be emojified."
:type 'boolean
:group 'emojify)
(defcustom emojify-company-tooltips-p t
"Should company mode tooltips be emojified."
:type 'boolean
:group 'emojify)
(defun emojify-in-org-tags-p (match beg _end)
"Determine whether the point is on `org-mode' tag.
MATCH, BEG and _END are the text currently matched emoji and the start position
and end position of emoji text respectively.
Easiest would have to inspect face at point but unfortunately, there is no
way to guarantee that we run after font-lock"
(and (memq major-mode '(org-mode org-agenda-mode))
(string-match-p ":[^:]+[:]?" match)
(org-at-heading-p)
(save-excursion
(save-match-data
(goto-char beg)
;; Regex for tag picked from https://code.orgmode.org/bzg/org-mode/src/master/lisp/org.el#L589-L590
(looking-at ":[[:alnum:]_@#%:]+:[\s-]*$")))))
(defun emojify-in-org-list-p (text beg &rest ignored)
"Determine whether the point is in `org-mode' list.
TEXT is the text which is supposed to rendered a an emoji. BEG is the beginning
of the emoji text in the buffer. The arguments IGNORED are ignored."
(and (eq major-mode 'org-mode)
(equal text "8)")
(equal (org-list-get-item-begin) beg)))
(defun emojify-program-context-at-point-per-syntax-table (beg end)
"Determine the progamming context between BEG and END using the the syntax table."
(let ((syntax-beg (syntax-ppss beg))
(syntax-end (syntax-ppss end)))
(cond ((and (nth 3 syntax-beg) (nth 3 syntax-end)) 'string)
((and (nth 4 syntax-beg) (nth 4 syntax-end)) 'comments)
(t 'code))))
(defun emojify-program-context-at-point-per-face (beg _end)
"Determine the progamming context between BEG and END using the the face.
Used when the major mode for which we need to check the program context is not
the same as the current buffer's major mode, currently only used when displaying
emojis in org source blocks."
(let* ((face-at-point (get-text-property beg 'face))
(faces-at-point (if (listp face-at-point)
face-at-point
(list face-at-point))))
(cond ((memql 'font-lock-doc-face faces-at-point) 'string)
((memql 'font-lock-string-face faces-at-point) 'string)
((memql 'font-lock-comment-face faces-at-point) 'comments)
(t 'code))))
(defun emojify-valid-program-context-p (emoji beg end &optional use-faces)
"Determine if EMOJI should be displayed for text between BEG and END.
If the optional USE-FACES is true, the programming context is determined using
faces. This returns non-nil if the region is valid according to
`emojify-program-contexts'"
(when emojify-program-contexts
(let ((context (if use-faces
(emojify-program-context-at-point-per-face beg end)
(emojify-program-context-at-point-per-syntax-table beg end))))
(and (memql context emojify-program-contexts)
(if (equal context 'code)
(and (string= (ht-get emoji "style") "unicode")
(memql 'unicode emojify-emoji-styles))
t)))))
(defun emojify-org-src-lang-at-point (point)
"Return the `major-mode' for the org source block at POINT.
Returns nil if the point is not at an org source block"
(when (eq major-mode 'org-mode)
(save-excursion
(goto-char point)
(let ((element (org-element-at-point)))
(when (eq (org-element-type element) 'src-block)
(emojify-org-src-get-lang-mode (org-element-property :language element)))))))
(defun emojify-looking-at-end-of-list-maybe (point)
"Determine if POINT is end of a list.
This is not accurate since it restricts the region to scan to
the visible area."
(let* ((area (emojify--get-relevant-region))
(beg (car area))
(end (cdr area)))
(save-restriction
(narrow-to-region beg end)
(let ((list-start (ignore-errors (scan-sexps point -1))))
(when (and list-start
;; Ignore the starting brace if it is an emoji
(not (get-text-property list-start 'emojified)))
;; If we got a list start make sure both start and end
;; belong to same string/comment
(let ((syntax-beg (syntax-ppss list-start))
(syntax-end (syntax-ppss point)))
(and list-start
(eq (nth 8 syntax-beg)
(nth 8 syntax-end)))))))))
(defun emojify-valid-ascii-emoji-context-p (beg end)
"Determine if the okay to display ascii emoji between BEG and END."
;; The text is at the start of the buffer
(and (or (not (char-before beg))
;; 32 space since ? (? followed by a space) is not readable
;; 34 is " since?" confuses font-lock
;; 41 is ) since?) (extra paren) confuses most packages
(memq (char-syntax (char-before beg))
;; space
'(32
;; start/end of string
34
;; whitespace syntax
?-
;; comment start
?<
;; comment end, this handles text at start of line immediately
;; after comment line in a multiline comment
?>)))
;; The text is at the end of the buffer
(or (not (char-after end))
(memq (char-syntax (char-after end))
;; space
'(32
;; start/end of string
34
;; whitespace syntax
?-
;; punctuation
?.
;; closing braces
41
;; comment end
?>)))))
;; Customizations to control the behaviour when point enters emojified text
(defcustom emojify-point-entered-behaviour 'echo
"The behaviour when point enters, an emojified text.
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 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
:type '(radio :tag "Behaviour when point enters an emoji"
(const :tag "Echo the underlying emoji text in the minibuffer" echo)
(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."
:type 'boolean
:group 'emojify)
(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-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.
This is inspired by `prettify-symbol-mode's logic for
`prettify-symbols-unprettify-at-point'."
(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.
To understand WINDOW, STRING and POS see the function documentation for
`help-echo' text-property."
(when (and emojify-show-help
(not isearch-mode)
(not (active-minibuffer-window))
(not (current-message)))
(plist-get (text-properties-at pos) 'emojify-text)))
;; Core functions and macros
;; Variables related to user emojis
(defcustom emojify-user-emojis nil
"User specified custom emojis.
This is an alist where first element of cons is the text to be displayed as
emoji, while the second element of the cons is an alist containing data about
the emoji.
The inner alist should have atleast (not all keys are strings)
`name' - The name of the emoji
`style' - This should be one of \"github\", \"ascii\" or \"github\"
(see `emojify-emoji-styles')
The alist should contain one of (see `emojify-display-style')
`unicode' - The replacement for the provided emoji for \"unicode\" display style
`image' - The replacement for the provided emoji for \"image\" display style.
This should be the absolute path to the image
`ascii' - The replacement for the provided emoji for \"ascii\" display style
Example -
The following assumes that custom images are at ~/.emacs.d/emojis/trollface.png and
~/.emacs.d/emojis/neckbeard.png
'((\":troll:\" . ((\"name\" . \"Troll\")
(\"image\" . \"~/.emacs.d/emojis/trollface.png\")
(\"style\" . \"github\")))
(\":neckbeard:\" . ((\"name\" . \"Neckbeard\")
(\"image\" . \"~/.emacs.d/emojis/neckbeard.png\")
(\"style\" . \"github\"))))"
:type '(alist :key-type string
:value-type (alist :key-type string
:value-type string))
:group 'emojify)
(defvar emojify--user-emojis nil
"User specified custom emojis.")
(defvar emojify--user-emojis-regexp nil
"Regexp to match user specified custom emojis.")
;; Variables related to default emojis
(defvar emojify-emojis nil
"Data about the emojis, this contains only the emojis that come with emojify.")
(defvar emojify-regexps nil
"List of regexps to match text to be emojified.")
(defvar emojify--completing-candidates-cache nil
"Cached values for completing read candidates calculated for `emojify-completing-read'.")
;; Cache for emoji completing read candidates
(defun emojify--get-completing-read-candidates ()
"Get the candidates to be used for `emojify-completing-read'.
The candidates are calculated according to currently active
`emojify-emoji-styles' and cached"
(let ((styles (mapcar #'symbol-name emojify-emoji-styles)))
(unless (and emojify--completing-candidates-cache
(equal styles (car emojify--completing-candidates-cache)))
(setq emojify--completing-candidates-cache
(cons styles
(let ((emojis '()))
(emojify-emojis-each (lambda (key value)
(when (seq-position styles (ht-get value "style"))
(push (format "%s - %s (%s)"
key
(ht-get value "name")
(ht-get value "style"))
emojis))))
emojis))))
(cdr emojify--completing-candidates-cache)))
(defun emojify-create-emojify-emojis (&optional force)
"Create `emojify-emojis' if needed.
The function avoids reading emoji data if it has already been read unless FORCE
in which case emoji data is re-read."
(when (or force (not emojify-emojis))
(emojify-set-emoji-data)))
(defun emojify-get-emoji (emoji)
"Get data for given EMOJI.
This first looks for the emoji in `emojify--user-emojis',
and then in `emojify-emojis'."
(or (when emojify--user-emojis
(ht-get emojify--user-emojis emoji))
(ht-get emojify-emojis emoji)))
(defun emojify-emojis-each (function)
"Execute FUNCTION for each emoji.
This first runs function for `emojify--user-emojis',
and then `emojify-emojis'."
(when emojify--user-emojis
(ht-each function emojify--user-emojis))
(ht-each function emojify-emojis))
(defun emojify--verify-user-emojis (emojis)
"Verify the EMOJIS in correct user format."
(seq-every-p (lambda (emoji)
(and (assoc "name" (cdr emoji))
;; Make sure style is present is only one of
;; "unicode", "ascii" and "github".
(assoc "style" (cdr emoji))
(seq-position '("unicode" "ascii" "github")
(cdr (assoc "style" (cdr emoji))))
(or (assoc "unicode" (cdr emoji))
(assoc "image" (cdr emoji))
(assoc "ascii" (cdr emoji)))))
emojis))
(defun emojify-set-emoji-data ()
"Read the emoji data for STYLES and set the regexp required to search them."
(setq-default emojify-emojis (let ((json-array-type 'list)
(json-object-type 'hash-table))
(json-read-file emojify-emoji-json)))
(let (unicode-emojis ascii-emojis)
(ht-each (lambda (emoji data)
(when (string= (ht-get data "style") "unicode")
(push emoji unicode-emojis))
(when (string= (ht-get data "style") "ascii")
(push emoji ascii-emojis)))
emojify-emojis)
;; Construct emojify-regexps such that github style are searched first
;; followed by unicode and then ascii emojis.
(setq emojify-regexps (list ":[[:alnum:]+_-]+:"
(regexp-opt unicode-emojis)
(regexp-opt ascii-emojis))))
(when emojify-user-emojis
(if (emojify--verify-user-emojis emojify-user-emojis)
;; Create entries for user emojis
(let ((emoji-pairs (mapcar (lambda (user-emoji)
(cons (car user-emoji)
(ht-from-alist (cdr user-emoji))))
emojify-user-emojis)))
(setq emojify--user-emojis (ht-from-alist emoji-pairs))
(setq emojify--user-emojis-regexp (regexp-opt (mapcar #'car emoji-pairs))))
(message "[emojify] User emojis are not in correct format ignoring them.")))
(emojify-emojis-each (lambda (emoji data)
;; Add the emoji text to data, this makes the values
;; of the `emojify-emojis' standalone containing all
;; data about the emoji
(ht-set! data "emoji" emoji)
(ht-set! data "custom" (and emojify--user-emojis
(ht-get emojify--user-emojis emoji)))))
;; Clear completion candidates cache
(setq emojify--completing-candidates-cache nil))
(defvar emojify-emoji-keymap
(let ((map (make-sparse-keymap)))
(define-key map [remap delete-char] #'emojify-delete-emoji-forward)
(define-key map [remap delete-forward-char] #'emojify-delete-emoji-forward)
(define-key map [remap backward-delete-char] #'emojify-delete-emoji-backward)
(define-key map [remap org-delete-backward-char] #'emojify-delete-emoji-backward)
(define-key map [remap delete-backward-char] #'emojify-delete-emoji-backward)
(define-key map [remap backward-delete-char-untabify] #'emojify-delete-emoji-backward)
map))
(defun emojify-image-dir ()
"Get the path to directory containing images for currently selected emoji set."
(expand-file-name emojify-emoji-set
emojify-emojis-dir))
(defun emojify--get-point-col-and-line (point)
"Return a cons of containing the column number and line at POINT."
(save-excursion
(goto-char point)
(cons (current-column) (line-number-at-pos))))
(defun emojify--get-characters-for-composition (composition)
"Extract the characters from COMPOSITION."
(if (nth 3 composition)
(nth 2 composition)
(let ((index -1))
(seq-filter #'identity
(seq-map (lambda (elt)
(cl-incf index)
(when (cl-evenp index) elt))
(nth 2 composition))))))
(defun emojify--get-composed-text (point)
"Get the text used as composition property at POINT.
This does not check if there is composition property at point the callers should
make sure the point has a composition property otherwise this function will
fail."
(let* ((composition (find-composition point nil nil t))
(characters (emojify--get-characters-for-composition composition)))
(emojify-string-join (seq-map #'char-to-string characters))))
(defun emojify--inside-rectangle-selection-p (beg end)
"Check if region marked by BEG and END is inside a rectangular selection.
In addition to explicit the parameters BEG and END, calling functions should
also dynamically bind `emojify-region-beg' and `emojify-region-end' to beginning
and end of region respectively."
(when (and emojify-region-beg
(bound-and-true-p rectangle-mark-mode))
(let ((rect-beg (emojify--get-point-col-and-line emojify-region-beg))
(rect-end (emojify--get-point-col-and-line emojify-region-end))
(emoji-start-pos (emojify--get-point-col-and-line beg))
(emoji-end-pos (emojify--get-point-col-and-line end)))
(or (and (<= (car rect-beg) (car emoji-start-pos))
(<= (car emoji-start-pos) (car rect-end))
(<= (cdr rect-beg) (cdr emoji-start-pos))
(<= (cdr emoji-start-pos) (cdr rect-end)))
(and (<= (car rect-beg) (car emoji-end-pos))
(<= (car emoji-end-pos) (car rect-end))
(<= (cdr rect-beg) (cdr emoji-end-pos))
(<= (cdr emoji-end-pos) (cdr rect-end)))))))
(defun emojify--inside-non-rectangle-selection-p (beg end)
"Check if region marked by BEG and END is inside a non-regular selection.
In addition to the explicit parameters BEG and END, calling functions should
also dynamically bind `emojify-region-beg' and `emojify-region-end' to beginning
and end of region respectively."
(when (and emojify-region-beg
(region-active-p)
(not (bound-and-true-p rectangle-mark-mode)))
(or (and (< emojify-region-beg beg)
(<= beg emojify-region-end))
(and (< emojify-region-beg end)
(<= end emojify-region-end)))))
(defun emojify--region-background-maybe (beg end)
"If the BEG and END falls inside an active region return the region face.
This returns nil if the emojis between BEG and END do not fall in region."
;; `redisplay-highlight-region-function' was not defined in Emacs 24.3
(when (and (or (not (boundp 'redisplay-highlight-region-function))
(equal (default-value 'redisplay-highlight-region-function) redisplay-highlight-region-function))
(or (emojify--inside-non-rectangle-selection-p beg end)
(emojify--inside-rectangle-selection-p beg end)))
(face-background 'region)))
(defun emojify--get-image-background (beg end)
"Get the color to be used as background for emoji between BEG and END."
;; We do a separate check for region since `background-color-at-point'
;; does not always detect background color inside regions properly
(or (emojify--region-background-maybe beg end)
(save-excursion
(goto-char beg)
(condition-case nil
(background-color-at-point)
(wrong-type-argument nil)))))
(defvar emojify--imagemagick-support-cache (ht-create))
(defun emojify--imagemagick-supports-p (format)
"Check if imagemagick support given FORMAT.
This function caches the result of the check since the naive check
(memq format (imagemagick-types))