From: Daiki Ueno Date: Mon, 20 Oct 2003 10:38:42 +0000 (+0000) Subject: * riece-xemacs.el (riece-xemacs-mode-line-buffer-identification): X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=commitdiff_plain;h=fd2f4576f383044390c4523947aaead409d34c1a * 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 --- 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 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,20 @@ +2003-10-20 Daiki Ueno + + * 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 * riece-options.el (riece-saved-forms): Add riece-layout. diff --git a/lisp/Makefile.am b/lisp/Makefile.am index d079d7c..e507f5f 100644 --- 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 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 +;; 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 --- 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 --- 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 --- 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 --- 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)