1 ;;; liece-hilit.el --- coloring IRC buffers
2 ;; Copyright (C) 1998-2000 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
7 ;; Keywords: IRC, liece
9 ;; This file is part of Liece.
11 ;; This program is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
35 (require 'liece-inlines)
38 (autoload 'liece-url-add-buttons "liece-url")
39 (autoload 'liece-channel-add-buttons "liece-channel")
40 (autoload 'liece-nick-add-buttons "liece-nick")
42 (defgroup liece-highlight nil
43 "Highlight your IRC buffer"
48 (defgroup liece-highlight-faces nil
49 "Faces for highlight your IRC buffer"
51 :prefix "liece-highlight-"
52 :group 'liece-highlight)
54 (defcustom liece-change-face 'liece-change-face
55 "Face used for displaying \"*** Change:\" line."
57 :group 'liece-highlight-faces)
59 (defcustom liece-notice-face 'liece-notice-face
60 "Face used for displaying \"*** Notice:\" line."
62 :group 'liece-highlight-faces)
64 (defcustom liece-broadcast-face 'liece-broadcast-face
65 "Face used for displaying \"*** Broadcast:\" line."
67 :group 'liece-highlight-faces)
69 (defcustom liece-wallops-face 'liece-wallops-face
70 "Face used for displaying \"*** Wallops:\" line."
72 :group 'liece-highlight-faces)
74 (defcustom liece-error-face 'liece-error-face
75 "Face used for displaying \"*** Error:\" line."
77 :group 'liece-highlight-faces)
79 (defcustom liece-info-face 'liece-info-face
80 "Face used for displaying \"*** Info:\" line."
82 :group 'liece-highlight-faces)
84 (defcustom liece-timestamp-face 'liece-timestamp-face
85 "Face used for displaying \"*** Time:\" line."
87 :group 'liece-highlight-faces)
89 (defcustom liece-client-face 'liece-client-face
90 "Face used for displaying \"CLIENT@\" line."
92 :group 'liece-highlight-faces)
94 (defcustom liece-dcc-face 'liece-dcc-face
95 "Face used for displaying \"*** DCC:\" line."
97 :group 'liece-highlight-faces)
99 (defcustom liece-prefix-face 'liece-prefix-face
100 "Face used for displaying \"<nick>\" extent."
102 :group 'liece-highlight-faces)
104 (defcustom liece-priv-prefix-face 'liece-priv-prefix-face
105 "Face used for displaying \"=nick\" line."
107 :group 'liece-highlight-faces)
109 (defcustom liece-pattern-face 'liece-pattern-face
110 "Face used for displaying user defined pattern."
112 :group 'liece-highlight-faces)
114 (defcustom liece-quoted-bold-face 'liece-quoted-bold-face
115 "Face used for displaying \002 quoted string."
117 :group 'liece-highlight-faces)
119 (defcustom liece-quoted-inverse-face 'liece-quoted-inverse-face
120 "Face used for displaying \026 quoted string."
122 :group 'liece-highlight-faces)
124 (defcustom liece-quoted-underline-face 'liece-quoted-underline-face
125 "Face used for displaying \037 quoted string."
127 :group 'liece-highlight-faces)
129 (defcustom liece-quoted-colors-ircle
130 '("white" "black" "red" "orange" "yellow" "LightGreen" "DarkOliveGreen"
131 "cyan4" "turquoise" "blue" "black" "black" "black" "black" "black"
132 "DarkBlue" "purple1" "purple2" "purple3" "magenta")
133 "Color list for displaying \003 quoted string."
134 :type '(list (radio string face))
135 :group 'liece-highlight)
137 (defcustom liece-quoted-colors-mirc
138 '("white" "black" "blue" "DarkOliveGreen" "red" "brown" "purple"
139 "orange" "yellow" "green" "cyan4" "turquoise" "RoyalBlue" "HotPink"
140 "gray50" "gray75" "black" "black" "black" "black")
141 "Color list for displaying \013 quoted string."
142 :type '(list (radio string face))
143 :group 'liece-highlight)
145 (defcustom liece-highlight-jingle-function nil
146 "Function playing jingles."
148 :group 'liece-highlight)
150 (defface liece-change-face
153 (:foreground "cyan" :bold t))
156 (:foreground "RoyalBlue" :bold t))
159 "Face used for displaying \"*** Change:\" line"
160 :group 'liece-highlight-faces)
162 (defface liece-notice-face
165 (:foreground "green2" :bold t))
168 (:foreground "MidnightBlue" :bold t))
171 "Face used for displaying \"*** Notice:\" line"
172 :group 'liece-highlight-faces)
174 (defface liece-broadcast-face
177 (:foreground "Plum1" :italic t))
180 (:foreground "purple" :italic t))
183 "Face used for displaying \"*** Broadcast:\" line"
184 :group 'liece-highlight-faces)
186 (defface liece-wallops-face
189 (:foreground "yellow" :bold t))
192 (:foreground "blue4" :bold t))
195 "Face used for displaying \"*** Wallops:\" line"
196 :group 'liece-highlight-faces)
198 (defface liece-error-face
201 (:foreground "cornflower blue" :bold t))
204 (:foreground "DarkGreen"))
207 "Face used for displaying \"*** Error:\" line"
208 :group 'liece-highlight-faces)
210 (defface liece-info-face
213 (:foreground "PaleTurquoise" :bold t))
216 (:foreground "RoyalBlue"))
219 "Face used for displaying \"*** Info:\" line"
220 :group 'liece-highlight-faces)
222 (defface liece-timestamp-face
225 (:foreground "yellow" :bold t))
228 (:foreground "blue4" :bold t))
231 "Face used for displaying \"*** Time:\" line"
232 :group 'liece-highlight-faces)
234 (defface liece-client-face
237 (:foreground "orange"))
243 "Face used for displaying \"CLIENT@\" line"
244 :group 'liece-highlight-faces)
246 (defface liece-dcc-face
249 (:foreground "orange"))
255 "Face used for displaying \"*** DCC:\" line"
256 :group 'liece-highlight-faces)
258 (defface liece-prefix-face
261 (:foreground "moccasin"))
264 (:foreground "firebrick"))
267 "Face used for displaying \"<nick>\" extent"
268 :group 'liece-highlight-faces)
270 (defface liece-priv-prefix-face
273 (:foreground "orange"))
276 (:foreground "grey40"))
279 "Face used for displaying \"=nick\" line"
280 :group 'liece-highlight-faces)
282 (defface liece-pattern-face
291 "Face used for displaying user defined pattern"
292 :group 'liece-highlight-faces)
294 (defface liece-quoted-bold-face
296 "Face used for displaying \002 quoted string"
297 :group 'liece-highlight-faces)
299 (defface liece-quoted-inverse-face
300 '((t (:inverse-video t)))
301 "Face used for displaying \026 quoted string"
302 :group 'liece-highlight-faces)
304 (defface liece-quoted-underline-face
305 '((t (:underline t)))
306 "Face used for displaying \037 quoted string"
307 :group 'liece-highlight-faces)
309 (defcustom liece-highlight-font-lock-keywords
311 ;; setting property occurred once
314 "^\\(" liece-time-prefix-regexp "\\)?"
315 "\\(\\([][<>(-][][<>(-]?[^ <>)]*[][<>)-][][<>)-]?\\)\\|"
316 "\\(=[^ ]*=\\|\\*\\*[^ \*]*\\*\\*\\)\\) ")
317 (3 liece-prefix-face append t)
318 (4 liece-priv-prefix-face append t)
319 ("\\(\002\\)\\([^\002\026\037\003]*\\)" nil nil
320 (2 liece-quoted-bold-face t t))
321 ("\\(\026\\)\\([^\002\026\037\003]*\\)" nil nil
322 (2 liece-quoted-inverse-face t t))
323 ("\\(\037\\)\\([^\002\026\037\003]*\\)" nil nil
324 (2 liece-quoted-underline-face t t))))
325 ;; set property whole line
330 "^\\(" liece-time-prefix-regexp "\\)?\\("
332 (symbol-value (intern (format "liece-%s-prefix" line))))
334 (list 2 (intern (format "liece-%s-face" line)) t t)))
335 '(change notice broadcast wallops error info timestamp client dcc))
336 '((eval . (cons liece-highlight-pattern liece-pattern-face))))
337 "Normal and deformed faces for IRC normal line."
338 :type '(repeat (list string))
339 :group 'liece-highlight)
341 (put 'liece-channel-mode 'font-lock-defaults
342 '(liece-highlight-font-lock-keywords t))
343 (put 'liece-others-mode 'font-lock-defaults
344 '(liece-highlight-font-lock-keywords t))
345 (put 'liece-dialogue-mode 'font-lock-defaults
346 '(liece-highlight-font-lock-keywords t))
348 (defadvice font-lock-mode
349 (around liece-replace-space-in-buffer-name activate)
350 (if (char-equal (aref (buffer-name) 0) ? )
353 (aset (buffer-name) 0 ?_)
355 (aset (buffer-name) 0 ? ))
358 (add-hook 'liece-after-load-startup-hook
359 'liece-highlight-maybe-turn-on-font-lock)
361 (defun liece-highlight-maybe-turn-on-font-lock ()
362 (when liece-highlight-mode
363 (add-hook 'liece-channel-mode-hook
364 'liece-highlight-turn-on-font-lock)
365 (add-hook 'liece-others-mode-hook
366 'liece-highlight-turn-on-font-lock)
367 (add-hook 'liece-dialogue-mode-hook
368 'liece-highlight-turn-on-font-lock)
369 (add-hook 'liece-insert-hook 'liece-url-add-buttons)
370 (add-hook 'liece-insert-hook 'liece-channel-add-buttons)
371 ;;(add-hook 'liece-insert-hook 'liece-nick-add-buttons)
374 (defun liece-highlight-turn-on-font-lock ()
375 (make-local-variable 'font-lock-defaults)
376 (setq font-lock-defaults '(liece-highlight-font-lock-keywords t))
377 (make-local-variable 'font-lock-verbose)
378 (setq font-lock-verbose nil)
379 (make-local-variable 'font-lock-support-mode)
380 (setq font-lock-support-mode nil)
381 (make-local-hook 'font-lock-mode-hook)
382 (setq font-lock-mode-hook nil)
384 (make-local-hook 'after-change-functions)
385 (or liece-display-prefix-tag
386 (add-hook 'after-change-functions
387 'liece-highlight-maybe-hide-prefix nil 'local))
388 (add-hook 'after-change-functions
389 'liece-highlight-colorize-quote nil 'local)
390 (add-hook 'after-change-functions
391 'liece-highlight-maybe-hide-quote 'append 'local)
392 (when (and (eq major-mode 'liece-dialogue-mode)
393 (liece-functionp liece-highlight-jingle-function))
394 (add-hook 'after-change-functions
395 'liece-highlight-maybe-play-jingle 'append 'local)))
397 (defun liece-highlight-maybe-hide-prefix (st nd len)
400 (if (looking-at liece-generic-prefix-tag-regexp)
402 (match-beginning 1) (match-end 1)))))
404 (defun liece-highlight-maybe-hide-quote (st nd len)
407 (while (re-search-forward "[\002\026\037]\\|[\003\013][0-9:;<=]+" nd t)
409 (match-beginning 0) (match-end 0)))))
411 (defun liece-highlight-maybe-play-jingle (st nd len)
414 (when (re-search-forward
415 (if (listp liece-highlight-pattern)
416 (car liece-highlight-pattern)
417 liece-highlight-pattern)
419 (funcall liece-highlight-jingle-function))))
421 (defun liece-highlight-colorize-quote (st nd len)
424 (let (num face faces vender name ovl)
425 (while (re-search-forward "\\([\003\013][0-9:;<=]+\\)\\([^\002\026\037\003\013]*\\)" nd t)
426 (setq ovl (make-overlay (match-beginning 2) (match-end 2))
428 vender (cond ((eq ?\003 (aref num 0)) 'ircle)
429 ((eq ?\013 (aref num 0)) 'mirc))
430 num (if (< 57 (char-int (aref num 1)))
431 (- (char-int (aref num 1)) 43)
432 (string-to-int (substring num 1)))
433 faces (nthcdr num (symbol-value
434 (intern (format "liece-quoted-colors-%s"
438 (setq face (make-face (intern (format "liece-quoted-color-%s-%d"
440 (set-face-foreground face (car faces))
442 (overlay-put ovl 'face face)))))
444 (provide 'liece-hilit)
446 ;;; liece-hilit.el ends here