183 lines
6.0 KiB
EmacsLisp
183 lines
6.0 KiB
EmacsLisp
;;; 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
|