X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-highlight.el;h=b601d227587dec8eb4664026b398c6667e87ebe9;hp=e984c93a8b96d2b36682157c4da48a9e90eefb8d;hb=2d67acd4af1122a36fcc09b47a479b927ca03904;hpb=128fd61defd46adee3734539563d4d815bfca7cf diff --git a/lisp/riece-highlight.el b/lisp/riece-highlight.el index e984c93..b601d22 100644 --- a/lisp/riece-highlight.el +++ b/lisp/riece-highlight.el @@ -1,4 +1,4 @@ -;;; riece-highlight.el --- coloring IRC buffers +;;; riece-highlight.el --- highlight IRC buffers ;; Copyright (C) 1998-2003 Daiki Ueno ;; Author: Daiki Ueno @@ -25,55 +25,22 @@ ;;; Code: (require 'riece-globals) +(require 'riece-options) ;riece-channel-list-buffer-mode +(require 'riece-identity) ;riece-format-identity (require 'font-lock) (defgroup riece-highlight nil - "Highlight your IRC buffer" + "Highlight IRC buffers" :tag "Highlight" :prefix "riece-" :group 'riece) (defgroup riece-highlight-faces nil - "Faces for highlight your IRC buffer" + "Faces for highlight IRC buffers" :tag "Faces" :prefix "riece-highlight-" :group 'riece-highlight) -(defcustom riece-dialogue-change-face 'riece-dialogue-change-face - "Face used for displaying \"*** Change:\" line." - :type 'face - :group 'riece-highlight-faces) - -(defcustom riece-dialogue-notice-face 'riece-dialogue-notice-face - "Face used for displaying \"*** Notice:\" line." - :type 'face - :group 'riece-highlight-faces) - -(defcustom riece-dialogue-wallops-face 'riece-dialogue-wallops-face - "Face used for displaying \"*** Wallops:\" line." - :type 'face - :group 'riece-highlight-faces) - -(defcustom riece-dialogue-error-face 'riece-dialogue-error-face - "Face used for displaying \"*** Error:\" line." - :type 'face - :group 'riece-highlight-faces) - -(defcustom riece-dialogue-info-face 'riece-dialogue-info-face - "Face used for displaying \"*** Info:\" line." - :type 'face - :group 'riece-highlight-faces) - -(defcustom riece-dialogue-server-face 'riece-dialogue-server-face - "Face used for displaying \"(from server)\" extent." - :type 'face - :group 'riece-highlight-faces) - -(defcustom riece-dialogue-prefix-face 'riece-dialogue-prefix-face - "Face used for displaying \"\" extent." - :type 'face - :group 'riece-highlight-faces) - (defface riece-dialogue-change-face '((((class color) (background dark)) @@ -85,6 +52,7 @@ (:bold t))) "Face used for displaying \"*** Change:\" line" :group 'riece-highlight-faces) +(defvar riece-dialogue-change-face 'riece-dialogue-change-face) (defface riece-dialogue-notice-face '((((class color) @@ -97,6 +65,7 @@ (:bold t))) "Face used for displaying \"*** Notice:\" line" :group 'riece-highlight-faces) +(defvar riece-dialogue-notice-face 'riece-dialogue-notice-face) (defface riece-dialogue-wallops-face '((((class color) @@ -109,6 +78,7 @@ (:bold t))) "Face used for displaying \"*** Wallops:\" line" :group 'riece-highlight-faces) +(defvar riece-dialogue-wallops-face 'riece-dialogue-wallops-face) (defface riece-dialogue-error-face '((((class color) @@ -121,6 +91,7 @@ (:bold t))) "Face used for displaying \"*** Error:\" line" :group 'riece-highlight-faces) +(defvar riece-dialogue-error-face 'riece-dialogue-error-face) (defface riece-dialogue-info-face '((((class color) @@ -133,6 +104,7 @@ (:bold t))) "Face used for displaying \"*** Info:\" line" :group 'riece-highlight-faces) +(defvar riece-dialogue-info-face 'riece-dialogue-info-face) (defface riece-dialogue-server-face '((((class color) @@ -145,6 +117,7 @@ (:bold t))) "Face used for displaying \"(from server)\" extent." :group 'riece-highlight-faces) +(defvar riece-dialogue-server-face 'riece-dialogue-server-face) (defface riece-dialogue-prefix-face '((((class color) @@ -157,6 +130,7 @@ (:bold nil))) "Face used for displaying \"\" extent" :group 'riece-highlight-faces) +(defvar riece-dialogue-prefix-face 'riece-dialogue-prefix-face) (defcustom riece-dialogue-font-lock-keywords (append @@ -179,39 +153,24 @@ :type '(repeat (list string)) :group 'riece-highlight) -(defcustom riece-channel-list-default-face 'riece-channel-list-default-face - "Face used for displaying channels." - :type 'face - :group 'riece-highlight-faces) - -(defcustom riece-channel-list-current-face 'riece-channel-list-current-face - "Face used for displaying the current channel." - :type 'face - :group 'riece-highlight-faces) - (defface riece-channel-list-default-face - '((((class color) - (background dark)) - (:foreground "turquoise")) - (((class color) - (background light)) - (:foreground "CadetBlue4")) - (t - ())) + '((t ())) "Face used for displaying channels." :group 'riece-highlight-faces) +(defvar riece-channel-list-default-face 'riece-channel-list-default-face) (defface riece-channel-list-current-face '((((class color) (background dark)) - (:foreground "PaleTurquoise" :underline t)) + (:foreground "turquoise" :underline t)) (((class color) (background light)) - (:foreground "ForestGreen" :underline t)) + (:foreground "SeaGreen" :underline t)) (t ())) "Face used for displaying the current channel." :group 'riece-highlight-faces) +(defvar riece-channel-list-current-face 'riece-channel-list-current-face) (defcustom riece-channel-list-mark-face-alist '((?* . riece-channel-list-current-face)) @@ -228,20 +187,13 @@ :type '(repeat (list string)) :group 'riece-highlight) -(defun riece-dialogue-schedule-turn-on-font-lock () - (add-hook 'riece-channel-mode-hook - 'riece-dialogue-turn-on-font-lock) - (add-hook 'riece-others-mode-hook - 'riece-dialogue-turn-on-font-lock) - (add-hook 'riece-dialogue-mode-hook - 'riece-dialogue-turn-on-font-lock)) +(defvar riece-highlight-enabled nil) -(defun riece-channel-list-schedule-turn-on-font-lock () - (add-hook 'riece-channel-list-mode-hook - 'riece-channel-list-turn-on-font-lock)) +(defconst riece-highlight-description + "Highlight IRC buffers") (defvar font-lock-support-mode) -(defun riece-dialogue-turn-on-font-lock () +(defun riece-highlight-setup-dialogue () (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(riece-dialogue-font-lock-keywords t)) (make-local-variable 'font-lock-verbose) @@ -251,18 +203,11 @@ (setq font-lock-support-mode nil)) (make-local-hook 'font-lock-mode-hook) (setq font-lock-mode-hook nil) - (turn-on-font-lock) (make-local-hook 'after-change-functions) (add-hook 'after-change-functions - 'riece-dialogue-hide-prefix nil 'local)) - -(defun riece-dialogue-hide-prefix (start end length) - (save-excursion - (goto-char start) - (if (looking-at riece-prefix-regexp) - (put-text-property (match-beginning 1) (match-end 1) 'invisible t)))) + 'riece-highlight-hide-prefix nil 'local)) -(defun riece-channel-list-turn-on-font-lock () +(defun riece-highlight-setup-channel-list () (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(riece-channel-list-font-lock-keywords t)) (make-local-variable 'font-lock-verbose) @@ -271,22 +216,83 @@ (make-local-variable 'font-lock-support-mode) (setq font-lock-support-mode nil)) (make-local-hook 'font-lock-mode-hook) - (setq font-lock-mode-hook nil) - (turn-on-font-lock)) + (setq font-lock-mode-hook nil)) + +(defun riece-highlight-hide-prefix (start end length) + (save-excursion + (goto-char start) + (if (looking-at riece-prefix-regexp) + (put-text-property (match-beginning 1) (match-end 1) 'invisible t)))) + +(defun riece-highlight-put-overlay-faces (start end) + (if riece-highlight-enabled + (riece-scan-property-region + 'riece-overlay-face + start end + (lambda (start end) + (riece-overlay-put (riece-make-overlay start end) + 'face + (get-text-property start 'riece-overlay-face)))))) + +(defun riece-highlight-format-identity-for-channel-list-indicator (index + identity) + (if (and riece-highlight-enabled + (riece-identity-equal identity riece-current-channel)) + (let ((string (riece-format-identity identity)) + (start 0)) + ;; Escape % -> %%. + (while (string-match "%" string start) + (setq start (1+ (match-end 0)) + string (replace-match "%%" nil nil string))) + (list (format "%d:" index) + (riece-propertize-modeline-string + string 'face 'riece-channel-list-current-face))))) (defun riece-highlight-insinuate () (put 'riece-channel-mode 'font-lock-defaults '(riece-dialogue-font-lock-keywords t)) + (add-hook 'riece-channel-mode-hook + 'riece-highlight-setup-dialogue) (put 'riece-others-mode 'font-lock-defaults '(riece-dialogue-font-lock-keywords t)) + (add-hook 'riece-others-mode-hook + 'riece-highlight-setup-dialogue) (put 'riece-dialogue-mode 'font-lock-defaults '(riece-dialogue-font-lock-keywords t)) - (add-hook 'riece-after-load-startup-hook - 'riece-dialogue-schedule-turn-on-font-lock) + (add-hook 'riece-dialogue-mode-hook + 'riece-highlight-setup-dialogue) (put 'riece-channel-list-mode 'font-lock-defaults '(riece-channel-list-font-lock-keywords t)) - (add-hook 'riece-after-load-startup-hook - 'riece-channel-list-schedule-turn-on-font-lock)) + (add-hook 'riece-channel-list-mode-hook + 'riece-highlight-setup-channel-list) + (add-hook 'riece-format-identity-for-channel-list-indicator-functions + 'riece-highlight-format-identity-for-channel-list-indicator) + (add-hook 'riece-after-insert-functions + 'riece-highlight-put-overlay-faces)) + +(defun riece-highlight-enable () + (let ((buffers riece-buffer-list)) + (while buffers + (if (memq (derived-mode-class + (with-current-buffer (car buffers) + major-mode)) + '(riece-dialogue-mode riece-channel-list-mode)) + (with-current-buffer (car buffers) + (font-lock-mode 1))) + (setq buffers (cdr buffers)))) + (setq riece-highlight-enabled t)) + +(defun riece-highlight-disable () + (let ((buffers riece-buffer-list)) + (while buffers + (if (memq (derived-mode-class + (with-current-buffer (car buffers) + major-mode)) + '(riece-dialogue-mode riece-channel-list-mode)) + (with-current-buffer (car buffers) + (font-lock-mode -1))) + (setq buffers (cdr buffers)))) + (setq riece-highlight-enabled nil)) (provide 'riece-highlight)