-
-(defvar smiley-data-directory (message-xmas-find-glyph-directory "smilies")
- "Location of the smiley faces files.")
-
-(defvar smiley-regexp-alist
- '(("\\s-\\(:-*\\]\\)" 1 "FaceGrinning.xpm")
- ("\\s-\\(:-*[oO]\\)" 1 "FaceStartled.xpm")
- ("\\s-\\(:-*[)>]\\)" 1 "FaceHappy.xpm")
- ("\\s-\\(;-*[>)]\\)" 1 "FaceWinking.xpm")
- ("\\s-\\(:-[/\\]\\)" 1 "FaceIronic.xpm")
- ("\\s-\\(:-*|\\)" 1 "FaceStraight.xpm")
- ("\\s-\\(:-*<\\)" 1 "FaceAngry.xpm")
- ("\\s-\\(:-*d\\)" 1 "FaceTasty.xpm")
- ("\\s-\\(:-*[pP]\\)" 1 "FaceYukky.xpm")
- ("\\s-\\(8-*|\\)" 1 "FaceKOed.xpm")
- ("\\s-\\(:-*(\\)" 1 "FaceAngry.xpm"))
- "A list of regexps to map smilies to real images.")
-
-(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"
- "Tongue color.")
-
-(defvar smiley-glyph-cache nil)
-(defvar smiley-running-xemacs (string-match "XEmacs" emacs-version))
-
-(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))))
-
-;;;###interactive
-(defun smiley-region (beg end)
- "Smilify the region between point and mark."
+(require 'nnheader)
+(require 'gnus-art)
+
+(defgroup smiley nil
+ "Turn :-)'s into real images."
+ :group 'gnus-visual)
+
+(defvar smiley-data-directory)
+
+(defcustom smiley-style
+ (if (or (and (fboundp 'face-attribute)
+ (>= (face-attribute 'default :height) 160))
+ (and (fboundp 'face-height)
+ (>= (face-height 'default) 14)))
+ '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
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (setq smiley-data-directory (smiley-directory))
+ (smiley-update-cache))
+ :initialize 'custom-initialize-default
+ :version "23.1" ;; No Gnus
+ :group 'smiley)
+
+;; For compatibility, honor the variable `smiley-data-directory' if the user
+;; has set it.
+
+(defun smiley-directory (&optional style)
+ "Return a the location of the smiley faces files.
+STYLE specifies which style to use, see `smiley-style'. If STYLE
+is nil, use `smiley-style'."
+ (unless style (setq style smiley-style))
+ (nnheader-find-etc-directory
+ (concat "images/smilies"
+ (cond ((eq smiley-style 'low-color) "")
+ ((eq smiley-style 'medium) "/medium")
+ ((eq smiley-style 'grayscale) "/grayscale")))))
+
+(defcustom smiley-data-directory (smiley-directory)
+ "*Location of the smiley faces files."
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (smiley-update-cache))
+ :initialize 'custom-initialize-default
+ :type 'directory
+ :group 'smiley)
+
+;; The XEmacs version has a baroque, if not rococo, set of these.
+(defcustom smiley-regexp-alist
+ '(("\\(;-)\\)\\W" 1 "blink")
+ ("[^;]\\(;)\\)\\W" 1 "blink")
+ ("\\(:-]\\)\\W" 1 "forced")
+ ("\\(8-)\\)\\W" 1 "braindamaged")
+ ("\\(:-|\\)\\W" 1 "indifferent")
+ ("\\(:-[/\\]\\)\\W" 1 "wry")
+ ("\\(:-(\\)\\W" 1 "sad")
+ ("\\(X-)\\)\\W" 1 "dead")
+ ("\\(:-{\\)\\W" 1 "frown")
+ ("\\(>:-)\\)\\W" 1 "evil")
+ ("\\(;-(\\)\\W" 1 "cry")
+ ("\\(:-D\\)\\W" 1 "grin")
+ ;; "smile" must be come after "evil"
+ ("\\(\\^?:-?)\\)\\W" 1 "smile"))
+ "*A list of regexps to map smilies to images.
+The elements are (REGEXP MATCH IMAGE), where MATCH is the submatch in
+regexp to replace with IMAGE. IMAGE is the name of an image file in
+`smiley-data-directory'."
+ :version "24.1"
+ :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 smiley file names to try."
+ :version "22.1"
+ :type '(repeat string)
+ :group 'smiley)
+
+(defvar smiley-cached-regexp-alist nil)
+
+(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)))))))
+
+;; Not implemented:
+;; (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))
+
+;;;###autoload
+(defun smiley-region (start end)
+ "Replace in the region `smiley-regexp-alist' matches with corresponding images.
+A list of images is returned."