*** empty log message ***

[gnus] / lisp / smiley.el

diff --git a/lisp/smiley.el b/lisp/smiley.el
index 37a69b5..ac9566c 100644 (file)
--- a/lisp/smiley.el
+++ b/lisp/smiley.el
@@ -53,14 +53,22 @@
 ;; two alists below.
 
 (defcustom smiley-deformed-regexp-alist
-  '(("\\(:-*[<«]+\\)\\W" 1 "FaceAngry.xpm")
+  '(("\\(\\^_?\\^;;;\\)\\W" 1 "WideFaceAse3.xbm")
+    ("\\(\\^_?\\^;;\\)\\W" 1 "WideFaceAse2.xbm")
+    ("\\(\\^_?\\^;\\)\\W" 1 "WideFaceAse1.xbm")
+    ("\\(\\^_?\\^\\)\\W" 1 "WideFaceSmile.xbm")
+    ("\\(;_;\\)\\W" 1 "WideFaceWeep.xbm")
+    ("\\(T_T\\)\\W" 1 "WideFaceWeep.xbm")
+    ("\\(:-*[<«]+\\)\\W" 1 "FaceAngry.xpm")
     ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm")
     ("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm")
     ("\\(:-*[)>}»]+\\)\\W" 1 "FaceHappy.xpm")
+    ("\\(=[)>»]+\\)\\W" 1 "FaceHappy.xpm")
     ("\\(:-*[/\\\"]\\)[^/]\\W" 1 "FaceIronic.xpm")
     ("\\([8|]-*[|Oo%]\\)\\W" 1 "FaceKOed.xpm")
     ("\\([:|]-*#+\\)\\W" 1 "FaceNyah.xpm")
     ("\\(:-*[({]+\\)\\W" 1 "FaceSad.xpm")
+    ("\\(=[({]+\\)\\W" 1 "FaceSad.xpm")
     ("\\(:-*[Oo\*]\\)\\W" 1 "FaceStartled.xpm")
     ("\\(:-*|\\)\\W" 1 "FaceStraight.xpm")
     ("\\(:-*p\\)\\W" 1 "FaceTalking.xpm")
@@ -80,10 +88,12 @@
     ("\\(:-+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")
     ("\\([:|]-+#+\\)\\W" 1 "FaceNyah.xpm")
     ("\\(:-+[({]+\\)\\W" 1 "FaceSad.xpm")
+    ("\\(=[({]+\\)\\W" 1 "FaceSad.xpm")
     ("\\(:-+[Oo\*]\\)\\W" 1 "FaceStartled.xpm")
     ("\\(:-+|\\)\\W" 1 "FaceStraight.xpm")
     ("\\(:-+p\\)\\W" 1 "FaceTalking.xpm")
@@ -140,7 +150,6 @@ above them."
   :type 'face
   :group 'smiley)
 
-
 (defvar smiley-glyph-cache nil)
 (defvar smiley-running-xemacs (string-match "XEmacs" emacs-version))
 
@@ -148,6 +157,14 @@ above them."
  "Keymap to toggle smiley states.")
 
 (define-key smiley-map [(button2)] 'smiley-toggle-extent)
+(define-key smiley-map [(button3)] 'smiley-popup-menu)
+
+(defun smiley-popup-menu (e)
+  (interactive "e")
+  (popup-menu
+   `("Smilies" 
+     ["Toggle This Smiley" (smiley-toggle-extent ,e) t]
+     ["Toggle All Smilies" (smiley-toggle-extents ,e) t])))
 
 (defun smiley-create-glyph (smiley pixmap)
   (and
@@ -191,6 +208,23 @@ above them."
            (reveal-annotation ant)
            (set-extent-property ext 'invisible t)))))))
 
+(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))
+   (event-buffer e)))
+
 ;;;###autoload
 (defun smiley-buffer (&optional buffer st nd)
   (interactive)
@@ -202,7 +236,14 @@ above them."
            (alist (if (symbolp smiley-regexp-alist)
                       (symbol-value smiley-regexp-alist)
                     smiley-regexp-alist))
+           (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)))
+        buffer st nd)
        (goto-char (or st (point-min)))
        (setq beg (point))
        ;; loop through alist
@@ -232,7 +273,18 @@ above them."
                  (set-extent-property ant 'keymap smiley-map)
                  ;; remember each other
                  (set-extent-property ant 'smiley-extent ext)
-                 (set-extent-property ext 'smiley-annotation ant))
+                 (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 'balloon-help
+                                      "Mouse button2 - toggle smiley
+Mouse button3 - menu")
+                 (set-extent-property ant 'balloon-help
+                                      "Mouse button2 - toggle smiley
+Mouse button3 - menu"))
                (when (smiley-end-paren-p start end)
                  (make-annotation ")" end 'text))
                (goto-char end)))))))))
@@ -251,6 +303,7 @@ above them."
 (defvar gnus-article-buffer)
 ;;;###autoload
 (defun gnus-smiley-display ()
+  "Display \"smileys\" as small graphical icons." 
   (interactive)
   (save-excursion
     (set-buffer gnus-article-buffer)