cgit.sxemacs.org Git - riece/blob - lisp/riece-highlight.el

   1 ;;; riece-highlight.el --- coloring IRC buffers
   2 ;; Copyright (C) 1998-2003 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1998-09-28
   6 ;; Keywords: IRC, riece
   7
   8 ;; This file is part of Riece.
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Code:
  26
  27 (eval-when-compile (require 'riece-inlines))
  28
  29 (require 'riece-globals)
  30 (require 'font-lock)
  31
  32 (defgroup riece-highlight nil
  33   "Highlight your IRC buffer"
  34   :tag "Highlight"
  35   :prefix "riece-"
  36   :group 'riece)
  37
  38 (defgroup riece-highlight-faces nil
  39   "Faces for highlight your IRC buffer"
  40   :tag "Faces"
  41   :prefix "riece-highlight-"
  42   :group 'riece-highlight)
  43
  44 (defcustom riece-change-face 'riece-change-face
  45   "Face used for displaying \"*** Change:\" line."
  46   :type 'face
  47   :group 'riece-highlight-faces)
  48
  49 (defcustom riece-notice-face 'riece-notice-face
  50   "Face used for displaying \"*** Notice:\" line."
  51   :type 'face
  52   :group 'riece-highlight-faces)
  53
  54 (defcustom riece-wallops-face 'riece-wallops-face
  55   "Face used for displaying \"*** Wallops:\" line."
  56   :type 'face
  57   :group 'riece-highlight-faces)
  58
  59 (defcustom riece-error-face 'riece-error-face
  60   "Face used for displaying \"*** Error:\" line."
  61   :type 'face
  62   :group 'riece-highlight-faces)
  63
  64 (defcustom riece-info-face 'riece-info-face
  65   "Face used for displaying \"*** Info:\" line."
  66   :type 'face
  67   :group 'riece-highlight-faces)
  68
  69 (defcustom riece-server-face 'riece-server-face
  70   "Face used for displaying \"(from server)\" extent."
  71   :type 'face
  72   :group 'riece-highlight-faces)
  73
  74 (defcustom riece-prefix-face 'riece-prefix-face
  75   "Face used for displaying \"<nick>\" extent."
  76   :type 'face
  77   :group 'riece-highlight-faces)
  78
  79 (defface riece-change-face
  80   '((((class color)
  81       (background dark))
  82      (:foreground "cyan" :bold t))
  83     (((class color)
  84       (background light))
  85      (:foreground "RoyalBlue" :bold t))
  86     (t
  87      (:bold t)))
  88   "Face used for displaying \"*** Change:\" line"
  89   :group 'riece-highlight-faces)
  90
  91 (defface riece-notice-face
  92   '((((class color)
  93       (background dark))
  94      (:foreground "green2" :bold t))
  95     (((class color)
  96       (background light))
  97      (:foreground "MidnightBlue" :bold t))
  98     (t
  99      (:bold t)))
 100   "Face used for displaying \"*** Notice:\" line"
 101   :group 'riece-highlight-faces)
 102
 103 (defface riece-wallops-face
 104   '((((class color)
 105       (background dark))
 106      (:foreground "yellow" :bold t))
 107     (((class color)
 108       (background light))
 109      (:foreground "blue4" :bold t))
 110     (t
 111      (:bold t)))
 112   "Face used for displaying \"*** Wallops:\" line"
 113   :group 'riece-highlight-faces)
 114
 115 (defface riece-error-face
 116   '((((class color)
 117       (background dark))
 118      (:foreground "cornflower blue" :bold t))
 119     (((class color)
 120       (background light))
 121      (:foreground "DarkGreen"))
 122     (t
 123      (:bold t)))
 124   "Face used for displaying \"*** Error:\" line"
 125   :group 'riece-highlight-faces)
 126
 127 (defface riece-info-face
 128   '((((class color)
 129       (background dark))
 130      (:foreground "PaleTurquoise" :bold t))
 131     (((class color)
 132       (background light))
 133      (:foreground "RoyalBlue"))
 134     (t
 135      (:bold t)))
 136   "Face used for displaying \"*** Info:\" line"
 137   :group 'riece-highlight-faces)
 138
 139 (defface riece-server-face
 140   '((((class color)
 141       (background dark))
 142      (:foreground "Gray70"))
 143     (((class color)
 144       (background light))
 145      (:foreground "DimGray"))
 146     (t
 147      (:bold t)))
 148   "Face used for displaying \"(from server)\" extent."
 149   :group 'riece-highlight-faces)
 150
 151 (defface riece-prefix-face
 152   '((((class color)
 153       (background dark))
 154      (:foreground "moccasin"))
 155     (((class color)
 156       (background light))
 157      (:foreground "firebrick"))
 158     (t
 159      (:bold nil)))
 160   "Face used for displaying \"<nick>\" extent"
 161   :group 'riece-highlight-faces)
 162
 163 (defcustom riece-highlight-font-lock-keywords
 164   (append
 165    (list
 166     `(,(concat
 167         "^" riece-time-prefix-regexp
 168         "\\(<[^>]+>\\|>[^<]+<\\|-[^-]+-\\|([^)]+)\\|=[^=]+=\\)")
 169       (1 riece-prefix-face append t)))
 170    ;; set property to the whole line
 171    (mapcar
 172     (lambda (line)
 173       (cons
 174        (concat
 175         "^" riece-time-prefix-regexp "\\("
 176         (regexp-quote
 177          (symbol-value (intern (format "riece-%s-prefix" line))))
 178         ".*\\)$")
 179        (list 1 (intern (format "riece-%s-face" line)) t t)))
 180     '(change notice wallops error info))
 181    (list (list "(from [^)]+)$" 0 riece-server-face t)))
 182   "Normal and deformed faces for IRC normal line."
 183   :type '(repeat (list string))
 184   :group 'riece-highlight)
 185
 186 (defun riece-highlight-schedule-turn-on-font-lock ()
 187   (add-hook 'riece-channel-mode-hook
 188             'riece-highlight-turn-on-font-lock)
 189   (add-hook 'riece-others-mode-hook
 190             'riece-highlight-turn-on-font-lock)
 191   (add-hook 'riece-dialogue-mode-hook
 192             'riece-highlight-turn-on-font-lock))
 193
 194 (defvar font-lock-support-mode)
 195 (defun riece-highlight-turn-on-font-lock ()
 196   (make-local-variable 'font-lock-defaults)
 197   (setq font-lock-defaults '(riece-highlight-font-lock-keywords t))
 198   (make-local-variable 'font-lock-verbose)
 199   (setq font-lock-verbose nil)
 200   (when (boundp 'font-lock-support-mode)
 201     (make-local-variable 'font-lock-support-mode)
 202     (setq font-lock-support-mode nil))
 203   (make-local-hook 'font-lock-mode-hook)
 204   (setq font-lock-mode-hook nil)
 205   (turn-on-font-lock)
 206   (make-local-hook 'after-change-functions)
 207   (add-hook 'after-change-functions
 208             'riece-highlight-hide-prefix nil 'local))
 209
 210 (defun riece-highlight-hide-prefix (start end length)
 211   (save-excursion
 212     (goto-char start)
 213     (if (looking-at riece-prefix-regexp)
 214         (put-text-property (match-beginning 1) (match-end 1) 'invisible t))))
 215
 216 (defun riece-highlight-insinuate ()
 217   (put 'riece-channel-mode 'font-lock-defaults
 218        '(riece-highlight-font-lock-keywords t))
 219   (put 'riece-others-mode 'font-lock-defaults
 220        '(riece-highlight-font-lock-keywords t))
 221   (put 'riece-dialogue-mode 'font-lock-defaults
 222        '(riece-highlight-font-lock-keywords t))
 223   (add-hook 'riece-after-load-startup-hook
 224             'riece-highlight-schedule-turn-on-font-lock))
 225
 226 (provide 'riece-highlight)
 227
 228 ;;; riece-highlight.el ends here