bug#43889: 28.0.50; [PATCH] Add new smiley-style emoji to Gnus

[Adam Sjøgren]

The new smiley-style called emoji takes advantage of the harfbuzz glyph
rendering to represent smileys as colorful unicode emoji rather than
images.

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

How about an option to use emoji for smileys in Gnus?

 lisp/gnus/smiley.el | 76 +++++++++++++++++++++++++++++++++------------
 1 file changed, 56 insertions(+), 20 deletions(-)

diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el
index 5504a52078..7d6efacfe0 100644
--- a/lisp/gnus/smiley.el
+++ b/lisp/gnus/smiley.el
@@ -44,6 +44,7 @@
 ;; cry               😢
 ;; dead              😵
 ;; grin              😀
+;; halo              😇
 
 ;;; Code:
 
@@ -64,7 +65,8 @@ smiley-style
   "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 @@ smiley-data-directory
   :type 'directory
   :group 'smiley)
 
+(defcustom smiley-emoji-regexp-alist
+  '(("\\(😉\\)\\W" 1 "😉")
+    ("[^;]\\(😉\\)\\W" 1 "😉")
+    ("\\(😬\\)\\W" 1 "😬")
+    ("\\(🥴\\)\\W" 1 "🥴")
+    ("\\(😐\\)\\W" 1 "😐")
+    ("\\(:-[/\\]\\)\\W" 1 "😕")
+    ("\\(😠\\)\\W" 1 "😠")
+    ("\\(😵\\)\\W" 1 "😵") ; 💀
+    ("\\(😦\\)\\W" 1 "😦")
+    ("\\(😈\\)\\W" 1 "😈")
+    ("\\(😢\\)\\W" 1 "😢")
+    ("\\(😀\\)\\W" 1 "😀")
+    ("\\(😇\\)\\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 @@ smiley-cached-regexp-alist
 
 (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 @@ smiley-region
            (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.28.0

-- 
 "I'm sorry I sound calm. I assure you that                 Adam Sjøgren
  I am hysterical."                                    asjo@koldfront.dk


In GNU Emacs 28.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.23, cairo 
version 1.16.0)
 of 2020-10-03 built on tullinup
Repository revision: 98728d576cf4db789a3f7e1ff01a4edcac985485
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12009000
System Description: Debian GNU/Linux bullseye/sid

Configured using:
 'configure --without-pop --with-cairo --with-harfbuzz'

Configured features:
XPM JPEG TIFF GIF PNG RSVG CAIRO SOUND GPM DBUS GSETTINGS GLIB NOTIFY
INOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE HARFBUZZ M17N_FLT LIBOTF
ZLIB TOOLKIT_SCROLL_BARS GTK3 X11 XDBE XIM MODULES THREADS LIBSYSTEMD
JSON PDUMPER LCMS2

Important settings:
  value of $LANG: en_GB.UTF-8
  locale-coding-system: utf-8-unix

Major mode: Group

Minor modes in effect:
  gnus-topic-mode: t
  gnus-undo-mode: t
  pixel-scroll-mode: t
  engine-mode: t
  global-magit-file-mode: t
  magit-auto-revert-mode: t
  global-git-commit-mode: t
  TeX-PDF-mode: t
  dumb-jump-mode: t
  which-function-mode: t
  global-auto-complete-mode: t
  shell-dirtrack-mode: t
  save-place-mode: t
  jabber-activity-mode: t
  winner-mode: t
  global-tab-line-mode: t
  tab-line-mode: t
  tooltip-mode: t
  global-eldoc-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  menu-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  buffer-read-only: t
  line-number-mode: t

Load-path shadows:
/usr/share/emacs/site-lisp/elpa-src/ess-18.10.2/debian-autoloads hides 
/usr/share/emacs/site-lisp/elpa-src/dpkg-dev-el-37.0/debian-autoloads
/usr/share/emacs/site-lisp/elpa-src/boxquote-2.1/boxquote hides 
~/elisp/extra/boxquote
~/elisp/let-alist/let-alist hides ~/elisp/extra/let-alist
~/elisp/let-alist/let-alist hides /usr/src/emacs/lisp/emacs-lisp/let-alist

Features:
(shadow emacsbug compface qp bbdb-message sendmail mule-util url-http
url-gw url-auth gnus-gravatar gravatar sort smiley gnus-cite mm-archive
gnus-async gnus-bcklg gnus-dup gnus-ml gmane gnus-topic utf-7 imap
rfc2104 pp epa-file network-stream nsm nnml bbdb-gnus bbdb-mua nnnil
gnus-demon gnus-twit gnus-delay gnus-draft gnus-agent gnus-srvr
gnus-score score-mode nnvirtual nntp gnus-cache nndraft nnmh mail-extr
spam spam-stat bbdb-com gnus-uu yenc gnus-msg gnus-html url-queue
help-fns radix-tree url-cache mm-url bbdb-picture gnus-art mm-uu mml2015
mm-view mml-smime smime dig gnus-sum gnus-group gnus-undo gnus-fun
hashcash gnus-start gnus-dbus gnus-cloud nnimap nnmail mail-source utf7
netrc nnoo gnus-spec gnus-int gnus-range gnus-win gnus nnheader paren
cus-start cus-load gopher shr kinsoku svg pixel-scroll litable
engine-mode gitpatch magithub magithub-ci magithub-issue magithub-cache
magithub-core magit-submodule magit-obsolete magit-popup magit-blame
magit-stash magit-reflog magit-bisect magit-push magit-pull magit-fetch
magit-clone magit-remote magit-commit magit-sequence magit-notes
magit-worktree magit-tag magit-merge magit-branch magit-reset
magit-files magit-refs magit-status magit magit-repos magit-apply
magit-wip magit-log magit-diff smerge-mode diff magit-core
magit-autorevert autorevert filenotify magit-margin magit-transient
magit-process magit-mode git-commit recentf tree-widget transient
magit-git magit-section benchmark magit-utils vc-git diff-mode log-edit
message rmc rfc822 mml mml-sec epa epg epg-config gnus-util rmail
rmail-loaddefs mm-decode mm-bodies mm-encode mail-parse rfc2231 rfc2047
rfc2045 mm-util ietf-drums mail-prsvr mailabbrev mail-utils gmm-utils
mailheader pcvs-util with-editor term disp-table ehelp eshell esh-cmd
esh-ext esh-opt esh-proc esh-io esh-arg esh-module esh-groups esh-util
xenops xenops-xen xenops-style xenops-util xenops-src xenops-png
xenops-parse xenops-overlay xenops-minted xenops-math xenops-math-latex
xenops-aio xenops-image xenops-footnote xenops-font xenops-elements
xenops-element xenops-doctor xenops-auctex xenops-avy xenops-apply
preview prv-emacs tex-buf latex-mode-expansions latex latex-flymake
tex-ispell tex-style tex crm dash-functional aio org-element avl-tree
the-org-mode-expansions org ob ob-tangle ob-ref ob-lob ob-table ob-exp
org-macro org-footnote org-src ob-comint org-pcomplete org-list
org-faces org-entities org-version ob-emacs-lisp ob-core ob-eval
org-table ol org-keys org-compat org-macs org-loaddefs find-func
cal-menu calendar cal-loaddefs avy wgrep-ag wgrep grep deadgrep spinner
ag vc-svn find-dired dumb-jump f dash s etags fileloop generator
auto-loads tex-site expand-region cperl-mode-expansions
text-mode-expansions html-mode-expansions er-basic-expansions
expand-region-core expand-region-custom which-func cperl-mode
auto-complete-config auto-complete popup cl-extra help-mode ess-site
ess-toolbar ess-mouse mouseme ess-swv ess-noweb ess-noweb-font-lock-mode
ess-jags-d ess-bugs-l essd-els ess-xls-d ess-vst-d ess-stata-mode
ess-stata-lang cc-vars cc-defs make-regexp ess-sp6w-d ess-sp5-d
ess-sp4-d ess-sas-d ess-sas-l ess-sas-a ess-s4-d ess-s3-d ess-omg-d
ess-omg-l ess-arc-d ess-lsp-l ess-sp6-d ess-dde ess-sp3-d ess-julia
julia-mode ess-r-mode ess-r-flymake rx flymake-proc flymake warnings
thingatpt ess-r-xref xref project ess-trns ess-r-package ess-r-syntax
pcase ess-r-completion ess-roxy ess-rd essddr noutline outline hideshow
ess-s-lang speedbar ezimage dframe ess-help info reporter ess-mode ess
ess-noweb-mode ess-inf ess-tracebug easy-mmode ess-generics compile
text-property-search ess-utils ido ess-custom executable tramp
tramp-loaddefs trampver tramp-integration files-x tramp-compat shell
pcomplete parse-time iso8601 ls-lisp debian-changelog-mode imenu add-log
dpkg-dev-el saveplace vc vc-dispatcher bbdb derived bbdb-site timezone
bbdb-loaddefs boxquote rect jabber-last-message-correction
jabber-http-file-upload url url-proxy url-privacy url-expand url-methods
url-history url-cookie url-domsuf url-util jabber-print-html jabber-otr
jabber jabber-notifications notifications jabber-libnotify dbus
jabber-awesome jabber-osd jabber-wmii jabber-xmessage jabber-festival
jabber-sawfish jabber-ratpoison jabber-tmux jabber-screen jabber-socks5
jabber-ft-server jabber-si-server jabber-ft-client jabber-ft-common
jabber-si-client jabber-si-common jabber-feature-neg jabber-truncate
jabber-time jabber-autoaway time-date jabber-vcard-avatars
jabber-chatstates jabber-events jabber-vcard jabber-avatar mailcap
jabber-activity jabber-watch jabber-modeline advice jabber-ahc-presence
jabber-ahc jabber-version jabber-ourversion jabber-muc-nick-completion
hippie-exp comint ansi-color jabber-browse jabber-search jabber-register
jabber-roster format-spec jabber-presence jabber-muc jabber-bookmarks
jabber-private jabber-muc-nick-coloring hexrgb jabber-widget
jabber-disco wid-edit jabber-chat jabber-history jabber-chatbuffer
jabber-alert jabber-iq jabber-core jabber-console sgml-mode dom ewoc
jabber-keymap jabber-sasl sasl sasl-anonymous sasl-login sasl-plain fsm
jabber-logon jabber-conn srv dns starttls tls jabber-xml xml jabber-menu
jabber-util cl winner ring gnutls puny find-file-from-selection
find-lisp dired dired-loaddefs cap-words superword subword edmacro
kmacro server tab-line finder-inf package easymenu browse-url
url-handlers url-parse auth-source cl-seq eieio eieio-core cl-macs
eieio-loaddefs password-cache json subr-x map url-vars seq byte-opt gv
bytecomp byte-compile cconv cl-loaddefs cl-lib tooltip eldoc electric
uniquify ediff-hook vc-hooks lisp-float-type mwheel term/x-win x-win
term/common-win x-dnd tool-bar dnd fontset image regexp-opt fringe
tabulated-list replace newcomment text-mode elisp-mode lisp-mode
prog-mode register page tab-bar menu-bar rfn-eshadow isearch timer
select scroll-bar mouse jit-lock font-lock syntax facemenu font-core
term/tty-colors frame minibuffer cl-generic cham georgian utf-8-lang
misc-lang vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms
cp51932 hebrew greek romanian slovak czech european ethiopic indian
cyrillic chinese composite charscript charprop case-table epa-hook
jka-cmpr-hook help simple abbrev obarray cl-preloaded nadvice button
loaddefs faces cus-face macroexp files window text-properties overlay
sha1 md5 base64 format env code-pages mule custom widget
hashtable-print-readable backquote threads dbusbind inotify lcms2
dynamic-setting system-font-setting font-render-setting cairo
move-toolbar gtk x-toolkit x multi-tty make-network-process emacs)

Memory information:
((conses 16 863166 53911)
 (symbols 48 49746 137)
 (strings 32 264072 16385)
 (string-bytes 1 11838201)
 (vectors 16 68138)
 (vector-slots 8 2319913 255943)
 (floats 8 481 380)
 (intervals 56 8480 315)
 (buffers 992 27))