X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fsmiley.el;h=610b130d8b34ebe3207ace20d63f0e2f3ef5fa2d;hp=a66d73183c7c59214978e2ae670aa50fea23749d;hb=751b08bcb2f4bcbe7a0bb7a7fc6034fba8d49cb9;hpb=d96d162f16b011eecdf968fbbb06024cdbc23772 diff --git a/lisp/smiley.el b/lisp/smiley.el index a66d73183..610b130d8 100644 --- a/lisp/smiley.el +++ b/lisp/smiley.el @@ -1,5 +1,5 @@ ;;; 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 ;; Keywords: fun @@ -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 . @@ -45,7 +45,7 @@ :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) @@ -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") + ("[^.0-9]\\([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") @@ -68,7 +76,7 @@ ("\\(;-*[>)}»]+\\)\\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"))) @@ -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") @@ -92,14 +102,14 @@ ("\\(:-+[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 - "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. @@ -113,34 +123,33 @@ If this is a symbol, take its value." :group 'smiley) (defcustom smiley-flesh-color "yellow" - "Flesh color." + "*Flesh color." :type 'string :group 'smiley) (defcustom smiley-features-color "black" - "Features color." + "*Features color." :type 'string :group 'smiley) (defcustom smiley-tongue-color "red" - "Tongue color." + "*Tongue color." :type 'string :group 'smiley) (defcustom smiley-circle-color "black" - "Circle color." + "*Circle color." :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." :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 @@ -163,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) @@ -175,7 +194,7 @@ above them." (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)) @@ -191,10 +210,27 @@ 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) - (when (featurep 'x) + (when (featurep '(or x mswindows)) (save-excursion (when buffer (set-buffer buffer)) @@ -202,7 +238,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 +275,20 @@ 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))))))))) @@ -242,24 +298,21 @@ above them." (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)) - (= (char-after (1- (point))) ?\())) + (eq (char-after (1- (point))) ?\())) t))) (defvar gnus-article-buffer) ;;;###autoload (defun gnus-smiley-display () - "Display \"smileys\" as small graphical icons." + "Display \"smileys\" as small graphical icons." (interactive) (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)))) + (article-goto-body) + (smiley-buffer (current-buffer) (point-min) (point-max)))) (provide 'smiley)