]> crepu.dev Git - config.git/blame_incremental - djavu-asus/elpa/jabber-20230715.456/jabber-muc-nick-coloring.el
Configuracion en desarrollo PC pega
[config.git] / djavu-asus / elpa / jabber-20230715.456 / jabber-muc-nick-coloring.el
... / ...
CommitLineData
1;;; jabber-muc-nick-coloring.el --- Add nick coloring abilyty to emacs-jabber -*- lexical-binding: t; -*-
2
3;; Copyright 2009, 2010, 2012, 2013 Terechkov Evgenii - evg@altlinux.org
4
5;; This program is free software; you can redistribute it and/or modify
6;; it under the terms of the GNU General Public License as published by
7;; the Free Software Foundation; either version 2, or (at your option)
8;; any later version.
9;;
10;; This program is distributed in the hope that it will be useful,
11;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13;; GNU General Public License for more details.
14;;
15;; You should have received a copy of the GNU General Public License
16;; along with this program; if not, write to the Free Software
17;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
18
19;;; Commentary:
20
21;;; Code:
22
23(require 'color)
24
25;;;;##########################################################################
26;;;; User Options, Variables
27;;;;##########################################################################
28
29(defcustom jabber-muc-participant-colors nil
30 "Alist of used colors.
31Format is (nick . color). Color may be
32in #RGB or textual (like red or blue) notation. Colors will be
33added in #RGB notation for unknown nicks."
34 :type '(alist :key-type string :value-type color)
35 :group 'jabber-chat)
36
37(defcustom jabber-muc-colorize-local nil
38 "Colorize MUC messages from you."
39 :type 'boolean
40 :group 'jabber-chat)
41
42(defcustom jabber-muc-colorize-foreign nil
43 "Colorize MUC messages not from you."
44 :type 'boolean
45 :group 'jabber-chat)
46
47(defcustom jabber-muc-nick-saturation 1.0
48 "Default saturation for nick coloring."
49 :type 'float
50 :group 'jabber-chat)
51
52(defcustom jabber-muc-nick-value 1.0
53 "Default value for nick coloring."
54 :type 'float
55 :group 'jabber-chat)
56
57(defun jabber-muc-nick-hsv-to-hsl (h s v)
58 "Convert color consisting of H, S and V to list of HSL values."
59 ;; https://en.wikipedia.org/wiki/HSL_and_HSV#HSV_to_HSL
60 (let* ((hue h)
61 (luminance (* v (- 1 (/ s 2.0))))
62 (saturation (if (or (= luminance 0) (= luminance 1))
63 0
64 (/ (- v luminance) (min luminance (- 1 luminance))))))
65 (list hue saturation luminance)))
66
67(defun jabber-muc-nick-gen-color (nick)
68 "Return a good enough color from the available pool."
69 (let* ((pool-index (mod (string-to-number (substring (md5 nick) 0 6) 16) 360))
70 (hue (/ pool-index 360.0))
71 (saturation jabber-muc-nick-saturation)
72 (value jabber-muc-nick-value)
73 (hsl (jabber-muc-nick-hsv-to-hsl hue saturation value)))
74 (apply #'color-rgb-to-hex (apply #'color-hsl-to-rgb hsl))))
75
76(defun jabber-muc-nick-get-color (nick)
77 "Get NICKs color."
78 (let ((color (cdr (assoc nick jabber-muc-participant-colors))))
79 (if color
80 color
81 (progn
82 (unless jabber-muc-participant-colors)
83 (push (cons nick (jabber-muc-nick-gen-color nick)) jabber-muc-participant-colors)
84 (cdr (assoc nick jabber-muc-participant-colors))))))
85
86(provide 'jabber-muc-nick-coloring)
87
88;;; jabber-muc-nick-coloring.el ends here