X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=inline;f=lisp%2Fsmiley.el;h=76b2884bd4f3b3b0c437f5f40cb23ca16f4d761c;hb=ccb2adc5044139063bb44f19adbc4e736a12d0b0;hp=34b416e3aab838b4f6c965f928532ea0d0ff64c3;hpb=101687523841c630e95201824689b2aab0d8157e;p=elisp%2Fgnus.git-

diff --git a/lisp/smiley.el b/lisp/smiley.el
index 34b416e..76b2884 100644
--- a/lisp/smiley.el
+++ b/lisp/smiley.el
@@ -35,9 +35,9 @@
 
 ;; The smilies were drawn by Joe Reiss <jreiss@vt.edu>.
 
+(eval-when-compile (require 'cl))
 (require 'annotations)
 (require 'messagexmas)
-(require 'cl)
 (require 'custom)
 
 (defgroup smiley nil
@@ -65,7 +65,7 @@
     ("\\(:-*[)>}(I;(B]+\\)\\W" 1 "FaceHappy.xpm")
     ("\\(=[)>(I;(B]+\\)\\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")
@@ -213,18 +213,17 @@ 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
@@ -241,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))
@@ -259,8 +258,8 @@ above them."
 		   (end (match-end group))
 		   (glyph
 		    (and (or (eq start 1)
-			     (not (string-match "\\(\\^\\|;\\|_\\);)" 
-						(buffer-substring 
+			     (not (string-match "\\(\\^\\|;\\|_\\);)"
+						(buffer-substring
 						 (1- start) (+ start 2)))))
 			 (smiley-create-glyph (buffer-substring start end)
 					      file))))
@@ -309,15 +308,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)
-    (article-goto-body)
-    (smiley-buffer (current-buffer) (point-min) (point-max))))
+    (save-restriction
+      (widen)
+      (article-goto-body)
+      (smiley-toggle-buffer arg (current-buffer) (point) (point-max)))))
 
 (provide 'smiley)