X-Git-Url: http://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-highlight.el;h=f40638e5388bf29df4d88cd015904c581959a9de;hp=b5c5b1f17ded3b86d22780db668fa33efb304af4;hb=f783b562b1f30b3d7eab4e80870b7decbc10c354;hpb=503a6a2b826a93e8acca3dbbe1c282babb77c3ff diff --git a/lisp/riece-highlight.el b/lisp/riece-highlight.el index b5c5b1f..f40638e 100644 --- a/lisp/riece-highlight.el +++ b/lisp/riece-highlight.el @@ -19,24 +19,30 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, 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 your IRC buffer" + "Decorate IRC buffers with faces and fonts." :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 +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) @@ -175,7 +181,7 @@ (defcustom riece-channel-list-mark-face-alist '((?* . riece-channel-list-current-face)) "An alist mapping marks on riece-channel-list-buffer to faces." - :type 'list + :type '(repeat (cons character symbol)) :group 'riece-highlight) (defcustom riece-channel-list-font-lock-keywords @@ -187,55 +193,62 @@ :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)) +(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) - (make-local-hook 'after-change-functions) + ;; In XEmacs, auto-initialization of font-lock is not affective + ;; when buffer-file-name is not set. + (font-lock-set-defaults) + (riece-make-local-hook 'after-change-functions) (add-hook 'after-change-functions - 'riece-dialogue-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 () + (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-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-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 (get 'riece-highlight 'riece-addon-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 (get 'riece-highlight 'riece-addon-enabled) + (riece-identity-equal identity riece-current-channel)) (let ((string (riece-format-identity identity)) (start 0)) ;; Escape % -> %%. @@ -244,7 +257,7 @@ 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 @@ -253,14 +266,58 @@ '(riece-dialogue-font-lock-keywords t)) (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)) + 'riece-highlight-format-identity-for-channel-list-indicator) + (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 (riece-derived-mode-p '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 + (if (with-current-buffer (car buffers) + (riece-derived-mode-p 'riece-dialogue-mode + 'riece-channel-list-mode)) + (with-current-buffer (car buffers) + (font-lock-mode 1))) + (setq buffers (cdr buffers))))) + +(defun riece-highlight-disable () + (let ((buffers riece-buffer-list)) + (while buffers + (if (with-current-buffer (car buffers) + (riece-derived-mode-p 'riece-dialogue-mode + 'riece-channel-list-mode)) + (with-current-buffer (car buffers) + (font-lock-mode 0))) + (setq buffers (cdr buffers))))) (provide 'riece-highlight)