Re: smiley.el (was Re: gnus-smiley.el -- new version)

[Lars Magne Ingebrigtsen <larsi@ifi.uio.no>]

Wes Hardaker <hardaker@ece.ucdavis.edu> writes:

>   "[^p]\\(:/\\)" and pick the \1 out of there, or use the entire
>   expression results if \1 DNE (ie, no sub-regions specified).  This
>   way you could more carefully watch out for things like http://,
>   which (used to) gets caught.  I also thought about requiring a white
>   space char before the smiley.  This would fix the problem as well,
>   and I doubt anyone is writing them without a space in the first place.

I've fiddled with it slightly and have added a new second element to
the alist elements -- the regexp grouping number.  (I haven't changed
the regexps themselves, so all use grouping 0.)

But you could say things like:

("[^/]\\(:-*[/\\]\\)" 1"FaceIronic.xpm")

to avoid matching "/:/" and stuff like that.  Embellish as needed.

(Oh, and and I've added a `delete-annotation' to delete any old
smileys.)

;;
;; comments go here.
;;

;;; Test smileys:  :-] :-o :-) ;-) :-< :-d :-P 8-| :-(

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

(require 'cl)

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

(defvar smiley-regexp-alist '((":-*\\]" 0 "FaceGrinning.xpm")
			      (":-*[oO]" 0 "FaceStartled.xpm")
			      (":-*[)>]" 0 "FaceHappy.xpm")
			      (";-*[>)]" 0 "FaceWinking.xpm")
			      (":-[/\\]" 0 "FaceIronic.xpm")
			      (":-*|" 0 "FaceStraight.xpm")
			      (":-*<" 0 "FaceAngry.xpm")
			      (":-*d" 0 "FaceTasty.xpm")
			      (":-*[pP]" 0 "FaceYukky.xpm")
			      ("8-*|" 0 "FaceKOed.xpm")
			      (":-*(" 0 "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-region (beg end)
  "Smilify the region between point and mark."
  (interactive "r")
  (smiley-buffer (current-buffer) beg end))

(defun smiley-buffer (&optional buffer st nd)
  (interactive)
  (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)
	      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)))
	    (if glyph
		(progn 
		  (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)
		  (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)