diff options
Diffstat (limited to 'lisp/gnus/smiley.el')
| -rw-r--r-- | lisp/gnus/smiley.el | 93 |
1 files changed, 65 insertions, 28 deletions
diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el index d41f32801ee..3edae04fcc0 100644 --- a/lisp/gnus/smiley.el +++ b/lisp/gnus/smiley.el @@ -44,6 +44,7 @@ ;; cry ;-( ;; dead X-) ;; grin :-D +;; halo O:-) ;;; Code: @@ -56,18 +57,16 @@ (defvar smiley-data-directory) -(defcustom smiley-style - (if (and (fboundp 'face-attribute) - ;; In batch mode, attributes can be unspecified. - (condition-case nil - (>= (face-attribute 'default :height) 160) - (error nil))) - 'medium - 'low-color) +;; In batch mode, attributes can be unspecified. +(defcustom smiley-style (if (ignore-errors + (>= (face-attribute 'default :height) 160)) + 'medium + 'low-color) "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)) @@ -99,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") @@ -145,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 @@ -193,8 +223,15 @@ 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)) + ;; This is a string, but mark the property for + ;; deletion if the washing method is switched off. + (insert (propertize string + 'display image + 'gnus-image-category 'smiley)))))) images)))) ;;;###autoload |