Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 541b63dcbb
Fetching contributors…

Cannot retrieve contributors at this time

file 150 lines (129 sloc) 5.939 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150
;;; erc-highlight-nicknames.el --- Highlights nicknames

;; Copyright (C) 2007 André Riemann
;; Copyright (C) 2008 Andy Stewart

;; Author: André Riemann <andre.riemann@web.de>
;; Maintainer: André Riemann <andre.riemann@web.de>
;; Created: 2007-09-25
;; Keywords: comm, faces

;; URL: http://www.emacswiki.org/cgi-bin/wiki/ErcHighlightNicknames
;; Compatibility: tested with
;; * GNU Emacs 23.0 (Erc 5.2, 5.3)
;; * XEmacs 21.4 (Erc 5.1) (briefly)
;; Version: 0.4.1
;; Last-Updated: 2008-12-07
;; By: Andy Stewart

;; 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 2, 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:
;; To activate this module, put this in your init file
;; (require 'erc-highlight-nicknames)
;; and add highlight-nicknames to `erc-modules' by customizing it.

;; Or put this in your init file
;; (and
;; (load-library "erc-highlight-nicknames")
;; (add-to-list 'erc-modules 'highlight-nicknames)
;; (erc-update-modules))

;; Press
;; M-x customize-face RET erc-highlight-nick-base-face RET
;; to customize the face that will be added before the color, if you want
;; for example all the nicks underlined.

;;; Change Log:
;; 2008-12-07 Andy Stewart
;; * There was a bug that function `erc-highlight-nicknames' created
;; many faces for the same nickname. It would create a new one when
;; erc inserts text, and didn't care whether a face already existed
;; for this nickname.
;; Now I added a hash table `erc-highlight-face-table' to save the
;; face for a nickname. Faces are now only created, if the nickname
;; doesn't occur in the hash table.
;; 2007-12-24 andre-r
;; * bug fixed in invert-color where color code contained spaces instead
;; of leading zeros
;; 2007-12-12 andre-r
;; * erc-highlight-nick-base-face is by default empty now,
;; not inherited from `default'
;; * erc-button-add-face instead of put-text-property
;; * using `x-color-values' instead of `color-values' since XEmacs
;; seams to only know the former
;; 2007-12-12 andre-r
;; * built in XEmacs-compatible code for text properties by Dave Marquardt
;; (works both in Emacs and XEmacs)
;; * changed it a bit so that the face for the text property is derived
;; from another face (hopefully it still works with XEmacs)
;; * for that purpose created a new, customizable face
;; 2007-09-25 andre-r
;; * inital release

;; This file is *NOT* part of GNU Emacs.

;;; Code:

(require 'erc)
(require 'erc-button)

(defface erc-highlight-nick-base-face
  '((t nil))
  "Base face used for highlighting nicks in erc. (Before the nick
color is added)"
  :group 'erc-faces)

(defvar erc-highlight-face-table
  (make-hash-table :test 'equal)
  "The hash table that contains unique erc nickname faces.")

(defun hexcolor-luminance (color)
  "Returns the luminance of color COLOR. COLOR is a string \(e.g.
\"#ffaa00\", \"blue\"\) `color-values' accepts. Luminance is a
value of 0.299 red + 0.587 green + 0.114 blue and is always
between 0 and 255."
  (let* ((values (x-color-values color))
         (r (car values))
         (g (car (cdr values)))
         (b (car (cdr (cdr values)))))
    (floor (+ (* 0.299 r) (* 0.587 g) (* 0.114 b)) 256)))

(defun invert-color (color)
  "Returns the inverted color of COLOR."
  (let* ((values (x-color-values color))
         (r (car values))
         (g (car (cdr values)))
         (b (car (cdr (cdr values)))))
    (format "#%04x%04x%04x"
            (- 65535 r) (- 65535 g) (- 65535 b))))

;;;###autoload
(defun erc-highlight-nicknames ()
  "Searches for nicknames and highlights them. Uses the first
twelve digits of the MD5 message digest of the nickname as
color (#rrrrggggbbbb)."
  (with-syntax-table erc-button-syntax-table
    (let (bounds word color new-nick-face)
      (goto-char (point-min))
      (while (re-search-forward "\\w+" nil t)
        (setq bounds (bounds-of-thing-at-point 'word))
        (setq word (buffer-substring-no-properties
                    (car bounds) (cdr bounds)))
        (when (erc-get-server-user word)
          (setq new-nick-face (gethash word erc-highlight-face-table))
          (unless new-nick-face
            (setq color (concat "#" (substring (md5 (downcase word)) 0 12)))
            (if (equal (cdr (assoc 'background-mode (frame-parameters))) 'dark)
                ;; if too dark for background
                (when (< (hexcolor-luminance color) 85)
                  (setq color (invert-color color)))
              ;; if to bright for background
              (when (> (hexcolor-luminance color) 170)
                (setq color (invert-color color))))
            (setq new-nick-face (make-symbol (concat "erc-highlight-nick-" word "-face")))
            (copy-face 'erc-highlight-nick-base-face new-nick-face)
            (set-face-foreground new-nick-face color)
            (puthash word new-nick-face erc-highlight-face-table))
          (erc-button-add-face (car bounds) (cdr bounds) new-nick-face))))))

(define-erc-module highlight-nicknames nil
  "Search through the buffer for nicknames, and highlight."
  ((add-hook 'erc-insert-modify-hook 'erc-highlight-nicknames t))
  ((remove-hook 'erc-insert-modify-hook 'erc-highlight-nicknames)))

(provide 'erc-highlight-nicknames)

;;; erc-highlight-nicknames.el ends here
Something went wrong with that request. Please try again.