From mboxrd@z Thu Jan  1 00:00:00 1970
X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/6697
Path: main.gmane.org!not-for-mail
From: William Perry <wmperry@monolith.spry.com>
Newsgroups: gmane.emacs.gnus.general
Subject: smiley.el (was Re: gnus-smiley.el -- new version)
Date: Fri, 14 Jun 1996 11:42:20 -0700
Message-ID: <199606141842.LAA07706@monolith.spry.com>
References: <199606141723.AA017493012@teal.ece.ucdavis.edu>
Reply-To: wmperry@spry.com
NNTP-Posting-Host: coloc-standby.netfonds.no
X-Trace: main.gmane.org 1035147115 4458 80.91.224.250 (20 Oct 2002 20:51:55 GMT)
X-Complaints-To: usenet@main.gmane.org
NNTP-Posting-Date: Sun, 20 Oct 2002 20:51:55 +0000 (UTC)
Cc: ding@ifi.uio.no
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 MAA18208 for <steve@miranova.com>; Fri, 14 Jun 1996 12:09:13 -0700
Original-Received: from monolith.spry.com (monolith.spry.com [198.185.2.198]) by ifi.uio.no with ESMTP (8.6.11/ifi2.4) 
	id <UAA28368@ifi.uio.no> for <ding@ifi.uio.no> ; Fri, 14 Jun 1996 20:41:56 +0200
Original-Received: (from wmperry@localhost) by monolith.spry.com (8.7.4/8.7.3) id LAA07706; Fri, 14 Jun 1996 11:42:20 -0700
Original-To: hardaker@ece.ucdavis.edu
Errors-to: wmperry@spry.com
X-Face: O~Rn;(l][/-o1sALg4A@xpE:9-"'IR[%;,,!m7</SYF`{vYQ(&RI1&EiH[FvT;J}@f!4kfz
 x_!Y#=y{Uuj9GvUi=cPuajQ(Z42R[wE@{G,sn$qGr5g/wnb*"*ktI+,CD}1Z'wxrM2ag-r0p5I6\nA
 [WJopW_J.WY;
In-Reply-To: <199606141723.AA017493012@teal.ece.ucdavis.edu>
Xref: main.gmane.org gmane.emacs.gnus.general:6697
X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:6697

Here is a slightly modified version that uses a tty-specifier in the glyph
so that you do not have to check if you are in X or not.  Also, its been
generalized a bit, so that you can (smiley-buffer your-fav-buffer start end)
gnus-smiley-buffer becomes a trivial wrapper.  This way it can be used in
VM or Emacs-W3, etc.

The finding of the pixmap directory needs to be automatic though.

-Bill P.

;;
;; comments go here.
;;

;; To use:
;; (require 'smiley)
;; (add-hook 'gnus-article-display-hook 'gnus-smiley-display t)

(defvar smiley-data-directory "/tmp/smilies/"
  "Location of the smiley faces files.")

(defvar 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 smiley-glyph-cache nil)
(defvar smiley-running-xemacs (string-match "XEmacs" emacs-version))

(defun smiley-create-glyph (smiley pixmap)
  (and
   smiley-running-xemacs
   (or
    (cdr-safe (assoc pixmap smiley-glyph-cache))
    (let ((glyph (make-glyph
		  (list
		   (cons 'x (expand-file-name pixmap smiley-data-directory))
		   (cons 'tty smiley)))))
      (setq smiley-glyph-cache (cons (cons pixmap glyph) smiley-glyph-cache))
      (set-glyph-face glyph 'default)
      glyph))))

(defun smiley-buffer (&optional buffer st nd)
  (save-excursion
    (and buffer (set-buffer buffer))
    (let ((buffer-read-only nil)
	  (alist smiley-regexp-alist)
	  bug entry regexp)
      (goto-char (or st (point-min)))
      (setq beg (point))
      ;; loop through alist
      (while (setq entry (pop alist))
	(setq regexp (car entry))
	(goto-char beg)
	(while (re-search-forward regexp nd t)
	  (let* ((start (match-beginning 0))
		 (end (match-end 0))
		 (file (nth 1 entry))
		 (glyph (smiley-create-glyph (buffer-substring start end)
					     file)))
	    (if glyph
		(progn 
		  (let ((ext (make-extent start end)))
		    (set-extent-property ext 'invisible t)
		    (set-extent-property ext 'end-open t))
		  (make-annotation glyph end 'text)
		  (goto-char end)))))))))
    
(defun gnus-smiley-display ()
  (interactive)
  (save-excursion
    (set-buffer gnus-article-buffer)
    (goto-char (point-min))
    ;; We skip the headers.
    (unless (search-forward "\n\n" nil t)
      (goto-char (point-max)))
    (smiley-buffer (current-buffer) (point))))

(provide 'smiley)