Mercurial > hg > xemacs-beta
diff lisp/gnus/smiley.el @ 70:131b0175ea99 r20-0b30
Import from CVS: tag r20-0b30
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:02:59 +0200 |
parents | ec9a17fef872 |
children | 0d2f883870bc |
line wrap: on
line diff
--- a/lisp/gnus/smiley.el Mon Aug 13 09:00:04 2007 +0200 +++ b/lisp/gnus/smiley.el Mon Aug 13 09:02:59 2007 +0200 @@ -1,5 +1,5 @@ ;;; smiley.el --- displaying smiley faces -;; Copyright (C) 1996,97 Free Software Foundation, Inc. +;; Copyright (C) 1996 Free Software Foundation, Inc. ;; Author: Wes Hardaker <hardaker@ece.ucdavis.edu> ;; Keywords: fun @@ -33,31 +33,23 @@ ;; (require 'smiley) ;; (add-hook 'gnus-article-display-hook 'gnus-smiley-display t) -;; The smilies were drawn by Joe Reiss <jreiss@vt.edu>. +;; The smilies were drawn by Joe Reiss <joe@jreiss.async.vt.edu>. (require 'annotations) (require 'messagexmas) -(require 'cl) -(require 'custom) - -(defgroup smiley nil - "Turn :-)'s into real images (XEmacs)." - :group 'gnus-visual) +(eval-when-compile (require 'cl)) -(defcustom smiley-data-directory (message-xmas-find-glyph-directory "smilies") - "Location of the smiley faces files." - :type 'directory - :group 'smiley) +(defvar smiley-data-directory (message-xmas-find-glyph-directory "smilies") + "Location of the smiley faces files.") -;; Notice the subtle differences in the regular expressions in the -;; two alists below. +;; Notice the subtle differences in the regular expessions in the two alists below -(defcustom smiley-deformed-regexp-alist +(defvar smiley-deformed-regexp-alist '(("\\(:-*[<«]+\\)\\W" 1 "FaceAngry.xpm") ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm") ("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm") ("\\(:-*[)>}»]+\\)\\W" 1 "FaceHappy.xpm") - ("\\(:-*[/\\\"]\\)[^/]\\W" 1 "FaceIronic.xpm") + ("\\(:-*[/\\\"]\\)[^/]" 1 "FaceIronic.xpm") ("\\([8|]-*[|Oo%]\\)\\W" 1 "FaceKOed.xpm") ("\\([:|]-*#+\\)\\W" 1 "FaceNyah.xpm") ("\\(:-*[({]+\\)\\W" 1 "FaceSad.xpm") @@ -68,18 +60,14 @@ ("\\(;-*[>)}»]+\\)\\W" 1 "FaceWinking.xpm") ("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm") ("\\([:|]-*P\\)\\W" 1 "FaceYukky.xpm")) - "Normal and deformed faces for smilies." - :type '(repeat (list regexp - (integer :tag "Match") - (string :tag "Image"))) - :group 'smiley) + "Normal and deformed faces for smilies.") -(defcustom smiley-nosey-regexp-alist +(defvar smiley-nosey-regexp-alist '(("\\(:-+[<«]+\\)\\W" 1 "FaceAngry.xpm") ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm") ("\\(:-+D\\)\\W" 1 "FaceGrinning.xpm") ("\\(:-+[}»]+\\)\\W" 1 "FaceHappy.xpm") - ("\\(:-*)+\\)\\W" 1 "FaceHappy.xpm") + ("\\(:-*)+\\)\\W" 1 "FaceHappy.xpm") ;; The exception that confirms the rule ("\\(:-+[/\\\"]+\\)\\W" 1 "FaceIronic.xpm") ("\\([8|]-+[|Oo%]\\)\\W" 1 "FaceKOed.xpm") ("\\([:|]-+#+\\)\\W" 1 "FaceNyah.xpm") @@ -90,71 +78,36 @@ ("\\(:-+d\\)\\W" 1 "FaceTasty.xpm") ("\\(;-+[>)}»]+\\)\\W" 1 "FaceWinking.xpm") ("\\(:-+[Vvµ]\\)\\W" 1 "FaceWry.xpm") - ("\\(][:8B]-[)>]\\)\\W" 1 "FaceDevilish.xpm") ("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm")) - "Smileys with noses. These get less false matches." - :type '(repeat (list regexp - (integer :tag "Match") - (string :tag "Image"))) - :group 'smiley) + "Smileys with noses. These get less false matches.") -(defcustom smiley-regexp-alist smiley-deformed-regexp-alist +(defvar smiley-regexp-alist smiley-deformed-regexp-alist "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. -If this is a symbol, take its value." - :type '(radio (variable-item smiley-deformed-regexp-alist) - (variable-item smiley-nosey-regexp-alist) - symbol - (repeat (list regexp - (integer :tag "Match") - (string :tag "Image")))) - :group 'smiley) +Defaults to the content of smiley-deformed-regexp-alist. +An alternative smiley-nose-regexp-alist that +matches less aggresively is available.") -(defcustom smiley-flesh-color "yellow" - "Flesh color." - :type 'string - :group 'smiley) +(defvar smiley-flesh-color "yellow" + "Flesh color.") -(defcustom smiley-features-color "black" - "Features color." - :type 'string - :group 'smiley) +(defvar smiley-features-color "black" + "Features color.") -(defcustom smiley-tongue-color "red" - "Tongue color." - :type 'string - :group 'smiley) +(defvar smiley-tongue-color "red" + "Tongue color.") -(defcustom smiley-circle-color "black" - "Circle color." - :type 'string - :group 'smiley) - -(defcustom smiley-mouse-face 'highlight - "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-circle-color "black" + "Circle color.") (defvar smiley-glyph-cache nil) (defvar smiley-running-xemacs (string-match "XEmacs" emacs-version)) -(defvar smiley-map (make-sparse-keymap "smiley-keys") - "Keymap to toggle smiley states.") - -(define-key smiley-map [(button2)] 'smiley-toggle-extent) - (defun smiley-create-glyph (smiley pixmap) (and smiley-running-xemacs (or (cdr-safe (assoc pixmap smiley-glyph-cache)) - (let* ((xpm-color-symbols + (let* ((xpm-color-symbols (and (featurep 'xpm) (append `(("flesh" ,smiley-flesh-color) ("features" ,smiley-features-color) @@ -174,23 +127,6 @@ (interactive "r") (smiley-buffer (current-buffer) beg end)) -(defun smiley-toggle-extent (event) - "Toggle smiley at given point" - (interactive "e") - (let* ((ant (event-glyph-extent event)) - (pt (event-closest-point event)) - ext) - (if (annotationp ant) - (when (extentp (setq ext (extent-property ant 'smiley-extent))) - (set-extent-property ext 'invisible nil) - (hide-annotation ant)) - (when pt - (while (setq ext (extent-at pt (event-buffer event) nil ext 'at)) - (when (annotationp (setq ant - (extent-property ext 'smiley-annotation))) - (reveal-annotation ant) - (set-extent-property ext 'invisible t))))))) - ;;;###autoload (defun smiley-buffer (&optional buffer st nd) (interactive) @@ -199,9 +135,7 @@ (when buffer (set-buffer buffer)) (let ((buffer-read-only nil) - (alist (if (symbolp smiley-regexp-alist) - (symbol-value smiley-regexp-alist) - smiley-regexp-alist)) + (alist smiley-regexp-alist) entry regexp beg group file) (goto-char (or st (point-min))) (setq beg (point)) @@ -218,21 +152,11 @@ file))) (when glyph (mapcar 'delete-annotation (annotations-at end)) - (let ((ext (make-extent start end)) - (ant (make-annotation glyph end 'text))) - ;; set text extent params - (set-extent-property ext 'end-open t) - (set-extent-property ext 'start-open t) + (let ((ext (make-extent start end))) (set-extent-property ext 'invisible t) - (set-extent-property ext 'keymap smiley-map) - (set-extent-property ext 'mouse-face smiley-mouse-face) - (set-extent-property ext 'intangible t) - ;; set annotation params - (set-extent-property ant 'mouse-face smiley-mouse-face) - (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 'end-open t) + (set-extent-property ext 'intangible t)) + (make-annotation glyph end 'text) (when (smiley-end-paren-p start end) (make-annotation ")" end 'text)) (goto-char end))))))))) @@ -248,8 +172,7 @@ (= (char-after (1- (point))) ?\())) t))) -(defvar gnus-article-buffer) -;;;###autoload +;;;###autoload (defun gnus-smiley-display () (interactive) (save-excursion