diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-irc-colors.el')
-rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-irc-colors.el | 182 |
1 files changed, 182 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-irc-colors.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-irc-colors.el new file mode 100644 index 0000000000..9b16ead2f9 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-irc-colors.el @@ -0,0 +1,182 @@ +;;; lui-irc-colors.el --- Add IRC color support to LUI + +;; Copyright (C) 2005 Jorgen Schaefer + +;; Author: Jorgen Schaefer <forcer@forcix.cx> + +;; This file is part of Lui. + +;; 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 tells LUI how to display IRC colors: +;; ^B - Bold +;; ^_ - Underline +;; ^V - Inverse +;; ^] - Italic +;; ^O - Return to normal +;; ^C1,2 - Colors + +;; The colors are documented at http://www.mirc.co.uk/help/color.txt + +;;; Code: + +(require 'lui) + +(defgroup lui-irc-colors nil + "LUI IRC colors faces." + :group 'circe) + +(defface lui-irc-colors-inverse-face + '((t (:inverse-video t))) + "Face used for inverse video." + :group 'lui-irc-colors) + +(defun lui-irc-defface (face property on-dark on-light rest doc) + (custom-declare-face + face + `((((type graphic) (class color) (background dark)) + (,property ,on-dark)) + (((type graphic) (class color) (background light)) + (,property ,on-light)) + (t (,property ,rest))) + doc + :group 'lui-irc-colors)) + +(defun lui-irc-defface-pair (number on-dark on-light rest name) + (lui-irc-defface + (intern (format "lui-irc-colors-fg-%d-face" number)) + :foreground + on-dark on-light rest + (concat "Face used for foreground IRC color " + (number-to-string number) " (" name ").")) + (lui-irc-defface + (intern (format "lui-irc-colors-bg-%d-face" number)) + :background + on-light on-dark rest + (concat "Face used for background IRC color " + (number-to-string number) " (" name ")."))) + +(defun lui-irc-defface-bulk (colors) + (dotimes (n (length colors)) + (apply 'lui-irc-defface-pair n (nth n colors)))) + +(lui-irc-defface-bulk + '(("#ffffff" "#585858" "white" "white") + ("#a5a5a5" "#000000" "black" "black") + ("#9b9bff" "#0000ff" "blue4" "blue") + ("#40eb51" "#006600" "green4" "green") + ("#ff9696" "#b60000" "red" "red") + ("#d19999" "#8f3d3d" "red4" "brown") + ("#d68fff" "#9c009c" "magenta4" "purple") + ("#ffb812" "#7a4f00" "yellow4" "orange") + ("#ffff00" "#5c5c00" "yellow" "yellow") + ("#80ff95" "#286338" "green" "light green") + ("#00b8b8" "#006078" "cyan4" "teal") + ("#00ffff" "#006363" "cyan" "light cyan") + ("#a8aeff" "#3f568c" "blue" "light blue") + ("#ff8bff" "#853885" "magenta" "pink") + ("#cfcfcf" "#171717" "dimgray" "grey") + ("#e6e6e6" "#303030" "gray" "light grey"))) + +(defvar lui-irc-colors-regex + "\\(\x02\\|\x1F\\|\x16\\|\x1D\\|\x0F\\|\x03\\)" + "A regular expression matching IRC control codes.") + +;;;###autoload +(defun enable-lui-irc-colors () + "Enable IRC color interpretation for Lui." + (interactive) + (add-hook 'lui-pre-output-hook 'lui-irc-colors)) + +(defun disable-lui-irc-colors () + "Disable IRC color interpretation for Lui." + (interactive) + (remove-hook 'lui-pre-output-hook 'lui-irc-colors)) + +(defun lui-irc-colors () + "Add color faces for IRC colors. +This is an appropriate function for `lui-pre-output-hook'." + (goto-char (point-min)) + (let ((start (point)) + (boldp nil) + (inversep nil) + (italicp nil) + (underlinep nil) + (fg nil) + (bg nil)) + (while (re-search-forward lui-irc-colors-regex nil t) + (lui-irc-propertize start (point) + boldp inversep italicp underlinep + fg bg) + (let ((code (match-string 1))) + (replace-match "") + (setq start (point)) + (cond + ((string= code "") + (setq boldp (not boldp))) + ((string= code "") + (setq inversep (not inversep))) + ((string= code "") + (setq italicp (not italicp))) + ((string= code "") + (setq underlinep (not underlinep))) + ((string= code "") + (setq boldp nil + inversep nil + italicp nil + underlinep nil + fg nil + bg nil)) + ((string= code "") + (if (looking-at "\\([0-9][0-9]?\\)\\(,\\([0-9][0-9]?\\)\\)?") + (progn + (setq fg (string-to-number (match-string 1)) + bg (if (match-string 2) + (string-to-number (match-string 3)) + bg)) + (setq fg (if (and fg (not (= fg 99))) (mod fg 16) nil) + bg (if (and bg (not (= bg 99))) (mod bg 16) nil)) + (replace-match "")) + (setq fg nil + bg nil))) + (t + (error "lui-irc-colors: Can't happen!"))))) + (lui-irc-propertize (point) (point-max) + boldp inversep italicp underlinep fg bg))) + +(defun lui-irc-propertize (start end boldp inversep italicp underlinep fg bg) + "Propertize the region between START and END." + (let ((faces (append (and boldp '(bold)) + (and inversep '(lui-irc-colors-inverse-face)) + (and italicp '(italic)) + (and underlinep '(underline)) + (and fg (list (lui-irc-colors-face 'fg fg))) + (and bg (list (lui-irc-colors-face 'bg bg)))))) + (when faces + (add-face-text-property start end faces)))) + +(defun lui-irc-colors-face (type n) + "Return a face appropriate for face number N. +TYPE is either 'fg or 'bg." + (if (and (<= 0 n) + (<= n 15)) + (intern (format "lui-irc-colors-%s-%s-face" type n)) + 'default-face)) + +(provide 'lui-irc-colors) +;;; lui-irc-colors.el ends here |