(defvar smiley-data-directory (message-xmas-find-glyph-directory "smilies")
"Location of the smiley faces files.")
-(defvar smiley-regexp-alist
- '(("\\s-\\(:-*\\]\\)\\W" 1 "FaceGrinning.xpm")
- ("\\s-\\(:-*[oO]\\)\\W" 1 "FaceStartled.xpm")
- ("\\s-\\(:-*[)>]\\)" 1 "FaceHappy.xpm")
- ("\\s-\\(;-*[>)]\\)" 1 "FaceWinking.xpm")
- ("\\s-\\(:-[/\\]\\)" 1 "FaceIronic.xpm")
- ("\\s-\\(:-*|\\)" 1 "FaceStraight.xpm")
- ("\\s-\\(:-*<\\)" 1 "FaceAngry.xpm")
- ("\\s-\\(:-*d\\)\\W" 1 "FaceTasty.xpm")
- ("\\s-\\(:-*[pP]\\)\\W" 1 "FaceYukky.xpm")
- ("\\s-\\(8-*|\\)" 1 "FaceKOed.xpm")
- ("\\s-\\(:-*(\\)" 1 "FaceAngry.xpm"))
- "A list of regexps to map smilies to real images.")
+;; Notice the subtle differences in the regular expessions in the two alists below
+
+(defvar smiley-deformed-regexp-alist
+ '(("\\(:-*[<«]+\\)\\W" 1 "FaceAngry.xpm")
+ ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm")
+ ("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm")
+ ("\\(:-*[)>}»]+\\)\\W" 1 "FaceHappy.xpm")
+ ("\\(:-*[/\\\"]\\)[^/]" 1 "FaceIronic.xpm")
+ ("\\([8|]-*[|Oo%]\\)\\W" 1 "FaceKOed.xpm")
+ ("\\([:|]-*#+\\)\\W" 1 "FaceNyah.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")
+ ("\\([:|]-*P\\)\\W" 1 "FaceYukky.xpm"))
+ "Normal and deformed faces for smilies.")
+
+(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") ;; The exception that confirms the rule
+ ("\\(:-+[/\\\"]+\\)\\W" 1 "FaceIronic.xpm")
+ ("\\([8|]-+[|Oo%]\\)\\W" 1 "FaceKOed.xpm")
+ ("\\([:|]-+#+\\)\\W" 1 "FaceNyah.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")
+ ("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm"))
+ "Smileys with noses. These get less false matches.")
+
+(defvar 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.")
(defvar smiley-flesh-color "yellow"
"Flesh 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
(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))
+ (if 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)
- (save-excursion
- (and buffer (set-buffer buffer))
- (let ((buffer-read-only nil)
- (alist smiley-regexp-alist)
- entry regexp beg group file)
- (goto-char (or st (point-min)))
- (setq beg (point))
- ;; loop through alist
- (while (setq entry (pop alist))
- (setq regexp (car entry)
- group (cadr entry)
- file (caddr entry))
- (goto-char beg)
- (while (re-search-forward regexp nd t)
- (let* ((start (match-beginning group))
- (end (match-end group))
- (glyph (smiley-create-glyph (buffer-substring start end)
- file)))
- (when glyph
- (mapcar 'delete-annotation (annotations-at end))
- (let ((ext (make-extent start end)))
- (set-extent-property ext 'invisible t)
- (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))))))))
+ (when (featurep 'x)
+ (save-excursion
+ (when buffer
+ (set-buffer buffer))
+ (let ((buffer-read-only nil)
+ (alist (if (symbolp smiley-regexp-alist)
+ (symbol-value smiley-regexp-alist)
+ smiley-regexp-alist))
+ entry regexp beg group file)
+ (goto-char (or st (point-min)))
+ (setq beg (point))
+ ;; loop through alist
+ (while (setq entry (pop alist))
+ (setq regexp (car entry)
+ group (cadr entry)
+ file (caddr entry))
+ (goto-char beg)
+ (while (re-search-forward regexp nd t)
+ (let* ((start (match-beginning group))
+ (end (match-end group))
+ (glyph (smiley-create-glyph (buffer-substring start end)
+ 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 'invisible t)
+ (set-extent-property ext 'end-open t)
+ (set-extent-property ext 'keymap smiley-map)
+ (set-extent-property ext 'mouse-face gnus-article-mouse-face)
+; (set-extent-property ext 'intangible t)
+ ;; set annotation params
+ (set-extent-property ant 'mouse-face gnus-article-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)))))))))
(defun smiley-end-paren-p (start end)
"Try to guess whether the current smiley is an end-paren smiley."
projects / gnus / blobdiff