X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Friece-highlight.el;h=77586277e218cd5e97a2de341f49485fb9b33b83;hb=f6897ef2c8dfa1ed160cae528ecb6098f503f1b2;hp=b1746efc25ea7a8ff738f71a719e2722644840a3;hpb=cb89240653b5a921c8d1e71edf1855c07279d960;p=riece diff --git a/lisp/riece-highlight.el b/lisp/riece-highlight.el index b1746ef..7758627 100644 --- a/lisp/riece-highlight.el +++ b/lisp/riece-highlight.el @@ -22,21 +22,27 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + +;; NOTE: This is an add-on module for Riece. + ;;; Code: (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 IRC buffers" + "Decorate IRC buffers with faces and fonts." :tag "Highlight" :prefix "riece-" :group 'riece) (defgroup riece-highlight-faces nil - "Faces for highlight IRC buffers" + "Faces for highlight IRC buffers." :tag "Faces" :prefix "riece-highlight-" :group 'riece-highlight) @@ -148,7 +154,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,29 +193,41 @@ :type '(repeat (list string)) :group 'riece-highlight) -(defvar riece-highlight-enabled nil) +(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))) (defconst riece-highlight-description - "Highlight IRC buffers") + "Highlight IRC buffers.") + +(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 () - (if (featurep 'xemacs) - ;; In XEmacs, auto-initialization of font-lock is not affective - ;; when buffer-file-name is not set. - (font-lock-set-defaults) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(riece-dialogue-font-lock-keywords t))) + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults '(riece-dialogue-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) (make-local-hook 'after-change-functions) (add-hook 'after-change-functions - 'riece-highlight-hide-prefix nil 'local)) + 'riece-highlight-hide-prefix nil t) + (if (get 'riece-highlight 'riece-addon-enabled) + (font-lock-mode 1))) (defun riece-highlight-setup-channel-list () - (if (featurep 'xemacs) - ;; In XEmacs, auto-initialization of font-lock is not affective - ;; when buffer-file-name is not set. - (font-lock-set-defaults) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(riece-channel-list-font-lock-keywords t)))) + (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 (get 'riece-highlight 'riece-addon-enabled) + (font-lock-mode 1))) (defun riece-highlight-hide-prefix (start end length) (save-excursion @@ -218,7 +236,7 @@ (put-text-property (match-beginning 1) (match-end 1) 'invisible t)))) (defun riece-highlight-put-overlay-faces (start end) - (if riece-highlight-enabled + (if (get 'riece-highlight 'riece-addon-enabled) (riece-scan-property-region 'riece-overlay-face start end @@ -229,7 +247,7 @@ (defun riece-highlight-format-identity-for-channel-list-indicator (index identity) - (if (and riece-highlight-enabled + (if (and (get 'riece-highlight 'riece-addon-enabled) (riece-identity-equal identity riece-current-channel)) (let ((string (riece-format-identity identity)) (start 0)) @@ -239,17 +257,13 @@ 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-dialogue-mode-hook @@ -263,6 +277,29 @@ (add-hook 'riece-after-insert-functions 'riece-highlight-put-overlay-faces)) +(defun riece-highlight-uninstall () + (let ((buffers riece-buffer-list)) + (save-excursion + (while buffers + (set-buffer (car buffers)) + (if (eq (derived-mode-class major-mode) + 'riece-dialogue-mode) + (remove-hook 'after-change-functions + 'riece-highlight-hide-prefix t)) + (setq buffers (cdr buffers))))) + (riece-remprop 'riece-channel-mode 'font-lock-defaults) + (riece-remprop 'riece-others-mode 'font-lock-defaults) + (riece-remprop 'riece-dialogue-mode 'font-lock-defaults) + (remove-hook 'riece-dialogue-mode-hook + 'riece-highlight-setup-dialogue) + (riece-remprop 'riece-channel-list-mode 'font-lock-defaults) + (remove-hook 'riece-channel-list-mode-hook + 'riece-highlight-setup-channel-list) + (remove-hook 'riece-format-identity-for-channel-list-indicator-functions + 'riece-highlight-format-identity-for-channel-list-indicator) + (remove-hook 'riece-after-insert-functions + 'riece-highlight-put-overlay-faces)) + (defun riece-highlight-enable () (let ((buffers riece-buffer-list)) (while buffers @@ -272,8 +309,7 @@ '(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)) + (setq buffers (cdr buffers))))) (defun riece-highlight-disable () (let ((buffers riece-buffer-list)) @@ -283,9 +319,8 @@ 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)) + (font-lock-mode 0))) + (setq buffers (cdr buffers))))) (provide 'riece-highlight)