@section Installation
Riece \e$B$N:G?7HG$O!"\e(B
-@uref{http://wiliki.designflaw.org/index.cgi?Riece&l=jp} \e$B$GG[I[$7$F$$$^\e(B
+@uref{http://wiliki.designflaw.org/riece.cgi} \e$B$GG[I[$7$F$$$^\e(B
\e$B$9!#E83+$7$?$i!"0J2<$N%3%^%s%I$r<B9T$9$k$3$H$G<j85$N4D6-$K%$%s%9%H!<%k$G\e(B
\e$B$-$^$9\e(B
\e$B%_%K%P%C%U%!$N$_$G\e(B IRC \e$B$r$9$k\e(B
@item riece-log
\e$B2qOC$N%m%0$N<}=8\e(B
+@item riece-alias
+\e$B%A%c%s%M%kL>$d%K%C%/%M!<%`$NJLL>$rDj5A\e(B
@end table
\e$B$3$l$i$N$&$A!"\e(B@samp{riece-highlight} \e$B$H\e(B @samp{riece-ctcp} \e$B$O%G%U%)%k%H$G\e(B
\e$B%m!<%+%kJQ?t$r2p$7$F%"%/%;%9$7$^$9!#\e(B
@subsection Obtaining server buffer
-\e$B%5!<%P$N%P%C%U%!$r<hF@$9$k$K$O!"$^$:$O$8$a$K%5!<%P$NL>A0$rF@$kI,MW$,$"$j\e(B
-\e$B$^$9!#$3$l$K$O\e(B @code{riece-find-server-name} \e$B$r;H$$$^$9!#$3$N4X?t$O!">u\e(B
-\e$B67$K1~$8$FA*Br$9$Y$-%5!<%P$NL>A0$rJV$7$^$9!#6qBNE*$K$O0J2<$N=g=x$G8!:w$r\e(B
-\e$B9T$$$^$9!#\e(B
-@findex riece-find-server-name
+\e$B%5!<%P$N%W%m%;%9$rF@$k$K$O!"$^$:$O$8$a$K%5!<%P$NL>A0$rF@$kI,MW$,$"$j\e(B
+\e$B$^$9!#%5!<%P$NL>A0$O0J2<$K5s$2$k$$$/$D$+$NJ}K!$G<hF@$G$-$^$9!#\e(B
-@enumerate
+@table @samp
@item
@vindex riece-overrinding-server-name
\e$BBg0hJQ?t\e(B @code{riece-overrinding-server-name} \e$B$NCM\e(B
\e$BCM$=$N$b$N\e(B
@item
-@vindex riece-current-channel
-\e$B%f!<%6$,8=:_$$$k%A%c%s%M%k\e(B (@code{riece-current-channel}) \e$B$NBg0hL>\e(B(\e$B8e=R\e(B)
-\e$B$+$i@Z$j=P$7$?%5!<%PL>\e(B
-@end enumerate
+@samp{riece-identity} \e$B%*%V%8%'%/%H$K7k$SIU$1$i$l$?%5!<%PL>\e(B(\e$B8e=R\e(B)
+@end table
-\e$B$3$&$7$FF@$?%5!<%PL>$G\e(B @code{riece-server-process-alist} \e$B$r:w$-!"%5!<%P\e(B
-\e$B$N%W%m%;%9$r<hF@$7$^$9!#%^%/%m\e(B riece-with-server-buffer \e$B$r;H$&$H!"$3$3$^\e(B
-\e$B$G$r0l3g$G$d$C$?$&$($G!"%W%m%;%9$N%P%C%U%!$G<0$rI>2A$9$k$3$H$,$G$-$^$9!#\e(B
-@vindex riece-server-process-alist
+\e$B$3$&$7$FF@$?%5!<%PL>$G\e(B @code{riece-server-process} \e$B$r8F=P$7!"%5!<%P$N\e(B
+\e$B%W%m%;%9$r<hF@$7$^$9!#\e(B
+@findex riece-server-process
-@subsection Global name
-\e$BJ#?t$N%5!<%P$K7R$$$@>l9g!"%A%c%s%M%kL>$d%K%C%/$r\e(B(\e$B%5!<%P$N%P%C%U%!>e$@$1\e(B
-\e$B$G$O$J$/\e(B)\e$BBg0hE*$K6hJL$9$kI,MW$,@8$8$^$9!#$=$3$G!"$3$l$i$NL>A0$r9)IW$7$F!"\e(B
-\e$BL>A0$N8e$K6uGr$r64$s$G%5!<%PL>$r;XDj$9$k<jK!$r:N$C$F$$$^$9!#$3$l$rBg0hL>\e(B
-\e$B$H8F$S$^$9!#$?$H$($P!"\e(B@samp{irc6} \e$B$H$$$&%5!<%P$N\e(B @samp{#Liece} \e$B$H$$$&%A%c\e(B
-\e$B%s%M%k$NBg0hL>$O\e(B @samp{#Liece irc6} \e$B$H$J$j$^$9!#\e(B
+@subsection Identity
+\e$BJ#?t$N%5!<%P$K7R$$$@>l9g!"%A%c%s%M%kL>$d%K%C%/$r\e(B(\e$B%5!<%P$N%P%C%U%!>e$@\e(B
+\e$B$1$G$O$J$/\e(B)\e$BBg0hE*$K6hJL$9$kI,MW$,@8$8$^$9!#$3$N$h$&$JL>A0$rI=8=$9$k$N\e(B
+\e$B$,\e(B @samp{riece-identity} \e$B%*%V%8%'%/%H$G$9!#\e(B
-\e$B$3$3$G6h@Z$j$r6uGr$K$7$F$$$k$N$O!"\e(BRFC2812 \e$B$G%A%c%s%M%k$K;HMQ$G$-$J$$J8;z\e(B
-\e$B$@$+$i$G$9!#\e(B
+@samp{riece-identity} \e$B%*%V%8%'%/%H$O0J2<$N\e(B 2 \e$B$D$NMWAG$r$b$D%Y%/%?!<$G$9!#\e(B
+
+@table @samp
+@item prefix
+\e$B%5!<%P%m!<%+%k$JL>A0\e(B
+@item server
+\e$B%5!<%P$NL>A0\e(B
+@end table
-\e$BBg0hL>$r07$&$K$O!"\e(B@samp{riece-identity} \e$B$H$$$&Cj>]$r2p$7$^$9!#$3$N%b%8%e!<\e(B
-\e$B%k$G$O!"0J2<$N$h$&$J4X?t$,Dj5A$5$l$F$$$^$9!#\e(B
+@samp{riece-identity} \e$B%*%V%8%'%/%H$KBP$9$kA`:n$K$O0J2<$N$h$&$J$b$N$,$"$j$^$9!#\e(B
@defun riece-make-identity prefix &optional server
-\e$BBg0hI=5-$r:n@.$7$^$9!#\e(Bserver \e$B$,>JN,$5$l$?>l9g$K$O!"\e(B
+@samp{riece-identity} \e$B%*%V%8%'%/%H$r:n@.$7$^$9!#\e(Bserver \e$B$,>JN,$5$l$?>l9g$K$O!"\e(B
riece-find-server-name \e$B$r;H$C$F<hF@$7$?%5!<%PL>$r;H$$$^$9\e(B
@end defun
@defun riece-identity-prefix identity
-\e$BBg0hI=5-$+$i%5!<%PL>$r=|$/ItJ,$rJV$7$^$9\e(B
+@samp{riece-identity} \e$B%*%V%8%'%/%H$+$i%5!<%P%m!<%+%k$JL>A0$r<h$j=P$7$^$9!#\e(B
@end defun
@defun riece-identity-server identity
-\e$BBg0hI=5-$+$i%5!<%P$r=|$/ItJ,$rJV$7$^$9\e(B
+@samp{riece-identity} \e$B%*%V%8%'%/%H$+$i%5!<%P$NL>A0$r<h$j=P$7$^$9!#\e(B
@end defun
-@defun riece-identity-canonicalize-prefix prefix
-\e$BBg0hI=5-$N%5!<%PL>$r=|$/ItJ,$r@55,2=$7$^$9!#$9$J$o$A!"\e(B
-@var{prefix} \e$B$rA4$F>.J8;z$KD>$7$?>e$G!"\e(BRFC2812 2.2 \e$B$K$J$i$$!"\e(B
-@samp{[]\~} \e$B$N$=$l$>$l$NJ8;z$r\e(B @samp{@{@}|^} \e$B$KCV$-49$($^$9!#\e(B
-@end defun
-
@defun riece-identity-equal ident1 ident2
-\e$BFs$D$NBg0hI=5-$,F1Ey$+D4$Y$^$9!#\e(B
-@end defun
-
-@defun riece-identity-equal-safe ident1 ident2
-@code{riece-identity-equal} \e$B$H0l=o$G$9$,!"0z?t$H$7$FM?$($i$l$?J8;zNs$K%5!<\e(B
-\e$B%PL>$,IU2C$5$l$F$$$J$1$l$P!"IU2C$7$F$+$i8!::$r9T$$$^$9!#\e(B
+2 \e$B$D$N\e(B@samp{riece-identity} \e$B%*%V%8%'%/%H$,F1Ey$+D4$Y$^$9!#\e(B
@end defun
@defun riece-identity-equal-no-server ident1 ident2
-\e$BFs$D$NBg0hI=5-$N%5!<%P0J30$NItJ,$,F1Ey$+D4$Y$^$9!#\e(B
+2 \e$B$D$N\e(B@samp{riece-identity} \e$B%*%V%8%'%/%H$N%5!<%P%m!<%+%k$JL>A0$,F1Ey$+\e(B
+\e$BD4$Y$^$9!#\e(B
@end defun
@defun riece-identity-member elt list
-\e$BBg0hI=5-\e(B @var{elt} \e$B$,\e(B @var{list} \e$B$K4^$^$l$k$+8!::$7$^$9!#\e(B
-@end defun
-
-@defun riece-identity-member-safe elt list
-@code{riece-identity-member} \e$B$H0l=o$G$9$,!"0z?t$K%5!<%PL>$,IU2C$5$l$F$$\e(B
-\e$B$J$1$l$P!"IU2C$7$F$+$i8!::$r9T$$$^$9!#\e(B
-@end defun
-
-@defun riece-identity-member-no-server elt list
-@code{riece-identity-member} \e$B$H0l=o$G$9$,!"Bg0hI=5-$N%5!<%P0J30$NItJ,$@\e(B
-\e$B$1$r8!::$7$^$9!#\e(B
+@samp{riece-identity} \e$B%*%V%8%'%/%H\e(B @var{elt} \e$B$,\e(B @var{list} \e$B$K4^$^$l$k\e(B
+\e$B$+8!::$7$^$9!#\e(B
@end defun
@subsection Channel and user management
-IRC \e$B$N%A%c%s%M%k$H%f!<%6$O4pK\E*$KC1$J$k%Y%/%?!<$H$7$FI=8=$5$l$F$$$^$9!#\e(B
-JOIN \e$B$d\e(B PART \e$B$H$$$C$?FCJL$JA`:n$O!"$3$l$i$N%*%V%8%'%/%H$K$O7k$S$D$1$^$;\e(B
-\e$B$s!#7k$S$D$1$?$[$&$,%*%V%8%'%/%H;X8~$GNI$$$N$G$O$J$$$+!"$H$$$&0U8+$b$"$j\e(B
-\e$B$^$9$,!"$=$N$h$&$K$9$k$H!"Aj8_$N7k$SIU$-$,6[L)$K$J$j$9$.!"%9%Q%2%C%F%#$N\e(B
-\e$B$b$H$K$J$k$3$H$O4{$K7P83:Q$_$G$9!#\e(B
+@samp{riece-identity} \e$B%*%V%8%'%/%H$K$h$C$F<1JL$5$l$k\e(B IRC \e$B$N%A%c%s%M%k\e(B
+\e$B$H%f!<%6$O$=$l$>$l\e(B @samp{riece-channel} \e$B%*%V%8%'%/%H$H\e(B
+@samp{riee-user} \e$B%*%V%8%'%/%H$K$h$jI=8=$5$l$^$9!#\e(B
@subsubsection Channels
@code{riece-channel} \e$B$O!"\e(BIRC \e$B$N%A%c%s%M%k$rI=$9%*%V%8%'%/%H$G$9!#0J2<$N\e(B
@end table
@subsubsection Mediator
-\e$B$5$F!"%A%c%s%M%k$H%f!<%6$N;22C$r4IM}$9$k$?$a$K!"\e(B @code{riece-naming} \e$B$H\e(B
-\e$B$$$&>e0L$N%b%8%e!<%k$rMQ0U$7$F$$$^$9!#$3$l$O!"%G%6%$%s%Q%?!<%s$G$$$&$H$3\e(B
-\e$B$m$N\e(B Mediator \e$B%Q%?!<%s$KAjEv$9$k$b$N$G$9!#\e(B
+\e$B%A%c%s%M%k$H%f!<%6$N;22C!&N%C&$r4IM}$9$k$?$a$K!"\e(B @code{riece-naming}
+\e$B$H$$$&>e0L$N%b%8%e!<%k$rMQ0U$7$F$$$^$9!#$3$l$O!"%G%6%$%s%Q%?!<%s$G$$$&\e(B
+\e$B$H$3$m$N\e(B Mediator \e$B%Q%?!<%s$KAjEv$9$k$b$N$G$9!#\e(B
@code{riece-naming} \e$B$r2p$9$k$3$H$G!"A0=R$N%A%c%s%M%k!&%f!<%6%*%V%8%'%/%H\e(B
\e$B$KD>@\<j$r?($l$k$3$H$J$/!"L>A06u4V$K0BA4$K%"%/%;%9$9$k$3$H$,$G$-$^$9!#\e(B
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)))
+2003-08-04 Daiki Ueno <ueno@unixuser.org>
+
+ * riece-server.el (riece-find-server-name): Abolish.
+
+ * riece-alias.el: Add usage.
+
+2003-08-04 Daiki Ueno <ueno@unixuser.org>
+
+ * 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 <ueno@unixuser.org>
* Riece: Version 0.0.4 released.
* riece-unread.el (riece-unread-display-message-function): Don't check
`selected-window'. It doesn't work as expected.
+2003-06-23 Daiki Ueno <ueno@unixuser.org>
+
+ * 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 <ueno@unixuser.org>
+
+ * 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 <yoichi@geiin.org>
* riece-log.el, riece-mini.el, riece-unread.el, riece-url.el:
* riece-coding.el (riece-default-coding-system): Fix default value.
+2003-06-22 Daiki Ueno <ueno@unixuser.org>
+
+ * 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 <bg66@koka-in.org>
* riece-unread.el (riece-unread-display-message-function): Check a
* riece-commands.el (riece-command-join): Use `let*' instead of `let'.
(riece-command-part): Ditto.
+2003-06-12 Daiki Ueno <ueno@unixuser.org>
+
+ * 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 <ueno@unixuser.org>
+
+ * 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 <ueno@unixuser.org>
+
+ * 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 <ueno@unixuser.org>
+
+ * 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 <ueno@unixuser.org>
+
+ * 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 <ueno@unixuser.org>
+
+ * 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 <ueno@unixuser.org>
+
+ * 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 <ueno@unixuser.org>
+
+ * 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 <ueno@unixuser.org>
+
+ * 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 <ueno@unixuser.org>
+
+ * 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 <bg66@koka-in.org>
* riece-ndcc.el (riece-ndcc-server-sentinel): Close a parenthesis.
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
(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"
(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)
(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
(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)
(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
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)
(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
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))))
(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)
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
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)
(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)))
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))))
--- /dev/null
+;;; riece-alias.el --- define aliases of names
+;; Copyright (C) 1998-2003 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; 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
;;; 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
(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."
"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)
(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)
(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)
(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)
(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)
(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)
(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)
;;; 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
(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
"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
"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)
(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"
(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: "
(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: "
(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? "))
(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? "))
(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? "))
(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
(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
(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
(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
(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."
(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.")))
(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)
(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.")))
(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))
(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."
(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\":"
;;; Code:
+(if (featurep 'xemacs)
+ (require 'riece-xemacs)
+ (require 'riece-emacs))
+
(defalias 'riece-mode-line-buffer-identification
'identity)
(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)))
(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
(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"
(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
(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"))
(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
: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))
(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 ()
(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)
"-")))))
(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)
(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)
(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.
--- /dev/null
+;;; riece-doctor.el --- "become a psychotherapist" add-on
+;; Copyright (C) 1998-2003 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; 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
;;; Code:
+(defalias 'riece-set-case-syntax-pair
+ 'set-case-syntax-pair)
+
(provide 'riece-emacs)
;;; riece-emacs.el ends here
(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))
(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)
;;; 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.")
"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.
(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 "-")
"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)
(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)))
(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
(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"
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)))
(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)))
(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
(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)))
(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
(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)))
(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))
(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))
(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)
(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)))
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))))
(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)))
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)))))
;;; 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."
(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
(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)))
(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)
: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)
"<")))))
(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)
">")))))
(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."
(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)
(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)
(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)
(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))))
(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
(require 'riece-identity)
(require 'riece-version)
(require 'riece-channel)
+(require 'riece-server)
(require 'riece-user)
(defun riece-get-buffer-create (name)
(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))
(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)
(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)
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)
(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)
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
: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
: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
(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)
user
(riece-strip-user-at-host
(riece-prefix-user-at-host prefix))
- target))
+ (riece-decode-coding-string target)))
"\n")))
t)))
(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
(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)
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)
(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
(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)
'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
(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."
"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)
(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)
(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)
(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
;;; Code:
-(if (featurep 'xemacs)
- (require 'riece-xemacs)
- (require 'riece-emacs))
-
(require 'riece-filter)
(require 'riece-display)
(require 'riece-server)
(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)))
(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"))))
" "
riece-user-indicator
" "
- riece-current-channel)))
+ riece-short-channel-indicator)))
(riece-simplify-mode-line-format)
(use-local-map riece-command-mode-map)
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 "-"
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)
"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
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
projects / elisp / riece.git / commitdiff