Re: What will they think of next: [fwd]

[Wes Hardaker <hardaker@ece.ucdavis.edu>]

Kevin Cheek <kcheek@cerebus.im.med.umich.edu> writes:

> >   we simply _HAVE_ to implement this.  Anyone know of a good smiley icon
> > repository? 
> 
> In case anyone actually wants some smiley icons, I got 15 small tiffs
> from the next-icon mail list. They're available via HTTP at
> <http/mmg2.im.med.umich.edu/~kcheek/smileys/>.

Well, so like I had my wisdom teeth pulled on Monday...  That didn't
leave much motivation for me to do anything productive today.
Therefore, I submit the very beginnings of the above mentioned project
(something, I've been wanting to see for a long time too).

You'll need ftp://ftp.ece.ucdavis.edu/pub/hardaker/smilies.tar.gz, as
well as the following lisp code.  Note that the default regular
expressions I threw together in roughly 5 minutes and haven't even
included all the faces in the face database (from Kevin) yet.  I'll
leave it to someone else (ie, a reg-exp and smiley expert) to clean
this up.  The good news is that it works (XEmacs required of course).

:-) :-\ :-] :-> :-/ :-| :-< :-(

Install the above lisp and smiley faces and re-read this message!

The faces should be colored in yellow, and the background should be
set to transparent (outside the circle), but again, I defer...

;;
;; comments go here.
;;

;; (add-hook 'gnus-article-display-hook 'gnus-smiley-display t)

(defvar gnus-smiley-db-dir "/home/hardaker/tmp/smilies/smilies")

(defvar gnus-smiley-regexp-alist '((":-*\\]" "FaceGrinning.xpm")
				 (":-*)" "FaceHappy.xpm")
				 (";-*[>)]" "FaceWinking.xpm")
				 (":-*[/\\]" "FaceIronic.xpm")
				 (":-*|" "FaceGoofy.xpm")
				 (":-*<" "FaceAngry.xpm")
				 (":-*(" "FaceAngry.xpm")))

(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))
		    (gl (make-glyph
			 (concat (file-name-as-directory gnus-smiley-db-dir) 
				 (nth 1 entry)))))
		(if gl
		    (progn 
		      (set-glyph-face gl 'default)
		      (delete-region start end)
		      (make-annotation gl start 'text))
		  (message "face doesn't exist")))))))))

-- 
                                                                _____ 
Wes Hardaker                                                   / ___ \
Department of Electrical and Computer Engineering             / /   \//\
University of California at Davis        __________________  \--/    /--\
Davis CA  95616                         /     Recycle!     \  \//\___/ /
(hardaker@ece.ucdavis.edu)             / It's not too late! \   \_____/