;;; smiley.el --- displaying smiley faces
-;; Copyright (C) 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
;; Author: Wes Hardaker <hardaker@ece.ucdavis.edu>
;; Keywords: fun
;; (require 'smiley)
;; (add-hook 'gnus-article-display-hook 'gnus-smiley-display t)
-;; The smilies were drawn by Joe Reiss <joe@jreiss.async.vt.edu>.
+;; The smilies were drawn by Joe Reiss <jreiss@vt.edu>.
(require 'annotations)
(require 'messagexmas)
-(eval-when-compile (require 'cl))
+(require 'cl)
+(require 'custom)
-(defvar smiley-data-directory (message-xmas-find-glyph-directory "smilies")
- "Location of the smiley faces files.")
+(defgroup smiley nil
+ "Turn :-)'s into real images (XEmacs)."
+ :group 'gnus-visual)
-;; Notice the subtle differences in the regular expessions in the two alists below
+(defcustom smiley-data-directory (message-xmas-find-glyph-directory "smilies")
+ "Location of the smiley faces files."
+ :type 'directory
+ :group 'smiley)
-(defvar smiley-deformed-regexp-alist
+;; Notice the subtle differences in the regular expressions in the
+;; two alists below.
+
+(defcustom smiley-deformed-regexp-alist
'(("\\(:-*[<«]+\\)\\W" 1 "FaceAngry.xpm")
("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm")
("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm")
("\\(:-*[)>}»]+\\)\\W" 1 "FaceHappy.xpm")
- ("\\(:-*[/\\\"]\\)[^/]" 1 "FaceIronic.xpm")
+ ("\\(:-*[/\\\"]\\)[^/]\\W" 1 "FaceIronic.xpm")
("\\([8|]-*[|Oo%]\\)\\W" 1 "FaceKOed.xpm")
("\\([:|]-*#+\\)\\W" 1 "FaceNyah.xpm")
("\\(:-*[({]+\\)\\W" 1 "FaceSad.xpm")
("\\(;-*[>)}»]+\\)\\W" 1 "FaceWinking.xpm")
("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm")
("\\([:|]-*P\\)\\W" 1 "FaceYukky.xpm"))
- "Normal and deformed faces for smilies.")
+ "Normal and deformed faces for smilies."
+ :type '(repeat (list regexp
+ (integer :tag "Match")
+ (string :tag "Image")))
+ :group 'smiley)
-(defvar smiley-nosey-regexp-alist
+(defcustom 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") ;; The exception that confirms the rule
+ ("\\(:-*)+\\)\\W" 1 "FaceHappy.xpm")
("\\(:-+[/\\\"]+\\)\\W" 1 "FaceIronic.xpm")
("\\([8|]-+[|Oo%]\\)\\W" 1 "FaceKOed.xpm")
("\\([:|]-+#+\\)\\W" 1 "FaceNyah.xpm")
("\\(:-+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.")
+ "Smileys with noses. These get less false matches."
+ :type '(repeat (list regexp
+ (integer :tag "Match")
+ (string :tag "Image")))
+ :group 'smiley)
-(defvar smiley-regexp-alist smiley-deformed-regexp-alist
+(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-nose-regexp-alist that
-matches less aggresively is available.
-If this is a symbol, take its value.")
+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)
+
+(defcustom smiley-flesh-color "yellow"
+ "Flesh color."
+ :type 'string
+ :group 'smiley)
+
+(defcustom smiley-features-color "black"
+ "Features color."
+ :type 'string
+ :group 'smiley)
-(defvar smiley-flesh-color "yellow"
- "Flesh color.")
+(defcustom smiley-tongue-color "red"
+ "Tongue color."
+ :type 'string
+ :group 'smiley)
-(defvar smiley-features-color "black"
- "Features color.")
+(defcustom smiley-circle-color "black"
+ "Circle color."
+ :type 'string
+ :group 'smiley)
-(defvar smiley-tongue-color "red"
- "Tongue color.")
+(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)
(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)
file)))
(when glyph
(mapcar 'delete-annotation (annotations-at end))
- (let ((ext (make-extent start end)))
- (set-extent-property ext 'invisible t)
+ (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 'intangible t))
- (make-annotation glyph end 'text)
+ (set-extent-property ext 'start-open t)
+ (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))
(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 ()
(interactive)
(save-excursion