Importing Gnus v5.8.3.

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

diff --git a/lisp/smiley.el b/lisp/smiley.el
index ac9566c..9caaa22 100644 (file)
--- a/lisp/smiley.el
+++ b/lisp/smiley.el
@@ -1,5 +1,5 @@
 ;;; smiley.el --- displaying smiley faces
 ;;; smiley.el --- displaying smiley faces

-;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.

 
 ;; Author: Wes Hardaker <hardaker@ece.ucdavis.edu>
 ;; Keywords: fun
 
 ;; Author: Wes Hardaker <hardaker@ece.ucdavis.edu>
 ;; Keywords: fun

@@ -31,7 +31,7 @@
 
 ;; To use:
 ;; (require 'smiley)
 
 ;; 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>.
 
 
 ;; The smilies were drawn by Joe Reiss <jreiss@vt.edu>.
 

@@ -45,7 +45,7 @@
   :group 'gnus-visual)
 
 (defcustom smiley-data-directory (message-xmas-find-glyph-directory "smilies")
   :group 'gnus-visual)
 
 (defcustom smiley-data-directory (message-xmas-find-glyph-directory "smilies")

-  "Location of the smiley faces files."
+  "*Location of the smiley faces files."

   :type 'directory
   :group 'smiley)
 
   :type 'directory
   :group 'smiley)
 

@@ -63,9 +63,9 @@
     ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm")
     ("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm")
     ("\\(:-*[)>}»]+\\)\\W" 1 "FaceHappy.xpm")
     ("\\(:-+\\]+\\)\\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")
     ("\\(:-*[/\\\"]\\)[^/]\\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")
     ("\\([:|]-*#+\\)\\W" 1 "FaceNyah.xpm")
     ("\\(:-*[({]+\\)\\W" 1 "FaceSad.xpm")
     ("\\(=[({]+\\)\\W" 1 "FaceSad.xpm")

@@ -76,7 +76,7 @@
     ("\\(;-*[>)}»]+\\)\\W" 1 "FaceWinking.xpm")
     ("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm")
     ("\\([:|]-*P\\)\\W" 1 "FaceYukky.xpm"))
     ("\\(;-*[>)}»]+\\)\\W" 1 "FaceWinking.xpm")
     ("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm")
     ("\\([:|]-*P\\)\\W" 1 "FaceYukky.xpm"))

-  "Normal and deformed faces for smilies."
+  "*Normal and deformed faces for smilies."

   :type '(repeat (list regexp
                       (integer :tag "Match")
                       (string :tag "Image")))
   :type '(repeat (list regexp
                       (integer :tag "Match")
                       (string :tag "Image")))

@@ -88,7 +88,7 @@
     ("\\(:-+D\\)\\W" 1 "FaceGrinning.xpm")
     ("\\(:-+[}»]+\\)\\W" 1 "FaceHappy.xpm")
     ("\\(:-*)+\\)\\W" 1 "FaceHappy.xpm")
     ("\\(:-+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")
     ("\\(:-+[/\\\"]+\\)\\W" 1 "FaceIronic.xpm")
     ("\\([8|]-+[|Oo%]\\)\\W" 1 "FaceKOed.xpm")
     ("\\([:|]-+#+\\)\\W" 1 "FaceNyah.xpm")

@@ -102,14 +102,14 @@
     ("\\(:-+[Vvµ]\\)\\W" 1 "FaceWry.xpm")
     ("\\(][:8B]-[)>]\\)\\W" 1 "FaceDevilish.xpm")
     ("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm"))
     ("\\(:-+[Vvµ]\\)\\W" 1 "FaceWry.xpm")
     ("\\(][:8B]-[)>]\\)\\W" 1 "FaceDevilish.xpm")
     ("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm"))

