* riece-xemacs.el (riece-xemacs-mode-line-buffer-identification):

Abolish.
(riece-mode-line-buffer-identification): Don't define alias.

* riece-server.el (riece-open-server): Handle errors occurred
during reading password.

* riece-options.el (riece-addons): Add riece-icon.

* riece-layout.el (riece-configure-windows-top): Collect arguments.

* riece-icon.el: New add-on.
* COMPILE (riece-modules): Add riece-icon.
* Makefile.am (EXTRA_DIST): Add riece-icon.el

diff --git a/lisp/COMPILE b/lisp/COMPILE
index 0833c5a..f485bd9 100644 (file)
--- a/lisp/COMPILE
+++ b/lisp/COMPILE
@@ -55,7 +55,8 @@
                riece-history
                riece-button
                riece-keyword
-               riece-menu))))
+               riece-menu
+               riece-icon))))
 
 (defun riece-compile-modules (modules)
   (let ((load-path (cons nil load-path)))

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 98e3737..7380d26 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,22 @@
 2003-10-20  Daiki Ueno  <ueno@unixuser.org>
 
+       * riece-xemacs.el (riece-xemacs-mode-line-buffer-identification):
+       Abolish.
+       (riece-mode-line-buffer-identification): Don't define alias.
+
+       * riece-server.el (riece-open-server): Handle errors occurred
+       during reading password.
+
+       * riece-options.el (riece-addons): Add riece-icon.
+
+       * riece-layout.el (riece-configure-windows-top): Collect arguments.
+
+       * riece-icon.el: New add-on.
+       * COMPILE (riece-modules): Add riece-icon.
+       * Makefile.am (EXTRA_DIST): Add riece-icon.el
+
+2003-10-20  Daiki Ueno  <ueno@unixuser.org>
+
        * riece-options.el (riece-saved-forms): Add riece-layout.
 
        * riece-layout.el (riece-layout-alist): Change format.

diff --git a/lisp/Makefile.am b/lisp/Makefile.am
index d079d7c..e507f5f 100644 (file)
--- a/lisp/Makefile.am
+++ b/lisp/Makefile.am
@@ -10,7 +10,7 @@ EXTRA_DIST = COMPILE ChangeLog ChangeLog.Liece \
        riece-ndcc.el riece-rdcc.el riece-log.el riece-mini.el \
        riece-doctor.el riece-alias.el riece-layout.el riece-skk-kakutei.el \
        riece-guess.el riece-history.el riece-button.el riece-keyword.el \
-       riece-menu.el
+       riece-menu.el riece-icon.el
 
 CLEANFILES = auto-autoloads.el custom-load.el *.elc
 FLAGS ?= -batch -q -no-site-file

diff --git a/lisp/riece-icon.el b/lisp/riece-icon.el
new file mode 100644 (file)
index 0000000..0e067f9
--- /dev/null
+++ b/lisp/riece-icon.el
@@ -0,0 +1,311 @@
+;;; riece-icon.el --- iconify buffer strings
+;; Copyright (C) 1'center8-2003 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1'center8-09-28
+;; Keywords: IRC, riece
+
+;; This file is part of Riece.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.         See the
+;; GNU General Public License for more details.
+
+;; 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.
+
+;;; Commentary:
+
+;; To use, add the following line to your ~/.riece/init.el:
+;; (add-to-list 'riece-addons 'riece-icon)
+
+;;; Code:
+
+(defvar riece-channel-list-icons
+  '((" " . "/* XPM */
+static char * blank_xpm[] = {
+\"12 12 1 1\",
+\"     c None\",
+\"            \",
+\"            \",
+\"            \",
+\"            \",
+\"            \",
+\"            \",
+\"            \",
+\"            \",
+\"            \",
+\"            \",
+\"            \",
+\"            \"};")
+    ("!" . "/* XPM */
+static char * balloon_xpm[] = {
+\"12 12 3 1\",
+\"       c None\",
+\"+      c #FFDD99\",
+\"@      c #000000\",
+\"            \",
+\"    ++++    \",
+\"  ++++++++  \",
+\" ++@@@@@@++ \",
+\" ++++++++++ \",
+\" ++@@@@@@++ \",
+\" ++++++++++ \",
+\" ++@@@@@@++ \",
+\"  ++++++++  \",
+\"   ++++++   \",
+\"   +++      \",
+\"   +        \"};")
+    ("+" . "/* XPM */
+static char * check_xpm[] = {
+\"12 12 3 1\",
+\"     c None\",
+\".    c #9696FF\",
+\"+    c #5959FF\",
+\"            \",
+\"            \",
+\" ..      .. \",
+\".++.    .++.\",
+\" .++.  .++. \",
+\"  .++..++.  \",
+\"   .++++.   \",
+\"    .++.    \",
+\"     ..     \",
+\"            \",
+\"            \",
+\"            \"};")
+    ("*" . "/* XPM */
+static char * active_xpm[] = {
+\"12 12 3 1\",
+\"     c None\",
+\".    c #96FF96\",
+\"+    c #59FF59\",
+\"            \",
+\"     ..     \",
+\"     .+.    \",
+\" .....++.   \",
+\" .+++++++.  \",
+\" .++++++++. \",
+\" .+++++++.  \",
+\" .....++.   \",
+\"     .+.    \",
+\"     ..     \",
+\"            \",
+\"            \"};")))
+
+(defvar riece-user-list-icons
+  '((" " . "/* XPM */
+static char * blank_xpm[] = {
+\"12 12 1 1\",
+\"     c None\",
+\"            \",
+\"            \",
+\"            \",
+\"            \",
+\"            \",
+\"            \",
+\"            \",
+\"            \",
+\"            \",
+\"            \",
+\"            \",
+\"            \"};")
+    ("@" . "/* XPM */
+static char * spiral_xpm[] = {
+\"12 12 3 1\",
+\"     c None\",
+\".    c #FF5959\",
+\"+    c #FF9696\",
+\"            \",
+\"            \",
+\"    +++++   \",
+\"   ++...++  \",
+\"  ++.+++.++ \",
+\"  +.++.++.+ \",
+\"  +.+.+.+.+ \",
+\"  +.+.+++.+ \",
+\"  +.++...++ \",
+\"  ++.+++++.+\",
+\"   ++.....+ \",
+\"    ++++++  \"};")
+    ("+" . "/* XPM */
+static char * cross_xpm[] = {
+\"12 12 3 1\",
+\"     c None\",
+\".    c #7F7F7F\",
+\"+    c #B2B2B2\",
+\"     ++     \",
+\"    +..+    \",
+\"    +..+    \",
+\"  +++..+++  \",
+\" +........+ \",
+\" +........+ \",
+\"  +++..+++  \",
+\"    +..+    \",
+\"    +..+    \",
+\"    +..+    \",
+\"    +..+    \",
+\"     ++     \"};")))
+
+(defvar riece-pointer-icon
+  "/* XPM */
+static char * a_xpm[] = {
+\"14 14 5 1\",
+\"     c None\",
+\".    c #FF9646\",
+\"+    c #FF5909\",
+\"@    c #FF7020\",
+\"*    c #FFA500\",
+\"              \",
+\"  @@@@@@@@@@@ \",
+\" @*.++++++.**@\",
+\" @*.++...++.*@\",
+\" @*.++.*.++.*@\",
+\" @*.++...+.**@\",
+\" @*.+++.+.***@\",
+\" @*.++.*.+.**@\",
+\" @*.++.*.++.*@\",
+\" @*.++.*.++.*@\",
+\" @*.++.*.++.*@\",
+\" @**..***..**@\",
+\"  @@@@@@@@@@@ \",
+\"              \"};")
+
+(defun riece-icon-available-p ()
+  (if (featurep 'xemacs)
+      (featurep 'xpm)
+    (image-type-available-p 'xpm)))
+
+(eval-and-compile
+  (if (featurep 'xemacs)
+      (defun riece-icon-make-image (data string)
+       (make-glyph (list (vector 'xpm :data data)
+                         (vector 'string :data string))))
+    (defun riece-icon-make-image (data string)
+      (create-image data 'xpm t :ascent 'center))))
+
+(defun riece-icon-make-images (alist)
+  (let ((pointer (setq alist (copy-alist alist))))
+    (while pointer
+      (setcdr (car pointer)
+             (riece-icon-make-image (cdr (car pointer)) (car (car pointer))))
+      (setq pointer (cdr pointer)))
+    alist))
+
+(eval-and-compile
+  (if (featurep 'xemacs)
+      (defun riece-icon-add-image-region (image start end)
+       (let ((extent (make-extent start end))
+             (annotation (make-annotation image end 'text)))
+         (set-extent-property extent 'end-open t)
+         (set-extent-property extent 'start-open t)
+         (set-extent-property extent 'invisible t)
+         (set-extent-property extent 'intangible t)
+         (set-extent-property annotation
+                              'riece-icon-user-list-extent extent)
+         (set-extent-property extent
+                              'riece-icon-user-list-extent annotation)))
+    (defun riece-icon-add-image-region (image start end)
+      (let ((inhibit-read-only t)
+           buffer-read-only)
+       (add-text-properties start end
+                            (list 'display
+                                  image
+                                  '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))))))
+
+(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))))))
+
+(eval-and-compile
+  (if (featurep 'xemacs)
+      (progn
+       (defvar riece-icon-xemacs-modeline-left-extent
+         (copy-extent modeline-buffer-id-left-extent))
+
+       (defvar riece-icon-xemacs-modeline-right-extent
+         (copy-extent modeline-buffer-id-right-extent))
+
+       (defun riece-icon-modeline-buffer-identification (line)
+         "Decorate 1st element of `mode-line-buffer-identification' LINE.
+Modify whole identification by side effect."
+         (let ((id (car line)) chopped)
+           (if (and (stringp id) (string-match "^Riece:" id))
+               (progn
+                 (setq chopped (substring id 0 (match-end 0))
+                       id (substring id (match-end 0)))
+                 (nconc
+                  (list
+                   (let ((glyph
+                          (make-glyph
+                           (nconc
+                            (if (featurep 'xpm)
+                                (list (vector 'xpm :data
+                                              riece-pointer-icon)))
+                            (list (vector 'string :data chopped))))))
+                     (set-glyph-face glyph 'modeline-buffer-id)
+                     (cons riece-icon-xemacs-modeline-left-extent glyph))
+                   (cons riece-icon-xemacs-modeline-right-extent id))
+                  (cdr line)))
+             line))))
+    (condition-case nil
+       (progn
+         (require 'image)
+         (defun riece-icon-modeline-buffer-identification (line)
+           "Decorate 1st element of `mode-line-buffer-identification' LINE.
+Modify whole identification by side effect."
+           (let ((id (copy-sequence (car line)))
+                 (image
+                  (if (image-type-available-p 'xpm)
+                      (create-image riece-pointer-icon 'xpm t
+                                    :ascent 'center))))
+             (when (and image
+                        (stringp id) (string-match "^Riece:" id))
+               (add-text-properties 0 (length id)
+                                    (list 'display image
+                                          'rear-nonsticky (list 'display))
+                                    id)
+               (setcar line id))
+             line)))
+      (error
+       (defalias 'riece-icon-modeline-buffer-identification 'identity)))))
+
+(defun riece-icon-insinuate ()
+  (defalias 'riece-mode-line-buffer-identification
+    'riece-icon-modeline-buffer-identification)
+  (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))))
+  (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)))))
+
+(provide 'riece-icon)
+
+;;; riece-icon.el ends here

diff --git a/lisp/riece-layout.el b/lisp/riece-layout.el
index 3e1af90..8643a4e 100644 (file)
--- a/lisp/riece-layout.el
+++ b/lisp/riece-layout.el
@@ -172,7 +172,7 @@ This function is used by \"default\" layout."
     (select-window (or (get-buffer-window buffer)
                       (get-buffer-window riece-command-buffer)))))
 
-(defun riece-configure-windows-top (&optional plist)
+(defun riece-configure-windows-top (&rest plist)
   "Candidate of `riece-configure-windows-function'.
 PLIST accept :command-height, :user-list-width, and :channel-list-width."
   (let ((command-height (or (plist-get plist :command-height) 4))

diff --git a/lisp/riece-options.el b/lisp/riece-options.el
index f07712f..d194b85 100644 (file)
--- a/lisp/riece-options.el
+++ b/lisp/riece-options.el
@@ -108,7 +108,8 @@ way is to put Riece variables on .emacs or file loaded from there."
                          riece-history
                          riece-url
                          riece-button
-                         riece-menu)
+                         riece-menu
+                         riece-icon)
   "Add-ons insinuated into Riece."
   :type '(repeat symbol)
   :group 'riece-options)

diff --git a/lisp/riece-server.el b/lisp/riece-server.el
index 921a6cd..e5cceb3 100644 (file)
--- a/lisp/riece-server.el
+++ b/lisp/riece-server.el
@@ -152,7 +152,10 @@ the `riece-server-keyword-map' variable."
        (message "Logging in to %s..." server-name))
       (if riece-reconnect-with-password        ;password incorrect or not set.
          (unwind-protect
-             (setq password (riece-read-passwd "Password: "))
+             ;; XEmacs signals an error when the keyboard cannot be grabbed.
+             (condition-case nil
+                 (setq password (riece-read-passwd "Password: "))
+               (error))
            (setq riece-reconnect-with-password nil)))
       (if password
          (riece-process-send-string process

diff --git a/lisp/riece-xemacs.el b/lisp/riece-xemacs.el
index 72efb4c..e180cfc 100644 (file)
--- a/lisp/riece-xemacs.el
+++ b/lisp/riece-xemacs.el
@@ -39,22 +39,6 @@
 (add-hook 'riece-user-list-mode-hook 'riece-xemacs-hide-modeline)
 (add-hook 'riece-channel-list-mode-hook 'riece-xemacs-hide-modeline)
 
-(defun riece-xemacs-mode-line-buffer-identification (line)
-  "Decorate 1st        element of `mode-line-buffer-identification' LINE.
-Modify whole identification by side effect."
-  (let ((id (car line)) chop)
-    (if (and (stringp id) (string-match "^Riece:" id))
-       (progn
-         (setq chop (match-end 0))
-         (nconc
-          (list
-           (cons (copy-extent modeline-buffer-id-left-extent)
-                 (substring id 0 chop))
-           (cons (copy-extent modeline-buffer-id-right-extent)
-                 (substring id chop)))
-          (cdr line)))
-      line)))
-
 (defun riece-xemacs-simplify-modeline-format ()
   "Remove unnecessary information from `modeline-format'."
   (setq modeline-format
@@ -62,9 +46,6 @@ Modify whole identification by side effect."
                  (delq 'modeline-multibyte-status
                        (copy-sequence mode-line-format)))))
 
-(defalias 'riece-mode-line-buffer-identification
-  'riece-xemacs-mode-line-buffer-identification)
-
 (defalias 'riece-simplify-mode-line-format
   'riece-xemacs-simplify-modeline-format)