Apply Dave Love's patches.

[gnus] / lisp / smiley.el

diff --git a/lisp/smiley.el b/lisp/smiley.el
index fd42472..901bf1b 100644 (file)
--- a/lisp/smiley.el
+++ b/lisp/smiley.el
@@ -31,7 +31,7 @@
 
 ;; To use:
 ;; (require 'smiley)
-;; (add-hook 'gnus-article-display-hook 'gnus-smiley-display t)
+;; (setq gnus-treat-display-smileys t)
 
 ;; The smilies were drawn by Joe Reiss <jreiss@vt.edu>.
 
@@ -63,9 +63,9 @@
     ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm")
     ("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm")
     ("\\(:-*[)>}»]+\\)\\W" 1 "FaceHappy.xpm")
-    ("\\(=[)>»]+\\)\\W" 1 "FaceHappy.xpm")
+    ("\\(=[)»]+\\)\\W" 1 "FaceHappy.xpm")
     ("\\(:-*[/\\\"]\\)[^/]\\W" 1 "FaceIronic.xpm")
-    ("\\([8|]-*[|Oo%]\\)\\W" 1 "FaceKOed.xpm")
+    ("[^.0-9]\\([8|]-*[|Oo%]\\)\\W" 1 "FaceKOed.xpm")
     ("\\([:|]-*#+\\)\\W" 1 "FaceNyah.xpm")
     ("\\(:-*[({]+\\)\\W" 1 "FaceSad.xpm")
     ("\\(=[({]+\\)\\W" 1 "FaceSad.xpm")
@@ -88,7 +88,7 @@
     ("\\(:-+D\\)\\W" 1 "FaceGrinning.xpm")
     ("\\(:-+[}»]+\\)\\W" 1 "FaceHappy.xpm")
     ("\\(:-*)+\\)\\W" 1 "FaceHappy.xpm")
-    ("\\(=[)>]+\\)\\W" 1 "FaceHappy.xpm")
+    ("\\(=[)]+\\)\\W" 1 "FaceHappy.xpm")
     ("\\(:-+[/\\\"]+\\)\\W" 1 "FaceIronic.xpm")
     ("\\([8|]-+[|Oo%]\\)\\W" 1 "FaceKOed.xpm")
     ("\\([:|]-+#+\\)\\W" 1 "FaceNyah.xpm")
@@ -154,7 +154,7 @@ above them."
 (defvar smiley-running-xemacs (string-match "XEmacs" emacs-version))
 
 (defvar smiley-map (make-sparse-keymap "smiley-keys")
- "Keymap to toggle smiley states.")
+  "Keymap to toggle smiley states.")
 
 (define-key smiley-map [(button2)] 'smiley-toggle-extent)
 (define-key smiley-map [(button3)] 'smiley-popup-menu)
@@ -162,7 +162,7 @@ above them."
 (defun smiley-popup-menu (e)
   (interactive "e")
   (popup-menu
-   `("Smilies" 
+   `("Smilies"
      ["Toggle This Smiley" (smiley-toggle-extent ,e) t]
      ["Toggle All Smilies" (smiley-toggle-extents ,e) t])))
 
@@ -180,6 +180,8 @@ above them."
           (glyph (make-glyph
                   (list
                    (cons 'x (expand-file-name pixmap smiley-data-directory))
+                   (cons 'mswindows
+                         (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)
@@ -211,24 +213,23 @@ above them."
 (defun smiley-toggle-extents (e)
   (interactive "e")
   (map-extents
-   '(lambda (e void)
-      (let (ant)
-       (if (annotationp (setq ant (extent-property e 'smiley-annotation)))
-           (progn
-             (if (eq (extent-property e 'invisible) nil)
-                 (progn
-                   (reveal-annotation ant)
-                   (set-extent-property e 'invisible t)
-                   )
-               (hide-annotation ant)
-               (set-extent-property e 'invisible nil))))
-       nil))
+   (lambda (e void)
+     (let (ant)
+       (if (annotationp (setq ant (extent-property e 'smiley-annotation)))
+          (if (eq (extent-property e 'invisible) nil)
+              (progn
+                (reveal-annotation ant)
+                (set-extent-property e 'invisible t)
+                )
+            (hide-annotation ant)
+            (set-extent-property e 'invisible nil)))
+       nil))
    (event-buffer e)))
 
 ;;;###autoload
 (defun smiley-buffer (&optional buffer st nd)
   (interactive)
-  (when (featurep 'x)
+  (when (featurep '(or x mswindows))
     (save-excursion
       (when buffer
        (set-buffer buffer))
@@ -239,10 +240,10 @@ above them."
            (case-fold-search nil)
            entry regexp beg group file)
        (map-extents
-        '(lambda (e void)
-           (when (or (extent-property e 'smiley-extent)
-                     (extent-property e 'smiley-annotation))
-             (delete-extent e)))
+        (lambda (e void)
+          (when (or (extent-property e 'smiley-extent)
+                    (extent-property e 'smiley-annotation))
+            (delete-extent e)))
         buffer st nd)
        (goto-char (or st (point-min)))
        (setq beg (point))
@@ -275,10 +276,12 @@ above them."
                  (set-extent-property ant 'smiley-extent ext)
                  (set-extent-property ext 'smiley-annotation ant)
                  ;; Help
-                 (set-extent-property ext 'help-echo
-                                      "button2 toggles smiley, button3 pops up menu")
-                 (set-extent-property ant 'help-echo
-                                      "button2 toggles smiley, button3 pops up menu")
+                 (set-extent-property
+                  ext 'help-echo
+                  "button2 toggles smiley, button3 pops up menu")
+                 (set-extent-property
+                  ant 'help-echo
+                  "button2 toggles smiley, button3 pops up menu")
                  (set-extent-property ext 'balloon-help
                                       "Mouse button2 - toggle smiley
 Mouse button3 - menu")
@@ -300,18 +303,46 @@ Mouse button3 - menu"))
                   (eq (char-after (1- (point))) ?\()))
       t)))
 
+(defun smiley-toggle-buffer (&optional arg buffer st nd)
+  "Toggle displaying smiley faces.
+With arg, turn displaying on if and only if arg is positive."
+  (interactive "P")
+  (let (on off)
+    (map-extents
+     (lambda (e void)
+       (let (ant)
+        (if (annotationp (setq ant (extent-property e 'smiley-annotation)))
+            (if (eq (extent-property e 'invisible) nil)
+                (setq off (cons (cons ant e) off))
+              (setq on (cons (cons ant e) on)))))
+       nil)
+     buffer st nd)
+    (if (and (not (and (numberp arg) (< arg 0)))
+            (or (and (numberp arg) (> arg 0))
+                (null on)))
+       (if off
+           (while off
+             (reveal-annotation (caar off))
+             (set-extent-property (cdar off) 'invisible t)
+             (setq off (cdr off)))
+         (smiley-buffer))
+      (while on
+       (hide-annotation (caar on))
+       (set-extent-property (cdar on) 'invisible nil)
+       (setq on (cdr on))))))
+
 (defvar gnus-article-buffer)
 ;;;###autoload
-(defun gnus-smiley-display ()
-  "Display \"smileys\" as small graphical icons."
-  (interactive)
+(defun gnus-smiley-display (&optional arg)
+  "Display \"smileys\" 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)
-    (goto-char (point-min))
-    ;; We skip the headers.
-    (unless (search-forward "\n\n" nil t)
-      (goto-char (point-max)))
-    (smiley-buffer (current-buffer) (point))))
+    (save-restriction
+      (widen)
+      (article-goto-body)
+      (smiley-toggle-buffer arg (current-buffer) (point) (point-max)))))
 
 (provide 'smiley)