Importing Oort Gnus v0.04.

[elisp/gnus.git-] / lisp / smiley-ems.el

diff --git a/lisp/smiley-ems.el b/lisp/smiley-ems.el
index 8e0cae3..f8a91d9 100644 (file)
--- a/lisp/smiley-ems.el
+++ b/lisp/smiley-ems.el
@@ -1,6 +1,6 @@
 ;;; smiley-ems.el --- displaying smiley faces
 
-;; Copyright (C) 2000 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
 
 ;; Author: Dave Love <fx@gnu.org>
 ;; Keywords: news mail multimedia
@@ -50,13 +50,17 @@
 
 ;; 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")
@@ -67,17 +71,36 @@ rgexp to replace with IMAGE.  IMAGE is the name of a PBM file in
   :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)))))
+  (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-active nil
   "Non-nil means smilies in the buffer will be displayed.")
@@ -92,7 +115,8 @@ rgexp to replace with IMAGE.  IMAGE is the name of a PBM file in
 
 ;;;###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))
@@ -102,25 +126,25 @@ rgexp to replace with IMAGE.  IMAGE is the name of a PBM file in
            (overlays-in start end))
     (unless smiley-cached-regexp-alist
       (smiley-update-cache))
+    (setq smiley-active t)
     (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)
+             (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.
@@ -145,11 +169,18 @@ With arg, turn displaying on if and only if arg is positive."
   "Display textual emoticaons (\"smilies\") as small graphical icons.
 With arg, turn displaying on if and only if arg is positive."
   (interactive "P")
-  (save-excursion
-    (article-goto-body)
-    (smiley-region (point) (point-max))
-    (if (and (numberp arg) (<= arg 0))
-       (smiley-toggle-buffer arg))))
+  (gnus-with-article-buffer
+    (if (memq 'smiley gnus-article-wash-types)
+       (gnus-delete-images 'smiley)
+      (article-goto-body)
+      (let ((images (smiley-region (point) (point-max))))
+       (when images
+         (gnus-add-wash-type 'smiley)
+         (dolist (image images)
+           (gnus-add-image 'smiley image))))
+      (when (and (numberp arg)
+                (<= arg 0))
+       (smiley-toggle-buffer arg)))))
 
 (provide 'smiley)