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).

diff --git a/etc/NEWS b/etc/NEWS
index bae4cb3963e9d005b5f55e85cc1e460205e046c9..d525ace6716c0fc47e3fe4f9662f78c8ba7700df 100644 (file)
--- 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 5504a5207836737516c7185a7a2bcd0dc80d6fb5..7d6efacfe07274a5782a7987357aebe9d4e8b372 100644 (file)
--- 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