├── .gitignore ├── readme.org └── erc-hl-nicks.el /.gitignore: -------------------------------------------------------------------------------- 1 | *.elc 2 | -------------------------------------------------------------------------------- /readme.org: -------------------------------------------------------------------------------- 1 | * NOTICE 2 | 3 | *As of July 2023, [[https://github.com/leathekd/erc-hl-nicks/issues/15][erc-hl-nicks is now a part of ERC]]*! 4 | 5 | It won't be released bundled with Emacs until version 30.1 but is already in ERC 6 | available on the Emacs [[https://elpa.gnu.org/packages/erc.html][GNU ELPA]] repository. 7 | 8 | This repo should be considered depricated and will be archived once 9 | the next version of ERC is released with Emacs but will be kept "live" 10 | for now so the Melpa package isn't accidentally removed before the 11 | new version is released. 12 | 13 | - [[https://git.savannah.gnu.org/cgit/emacs.git/tree/etc/ERC-NEWS?id=9bdc5c62#n33][ERC news]] 14 | - [[https://git.savannah.gnu.org/cgit/emacs.git/tree/lisp/erc/erc-nicks.el?id=9bdc5c62][New implementation]] 15 | 16 | Please don't report issues here for the new version and instead follow the instructions at 17 | [[https://www.gnu.org/software/emacs/manual/html_node/erc/Getting-Help-and-Reporting-Bugs.html][Getting Help and Reporting Bugs]] 18 | in the ERC manual. 19 | 20 | 21 | 22 | * erc-hl-nicks - ERC Module to Highlight Nicknames 23 | 24 | ** I already have a nickname highlighter, why should I switch? 25 | If you're happy with what you're using, you shouldn't. (If it ain't 26 | broke...) BUT, if you are interested in trying something new, here 27 | are some things you should know: 28 | - erc-hl-nicks is based on erc-highlight-nicknames, so it will auto 29 | colorize nicknames (you don't have to specify colors) 30 | - erc-hl-nicks will ignore certain characters that IRC clients add to 31 | nicknames to avoid duplicates (nickname, nickname', nickname'', 32 | etc.) 33 | - erc-hl-nicks can attempt to produce colors with a sufficient amount 34 | of contrast between the nick color and the background color. 35 | 36 | ** Installation 37 | *** Via Package (recommended) 38 | Pick your favorite package archive- I do try to keep this package 39 | up-to-date on Marmalade and it is also available via Mepla and 40 | Melpa-stable. 41 | 42 | #+BEGIN_EXAMPLE 43 | (require 'package) 44 | 45 | (add-to-list 'package-archives 46 | '("melpa" . "http://melpa.org/packages/") t) 47 | 48 | ;; Either of these will work, as well. 49 | 50 | ;; (add-to-list 'package-archives 51 | ;; '("marmalade" . "http://marmalade-repo.org/packages/") t) 52 | 53 | ;; (add-to-list 'package-archives 54 | ;; '("melpa-stable" . "http://stable.melpa.org/packages/") t) 55 | 56 | (package-initialize) 57 | #+END_EXAMPLE 58 | 59 | Then you can install it: 60 | 61 | #+BEGIN_EXAMPLE 62 | M-x package-refresh-contents 63 | M-x package-install RET erc-hl-nicks RET 64 | #+END_EXAMPLE 65 | 66 | *** Manually (via git) 67 | Download the source or clone the repo and add the following 68 | to ~/.emacs.d/init.el: 69 | 70 | #+BEGIN_EXAMPLE 71 | (add-to-list 'load-path "path/to/erc-hl-nicks") 72 | (require 'erc-hl-nicks) 73 | #+END_EXAMPLE 74 | -------------------------------------------------------------------------------- /erc-hl-nicks.el: -------------------------------------------------------------------------------- 1 | ;;; erc-hl-nicks.el --- ERC nick highlighter that ignores uniquifying chars when colorizing 2 | 3 | ;; Copyright (C) 2011-2013 David Leatherman 4 | 5 | ;; Author: David Leatherman 6 | ;; Deprecated-since: 30.1 7 | ;; URL: http://www.github.com/leathekd/erc-hl-nicks 8 | ;; Version: 1.3.5 9 | 10 | ;; This file is not part of GNU Emacs. 11 | 12 | ;;; Commentary: 13 | 14 | ;; This package is now a part of Emacs. This version is considered 15 | ;; deprecated. Please use the `nicks' module in ERC 5.6+. See the 16 | ;; README from the repo for more information. 17 | 18 | ;; This file was originally erc-highlight-nicknames. It was modified 19 | ;; to optionally ignore the uniquifying characters that IRC clients 20 | ;; add to nicknames 21 | 22 | ;; History 23 | 24 | ;; 1.3.5 25 | ;; 26 | ;; - Mark this package as obsolete now that it's part of Emacs. 27 | ;; Thanks all! 28 | 29 | ;; 1.3.4 30 | ;; 31 | ;; - Pull request #13 - `erc-hl-nicks-refresh-colors' to refresh faces 32 | ;; Thanks thblt! 33 | 34 | ;; 1.3.3 35 | ;; 36 | ;; - Pull request #9 - switch from cl to cl-lib 37 | ;; Thanks jgkamat! 38 | 39 | ;; 1.3.2 40 | ;; 41 | ;; - Pull request #6 - handle when `word-at-point' is nil 42 | ;; Thanks alezost! 43 | ;; 44 | ;; - Pull request #7 - remove the list membership check on autoload 45 | ;; Thanks albertodonato! 46 | 47 | ;; 1.3.1 48 | ;; 49 | ;; - Fix a require issue 50 | 51 | ;; 1.3.0 (was uploaded as 1.2.4, accidentally) 52 | ;; 53 | ;; - Fix autoloads - erc-hl-nicks should require itself as needed 54 | ;; 55 | ;; - reset face table is now interactive 56 | ;; 57 | ;; - reworked how colors are chosen (should continue to work the same 58 | ;; for everyone, though). See `erc-hl-nicks-color-contrast-strategy' 59 | ;; for details. 60 | ;; 61 | ;; - Added `erc-hl-nicks-bg-color' to allow terminal users to specify 62 | ;; their background colors 63 | ;; 64 | ;; - Added `erc-hl-nicks-alias-nick' to allow setting up several nicks 65 | ;; to use the same color 66 | ;; 67 | ;; - Added `erc-hl-nicks-force-nick-face' to force a nick to use a 68 | ;; specific color 69 | 70 | ;; 1.2.3 - Updated copyright date 71 | ;; 72 | ;; - Updated some formatting 73 | ;; 74 | ;; - added highlighting on erc-send-modify-hook 75 | 76 | ;; 1.2.2 - Added dash to the list of characters to ignore 77 | ;; 78 | ;; - Fixed an issue where timestamps could prevent highlighting 79 | ;; from occurring 80 | 81 | ;; 1.2.1 - Remove accidental use of 'some' which comes from cl 82 | 83 | ;; 1.2.0 - Added erc-hl-nicks-skip-nicks to give a way to prevent 84 | ;; certain nicks from being highlighted. 85 | ;; 86 | ;; - Added erc-hl-nicks-skip-faces to give a way to prevent 87 | ;; highlighting over other faces. Defaults to: 88 | ;; (erc-notice-face erc-fool-face erc-pal-face) 89 | 90 | ;; 1.1.0 - Remove use of cl package (was using 'reduce'). 91 | ;; 92 | ;; - The hook is called with a narrowed buffer, so it makes 93 | ;; more sense to iterate over each word, one by one. This 94 | ;; is more efficient and has a secondary benefit of fixing a 95 | ;; case issue. 96 | ;; 97 | ;; - Added an option to not highlight fools 98 | 99 | ;; 1.0.4 - Use erc-channel-users instead of erc-server-users 100 | ;; 101 | ;; - Ignore leading characters, too. 102 | 103 | ;; 1.0.3 - Was finding but not highlighting nicks with differing 104 | ;; cases. Fixed. Ignore leading characters, too. Doc changes. 105 | 106 | ;; 1.0.2 - Fixed a recur issue, prevented another, and fixed a 107 | ;; spelling issue. 108 | 109 | ;; 1.0.1 - tweaked so that the re-search will pick up instances of the 110 | ;; trimmed nick, settled on 'nick' as the variable name 111 | ;; instead of kw, keyword, word, etc 112 | 113 | ;; 1.0.0 - initial release 114 | 115 | ;;; License: 116 | 117 | ;; This program is free software; you can redistribute it and/or 118 | ;; modify it under the terms of the GNU General Public License 119 | ;; as published by the Free Software Foundation; either version 3 120 | ;; of the License, or (at your option) any later version. 121 | ;; 122 | ;; This program is distributed in the hope that it will be useful, 123 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 124 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 125 | ;; GNU General Public License for more details. 126 | ;; 127 | ;; You should have received a copy of the GNU General Public License 128 | ;; along with GNU Emacs; see the file COPYING. If not, write to the 129 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 130 | ;; Boston, MA 02110-1301, USA. 131 | 132 | ;;; Code: 133 | (require 'erc) 134 | (require 'erc-button) 135 | (require 'cl-lib) 136 | (require 'color) 137 | 138 | (defgroup erc-hl-nicks nil 139 | "Highlighting nicknames in erc buffers" 140 | :group 'erc) 141 | 142 | (defcustom erc-hl-nicks-trim-nick-for-face t 143 | "Ignore some characters when determining nick face" 144 | :group 'erc-hl-nicks 145 | :type 'boolean) 146 | 147 | (defcustom erc-hl-nicks-ignore-chars ",`'_-" 148 | "Characters at the end of a nick to ignore while highlighting" 149 | :group 'erc-hl-nicks 150 | :type 'string) 151 | 152 | (defcustom erc-hl-nicks-skip-nicks nil 153 | "Nicks to skip when highlighting" 154 | :group 'erc-hl-nicks 155 | :type '(repeat string)) 156 | 157 | (defcustom erc-hl-nicks-skip-faces 158 | '("erc-notice-face" "erc-pal-face" "erc-fool-face") 159 | "Faces to avoid overriding when highlighting" 160 | :group 'erc-hl-nicks 161 | :type '(repeat string)) 162 | 163 | (defface erc-hl-nicks-nick-base-face 164 | '((t nil)) 165 | "Base face used for highlighting nicks. (Before the nick 166 | color is added)" 167 | :group 'erc-hl-nicks) 168 | 169 | (defvar erc-hl-nicks-minimum-luminence 85 170 | "The threshold to invert when the background-mode is dark") 171 | 172 | (defvar erc-hl-nicks-maximum-luminence 170 173 | "The threshold to invert when the background-mode is light") 174 | 175 | (defvar erc-hl-nicks-bg-color (cdr (assoc 'background-color (frame-parameters))) 176 | "The background color to use when calculating the contrast. This var is 177 | exposed so it can be manually set in the case of terminal emacs (which doesn't 178 | necessarily know the bg color).") 179 | 180 | (defvar erc-hl-nicks-minimum-contrast-ratio 3.5 181 | "The amount of contrast desired between the buffer background color 182 | and the foreground color chosen by erc-hl-nicks. The higher the 183 | number the greater the contrast. A high number on a dark background 184 | would make all of the nicks appear in pastel/washed-out colors while 185 | on a dark background they may appear close to black. Somewhere 186 | between 3.0 and 4.5 seems to be the sweet spot.") 187 | 188 | (defvar erc-hl-nicks-color-contrast-strategies 189 | '((invert . erc-hl-nicks-invert-for-visibility) 190 | (contrast . erc-hl-nicks-fix-color-contrast)) 191 | "An alist of strategies available and their functions: 192 | 193 | 'invert - if the color is too dark/light to be seen based on the 194 | bg-mode (dark or light) of the frame, simply invert the color. 195 | 196 | 'contrast - attempt to achieve a decent contrast ratio (specified by 197 | `erc-hl-nicks-minimum-contrast-ratio') by brightening or darkening 198 | the color") 199 | 200 | (defvar erc-hl-nicks-color-contrast-strategy 'invert 201 | "How should erc-hl-nicks attempt to make the nick colors visible? 202 | The options are listed in `erc-hl-nicks-color-contrast-strategies' 203 | 204 | This option can be a list and will be applied in the order defined. 205 | That is, '(invert contrast) will invert as needed and then adjust 206 | the color as needed.") 207 | 208 | (defvar erc-hl-nicks-face-table 209 | (make-hash-table :test 'equal) 210 | "The hash table that contains unique nick faces.") 211 | 212 | ;; for debugging 213 | (defun erc-hl-nicks-reset-face-table () 214 | (interactive) 215 | (setq erc-hl-nicks-face-table 216 | (make-hash-table :test 'equal))) 217 | 218 | (defun erc-hl-nicks-hexcolor-luminance (color) 219 | "Returns the luminance of color COLOR. COLOR is a string \(e.g. 220 | \"#ffaa00\", \"blue\"\) `color-values' accepts. Luminance is a 221 | value of 0.299 red + 0.587 green + 0.114 blue and is always 222 | between 0 and 255." 223 | (let* ((values (x-color-values color)) 224 | (r (car values)) 225 | (g (car (cdr values))) 226 | (b (car (cdr (cdr values))))) 227 | (floor (+ (* 0.299 r) (* 0.587 g) (* 0.114 b)) 256))) 228 | 229 | (defun erc-hl-nicks-invert-color (color) 230 | "Returns the inverted color of COLOR." 231 | (let* ((values (x-color-values color)) 232 | (r (car values)) 233 | (g (car (cdr values))) 234 | (b (car (cdr (cdr values))))) 235 | (format "#%04x%04x%04x" 236 | (- 65535 r) (- 65535 g) (- 65535 b)))) 237 | 238 | (defun erc-hl-nicks-trim-irc-nick (nick) 239 | "Removes instances of erc-hl-nicks-ignore-chars from both sides of NICK" 240 | (let ((stripped (replace-regexp-in-string 241 | (format "\\([%s]\\)+$" erc-hl-nicks-ignore-chars) 242 | "" nick))) 243 | (replace-regexp-in-string 244 | (format "^\\([%s]\\)+" erc-hl-nicks-ignore-chars) 245 | "" stripped))) 246 | 247 | (defun erc-hl-nicks-brightness-contrast (c1 c2) 248 | "Determines the amount of contrast between C1 and C2" 249 | (let* ((l1 (erc-hl-nicks-hexcolor-luminance c1)) 250 | (l2 (erc-hl-nicks-hexcolor-luminance c2)) 251 | (d (if (< l1 l2) l1 l2)) 252 | (b (if (equal d l1) l2 l1))) 253 | (/ (+ 0.05 b) (+ 0.05 d)))) 254 | 255 | (defun erc-hl-nicks-fix-color-contrast (color) 256 | "Adjusts COLOR by blending it with white or black, based on 257 | background-mode until there is enough contrast between COLOR and 258 | the background color. See `erc-hl-nicks-minimum-contrast-ratio' to 259 | adjust how far to blend the color." 260 | (if (and erc-hl-nicks-minimum-contrast-ratio 261 | (< 0 erc-hl-nicks-minimum-contrast-ratio)) 262 | (cl-some 263 | (lambda (c) 264 | (let ((hex (color-rgb-to-hex (nth 0 c) (nth 1 c) (nth 2 c)))) 265 | (when (> (erc-hl-nicks-brightness-contrast erc-hl-nicks-bg-color hex) 266 | erc-hl-nicks-minimum-contrast-ratio) 267 | hex))) 268 | (let ((bg-mode (cdr (assoc 'background-mode (frame-parameters))))) 269 | (color-gradient 270 | (color-name-to-rgb color) 271 | (color-name-to-rgb 272 | (if (equal 'dark bg-mode) "white" "black")) 273 | 512))) 274 | color)) 275 | 276 | (defun erc-hl-nicks-invert-for-visibility (color) 277 | "Inverts the given color based on luminence and background-mode 278 | (dark or light)." 279 | (let ((bg-mode (cdr (assoc 'background-mode (frame-parameters))))) 280 | (cond 281 | ((and (equal 'dark bg-mode) 282 | (< (erc-hl-nicks-hexcolor-luminance color) 283 | erc-hl-nicks-minimum-luminence)) 284 | (erc-hl-nicks-invert-color color)) 285 | ((and (equal 'light bg-mode) 286 | (> (erc-hl-nicks-hexcolor-luminance color) 287 | erc-hl-nicks-maximum-luminence)) 288 | (erc-hl-nicks-invert-color color)) 289 | (t color)))) 290 | 291 | (defun erc-hl-nicks-color-for-nick (nick) 292 | "Get the color to use for the given nick by calculating the color 293 | and applying the contrast strategies to it." 294 | (let ((color (concat "#" (substring (md5 (downcase nick)) 0 12)))) 295 | (cl-reduce 296 | (lambda (color strategy) 297 | (let ((fn (cdr (assq strategy erc-hl-nicks-color-contrast-strategies)))) 298 | (if fn 299 | (funcall fn color) 300 | color))) 301 | (erc-hl-nicks-ensure-list erc-hl-nicks-color-contrast-strategy) 302 | :initial-value color))) 303 | 304 | (defun erc-hl-nicks-face-name (nick) 305 | (make-symbol (concat "erc-hl-nicks-nick-" nick "-face"))) 306 | 307 | (defun erc-hl-nicks-make-face (nick) 308 | "Create and cache a new face for the given nick" 309 | (or (gethash nick erc-hl-nicks-face-table) 310 | (let ((color (erc-hl-nicks-color-for-nick nick)) 311 | (new-nick-face (erc-hl-nicks-face-name nick))) 312 | (copy-face 'erc-hl-nicks-nick-base-face new-nick-face) 313 | (set-face-foreground new-nick-face color) 314 | (puthash nick new-nick-face erc-hl-nicks-face-table)))) 315 | 316 | (defun erc-hl-nicks-ensure-list (maybe-list) 317 | (if (listp maybe-list) 318 | maybe-list 319 | (list maybe-list))) 320 | 321 | (defun erc-hl-nicks-has-skip-face-p (pt) 322 | (remq nil (mapcar (lambda (face) 323 | (member (symbol-name face) erc-hl-nicks-skip-faces)) 324 | (erc-hl-nicks-ensure-list 325 | (get-text-property pt 'face))))) 326 | 327 | (defun erc-hl-nicks-highlight-p (nick trimmed bounds) 328 | (and erc-channel-users 329 | (erc-get-channel-user nick) 330 | (not (member trimmed erc-hl-nicks-skip-nicks)) 331 | (not (erc-hl-nicks-has-skip-face-p (car bounds))))) 332 | 333 | ;;;###autoload 334 | (defun erc-hl-nicks-force-nick-face (nick color) 335 | "Force nick highlighting to be a certain color for a nick. Both NICK and COLOR 336 | should be strings." 337 | (let ((new-nick-face (erc-hl-nicks-face-name nick))) 338 | (copy-face 'erc-hl-nicks-nick-base-face new-nick-face) 339 | (set-face-foreground new-nick-face color) 340 | (puthash nick new-nick-face erc-hl-nicks-face-table))) 341 | 342 | ;;;###autoload 343 | (defun erc-hl-nicks-alias-nick (nick &rest nick-aliases) 344 | "Manually handle the really wacked out nickname transformations." 345 | (erc-hl-nicks-make-face nick) 346 | (let ((nick-face (gethash nick erc-hl-nicks-face-table))) 347 | (dolist (nick-alias nick-aliases) 348 | (puthash nick-alias nick-face erc-hl-nicks-face-table)))) 349 | 350 | ;;;###autoload 351 | (defun erc-hl-nicks () 352 | "Retrieves a list of usernames from the server and highlights them" 353 | (declare (obsolete "use the `nicks' module in ERC 5.6+ instead." "30.1")) 354 | (save-excursion 355 | (with-syntax-table erc-button-syntax-table 356 | (let ((inhibit-field-text-motion t)) 357 | (goto-char (point-min)) 358 | (while (forward-word 1) 359 | (let ((word (word-at-point))) 360 | (when word 361 | (let ((trimmed (erc-hl-nicks-trim-irc-nick word)) 362 | (bounds (bounds-of-thing-at-point 'word)) 363 | (inhibit-read-only t)) 364 | (when (erc-hl-nicks-highlight-p word trimmed bounds) 365 | (erc-button-add-face (car bounds) (cdr bounds) 366 | (erc-hl-nicks-make-face trimmed))))))))))) 367 | 368 | (defun erc-hl-nicks-refresh-colors () 369 | "Recompute color for all nicks." 370 | (interactive) 371 | (save-excursion 372 | (dolist (nick (hash-table-keys erc-hl-nicks-face-table)) 373 | (set-face-foreground (gethash nick erc-hl-nicks-face-table) (erc-hl-nicks-color-for-nick nick))))) 374 | 375 | (defun erc-hl-nicks-fix-hook-order (&rest _) 376 | (remove-hook 'erc-insert-modify-hook 'erc-hl-nicks) 377 | (add-hook 'erc-insert-modify-hook 'erc-hl-nicks t) 378 | (remove-hook 'erc-send-modify-hook 'erc-hl-nicks) 379 | (add-hook 'erc-send-modify-hook 'erc-hl-nicks t)) 380 | 381 | (define-erc-module hl-nicks nil 382 | "Highlight usernames in the buffer" 383 | ((add-hook 'erc-insert-modify-hook 'erc-hl-nicks t) 384 | (add-hook 'erc-send-modify-hook 'erc-hl-nicks t) 385 | (add-hook 'erc-connect-pre-hook 'erc-hl-nicks-fix-hook-order t)) 386 | ((remove-hook 'erc-insert-modify-hook 'erc-hl-nicks) 387 | (remove-hook 'erc-send-modify-hook 'erc-hl-nicks) 388 | (remove-hook 'erc-connect-pre-hook 'erc-hl-nicks-fix-hook-order))) 389 | 390 | ;; For first time use 391 | ;;;###autoload 392 | (when (boundp 'erc-modules) 393 | (add-to-list 'erc-modules 'hl-nicks)) 394 | 395 | (provide 'erc-hl-nicks) 396 | 397 | ;;;###autoload 398 | (eval-after-load 'erc 399 | '(progn 400 | (unless (featurep 'erc-hl-nicks) 401 | (require 'erc-hl-nicks)) 402 | (add-to-list 'erc-modules 'hl-nicks t))) 403 | 404 | ;;; erc-hl-nicks.el ends here 405 | --------------------------------------------------------------------------------