diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-color-nicks.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-color-nicks.el | 340 |
1 files changed, 0 insertions, 340 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-color-nicks.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-color-nicks.el deleted file mode 100644 index dd5e64e04fa6..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-color-nicks.el +++ /dev/null @@ -1,340 +0,0 @@ -;;; circe-color-nicks.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 3 -;; 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) -;; (enable-circe-color-nicks) - -;;; Code: - -(require 'circe) -(require 'color) -(require 'cl-lib) - -;;;###autoload -(defun enable-circe-color-nicks () - "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)))) - (add-hook 'circe-channel-mode-hook - 'add-circe-color-nicks)) - -(defun disable-circe-color-nicks () - "Disable the Color Nicks module for Circe. -See `enable-circe-color-nicks'." - (interactive) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (eq major-mode 'circe-channel-mode) - (remove-circe-color-nicks)))) - (remove-hook 'circe-channel-mode-hook - 'add-circe-color-nicks)) - -(defun add-circe-color-nicks () - "Add `circe-color-nicks' to `lui-pre-output-hook'." - (add-hook 'lui-pre-output-hook 'circe-color-nicks)) - -(defun remove-circe-color-nicks () - "Remove `circe-color-nicks' from `lui-pre-output-hook'." - (remove-hook 'lui-pre-output-hook 'circe-color-nicks)) - - -(defgroup circe-color-nicks nil - "Nicks colorization for Circe" - :prefix "circe-color-nicks-" - :group 'circe) - -(defcustom circe-color-nicks-min-contrast-ratio 7 - "Minimum contrast ratio from background for generated colors; -recommended is 7:1, or at least 4.5:1 (7 stands for 7:1 here). -Lower value allows higher color spread, but could lead to less -readability." - :group 'circe-color-nicks) - -(defcustom circe-color-nicks-min-difference 17 - "Minimum difference from each other for generated colors." - :group 'circe-color-nicks) - -(defcustom circe-color-nicks-min-fg-difference 17 - "Minimum difference from foreground for generated colors." - :group 'circe-color-nicks) - -(defcustom circe-color-nicks-min-my-message-difference 0 - "Minimum difference from own nick color for generated colors." - :group 'circe-color-nicks) - -(defcustom circe-color-nicks-everywhere nil - "Whether nicks should be colored in message bodies too." - :type 'boolean - :group 'circe-color-nicks) - -(defcustom circe-color-nicks-message-blacklist nil - "Blacklist for nicks that shall never be highlighted inside - images." - :type '(repeat string) - :group 'circe-color-nicks) - -(defcustom circe-color-nicks-pool-type 'adaptive - "Type of the color nick pool. -Must be one of the following: - -'adaptive: Generate colors based on the current theme. - -List of strings: Pick colors from the specified list of hex codes -or color names (see `color-name-rgb-alist')." - :type '(choice (const :tag "Adaptive" adaptive) - (repeat string)) - :group 'circe-color-nicks) - - -;;; See http://www.w3.org/TR/2013/NOTE-WCAG20-TECHS-20130905/G18 - -(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)))) - - -(defun circe-color-alist () - "Return list of colors (name rgb lab) where rgb is 0 to 1." - (let ((alist (if (display-graphic-p) - color-name-rgb-alist - (mapcar (lambda (c) - (cons (car c) (cddr c))) - (tty-color-alist)))) - (valmax (float (car (color-values "#ffffff"))))) - (mapcar (lambda (c) - (let* ((name (car c)) - (rgb (mapcar (lambda (v) - (/ v valmax)) - (cdr c))) - (lab (apply #'color-srgb-to-lab rgb))) - (list name rgb lab))) - alist))) - -(defun circe-color-canonicalize-format (color) - "Turns COLOR into (name rgb lab) format. Avoid calling this in -a loop, it's very slow on a tty!" - (let* ((name color) - (rgb (circe-color-name-to-rgb color)) - (lab (apply #'color-srgb-to-lab rgb))) - (list name rgb lab))) - -(defun circe-color-contrast-ratio (color1 color2) - "Gives the contrast ratio between two colors." - (circe-w3-contrast-contrast-ratio (nth 1 color1) (nth 1 color2))) - -(defun circe-color-diff (color1 color2) - "Gives the difference between two colors per CIEDE2000." - (color-cie-de2000 (nth 2 color1) (nth 2 color2))) - -(defun circe-color-name-to-rgb (color) - "Like `color-name-to-rgb' but also handles \"unspecified-bg\" -and \"unspecified-fg\"." - (cond ((equal color "unspecified-bg") '(0 0 0)) - ((equal color "unspecified-fg") '(1 1 1)) - (t (color-name-to-rgb color)))) - - -(defun circe-nick-color-appropriate-p (color bg fg my-msg) - "Tells whether COLOR is appropriate for being a nick color. -BG, FG, and MY-MSG are the background, foreground, and my-message -colors; these are expected as parameters instead of computed here -because computing them repeatedly is a heavy operation." - (and (>= (circe-color-contrast-ratio color bg) - circe-color-nicks-min-contrast-ratio) - (>= (circe-color-diff color fg) - circe-color-nicks-min-fg-difference) - (>= (circe-color-diff color my-msg) - circe-color-nicks-min-my-message-difference))) - -(defun circe-nick-colors-delete-similar (colors) - "Return list COLORS with pairs of colors filtered out that are -too similar per `circe-color-nicks-min-difference'. COLORS may -be mutated." - (cl-mapl (lambda (rest) - (let ((color (car rest))) - (setcdr rest (cl-delete-if - (lambda (c) - (< (circe-color-diff color c) - circe-color-nicks-min-difference)) - (cdr rest))))) - colors) - colors) - -(defun circe-nick-color-generate-pool () - "Return a list of appropriate nick colors." - (if (consp circe-color-nicks-pool-type) - circe-color-nicks-pool-type - (let ((bg (circe-color-canonicalize-format (face-background 'default))) - (fg (circe-color-canonicalize-format (face-foreground 'default))) - (my-msg (circe-color-canonicalize-format - (face-attribute - 'circe-my-message-face :foreground nil 'default)))) - (mapcar #'car (circe-nick-colors-delete-similar - (cl-remove-if-not - (lambda (c) - (circe-nick-color-appropriate-p c bg fg my-msg)) - (circe-color-alist))))))) - -(defun circe-nick-color-pool-test () - "Display all appropriate nick colors in a temp buffer." - (interactive) - (switch-to-buffer (get-buffer-create "*Circe color test*")) - (erase-buffer) - (let ((pool (circe-nick-color-generate-pool))) - (while pool - (let ((pt (point))) - (insert "The quick brown fox jumped over the lazy dog.\n") - (put-text-property pt (point) 'face `(:foreground ,(pop pool))))))) - -(defvar circe-nick-color-pool nil - "Pool of yet unused nick colors.") - -(defvar circe-nick-color-mapping (make-hash-table :test 'equal) - "Hash-table from nicks to colors.") - -(defun circe-nick-color-nick-list () - "Return list of all nicks that should be colored in this channel. -Own and blacklisted nicks are excluded." - (let ((our-nick (circe-nick)) - (channel-nicks (circe-channel-nicks))) - (cl-remove-if (lambda (nick) - (or (string= our-nick nick) - (member nick circe-color-nicks-message-blacklist))) - channel-nicks))) - -(defvar circe-nick-color-timestamps (make-hash-table :test 'equal) - "Hash-table from colors to the timestamp of their last use.") - -(defun circe-nick-color-for-nick (nick) - "Return the color for NICK. Assigns a color to NICK if one -wasn't assigned already." - (let ((color (gethash nick circe-nick-color-mapping))) - (when (not color) - ;; NOTE use this as entry point for taking NICK into account for - ;; picking the new color - (setq color (circe-nick-color-pick)) - (puthash nick color circe-nick-color-mapping)) - (puthash color (float-time) circe-nick-color-timestamps) - color)) - -(defun circe-nick-color-pick () - "Picks either a color from the pool of unused colors, or the -color that was used least recently (i.e. nicks that have it -assigned have been least recently active)." - (if (zerop (hash-table-count circe-nick-color-mapping)) - (setq circe-nick-color-pool (circe-nick-color-generate-pool))) - (or (pop circe-nick-color-pool) - (circe-nick-color-pick-least-recent))) - -(defun circe-nick-color-pick-least-recent () - "Pick the color that was used least recently. -See `circe-nick-color-pick', which is where this is used." - (let ((least-recent-color nil) - (oldest-time (float-time))) - (maphash - (lambda (color time) - (if (< time oldest-time) - (progn - (setq least-recent-color color) - (setq oldest-time time)))) - circe-nick-color-timestamps) - (if least-recent-color - least-recent-color - ;; Someone must have messed with `circe-nick-color-mapping', recover by - ;; re-filling the pool. - (setq circe-nick-color-pool (circe-nick-color-generate-pool)) - (pop circe-nick-color-pool)))) - -(defun circe-color-nicks () - "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-single-property-change nickstart - 'lui-format-argument)) - (nick (plist-get (plist-get (text-properties-at nickstart) - 'lui-keywords) - :nick))) - (when (not (circe-server-my-nick-p nick)) - (let ((color (circe-nick-color-for-nick nick))) - (add-face-text-property nickstart nickend - `(:foreground ,color))))))) - (when circe-color-nicks-everywhere - (let ((body (text-property-any (point-min) (point-max) - 'lui-format-argument 'body))) - (when body - (with-syntax-table circe-nick-syntax-table - (goto-char body) - (let* ((nicks (circe-nick-color-nick-list)) - (regex (regexp-opt nicks 'words))) - (let (case-fold-search) - (while (re-search-forward regex nil t) - (let* ((nick (match-string-no-properties 0)) - (color (circe-nick-color-for-nick nick))) - (add-face-text-property (match-beginning 0) (match-end 0) - `(:foreground ,color)))))))))))) - -(defun circe-nick-color-reset () - "Reset the nick color mapping (and some internal data). - -This is useful if you switched between frames supporting -different color ranges and would like nicks to get new colors -appropriate to the new color range." - (interactive) - (setq circe-nick-color-pool (circe-nick-color-generate-pool)) - (setq circe-nick-color-mapping (make-hash-table :test 'equal)) - (setq circe-nick-color-timestamps (make-hash-table :test 'equal))) - -(provide 'circe-color-nicks) -;;; circe-color-nicks.el ends here |