X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-highlight.el;h=6b3dbb53b58552c86883fd3130b75c44a43a5e24;hp=b7f3a38a1ae6239bd947b34c113a105275e655a3;hb=2b559fc272a39d2dd115a59357eaeafc58374441;hpb=1593ebc6a65fd3189e4d1f7b5e3719bc203d63ed diff --git a/lisp/riece-highlight.el b/lisp/riece-highlight.el index b7f3a38..6b3dbb5 100644 --- a/lisp/riece-highlight.el +++ b/lisp/riece-highlight.el @@ -27,16 +27,18 @@ (require 'riece-globals) (require 'riece-options) ;riece-channel-list-buffer-mode (require 'riece-identity) ;riece-format-identity +(require 'riece-misc) (require 'font-lock) +(require 'derived) (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) @@ -148,7 +150,7 @@ ".*\\)$") (list 1 (intern (format "riece-dialogue-%s-face" line)) t t))) '(change notice wallops error info)) - (list (list "(from [^)]+)$" 0 riece-dialogue-server-face t))) + '((riece-highlight-server-match 0 riece-dialogue-server-face t))) "Default expressions to highlight in riece-dialogue-mode." :type '(repeat (list string)) :group 'riece-highlight) @@ -187,64 +189,64 @@ :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)) +(unless (riece-facep 'riece-modeline-current-face) + (make-face 'riece-modeline-current-face + "Face used for displaying the current channel in modeline.") + (if (featurep 'xemacs) + (set-face-parent 'riece-modeline-current-face 'modeline)) + (set-face-foreground 'riece-modeline-current-face + (face-foreground 'riece-channel-list-current-face))) -(defun riece-channel-list-schedule-turn-on-font-lock () - (add-hook 'riece-channel-list-mode-hook - 'riece-channel-list-turn-on-font-lock)) +(defvar riece-highlight-enabled nil) + +(defconst riece-highlight-description + "Highlight IRC buffers") -(defvar font-lock-support-mode) -(defun riece-dialogue-turn-on-font-lock () +(defun riece-highlight-server-match (limit) + (and (re-search-forward "(from [^)]+)$" limit t) + (get-text-property (match-beginning 0) 'riece-server-name))) + +(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) - (setq font-lock-verbose nil) - (when (boundp 'font-lock-support-mode) - (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) + ;; In XEmacs, auto-initialization of font-lock is not affective + ;; when buffer-file-name is not set. + (font-lock-set-defaults) (make-local-hook 'after-change-functions) (add-hook 'after-change-functions - 'riece-dialogue-hide-prefix nil 'local)) + 'riece-highlight-hide-prefix nil 'local) + (if riece-highlight-enabled + (font-lock-mode 1))) + +(defun riece-highlight-setup-channel-list () + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults '(riece-channel-list-font-lock-keywords t)) + ;; In XEmacs, auto-initialization of font-lock is not affective + ;; when buffer-file-name is not set. + (font-lock-set-defaults) + (if riece-highlight-enabled + (font-lock-mode 1))) -(defun riece-dialogue-hide-prefix (start end length) +(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-put-overlay-faces (start end) - (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-channel-list-turn-on-font-lock () - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(riece-channel-list-font-lock-keywords t)) - (make-local-variable 'font-lock-verbose) - (setq font-lock-verbose nil) - (when (boundp 'font-lock-support-mode) - (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)) +(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 (riece-identity-equal identity riece-current-channel) + (if (and riece-highlight-enabled + (riece-identity-equal identity riece-current-channel)) (let ((string (riece-format-identity identity)) (start 0)) ;; Escape % -> %%. @@ -253,24 +255,53 @@ string (replace-match "%%" nil nil string))) (list (format "%d:" index) (riece-propertize-modeline-string - string 'face 'riece-channel-list-current-face))))) + string 'face 'riece-modeline-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-put-overlay-faces)) + (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 0))) + (setq buffers (cdr buffers)))) + (setq riece-highlight-enabled nil)) (provide 'riece-highlight)