Package: emacs;
Reported by: Adam Sjøgren <asjo <at> koldfront.dk>
Date: Fri, 9 Oct 2020 19:36:02 UTC
Severity: normal
Tags: fixed, patch
Found in version 28.0.50
Fixed in version 28.1
Done: Lars Ingebrigtsen <larsi <at> gnus.org>
Bug is archived. No further changes may be made.
Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Adam Sjøgren <asjo <at> koldfront.dk> To: bug-gnu-emacs <at> gnu.org Subject: 28.0.50; [PATCH] Add new smiley-style emoji to Gnus Date: Fri, 09 Oct 2020 21:35:06 +0200
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 <at> 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))
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.