* gnus-agent.el (gnus-agent-regenerate-group): New function.
[gnus] / lisp / smiley-ems.el
index e4c23e8..a5c1a5c 100644 (file)
@@ -1,6 +1,6 @@
 ;;; 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
 
 ;; 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.
@@ -139,21 +163,6 @@ With arg, turn displaying on if and only if arg is positive."
       (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