;;; smiley-ems.el --- displaying smiley faces
-;; Copyright (C) 2000 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: news mail multimedia
(eval-when-compile (require 'cl))
(require 'nnheader)
+(require 'gnus-art)
(defgroup smiley nil
"Turn :-)'s into real images."
;; The XEmacs version has a baroque, if not rococo, set of these.
(defcustom smiley-regexp-alist
- ;; Perhaps :-) should be distinct -- it does appear in the Jargon File.
- '(("\\([:;]-?)\\)\\W" 1 "smile.pbm")
- ("\\(:-[/\\]\\)\\W" 1 "wry.pbm")
- ("\\(:-[({]\\)\\W" 1 "frown.pbm"))
+ '(("\\(:-?)\\)\\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
-rgexp to replace with IMAGE. IMAGE is the name of a PBM file 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")
: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."
+ :type '(repeat string)
+ :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)
+ (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 (find-image (list (list :type (intern type)
+ :file file
+ :ascent 'center)))))
+ (when image
+ (push (list (car elt) (cadr elt) image)
+ smiley-cached-regexp-alist)))))))
(defvar smiley-mouse-map
(let ((map (make-sparse-keymap)))
;;;###autoload
(defun smiley-region (start end)
- "Replace in the region `smiley-regexp-alist' matches with corresponding images."
+ "Replace in the region `smiley-regexp-alist' matches with corresponding images.
+A list of images is returned."
(interactive "r")
(when (and (fboundp 'display-graphic-p)
(display-graphic-p))
(smiley-update-cache))
(save-excursion
(let ((beg (or start (point-min)))
- group overlay image)
+ group overlay image images)
(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))))))
- (setq smiley-active t)))
+ (push image images)
+ (gnus-add-wash-type 'smiley)
+ (gnus-add-image 'smiley image)
+ (add-text-properties
+ (match-beginning group) (match-end group)
+ `(display ,image
+ mouse-face highlight
+ smiley t
+ help-echo "mouse-2: toggle smilies in buffer"
+ keymap smiley-mouse-map)))))
+ images))))
(defun smiley-toggle-buffer (&optional arg)
- "Toggle displaying smiley faces.
+ "Toggle displaying smiley faces in article buffer.
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))))
+ (gnus-with-article-buffer
+ (if (if (numberp arg)
+ (> arg 0)
+ (not (memq 'smiley gnus-article-wash-types)))
+ (smiley-region (point-min) (point-max))
+ (gnus-delete-images 'smiley))))
(defun smiley-mouse-toggle-buffer (event)
"Toggle displaying smiley faces.
(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)
;;; smiley-ems.el ends here
projects / elisp / gnus.git- / blobdiff