-
-(defvar smiley-data-directory (message-xmas-find-glyph-directory "smilies")
- "Location of the smiley faces files.")
-
-;; Notice the subtle differences in the regular expessions in the two alists below
-
-(defvar smiley-deformed-regexp-alist
- '(("\\(:-*[<«]+\\)\\W" 1 "FaceAngry.xpm")
- ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm")
- ("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm")
- ("\\(:-*[)>}»]+\\)\\W" 1 "FaceHappy.xpm")
- ("\\(:-*[/\\\"]\\)[^/]" 1 "FaceIronic.xpm")
- ("\\([8|]-*[|Oo%]\\)\\W" 1 "FaceKOed.xpm")
- ("\\([:|]-*#+\\)\\W" 1 "FaceNyah.xpm")
- ("\\(:-*[({]+\\)\\W" 1 "FaceSad.xpm")
- ("\\(:-*[Oo\*]\\)\\W" 1 "FaceStartled.xpm")
- ("\\(:-*|\\)\\W" 1 "FaceStraight.xpm")
- ("\\(:-*p\\)\\W" 1 "FaceTalking.xpm")
- ("\\(:-*d\\)\\W" 1 "FaceTasty.xpm")
- ("\\(;-*[>)}»]+\\)\\W" 1 "FaceWinking.xpm")
- ("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm")
- ("\\([:|]-*P\\)\\W" 1 "FaceYukky.xpm"))
- "Normal and deformed faces for smilies.")
-
-(defvar smiley-nosey-regexp-alist
- '(("\\(:-+[<«]+\\)\\W" 1 "FaceAngry.xpm")
- ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm")
- ("\\(:-+D\\)\\W" 1 "FaceGrinning.xpm")
- ("\\(:-+[}»]+\\)\\W" 1 "FaceHappy.xpm")
- ("\\(:-*)+\\)\\W" 1 "FaceHappy.xpm") ;; The exception that confirms the rule
- ("\\(:-+[/\\\"]+\\)\\W" 1 "FaceIronic.xpm")
- ("\\([8|]-+[|Oo%]\\)\\W" 1 "FaceKOed.xpm")
- ("\\([:|]-+#+\\)\\W" 1 "FaceNyah.xpm")
- ("\\(:-+[({]+\\)\\W" 1 "FaceSad.xpm")
- ("\\(:-+[Oo\*]\\)\\W" 1 "FaceStartled.xpm")
- ("\\(:-+|\\)\\W" 1 "FaceStraight.xpm")
- ("\\(:-+p\\)\\W" 1 "FaceTalking.xpm")
- ("\\(:-+d\\)\\W" 1 "FaceTasty.xpm")
- ("\\(;-+[>)}»]+\\)\\W" 1 "FaceWinking.xpm")
- ("\\(:-+[Vvµ]\\)\\W" 1 "FaceWry.xpm")
- ("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm"))
- "Smileys with noses. These get less false matches.")
-
-(defvar smiley-regexp-alist smiley-deformed-regexp-alist
- "A list of regexps to map smilies to real images.
-Defaults to the content of smiley-deformed-regexp-alist.
-An alternative smiley-nose-regexp-alist that
-matches less aggresively is available.
-If this is a symbol, take its value.")
-
-(defvar smiley-flesh-color "yellow"
- "Flesh color.")
-
-(defvar smiley-features-color "black"
- "Features color.")
-
-(defvar smiley-tongue-color "red"
- "Tongue color.")
-
-(defvar smiley-circle-color "black"
- "Circle color.")
-
-(defvar smiley-glyph-cache nil)
-(defvar smiley-running-xemacs (string-match "XEmacs" emacs-version))
-
-(defvar smiley-map (make-sparse-keymap "smiley-keys")
- "keymap to toggle smiley states")
-
-(define-key smiley-map [(button2)] 'smiley-toggle-extent)
-
-(defun smiley-create-glyph (smiley pixmap)
- (and
- smiley-running-xemacs
- (or
- (cdr-safe (assoc pixmap smiley-glyph-cache))
- (let* ((xpm-color-symbols
- (and (featurep 'xpm)
- (append `(("flesh" ,smiley-flesh-color)
- ("features" ,smiley-features-color)
- ("tongue" ,smiley-tongue-color))
- xpm-color-symbols)))
- (glyph (make-glyph
- (list
- (cons 'x (expand-file-name pixmap smiley-data-directory))
- (cons 'tty smiley)))))
- (setq smiley-glyph-cache (cons (cons pixmap glyph) smiley-glyph-cache))
- (set-glyph-face glyph 'default)
- glyph))))
+(require 'nnheader)
+(require 'gnus-art)
+
+(defgroup smiley nil
+ "Turn :-)'s into real images."
+ :group 'gnus-visual)
+
+;; Maybe this should go.
+(defcustom smiley-data-directory (nnheader-find-etc-directory "smilies")
+ "*Location of the smiley faces files."
+ :type 'directory
+ :group 'smiley)
+
+;; The XEmacs version has a baroque, if not rococo, set of these.
+(defcustom smiley-regexp-alist
+ '(("\\(:-?)\\)\\W" 1 "smile")
+ ("\\(;-?)\\)\\W" 1 "blink")
+ ("\\(:-]\\)\\W" 1 "forced")
+ ("\\(8-)\\)\\W" 1 "braindamaged")
+ ("\\(:-|\\)\\W" 1 "indifferent")
+ ("\\(:-[/\\]\\)\\W" 1 "wry")
+ ("\\(:-(\\)\\W" 1 "sad")
+ ("\\(:-{\\)\\W" 1 "frown"))
+ "*A list of regexps to map smilies to images.
+The elements are (REGEXP MATCH FILE), where MATCH is the submatch in
+regexp to replace with IMAGE. IMAGE is the name of a PBM file in
+`smiley-data-directory'."
+ :type '(repeat (list regexp
+ (integer :tag "Regexp match number")
+ (string :tag "Image name")))
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (smiley-update-cache))
+ :initialize 'custom-initialize-default
+ :group 'smiley)
+
+(defcustom gnus-smiley-file-types
+ (let ((types (list "pbm")))
+ (when (gnus-image-type-available-p 'xpm)
+ (push "xpm" types))
+ types)
+ "*List of suffixes on picon file names to try."
+ :version "22.1"
+ :type '(repeat string)
+ :group 'smiley)
+
+(defvar smiley-cached-regexp-alist nil)
+
+(defun smiley-update-cache ()
+ (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)))))))
+
+(defvar smiley-mouse-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [down-mouse-2] 'ignore) ; override widget
+ (define-key map [mouse-2]
+ 'smiley-mouse-toggle-buffer)
+ map))