Mercurial > hg > xemacs-beta

comparison lisp/gnus/smiley.el @ 108:360340f9fd5f r20-1b6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b6
author cvs
date Mon, 13 Aug 2007 09:18:39 +0200
parents 0d2f883870bc
children b980b6286996
comparison
equal deleted inserted replaced
107:523141596bda 108:360340f9fd5f
31 31
32 ;; To use: 32 ;; To use:
33 ;; (require 'smiley) 33 ;; (require 'smiley)
34 ;; (add-hook 'gnus-article-display-hook 'gnus-smiley-display t) 34 ;; (add-hook 'gnus-article-display-hook 'gnus-smiley-display t)
35 35
36 ;; The smilies were drawn by Joe Reiss <jreiss@vt.edu>. 36 ;; The smilies were drawn by Joe Reiss <jreiss@vt.edu>.
37 37
38 (require 'annotations) 38 (require 'annotations)
39 (require 'messagexmas) 39 (require 'messagexmas)
40 (require 'cl) 40 (require 'cl)
41 (require 'custom) 41 (require 'custom)
47 (defcustom smiley-data-directory (message-xmas-find-glyph-directory "smilies") 47 (defcustom smiley-data-directory (message-xmas-find-glyph-directory "smilies")
48 "Location of the smiley faces files." 48 "Location of the smiley faces files."
49 :type 'directory 49 :type 'directory
50 :group 'smiley) 50 :group 'smiley)
51 51
52 ;; Notice the subtle differences in the regular expressions in the two alists below 52 ;; Notice the subtle differences in the regular expressions in the
53 ;; two alists below.
53 54
54 (defcustom smiley-deformed-regexp-alist 55 (defcustom smiley-deformed-regexp-alist
55 '(("\\(:-*[<«]+\\)\\W" 1 "FaceAngry.xpm") 56 '(("\\(:-*[<«]+\\)\\W" 1 "FaceAngry.xpm")
56 ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm") 57 ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm")
57 ("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm") 58 ("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm")
58 ("\\(:-*[)>}»]+\\)\\W" 1 "FaceHappy.xpm") 59 ("\\(:-*[)>}»]+\\)\\W" 1 "FaceHappy.xpm")
59 ("\\(:-*[/\\\"]\\)[^/]" 1 "FaceIronic.xpm") 60 ("\\(:-*[/\\\"]\\)[^/]\\W" 1 "FaceIronic.xpm")
60 ("\\([8|]-*[|Oo%]\\)\\W" 1 "FaceKOed.xpm") 61 ("\\([8|]-*[|Oo%]\\)\\W" 1 "FaceKOed.xpm")
61 ("\\([:|]-*#+\\)\\W" 1 "FaceNyah.xpm") 62 ("\\([:|]-*#+\\)\\W" 1 "FaceNyah.xpm")
62 ("\\(:-*[({]+\\)\\W" 1 "FaceSad.xpm") 63 ("\\(:-*[({]+\\)\\W" 1 "FaceSad.xpm")
63 ("\\(:-*[Oo\*]\\)\\W" 1 "FaceStartled.xpm") 64 ("\\(:-*[Oo\*]\\)\\W" 1 "FaceStartled.xpm")
64 ("\\(:-*|\\)\\W" 1 "FaceStraight.xpm") 65 ("\\(:-*|\\)\\W" 1 "FaceStraight.xpm")
65 ("\\(:-*p\\)\\W" 1 "FaceTalking.xpm") 66 ("\\(:-*p\\)\\W" 1 "FaceTalking.xpm")
66 ("\\(:-*d\\)\\W" 1 "FaceTasty.xpm") 67 ("\\(:-*d\\)\\W" 1 "FaceTasty.xpm")
67 ("\\(;-*[>)}»]+\\)\\W" 1 "FaceWinking.xpm") 68 ("\\(;-*[>)}»]+\\)\\W" 1 "FaceWinking.xpm")
68 ("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm") 69 ("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm")
69 ("\\([:|]-*P\\)\\W" 1 "FaceYukky.xpm")) 70 ("\\([:|]-*P\\)\\W" 1 "FaceYukky.xpm"))
70 "Normal and deformed faces for smilies." 71 "Normal and deformed faces for smilies."
71 :type '(repeat (list regexp 72 :type '(repeat (list regexp
72 (integer :tag "Match") 73 (integer :tag "Match")
73 (string :tag "Image"))) 74 (string :tag "Image")))
74 :group 'smiley) 75 :group 'smiley)
75 76
76 (defcustom smiley-nosey-regexp-alist 77 (defcustom smiley-nosey-regexp-alist
90 ("\\(;-+[>)}»]+\\)\\W" 1 "FaceWinking.xpm") 91 ("\\(;-+[>)}»]+\\)\\W" 1 "FaceWinking.xpm")
91 ("\\(:-+[Vvµ]\\)\\W" 1 "FaceWry.xpm") 92 ("\\(:-+[Vvµ]\\)\\W" 1 "FaceWry.xpm")
92 ("\\(][:8B]-[)>]\\)\\W" 1 "FaceDevilish.xpm") 93 ("\\(][:8B]-[)>]\\)\\W" 1 "FaceDevilish.xpm")
93 ("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm")) 94 ("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm"))
94 "Smileys with noses. These get less false matches." 95 "Smileys with noses. These get less false matches."
95 :type '(repeat (list regexp 96 :type '(repeat (list regexp
96 (integer :tag "Match") 97 (integer :tag "Match")
97 (string :tag "Image"))) 98 (string :tag "Image")))
98 :group 'smiley) 99 :group 'smiley)
99 100
100 (defcustom smiley-regexp-alist smiley-deformed-regexp-alist 101 (defcustom smiley-regexp-alist smiley-deformed-regexp-alist
101 "A list of regexps to map smilies to real images. 102 "A list of regexps to map smilies to real images.
102 Defaults to the content of smiley-deformed-regexp-alist. 103 Defaults to the contents of `smiley-deformed-regexp-alist'.
103 An alternative smiley-nosey-regexp-alist that 104 An alternative is `smiley-nosey-regexp-alist' that matches less
104 matches less aggressively is available. 105 aggressively.
105 If this is a symbol, take its value." 106 If this is a symbol, take its value."
106 :type '(radio (variable-item smiley-deformed-regexp-alist) 107 :type '(radio (variable-item smiley-deformed-regexp-alist)
107 (variable-item smiley-nosey-regexp-alist) 108 (variable-item smiley-nosey-regexp-alist)
108 symbol 109 symbol
109 (repeat (list regexp 110 (repeat (list regexp
110 (integer :tag "Match") 111 (integer :tag "Match")
111 (string :tag "Image")))) 112 (string :tag "Image"))))
112 :group 'smiley) 113 :group 'smiley)
113 114
114 (defcustom smiley-flesh-color "yellow" 115 (defcustom smiley-flesh-color "yellow"
142 143
143 (defvar smiley-glyph-cache nil) 144 (defvar smiley-glyph-cache nil)
144 (defvar smiley-running-xemacs (string-match "XEmacs" emacs-version)) 145 (defvar smiley-running-xemacs (string-match "XEmacs" emacs-version))
145 146
146 (defvar smiley-map (make-sparse-keymap "smiley-keys") 147 (defvar smiley-map (make-sparse-keymap "smiley-keys")
147 "keymap to toggle smiley states") 148 "Keymap to toggle smiley states.")
148 149
149 (define-key smiley-map [(button2)] 'smiley-toggle-extent) 150 (define-key smiley-map [(button2)] 'smiley-toggle-extent)
150 151
151 (defun smiley-create-glyph (smiley pixmap) 152 (defun smiley-create-glyph (smiley pixmap)
152 (and 153 (and
153 smiley-running-xemacs 154 smiley-running-xemacs
154 (or 155 (or
155 (cdr-safe (assoc pixmap smiley-glyph-cache)) 156 (cdr-safe (assoc pixmap smiley-glyph-cache))
156 (let* ((xpm-color-symbols 157 (let* ((xpm-color-symbols
157 (and (featurep 'xpm) 158 (and (featurep 'xpm)
158 (append `(("flesh" ,smiley-flesh-color) 159 (append `(("flesh" ,smiley-flesh-color)
159 ("features" ,smiley-features-color) 160 ("features" ,smiley-features-color)
160 ("tongue" ,smiley-tongue-color)) 161 ("tongue" ,smiley-tongue-color))
161 xpm-color-symbols))) 162 xpm-color-symbols)))
183 (when (extentp (setq ext (extent-property ant 'smiley-extent))) 184 (when (extentp (setq ext (extent-property ant 'smiley-extent)))
184 (set-extent-property ext 'invisible nil) 185 (set-extent-property ext 'invisible nil)
185 (hide-annotation ant)) 186 (hide-annotation ant))
186 (when pt 187 (when pt
187 (while (setq ext (extent-at pt (event-buffer event) nil ext 'at)) 188 (while (setq ext (extent-at pt (event-buffer event) nil ext 'at))
188 (when (annotationp (setq ant 189 (when (annotationp (setq ant
189 (extent-property ext 'smiley-annotation))) 190 (extent-property ext 'smiley-annotation)))
190 (reveal-annotation ant) 191 (reveal-annotation ant)
191 (set-extent-property ext 'invisible t))))))) 192 (set-extent-property ext 'invisible t)))))))
192 193
193 ;;;###autoload 194 ;;;###autoload
245 (goto-char end) 246 (goto-char end)
246 (or (not (re-search-forward "[()]" nil t)) 247 (or (not (re-search-forward "[()]" nil t))
247 (= (char-after (1- (point))) ?\())) 248 (= (char-after (1- (point))) ?\()))
248 t))) 249 t)))
249 250
250 ;;;###autoload 251 (defvar gnus-article-buffer)
252 ;;;###autoload
251 (defun gnus-smiley-display () 253 (defun gnus-smiley-display ()
252 (interactive) 254 (interactive)
253 (save-excursion 255 (save-excursion
254 (set-buffer gnus-article-buffer) 256 (set-buffer gnus-article-buffer)
255 (goto-char (point-min)) 257 (goto-char (point-min))