;; (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 <jreiss@vt.edu>.
(require 'annotations)
(require 'messagexmas)
:type 'directory
:group 'smiley)
-;; Notice the subtle differences in the regular expressions in the two alists below
+;; Notice the subtle differences in the regular expressions in the
+;; 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")
- ("\\(:-*[/\\\"]\\)[^/]" 1 "FaceIronic.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")
("\\(:-*d\\)\\W" 1 "FaceTasty.xpm")
("\\(;-*[>)}»]+\\)\\W" 1 "FaceWinking.xpm")
- ("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm")
+ ("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm")
("\\([:|]-*P\\)\\W" 1 "FaceYukky.xpm"))
"Normal and deformed faces for smilies."
- :type '(repeat (list regexp
+ :type '(repeat (list regexp
(integer :tag "Match")
(string :tag "Image")))
:group 'smiley)
("\\(:-+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")
("\\(][:8B]-[)>]\\)\\W" 1 "FaceDevilish.xpm")
("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm"))
"Smileys with noses. These get less false matches."
- :type '(repeat (list regexp
+ :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.
-Defaults to the content of smiley-deformed-regexp-alist.
-An alternative smiley-nosey-regexp-alist that
-matches less aggressively is available.
+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
+ symbol
+ (repeat (list regexp
(integer :tag "Match")
(string :tag "Image"))))
:group 'smiley)
:type 'face
:group 'smiley)
-
(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")
+ "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
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)
(hide-annotation ant))
(when pt
(while (setq ext (extent-at pt (event-buffer event) nil ext 'at))
- (when (annotationp (setq ant
+ (when (annotationp (setq ant
(extent-property ext 'smiley-annotation)))
(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)
(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
(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)))))))))
(= (char-after (1- (point))) ?\()))
t)))
-;;;###autoload
+(defvar gnus-article-buffer)
+;;;###autoload
(defun gnus-smiley-display ()
+ "Display \"smileys\" as small graphical icons."
(interactive)
(save-excursion
(set-buffer gnus-article-buffer)