From 005a2a7642c9f43d699922799801124a77d56f5d Mon Sep 17 00:00:00 2001 From: Daiki Ueno Date: Mon, 4 Aug 2003 04:44:14 +0000 Subject: [PATCH] Merge strict-naming branch. --- doc/riece-ja.texi | 98 +++++-------- lisp/COMPILE | 4 +- lisp/ChangeLog | 220 +++++++++++++++++++++++++++++ lisp/Makefile.am | 3 +- lisp/riece-300.el | 212 +++++++++++++++------------- lisp/riece-alias.el | 99 +++++++++++++ lisp/riece-channel.el | 115 ++++++--------- lisp/riece-commands.el | 209 ++++++++++++++++------------ lisp/riece-compat.el | 4 + lisp/riece-ctcp.el | 25 ++-- lisp/riece-display.el | 226 +++++++++++++++--------------- lisp/riece-doctor.el | 110 +++++++++++++++ lisp/riece-emacs.el | 3 + lisp/riece-filter.el | 50 ++++--- lisp/riece-globals.el | 35 ++--- lisp/riece-handle.el | 308 +++++++++++++++++++++++------------------ lisp/riece-identity.el | 191 +++++++++---------------- lisp/riece-message.el | 101 +++++++------- lisp/riece-mini.el | 8 +- lisp/riece-misc.el | 70 +++++----- lisp/riece-naming.el | 48 ++++--- lisp/riece-options.el | 10 -- lisp/riece-rdcc.el | 7 +- lisp/riece-server.el | 143 ++++++++----------- lisp/riece-unread.el | 4 +- lisp/riece-user.el | 97 +++++-------- lisp/riece-xemacs.el | 3 + lisp/riece.el | 23 +-- 28 files changed, 1420 insertions(+), 1006 deletions(-) create mode 100644 lisp/riece-alias.el create mode 100644 lisp/riece-doctor.el diff --git a/doc/riece-ja.texi b/doc/riece-ja.texi index 0ade1d6..f96e8e9 100644 --- a/doc/riece-ja.texi +++ b/doc/riece-ja.texi @@ -110,7 +110,7 @@ Riece $B$O!"D9$$4V%a%s%F%J%s%9IT2DG=$J>uBV$K$"$C$?(B Liece $B$N%3!<%I$r40A4$K @section Installation Riece $B$N:G?7HG$O!"(B -@uref{http://wiliki.designflaw.org/index.cgi?Riece&l=jp} $B$GG[I[$7$F$$$^(B +@uref{http://wiliki.designflaw.org/riece.cgi} $B$GG[I[$7$F$$$^(B $B$9!#E83+$7$?$i!"0J2<$N%3%^%s%I$rAw(B $B%_%K%P%C%U%!$N$_$G(B IRC $B$r$9$k(B @item riece-log $B2qOC$N%m%0$N<}=8(B +@item riece-alias +$B%A%c%s%M%kL>$d%K%C%/%M!<%`$NJLL>$rDj5A(B @end table $B$3$l$i$N$&$A!"(B@samp{riece-highlight} $B$H(B @samp{riece-ctcp} $B$O%G%U%)%k%H$G(B @@ -704,13 +706,10 @@ Riece $B$OJ#?t$N%5!<%P$KF1;~$K@\B3$9$k$?$a!"%5!<%PKh$KJL!9$NL>A06u4V$r4IM}(B $B%m!<%+%kJQ?t$r2p$7$F%"%/%;%9$7$^$9!#(B @subsection Obtaining server buffer -$B%5!<%P$N%P%C%U%!$rA0$rF@$kI,MW$,$"$j(B -$B$^$9!#$3$l$K$O(B @code{riece-find-server-name} $B$r;H$$$^$9!#$3$N4X?t$O!">u(B -$B67$K1~$8$FA*Br$9$Y$-%5!<%P$NL>A0$rJV$7$^$9!#6qBNE*$K$O0J2<$N=g=x$G8!:w$r(B -$B9T$$$^$9!#(B -@findex riece-find-server-name +$B%5!<%P$N%W%m%;%9$rF@$k$K$O!"$^$:$O$8$a$K%5!<%P$NL>A0$rF@$kI,MW$,$"$j(B +$B$^$9!#%5!<%P$NL>A0$O0J2<$K5s$2$k$$$/$D$+$NJ}K!$GA06u4V$r4IM}(B $BCM$=$N$b$N(B @item -@vindex riece-current-channel -$B%f!<%6$,8=:_$$$k%A%c%s%M%k(B (@code{riece-current-channel}) $B$NBg0hL>(B($B8e=R(B) -$B$+$i@Z$j=P$7$?%5!<%PL>(B -@end enumerate +@samp{riece-identity} $B%*%V%8%'%/%H$K7k$SIU$1$i$l$?%5!<%PL>(B($B8e=R(B) +@end table -$B$3$&$7$FF@$?%5!<%PL>$G(B @code{riece-server-process-alist} $B$r:w$-!"%5!<%P(B -$B$N%W%m%;%9$r2A$9$k$3$H$,$G$-$^$9!#(B -@vindex riece-server-process-alist +$B$3$&$7$FF@$?%5!<%PL>$G(B @code{riece-server-process} $B$r8F=P$7!"%5!<%P$N(B +$B%W%m%;%9$rl9g!"%A%c%s%M%kL>$d%K%C%/$r(B($B%5!<%P$N%P%C%U%!>e$@$1(B -$B$G$O$J$/(B)$BBg0hE*$K6hJL$9$kI,MW$,@8$8$^$9!#$=$3$G!"$3$l$i$NL>A0$r9)IW$7$F!"(B -$BL>A0$N8e$K6uGr$r64$s$G%5!<%PL>$r;XDj$9$k(B -$B$H8F$S$^$9!#$?$H$($P!"(B@samp{irc6} $B$H$$$&%5!<%P$N(B @samp{#Liece} $B$H$$$&%A%c(B -$B%s%M%k$NBg0hL>$O(B @samp{#Liece irc6} $B$H$J$j$^$9!#(B +@subsection Identity +$BJ#?t$N%5!<%P$K7R$$$@>l9g!"%A%c%s%M%kL>$d%K%C%/$r(B($B%5!<%P$N%P%C%U%!>e$@(B +$B$1$G$O$J$/(B)$BBg0hE*$K6hJL$9$kI,MW$,@8$8$^$9!#$3$N$h$&$JL>A0$rI=8=$9$k$N(B +$B$,(B @samp{riece-identity} $B%*%V%8%'%/%H$G$9!#(B -$B$3$3$G6h@Z$j$r6uGr$K$7$F$$$k$N$O!"(BRFC2812 $B$G%A%c%s%M%k$K;HMQ$G$-$J$$J8;z(B -$B$@$+$i$G$9!#(B +@samp{riece-identity} $B%*%V%8%'%/%H$O0J2<$N(B 2 $B$D$NMWAG$r$b$D%Y%/%?!<$G$9!#(B + +@table @samp +@item prefix +$B%5!<%P%m!<%+%k$JL>A0(B +@item server +$B%5!<%P$NL>A0(B +@end table -$BBg0hL>$r07$&$K$O!"(B@samp{riece-identity} $B$H$$$&Cj>]$r2p$7$^$9!#$3$N%b%8%e!<(B -$B%k$G$O!"0J2<$N$h$&$J4X?t$,Dj5A$5$l$F$$$^$9!#(B +@samp{riece-identity} $B%*%V%8%'%/%H$KBP$9$kA`:n$K$O0J2<$N$h$&$J$b$N$,$"$j$^$9!#(B @defun riece-make-identity prefix &optional server -$BBg0hI=5-$r:n@.$7$^$9!#(Bserver $B$,>JN,$5$l$?>l9g$K$O!"(B +@samp{riece-identity} $B%*%V%8%'%/%H$r:n@.$7$^$9!#(Bserver $B$,>JN,$5$l$?>l9g$K$O!"(B riece-find-server-name $B$r;H$C$F$r;H$$$^$9(B @end defun @defun riece-identity-prefix identity -$BBg0hI=5-$+$i%5!<%PL>$r=|$/ItJ,$rJV$7$^$9(B +@samp{riece-identity} $B%*%V%8%'%/%H$+$i%5!<%P%m!<%+%k$JL>A0$rA0$r$r=|$/ItJ,$r@55,2=$7$^$9!#$9$J$o$A!"(B -@var{prefix} $B$rA4$F>.J8;z$KD>$7$?>e$G!"(BRFC2812 2.2 $B$K$J$i$$!"(B -@samp{[]\~} $B$N$=$l$>$l$NJ8;z$r(B @samp{@{@}|^} $B$KCV$-49$($^$9!#(B -@end defun - @defun riece-identity-equal ident1 ident2 -$BFs$D$NBg0hI=5-$,F1Ey$+D4$Y$^$9!#(B -@end defun - -@defun riece-identity-equal-safe ident1 ident2 -@code{riece-identity-equal} $B$H0l=o$G$9$,!"0z?t$H$7$FM?$($i$l$?J8;zNs$K%5!<(B -$B%PL>$,IU2C$5$l$F$$$J$1$l$P!"IU2C$7$F$+$i8!::$r9T$$$^$9!#(B +2 $B$D$N(B@samp{riece-identity} $B%*%V%8%'%/%H$,F1Ey$+D4$Y$^$9!#(B @end defun @defun riece-identity-equal-no-server ident1 ident2 -$BFs$D$NBg0hI=5-$N%5!<%P0J30$NItJ,$,F1Ey$+D4$Y$^$9!#(B +2 $B$D$N(B@samp{riece-identity} $B%*%V%8%'%/%H$N%5!<%P%m!<%+%k$JL>A0$,F1Ey$+(B +$BD4$Y$^$9!#(B @end defun @defun riece-identity-member elt list -$BBg0hI=5-(B @var{elt} $B$,(B @var{list} $B$K4^$^$l$k$+8!::$7$^$9!#(B -@end defun - -@defun riece-identity-member-safe elt list -@code{riece-identity-member} $B$H0l=o$G$9$,!"0z?t$K%5!<%PL>$,IU2C$5$l$F$$(B -$B$J$1$l$P!"IU2C$7$F$+$i8!::$r9T$$$^$9!#(B -@end defun - -@defun riece-identity-member-no-server elt list -@code{riece-identity-member} $B$H0l=o$G$9$,!"Bg0hI=5-$N%5!<%P0J30$NItJ,$@(B -$B$1$r8!::$7$^$9!#(B +@samp{riece-identity} $B%*%V%8%'%/%H(B @var{elt} $B$,(B @var{list} $B$K4^$^$l$k(B +$B$+8!::$7$^$9!#(B @end defun @subsection Channel and user management -IRC $B$N%A%c%s%M%k$H%f!<%6$O4pK\E*$KC1$J$k%Y%/%?!<$H$7$FI=8=$5$l$F$$$^$9!#(B -JOIN $B$d(B PART $B$H$$$C$?FCJL$JA`:n$O!"$3$l$i$N%*%V%8%'%/%H$K$O7k$S$D$1$^$;(B -$B$s!#7k$S$D$1$?$[$&$,%*%V%8%'%/%H;X8~$GNI$$$N$G$O$J$$$+!"$H$$$&0U8+$b$"$j(B -$B$^$9$,!"$=$N$h$&$K$9$k$H!"Aj8_$N7k$SIU$-$,6[L)$K$J$j$9$.!"%9%Q%2%C%F%#$N(B -$B$b$H$K$J$k$3$H$O4{$K7P83:Q$_$G$9!#(B +@samp{riece-identity} $B%*%V%8%'%/%H$K$h$C$F<1JL$5$l$k(B IRC $B$N%A%c%s%M%k(B +$B$H%f!<%6$O$=$l$>$l(B @samp{riece-channel} $B%*%V%8%'%/%H$H(B +@samp{riee-user} $B%*%V%8%'%/%H$K$h$jI=8=$5$l$^$9!#(B @subsubsection Channels @code{riece-channel} $B$O!"(BIRC $B$N%A%c%s%M%k$rI=$9%*%V%8%'%/%H$G$9!#0J2<$N(B @@ -835,9 +813,9 @@ AWAY $BCf$+$I$&$+(B @end table @subsubsection Mediator -$B$5$F!"%A%c%s%M%k$H%f!<%6$N;22C$r4IM}$9$k$?$a$K!"(B @code{riece-naming} $B$H(B -$B$$$&>e0L$N%b%8%e!<%k$rMQ0U$7$F$$$^$9!#$3$l$O!"%G%6%$%s%Q%?!<%s$G$$$&$H$3(B -$B$m$N(B Mediator $B%Q%?!<%s$KAjEv$9$k$b$N$G$9!#(B +$B%A%c%s%M%k$H%f!<%6$N;22C!&N%C&$r4IM}$9$k$?$a$K!"(B @code{riece-naming} +$B$H$$$&>e0L$N%b%8%e!<%k$rMQ0U$7$F$$$^$9!#$3$l$O!"%G%6%$%s%Q%?!<%s$G$$$&(B +$B$H$3$m$N(B Mediator $B%Q%?!<%s$KAjEv$9$k$b$N$G$9!#(B @code{riece-naming} $B$r2p$9$k$3$H$G!"A0=R$N%A%c%s%M%k!&%f!<%6%*%V%8%'%/%H(B $B$KD>@\A06u4V$K0BA4$K%"%/%;%9$9$k$3$H$,$G$-$^$9!#(B diff --git a/lisp/COMPILE b/lisp/COMPILE index 9b9c2bf..d5473c2 100644 --- a/lisp/COMPILE +++ b/lisp/COMPILE @@ -45,7 +45,9 @@ riece-mini riece-rdcc riece-url - riece-unread)))) + riece-unread + riece-doctor + riece-alias)))) (defun riece-compile-modules (modules) (let ((load-path (cons nil load-path))) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index bfb6fb9..5564fca 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,34 @@ +2003-08-04 Daiki Ueno + + * riece-server.el (riece-find-server-name): Abolish. + + * riece-alias.el: Add usage. + +2003-08-04 Daiki Ueno + + * riece-mini.el (riece-mini-send-message): Use + riece-completing-read-identity; don't use riece-own-channel-message. + + * riece-identity.el: Require 'riece-compat. + (riece-identity-prefix-case-table): New variable. + (riece-abbrev-identity-string-function): New variable. + (riece-expand-identity-string-function): New variable. + (riece-format-identity): Rename from riece-decode-identity. + (riece-parse-identity): Rename from riece-encode-identity. + (riece-with-identity-buffer): Abolish. + (riece-identity-canonicalize-prefix): Use case-table. + + * riece-filter.el (riece-handle-numeric-reply): Decode messages. + (riece-handle-message): Ditto. + + * riece-alias.el: New add-on. + * COMPILE (riece-modules): Add riece-alias. + * Makefile.am (EXTRA_DIST): Add riece-alias.el. + + * riece-emacs.el (riece-set-case-syntax-pair): New alias. + * riece-xemacs.el (riece-set-case-syntax-pair): New alias. + * riece-identity.el (riece-identity-canonicalize-prefix): Simplified. + 2003-08-03 Daiki Ueno * Riece: Version 0.0.4 released. @@ -8,6 +39,50 @@ * riece-unread.el (riece-unread-display-message-function): Don't check `selected-window'. It doesn't work as expected. +2003-06-23 Daiki Ueno + + * riece-misc.el (riece-channel-p): Moved from riece-channel.el. + + * riece-300.el: Rewrite using riece-decode-identity. + + * riece-identity.el (riece-completing-read-identity): Signal an + error when the encoded channel name is not matched with + riece-channel-regexp. + + * riece-globals.el (riece-channel-regexp): Moved from + riece-channel.el. + (riece-user-regexp): Moved form riece-user.el. + +2003-06-23 Daiki Ueno + + * riece-handle.el (riece-handle-join-message): Don't call + riece-switch-to-channel. + (riece-handle-part-message): Don't decode message if it is empty. + (riece-handle-kick-message): Ditto. + (riece-handle-quit-message): Ditto. + (riece-handle-kill-message): Ditto. + + * riece-commands.el (riece-command-part): Show the current channel + as default candidate. + + * riece-identity.el (riece-completing-read-identity): Accept + optional 5th argument `initial'. + + * riece-unread.el (riece-unread-update-channel-list-buffer): + Simplified. + + * riece-filter.el (riece-sentinel): Don't bind + riece-inhibit-update-buffers. + + * riece-display.el (riece-redisplay-buffer): New variable. + (riece-inhibit-update-buffers): Abolish. + (riece-update-channel-list-buffer): Memorize + encoded identity as text property on each line. + + * riece.el (riece-channel-list-mode): Make riece-redisplay-buffer + buffer local. + (riece-user-list-mode): Ditto. + 2003-06-22 Yoichi NAKAYAMA * riece-log.el, riece-mini.el, riece-unread.el, riece-url.el: @@ -15,6 +90,26 @@ * riece-coding.el (riece-default-coding-system): Fix default value. +2003-06-22 Daiki Ueno + + * riece-display.el (riece-inhibit-update-buffers): New variable. + * riece-filter.el (riece-sentinel): Bind + riece-inhibit-update-buffers while removing channels from + riece-current-channels. + * riece-unread.el (riece-unread-display-message-function): Don't + update channel list buffer when riece-inhibit-update-buffers is + non-nil. + (riece-unread-channel-switch-hook): Ditto. + (riece-unread-insinuate): Add + riece-unread-update-channel-list-buffer to + riece-update-buffer-functions. + + * riece-commands.el (riece-command-switch-to-channel): Call + riece-redisplay-buffers instead of riece-command-configure-windows. + + * riece-identity.el (riece-completing-read-identity): Remove nil + from riece-current-channels before converting it to an alist. + 2003-06-17 OHASHI Akira * riece-unread.el (riece-unread-display-message-function): Check a @@ -32,6 +127,131 @@ * riece-commands.el (riece-command-join): Use `let*' instead of `let'. (riece-command-part): Ditto. +2003-06-12 Daiki Ueno + + * riece-naming.el (riece-naming-assert-join): Call + riece-update-buffers. + (riece-naming-assert-part): Ditto. + + * riece-filter.el (riece-sentinel): Don't bind + riece-overriding-server-name; use riece-part-channel. + + * riece-display.el (riece-switch-to-channel): Don't set + riece-channel-buffer. + (riece-update-buffers): Set riece-channel-buffer here. + + * riece-commands.el (riece-command-switch-to-channel-by-number): Fixed. + (riece-command-close-server): Fixed completion bug. + (riece-command-universal-server-name-argument): Ditto. + +2003-06-12 Daiki Ueno + + * riece-doctor.el: Don't require 'doctor; autoload doctor-mode and + doctor-read-print. + + * riece-handle.el (riece-handle-nick-message): Use + riece-decode-identity to decode user. + (riece-handle-join-message): Ditto. + (riece-handle-part-message): Ditto. + (riece-handle-kick-message): Ditto. + (riece-handle-quit-message): Ditto. + (riece-handle-kill-message): Ditto. + (riece-handle-invite-message): Ditto. + (riece-handle-topic-message): Ditto. + (riece-handle-mode-message): Ditto. + +2003-06-12 Daiki Ueno + + * riece-message.el (riece-own-channel-message): Abolish. + + * riece-commands.el (riece-command-send-message): Don't use + riece-own-channel-message. + + * riece-doctor.el (riece-doctor-reply): Don't use + riece-own-channel-message. + (riece-doctor-hello-regexp): New user option. + (riece-doctor-bye-regexp): New user option. + +2003-06-11 Daiki Ueno + + * riece-identity.el (riece-identity-member-no-server): Abolish. + + * riece-doctor.el (riece-doctor-patients): Make it global variable. + (riece-doctor-after-privmsg-hook): Use riece-identity-member + instead of riece-identity-member-no-server. + +2003-06-11 Daiki Ueno + + * riece-doctor.el: New add-on. + * COMPILE (riece-modules): Add riece-doctor. + * Makefile.am (EXTRA_DIST): Add riece-doctor.el + +2003-06-11 Daiki Ueno + + * riece-handle.el (riece-handle-nick-message): Follow the change + of riece-identity-member. + + * riece-commands.el (riece-command-next-channel): Use + riece-identity-member instead of riece-identity-member-no-server. + (riece-command-previous-channel): Ditto. + +2003-06-11 Daiki Ueno + + * riece-identity.el (riece-completing-read-identity): Remove nil + from channels before completing-read. + + * riece-message.el (riece-message-make-name): Fix condition for priv. + (riece-message-make-global-name): Ditto. + (riece-message-buffer): Ditto. + + * riece-misc.el (riece-current-nickname): Use + riece-with-identity-buffer. + +2003-06-11 Daiki Ueno + + * riece-message.el (riece-message-parent-buffers): Regard message's + speaker as target when priv mode. + + * riece-display.el (riece-update-channel-indicator): Decode + riece-current-channel even in priv mode. + + * riece-identity.el (riece-decode-identity): Respect prefix-only. + (riece-completing-read-identity): Check if illegal characters in + channel name. + +2003-06-08 Daiki Ueno + + * riece.el (riece-buffer-mode-alist): Add riece-user-list-buffer. + * riece-globals.el (riece-user-buffer-format): Abolish. + (riece-user-list-buffer): Default to " *Users*". + * riece-display.el (riece-user-list-buffer-name): Abolish. + (riece-user-list-buffer-create): Abolish. + +2003-06-08 Daiki Ueno + + * riece-filter.el (riece-handle-numeric-reply): Don't decode messages. + (riece-handle-message): Ditto. + (riece-sentinel): Clear system here. + + * riece-server.el (riece-server-process-name): New function. + (riece-server-process): New function. + (riece-close-server): Abolish. + + * riece-identity.el: Adopt vector object representation for + identity objects. + (riece-with-identity-buffer): New macro. + (riece-decode-identity): New function. + (riece-encode-identity): New function. + + * riece-globals.el (riece-process-list): New variable. + (riece-server-process-alist): Abolish. + (riece-channel-buffer-alist): Abolish. + (riece-user-list-buffer-alist): Abolish. + (riece-short-channel-indicator): New variable. + + * riece-channel.el: Assume that we are already in the server buffer. + * riece-user.el: Likewise. + 2003-06-06 OHASHI Akira * riece-ndcc.el (riece-ndcc-server-sentinel): Close a parenthesis. diff --git a/lisp/Makefile.am b/lisp/Makefile.am index 0322658..8439371 100644 --- a/lisp/Makefile.am +++ b/lisp/Makefile.am @@ -7,7 +7,8 @@ EXTRA_DIST = COMPILE ChangeLog ChangeLog.Liece \ riece-options.el riece-server.el riece-user.el riece-version.el \ riece-xemacs.el riece.el \ riece-ctcp.el riece-url.el riece-unread.el \ - riece-ndcc.el riece-rdcc.el riece-log.el riece-mini.el + riece-ndcc.el riece-rdcc.el riece-log.el riece-mini.el \ + riece-doctor.el riece-alias.el CLEANFILES = auto-autoloads.el custom-load.el *.elc FLAGS ?= -batch -q -no-site-file diff --git a/lisp/riece-300.el b/lisp/riece-300.el index da7b073..499a98f 100644 --- a/lisp/riece-300.el +++ b/lisp/riece-300.el @@ -54,7 +54,9 @@ (concat (riece-concat-server-name (format "%s is (%s) [%s, %s]" - user + (riece-format-identity + (riece-make-identity user riece-server-name) + t) (riece-strip-user-at-host user-at-host) (if operator "operator" @@ -71,24 +73,34 @@ (riece-insert-info (list riece-dialogue-buffer riece-others-buffer) (concat - (riece-concat-server-name (concat "Online: " (substring string 1))) + (riece-concat-server-name + (concat "Online: " + (mapconcat + (lambda (user) + (riece-format-identity + (riece-make-identity user riece-server-name) + t)) + (split-string (substring string 1) " ") + ""))) "\n"))) (defun riece-handle-301-message (prefix number name string) - (when (string-match - (concat "^\\(" riece-user-regexp "\\) :") - string) - (let ((user (match-string 1 string)) - (message (substring string (match-end 0)))) - (riece-user-toggle-away user t) - (riece-insert-info - (list riece-dialogue-buffer riece-others-buffer) - (concat - (riece-concat-server-name - (format "%s is away: %s" user message)) - "\n"))) + (if (string-match (concat "^\\(" riece-user-regexp "\\) :") string) + (let ((user (match-string 1 string)) + (message (substring string (match-end 0)))) + (riece-user-toggle-away user t) + (riece-insert-info + (list riece-dialogue-buffer riece-others-buffer) + (concat + (riece-concat-server-name + (format "%s is away: %s" + (riece-format-identity + (riece-make-identity user riece-server-name) + t) + message)) + "\n")))) (riece-update-status-indicators) - (force-mode-line-update t))) + (force-mode-line-update t)) (defun riece-handle-305-message (prefix number name string) (riece-user-toggle-away riece-real-nickname nil) @@ -105,16 +117,21 @@ (concat "^\\(" riece-user-regexp "\\) \\([^ ]+\\) \\([^ ]+\\) \\* :") string) - (riece-insert-info - (list riece-dialogue-buffer riece-others-buffer) - (concat - (riece-concat-server-name - (format "%s is %s (%s@%s)" - (match-string 1 string) - (substring string (match-end 0)) - (match-string 2 string) - (match-string 3 string))) - "\n")))) + (let ((user (match-string 1 string)) + (name (substring string (match-end 0))) + (user-at-host (concat (match-string 2 string) "@" + (match-string 3 string)))) + (riece-insert-info + (list riece-dialogue-buffer riece-others-buffer) + (concat + (riece-concat-server-name + (format "%s is %s (%s)" + (riece-format-identity + (riece-make-identity user riece-server-name) + t) + name + user-at-host)) + "\n"))))) (defun riece-handle-312-message (prefix number name string) (if (string-match @@ -131,25 +148,33 @@ (defun riece-handle-313-message (prefix number name string) (if (string-match (concat "^" riece-user-regexp) string) - (riece-insert-info - (list riece-dialogue-buffer riece-others-buffer) - (concat - (riece-concat-server-name - (concat (match-string 0 string) " is an IRC operator")) - "\n")))) + (let ((user (match-string 0 string))) + (riece-insert-info + (list riece-dialogue-buffer riece-others-buffer) + (concat + (riece-concat-server-name + (concat (riece-format-identity + (riece-make-identity user riece-server-name) + t) + " is an IRC operator")) + "\n"))))) (defun riece-handle-317-message (prefix number name string) (if (string-match (concat "^\\(" riece-user-regexp "\\) \\([0-9]+\\) :") string) - (riece-insert-info - (list riece-dialogue-buffer riece-others-buffer) - (concat - (riece-concat-server-name - (format "%s is %s seconds idle" - (match-string 1 string) - (match-string 2 string))) - "\n")))) + (let ((user (match-string 1 string)) + (idle (match-string 2 string))) + (riece-insert-info + (list riece-dialogue-buffer riece-others-buffer) + (concat + (riece-concat-server-name + (format "%s is %s seconds idle" + (riece-format-identity + (riece-make-identity user riece-server-name) + t) + idle)) + "\n"))))) (defun riece-handle-351-message (prefix number name string) (if (string-match "\\([^ ]+\\.[^ ]+\\) \\([^ ]+\\) :" string) @@ -192,9 +217,10 @@ (let* ((channel (match-string 1 string)) (visible (match-string 2 string)) (topic (substring string (match-end 0)))) - (let ((buffer (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist)))) + (riece-channel-set-topic (riece-get-channel channel) topic) + (let* ((channel-identity (riece-make-identity channel + riece-server-name)) + (buffer (riece-channel-buffer-name channel-identity))) (riece-insert-info buffer (concat visible " users, topic: " topic "\n")) (riece-insert-info @@ -204,7 +230,8 @@ riece-dialogue-buffer) (concat (riece-concat-server-name - (format "%s users on %s, topic: %s" visible channel topic)) + (format "%s users on %s, topic: %s" visible + (riece-format-identity channel-identity t) topic)) "\n")))))) (defun riece-handle-324-message (prefix number name string) @@ -217,9 +244,9 @@ (while modes (riece-channel-toggle-mode channel (car modes) (eq toggle ?+)) (setq modes (cdr modes))) - (let ((buffer (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist)))) + (let* ((channel-identity (riece-make-identity channel + riece-server-name)) + (buffer (riece-channel-buffer-name channel-identity))) (riece-insert-info buffer (concat "Mode: " mode-string "\n")) (riece-insert-info (if (and riece-channel-buffer-mode @@ -228,7 +255,9 @@ riece-dialogue-buffer) (concat (riece-concat-server-name - (format "Mode for %s: %s" channel mode-string)) + (format "Mode for %s: %s" + (riece-format-identity channel-identity t) + mode-string)) "\n"))) (riece-update-channel-indicator) (force-mode-line-update t)))) @@ -237,9 +266,8 @@ (if (string-match "^\\([^ ]+\\) :" string) (let* ((channel (match-string 1 string)) (message (substring string (match-end 0))) - (buffer (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist)))) + (channel-identity (riece-make-identity channel riece-server-name)) + (buffer (riece-channel-buffer-name channel-identity))) (if remove (riece-channel-set-topic (riece-get-channel channel) nil) (riece-channel-set-topic (riece-get-channel channel) message) @@ -251,23 +279,24 @@ riece-dialogue-buffer) (concat (riece-concat-server-name - (format "Topic for %s: %s" channel message)) + (format "Topic for %s: %s" + (riece-format-identity channel-identity t) + message)) "\n")) (riece-update-channel-indicator))))) (defun riece-handle-331-message (prefix number name string) - (riece-handle-set-topic prefix name name string t)) + (riece-handle-set-topic prefix number name string t)) (defun riece-handle-332-message (prefix number name string) - (riece-handle-set-topic prefix name name string nil)) + (riece-handle-set-topic prefix number name string nil)) (defun riece-handle-341-message (prefix number name string) (if (string-match "^\\([^ ]+\\) " string) (let* ((channel (match-string 1 string)) (user (substring string (match-end 0))) - (buffer (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist)))) + (channel-identity (riece-make-identity channel riece-server-name)) + (buffer (riece-channel-buffer-name channel-identity))) (riece-insert-info buffer (concat "Inviting " user "\n")) (riece-insert-info (if (and riece-channel-buffer-mode @@ -276,7 +305,8 @@ riece-dialogue-buffer) (concat (riece-concat-server-name - (format "Inviting %s to %s" user channel)) + (format "Inviting %s to %s" user + (riece-format-identity channel-identity t))) "\n"))))) (defun riece-handle-352-message (prefix number name string) @@ -291,31 +321,31 @@ (flag (match-string 8 string)) (hops (match-string 9 string)) (name (substring string (match-end 0))) - (buffer (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist)))) + (buffer (riece-channel-buffer-name + (riece-make-identity channel riece-server-name))) + (info (format "%10s = %s (%s) [%s, %s, %s hops, on %s]" + (concat + (if (memq flag '(?@ ?+)) + (char-to-string flag) + " ") + (riece-format-identity + (riece-make-identity nick riece-server-name) + t)) + name + (riece-strip-user-at-host + (concat user "@" host)) + (if operator + "operator" + "not operator") + (if away + "away" + "not away") + hops + server))) (riece-naming-assert-join nick channel) (riece-user-toggle-away user away) (riece-user-toggle-operator user operator) - (riece-insert-info - buffer - (format "%10s = %s (%s) [%s, %s, %s hops, on %s]\n" - (concat - (if (memq flag '(?@ ?+)) - (char-to-string flag) - " ") - nick) - name - (riece-strip-user-at-host - (concat user "@" host)) - (if operator - "operator" - "not operator") - (if away - "away" - "not away") - hops - server)) + (riece-insert-info buffer (concat info "\n")) (riece-insert-info (if (and riece-channel-buffer-mode (not (eq buffer riece-channel-buffer))) @@ -323,24 +353,12 @@ riece-dialogue-buffer) (concat (riece-concat-server-name - (format "%s %10s = %s (%s) [%s, %s, %s hops, on %s]\n" - channel - (concat - (if (memq flag '(?@ ?+)) - (char-to-string flag) - " ") - nick) - name - (riece-strip-user-at-host - (concat user "@" host)) - (if operator - "operator" - "not operator") - (if away - "away" - "not away") - hops - server)) + (concat + (riece-format-identity + (riece-make-identity channel riece-server-name) + t) + " " + info)) "\n")) (riece-redisplay-buffers)))) diff --git a/lisp/riece-alias.el b/lisp/riece-alias.el new file mode 100644 index 0000000..dae97f5 --- /dev/null +++ b/lisp/riece-alias.el @@ -0,0 +1,99 @@ +;;; riece-alias.el --- define aliases of names +;; Copyright (C) 1998-2003 Daiki Ueno + +;; Author: Daiki Ueno +;; 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. + +;; This add-on allows you to define aliases for IRC names. + +;; To use, add the following line to your ~/.riece/init.el: +;; (add-to-list 'riece-addons 'riece-alias) + +;; For example, if you want to define an alias `#l' for `#Liece', you +;; can customize riece-alias-alist as follows: +;; (setq riece-alias-alist '(("#Liece" . "#l"))) + +;;; Code: + +(defgroup riece-alias nil + "Define aliases of names" + :prefix "riece-" + :group 'riece) + +(defcustom riece-alias-percent-hack-mask "*.jp" + "The mask of local IRC network" + :type 'string + :group 'riece-alias) + +(defcustom riece-alias-enable-percent-hack t + "If non-nil, the target mask is abbreviated with `%'." + :type 'boolean + :group 'riece-alias) + +(defcustom riece-alias-alist nil + "An alist mapping aliases to names." + :type 'list + :group 'riece-alias) + +(defun riece-alias-abbrev-percent-hack (string) + (if (string-match (concat "^#\\([^ ]+\\):" + (regexp-quote riece-alias-percent-hack-mask) + "\\( .+\\|$\\)") + string) + (replace-match "%\\1\\2" nil nil string) + string)) + +(defun riece-alias-expand-percent-hack (string) + (if (string-match "^%\\([^ ]+\\)\\( .+\\|$\\)" string) + (replace-match (concat "#\\1:" riece-alias-percent-hack-mask "\\2") + nil nil string) + string)) + +(defun riece-alias-abbrev-identity-string (string) + (if riece-alias-enable-percent-hack + (setq string (riece-alias-abbrev-percent-hack string))) + (let ((alist riece-alias-alist)) + (catch 'done + (while alist + (if (equal (car (car alist)) string) + (throw 'done (cdr (car alist)))) + (setq alist (cdr alist))) + string))) + +(defun riece-alias-expand-identity-string (string) + (if riece-alias-enable-percent-hack + (setq string (riece-alias-expand-percent-hack string))) + (let ((alist riece-alias-alist)) + (catch 'done + (while alist + (if (equal (cdr (car alist)) string) + (throw 'done (car (car alist)))) + (setq alist (cdr alist))) + string))) + +(defun riece-alias-insinuate () + (setq riece-abbrev-identity-string-function + #'riece-alias-abbrev-identity-string + riece-expand-identity-string-function + #'riece-alias-expand-identity-string)) + +(provide 'riece-alias) + +;;; riece-alias.el ends here diff --git a/lisp/riece-channel.el b/lisp/riece-channel.el index 5e9971a..5805faf 100644 --- a/lisp/riece-channel.el +++ b/lisp/riece-channel.el @@ -25,38 +25,27 @@ ;;; Code: (require 'riece-options) +(require 'riece-globals) (require 'riece-identity) -;;; String representation of a channel: -(defconst riece-channel-regexp "^[+&#!]") - -(defun riece-channel-p (string) - "Return t if STRING is a channel. -\(i.e. it matches `riece-channel-regexp')" - (string-match riece-channel-regexp string)) - ;;; Channel object: (defun riece-find-channel (name) "Get a channel object named NAME from the server buffer." - (riece-with-server-buffer - (let ((symbol (intern-soft (riece-identity-canonicalize-prefix - (riece-identity-prefix name)) - riece-obarray))) - (if symbol - (symbol-value symbol))))) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name) + riece-obarray))) + (if symbol + (symbol-value symbol)))) (defun riece-forget-channel (name) - (riece-with-server-buffer - (let ((symbol (intern-soft (riece-identity-canonicalize-prefix - (riece-identity-prefix name)) - riece-obarray))) - (when symbol - (makunbound symbol) - (unintern (symbol-name symbol) riece-obarray))))) - -(defun riece-make-channel (&optional users operators speakers - topic modes banned invited uninvited - key) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name) + riece-obarray))) + (when symbol + (makunbound symbol) + (unintern (symbol-name symbol) riece-obarray)))) + +(defun riece-make-channel (users operators speakers + topic modes banned invited uninvited + key) "Make an instance of channel object. Arguments are appropriate to channel users, operators, speakers \(+v), topic, modes, banned users, invited users, uninvited users, and @@ -64,16 +53,13 @@ the channel key, respectively." (vector users operators speakers topic modes banned invited uninvited)) (defun riece-get-channel (name) - (riece-with-server-buffer - (let ((symbol (intern-soft (riece-identity-canonicalize-prefix - (riece-identity-prefix name)) - riece-obarray))) - (if symbol - (symbol-value symbol) - (set (intern (riece-identity-canonicalize-prefix - (riece-identity-prefix name)) - riece-obarray) - (riece-make-channel)))))) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name) + riece-obarray))) + (if symbol + (symbol-value symbol) + (set (intern (riece-identity-canonicalize-prefix name) + riece-obarray) + (riece-make-channel nil nil nil nil nil nil nil nil nil))))) (defun riece-channel-users (channel) "Return the users of CHANNEL." @@ -147,55 +133,46 @@ the channel key, respectively." "Set the key of CHANNEL to VALUE." (aset channel 8 value)) -(defun riece-channel-get-users (&optional name) +(defun riece-channel-get-users (name) "Return channel's users as list." - (riece-channel-users - (riece-get-channel (or name riece-current-channel)))) + (riece-channel-users (riece-get-channel name))) -(defun riece-channel-get-operators (&optional name) +(defun riece-channel-get-operators (name) "Return channel's operators as list." - (riece-channel-operators - (riece-get-channel (or name riece-current-channel)))) + (riece-channel-operators (riece-get-channel name))) -(defun riece-channel-get-speakers (&optional name) +(defun riece-channel-get-speakers (name) "Return channel's speakers as list." - (riece-channel-speakers - (riece-get-channel (or name riece-current-channel)))) + (riece-channel-speakers (riece-get-channel name))) -(defun riece-channel-get-topic (&optional name) +(defun riece-channel-get-topic (name) "Return channel's topic." - (riece-channel-topic - (riece-get-channel (or name riece-current-channel)))) + (riece-channel-topic (riece-get-channel name))) -(defun riece-channel-get-modes (&optional name) +(defun riece-channel-get-modes (name) "Return channel's modes as list." - (riece-channel-modes - (riece-get-channel (or name riece-current-channel)))) + (riece-channel-modes (riece-get-channel name))) -(defun riece-channel-get-banned (&optional name) +(defun riece-channel-get-banned (name) "Return channel's banned users as list." - (riece-channel-banned - (riece-get-channel (or name riece-current-channel)))) + (riece-channel-banned (riece-get-channel name))) -(defun riece-channel-get-invited (&optional name) +(defun riece-channel-get-invited (name) "Return channel's invited users as list." - (riece-channel-invited - (riece-get-channel (or name riece-current-channel)))) + (riece-channel-invited (riece-get-channel name))) -(defun riece-channel-get-uninvited (&optional name) +(defun riece-channel-get-uninvited (name) "Return channel's uninvited users as list." - (riece-channel-uninvited - (riece-get-channel (or name riece-current-channel)))) + (riece-channel-uninvited (riece-get-channel name))) -(defun riece-channel-get-key (&optional name) +(defun riece-channel-get-key (name) "Return channel's key." - (riece-channel-key - (riece-get-channel (or name riece-current-channel)))) + (riece-channel-key (riece-get-channel name))) ;;; Functions called from `riece-handle-mode-message': (defun riece-channel-toggle-mode (name mode flag) "Add or remove channel MODE of channel." - (let* ((channel (riece-get-channel (or name riece-current-channel))) + (let* ((channel (riece-get-channel name)) (modes (riece-channel-modes channel))) (if flag (unless (memq mode modes) @@ -205,7 +182,7 @@ the channel key, respectively." (defun riece-channel-toggle-banned (name pattern flag) "Add or remove banned PATTERN of channel." - (let* ((channel (riece-get-channel (or name riece-current-channel))) + (let* ((channel (riece-get-channel name)) (banned (riece-channel-banned channel))) (if flag (unless (member pattern banned) @@ -215,7 +192,7 @@ the channel key, respectively." (defun riece-channel-toggle-invited (name pattern flag) "Add or remove invited PATTERN of channel." - (let* ((channel (riece-get-channel (or name riece-current-channel))) + (let* ((channel (riece-get-channel name)) (invited (riece-channel-invited channel))) (if flag (unless (member pattern invited) @@ -225,7 +202,7 @@ the channel key, respectively." (defun riece-channel-toggle-uninvited (name pattern flag) "Add or remove uninvited PATTERN to channel." - (let* ((channel (riece-get-channel (or name riece-current-channel))) + (let* ((channel (riece-get-channel name)) (uninvited (riece-channel-uninvited channel))) (if flag (unless (member pattern uninvited) @@ -236,7 +213,7 @@ the channel key, respectively." (defun riece-channel-toggle-user (name user flag) "Add or remove an user to channel." - (let* ((channel (riece-get-channel (or name riece-current-channel))) + (let* ((channel (riece-get-channel name)) (users (riece-channel-users channel))) (if flag (unless (member user users) @@ -246,7 +223,7 @@ the channel key, respectively." (defun riece-channel-toggle-operator (name user flag) "Add or remove an operator to channel." - (let* ((channel (riece-get-channel (or name riece-current-channel))) + (let* ((channel (riece-get-channel name)) (operators (riece-channel-operators channel))) (if flag (unless (member user operators) @@ -256,7 +233,7 @@ the channel key, respectively." (defun riece-channel-toggle-speaker (name user flag) "Add or remove an speaker to channel." - (let* ((channel (riece-get-channel (or name riece-current-channel))) + (let* ((channel (riece-get-channel name)) (speakers (riece-channel-speakers channel))) (if flag (unless (member user speakers) diff --git a/lisp/riece-commands.el b/lisp/riece-commands.el index 3442c5d..2c8cb1a 100644 --- a/lisp/riece-commands.el +++ b/lisp/riece-commands.el @@ -35,12 +35,11 @@ ;;; Channel movement: (defun riece-command-switch-to-channel (channel) - (interactive - (list (completing-read "Channel/User: " - (mapcar #'list riece-current-channels) - nil t))) - (riece-switch-to-channel channel) - (riece-command-configure-windows)) + (interactive (list (riece-completing-read-identity + "Channel/User: " riece-current-channels nil t))) + (unless (equal channel riece-current-channels) + (riece-switch-to-channel channel) + (riece-redisplay-buffers))) (defun riece-command-switch-to-channel-by-number (number) (interactive @@ -48,15 +47,9 @@ (if (string-match "[0-9]+$" command-name) (list (string-to-number (match-string 0 command-name))) (list (string-to-number (read-string "Number: ")))))) - (let ((channels riece-current-channels) - (index 1)) - (while (and channels - (< index number)) - (if (car channels) - (setq index (1+ index))) - (setq channels (cdr channels))) - (if (car channels) - (riece-command-switch-to-channel (car channels)) + (let ((channel (nth (1- number) riece-current-channels))) + (if channel + (riece-command-switch-to-channel channel) (error "No such number!")))) (eval-and-compile @@ -71,7 +64,7 @@ "Select the next channel." (interactive) (when (> (length riece-current-channels) 1) - (let ((pointer (cdr (riece-identity-member-no-server + (let ((pointer (cdr (riece-identity-member riece-current-channel riece-current-channels)))) (while (and pointer @@ -90,7 +83,7 @@ "Select the previous channel." (interactive) (when (> (length riece-current-channels) 1) - (let ((pointer (riece-identity-member-no-server + (let ((pointer (riece-identity-member riece-current-channel riece-current-channels)) (start riece-current-channels) @@ -153,8 +146,11 @@ (defun riece-command-topic (topic) (interactive (list (read-from-minibuffer - "Topic: " (cons (or (riece-channel-get-topic - riece-current-channel) + "Topic: " (cons (or (riece-with-server-buffer + (riece-identity-server riece-current-channel) + (riece-channel-get-topic + (riece-identity-prefix + riece-current-channel))) "") 0)))) (riece-send-string (format "TOPIC %s :%s\r\n" @@ -165,7 +161,8 @@ (interactive (let ((completion-ignore-case t)) (unless (and riece-current-channel - (riece-channel-p riece-current-channel)) + (riece-channel-p (riece-identity-prefix + riece-current-channel))) (error "Not on a channel")) (list (completing-read "User: " @@ -178,7 +175,8 @@ (interactive (let ((completion-ignore-case t)) (unless (and riece-current-channel - (riece-channel-p riece-current-channel)) + (riece-channel-p (riece-identity-prefix + riece-current-channel))) (error "Not on a channel")) (list (completing-read "User: " @@ -201,8 +199,9 @@ (list (read-from-minibuffer "Pattern: " (if (and riece-current-channel - (riece-channel-p riece-current-channel)) - (cons (riece-identity-prefix riece-current-channel) + (riece-channel-p (riece-identity-prefix + riece-current-channel))) + (cons (riece-format-identity riece-current-channel t) 0)))))) (if (or (not (equal pattern "")) (yes-or-no-p "Really want to query NAMES without argument? ")) @@ -214,8 +213,9 @@ (list (read-from-minibuffer "Pattern: " (if (and riece-current-channel - (riece-channel-p riece-current-channel)) - (cons (riece-identity-prefix riece-current-channel) + (riece-channel-p (riece-identity-prefix + riece-current-channel))) + (cons (riece-format-identity riece-current-channel t) 0)))))) (if (or (not (equal pattern "")) (yes-or-no-p "Really want to query WHO without argument? ")) @@ -227,8 +227,9 @@ (list (read-from-minibuffer "Pattern: " (if (and riece-current-channel - (riece-channel-p riece-current-channel)) - (cons (riece-identity-prefix riece-current-channel) + (riece-channel-p (riece-identity-prefix + riece-current-channel))) + (cons (riece-format-identity riece-current-channel t) 0)))))) (if (or (not (equal pattern "")) (yes-or-no-p "Really want to query LIST without argument? ")) @@ -239,30 +240,34 @@ (let* ((completion-ignore-case t) (channel (if current-prefix-arg - (completing-read - "Channel/User: " - (mapcar #'list riece-current-channels)) + (riece-completing-read-identity + "Channel/User: " riece-current-channels) riece-current-channel)) (riece-overriding-server-name (riece-identity-server channel)) (riece-temp-minibuffer-message (concat "[Available modes: " - (riece-with-server-buffer - (if (and (riece-channel-p channel) - riece-supported-channel-modes) - (apply #'string riece-supported-channel-modes) - (if (and (not (riece-channel-p channel)) - riece-supported-user-modes) - (apply #'string riece-supported-user-modes)))) + (riece-with-server-buffer (riece-identity-server channel) + (if (riece-channel-p (riece-identity-prefix channel)) + (if riece-supported-channel-modes + (apply #'string riece-supported-channel-modes)) + (if riece-supported-user-modes + (apply #'string riece-supported-user-modes)))) "]"))) (list channel (read-from-minibuffer - (concat (riece-concat-modes channel "Mode (? for help)") ": ") + (concat (riece-concat-channel-modes + channel "Mode (? for help)") ": ") nil riece-minibuffer-map)))) - (riece-send-string (format "MODE %s :%s\r\n" channel change))) + (riece-send-string (format "MODE %s :%s\r\n" (riece-identity-prefix channel) + change))) (defun riece-command-set-operators (users &optional arg) (interactive - (let ((operators (riece-channel-get-operators riece-current-channel)) + (let ((operators + (riece-with-server-buffer + (riece-identity-server riece-current-channel) + (riece-channel-get-operators + (riece-identity-prefix riece-current-channel)))) (completion-ignore-case t) users) (if current-prefix-arg @@ -271,11 +276,16 @@ (mapcar #'list operators))) (setq users (riece-completing-read-multiple "Users" - (delq nil (mapcar (lambda (user) - (unless (member user operators) - (list user))) - (riece-channel-get-users - riece-current-channel)))))) + (delq nil (mapcar + (lambda (user) + (unless (member user operators) + (list user))) + (riece-with-server-buffer + (riece-identity-server + riece-current-channel) + (riece-channel-get-users + (riece-identity-prefix + riece-current-channel)))))))) (list users current-prefix-arg))) (let (group) (while users @@ -294,7 +304,11 @@ (defun riece-command-set-speakers (users &optional arg) (interactive - (let ((speakers (riece-channel-get-speakers riece-current-channel)) + (let ((speakers + (riece-with-server-buffer + (riece-identity-server riece-current-channel) + (riece-channel-get-speakers + (riece-identity-prefix riece-current-channel)))) (completion-ignore-case t) users) (if current-prefix-arg @@ -303,11 +317,16 @@ (mapcar #'list speakers))) (setq users (riece-completing-read-multiple "Users" - (delq nil (mapcar (lambda (user) - (unless (member user speakers) - (list user))) - (riece-channel-get-users - riece-current-channel)))))) + (delq nil (mapcar + (lambda (user) + (unless (member user speakers) + (list user))) + (riece-with-server-buffer + (riece-identity-server + riece-current-channel) + (riece-channel-get-users + (riece-identity-prefix + riece-current-channel)))))))) (list users current-prefix-arg))) (let (group) (while users @@ -337,12 +356,16 @@ (format "NOTICE %s :%s\r\n" (riece-identity-prefix riece-current-channel) message)) - (riece-own-channel-message message riece-current-channel 'notice)) + (riece-display-message + (riece-make-message (riece-current-nickname) riece-current-channel + message 'notice t))) (riece-send-string (format "PRIVMSG %s :%s\r\n" (riece-identity-prefix riece-current-channel) message)) - (riece-own-channel-message message))) + (riece-display-message + (riece-make-message (riece-current-nickname) riece-current-channel + message nil t)))) (defun riece-command-enter-message () "Send the current line to the current channel." @@ -365,11 +388,7 @@ (next-line 1))) (defun riece-command-join-channel (target key) - (let ((server-name (riece-identity-server target)) - process) - (if server-name - (setq process (cdr (assoc server-name riece-server-process-alist))) - (setq process riece-server-process)) + (let ((process (riece-server-process (riece-identity-server target)))) (unless process (error "%s" (substitute-command-keys "Type \\[riece-command-open-server] to open server."))) @@ -382,7 +401,7 @@ (riece-identity-prefix target)))))) (defun riece-command-join-partner (target) - (let ((pointer (riece-identity-member-safe target riece-current-channels))) + (let ((pointer (riece-identity-member target riece-current-channels))) (if pointer (riece-command-switch-to-channel (car pointer)) (riece-join-channel target) @@ -393,27 +412,23 @@ (interactive (let* ((completion-ignore-case t) (target - (completing-read "Channel/User: " - (mapcar #'list riece-current-channels))) + (riece-completing-read-identity + "Channel/User: " riece-current-channels)) key) (if (and current-prefix-arg (riece-channel-p target)) (setq key (riece-read-passwd (format "Key for %s: " target)))) (list target key))) - (let ((pointer (riece-identity-member-safe target riece-current-channels))) + (let ((pointer (riece-identity-member target riece-current-channels))) (if pointer (riece-command-switch-to-channel (car pointer)) - (if (riece-channel-p target) + (if (riece-channel-p (riece-identity-prefix target)) (riece-command-join-channel target key) (riece-command-join-partner target))))) (defun riece-command-part-channel (target message) - (let ((server-name (riece-identity-server target)) - process) - (if server-name - (setq process (cdr (assoc server-name riece-server-process-alist))) - (setq process riece-server-process)) + (let ((process (riece-server-process (riece-identity-server target)))) (unless process (error "%s" (substitute-command-keys "Type \\[riece-command-open-server] to open server."))) @@ -428,17 +443,17 @@ (defun riece-command-part (target &optional message) (interactive (let* ((completion-ignore-case t) - (target - (completing-read "Channel/User: " - (mapcar #'list riece-current-channels) - nil t (cons riece-current-channel 0))) - message) + (target + (riece-completing-read-identity + "Channel/User: " riece-current-channels nil nil + (cons (riece-format-identity riece-current-channel) 0))) + message) (if (and current-prefix-arg - (riece-channel-p target)) + (riece-channel-p (riece-identity-prefix target))) (setq message (read-string "Message: "))) (list target message))) - (if (riece-identity-member-safe target riece-current-channels) - (if (riece-channel-p target) + (if (riece-identity-member target riece-current-channels) + (if (riece-channel-p (riece-identity-prefix target)) (riece-command-part-channel target message) (riece-part-channel target) (riece-redisplay-buffers)) @@ -546,8 +561,14 @@ If prefix argument ARG is non-nil, toggle frozen status." (if arg (read-string "Message: ") (or riece-quit-message - (riece-extended-version))))) - (riece-close-all-server message)))) + (riece-extended-version)))) + (process-list riece-process-list)) + (while process-list + (riece-process-send-string (car process-list) + (if message + (format "QUIT :%s\r\n" message) + "QUIT\r\n")) + (setq process-list (cdr process-list)))))) (defun riece-command-raw (command) "Enter raw IRC command, which is sent to the server." @@ -577,26 +598,40 @@ If prefix argument ARG is non-nil, toggle frozen status." (defun riece-command-open-server (server-name) (interactive (list (completing-read "Server: " riece-server-alist))) - (if (assoc server-name riece-server-process-alist) - (error "%s is already opened" server-name) - (riece-open-server - (riece-server-name-to-server server-name) - server-name))) + (if (riece-server-process server-name) + (error "%s is already opened" server-name)) + (riece-open-server + (riece-server-name-to-server server-name) + server-name)) (defun riece-command-close-server (server-name &optional message) (interactive - (list (completing-read "Server: " riece-server-process-alist) + (list (completing-read + "Server: " + (mapcar + (lambda (process) + (with-current-buffer (process-buffer process) + (list riece-server-name))) + riece-process-list)) (if current-prefix-arg (read-string "Message: ") (or riece-quit-message (riece-extended-version))))) - (riece-close-server server-name message)) + (riece-process-send-string (riece-server-process server-name) + (if message + (format "QUIT :%s\r\n" message) + "QUIT\r\n"))) (defun riece-command-universal-server-name-argument () (interactive) (let* ((riece-overriding-server-name - (completing-read "Server: " - riece-server-process-alist)) + (completing-read + "Server: " + (mapcar + (lambda (process) + (with-current-buffer (process-buffer process) + (list riece-server-name))) + riece-process-list))) (command (key-binding (read-key-sequence (format "Command to execute on \"%s\":" diff --git a/lisp/riece-compat.el b/lisp/riece-compat.el index bcc82ac..ef41c10 100644 --- a/lisp/riece-compat.el +++ b/lisp/riece-compat.el @@ -24,6 +24,10 @@ ;;; Code: +(if (featurep 'xemacs) + (require 'riece-xemacs) + (require 'riece-emacs)) + (defalias 'riece-mode-line-buffer-identification 'identity) diff --git a/lisp/riece-ctcp.el b/lisp/riece-ctcp.el index 1110ca2..78a4dae 100644 --- a/lisp/riece-ctcp.el +++ b/lisp/riece-ctcp.el @@ -83,9 +83,8 @@ (defun riece-handle-ctcp-version-request (prefix target string) (let ((buffer (if (riece-channel-p target) - (cdr (riece-identity-assoc - (riece-make-identity target) - riece-channel-buffer-alist)))) + (riece-channel-buffer-name + (riece-make-identity target riece-server-name)))) (user (riece-prefix-nickname prefix))) (riece-send-string (format "NOTICE %s :\1VERSION %s\1\r\n" user (riece-extended-version))) @@ -105,9 +104,8 @@ (defun riece-handle-ctcp-ping-request (prefix target string) (let ((buffer (if (riece-channel-p target) - (cdr (riece-identity-assoc - (riece-make-identity target) - riece-channel-buffer-alist)))) + (riece-channel-buffer-name + (riece-make-identity target riece-server-name)))) (user (riece-prefix-nickname prefix))) (riece-send-string (if string @@ -129,9 +127,8 @@ (defun riece-handle-ctcp-clientinfo-request (prefix target string) (let ((buffer (if (riece-channel-p target) - (cdr (riece-identity-assoc - (riece-make-identity target) - riece-channel-buffer-alist)))) + (riece-channel-buffer-name + (riece-make-identity target riece-server-name)))) (user (riece-prefix-nickname prefix))) (riece-send-string (format "NOTICE %s :\1CLIENTINFO %s\1\r\n" @@ -166,9 +163,8 @@ (defun riece-handle-ctcp-action-request (prefix target string) (let ((buffer (if (riece-channel-p target) - (cdr (riece-identity-assoc - (riece-make-identity target) - riece-channel-buffer-alist)))) + (riece-channel-buffer-name + (riece-make-identity target riece-server-name)))) (user (riece-prefix-nickname prefix))) (riece-insert-change buffer (concat user " " string "\n")) (riece-insert-change @@ -292,9 +288,8 @@ (riece-send-string (format "PRIVMSG %s :\1ACTION %s\1\r\n" (riece-identity-prefix channel) action)) - (let ((buffer (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist)))) + (let ((buffer (riece-channel-buffer-name + (riece-make-identity channel riece-server-name)))) (riece-insert-change buffer (concat (riece-identity-prefix (riece-current-nickname)) " " action "\n")) diff --git a/lisp/riece-display.el b/lisp/riece-display.el index 37fd476..64ac02b 100644 --- a/lisp/riece-display.el +++ b/lisp/riece-display.el @@ -28,13 +28,6 @@ (require 'riece-channel) (require 'riece-misc) -(defvar riece-update-buffer-functions - '(riece-update-user-list-buffer - riece-update-channel-list-buffer - riece-update-status-indicators - riece-update-channel-indicator - riece-update-channel-list-indicator)) - (defcustom riece-configure-windows-function #'riece-configure-windows "Function to configure windows." :type 'function @@ -46,13 +39,26 @@ :type 'function :group 'riece-looks) +(defvar riece-update-buffer-functions + '(riece-update-user-list-buffer + riece-update-channel-list-buffer + riece-update-status-indicators + riece-update-channel-indicator + riece-update-short-channel-indicator + riece-update-channel-list-indicator)) + +(defvar riece-redisplay-buffer nil + "Non-nil means the buffer needs to be updated. +Local to the buffers.") + (defun riece-configure-windows () (let ((buffer (window-buffer)) (show-user-list (and riece-user-list-buffer-mode riece-current-channel ;; User list buffer is nuisance for private conversation. - (riece-channel-p riece-current-channel)))) + (riece-channel-p (riece-identity-prefix + riece-current-channel))))) ;; Can't expand minibuffer to full frame. (if (eq (selected-window) (minibuffer-window)) (other-window 1)) @@ -96,66 +102,84 @@ (get-buffer-window riece-command-buffer))))) (defun riece-set-window-points () - (if (and riece-user-list-buffer - (get-buffer-window riece-user-list-buffer)) + (if (get-buffer-window riece-user-list-buffer) (with-current-buffer riece-user-list-buffer (unless (riece-frozen riece-user-list-buffer) (set-window-start (get-buffer-window riece-user-list-buffer) (point-min))))) - (if (and riece-channel-list-buffer - (get-buffer-window riece-channel-list-buffer)) + (if (get-buffer-window riece-channel-list-buffer) (with-current-buffer riece-channel-list-buffer (unless (riece-frozen riece-channel-list-buffer) (set-window-start (get-buffer-window riece-channel-list-buffer) (point-min)))))) (defun riece-update-user-list-buffer () - (if (and riece-user-list-buffer - (get-buffer riece-user-list-buffer)) - (save-excursion - (set-buffer riece-user-list-buffer) - (when (and riece-current-channel - (riece-channel-p riece-current-channel)) - (let ((inhibit-read-only t) - buffer-read-only - (users (riece-channel-get-users riece-current-channel)) - (operators (riece-channel-get-operators riece-current-channel)) - (speakers (riece-channel-get-speakers riece-current-channel))) - (erase-buffer) - (while users - (if (member (car users) operators) - (insert "@" (car users) "\n") - (if (member (car users) speakers) - (insert "+" (car users) "\n") - (insert " " (car users) "\n"))) - (setq users (cdr users)))))))) - -(defun riece-update-channel-list-buffer () - (if (and riece-channel-list-buffer - (get-buffer riece-channel-list-buffer)) - (save-excursion - (set-buffer riece-channel-list-buffer) + (save-excursion + (set-buffer riece-user-list-buffer) + (when (and riece-redisplay-buffer + riece-current-channel + (riece-channel-p (riece-identity-prefix riece-current-channel))) + (let (users operators speakers) + (with-current-buffer (process-buffer (riece-server-process + (riece-identity-server + riece-current-channel))) + (setq users + (riece-channel-get-users + (riece-identity-prefix riece-current-channel)) + operators + (riece-channel-get-operators + (riece-identity-prefix riece-current-channel)) + speakers + (riece-channel-get-speakers + (riece-identity-prefix riece-current-channel)))) (let ((inhibit-read-only t) - buffer-read-only - (index 1) - (channels riece-current-channels)) + buffer-read-only) (erase-buffer) - (while channels - (if (car channels) - (insert (format "%2d: %s\n" index (car channels)))) - (setq index (1+ index) - channels (cdr channels))))))) + (while users + (if (member (car users) operators) + (insert "@" (car users) "\n") + (if (member (car users) speakers) + (insert "+" (car users) "\n") + (insert " " (car users) "\n"))) + (setq users (cdr users))))) + (setq riece-redisplay-buffer nil)))) + +(defun riece-update-channel-list-buffer () + (save-excursion + (set-buffer riece-channel-list-buffer) + (when riece-redisplay-buffer + (let ((inhibit-read-only t) + buffer-read-only + (index 1) + (channels riece-current-channels)) + (erase-buffer) + (while channels + (if (car channels) + (let ((point (point))) + (insert (format "%2d: %s\n" index + (riece-format-identity (car channels)))) + (put-text-property point (point) 'riece-identity + (car channels)))) + (setq index (1+ index) + channels (cdr channels)))) + (setq riece-redisplay-buffer nil)))) (defun riece-update-channel-indicator () (setq riece-channel-indicator (if riece-current-channel - (riece-concat-current-channel-modes - (if (and riece-current-channel - (riece-channel-p riece-current-channel) - (riece-channel-get-topic riece-current-channel)) - (concat riece-current-channel ": " - (riece-channel-get-topic riece-current-channel)) - riece-current-channel)) + (if (riece-channel-p (riece-identity-prefix riece-current-channel)) + (riece-concat-channel-modes + riece-current-channel + (riece-concat-channel-topic + riece-current-channel + (riece-format-identity riece-current-channel))) + (riece-format-identity riece-current-channel)) + "None"))) + +(defun riece-update-short-channel-indicator () + (setq riece-short-channel-indicator + (if riece-current-channel + (riece-format-identity riece-current-channel) "None"))) (defun riece-update-channel-list-indicator () @@ -170,26 +194,28 @@ (mapcar (lambda (channel) (prog1 (if channel - (format "%d:%s" index channel)) + (format "%d:%s" index + (riece-format-identity channel))) (setq index (1+ index)))) riece-current-channels)) ","))) (setq riece-channel-list-indicator "No channel"))) (defun riece-update-status-indicators () - (with-current-buffer riece-command-buffer - (riece-with-server-buffer - (setq riece-away-indicator - (if (and riece-real-nickname - (riece-user-get-away riece-real-nickname)) - "A" - "-") - riece-operator-indicator - (if (and riece-real-nickname - (riece-user-get-operator riece-real-nickname)) - "O" - "-") - riece-user-indicator riece-real-nickname))) + (if riece-current-channel + (with-current-buffer riece-command-buffer + (riece-with-server-buffer (riece-identity-server riece-current-channel) + (setq riece-away-indicator + (if (and riece-real-nickname + (riece-user-get-away riece-real-nickname)) + "A" + "-") + riece-operator-indicator + (if (and riece-real-nickname + (riece-user-get-operator riece-real-nickname)) + "O" + "-") + riece-user-indicator riece-real-nickname)))) (setq riece-freeze-indicator (with-current-buffer (if (and riece-channel-buffer-mode riece-channel-buffer) @@ -202,15 +228,20 @@ "-"))))) (defun riece-update-buffers () + (if riece-current-channel + (setq riece-channel-buffer (get-buffer (riece-channel-buffer-name + riece-current-channel)))) (run-hooks 'riece-update-buffer-functions) - (force-mode-line-update t) - (run-hooks 'riece-update-buffers-hook)) + (force-mode-line-update t)) + +(defun riece-channel-buffer-name (identity) + (format riece-channel-buffer-format (riece-format-identity identity))) (eval-when-compile (autoload 'riece-channel-mode "riece")) (defun riece-channel-buffer-create (identity) (with-current-buffer - (riece-get-buffer-create (format riece-channel-buffer-format identity)) + (riece-get-buffer-create (riece-channel-buffer-name identity)) (unless (eq major-mode 'riece-channel-mode) (riece-channel-mode) (let (buffer-read-only) @@ -222,46 +253,21 @@ (run-hook-with-args 'riece-channel-buffer-create-functions identity))) (current-buffer))) -(eval-when-compile - (autoload 'riece-user-list-mode "riece")) -(defun riece-user-list-buffer-create (identity) - (with-current-buffer - (riece-get-buffer-create (format riece-user-list-buffer-format identity)) - (unless (eq major-mode 'riece-user-list-mode) - (riece-user-list-mode)) - (current-buffer))) - (defun riece-switch-to-channel (identity) (setq riece-last-channel riece-current-channel - riece-current-channel identity - riece-channel-buffer - (cdr (riece-identity-assoc - identity riece-channel-buffer-alist)) - riece-user-list-buffer - (cdr (riece-identity-assoc - identity riece-user-list-buffer-alist))) + riece-current-channel identity) + (with-current-buffer riece-user-list-buffer + (setq riece-redisplay-buffer t)) (run-hooks 'riece-channel-switch-hook)) -(defun riece-join-channel (channel-name) - (let ((identity (riece-make-identity channel-name))) - (unless (riece-identity-member - identity riece-current-channels) - (setq riece-current-channels - (riece-identity-assign-binding - identity riece-current-channels - riece-default-channel-binding))) - (unless (riece-identity-assoc - identity riece-channel-buffer-alist) - (let ((buffer (riece-channel-buffer-create identity))) - (setq riece-channel-buffer-alist - (cons (cons identity buffer) - riece-channel-buffer-alist)))) - (unless (riece-identity-assoc - identity riece-user-list-buffer-alist) - (let ((buffer (riece-user-list-buffer-create identity))) - (setq riece-user-list-buffer-alist - (cons (cons identity buffer) - riece-user-list-buffer-alist)))))) +(defun riece-join-channel (identity) + (unless (riece-identity-member identity riece-current-channels) + (setq riece-current-channels + (riece-identity-assign-binding identity riece-current-channels + riece-default-channel-binding)) + (riece-channel-buffer-create identity) + (with-current-buffer riece-channel-list-buffer + (setq riece-redisplay-buffer t)))) (defun riece-switch-to-nearest-channel (pointer) (let ((start riece-current-channels) @@ -280,14 +286,14 @@ (setq riece-last-channel riece-current-channel riece-current-channel nil)))) -(defun riece-part-channel (channel-name) - (let* ((identity (riece-make-identity channel-name)) - (pointer (riece-identity-member - identity riece-current-channels))) +(defun riece-part-channel (identity) + (let ((pointer (riece-identity-member identity riece-current-channels))) (if pointer (setcar pointer nil)) (if (riece-identity-equal identity riece-current-channel) - (riece-switch-to-nearest-channel pointer)))) + (riece-switch-to-nearest-channel pointer)) + (with-current-buffer riece-channel-list-buffer + (setq riece-redisplay-buffer t)))) (defun riece-configure-windows-predicate () ;; The current channel is changed, and some buffers are visible. diff --git a/lisp/riece-doctor.el b/lisp/riece-doctor.el new file mode 100644 index 0000000..c922c9e --- /dev/null +++ b/lisp/riece-doctor.el @@ -0,0 +1,110 @@ +;;; riece-doctor.el --- "become a psychotherapist" add-on +;; Copyright (C) 1998-2003 Daiki Ueno + +;; Author: Daiki Ueno +;; 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: + +;; This add-on allows you to become a psychotherapist. + +;; To use, add the following line to your ~/.riece/init.el: +;; (add-to-list 'riece-addons 'riece-doctor t) + +;;; Code: + +(defgroup riece-doctor nil + "Interface to doctor.el" + :prefix "riece-" + :group 'riece) + +(defcustom riece-doctor-hello-regexp "^, doctor" + "Pattern of string patients start consultation." + :type 'string + :group 'riece-doctor) + +(defcustom riece-doctor-bye-regexp "^, bye doctor" + "Pattern of string patients end consultation." + :type 'string + :group 'riece-doctor) + +(defvar riece-doctor-patients nil) + +(autoload 'doctor-mode "doctor") +(autoload 'doctor-read-print "doctor") + +(defun riece-doctor-buffer-name (user) + (concat " *riece-doctor*" (riece-format-identity user))) + +(defun riece-doctor-reply (target string) + (riece-display-message + (riece-make-message (riece-make-identity riece-real-nickname + riece-server-name) + (riece-make-identity target riece-server-name) + string 'notice t)) + (riece-send-string (format "NOTICE %s :%s\r\n" target string))) + +(defun riece-doctor-after-privmsg-hook (prefix string) + (let* ((user (riece-make-identity (riece-prefix-nickname prefix) + riece-server-name)) + (parameters (riece-split-parameters string)) + (targets (split-string (car parameters) ",")) + (message (nth 1 parameters))) + (if (string-match riece-doctor-hello-regexp message) + (if (riece-identity-member user riece-doctor-patients) + (riece-doctor-reply + (car targets) + "You are already talking with me.") + (save-excursion + (set-buffer (get-buffer-create (riece-doctor-buffer-name user))) + (erase-buffer) + (doctor-mode)) + (setq riece-doctor-patients (cons user riece-doctor-patients)) + (riece-doctor-reply + (car targets) + "I am the psychotherapist. Please, describe your problems.")) + (if (string-match riece-doctor-bye-regexp message) + (let ((pointer (riece-identity-member user riece-doctor-patients))) + (when pointer + (kill-buffer (riece-doctor-buffer-name user)) + (setq riece-doctor-patients (delq (car pointer) + riece-doctor-patients)) + (riece-doctor-reply (car targets) "Good bye."))) + (if (riece-identity-member user riece-doctor-patients) + (let (string) + (save-excursion + (set-buffer (get-buffer (riece-doctor-buffer-name user))) + (goto-char (point-max)) + (insert message "\n") + (let ((point (point))) + (doctor-read-print) + (setq string (buffer-substring (1+ point) (- (point) 2)))) + (with-temp-buffer + (insert string) + (subst-char-in-region (point-min) (point-max) ?\n ? ) + (setq string (buffer-string)))) + (riece-doctor-reply (car targets) string))))))) + +(defun riece-doctor-insinuate () + (add-hook 'riece-after-privmsg-hook 'riece-doctor-after-privmsg-hook)) + +(provide 'riece-doctor) + +;;; riece-doctor.el ends here diff --git a/lisp/riece-emacs.el b/lisp/riece-emacs.el index eb13289..e46f8c5 100644 --- a/lisp/riece-emacs.el +++ b/lisp/riece-emacs.el @@ -24,6 +24,9 @@ ;;; Code: +(defalias 'riece-set-case-syntax-pair + 'set-case-syntax-pair) + (provide 'riece-emacs) ;;; riece-emacs.el ends here diff --git a/lisp/riece-filter.el b/lisp/riece-filter.el index c6eba72..fb8894d 100644 --- a/lisp/riece-filter.el +++ b/lisp/riece-filter.el @@ -27,6 +27,8 @@ (require 'riece-handle) (require 'riece-misc) (require 'riece-server) ;riece-close-server +(require 'riece-identity) +(require 'riece-display) (defun riece-handle-numeric-reply (prefix number name string) (let ((base-number (* (/ number 100) 100)) @@ -123,34 +125,46 @@ (forward-line))))) (eval-when-compile - (autoload 'riece "riece")) + (autoload 'riece-exit "riece")) (defun riece-sentinel (process status) (if riece-reconnect-with-password (unwind-protect - (if (eq process riece-server-process) - (riece) ;Need to initialize system. - (let ((server-name - (car (rassq process riece-server-process-alist)))) - (riece-close-server server-name) - (riece-open-server - (riece-server-name-to-server server-name) - server-name))) + (let ((server-name + (with-current-buffer (process-buffer process) + riece-server-name))) + (riece-close-server-process process) + (riece-open-server + (if (equal server-name "") + riece-server + (riece-server-name-to-server server-name)) + server-name)) (setq riece-reconnect-with-password nil)) (let ((server-name (with-current-buffer (process-buffer process) riece-server-name))) (if (and (process-id process) ;not a network connection (string-match "^exited abnormally with code \\([0-9]+\\)" status)) - (if server-name - (message "Connection to \"%s\" closed: %s" - server-name (match-string 1 status)) - (message "Connection closed: %s" (match-string 1 status))) - (if server-name + (if (equal server-name "") + (message "Connection closed: %s" (match-string 1 status)) (message "Connection to \"%s\" closed: %s" - server-name (substring status 0 (1- (length status)))) - (message "Connection closed: %s" - (substring status 0 (1- (length status)))))) - (riece-close-server server-name)))) + server-name (match-string 1 status))) + (if (equal server-name "") + (message "Connection closed: %s" + (substring status 0 (1- (length status)))) + (message "Connection to \"%s\" closed: %s" + server-name (substring status 0 (1- (length status)))))) + (let ((channels riece-current-channels)) + (while channels + (if (and (car channels) + (equal (riece-identity-server (car channels)) + server-name)) + (riece-part-channel (car channels))) + (setq channels (cdr channels)))) + (riece-redisplay-buffers) + (riece-close-server-process process) + ;; If no server process is available, exit. + (unless riece-process-list + (riece-exit))))) (provide 'riece-filter) diff --git a/lisp/riece-globals.el b/lisp/riece-globals.el index 6c77e86..a260377 100644 --- a/lisp/riece-globals.el +++ b/lisp/riece-globals.el @@ -24,16 +24,22 @@ ;;; Code: +;;; Constants: +(defconst riece-channel-regexp + "\\([+&#]\\|![A-Z0-9]\\{5\\}\\)[^\0\7\r\n ,:]*\\(:[^\0\7\r\n ,:]*\\)?") +(defconst riece-user-regexp + "[][\\\\`_^{|}A-Za-z][][\\\\`_^{|}A-Za-z0-9-]\\{0,8\\}") + ;;; Miscellaneous global variables: -(defvar riece-server-process nil - "Primary server process.") -(defvar riece-server-process-alist nil - "An alist mapping secondary server name to opened processes.") +(defvar riece-process-list nil + "List of processes opened in the current session.") (defvar riece-current-channel nil "The channel you currently have joined.") (defvar riece-current-channels nil "The channels you have currently joined.") +(defvar riece-last-channel nil + "The channel you had joined the last time.") (defvar riece-save-variables-are-dirty nil "Non nil if the variables in `riece-saved-forms' are changed.") @@ -94,17 +100,6 @@ Local to the server buffers.") "Coding system for process I/O. Local to the server buffers.") -;;; Variables local to the command buffer: -(defvar riece-default-channel-candidate nil - "A channel name used as completion candidate. -Local to the command buffer.") -(defvar riece-last-channel nil - "The channel you joined the last time.") -(defvar riece-command-buffer-mode 'channel - "Command buffer mode. -Possible values are `chat' and `channel'. -Local to the command buffer.") - ;;; Variables local to the channel buffers: (defvar riece-freeze nil "If t, channel window is not scrolled. @@ -115,7 +110,9 @@ Local to the channel buffers.") (defvar riece-channel-indicator "None" "A modeline indicator of the current channel.") (defvar riece-channel-list-indicator "No channel" - "The current joined channels, \"pretty-printed.\".") + "A modeline indicator of the current joined channels.") +(defvar riece-short-channel-indicator "None" + "A modeline indicator of the current channel.") (defvar riece-user-indicator nil) (defvar riece-away-indicator "-") @@ -137,14 +134,10 @@ Local to the channel buffers.") "Format of channel message buffer.") (defvar riece-channel-list-buffer " *Channels*" "Name of channel list buffer.") -(defvar riece-user-list-buffer nil +(defvar riece-user-list-buffer " *Users*" "Name of user list buffer.") -(defvar riece-user-list-buffer-format " *Users:%s*" - "Format of user list buffer.") (defvar riece-wallops-buffer " *WALLOPS*") -(defvar riece-channel-buffer-alist nil) -(defvar riece-user-list-buffer-alist nil) (defvar riece-buffer-list nil) (defvar riece-overriding-server-name nil) diff --git a/lisp/riece-handle.el b/lisp/riece-handle.el index 371c407..2ca23eb 100644 --- a/lisp/riece-handle.el +++ b/lisp/riece-handle.el @@ -33,37 +33,40 @@ (defun riece-handle-nick-message (prefix string) (let* ((old (riece-prefix-nickname prefix)) (new (car (riece-split-parameters string))) + (old-identity (riece-make-identity old riece-server-name)) + (new-identity (riece-make-identity new riece-server-name)) (channels (riece-user-get-channels old)) - (visible (riece-identity-member riece-current-channel channels))) + (visible (riece-identity-member + riece-current-channel + (mapcar (lambda (channel) + (riece-make-identity channel riece-server-name)) + channels)))) (riece-naming-assert-rename old new) - (let ((pointer (riece-identity-member - (riece-make-identity old) - riece-current-channels))) + (let ((pointer (riece-identity-member old-identity + riece-current-channels))) (when pointer - (setcar pointer (riece-make-identity new)) - (setcar (riece-identity-assoc (riece-make-identity old) - riece-channel-buffer-alist) - (riece-make-identity new)) - (setcar (riece-identity-assoc (riece-make-identity old) - riece-user-list-buffer-alist) - (riece-make-identity new)) - (if (riece-identity-equal (riece-make-identity old) - riece-current-channel) - (riece-switch-to-channel (riece-make-identity new))) - (setq channels (cons (riece-make-identity new) channels)))) + (setcar pointer new-identity) + (with-current-buffer (riece-channel-buffer-name new-identity) + (rename-buffer (riece-channel-buffer-name new-identity))) + (if (riece-identity-equal new-identity riece-current-channel) + (riece-switch-to-channel new-identity)) + (setq channels (cons new-identity channels)))) (riece-insert-change (mapcar (lambda (channel) - (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist))) + (riece-channel-buffer-name + (riece-make-identity channel riece-server-name))) channels) - (format "%s -> %s\n" old new)) + (format "%s -> %s\n" + (riece-format-identity old-identity t) + (riece-format-identity new-identity t))) (riece-insert-change (if visible riece-dialogue-buffer (list riece-dialogue-buffer riece-others-buffer)) (concat (riece-concat-server-name - (format "%s -> %s" old new)) + (format "%s -> %s" + (riece-format-identity old-identity t) + (riece-format-identity new-identity t))) "\n")) (riece-redisplay-buffers))) @@ -72,10 +75,12 @@ (parameters (riece-split-parameters string)) (targets (split-string (car parameters) ",")) (message (nth 1 parameters))) - (unless (equal message "") ;not ignored by server? - (riece-display-message - (riece-make-message user (riece-make-identity (car targets)) - message))))) + (riece-display-message + (riece-make-message (riece-make-identity user + riece-server-name) + (riece-make-identity (car targets) + riece-server-name) + message)))) (defun riece-handle-notice-message (prefix string) (let* ((user (if prefix @@ -83,15 +88,17 @@ (parameters (riece-split-parameters string)) (targets (split-string (car parameters) ",")) (message (nth 1 parameters))) - (unless (equal message "") ;not ignored by server? - (if user - (riece-display-message - (riece-make-message user (riece-make-identity (car targets)) - message 'notice)) - ;; message from server - (riece-insert-notice - (list riece-dialogue-buffer riece-others-buffer) - (concat (riece-concat-server-name message) "\n")))))) + (if user + (riece-display-message + (riece-make-message (riece-make-identity user + riece-server-name) + (riece-make-identity (car targets) + riece-server-name) + message 'notice)) + ;; message from server + (riece-insert-notice + (list riece-dialogue-buffer riece-others-buffer) + (concat (riece-concat-server-name message) "\n"))))) (defun riece-handle-ping-message (prefix string) (riece-send-string (format "PONG :%s\r\n" @@ -100,22 +107,23 @@ string)))) (defun riece-handle-join-message (prefix string) - (let ((user (riece-prefix-nickname prefix)) - (channels (split-string (car (riece-split-parameters string)) ","))) + (let* ((user (riece-prefix-nickname prefix)) + ;; RFC2812 3.2.1 doesn't recommend server to send join + ;; messages which contain multiple targets. + (channels (split-string (car (riece-split-parameters string)) ",")) + (user-identity (riece-make-identity user riece-server-name))) (while channels (riece-naming-assert-join user (car channels)) - ;;XXX - (if (riece-identity-equal-no-server user riece-real-nickname) - (riece-switch-to-channel (riece-make-identity (car channels)))) - (let ((buffer (cdr (riece-identity-assoc - (riece-make-identity (car channels)) - riece-channel-buffer-alist)))) + (let* ((channel-identity (riece-make-identity (car channels) + riece-server-name)) + (buffer (get-buffer (riece-channel-buffer-name + channel-identity)))) (riece-insert-change buffer (format "%s (%s) has joined %s\n" - user + (riece-format-identity user-identity t) (riece-user-get-user-at-host user) - (car channels))) + (riece-format-identity channel-identity t))) (riece-insert-change (if (and riece-channel-buffer-mode (not (eq buffer riece-channel-buffer))) @@ -124,9 +132,9 @@ (concat (riece-concat-server-name (format "%s (%s) has joined %s" - user + (riece-format-identity user-identity t) (riece-user-get-user-at-host user) - (car channels))) + (riece-format-identity channel-identity t))) "\n"))) (setq channels (cdr channels))) (riece-redisplay-buffers))) @@ -134,18 +142,24 @@ (defun riece-handle-part-message (prefix string) (let* ((user (riece-prefix-nickname prefix)) (parameters (riece-split-parameters string)) + ;; RFC2812 3.2.2 doesn't recommend server to send part + ;; messages which contain multiple targets. (channels (split-string (car parameters) ",")) - (message (nth 1 parameters))) + (message (nth 1 parameters)) + (user-identity (riece-make-identity user riece-server-name))) (while channels (riece-naming-assert-part user (car channels)) - (let ((buffer (cdr (riece-identity-assoc - (riece-make-identity (car channels)) - riece-channel-buffer-alist)))) + (let* ((channel-identity (riece-make-identity (car channels) + riece-server-name)) + (buffer (get-buffer (riece-channel-buffer-name + channel-identity)))) (riece-insert-change buffer (concat (riece-concat-message - (format "%s has left %s" user (car channels)) + (format "%s has left %s" + (riece-format-identity user-identity t) + (riece-format-identity channel-identity t)) message) "\n")) (riece-insert-change @@ -156,7 +170,9 @@ (concat (riece-concat-server-name (riece-concat-message - (format "%s has left %s" user (car channels)) + (format "%s has left %s" + (riece-format-identity user-identity t) + (riece-format-identity channel-identity t)) message)) "\n"))) (setq channels (cdr channels))) @@ -167,16 +183,20 @@ (parameters (riece-split-parameters string)) (channel (car parameters)) (user (nth 1 parameters)) - (message (nth 2 parameters))) + (message (nth 2 parameters)) + (kicker-identity (riece-make-identity kicker riece-server-name)) + (channel-identity (riece-make-identity channel riece-server-name)) + (user-identity (riece-make-identity user riece-server-name))) (riece-naming-assert-part user channel) - (let ((buffer (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist)))) + (let ((buffer (get-buffer (riece-channel-buffer-name channel-identity)))) (riece-insert-change buffer (concat (riece-concat-message - (format "%s kicked %s out from %s" kicker user channel) + (format "%s kicked %s out from %s" + (riece-format-identity kicker-identity t) + (riece-format-identity user-identity t) + (riece-format-identity channel-identity t)) message) "\n")) (riece-insert-change @@ -187,7 +207,10 @@ (concat (riece-concat-server-name (riece-concat-message - (format "%s kicked %s out from %s\n" kicker user channel) + (format "%s kicked %s out from %s\n" + (riece-format-identity kicker-identity t) + (riece-format-identity user-identity t) + (riece-format-identity channel-identity t)) message)) "\n"))) (riece-redisplay-buffers))) @@ -196,42 +219,44 @@ (let* ((user (riece-prefix-nickname prefix)) (channels (copy-sequence (riece-user-get-channels user))) (pointer channels) - (message (car (riece-split-parameters string)))) - ;; If you are quitting, no need to cleanup. - (unless (riece-identity-equal-no-server user riece-real-nickname) - ;; You were talking with the user. - (if (riece-identity-member (riece-make-identity user) - riece-current-channels) - (riece-part-channel user)) ;XXX - (setq pointer channels) - (while pointer - (riece-naming-assert-part user (car pointer)) - (setq pointer (cdr pointer))) - (let ((buffers - (mapcar - (lambda (channel) - (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist))) - channels))) - (riece-insert-change buffers - (concat (riece-concat-message - (format "%s has left IRC" user) - message) - "\n")) - (riece-insert-change (if (and riece-channel-buffer-mode - (not (memq riece-channel-buffer - buffers))) - (list riece-dialogue-buffer - riece-others-buffer) - riece-dialogue-buffer) - (concat - (riece-concat-server-name - (riece-concat-message - (format "%s has left IRC" user) - message)) - "\n")))) - (riece-redisplay-buffers))) + (parameters (riece-split-parameters string)) + (message (car parameters)) + (user-identity (riece-make-identity user riece-server-name))) + ;; If you are talking with the user, quit it. + (if (riece-identity-member user-identity riece-current-channels) + (riece-part-channel user)) + (setq pointer channels) + (while pointer + (riece-naming-assert-part user (car pointer)) + (setq pointer (cdr pointer))) + (let ((buffers + (mapcar + (lambda (channel) + (get-buffer + (riece-channel-buffer-name + (riece-make-identity channel riece-server-name)))) + channels))) + (riece-insert-change + buffers + (concat + (riece-concat-message + (format "%s has left IRC" + (riece-format-identity user-identity t)) + message) + "\n")) + (riece-insert-change + (if (and riece-channel-buffer-mode + (not (memq riece-channel-buffer buffers))) + (list riece-dialogue-buffer riece-others-buffer) + riece-dialogue-buffer) + (concat + (riece-concat-server-name + (riece-concat-message + (format "%s has left IRC" + (riece-format-identity user-identity t)) + message)) + "\n")))) + (riece-redisplay-buffers)) (defun riece-handle-kill-message (prefix string) (let* ((killer (riece-prefix-nickname prefix)) @@ -239,11 +264,12 @@ (user (car parameters)) (message (nth 1 parameters)) (channels (copy-sequence (riece-user-get-channels user))) + (killer-identity (riece-make-identity killer riece-server-name)) + (user-identity (riece-make-identity user riece-server-name)) pointer) - ;; You were talking with the user. - (if (riece-identity-member (riece-make-identity user) - riece-current-channels) - (riece-part-channel user)) ;XXX + ;; If you are talking with the user, quit it. + (if (riece-identity-member user-identity riece-current-channels) + (riece-part-channel user)) (setq pointer channels) (while pointer (riece-naming-assert-part user (car pointer)) @@ -251,27 +277,32 @@ (let ((buffers (mapcar (lambda (channel) - (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist))) + (get-buffer + (riece-channel-buffer-name + (riece-make-identity channel riece-server-name)))) channels))) - (riece-insert-change buffers - (concat (riece-concat-message - (format "%s killed %s" killer user) - message) - "\n")) - (riece-insert-change (if (and riece-channel-buffer-mode - (not (memq riece-channel-buffer - buffers))) - (list riece-dialogue-buffer - riece-others-buffer) - riece-dialogue-buffer) - (concat - (riece-concat-server-name - (riece-concat-message - (format "%s killed %s" killer user) - message)) - "\n"))) + (riece-insert-change + buffers + (concat + (riece-concat-message + (format "%s killed %s" + (riece-format-identity killer-identity t) + (riece-format-identity user-identity t)) + message) + "\n")) + (riece-insert-change + (if (and riece-channel-buffer-mode + (not (memq riece-channel-buffer buffers))) + (list riece-dialogue-buffer riece-others-buffer) + riece-dialogue-buffer) + (concat + (riece-concat-server-name + (riece-concat-message + (format "%s killed %s" + (riece-format-identity killer-identity t) + (riece-format-identity user-identity t)) + message)) + "\n"))) (riece-redisplay-buffers))) (defun riece-handle-invite-message (prefix string) @@ -282,21 +313,27 @@ (list riece-dialogue-buffer riece-others-buffer) (concat (riece-concat-server-name - (format "%s invites you to %s" user channel)) + (format "%s invites you to %s" + (riece-format-identity (riece-make-identity + user riece-server-name)) + (riece-format-identity (riece-make-identity + channel riece-server-name)))) "\n")))) (defun riece-handle-topic-message (prefix string) (let* ((user (riece-prefix-nickname prefix)) (parameters (riece-split-parameters string)) (channel (car parameters)) - (topic (nth 1 parameters))) + (topic (nth 1 parameters)) + (user-identity (riece-make-identity user riece-server-name)) + (channel-identity (riece-make-identity channel riece-server-name))) (riece-channel-set-topic (riece-get-channel channel) topic) - (let ((buffer (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist)))) + (let ((buffer (get-buffer (riece-channel-buffer-name channel-identity)))) (riece-insert-change buffer - (format "Topic by %s: %s\n" user topic)) + (format "Topic by %s: %s\n" + (riece-format-identity user-identity t) + topic)) (riece-insert-change (if (and riece-channel-buffer-mode (not (eq buffer riece-channel-buffer))) @@ -304,7 +341,10 @@ riece-dialogue-buffer) (concat (riece-concat-server-name - (format "Topic on %s by %s: %s" channel user topic)) + (format "Topic on %s by %s: %s" + (riece-format-identity channel-identity t) + (riece-format-identity user-identity t) + topic)) "\n")) (riece-redisplay-buffers)))) @@ -339,18 +379,21 @@ (setq modes (cdr modes)))))) (defun riece-handle-mode-message (prefix string) - (let ((user (riece-prefix-nickname prefix)) - channel) + (let* ((user (riece-prefix-nickname prefix)) + (user-identity (riece-make-identity user riece-server-name)) + channel) (when (string-match "\\([^ ]+\\) *:?" string) (setq channel (match-string 1 string) string (substring string (match-end 0))) (riece-parse-channel-modes string channel) - (let ((buffer (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist)))) + (let* ((channel-identity (riece-make-identity channel riece-server-name)) + (buffer (get-buffer (riece-channel-buffer-name + channel-identity)))) (riece-insert-change buffer - (format "Mode by %s: %s\n" user string)) + (format "Mode by %s: %s\n" + (riece-format-identity user-identity t) + string)) (riece-insert-change (if (and riece-channel-buffer-mode (not (eq buffer riece-channel-buffer))) @@ -358,7 +401,10 @@ riece-dialogue-buffer) (concat (riece-concat-server-name - (format "Mode on %s by %s: %s" channel user string)) + (format "Mode on %s by %s: %s" + (riece-format-identity channel-identity t) + (riece-format-identity user-identity t) + string)) "\n")) (riece-redisplay-buffers))))) diff --git a/lisp/riece-identity.el b/lisp/riece-identity.el index 8f5c39d..0def749 100644 --- a/lisp/riece-identity.el +++ b/lisp/riece-identity.el @@ -25,48 +25,32 @@ ;;; Code: (require 'riece-globals) - -(defun riece-find-server-name () - (or riece-overriding-server-name - ;already in the server buffer - (if (local-variable-p 'riece-server-name (current-buffer)) - riece-server-name - (if riece-current-channel - (riece-identity-server riece-current-channel))))) - -(defun riece-find-server-process () - (let ((server-name (riece-find-server-name))) - (if server-name - (cdr (assoc server-name riece-server-process-alist)) - riece-server-process))) - -(defmacro riece-with-server-buffer (&rest body) - `(let ((process (riece-find-server-process))) - (if process - (with-current-buffer (process-buffer process) - ,@body) - (error "Server closed.")))) - +(require 'riece-coding) +(require 'riece-server) +(require 'riece-compat) ;riece-set-case-syntax-pair + +(defvar riece-abbrev-identity-string-function nil) +(defvar riece-expand-identity-string-function nil) + +(defvar riece-identity-prefix-case-table + (let ((table (copy-case-table (standard-case-table)))) + (riece-set-case-syntax-pair ?\[ ?{ table) + (riece-set-case-syntax-pair ?\] ?} table) + (riece-set-case-syntax-pair ?\\ ?| table) + (riece-set-case-syntax-pair ?~ ?^ table) + table)) + (defun riece-identity-prefix (identity) "Return the component sans its server from IDENTITY." - (if (string-match " " identity) - (substring identity 0 (match-beginning 0)) - identity)) + (aref identity 0)) (defun riece-identity-server (identity) "Return the server component in IDENTITY." - (if (string-match " " identity) - (substring identity (match-end 0)))) + (aref identity 1)) -(defun riece-make-identity (prefix &optional server) +(defun riece-make-identity (prefix server) "Make an identity object from PREFIX and SERVER." - (if (riece-identity-server prefix) - prefix - (unless server - (setq server (riece-find-server-name))) - (if server - (concat prefix " " server) - prefix))) + (vector prefix server)) (defun riece-identity-equal (ident1 ident2) "Return t, if IDENT1 and IDENT2 is equal." @@ -77,99 +61,38 @@ (riece-identity-server ident1) (riece-identity-server ident2)))) -(defun riece-identity-equal-safe (ident1 ident2) - "Return t, if IDENT1 and IDENT2 is equal. -The only difference with `riece-identity-equal', this function appends -server name before comparison." - (riece-identity-equal - (if (riece-identity-server ident1) - ident1 - (riece-make-identity ident1)) - (if (riece-identity-server ident2) - ident2 - (riece-make-identity ident2)))) - (defun riece-identity-canonicalize-prefix (prefix) "Canonicalize identity PREFIX. -This function downcases PREFIX first, then does special treatment for -Scandinavian alphabets. +This function downcases PREFIX with Scandinavian alphabet rule. RFC2812, 2.2 \"Character codes\" says: Because of IRC's Scandinavian origin, the characters {}|^ are considered to be the lower case equivalents of the characters []\~, respectively. This is a critical issue when determining the equivalence of two nicknames or channel names." - (let* ((result (downcase prefix)) - (length (length result)) - (index 0)) - (while (< index length) - (if (eq (aref result index) ?\[) - (aset result index ?{) - (if (eq (aref result index) ?\]) - (aset result index ?}) - (if (eq (aref result index) ?\\) - (aset result index ?|) - (if (eq (aref result index) ?~) - (aset result index ?^))))) - (setq index (1+ index))) - result)) + (let ((old-table (current-case-table))) + (unwind-protect + (progn + (set-case-table riece-identity-prefix-case-table) + (downcase prefix)) + (set-case-table old-table)))) (defun riece-identity-equal-no-server (prefix1 prefix2) "Return t, if IDENT1 and IDENT2 is equal without server." (equal (riece-identity-canonicalize-prefix prefix1) (riece-identity-canonicalize-prefix prefix2))) -(defun riece-identity-equal-no-server-safe (prefix1 prefix2) - "Return t, if IDENT1 and IDENT2 is equal without server. -The only difference with `riece-identity-no-server', this function removes -server name before comparison." - (equal (riece-identity-canonicalize-prefix - (riece-identity-prefix prefix1)) - (riece-identity-canonicalize-prefix - (riece-identity-prefix prefix2)))) - (defun riece-identity-member (elt list) "Return non-nil if an identity ELT is an element of LIST." (catch 'found (while list - (if (and (stringp (car list)) + (if (and (vectorp (car list)) ;needed because + ;riece-current-channels + ;contains nil. (riece-identity-equal (car list) elt)) (throw 'found list) (setq list (cdr list)))))) -(defun riece-identity-member-safe (elt list) - "Return non-nil if an identity ELT is an element of LIST. -The only difference with `riece-identity-member', this function uses -`riece-identity-equal-safe' for comparison." - (catch 'found - (while list - (if (and (stringp (car list)) - (riece-identity-equal-safe (car list) elt)) - (throw 'found list) - (setq list (cdr list)))))) - -(defun riece-identity-member-no-server (elt list) - "Return non-nil if an identity ELT is an element of LIST. -The only difference with `riece-identity-member', this function doesn't -take server names into account." - (catch 'found - (while list - (if (and (stringp (car list)) - (riece-identity-equal-no-server (car list) elt)) - (throw 'found list) - (setq list (cdr list)))))) - -(defun riece-identity-member-no-server-safe (elt list) - "Return non-nil if an identity ELT is an element of LIST. -The only difference with `riece-identity-member-no-server', this function uses -`riece-identity-equal-no-server-safe' for comparison." - (catch 'found - (while list - (if (and (stringp (car list)) - (riece-identity-equal-no-server-safe (car list) elt)) - (throw 'found list) - (setq list (cdr list)))))) - (defun riece-identity-assoc (elt alist) "Return non-nil if an identity ELT matches the car of an element of ALIST." (catch 'found @@ -178,18 +101,8 @@ The only difference with `riece-identity-member-no-server', this function uses (throw 'found (car alist)) (setq alist (cdr alist)))))) -(defun riece-identity-assoc-safe (elt alist) - "Return non-nil if an identity ELT matches the car of an element of ALIST. -The only difference with `riece-identity-assoc', this function uses -`riece-identity-equal-safe' for comparison." - (catch 'found - (while alist - (if (riece-identity-equal-safe (car (car alist)) elt) - (throw 'found (car alist)) - (setq alist (cdr alist)))))) - (defun riece-identity-assign-binding (item list binding) - (let ((slot (riece-identity-member-safe item binding)) + (let ((slot (riece-identity-member item binding)) pointer) (unless list ;we need at least one room (setq list (list nil))) @@ -208,11 +121,45 @@ The only difference with `riece-identity-assoc', this function uses (setcar pointer item) list)) -(defun riece-current-nickname () - "Return the current nickname." - (riece-with-server-buffer - (if riece-real-nickname - (riece-make-identity riece-real-nickname)))) +(defun riece-format-identity (identity &optional prefix-only) + (let ((string + (if (or prefix-only + (equal (riece-identity-server identity) "")) + (riece-identity-prefix identity) + (concat (riece-identity-prefix identity) " " + (riece-identity-server identity))))) + (if riece-abbrev-identity-string-function + (funcall riece-abbrev-identity-string-function string) + string))) + +(defun riece-parse-identity (string) + (if riece-expand-identity-string-function + (setq string (funcall riece-expand-identity-string-function string))) + (riece-make-identity (if (string-match " " string) + (substring string 0 (match-beginning 0)) + string) + (if (string-match " " string) + (substring string (match-end 0)) + ""))) + +(defun riece-completing-read-identity (prompt channels + &optional predicate must-match + initial) + (let* ((string + (completing-read + prompt + (mapcar (lambda (channel) + (list (riece-format-identity channel))) + (delq nil (copy-sequence (or channels + riece-current-channels)))) + predicate must-match initial)) + (identity + (riece-parse-identity string))) + (unless (string-match (concat "^\\(" riece-channel-regexp "\\|" + riece-user-regexp "\\)") + (riece-identity-prefix identity)) + (error "Invalid channel name!")) + identity)) (provide 'riece-identity) diff --git a/lisp/riece-message.el b/lisp/riece-message.el index 073710c..8a20efb 100644 --- a/lisp/riece-message.el +++ b/lisp/riece-message.el @@ -60,7 +60,7 @@ :group 'riece-message) (defun riece-message-make-open-bracket (message) - "Makes `open-bracket' string for MESSAGE." + "Make `open-bracket' string for MESSAGE." (if (riece-message-own-p message) ">" (if (eq (riece-message-type message) 'notice) @@ -72,7 +72,7 @@ "<"))))) (defun riece-message-make-close-bracket (message) - "Makes `close-bracket' string for MESSAGE." + "Make `close-bracket' string for MESSAGE." (if (riece-message-own-p message) "<" (if (eq (riece-message-type message) 'notice) @@ -84,50 +84,59 @@ ">"))))) (defun riece-message-make-name (message) - "Makes local identity for MESSAGE." - (riece-identity-prefix - (if (and (riece-message-private-p message) - (riece-message-own-p message)) - (riece-message-target message) - (riece-message-speaker message)))) + "Make local identity for MESSAGE." + (if (riece-message-private-p message) + (if (riece-message-own-p message) + (riece-format-identity (riece-message-target message) t) + (riece-format-identity (riece-message-speaker message) t)) + (riece-format-identity (riece-message-speaker message) t))) (defun riece-message-make-global-name (message) - "Makes global identity for MESSAGE." + "Make global identity for MESSAGE." (if (riece-message-private-p message) (if (riece-message-own-p message) - (riece-identity-prefix (riece-message-target message)) - (riece-identity-prefix (riece-message-speaker message))) - (concat (riece-identity-prefix (riece-message-target message)) ":" - (riece-identity-prefix (riece-message-speaker message))))) + (riece-format-identity (riece-message-target message) t) + (riece-format-identity (riece-message-speaker message) t)) + (concat (riece-format-identity (riece-message-target message) t) ":" + (riece-format-identity (riece-message-speaker message) t)))) (defun riece-message-buffer (message) "Return the buffer where MESSAGE should appear." - (let* ((target (if (riece-identity-equal - (riece-message-target message) - (riece-current-nickname)) - (riece-message-speaker message) - (riece-message-target message))) - (entry (riece-identity-assoc target riece-channel-buffer-alist))) - (unless entry + (let ((target (if (riece-message-private-p message) + (if (riece-message-own-p message) + (riece-message-target message) + (riece-message-speaker message)) + (riece-message-target message)))) + (unless (riece-identity-member target riece-current-channels) (riece-join-channel target) ;; If you are not joined any channel, ;; switch to the target immediately. (unless riece-current-channel (riece-switch-to-channel target)) - (riece-redisplay-buffers) - (setq entry (riece-identity-assoc target riece-channel-buffer-alist))) - (cdr entry))) + (riece-redisplay-buffers)) + (riece-channel-buffer-name target))) (defun riece-message-parent-buffers (message buffer) "Return the parents of BUFFER where MESSAGE should appear. Normally they are *Dialogue* and/or *Others*." - (if (or (and buffer (riece-frozen buffer)) - (and riece-current-channel + (if (and buffer (riece-frozen buffer)) ;the message might not be + ;visible in buffer's window + (list riece-dialogue-buffer riece-others-buffer) + (if (and riece-current-channel ;the message is not sent to + ;the current channel + (if (riece-message-private-p message) + (if (riece-message-own-p message) + (not (riece-identity-equal + (riece-message-target message) + riece-current-channel)) + (not (riece-identity-equal + (riece-message-speaker message) + riece-current-channel))) (not (riece-identity-equal (riece-message-target message) riece-current-channel)))) - (list riece-dialogue-buffer riece-others-buffer) - riece-dialogue-buffer)) + (list riece-dialogue-buffer riece-others-buffer) + riece-dialogue-buffer))) (defun riece-display-message (message) "Display MESSAGE object." @@ -140,6 +149,7 @@ Normally they are *Dialogue* and/or *Others*." (global-name (funcall riece-message-make-global-name-function message)) (buffer (riece-message-buffer message)) + (server-name (riece-identity-server (riece-message-speaker message))) parent-buffers) (when (and buffer (riece-message-own-p message) @@ -152,11 +162,12 @@ Normally they are *Dialogue* and/or *Others*." (concat open-bracket name close-bracket " " (riece-message-text message) "\n")) (riece-insert parent-buffers - (concat - (riece-concat-server-name - (concat open-bracket global-name close-bracket - " " (riece-message-text message))) - "\n")) + (if (equal server-name "") + (concat open-bracket global-name close-bracket + " " (riece-message-text message) "\n") + (concat open-bracket global-name close-bracket + " " (riece-message-text message) + " (from " server-name ")\n"))) (run-hook-with-args 'riece-after-display-message-functions message))) (defun riece-make-message (speaker target text &optional type own-p) @@ -192,25 +203,21 @@ Currently possible values are `action' and `notice'." (defun riece-message-private-p (message) "Return t if MESSAGE is a private message." - (if (riece-message-own-p message) - (not (riece-channel-p (riece-message-target message))) - (riece-identity-equal - (riece-message-target message) - (riece-current-nickname)))) + (not (or (riece-channel-p (riece-identity-prefix + (riece-message-speaker message))) + (riece-channel-p (riece-identity-prefix + (riece-message-target message)))))) (defun riece-message-external-p (message) "Return t if MESSAGE is from outside the channel." (not (riece-identity-member - (riece-message-target message) - (mapcar #'riece-make-identity - (riece-user-get-channels (riece-message-speaker message)))))) - -(defun riece-own-channel-message (message &optional channel type) - "Display MESSAGE as you sent to CHNL." - (riece-display-message - (riece-make-message (riece-current-nickname) - (or channel riece-current-channel) - message type t))) + (riece-message-speaker message) + (let ((target (riece-message-target message))) + (riece-with-server-buffer (riece-identity-server target) + (mapcar + (lambda (user) + (riece-make-identity user riece-server-name)) + (riece-channel-get-users (riece-identity-prefix target)))))))) (provide 'riece-message) diff --git a/lisp/riece-mini.el b/lisp/riece-mini.el index f44db0c..e57393d 100644 --- a/lisp/riece-mini.el +++ b/lisp/riece-mini.el @@ -79,8 +79,8 @@ If twice (C-u C-u), then ask the channel." (target (cond ((equal arg '(16)) - (completing-read "Channel/User: " - (mapcar #'list riece-current-channels) nil t)) + (riece-completing-read-identity + "Channel/User: " riece-current-channels nil t)) (arg (or riece-mini-last-channel riece-current-channel)) (t riece-current-channel))) (message (read-string (format "Message to %s: " target)))) @@ -90,7 +90,9 @@ If twice (C-u C-u), then ask the channel." (format "PRIVMSG %s :%s\r\n" (riece-identity-prefix target) message)) - (riece-own-channel-message message target)))) + (riece-display-message + (riece-make-message (riece-current-nickname) target + message nil t))))) (defun riece-mini-insinuate () (add-hook 'riece-after-display-message-functions diff --git a/lisp/riece-misc.el b/lisp/riece-misc.el index 9d2d735..2ba5785 100644 --- a/lisp/riece-misc.el +++ b/lisp/riece-misc.el @@ -29,6 +29,7 @@ (require 'riece-identity) (require 'riece-version) (require 'riece-channel) +(require 'riece-server) (require 'riece-user) (defun riece-get-buffer-create (name) @@ -78,16 +79,16 @@ (with-current-buffer buffer (eq riece-freeze 'own))) -(defun riece-process-send-string (process string) - (with-current-buffer (process-buffer process) - (process-send-string process (riece-encode-coding-string string)))) +(defun riece-channel-p (string) + "Return t if STRING is a channel. +\(i.e. it matches `riece-channel-regexp')" + (string-match (concat "^" riece-channel-regexp) string)) -(defun riece-send-string (string) - (let ((process (riece-find-server-process))) - (unless process - (error "%s" (substitute-command-keys - "Type \\[riece-command-open-server] to open server."))) - (riece-process-send-string process string))) +(defun riece-current-nickname () + "Return the current nickname." + (riece-with-server-buffer (riece-identity-server riece-current-channel) + (if riece-real-nickname + (riece-make-identity riece-real-nickname riece-server-name)))) (defun riece-split-parameters (string) (if (eq ?: (aref string 0)) @@ -104,19 +105,19 @@ (setq parameters (nconc parameters (list string)))) parameters))) -(defun riece-concat-modes (target string) - (let ((modes - (if (riece-channel-p target) - (riece-channel-get-modes target) - (riece-user-get-modes target)))) - (if modes - (concat string " [" (apply #'string modes) "]") - string))) +(defun riece-concat-channel-topic (target string) + (riece-with-server-buffer (riece-identity-server target) + (let ((topic (riece-channel-get-topic (riece-identity-prefix target)))) + (if topic + (concat string ": " topic) + string)))) -(defsubst riece-concat-current-channel-modes (string) - (if riece-current-channel - (riece-concat-modes riece-current-channel string) - string)) +(defun riece-concat-channel-modes (target string) + (riece-with-server-buffer (riece-identity-server target) + (let ((modes (riece-channel-get-modes (riece-identity-prefix target)))) + (if modes + (concat string " [" (apply #'string modes) "]") + string)))) (defun riece-concat-message (string message) (if (or (null message) @@ -125,10 +126,9 @@ (concat string " (" message ")"))) (defun riece-concat-server-name (string) - (riece-with-server-buffer - (if riece-server-name - (concat string " (from " riece-server-name ")") - string))) + (if (equal riece-server-name "") + string + (concat string " (from " riece-server-name ")"))) (defun riece-prefix-user-at-host (prefix) (if (string-match "!" prefix) @@ -159,16 +159,16 @@ user-at-host)) (defun riece-get-users-on-server () - (riece-with-server-buffer - (let (users) - (mapatoms - (lambda (atom) - (unless (riece-channel-p (symbol-name atom)) - (setq users (cons (symbol-name atom) users)))) - riece-obarray) - (if (member riece-real-nickname users) - users - (cons riece-real-nickname users))))) + (riece-with-server-buffer (riece-identity-server riece-current-channel) + (let (users) + (mapatoms + (lambda (atom) + (unless (riece-channel-p (symbol-name atom)) + (setq users (cons (symbol-name atom) users)))) + riece-obarray) + (if (member riece-real-nickname users) + users + (cons riece-real-nickname users))))) (provide 'riece-misc) diff --git a/lisp/riece-naming.el b/lisp/riece-naming.el index 51f8029..cde0032 100644 --- a/lisp/riece-naming.el +++ b/lisp/riece-naming.el @@ -30,26 +30,34 @@ (require 'riece-display) (defun riece-naming-assert-join (user-name channel-name) - (if (riece-identity-equal-no-server user-name riece-real-nickname) - (riece-join-channel channel-name)) (riece-user-toggle-channel user-name channel-name t) - (riece-channel-toggle-user channel-name user-name t)) + (riece-channel-toggle-user channel-name user-name t) + (if (riece-identity-equal-no-server user-name riece-real-nickname) + (let ((channel-identity (riece-make-identity channel-name + riece-server-name))) + (riece-join-channel channel-identity) + (riece-switch-to-channel channel-identity)) + (if (and riece-current-channel + (riece-identity-equal (riece-make-identity channel-name + riece-server-name) + riece-current-channel)) + (with-current-buffer riece-user-list-buffer + (setq riece-redisplay-buffer t))))) (defun riece-naming-assert-part (user-name channel-name) + (riece-user-toggle-channel user-name channel-name nil) + (riece-channel-toggle-user channel-name user-name nil) + (riece-channel-toggle-operator channel-name user-name nil) + (riece-channel-toggle-speaker channel-name user-name nil) (if (riece-identity-equal-no-server user-name riece-real-nickname) - (progn - (riece-part-channel channel-name) - (riece-forget-channel channel-name)) - (riece-user-toggle-channel user-name channel-name nil) - (riece-channel-toggle-user channel-name user-name nil) - (riece-channel-toggle-operator channel-name user-name nil) - (riece-channel-toggle-speaker channel-name user-name nil) - (if (riece-identity-equal-safe user-name (riece-current-nickname)) - (let* ((identity (riece-make-identity channel-name)) - (pointer (riece-identity-member-safe - identity riece-current-channels))) - (if pointer - (setcar pointer nil)))))) + (riece-part-channel (riece-make-identity channel-name + riece-server-name)) + (if (and riece-current-channel + (riece-identity-equal (riece-make-identity channel-name + riece-server-name) + riece-current-channel)) + (with-current-buffer riece-user-list-buffer + (setq riece-redisplay-buffer t))))) (defun riece-naming-assert-rename (old-name new-name) (if (riece-identity-equal-no-server old-name riece-real-nickname) @@ -71,7 +79,15 @@ pointer (member old-name users)) (if pointer (setcar pointer new-name)) + (if (and riece-current-channel + (riece-identity-equal (riece-make-identity (car channels) + riece-server-name) + riece-current-channel)) + (with-current-buffer riece-user-list-buffer + (setq riece-redisplay-buffer t))) (setq channels (cdr channels))) (riece-rename-user old-name new-name))) (provide 'riece-naming) + +;;; riece-naming.el ends here diff --git a/lisp/riece-options.el b/lisp/riece-options.el index aa86dbb..333fd5c 100644 --- a/lisp/riece-options.el +++ b/lisp/riece-options.el @@ -68,11 +68,6 @@ :type '(repeat integer) :group 'riece-looks) -(defcustom riece-inhibit-startup-message nil - "If non-nil, the startup message will not be displayed." - :group 'riece-looks - :type 'boolean) - (defcustom riece-directory "~/.riece" "Where to look for data files." :type 'directory @@ -182,11 +177,6 @@ way is to put Riece variables on .emacs or file loaded from there." :type 'string :group 'riece-server) -(defcustom riece-startup-channel-list nil - "A list of channels to join automatically at startup." - :type '(repeat (string :tag "Startup Channel")) - :group 'riece-channel) - (defcustom riece-retry-with-new-nickname nil "When nickname has already been in use, grow-tail automatically." :type 'boolean diff --git a/lisp/riece-rdcc.el b/lisp/riece-rdcc.el index 5b4e891..f984d23 100644 --- a/lisp/riece-rdcc.el +++ b/lisp/riece-rdcc.el @@ -265,9 +265,8 @@ puts(\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" (port (string-to-number (match-string 3 message))) (size (string-to-number (match-string 4 message))) (buffer (if (riece-channel-p target) - (cdr (riece-identity-assoc - (riece-make-identity target) - riece-channel-buffer-alist)))) + (riece-channel-buffer-name + (riece-make-identity target riece-server-name)))) (user (riece-prefix-nickname prefix))) (setq riece-rdcc-requests (cons (list user file address port size) @@ -284,7 +283,7 @@ puts(\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" user (riece-strip-user-at-host (riece-prefix-user-at-host prefix)) - target)) + (riece-decode-coding-string target))) "\n"))) t))) diff --git a/lisp/riece-server.el b/lisp/riece-server.el index 20aedf8..d750824 100644 --- a/lisp/riece-server.el +++ b/lisp/riece-server.el @@ -26,10 +26,7 @@ (require 'riece-options) (require 'riece-globals) ;for server local variables. -(require 'riece-misc) ;riece-process-send-string, etc. (require 'riece-coding) ;riece-default-coding-system -(require 'riece-identity) -(require 'riece-display) (eval-and-compile (defvar riece-server-keyword-map @@ -69,12 +66,14 @@ the `riece-server-keyword-map' variable." (buffer-live-p (car riece-buffer-list))) (funcall riece-buffer-dispose-function (car riece-buffer-list))) (setq riece-buffer-list (cdr riece-buffer-list))) - (setq riece-channel-buffer-alist nil - riece-user-list-buffer-alist nil - riece-current-channels nil + (setq riece-current-channels nil riece-current-channel nil + riece-user-indicator nil riece-channel-indicator "None" - riece-channel-list-indicator "No channel") + riece-channel-list-indicator "No channel" + riece-away-indicator "-" + riece-operator-indicator "-" + riece-freeze-indicator "-") (delete-other-windows)) (defun riece-server-parse-string (string) @@ -102,19 +101,54 @@ the `riece-server-keyword-map' variable." riece-save-variables-are-dirty t)) (cdr entry))) -(defun riece-open-server (server &optional server-name) - (if server-name - (message "Connecting to %s..." server-name) - (message "Connecting to IRC server...")) +(defun riece-server-process-name (server-name) + (if (equal server-name "") + "IRC" + (format "IRC<%s>" server-name))) + +(defun riece-server-process (server-name) + (get-process (riece-server-process-name server-name))) + +(defmacro riece-with-server-buffer (server-name &rest body) + `(let ((process (riece-server-process ,server-name))) + (if process + (with-current-buffer (process-buffer process) + ,@body) + (error "Server closed")))) + +(put 'riece-with-server-buffer 'lisp-indent-function 1) + +(defun riece-process-send-string (process string) + (with-current-buffer (process-buffer process) + (process-send-string process (riece-encode-coding-string string)))) + +(defun riece-send-string (string) + (let* ((server-name + (or riece-overriding-server-name + ;already in the server buffer + (if (local-variable-p 'riece-server-name (current-buffer)) + riece-server-name + (if riece-current-channel + (riece-identity-server riece-current-channel) + (if (riece-server-opened "") + ""))))) + (process (riece-server-process server-name))) + (unless process + (error "%s" (substitute-command-keys + "Type \\[riece-command-open-server] to open server."))) + (riece-process-send-string process string))) + +(defun riece-open-server (server server-name) + (if (equal server-name "") + (message "Connecting to IRC server...") + (message "Connecting to %s..." server-name)) (riece-server-keyword-bind server (let* (selective-display (coding-system-for-read 'binary) (coding-system-for-write 'binary) (process - (funcall function "IRC" - (if server-name - (format " *IRC*%s" server-name) - " *IRC*") + (funcall function (riece-server-process-name server-name) + (concat " *IRC*" server-name) host service))) (riece-reset-process-buffer process) (with-current-buffer (process-buffer process) @@ -138,14 +172,11 @@ the `riece-server-keyword-map' variable." (setq riece-last-nickname riece-real-nickname riece-nick-accepted 'sent riece-coding-system coding)) - (if server-name - (setq riece-server-process-alist - (cons (cons server-name process) - riece-server-process-alist)) - (setq riece-server-process process)))) - (if server-name - (message "Connecting to %s...done" server-name) - (message "Connecting to IRC server...done"))) + (setq riece-process-list + (cons process riece-process-list)))) + (if (equal server-name "") + (message "Connecting to IRC server...done") + (message "Connecting to %s...done" server-name))) (defun riece-reset-process-buffer (process) (save-excursion @@ -172,71 +203,19 @@ the `riece-server-keyword-map' variable." (buffer-disable-undo) (erase-buffer))) -(defun riece-close-server-process (process &optional quit-message) - (if (eq 'riece-filter (process-filter process)) - (set-process-filter process nil)) - (if (eq 'riece-sentinel (process-sentinel process)) - (set-process-sentinel process nil)) - (if (memq (process-status process) '(open run)) - (riece-process-send-string process - (if quit-message - (format "QUIT :%s\r\n" quit-message) - "QUIT\r\n"))) +(defun riece-close-server-process (process) (if riece-debug (delete-process process) - (kill-buffer (process-buffer process)))) - -(eval-when-compile - (autoload 'riece-exit "riece")) -(defun riece-close-server (server-name &optional quit-message) - ;; Remove channels which belong to the server. - (let ((riece-overriding-server-name server-name) - (channels riece-current-channels)) - (while channels - (if (and (car channels) - (equal (riece-identity-server (car channels)) - server-name)) - (riece-part-channel (car channels))) - (setq channels (cdr channels))) - (riece-redisplay-buffers)) - ;; Close now. - (let (process) - (if server-name - (let ((entry (assoc server-name riece-server-process-alist))) - (setq process (cdr entry) - riece-server-process-alist - (delq entry riece-server-process-alist))) - (setq process riece-server-process - riece-server-process nil)) - (riece-close-server-process process quit-message) - ;; If no server process is available, exit. - (if (and (null riece-server-process) - (null riece-server-process-alist)) - (riece-exit)))) - -(defun riece-close-all-server (&optional quit-message) - (let ((process-list - (delq nil (cons riece-server-process - (mapcar #'cdr riece-server-process-alist))))) - (while process-list - (riece-close-server-process (car process-list) quit-message) - (setq process-list (cdr process-list))) - (setq riece-server-process nil - riece-server-process-alist nil) - (riece-exit))) + (kill-buffer (process-buffer process))) + (setq riece-process-list (delq process riece-process-list))) (defun riece-server-opened (&optional server-name) - (let ((processes - (delq nil - (if server-name - (cdr (assoc server-name riece-server-process-alist)) - (cons riece-server-process - (mapcar #'cdr riece-server-process-alist)))))) + (let ((process-list riece-process-list)) (catch 'found - (while processes - (if (memq (process-status (car processes)) '(open run)) + (while process-list + (if (memq (process-status (car process-list)) '(open run)) (throw 'found t)) - (setq processes (cdr processes)))))) + (setq process-list (cdr process-list)))))) (provide 'riece-server) diff --git a/lisp/riece-unread.el b/lisp/riece-unread.el index 6616872..d03024d 100644 --- a/lisp/riece-unread.el +++ b/lisp/riece-unread.el @@ -83,8 +83,8 @@ 'riece-unread-display-message-function) (add-hook 'riece-channel-switch-hook 'riece-unread-channel-switch-hook) - (add-hook 'riece-update-buffers-hook - 'riece-unread-update-channel-list-buffer) + (add-hook 'riece-update-buffer-functions + 'riece-unread-update-channel-list-buffer t) (define-key riece-command-mode-map "\C-c\C-u" 'riece-unread-switch-to-channel) (define-key riece-dialogue-mode-map diff --git a/lisp/riece-user.el b/lisp/riece-user.el index 323e276..e42c825 100644 --- a/lisp/riece-user.el +++ b/lisp/riece-user.el @@ -25,60 +25,46 @@ (require 'riece-identity) -(defconst riece-user-regexp - "[][\\\\`_^{|}A-Za-z][][\\\\`_^{|}A-Za-z0-9-]\\{0,8\\}") - ;;; User object: (defun riece-find-user (name) "Get a user object named NAME from the server buffer." - (riece-with-server-buffer - (let ((symbol (intern-soft (riece-identity-canonicalize-prefix - (riece-identity-prefix name)) - riece-obarray))) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name) + riece-obarray))) (if symbol - (symbol-value symbol))))) + (symbol-value symbol)))) (defun riece-forget-user (name) - (riece-with-server-buffer - (let ((symbol (intern-soft (riece-identity-canonicalize-prefix - (riece-identity-prefix name))))) - (when symbol - (makunbound symbol) - (unintern (symbol-name symbol) riece-obarray))))) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name)))) + (when symbol + (makunbound symbol) + (unintern (symbol-name symbol) riece-obarray)))) (defun riece-rename-user (old-name new-name) - (riece-with-server-buffer - (unless (equal (riece-identity-canonicalize-prefix - (riece-identity-prefix old-name)) - (riece-identity-canonicalize-prefix - (riece-identity-prefix new-name))) - (let ((symbol (intern-soft (riece-identity-canonicalize-prefix - (riece-identity-prefix old-name)) - riece-obarray))) - (when symbol - (set (intern (riece-identity-canonicalize-prefix - (riece-identity-prefix new-name)) - riece-obarray) - (symbol-value symbol)) - (makunbound symbol) - (unintern (symbol-name symbol) riece-obarray)))))) - -(defun riece-make-user (&optional channels user-at-host modes away operator) + (unless (equal (riece-identity-canonicalize-prefix old-name) + (riece-identity-canonicalize-prefix new-name)) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix old-name) + riece-obarray))) + (when symbol + (set (intern (riece-identity-canonicalize-prefix new-name) + riece-obarray) + (symbol-value symbol)) + (makunbound symbol) + (unintern (symbol-name symbol) riece-obarray))))) + +(defun riece-make-user (channels user-at-host modes away operator) "Make an instance of user object. Arguments are appropriate to joined channels, user-at-host, mode, and away status, respectively." (vector channels user-at-host modes away operator)) (defun riece-get-user (name) - (riece-with-server-buffer - (let ((symbol (intern-soft (riece-identity-canonicalize-prefix - (riece-identity-prefix name)) - riece-obarray))) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name) + riece-obarray))) (if symbol (symbol-value symbol) - (set (intern (riece-identity-canonicalize-prefix - (riece-identity-prefix name)) riece-obarray) - (riece-make-user)))))) + (set (intern (riece-identity-canonicalize-prefix name) + riece-obarray) + (riece-make-user nil nil nil nil nil))))) (defun riece-user-channels (user) "Return joined channels of USER." @@ -120,29 +106,24 @@ away status, respectively." "Set the operator status of USER to VALUE." (aset user 4 value)) -(defun riece-user-get-channels (&optional name) - (riece-user-channels - (riece-get-user (or name riece-real-nickname)))) +(defun riece-user-get-channels (name) + (riece-user-channels (riece-get-user name))) -(defun riece-user-get-user-at-host (&optional name) - (riece-user-user-at-host - (riece-get-user (or name riece-real-nickname)))) +(defun riece-user-get-user-at-host (name) + (riece-user-user-at-host (riece-get-user name))) -(defun riece-user-get-modes (&optional name) - (riece-user-modes - (riece-get-user (or name riece-real-nickname)))) +(defun riece-user-get-modes (name) + (riece-user-modes (riece-get-user name))) -(defun riece-user-get-away (&optional name) - (riece-user-away - (riece-get-user (or name riece-real-nickname)))) +(defun riece-user-get-away (name) + (riece-user-away (riece-get-user name))) -(defun riece-user-get-operator (&optional name) - (riece-user-operator - (riece-get-user (or name riece-real-nickname)))) +(defun riece-user-get-operator (name) + (riece-user-operator (riece-get-user name))) (defun riece-user-toggle-channel (name channel flag) "Add or remove the joined channel of user." - (let* ((user (riece-get-user (or name (riece-current-nickname)))) + (let* ((user (riece-get-user name)) (channels (riece-user-channels user))) (if flag (unless (member channel channels) @@ -152,7 +133,7 @@ away status, respectively." (defun riece-user-toggle-mode (name mode flag) "Add or remove user MODE of user." - (let* ((user (riece-get-user (or name (riece-current-nickname)))) + (let* ((user (riece-get-user name)) (modes (riece-user-modes user))) (if flag (unless (memq mode modes) @@ -161,12 +142,10 @@ away status, respectively." (riece-user-set-modes user (delq mode modes)))))) (defun riece-user-toggle-away (name flag) - (riece-user-set-away - (riece-get-user (or name (riece-current-nickname))) flag)) + (riece-user-set-away (riece-get-user name) flag)) (defun riece-user-toggle-operator (name flag) - (riece-user-set-operator - (riece-get-user (or name (riece-current-nickname))) flag)) + (riece-user-set-operator (riece-get-user name) flag)) (provide 'riece-user) diff --git a/lisp/riece-xemacs.el b/lisp/riece-xemacs.el index 055fa7c..f6b1262 100644 --- a/lisp/riece-xemacs.el +++ b/lisp/riece-xemacs.el @@ -70,6 +70,9 @@ Modify whole identification by side effect." (defalias 'riece-simplify-mode-line-format 'riece-xemacs-simplify-modeline-format) +(defalias 'riece-set-case-syntax-pair + 'put-case-table-pair) + (provide 'riece-xemacs) ;;; riece-xemacs.el ends here diff --git a/lisp/riece.el b/lisp/riece.el index 11303ef..f2a743b 100644 --- a/lisp/riece.el +++ b/lisp/riece.el @@ -24,10 +24,6 @@ ;;; Code: -(if (featurep 'xemacs) - (require 'riece-xemacs) - (require 'riece-emacs)) - (require 'riece-filter) (require 'riece-display) (require 'riece-server) @@ -57,6 +53,7 @@ (defvar riece-buffer-mode-alist '((riece-dialogue-buffer . riece-dialogue-mode) (riece-others-buffer . riece-others-mode) + (riece-user-list-buffer . riece-user-list-mode) (riece-channel-list-buffer . riece-channel-list-mode) (riece-private-buffer . riece-dialogue-mode) (riece-wallops-buffer))) @@ -255,16 +252,9 @@ If already connected, just pop up the windows." (setq riece-server (completing-read "Server: " riece-server-alist))) (if (stringp riece-server) (setq riece-server (riece-server-name-to-server riece-server))) - (riece-open-server riece-server) (riece-create-buffers) (riece-configure-windows) - (let ((channel-list riece-startup-channel-list)) - (while channel-list - (if (listp (car channel-list)) - (riece-command-join (car (car channel-list)) - (cadr (car channel-list))) - (riece-command-join (car channel-list))) - (setq channel-list (cdr channel-list)))) + (riece-open-server riece-server "") (run-hooks 'riece-startup-hook) (message "%s" (substitute-command-keys "Type \\[describe-mode] for help")))) @@ -298,7 +288,7 @@ For a list of the generic commands type \\[riece-command-generic] ? RET. " " riece-user-indicator " " - riece-current-channel))) + riece-short-channel-indicator))) (riece-simplify-mode-line-format) (use-local-map riece-command-mode-map) @@ -318,10 +308,8 @@ All normal editing commands are turned off. Instead, these commands are available: \\{riece-dialogue-mode-map}" (kill-all-local-variables) - (make-local-variable 'riece-freeze) (make-local-variable 'tab-stop-list) - (setq riece-freeze riece-default-freeze riece-away-indicator "-" riece-operator-indicator "-" @@ -337,7 +325,6 @@ Instead, these commands are available: riece-channel-list-indicator " ")) buffer-read-only t tab-stop-list riece-tab-stop-list) - (riece-update-status-indicators) (riece-simplify-mode-line-format) (use-local-map riece-dialogue-mode-map) (buffer-disable-undo) @@ -369,6 +356,8 @@ Instead, these commands are available: "Major mode for displaying channel list. All normal editing commands are turned off." (kill-all-local-variables) + (buffer-disable-undo) + (make-local-variable 'riece-redisplay-buffer) (setq major-mode 'riece-channel-list-mode mode-name "Channels" mode-line-buffer-identification @@ -384,6 +373,8 @@ All normal editing commands are turned off. Instead, these commands are available: \\{riece-user-list-mode-map}" (kill-all-local-variables) + (buffer-disable-undo) + (make-local-variable 'riece-redisplay-buffer) (setq major-mode 'riece-user-list-mode mode-name "User list" mode-line-buffer-identification -- 2.25.1