X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-icon.el;h=2064c23016b6c1225f92e297bd0c5b6e95431bcd;hp=0e067f9b1e6862fdf15c0d0c181f02c0d96c0975;hb=45fc02379b0ffc2ea029b9f530ea139d62fa2e92;hpb=fd2f4576f383044390c4523947aaead409d34c1a diff --git a/lisp/riece-icon.el b/lisp/riece-icon.el index 0e067f9..2064c23 100644 --- a/lisp/riece-icon.el +++ b/lisp/riece-icon.el @@ -1,8 +1,8 @@ -;;; riece-icon.el --- iconify buffer strings -;; Copyright (C) 1'center8-2003 Daiki Ueno +;;; riece-icon.el --- display icons in IRC buffers +;; Copyright (C) 1998-2003 Daiki Ueno ;; Author: Daiki Ueno -;; Created: 1'center8-09-28 +;; Created: 1998-09-28 ;; Keywords: IRC, riece ;; This file is part of Riece. @@ -24,11 +24,13 @@ ;;; Commentary: -;; To use, add the following line to your ~/.riece/init.el: -;; (add-to-list 'riece-addons 'riece-icon) +;; NOTE: This is an add-on module for Riece. ;;; Code: +(require 'riece-globals) +(require 'riece-signal) + (defvar riece-channel-list-icons '((" " . "/* XPM */ static char * blank_xpm[] = { @@ -179,10 +181,16 @@ static char * a_xpm[] = { \" @@@@@@@@@@@ \", \" \"};") +(defvar riece-icon-enabled nil) + +(defconst riece-icon-description + "Display icons in IRC buffers.") + (defun riece-icon-available-p () (if (featurep 'xemacs) (featurep 'xpm) - (image-type-available-p 'xpm))) + (if (fboundp 'image-type-available-p) + (image-type-available-p 'xpm)))) (eval-and-compile (if (featurep 'xemacs) @@ -203,6 +211,12 @@ static char * a_xpm[] = { (eval-and-compile (if (featurep 'xemacs) (defun riece-icon-add-image-region (image start end) + (map-extents + (lambda (extent ignore) + (if (or (extent-property extent 'riece-icon-user-list-extent) + (extent-property extent 'riece-icon-user-list-annotation)) + (delete-extent extent))) + (current-buffer) start end) (let ((extent (make-extent start end)) (annotation (make-annotation image end 'text))) (set-extent-property extent 'end-open t) @@ -212,7 +226,7 @@ static char * a_xpm[] = { (set-extent-property annotation 'riece-icon-user-list-extent extent) (set-extent-property extent - 'riece-icon-user-list-extent annotation))) + 'riece-icon-user-list-annotation annotation))) (defun riece-icon-add-image-region (image start end) (let ((inhibit-read-only t) buffer-read-only) @@ -222,22 +236,24 @@ static char * a_xpm[] = { 'rear-nonsticky (list 'display))))))) (defun riece-icon-update-user-list-buffer () - (let ((images (riece-icon-make-images riece-user-list-icons))) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^[ @+]" nil t) - (riece-icon-add-image-region - (cdr (assoc (match-string 0) images)) - (1- (point)) (point)))))) + (if riece-icon-enabled + (let ((images (riece-icon-make-images riece-user-list-icons))) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^[ @+]" nil t) + (riece-icon-add-image-region + (cdr (assoc (match-string 0) images)) + (1- (point)) (point))))))) (defun riece-icon-update-channel-list-buffer () - (let ((images (riece-icon-make-images riece-channel-list-icons))) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^ ?[0-9]+:\\([ !+*]\\)" nil t) - (riece-icon-add-image-region - (cdr (assoc (match-string 1) images)) - (match-beginning 1) (match-end 1)))))) + (if riece-icon-enabled + (let ((images (riece-icon-make-images riece-channel-list-icons))) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^ ?[0-9]+:\\([ !+*]\\)" nil t) + (riece-icon-add-image-region + (cdr (assoc (match-string 1) images)) + (match-beginning 1) (match-end 1))))))) (eval-and-compile (if (featurep 'xemacs) @@ -292,19 +308,77 @@ Modify whole identification by side effect." (error (defalias 'riece-icon-modeline-buffer-identification 'identity))))) +(defun riece-icon-user-list-mode-hook () + (if (riece-icon-available-p) + (add-hook 'riece-update-buffer-functions + 'riece-icon-update-user-list-buffer t t))) + +(defun riece-icon-channel-list-mode-hook () + (if (riece-icon-available-p) + (add-hook 'riece-update-buffer-functions + 'riece-icon-update-channel-list-buffer t t))) + (defun riece-icon-insinuate () - (defalias 'riece-mode-line-buffer-identification - 'riece-icon-modeline-buffer-identification) + (save-excursion + (when riece-user-list-buffer + (set-buffer riece-user-list-buffer) + (riece-icon-user-list-mode-hook)) + (when riece-channel-list-buffer + (set-buffer riece-channel-list-buffer) + (riece-icon-channel-list-mode-hook))) (add-hook 'riece-user-list-mode-hook - (lambda () - (if (riece-icon-available-p) - (add-hook 'riece-update-buffer-functions - 'riece-icon-update-user-list-buffer t t)))) + 'riece-icon-user-list-mode-hook) (add-hook 'riece-channel-list-mode-hook - (lambda () - (if (riece-icon-available-p) - (add-hook 'riece-update-buffer-functions - 'riece-icon-update-channel-list-buffer t t))))) + 'riece-icon-channel-list-mode-hook)) + +(defun riece-icon-uninstall () + (save-excursion + (when riece-user-list-buffer + (set-buffer riece-user-list-buffer) + (remove-hook 'riece-update-buffer-functions + 'riece-icon-update-user-list-buffer t)) + (when riece-channel-list-buffer + (set-buffer riece-channel-list-buffer) + (remove-hook 'riece-update-buffer-functions + 'riece-icon-update-user-list-buffer t))) + (remove-hook 'riece-user-list-mode-hook + 'riece-icon-user-list-mode-hook) + (remove-hook 'riece-channel-list-mode-hook + 'riece-icon-channel-list-mode-hook)) + +(defvar riece-icon-original-mode-line-buffer-identification nil) + +(defun riece-icon-update-mode-line-buffer-identification () + (let ((buffers riece-buffer-list)) + (save-excursion + (while buffers + (set-buffer (car buffers)) + (if (local-variable-p 'riece-mode-line-buffer-identification + (car buffers)) + (setq mode-line-buffer-identification + (riece-mode-line-buffer-identification + riece-mode-line-buffer-identification))) + (setq buffers (cdr buffers)))))) + +(defun riece-icon-enable () + (setq riece-icon-original-mode-line-buffer-identification + (symbol-function 'riece-mode-line-buffer-identification)) + (defalias 'riece-mode-line-buffer-identification + 'riece-icon-modeline-buffer-identification) + (riece-icon-update-mode-line-buffer-identification) + (setq riece-icon-enabled t) + (if riece-current-channel + (riece-emit-signal 'user-list-changed riece-current-channel)) + (riece-emit-signal 'channel-list-changed)) + +(defun riece-icon-disable () + (fset 'riece-mode-line-buffer-identification + riece-icon-original-mode-line-buffer-identification) + (riece-icon-update-mode-line-buffer-identification) + (setq riece-icon-enabled nil) + (if riece-current-channel + (riece-emit-signal 'user-list-changed riece-current-channel)) + (riece-emit-signal 'channel-list-changed)) (provide 'riece-icon)