From 990791262433923748047d3bec0161cbcfca5b59 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Adam=20Sj=C3=B8gren?= <asjo@koldfront.dk>
Date: Sun, 18 Oct 2020 09:36:43 +0200
Subject: [PATCH] Add support for emojis i smiley.el

* lisp/gnus/smiley.el (smiley-style): Add emoji
tag.
(smiley-emoji-regexp-alist): New defcustom.
(smiley-update-cache, smiley-region): Support emoji (non-image)
replacement (bug#43889).
---
 etc/NEWS            |  4 +++
 lisp/gnus/smiley.el | 76 +++++++++++++++++++++++++++++++++------------
 2 files changed, 60 insertions(+), 20 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index bae4cb3963e..d525ace6716 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -434,6 +434,10 @@ tags to be considered as well.
 
 ** Gnus
 
+*** New value for user option 'smiley-style'
+Smileys can now be rendered with emojis instead of small images when
+using the new 'emoji' value in 'smiley-style'.
+
 +++
 *** New user option 'gnus-agent-eagerly-store-articles'.
 If non-nil (which is the default), the Gnus Agent will store all read
diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el
index 5504a520783..7d6efacfe07 100644
--- a/lisp/gnus/smiley.el
+++ b/lisp/gnus/smiley.el
@@ -44,6 +44,7 @@
 ;; cry               ;-(
 ;; dead              X-)
 ;; grin              :-D
+;; halo              O:-)
 
 ;;; Code:
 
@@ -64,7 +65,8 @@
   "Smiley style."
   :type '(choice (const :tag "small, 3 colors" low-color)  ;; 13x14
 		 (const :tag "medium, ~10 colors" medium)  ;; 16x16
-		 (const :tag "dull, grayscale" grayscale)) ;; 14x14
+		 (const :tag "dull, grayscale" grayscale)  ;; 14x14
+                 (const :tag "emoji, full color" emoji))
   :set (lambda (symbol value)
 	 (set-default symbol value)
 	 (setq smiley-data-directory (smiley-directory))
@@ -96,6 +98,35 @@ is nil, use `smiley-style'."
   :type 'directory
   :group 'smiley)
 
+(defcustom smiley-emoji-regexp-alist
+  '(("\\(;-)\\)\\W" 1 "😉")
+    ("[^;]\\(;)\\)\\W" 1 "😉")
+    ("\\(:-]\\)\\W" 1 "😬")
+    ("\\(8-)\\)\\W" 1 "🥴")
+    ("\\(:-|\\)\\W" 1 "😐")
+    ("\\(:-[/\\]\\)\\W" 1 "😕")
+    ("\\(:-(\\)\\W" 1 "😠")
+    ("\\(X-)\\)\\W" 1 "😵") ; 💀
+    ("\\(:-{\\)\\W" 1 "😦")
+    ("\\(>:-)\\)\\W" 1 "😈")
+    ("\\(;-(\\)\\W" 1 "😢")
+    ("\\(:-D\\)\\W" 1 "😀")
+    ("\\(O:-)\\)\\W" 1 "😇")
+    ;; "smile" must be come after "evil"
+    ("\\(\\^?:-?)\\)\\W" 1 "🙂"))
+  "A list of regexps to map smilies to emoji.
+The elements are (REGEXP MATCH EMOJI), where MATCH is the submatch in
+regexp to replace with EMOJI."
+  :version "28.1"
+  :type '(repeat (list regexp
+		       (integer :tag "Regexp match number")
+		       (string :tag "Emoji")))
+  :set (lambda (symbol value)
+	 (set-default symbol value)
+	 (smiley-update-cache))
+  :initialize 'custom-initialize-default
+  :group 'smiley)
+
 ;; The XEmacs version has a baroque, if not rococo, set of these.
 (defcustom smiley-regexp-alist
   '(("\\(;-)\\)\\W" 1 "blink")
@@ -142,23 +173,25 @@ regexp to replace with IMAGE.  IMAGE is the name of an image file in
 
 (defun smiley-update-cache ()
   (setq smiley-cached-regexp-alist nil)
-  (dolist (elt (if (symbolp smiley-regexp-alist)
-		   (symbol-value smiley-regexp-alist)
-		 smiley-regexp-alist))
-    (let ((types gnus-smiley-file-types)
-	  file type)
-      (while (and (not file)
-		  (setq type (pop types)))
-	(unless (file-exists-p
-		 (setq file (expand-file-name (concat (nth 2 elt) "." type)
-					      smiley-data-directory)))
-	  (setq file nil)))
-      (when type
-	(let ((image (gnus-create-image file (intern type) nil
-					:ascent 'center)))
-	  (when image
-	    (push (list (car elt) (cadr elt) image)
-		  smiley-cached-regexp-alist)))))))
+  (if (eq smiley-style 'emoji)
+      (setq smiley-cached-regexp-alist smiley-emoji-regexp-alist)
+    (dolist (elt (if (symbolp smiley-regexp-alist)
+		     (symbol-value smiley-regexp-alist)
+		   smiley-regexp-alist))
+      (let ((types gnus-smiley-file-types)
+	    file type)
+        (while (and (not file)
+		    (setq type (pop types)))
+	  (unless (file-exists-p
+		   (setq file (expand-file-name (concat (nth 2 elt) "." type)
+					        smiley-data-directory)))
+	    (setq file nil)))
+        (when type
+	  (let ((image (gnus-create-image file (intern type) nil
+					  :ascent 'center)))
+	    (when image
+	      (push (list (car elt) (cadr elt) image)
+		    smiley-cached-regexp-alist))))))))
 
 ;; Not implemented:
 ;; (defvar smiley-mouse-map
@@ -190,8 +223,11 @@ A list of images is returned."
 	    (when image
 	      (push image images)
 	      (gnus-add-wash-type 'smiley)
-	      (gnus-add-image 'smiley image)
-	      (gnus-put-image image string 'smiley))))
+              (if (symbolp image)
+                  (progn
+	            (gnus-add-image 'smiley image)
+	            (gnus-put-image image string 'smiley))
+                (insert image)))))
 	images))))
 
 ;;;###autoload
-- 
2.39.2