X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fsmiley.el;h=0d5f71012e061195330856d1aa51a512ba0efdef;hb=25ae8d0af030d77d5fead1083abf8b20259b55c4;hp=385d6889fa56b6b40ba18e8b3ed38458e648a6cd;hpb=8944908a9e5aa4e0e29843510245e84337a2a8a5;p=elisp%2Fgnus.git- diff --git a/lisp/smiley.el b/lisp/smiley.el index 385d688..0d5f710 100644 --- a/lisp/smiley.el +++ b/lisp/smiley.el @@ -1,5 +1,6 @@ ;;; smiley.el --- displaying smiley faces -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Wes Hardaker ;; Keywords: fun @@ -35,9 +36,10 @@ ;; The smilies were drawn by Joe Reiss . +(eval-when-compile (require 'cl)) + (require 'annotations) (require 'messagexmas) -(require 'cl) (require 'custom) (defgroup smiley nil @@ -65,7 +67,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") @@ -88,7 +90,7 @@ ("\\(:-+D\\)\\W" 1 "FaceGrinning.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") @@ -154,7 +156,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) @@ -180,6 +182,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 +215,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 +242,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 +278,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 +305,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