riece-avatar.el

;;; riece-avatar.el --- insert external icon to IRC buffers

;; Copyright (C) 2009  Iwata

;; Author: Iwata <iratqq@gmail.com>
;; Keywords: IRC, riece

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.	If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;;; Code:

(require 'riece-message)

(defconst riece-avatar-description
  "Display icon in xmpp buffers.")

(defvar riece-avatar-icon-path-alist nil)

(defun riece-avatar-filename (user)
  (let ((string user))
    (while (string-match "[\\./ -]" string)
      (setq string (replace-match "_" nil nil string)))
    string))

(defun riece-avatar-update-buffer (start end)
  (goto-char start)
  (while (re-search-forward
	  ;; XXX: assume bitlbee format
	  "^\\([0-9][0-9]:[0-9][0-9]\\) =\\([a-zA-Z0-9._-]+\\)= \\(<\\)?\\([a-zA-Z0-9._-]+\\)\\(>\\)?:?"
	  end t)
    (let* ((time (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
	   (chan (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
	   (name (buffer-substring-no-properties (match-beginning 4) (match-end 3)))
	   (pixmap-path (assoc-default chan riece-avatar-icon-path-alist)))
      (if pixmap-path
	  (progn
	    (let* ((icon-basename (concat pixmap-path "/" name))
		   (icon-files
		    (directory-files pixmap-path t (concat "^" name "\\."))))
	      (if icon-files
		  (progn
		    (delete-region (match-beginning 0) (match-end 0))
		    (goto-char (match-beginning 0))
		    (insert-image
		     (create-image (car icon-files) nil nil :ascent 100))
		    (insert (format " [%s] %s: " time name))
		    ))))))))

(defun riece-avatar-insinuate ()
  (add-hook 'riece-after-insert-functions
            'riece-avatar-update-buffer))

(defun riece-avatar-uninstall ()
  (remove-hook 'riece-after-insert-functions
               'riece-avatar-update-buffer))


(provide 'riece-avatar)
;;; riece-avatar.el ends here