X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fsmiley.el;h=f7cdda1c14c15ed43cc1fb249a414724a9fea4a8;hb=cd13ede00e34997d48de2589ea45c0d6a62cf7c4;hp=fd424722a4af59114fcfb389232712f19d38d11d;hpb=82300762c3419b73fc2e994b14e3d520fe88b0a9;p=elisp%2Fgnus.git- diff --git a/lisp/smiley.el b/lisp/smiley.el index fd42472..f7cdda1 100644 --- a/lisp/smiley.el +++ b/lisp/smiley.el @@ -31,13 +31,14 @@ ;; 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 . +(eval-when-compile (require 'cl)) + (require 'annotations) (require 'messagexmas) -(require 'cl) (require 'custom) (defgroup smiley nil @@ -59,13 +60,13 @@ ("\\(\\^_?\\^\\)\\W" 1 "WideFaceSmile.xbm") ("\\(;_;\\)\\W" 1 "WideFaceWeep.xbm") ("\\(T_T\\)\\W" 1 "WideFaceWeep.xbm") - ("\\(:-*[<«]+\\)\\W" 1 "FaceAngry.xpm") + ("\\(:-*[<(I+(B]+\\)\\W" 1 "FaceAngry.xpm") ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm") ("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm") - ("\\(:-*[)>}»]+\\)\\W" 1 "FaceHappy.xpm") - ("\\(=[)>»]+\\)\\W" 1 "FaceHappy.xpm") + ("\\(:-*[)>}(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") @@ -73,8 +74,8 @@ ("\\(:-*|\\)\\W" 1 "FaceStraight.xpm") ("\\(:-*p\\)\\W" 1 "FaceTalking.xpm") ("\\(:-*d\\)\\W" 1 "FaceTasty.xpm") - ("\\(;-*[>)}»]+\\)\\W" 1 "FaceWinking.xpm") - ("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm") + ("\\(;-*[>)}(I;(B]+\\)\\W" 1 "FaceWinking.xpm") + ("\\(:-*[Vv(I5(B]\\)\\W" 1 "FaceWry.xpm") ("\\([:|]-*P\\)\\W" 1 "FaceYukky.xpm")) "*Normal and deformed faces for smilies." :type '(repeat (list regexp @@ -83,12 +84,12 @@ :group 'smiley) (defcustom smiley-nosey-regexp-alist - '(("\\(:-+[<«]+\\)\\W" 1 "FaceAngry.xpm") + '(("\\(:-+[<(I+(B]+\\)\\W" 1 "FaceAngry.xpm") ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm") ("\\(:-+D\\)\\W" 1 "FaceGrinning.xpm") - ("\\(:-+[}»]+\\)\\W" 1 "FaceHappy.xpm") + ("\\(:-+[}(I;(B]+\\)\\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") @@ -98,8 +99,8 @@ ("\\(:-+|\\)\\W" 1 "FaceStraight.xpm") ("\\(:-+p\\)\\W" 1 "FaceTalking.xpm") ("\\(:-+d\\)\\W" 1 "FaceTasty.xpm") - ("\\(;-+[>)}»]+\\)\\W" 1 "FaceWinking.xpm") - ("\\(:-+[Vvµ]\\)\\W" 1 "FaceWry.xpm") + ("\\(;-+[>)}(I;(B]+\\)\\W" 1 "FaceWinking.xpm") + ("\\(:-+[Vv(I5(B]\\)\\W" 1 "FaceWry.xpm") ("\\(][:8B]-[)>]\\)\\W" 1 "FaceDevilish.xpm") ("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm")) "*Smileys with noses. These get less false matches." @@ -154,7 +155,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 +163,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 +181,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 +214,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 +241,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 +277,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,19 +304,51 @@ 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) +;; Local Variables: +;; coding: iso-8859-1 +;; End: + ;;; smiley.el ends here