X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fsmiley.el;h=c79a8258d43267a7f4ee70b428cdeebad25306a1;hb=9b741e050b400987d68ff761c6cc3276c932839c;hp=5edb17608f6b4ed1a45973bf8317028bb6949f93;hpb=b6a93585a31c8f392c69dabc5ff84248b93b8eac;p=elisp%2Fgnus.git-

diff --git a/lisp/smiley.el b/lisp/smiley.el
index 5edb176..c79a825 100644
--- a/lisp/smiley.el
+++ b/lisp/smiley.el
@@ -51,14 +51,71 @@
 
 ;; The XEmacs version has a baroque, if not rococo, set of these.
 (defcustom smiley-regexp-alist
-  '(("\\(:-?)\\)\\W" 1 "smile")
-    ("\\(;-?)\\)\\W" 1 "blink")
-    ("\\(:-]\\)\\W" 1 "forced")
-    ("\\(8-)\\)\\W" 1 "braindamaged")
-    ("\\(:-|\\)\\W" 1 "indifferent")
-    ("\\(:-[/\\]\\)\\W" 1 "wry")
-    ("\\(:-(\\)\\W" 1 "sad")
-    ("\\(:-{\\)\\W" 1 "frown"))
+  (if (file-exists-p (expand-file-name "WideFaceSmile.xbm"
+				       smiley-data-directory))
+      ;; Use faces in ftp://ftp.gnus.org/pub/gnus/etc-0.27.tar.gz
+      '(;; ^_^ ^^
+	("\\(\\^_?\\^\\)\\W" 1 "WideFaceSmile")
+	;; ;-> ;-) ;-} ;> ;) :}
+	("\\(;-?[>)}]+\\)\\W" 1 "FaceWinking")
+	;; ^_^; ^^;
+	("\\(\\^_?\\^;\\)\\W" 1 "WideFaceAse1")
+	;; ^_^;; ^^;;
+	("\\(\\^_?\\^;;\\)\\W" 1 "WideFaceAse2")
+	;; ^_^;;; ^^;;;
+	("\\(\\^_?\\^;;;\\)\\W" 1 "WideFaceAse3")
+	;; ;_;
+	("\\(;_;\\)\\W" 1 "WideFaceWeep")
+	;; T_T
+	("\\(T_T\\)\\W" 1 "WideFaceWeep")
+	;; >_<
+	("\\(>_<\\)\\W" 1 "WideFaceWeep")
+	;; :-< :<
+	("\\(:-?<\\)\\W" 1 "FaceAngry")
+	;; :-] :]
+	("\\(:-?\\]+\\)\\W" 1 "FaceGoofy")
+	;; :-D :D
+	("\\(:-?D\\)\\W" 1 "FaceGrinning")
+	;; :-) :-> :-} :) :> :}
+	("\\(:-?[)>}]+\\)\\W" 1 "FaceHappy")
+	;; =)
+	("\\(=)\\)\\W" 1 "FaceHappy")
+	;; :-/ :-\ :/ :\  excludes urls etc.
+	("\\(:-[/\\]\\)\\W" 1 "FaceIronic")
+	("\\(:/\\)\\([\t\n ]\\|[^/]\\W\\)" 1 "FaceIronic")
+	("\\(:\\\\\\)\\([\t\n ]\\|[^\\]\\W\\)" 1 "FaceIronic")
+	;; 8-| 8-O 8-%
+	;; excludes just numbers
+	("[^.0-9]\\(8-[|O%]\\)\\W" 1 "FaceKOed")
+	;; :-# :#
+	("\\(:-?#\\)\\W" 1 "FaceNyah")
+	;; :-( :-{ :( :{
+	("\\(:-?[({]+\\)\\W" 1 "FaceSad")
+	;; =( ={
+	("\\(=[({]+\\)\\W" 1 "FaceSad")
+	;; :-O :-o :O :o
+	("\\(:-?[Oo]\\)\\W" 1 "FaceStartled")
+	;; :-| :|
+	("\\(:-?|\\)\\W" 1 "FaceStraight")
+	;; :-p :p
+	("\\(:-?p\\)\\W" 1 "FaceTalking")
+	;; :-d
+	("\\(:-d\\)\\W" 1 "FaceTasty")
+	;; :-V :-v :V :v
+	("\\(:-?[Vv]\\)\\W" 1 "FaceWry")
+	;; :-P :P
+	("\\(:-?P\\)\\W" 1 "FaceYukky")
+	;; ]:-) ]:-> ]:-} ]8-) ]8-> ]8-} ]B-) ]B-> ]B-}
+	;; ]:) ]:> ]:} ]8) ]8> ]8} ]B) ]B> ]B}
+	("\\(\\][:8B]-?[)>}]\\)\\W" 1 "FaceDevilish"))
+    '(("\\(:-?)\\)\\W" 1 "smile")
+      ("\\(;-?)\\)\\W" 1 "blink")
+      ("\\(:-]\\)\\W" 1 "forced")
+      ("\\(8-)\\)\\W" 1 "braindamaged")
+      ("\\(:-|\\)\\W" 1 "indifferent")
+      ("\\(:-[/\\]\\)\\W" 1 "wry")
+      ("\\(:-(\\)\\W" 1 "sad")
+      ("\\(:-{\\)\\W" 1 "frown")))
   "*A list of regexps to map smilies to images.
 The elements are (REGEXP MATCH FILE), where MATCH is the submatch in
 regexp to replace with IMAGE.  IMAGE is the name of a PBM file in
@@ -76,6 +133,8 @@ regexp to replace with IMAGE.  IMAGE is the name of a PBM file in
   (let ((types (list "pbm")))
     (when (gnus-image-type-available-p 'xpm)
       (push "xpm" types))
+    (when (gnus-image-type-available-p 'xbm)
+      (push "xbm" types))
     types)
   "*List of suffixes on picon file names to try."
   :type '(repeat string)
@@ -125,14 +184,21 @@ A list of images is returned."
 		image (nth 2 entry))
 	  (goto-char beg)
 	  (while (re-search-forward (car entry) end t)
-	    (setq string (match-string group))
 	    (goto-char (match-end group))
-	    (delete-region (match-beginning group) (match-end group))
-	    (when image
-	      (push image images)
-	      (gnus-add-wash-type 'smiley)
-	      (gnus-add-image 'smiley image)
-	      (gnus-put-image image string))))
+	    (unless (text-property-any (match-beginning group) (point)
+				       'smilified t)
+	      (setq string (match-string group))
+	      (delete-region (match-beginning group) (match-end group))
+	      (when image
+		(push image images)
+		(gnus-add-wash-type 'smiley)
+		(gnus-add-image 'smiley image)
+		(put-text-property (point)
+				   (progn
+				     (gnus-put-image image string)
+				     (point))
+				   'smilified t)))))
+	(put-text-property beg (or end (point-max)) 'smilified nil)
 	images))))
 
 (defun smiley-toggle-buffer (&optional arg)