circe colors

circe-color-nicks-f.el

;;; circe-color-nicks-f.el --- Color nicks in the channel

;; Copyright (C) 2012  Taylan Ulrich Bayırlı/Kammer

;; Author: Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>

;; This file is part of Circe.

;; This program 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 2
;; of the License, or (at your option) any later version.

;; This program 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 this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
;; 02110-1301  USA

;;; Commentary:

;; This Circe module adds the ability to assign a color to each
;; nick in a channel.

;; Some ideas/code copied from rcirc-colors.el.

;; To use it, put the following into your .emacs:

;; (require 'circe-color-nicks-f)
;; (enable-circe-color-nicks-f)

;;; Code:

(require 'circe)

;;;###autoload
(defun enable-circe-color-nicks-f ()
  "Enable the Color Nicks module for Circe.
This module colors all encountered nicks in a cross-server fashion."
  (interactive)
  (dolist (buf (buffer-list))
    (with-current-buffer buf
      (when (eq major-mode 'circe-channel-mode)
        (add-circe-color-nicks-f))))
  (add-hook 'circe-channel-mode-hook
            'add-circe-color-nicks-f))

(defun disable-circe-color-nicks-f ()
  "Disable the Color Nicks module for Circe.
See `enable-circe-color-nicks-f'."
  (interactive)
  (dolist (buf (buffer-list))
    (with-current-buffer buf
      (when (eq major-mode 'circe-channel-mode)
        (remove-circe-color-nicks-f))))
  (remove-hook 'circe-channel-mode-hook
               'add-circe-color-nicks-f))

(defun add-circe-color-nicks-f ()
  "Add `circe-color-nicks-f' to `lui-pre-output-hook'."
  (add-hook 'lui-pre-output-hook 'circe-color-nicks-f))

(defun remove-circe-color-nicks-f ()
  "Remove `circe-color-nicks-f' from `lui-pre-output-hook'."
  (remove-hook 'lui-pre-output-hook 'circe-color-nicks-f))

(defmacro circe-unpack-color (color red green blue &rest body)
  `(let ((,red   (car ,color))
         (,green (car (cdr ,color)))
         (,blue  (car (cddr ,color))))
     ,@body))

(defun circe-rgb-to-html (color)
  (concat "#" (eval `(format "%02x%02x%02x" ,@color))))

(defun circe-hexcolor-luminance (color)
  (my-unpack-color color red green blue
   (floor (+ (* 0.299 red) (* 0.587 green) (* 0.114 blue)))))

(defun circe-invert-color (color)
  (mapcar (lambda (comp) (- 255 comp)) color))

(defun circe-get-color-for-nick (nick &optional dark)
  (let* ((hash   (md5 nick))
         (red    (mod (string-to-number (substring hash 0 10) 16) 256))
         (blue   (mod (string-to-number (substring hash 10 20) 16) 256))
         (green  (mod (string-to-number (substring hash 20 30) 16) 256))
         (color `(,red ,green ,blue)))
    (my-rgb-to-html (if (if dark (< (my-hexcolor-luminance color) 85)
                       (> (my-hexcolor-luminance color) 170))
                     (my-invert-color color)
                   color))))

(defcustom circe-color-nicks-f-everywhere nil
  "Whether nicks should be colored in message bodies too."
  :group 'circe)

(defun circe-color-nicks-f ()
  "Color nicks on this lui output line."
  (when (eq major-mode 'circe-channel-mode)
    (let ((nickstart (text-property-any (point-min) (point-max)
                                        'lui-format-argument 'nick)))
      (when nickstart
        (goto-char nickstart)
        (let* ((nickend (next-property-change nickstart))
               (nick (buffer-substring-no-properties nickstart nickend)))
          (when (not (circe-server-my-nick-p nick))
            (let ((color (circe-get-color-for-nick nick)))
              (put-text-property nickstart nickend 'face `(:foreground ,color)))))))
    (when circe-color-nicks-f-everywhere
      (let ((body (text-property-any (point-min) (point-max)
                                     'lui-format-argument 'body))
            (nicks '())
            (regex nil))
        (when body
          (when circe-channel-users
            (maphash (lambda (nick _)
                       (when (not (circe-server-my-nick-p nick))
                         (setq nicks (cons nick nicks))))
                     circe-channel-users))
          (setq regex (regexp-opt nicks 'words))
          (goto-char body)
          (while (re-search-forward regex nil t)
            (put-text-property
             (match-beginning 0) (match-end 0)
             'face `(:foreground
                     ,(circe-get-color-for-nick (match-string-no-properties 0))))))))))

(provide 'circe-color-nicks-f)
;;; circe-color-nicks-f.el ends here