From mboxrd@z Thu Jan  1 00:00:00 1970
X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/6694
Path: main.gmane.org!not-for-mail
From: hardaker@ece.ucdavis.edu (Wes Hardaker)
Newsgroups: gmane.emacs.gnus.general
Subject: gnus-smiley.el -- new version
Date: Fri, 14 Jun 1996 10:23:32 -0700
Message-ID: <199606141723.AA017493012@teal.ece.ucdavis.edu>
Reply-To: hardaker@ece.ucdavis.edu
NNTP-Posting-Host: coloc-standby.netfonds.no
X-Trace: main.gmane.org 1035147112 4451 80.91.224.250 (20 Oct 2002 20:51:52 GMT)
X-Complaints-To: usenet@main.gmane.org
NNTP-Posting-Date: Sun, 20 Oct 2002 20:51:52 +0000 (UTC)
Return-Path: ding-request@ifi.uio.no
Original-Received: from ifi.uio.no (ifi.uio.no [129.240.64.2]) by deanna.miranova.com (8.7.5/8.6.9) with SMTP id KAA16898 for <steve@miranova.com>; Fri, 14 Jun 1996 10:49:08 -0700
Original-Received: from teal.ece.ucdavis.edu (hardaker@teal.ece.ucdavis.edu [128.120.54.142]) by ifi.uio.no with ESMTP (8.6.11/ifi2.4) 
	id <TAA24333@ifi.uio.no> for <ding@ifi.uio.no> ; Fri, 14 Jun 1996 19:23:36 +0200
Original-Received: by teal.ece.ucdavis.edu (1.37.109.16/Ultrix3.0-C/eecs 1.1)
	id AA017493012; Fri, 14 Jun 1996 10:23:32 -0700
Original-To: ding@ifi.uio.no
X-Face: #qW^}a%m*T^{A:Cp}$R\"38+d}41-Z}uU8,r%F#c#s:~Nzp0G9](s?,K49KJ]s"*7gvRgA
 SrAvQc4@/}L7Qc=w{)]ACO\R{LF@S{pXfojjjGg6c;q6{~C}CxC^^&~(F]`1W)%9j/iS/IM",B1
 M.?{w8ckLTYD'`|kTr\i\cgY)P4
X-Url: http://www.ece.ucdavis.edu/~hardaker
Xref: main.gmane.org gmane.emacs.gnus.general:6694
X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:6694


Did things slightly more correctly this time:

  -- cached last glyph for faster loading (of frequent smilies :-)
  -- Used "invisible extents" rather than deleting the original region
  -- more reg-exp -> smily matching

Additionally, I made the smily faces yellow with a trasparent edge, so
they look like they really should now!  Get a new copy at
ftp.ece.ucdavis.edu:/pub/hardaker/smilies.tar.gz

:-)

Wes Hardaker
Professional Time Waster

;;
;; comments go here.
;;

;; To use:
;; (load "gnus-smiley.el")
;; (add-hook 'gnus-article-display-hook 'gnus-smiley-display t)

(defvar gnus-smiley-db-dir "/home/hardaker/lib/smilies"
  "Location of the smiley xpm faces files.")

(defvar gnus-smiley-regexp-alist '((":-*\\]" "FaceGrinning.xpm")
				 (":-*[oO]" "FaceStartled.xpm")
				 (":-*[)>]" "FaceHappy.xpm")
				 (";-*[>)]" "FaceWinking.xpm")
				 (":-[/\\]" "FaceIronic.xpm")
				 (":-*|" "FaceStraight.xpm")
				 (":-*<" "FaceAngry.xpm")
				 (":-*d" "FaceTasty.xpm")
				 (":-*[pP]" "FaceYukky.xpm")
				 ("8-*|" "FaceKOed.xpm")
				 (":-*(" "FaceAngry.xpm"))
"A list of regexps to map smilies to real images.")

(defvar gnus-smiley-glyph nil)

(defvar gnus-smiley-last-file nil)

(defun gnus-smiley-display ()
  (interactive)
  (if (and (featurep 'xpm) 
           (or (not (fboundp 'device-type)) (equal (device-type) 'x)))
      (save-excursion
	(set-buffer gnus-article-buffer)
	;; search and replace
	(let ((buffer-read-only nil)
	      (alist gnus-smiley-regexp-alist)
	      bug entry regexp)
	  (goto-char (point-min))
	  ;; We skip the headers.
	  (unless (search-forward "\n\n" nil t)
	    (goto-char (point-max)))
	  (setq beg (point))
	  ;; loop through alist
	  (while (setq entry (pop alist))
	    (setq regexp (car entry))
	    (goto-char beg)
	    (while (re-search-forward regexp nil t)
	      (let ((start (match-beginning 0))
		    (end (match-end 0))
		    (file (concat (file-name-as-directory gnus-smiley-db-dir) 
				 (nth 1 entry))))
		(if (not (equal file gnus-smiley-last-file))
		    (setq gnus-smiley-glyph (make-glyph file)))
		(if gnus-smiley-glyph
		    (progn 
		      (set-glyph-face gnus-smiley-glyph 'default)
		      (let ((ext (make-extent start end)))
			(set-extent-property ext 'invisible t)
			(set-extent-property ext 'end-open t))
		      (make-annotation gnus-smiley-glyph end 'text)
		      (goto-char end))
		  ))))))))