2 (if (fboundp 'color-distance
)
3 (let ((min-distance (* 0.23 (color-distance "black" "white")))
4 (bg (face-background 'default
))
5 (fg (face-foreground 'rcirc-my-nick
))
7 (dolist (item color-name-rgb-alist
)
8 (let ((color (car item
)))
9 (when (and (not (color-gray-p color
))
10 (> (color-distance color bg
) min-distance
)
11 (> (color-distance color fg
) min-distance
))
12 (setq candidates
(cons color candidates
)))))
14 (delete (face-background 'default
) (defined-colors)))
15 "Colors to use for nicks in rcirc.
16 By default, all the non-grey colors that are very different from
17 the default background are candidates. The minimum
18 color-distance is half the distance between black and red as
19 computed by `color-distance'.
21 To check out the list, evaluate (list-colors-display rcirc-colors).")
23 (defvar rcirc-color-mapping
(make-hash-table :test
'equal
)
24 "Hash-map mapping nicks to color names.")
26 (eval-after-load 'rcirc
27 '(defun rcirc-facify (string face
)
28 "Return a copy of STRING with FACE property added.
29 Also add colors to other nicks based on `rcirc-colors'."
30 (when (and (eq face
'rcirc-other-nick
)
31 (not (string= string
"")))
32 (let ((color (gethash string rcirc-color-mapping
)))
34 (setq color
(elt rcirc-colors
(random (length rcirc-colors
))))
35 (puthash string color rcirc-color-mapping
))
36 (setq face
`((foreground-color .
,color
)))))
38 (propertize (or string
"") 'face face
'rear-nonsticky t
)
41 (defadvice rcirc-mangle-text
(after rcirc-mangle-text-color-nick activate
)
42 "Highlight nicks according to `rcirc-color-mapping'."
43 (with-syntax-table rcirc-nick-syntax-table
44 (maphash (lambda (nick color
)
45 (let ((face (cons 'foreground-color color
)))
46 (rcirc-map-regexp (lambda (start end string
)
48 start end
`(face ,face rear-nonsticky t
)
50 (concat "\\b" (regexp-quote nick
) "\\b")
52 rcirc-color-mapping
)))
54 (eval-after-load 'rcirc
55 '(defun-rcirc-command color
(args)
56 "Change one of the nick colors."
58 (setq args
(split-string args
))
59 (rcirc-do-color (car args
) (cadr args
) process target
)))
61 (defun rcirc-do-color (nick color process target
)
65 (maphash (lambda (key value
)
68 `(face ((foreground-color .
,value
)) help-echo
,value
)
70 (setq names
(cons key names
)))
72 (rcirc-print process
(rcirc-nick process
) "NOTICE" target
73 (mapconcat 'identity names
" ")))
75 (error "Use what color?"))
76 (puthash nick color rcirc-color-mapping
)))
78 (defadvice rcirc-handler-NICK
(before rcirc-handler-NICK-colors activate
)
79 "Update colors in `rcirc-color-mapping'."
80 (let* ((old-nick (rcirc-user-nick sender
))
81 (color (gethash old-nick rcirc-color-mapping
))
82 (new-nick (car args
)))
83 ;; don't delete the old mapping
84 (puthash new-nick color rcirc-color-mapping
)))