-  "Smileys with noses.  These get less false matches."
+  "*Smileys with noses.  These get less false matches."

   :type '(repeat (list regexp
                       (integer :tag "Match")
                       (string :tag "Image")))
   :group 'smiley)
 
 (defcustom smiley-regexp-alist smiley-deformed-regexp-alist
   :type '(repeat (list regexp
                       (integer :tag "Match")
                       (string :tag "Image")))
   :group 'smiley)
 
 (defcustom smiley-regexp-alist smiley-deformed-regexp-alist

-  "A list of regexps to map smilies to real images.
+  "*A list of regexps to map smilies to real images.

 Defaults to the contents of `smiley-deformed-regexp-alist'.
 An alternative is `smiley-nosey-regexp-alist' that matches less
 aggressively.
 Defaults to the contents of `smiley-deformed-regexp-alist'.
 An alternative is `smiley-nosey-regexp-alist' that matches less
 aggressively.

@@ -123,27 +123,27 @@ If this is a symbol, take its value."
   :group 'smiley)
 
 (defcustom smiley-flesh-color "yellow"
   :group 'smiley)
 
 (defcustom smiley-flesh-color "yellow"

-  "Flesh color."
+  "*Flesh color."

   :type 'string
   :group 'smiley)
 
 (defcustom smiley-features-color "black"
   :type 'string
   :group 'smiley)
 
 (defcustom smiley-features-color "black"

-  "Features color."
+  "*Features color."

   :type 'string
   :group 'smiley)
 
 (defcustom smiley-tongue-color "red"
   :type 'string
   :group 'smiley)
 
 (defcustom smiley-tongue-color "red"

-  "Tongue color."
+  "*Tongue color."

   :type 'string
   :group 'smiley)
 
 (defcustom smiley-circle-color "black"
   :type 'string
   :group 'smiley)
 
 (defcustom smiley-circle-color "black"

-  "Circle color."
+  "*Circle color."

   :type 'string
   :group 'smiley)
 
 (defcustom smiley-mouse-face 'highlight
   :type 'string
   :group 'smiley)
 
 (defcustom smiley-mouse-face 'highlight

-  "Face used for mouse highlighting in the smiley buffer.
+  "*Face used for mouse highlighting in the smiley buffer.

 
 Smiley buttons will be displayed in this face when the cursor is
 above them."
 
 Smiley buttons will be displayed in this face when the cursor is
 above them."

@@ -154,7 +154,7 @@ above them."
 (defvar smiley-running-xemacs (string-match "XEmacs" emacs-version))
 
 (defvar smiley-map (make-sparse-keymap "smiley-keys")
 (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)
 
 (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
 (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])))
 
      ["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))
           (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)
                    (cons 'tty smiley)))))
       (setq smiley-glyph-cache (cons (cons pixmap glyph) smiley-glyph-cache))
       (set-glyph-face glyph 'default)

@@ -192,7 +194,7 @@ above them."
   (smiley-buffer (current-buffer) beg end))
 
 (defun smiley-toggle-extent (event)
   (smiley-buffer (current-buffer) beg end))
 
 (defun smiley-toggle-extent (event)

-  "Toggle smiley at given point"
+  "Toggle smiley at given point."

   (interactive "e")
   (let* ((ant (event-glyph-extent event))
         (pt (event-closest-point event))
   (interactive "e")
   (let* ((ant (event-glyph-extent event))
         (pt (event-closest-point event))

@@ -211,24 +213,23 @@ above them."
 (defun smiley-toggle-extents (e)
   (interactive "e")
   (map-extents
 (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)
    (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))
     (save-excursion
       (when buffer
        (set-buffer buffer))

@@ -239,10 +240,10 @@ above them."
            (case-fold-search nil)
            entry regexp beg group file)
        (map-extents
            (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))
         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 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")
                  (set-extent-property ext 'balloon-help
                                       "Mouse button2 - toggle smiley
 Mouse button3 - menu")

@@ -294,25 +297,57 @@ Mouse button3 - menu"))
   (save-excursion
     (goto-char start)
     (when (and (re-search-backward "[()]" nil t)
   (save-excursion
     (goto-char start)
     (when (and (re-search-backward "[()]" nil t)

-              (= (following-char) ?\()
+              (eq (char-after) ?\()

               (goto-char end)
               (or (not (re-search-forward "[()]" nil t))
               (goto-char end)
               (or (not (re-search-forward "[()]" nil t))

-                  (= (char-after (1- (point))) ?\()))
+                  (eq (char-after (1- (point))) ?\()))

       t)))
 
       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
 (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)
   (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)
 
 
 (provide 'smiley)
 

+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+

 ;;; smiley.el ends here
 ;;; smiley.el ends here