(require 'nnheader)
(defgroup smiley nil
"Turn :-)'s into real images."
:group 'gnus-visual)
(defcustom smiley-data-directory (nnheader-find-etc-directory "smilies")
"*If non-nil, a directory to search for the smiley image files.
This is in addition to the normal image search path."
:type '(choice directory
(const nil))
:group 'smiley)
(defcustom smiley-regexp-alist
'(("\\([:;]-?)\\)\\(\\W\\|\\'\\)" 1 "smile.pbm")
("\\(:-[/\\]\\)\\(\\W\\|\\'\\)" 1 "wry.pbm")
("\\(:-[({]\\)\\(\\W\\|\\'\\)" 1 "frown.pbm"))
"*A list of regexps to map smilies to images.
The elements are (REGEXP MATCH FILE), where MATCH is the submatch in
rgexp to replace with IMAGE. IMAGE is the name of a PBM file in
`smiley-data-directory' or the normal image search path."
: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)
(defvar smiley-cached-regexp-alist nil)
(defun smiley-update-cache ()
(dolist (elt smiley-regexp-alist)
(let* ((data-directory smiley-data-directory)
(image (find-image (list (list :type 'pbm
:file (nth 2 elt)
:ascent 'center)))))
(if image
(push (list (car elt) (cadr elt) image)
smiley-cached-regexp-alist)))))
(defvar smiley-active nil
"Non-nil means smilies in the buffer will be displayed.")
(make-variable-buffer-local 'smiley-active)
(defvar smiley-mouse-map
(let ((map (make-sparse-keymap)))
(define-key map [down-mouse-2] 'ignore) (define-key map [mouse-2]
'smiley-mouse-toggle-buffer)
map))
(defun smiley-region (start end)
"Display textual smileys as images.
START and END specify the region; interactively, use the values
of point and mark. The value of `smiley-regexp-alist' determines
which smileys to operate on and which images to use for them."
(interactive "r")
(when (and (fboundp 'display-graphic-p)
(display-graphic-p))
(mapc (lambda (o)
(if (eq 'smiley (overlay-get o 'smiley))
(delete-overlay o)))
(overlays-in start end))
(unless smiley-cached-regexp-alist
(smiley-update-cache))
(save-excursion
(let ((beg (or start (point-min)))
(inhibit-point-motion-hooks t)
group overlay image)
(dolist (entry smiley-cached-regexp-alist)
(setq group (nth 1 entry)
image (nth 2 entry))
(goto-char beg)
(while (re-search-forward (car entry) end t)
(when image
(setq overlay (make-overlay (match-beginning group)
(match-end group)))
(overlay-put overlay
'display `(when smiley-active ,@image))
(overlay-put overlay 'mouse-face 'highlight)
(overlay-put overlay 'smiley t)
(overlay-put overlay
'help-echo "mouse-2: toggle smilies in buffer")
(overlay-put overlay 'keymap smiley-mouse-map)
(goto-char (match-end group)))))))
(setq smiley-active t)))
(defun smiley-toggle-buffer (&optional arg)
"Toggle displaying smiley faces.
With arg, turn displaying on if and only if arg is positive."
(interactive "P")
(if (numberp arg)
(setq smiley-active (> arg 0))
(setq smiley-active (not smiley-active))))
(defun smiley-mouse-toggle-buffer (event)
"Toggle displaying smiley faces.
With arg, turn displaying on if and only if arg is positive."
(interactive "e")
(save-excursion
(save-window-excursion
(mouse-set-point event)
(smiley-toggle-buffer))))
(eval-when-compile (defvar gnus-article-buffer))
(defun gnus-smiley-display (&optional arg)
"Display textual emoticaons (\"smilies\") as small graphical icons.
With arg, turn displaying on if and only if arg is positive."
(interactive "P")
(save-excursion
(set-buffer gnus-article-buffer)
(save-restriction
(widen)
(article-goto-body)
(smiley-region (point-min) (point-max))
(if (and (numberp arg) (<= arg 0))
(smiley-toggle-buffer arg)))))
(provide 'smiley)