colorz

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))

(defsubst circe-w3-contrast-c-to-l (c)
  (if (<= c 0.03928)
      (/ c 12.92)
    (expt (/ (+ c 0.055) 1.055) 2.4)))

(defsubst circe-w3-contrast-relative-luminance (rgb)
  (apply '+
         (cl-mapcar (lambda (color coefficient)
                      (* coefficient
                         (circe-w3-contrast-c-to-l color)))
                    rgb
                    '(0.2126 0.7152 0.0722))))

(defsubst circe-w3-contrast-contrast-ratio (color1 color2)
  (let ((l1 (+ 0.05 (circe-w3-contrast-relative-luminance color1)))
        (l2 (+ 0.05 (circe-w3-contrast-relative-luminance color2))))
    (if (> l1 l2)
        (/ l1 l2)
        (/ l2 l1))))

(defsubst circe-w3-contrast-l-to-c (m)
  (if (<= m (/ 0.03928 12.92))
      (* m 12.92)
      (- (* (expt m (/ 1 2.4))
            1.055)
         0.055)))

(defsubst circe-w3-contrast-nn (n)
  (cond ((< n 0) 0)
        ((> n 1) 1)
        (t n)))

(defsubst circe-w3-contrast-color-with-luminance-higher-than (N randR randG randB)
  (let* ((Rc 0.2126)
         (Gc 0.7152)
         (Bc 0.0722)

         (R-min-lum (circe-w3-contrast-nn (/ (- N Gc Bc) Rc)))
         (R-min-color (circe-w3-contrast-l-to-c R-min-lum))
         (R-color (+ R-min-color (* randR)))
         (R-lum (* Rc (circe-w3-contrast-c-to-l R-color)))

         (G-min-lum (circe-w3-contrast-nn (/ (- N R-lum Bc) Gc)))
         (G-min-color (circe-w3-contrast-l-to-c G-min-lum))
         (G-color (+ G-min-color (* randG)))
         (G-lum (* Gc (circe-w3-contrast-c-to-l G-color)))

         (B-min-lum (circe-w3-contrast-nn (/ (- N R-lum G-lum) Bc)))
         (B-min-color (circe-w3-contrast-l-to-c B-min-lum))
         (B-color (+ B-min-color (* randB)))
         (B-lum (* Bc (circe-w3-contrast-c-to-l B-color))))
    (list R-color G-color B-color)))

(defsubst circe-w3-contrast-color-with-luminance-lower-than (N randR randG randB)
  (let* ((Rc 0.2126)
         (Gc 0.7152)
         (Bc 0.0722)

         (R-max-lum (circe-w3-contrast-nn (/ N Rc)))
         (R-max-color (circe-w3-contrast-l-to-c R-max-lum))
         (R-color (* R-max-color randR))
         (R-lum (* Rc (circe-w3-contrast-c-to-l R-color)))

         (G-max-lum (circe-w3-contrast-nn (/ (- N R-lum) Gc)))
         (G-max-color (circe-w3-contrast-l-to-c G-max-lum))
         (G-color (* G-max-color randG))
         (G-lum (* Gc (circe-w3-contrast-c-to-l G-color)))

         (B-max-lum (circe-w3-contrast-nn (/ (- N R-lum G-lum) Bc)))
         (B-max-color (circe-w3-contrast-l-to-c B-max-lum))
         (B-color (* B-max-color randB))
         (B-lum (* Bc (circe-w3-contrast-c-to-l B-color))))
    (list R-color G-color B-color)))

(defsubst circe-w3-contrast-generate-contrast-color (red blue green color ratio)
  (let ((color-lum (circe-w3-contrast-relative-luminance color)))
    (if (< color-lum (- (/ 1.0 ratio) 0.05))
        (circe-w3-contrast-color-with-luminance-higher-than (+ (* (+ color-lum 0.05) ratio) 0.05) red blue green)
        (circe-w3-contrast-color-with-luminance-lower-than (- (/ (+ color-lum 0.05) ratio) 0.05) red blue green))))

(defsubst circe-scale-hash-substr (n)
  (/ n 1099511627775.0))

(defsubst circe-color-from-values (values)
  (apply 'concat
         (cons "#"
               (mapcar (lambda (val)
                         (format "%02x"
                                 (* (cond ((< val 0) 0)
                                          ((> val 1) 1)
                                          (t val))
                                    255)))
                       values))))

(defun circe-get-color-for-nick (nick)
  (let* ((hash   (md5 nick))
         (red    (circe-scale-hash-substr (string-to-number (substring hash 0 10) 16)))
         (blue   (circe-scale-hash-substr (string-to-number (substring hash 10 20) 16)))
         (green  (circe-scale-hash-substr (string-to-number (substring hash 20 30) 16)))
         (color `(,red ,green ,blue)))
    (circe-color-from-values
     (circe-w3-contrast-generate-contrast-color red blue green
                                                (mapcar (lambda (x) (/ x 65535.0))
                                                        (color-values (face-background 'default)))
                                                7))))

(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