From a90da5167ee52cbf7b1320a4c6a4465b8b10075d Mon Sep 17 00:00:00 2001 From: Daiki Ueno Date: Sun, 7 Mar 2004 23:16:48 +0000 Subject: [PATCH] Merge signal-slot branch. --- doc/riece-ja.texi | 99 +++++++++++++++- lisp/COMPILE | 2 + lisp/ChangeLog | 246 +++++++++++++++++++++++++++++++++++++++ lisp/Makefile.am | 4 +- lisp/riece-300.el | 104 +++++++++-------- lisp/riece-commands.el | 23 ++-- lisp/riece-ctcp.el | 1 - lisp/riece-display.el | 250 +++++++++++++++++++++++++++++++++++----- lisp/riece-emacs.el | 4 + lisp/riece-filter.el | 1 - lisp/riece-handle.el | 123 ++++++++++++-------- lisp/riece-highlight.el | 18 ++- lisp/riece-history.el | 28 ++++- lisp/riece-message.el | 5 +- lisp/riece-naming.el | 61 ++++++---- lisp/riece-ndcc.el | 1 - lisp/riece-signal.el | 109 ++++++++++++++++++ lisp/riece-unread.el | 29 +++-- lisp/riece-xemacs.el | 5 + lisp/riece-xface.el | 43 +++---- lisp/riece.el | 1 + 21 files changed, 944 insertions(+), 213 deletions(-) create mode 100644 lisp/riece-signal.el diff --git a/doc/riece-ja.texi b/doc/riece-ja.texi index a43f04e..53a4ef0 100644 --- a/doc/riece-ja.texi +++ b/doc/riece-ja.texi @@ -192,7 +192,7 @@ Riece $B$O@_Dj%U%!%$%k$rJQ?t(B @code{riece-directory} $B$G;X<($5$l$k%G%#%l%/% * Connecting to multiple servers:: $BJ#?t$N%5!<%P$K$D$J$0$K$O(B @end menu -@node Windows, Commands, Basic usage, Basic usage +@node Windows, Indicators, Basic usage, Basic usage @section Windows $B%G%U%)%k%H$N@_Dj$G$O!"%A%c%s%M%k$KF~$k$H!"2<$N?^$K<($9$h$&$J8^$D$N%&%#%s(B @@ -237,7 +237,7 @@ Riece $B$O@_Dj%U%!%$%k$rJQ?t(B @code{riece-directory} $B$G;X<($5$l$k%G%#%l%/% $B%"%6!<%:%P%C%U%!(B (@samp{*Others*})$B!#8=:_$N%A%c%s%M%k0J30$N2qOC$,N.$l$^$9!#(B @end enumerate -@node Indicators +@node Indicators, Commands, Windows, Basic usage @section Indicators $B%3%^%s%I%P%C%U%!$d%A%c%s%M%k%P%C%U%!$N%b!<%I%i%$%s$N:8C<$K$O!"(B @@ -262,7 +262,7 @@ Riece: --- ueno #Liece [n] $B$P(B @samp{f}) @end enumerate -@node Commands, Connecting to multiple servers, Windows, Basic usage +@node Commands, Connecting to multiple servers, Indicators, Basic usage @section Commands $BJ8>O$rF~NO$7$?%P%C%U%!$O!"%3%^%s%I%P%C%U%!$H8F$P$l!"%3%^%s%I%P%C%U%!$+$i(B @@ -373,10 +373,12 @@ Riece $B$N%P!<%8%g%s$rI=<($7$^$9!#A0CV0z?t(B (@kbd{C-u}) $B$rM?$($k$H!"$h$j>\ $B%f!<%6%j%9%H%P%C%U%!$NI=<(!&HsI=<($r@Z$jBX$($^$9(B(@code{riece-command-toggle-user-list-buffer-mode}) @item C-c C-t f @findex riece-command-toggle-freeze -$B%A%c%s%M%k%P%C%U%!!"$^$?$O%@%$%"%m%0%P%C%U%!$N%9%/%m!<%k$r6X;_$7$^$9(B(@code{riece-command-toggle-freeze}) +$B%A%c%s%M%k%P%C%U%!!"$^$?$O%@%$%"%m%0%P%C%U%!$rE`7k(B($B%9%/%m!<%k$r6X;_(B)$B$7$^(B +$B$9(B(@code{riece-command-toggle-freeze}) @item C-c C-t o @findex riece-command-toggle-own-freeze -$B%A%c%s%M%k%P%C%U%!!"$^$?$O%@%$%"%m%0%P%C%U%!$N%9%/%m!<%k$r!"<+J,$,H/8@$9$k$^$G6X;_$7$^$9(B(@code{riece-command-toggle-own-freeze}) +$B%A%c%s%M%k%P%C%U%!!"$^$?$O%@%$%"%m%0%P%C%U%!$r!"<+J,$,H/8@$9$k$^$GE`7k$7(B +$B$^$9(B(@code{riece-command-toggle-own-freeze}) @item C-c C-t a @findex riece-command-toggle-away $B<+J,$NN%@J>uBV$r@Z$jBX$($^$9(B(@code{riece-command-toggle-away}) @@ -617,6 +619,7 @@ Riece $B$K$O!"%O%s%I%i%U%C%/$H8F$P$l$kFCAw(B (Emacs 21.3 $B$ @code{make-network-connection} $B$K$h$kA06u4V$r4IM}(B @@ -870,6 +875,88 @@ AWAY $BCf$+$I$&$+(B $B%f!<%6$NL>A0$,JQ99$5$l$?$3$H$rI=L@$7$^$9(B @end defun +@node Signals, , Namespace management, Development +@section Signals + +$B2hLL$N:FIA2h$r8zN(NI$/9T$&$?$a$K!"%$%Y%s%H$HIA2hBP>]$N%*%V%8%'%/%H(B($B%P%C(B +$B%U%!$d!"%b!<%I%i%$%s$N0u(B @pxref{Indicators})$B$r7k$SIU$1$k%a%+%K%:%`$rMQ0U(B +$B$7$F$$$^$9!#(B + +$B2?$i$+$N%$%Y%s%H$,H/@8$9$k$H!"%7%0%J%k$,Aw=P$5$l$^$9!#%7%0%J%k$N35G0$O!"(B +Qt $B$d(B GTK+ $B$H$$$C$?(B GUI $B%D!<%k%-%C%H$KMQ0U$5$l$F$$$k$b$N$HF1MM$G$9!#(B + +$B%7%0%J%k$rAw=P$9$k$K$O!"(B@samp{riece-emit-signal} $B$r;H$$$^$9!#(B + +@defun riece-emit-signal signal-name &rest args +@var{signal-name} $B$G;X<($5$l$k%7%0%J%k$r!"0z?t(B @var{args} $B$H$H$b$KAw=P$7$^$9(B +@end defun + +$B%7%0%J%k$K1~Ez$9$k$K$O!"(B@samp{riece-connect-signal} $B$r;H$$$^$9!#(B + +@defun riece-connect-signal signal-name slot-function &optional filter-function handback +@var{signal-name} $B$G;X<($5$l$k%7%0%J%k$K1~Ez$9$k4X?t(B @var{slot-function} +$B$r7k$SIU$1$^$9!#(B@var{slot-function} $B$K;XDj$5$l$?4X?t$O(B 2 $B$D$N0z?t$rl9g$K$O!"(B +@var{slot-function} $B$,8F$P$l$k$3$H$O$"$j$^$;$s!#(B +@end defun + +$B%7%0%J%k%*%V%8%'%/%H$K%"%/%;%9$9$k$K$O!"0J2<$N4X?t$r;H$$$^$9!#(B + +@defun riece-signal-name +$B%7%0%J%k$NL>A0(B($B%7%s%\%k(B)$B$rJV$7$^$9!#(B +@end defun + +@defun riece-signal-args +$B%7%0%J%kAw=P;~$KM?$($i$l$?0z?t$rJV$7$^$9!#(B +@end defun + +$B8=:_!"0J2<$N%7%0%J%k$,I8=`$GEPO?$5$l$F$$$^$9!'(B + +@table @samp +@item channel-list-changed +$B;22C$7$F$$$k%A%c%s%M%k$N0lMw$NJQ2=(B +@item user-list-changed +$B%A%c%s%M%k$N;22CA0$rJQ99(B +($B0z?t$O!"0JA0$H8=:_$NL>A0$KAjEv$9$k(B @samp{riece-identity} $B%*%V%8%'%/%H(B) +@item user-away-changed +$B%f!<%6$NN%@J>uBV$NJQ2=(B +($B0z?t$O!"%f!<%6$KAjEv$9$k(B @samp{riece-identity} $B%*%V%8%'%/%H(B) +@item user-operator-changed +$B%f!<%6$N%*%Z%l!<%?>uBV$NJQ2=(B +($B0z?t$O!"%f!<%6$KAjEv$9$k(B @samp{riece-identity} $B%*%V%8%'%/%H(B) +@item channel-topic-changed +$B%A%c%s%M%k$N%H%T%C%/$NJQ2=(B +($B0z?t$O!"%A%c%s%M%k$KAjEv$9$k(B @samp{riece-identity} $B%*%V%8%'%/%H(B) +@item channel-modes-changed +$B%A%c%s%M%k$N%b!<%I$NJQ2=(B +($B0z?t$O!"%A%c%s%M%k$KAjEv$9$k(B @samp{riece-identity} $B%*%V%8%'%/%H(B) +@item channel-operators-changed +$B%A%c%s%M%k$G%*%Z%l!<%?8"8B$r;}$D%f!<%6$N0lMw$NJQ2=(B +($B0z?t$O!"%A%c%s%M%k$KAjEv$9$k(B @samp{riece-identity} $B%*%V%8%'%/%H(B) +@item channel-speakers-changed +$B%A%c%s%M%k$GH/8@8"$r;}$D%f!<%6$N0lMw$NJQ2=(B +($B0z?t$O!"%A%c%s%M%k$KAjEv$9$k(B @samp{riece-identity} $B%*%V%8%'%/%H(B) +@item buffer-freeze-changed +$B%P%C%U%!$NE`7k>uBV$NJQ2=(B +($B0z?t$O%P%C%U%!(B) +@end table + @node Index, Function Index, Development, Top @chapter Index @printindex cp diff --git a/lisp/COMPILE b/lisp/COMPILE index f9abd24..de49d00 100644 --- a/lisp/COMPILE +++ b/lisp/COMPILE @@ -18,6 +18,8 @@ riece-user riece-misc + riece-signal + ;; riece-layout ---> riece-display riece-layout riece-display diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 43dd8f7..fa5b7dc 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,249 @@ +2004-03-07 Daiki Ueno + + * riece-display.el: Rename some signals. + + * riece-commands.el (riece-command-set-operators): Reverse user-list. + (riece-command-set-speakers): Ditto. + +2004-03-07 Daiki Ueno + + * riece-unread.el + (riece-unread-format-identity-for-channel-list-indicator): Escape + % -> %%; use riece-propertize-modeline-string. + + * riece-history.el + (riece-history-format-identity-for-channel-list-indicator): Escape + % -> %%; use riece-propertize-modeline-string. + + * riece-highlight.el + (riece-highlight-format-identity-for-channel-list-indicator): + Escape % -> %%; use riece-propertize-modeline-string. + + * riece-display.el + (riece-format-identity-for-channel-list-indicator): Escape % -> + %%. + (riece-update-channel-list-indicator): Rewrite. + + * riece-emacs.el (riece-propertize-modeline-string): New function. + * riece-xemacs.el (riece-propertize-modeline-string): New function. + +2004-03-07 Daiki Ueno + + * riece-unread.el + (riece-unread-format-identity-for-channel-list-indicator): New + function. + (riece-unread-insinuate): Setup + riece-format-identity-for-channel-list-indicator-functions. + + * riece-history.el + (riece-history-format-identity-for-channel-list-buffer): New + function. + (riece-history-insinuate): Setup + riece-format-identity-for-channel-list-indicator-functions. + + * riece-highlight.el + (riece-highlight-format-identity-for-channel-list-indicator): New + function. + (riece-highlight-insinuate): Setup + riece-format-identity-for-channel-list-indicator-functions. + + * riece-display.el + (riece-format-identity-for-channel-list-buffer): Rename from + riece-format-channel-list-line. + (riece-format-identity-for-channel-list-indicator): New function. + (riece-update-channel-list-indicator): Use it. + +2004-03-07 Daiki Ueno + + * riece-handle.el (riece-parse-modes): Make sure that mode params + are started at the beginning of the mode string. + (riece-handle-channel-modes): Fixed arguments passed to + riece-channel-toggle-*. + +2004-03-06 Daiki Ueno + + * riece-xface.el (riece-xface-insinuate): Set + 'riece-update-buffer-functions local to the user-list buffer. + + * riece-unread.el: Require 'riece-signal instead of + 'riece-display. + (riece-unread-after-display-message-function): Emit + 'riece-update-buffer signal instead of + 'riece-unread-channel-list-update signal. + + * riece-ndcc.el: Don't require 'riece-display. + + * riece-naming.el: Require 'riece-signal instead of + 'riece-display. + (riece-naming-assert-rename): Don't rename buffer. + + * riece-history.el (riece-history-format-channel-list-line): Don't + append "\n". + + * riece-handle.el: Require 'riece-signal instead of + 'riece-display. + (riece-parse-modes): Rename from riece-parse-channel-modes; don't + update channel modes. + (riece-handle-channel-modes): New function which processes the + result of riece-parse-modes. + (riece-handle-mode-message): Use it. + + * riece-filter.el: Don't require 'riece-display. + * riece-display.el: Require 'riece-signal; connect + 'riece-update-buffer signal. + + * riece-ctcp.el: Don't require 'riece-display. + + * riece-signal.el: New module splitted from riece-display.el. + * Makefile.am (EXTRA_DIST): Add riece-signal. + * COMPILE (riece-modules): Add riece-signal. + +2004-03-05 Daiki Ueno + + * riece-unread.el (riece-unread-after-display-message-function): + Emit 'riece-unread-channel-list-update signal. + (riece-unread-insinuate): Connect the signal to the function which + updates channel-list buffer. + + * riece-display.el (riece-display-connect-signals): Fix parenthesis. + +2004-03-04 Daiki Ueno + + * riece-display.el (riece-emit-signal): Fixed bug that errors + during signal filter execution were not caught. + (riece-display-connect-signals): Check riece-current-channel is set. + +2004-03-01 Daiki Ueno + + * riece-display.el (riece-display-connect-signals): Fixed bug in + signal filters. + + * riece-handle.el (riece-handle-mode-message): Don't call + riece-parse-channel-modes if channel doesn't match with + riece-channel-regexp. + +2004-02-28 Daiki Ueno + + * riece-display.el (riece-display-connect-signals): Connect some + signals. + + * riece-naming.el (riece-naming-assert-join): Don't change the + current channel manually. + (riece-naming-assert-part): Ditto. + (riece-naming-assert-rename): Ditto. + (riece-naming-assert-channel-users): Ditto. + +2004-02-27 Daiki Ueno + + * riece-display.el (riece-emit-signal): Create signal object + internally. + + * riece-message.el (riece-display-message-1): Emit + 'riece-buffer-toggle-freeze signal. + + * riece-commands.el (riece-command-toggle-freeze): Emit + 'riece-buffer-toggle-freeze signal; don't update status indicators + manually. + (riece-command-toggle-own-freeze): Ditto. + + * riece-naming.el (riece-naming-assert-join): Rename signal 'join + -> 'riece-naming-assert-join. + (riece-naming-assert-part): Rename signal 'part -> + 'riece-naming-assert-part. + (riece-naming-assert-rename): Rename signal 'rename -> + 'riece-naming-assert-rename. + (riece-naming-assert-channel-users): Rename from + riece-naming-assert-users; rename signal 'users -> + 'riece-naming-assert-channel-users. + + * riece-handle.el (riece-handle-topic-message): Emit + 'riece-channel-set-topic signal. + (riece-parse-channel-modes): Emit 'riece-channel-toggle-operator, + 'riece-channel-toggle-speaker, and 'riece-channel-toggle-modes signals. + + * riece-display.el (riece-display-connect-signals): Rename some + signals; connect more signals. + + * riece-300.el (riece-handle-302-message): Emit + 'riece-user-toggle-away, and 'riece-user-toggle-operator signals; + don't update status indicators manually. + (riece-handle-301-message): Emit 'riece-user-toggle-away signal; + don't update status indicators manually. + (riece-handle-305-message): Ditto. + (riece-handle-306-message): Ditto. + (riece-handle-353-message): Follow the name change of + riece-naming-assert-users. + (riece-handle-324-message): Emit 'riece-channel-toggle-modes + signal; don't update status indicators manually. + (riece-handle-set-topic): Emit 'riece-channel-set-topic signal; + don't update channel indicator manually. + (riece-handle-352-message): Emit 'riece-user-toggle-away, and + 'riece-user-toggle-operator signals; don't update status + indicators manually. + +2004-02-27 Daiki Ueno + + * riece-display.el (riece-connect-signal): Create slot object + internally. + +2004-02-27 Daiki Ueno + + * riece.el (riece): Setup signal slots. + + * riece-unread.el (riece-unread-after-display-message-function): + Don't call riece-redisplay-buffers. + + * riece-naming.el (riece-naming-assert-names): New function. + (riece-naming-assert-join): Emit 'join signal. + (riece-naming-assert-part): Emit 'part signal. + (riece-naming-assert-rename): Emit 'rename signal. + + * riece-message.el (riece-message-buffer): Don't call + riece-redisplay-buffers. + + * riece-handle.el (riece-handle-nick-message): Don't call + riece-redisplay-buffers. + (riece-handle-join-message): Ditto. + (riece-handle-part-message): Ditto. + (riece-handle-kick-message): Ditto. + (riece-handle-kill-message): Ditto. + (riece-handle-topic-message): Ditto. + (riece-parse-channel-modes): Ditto. + + * riece-display.el (riece-update-user-list-buffer): Use + riece-with-server-buffer. + (riece-emit-signal): Notify if signal filter fails. + (riece-display-connect-signals): New function. + (riece-update-user-list-buffer): Don't switch to user-list buffer. + (riece-update-channel-list-buffer): Don't switch to channel-list + buffer. + (riece-switch-to-channel): Emit 'switch-to-channel signal. + (riece-switch-to-nearest-channel): Ditto. + + * riece-commands.el (riece-command-switch-to-channel): Don't call + riece-redisplay-buffers. + (riece-command-join-partner): Ditto. + (riece-command-part): Ditto. + + * riece-300.el (riece-handle-353-message): Save match data before + calling riece-naming-assert-names; don't call riece-redisplay-buffers. + (riece-handle-322-message): Don't call riece-redisplay-buffers. + +2004-02-26 Daiki Ueno + + * riece-display.el: Introduce Qt like "signal-slot" abstraction + for routing display events. + (riece-signal-slot-obarray): New variable. + (riece-make-slot): New function. + (riece-slot-function): New function. + (riece-slot-filter): New function. + (riece-slot-handback): New function. + (riece-make-signal): New function. + (riece-signal-name): New function. + (riece-signal-args): New function. + (riece-connect-signal): New function. + (riece-emit-signal): New function. + 2004-02-19 Daiki Ueno * riece-300.el (riece-handle-353-message): Add 'riece-identity diff --git a/lisp/Makefile.am b/lisp/Makefile.am index b0ced27..108ec38 100644 --- a/lisp/Makefile.am +++ b/lisp/Makefile.am @@ -4,8 +4,8 @@ EXTRA_DIST = COMPILE ChangeLog ChangeLog.Liece \ riece-complete.el riece-display.el riece-emacs.el riece-filter.el \ riece-globals.el riece-handle.el riece-highlight.el riece-identity.el \ riece-message.el riece-misc.el riece-naming.el \ - riece-options.el riece-server.el riece-user.el riece-version.el \ - riece-xemacs.el riece.el \ + riece-options.el riece-server.el riece-signal.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-doctor.el riece-alias.el riece-layout.el riece-skk-kakutei.el \ diff --git a/lisp/riece-300.el b/lisp/riece-300.el index cb22cf8..034e9c0 100644 --- a/lisp/riece-300.el +++ b/lisp/riece-300.el @@ -52,7 +52,13 @@ (if operator (setq status (cons "operator" status))) (riece-user-toggle-away user away) + (riece-emit-signal 'user-away-changed + (riece-make-identity user riece-server-name) + away) (riece-user-toggle-operator user operator) + (riece-emit-signal 'user-operator-changed + (riece-make-identity user riece-server-name) + operator) (riece-insert-info (list riece-dialogue-buffer riece-others-buffer) (concat @@ -65,9 +71,7 @@ t) (riece-strip-user-at-host user-at-host)))) "\n")))) - (setq replies (cdr replies))) - (riece-update-status-indicators) - (force-mode-line-update t))) + (setq replies (cdr replies))))) (defun riece-handle-303-message (prefix number name string) (riece-insert-info @@ -89,6 +93,9 @@ (let ((user (match-string 1 string)) (message (substring string (match-end 0)))) (riece-user-toggle-away user t) + (riece-emit-signal 'user-away-changed + (riece-make-identity user riece-server-name) + t) (riece-insert-info (list riece-dialogue-buffer riece-others-buffer) (concat @@ -98,19 +105,21 @@ (riece-make-identity user riece-server-name) t) message)) - "\n")))) - (riece-update-status-indicators) - (force-mode-line-update t)) + "\n"))))) (defun riece-handle-305-message (prefix number name string) (riece-user-toggle-away riece-real-nickname nil) - (riece-update-status-indicators) - (force-mode-line-update t)) + (riece-emit-signal 'user-away-changed + (riece-make-identity riece-real-nickname + riece-server-name) + nil)) (defun riece-handle-306-message (prefix number name string) (riece-user-toggle-away riece-real-nickname t) - (riece-update-status-indicators) - (force-mode-line-update t)) + (riece-emit-signal 'user-away-changed + (riece-make-identity riece-real-nickname + riece-server-name) + t)) (defun riece-handle-311-message (prefix number name string) (if (string-match @@ -220,7 +229,8 @@ "RPL_NAMREPLY \" :[[@|+] [[@|+] [...]]]\"." (if (string-match "^[=\*@] *\\([^ ]+\\) +:" string) (let ((channel (match-string 1 string)) - (start 0)) + (start 0) + user users) (setq string (substring string (match-end 0))) (while (string-match (concat "\\([@+]\\)?\\(" riece-user-regexp "\\) *") @@ -230,21 +240,15 @@ (riece-make-identity (match-string 2 string) riece-server-name) string) - (setq start (match-end 0)) - (if (match-beginning 1) - (if (eq (aref string (match-beginning 1)) ?@) - (progn - (riece-naming-assert-join - (match-string 2 string) channel) - (riece-channel-toggle-operator - channel (match-string 2 string) t)) - (if (eq (aref string (match-beginning 1)) ?+) - (progn - (riece-naming-assert-join - (match-string 2 string) channel) - (riece-channel-toggle-speaker - channel (match-string 2 string) t)))) - (riece-naming-assert-join (match-string 2 string) channel))) + (setq start (match-end 0) + user (if (match-beginning 1) + (if (eq (aref string (match-beginning 1)) ?@) + (list (match-string 2 string) ?o) + (if (eq (aref string (match-beginning 1)) ?+) + (list (match-string 2 string) ?v))) + (list (match-string 2 string))) + users (cons user users))) + (riece-naming-assert-channel-users (nreverse users) channel) (let* ((channel-identity (riece-make-identity channel riece-server-name)) (buffer (riece-channel-buffer channel-identity))) @@ -258,8 +262,7 @@ (riece-concat-server-name (format "Users on %s: %s" (riece-format-identity channel-identity t) string)) - "\n"))) - (riece-redisplay-buffers)))) + "\n")))))) (defun riece-handle-322-message (prefix number name string) (if (string-match "^\\([^ ]+\\) \\([0-9]+\\) :" string) @@ -293,6 +296,9 @@ (while modes (riece-channel-toggle-mode channel (car modes) (eq toggle ?+)) (setq modes (cdr modes))) + (riece-emit-signal 'channel-modes-changed + (riece-make-identity channel riece-server-name) + modes (eq toggle ?+)) (let* ((channel-identity (riece-make-identity channel riece-server-name)) (buffer (riece-channel-buffer channel-identity))) @@ -307,9 +313,7 @@ (format "Mode for %s: %s" (riece-format-identity channel-identity t) mode-string)) - "\n"))) - (riece-update-channel-indicator) - (force-mode-line-update t)))) + "\n")))))) (defun riece-handle-set-topic (prefix number name string remove) (if (string-match "^\\([^ ]+\\) :" string) @@ -320,19 +324,22 @@ (if remove (riece-channel-set-topic (riece-get-channel channel) nil) (riece-channel-set-topic (riece-get-channel channel) message) - (riece-insert-info buffer (concat "Topic: " message "\n")) - (riece-insert-info - (if (and riece-channel-buffer-mode - (not (eq buffer riece-channel-buffer))) - (list riece-dialogue-buffer riece-others-buffer) - riece-dialogue-buffer) - (concat - (riece-concat-server-name - (format "Topic for %s: %s" - (riece-format-identity channel-identity t) - message)) - "\n")) - (riece-update-channel-indicator))))) + (riece-insert-info buffer (concat "Topic: " message "\n")) + (riece-insert-info + (if (and riece-channel-buffer-mode + (not (eq buffer riece-channel-buffer))) + (list riece-dialogue-buffer riece-others-buffer) + riece-dialogue-buffer) + (concat + (riece-concat-server-name + (format "Topic for %s: %s" + (riece-format-identity channel-identity t) + message)) + "\n"))) + (riece-emit-signal 'channel-topic-changed + channel-identity + (unless remove + message))))) (defun riece-handle-331-message (prefix number name string) (riece-handle-set-topic prefix number name string t)) @@ -396,7 +403,13 @@ (setq status (nreverse status))) (riece-naming-assert-join nick channel) (riece-user-toggle-away user away) + (riece-emit-signal 'user-away-changed + (riece-make-identity user riece-server-name) + away) (riece-user-toggle-operator user operator) + (riece-emit-signal 'user-operator-changed + (riece-make-identity user riece-server-name) + operator) (riece-insert-info buffer (concat (riece-concat-user-status status info) "\n")) @@ -415,8 +428,7 @@ t) " " info))) - "\n")) - (riece-redisplay-buffers)))) + "\n"))))) (defun riece-handle-315-message (prefix number name string)) (defun riece-handle-318-message (prefix number name string)) diff --git a/lisp/riece-commands.el b/lisp/riece-commands.el index 890e2e8..214ac1c 100644 --- a/lisp/riece-commands.el +++ b/lisp/riece-commands.el @@ -38,8 +38,7 @@ (interactive (list (riece-completing-read-identity "Channel/User: " riece-current-channels nil t))) (unless (equal channel riece-current-channel) - (riece-switch-to-channel channel) - (riece-redisplay-buffers))) + (riece-switch-to-channel channel))) (defun riece-command-switch-to-channel-by-number (number) (interactive @@ -303,7 +302,7 @@ the layout to the selected layout-name." ?- ?+) (make-string (length group) ?o) - (mapconcat #'identity group " "))) + (mapconcat #'identity (nreverse group) " "))) (setq group nil))))) (defun riece-command-set-speakers (users &optional arg) @@ -336,7 +335,7 @@ the layout to the selected layout-name." ?- ?+) (make-string (length group) ?v) - (mapconcat #'identity group " "))) + (mapconcat #'identity (nreverse group) " "))) (setq group nil))))) (defun riece-command-send-message (message notice) @@ -416,8 +415,7 @@ the layout to the selected layout-name." (if pointer (riece-command-switch-to-channel (car pointer)) (riece-join-channel target) - (riece-switch-to-channel target) - (riece-redisplay-buffers)))) + (riece-switch-to-channel target)))) (defun riece-command-join (target &optional key) (interactive @@ -476,8 +474,7 @@ the layout to the selected layout-name." (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)) + (riece-part-channel target)) (error "You are not talking with %s" target))) (defun riece-command-change-nickname (nickname) @@ -561,9 +558,9 @@ If prefix argument ARG is non-nil, toggle frozen status." riece-dialogue-buffer) (setq riece-freeze (if arg (< 0 (prefix-numeric-value arg)) - (not riece-freeze)))) - (riece-update-status-indicators) - (force-mode-line-update t)) + (not riece-freeze))) + (riece-emit-signal 'buffer-freeze-changed + (current-buffer) riece-freeze))) (defun riece-command-toggle-own-freeze (&optional arg) "Prevent automatic scrolling of the dialogue window. @@ -579,8 +576,8 @@ If prefix argument ARG is non-nil, toggle frozen status." (not (eq riece-freeze 'own))) (setq riece-freeze 'own) (setq riece-freeze nil))) - (riece-update-status-indicators) - (force-mode-line-update t)) + (riece-emit-signal 'buffer-freeze-changed + (current-buffer) riece-freeze)) (eval-when-compile (autoload 'riece-exit "riece")) diff --git a/lisp/riece-ctcp.el b/lisp/riece-ctcp.el index 8baad1d..37061bc 100644 --- a/lisp/riece-ctcp.el +++ b/lisp/riece-ctcp.el @@ -26,7 +26,6 @@ (require 'riece-version) (require 'riece-misc) -(require 'riece-display) (require 'riece-highlight) (defface riece-ctcp-action-face diff --git a/lisp/riece-display.el b/lisp/riece-display.el index f675e99..c78d9e7 100644 --- a/lisp/riece-display.el +++ b/lisp/riece-display.el @@ -28,6 +28,7 @@ (require 'riece-channel) (require 'riece-misc) (require 'riece-layout) +(require 'riece-signal) (defvar riece-channel-buffer-format "*Channel:%s*" "Format of channel message buffer.") @@ -45,15 +46,183 @@ Local to the buffer in `riece-buffer-list'.") riece-update-channel-list-indicator) "Functions to update modeline indicators.") +(defun riece-display-connect-signals () + (riece-connect-signal + 'channel-list-changed + (lambda (signal handback) + (save-excursion + (set-buffer riece-channel-list-buffer) + (run-hooks 'riece-update-buffer-functions)) + (riece-update-channel-list-indicator))) + (riece-connect-signal + 'user-list-changed + (lambda (signal handback) + (save-excursion + (set-buffer riece-user-list-buffer) + (run-hooks 'riece-update-buffer-functions))) + (lambda (signal) + (and riece-current-channel + (riece-identity-equal (car (riece-signal-args signal)) + riece-current-channel)))) + (riece-connect-signal + 'channel-switched + (lambda (signal handback) + (riece-update-status-indicators) + (riece-update-channel-indicator) + (riece-update-long-channel-indicator) + (force-mode-line-update t) + (riece-emit-signal 'channel-list-changed) + (riece-emit-signal 'user-list-changed riece-current-channel) + (save-excursion + (riece-redraw-layout)))) + (riece-connect-signal + 'user-joined-channel + (lambda (signal handback) + (riece-emit-signal 'user-list-changed riece-current-channel)) + (lambda (signal) + (and riece-current-channel + (riece-identity-equal (nth 1 (riece-signal-args signal)) + riece-current-channel) + (not (riece-identity-equal (car (riece-signal-args signal)) + (riece-current-nickname)))))) + (riece-connect-signal + 'user-joined-channel + (lambda (signal handback) + (riece-join-channel (nth 1 (riece-signal-args signal))) + (riece-switch-to-channel (nth 1 (riece-signal-args signal))) + (setq riece-join-channel-candidate nil)) + (lambda (signal) + (riece-identity-equal (car (riece-signal-args signal)) + (riece-current-nickname)))) + (riece-connect-signal + 'user-left-channel + (lambda (signal handback) + (riece-emit-signal 'user-list-changed riece-current-channel)) + (lambda (signal) + (and riece-current-channel + (riece-identity-equal (nth 1 (riece-signal-args signal)) + riece-current-channel) + (not (riece-identity-equal (car (riece-signal-args signal)) + (riece-current-nickname)))))) + (riece-connect-signal + 'user-left-channel + (lambda (signal handback) + (riece-part-channel (nth 1 (riece-signal-args signal)))) + (lambda (signal) + (riece-identity-equal (car (riece-signal-args signal)) + (riece-current-nickname)))) + (riece-connect-signal + 'user-renamed + (lambda (signal handback) + (riece-emit-signal 'user-list-changed riece-current-channel)) + (lambda (signal) + (and riece-current-channel + (equal (riece-identity-server (nth 1 (riece-signal-args signal))) + (riece-identity-server riece-current-channel)) + (riece-with-server-buffer (riece-identity-server + riece-current-channel) + (riece-identity-assoc + (riece-identity-prefix (nth 1 (riece-signal-args signal))) + (riece-channel-get-users (riece-identity-prefix + riece-current-channel)) + t))))) + (riece-connect-signal + 'user-renamed + (lambda (signal handback) + (riece-update-status-indicators) + (riece-update-channel-indicator) + (force-mode-line-update t)) + (lambda (signal) + (riece-identity-equal (nth 1 (riece-signal-args signal)) + (riece-current-nickname)))) + (riece-connect-signal + 'user-renamed + (lambda (signal handback) + (riece-switch-to-channel (nth 1 (riece-signal-args signal)))) + (lambda (signal) + (and riece-current-channel + (riece-identity-equal (car (riece-signal-args signal)) + riece-current-channel)))) + (riece-connect-signal + 'user-renamed + (lambda (signal handback) + (let* ((old-identity (car (riece-signal-args signal))) + (new-identity (nth 1 (riece-signal-args signal))) + (pointer (riece-identity-member old-identity + riece-current-channels))) + ;; Rename the channel buffer. + (when pointer + (setcar pointer new-identity) + (with-current-buffer (riece-channel-buffer old-identity) + (rename-buffer (riece-channel-buffer-name new-identity) t) + (setq riece-channel-buffer-alist + (cons (cons new-identity (current-buffer)) + (delq (riece-identity-assoc old-identity + riece-channel-buffer-alist) + riece-channel-buffer-alist)))))))) + (riece-connect-signal + 'user-away-changed + (lambda (signal handback) + (riece-update-status-indicators) + (force-mode-line-update t)) + (lambda (signal) + (riece-identity-equal (car (riece-signal-args signal)) + (riece-current-nickname)))) + (riece-connect-signal + 'user-operator-changed + (lambda (signal handback) + (riece-update-status-indicators) + (force-mode-line-update t)) + (lambda (signal) + (riece-identity-equal (car (riece-signal-args signal)) + (riece-current-nickname)))) + (riece-connect-signal + 'channel-topic-changed + (lambda (signal handback) + (riece-update-long-channel-indicator) + (force-mode-line-update t)) + (lambda (signal) + (and riece-current-channel + (riece-identity-equal (car (riece-signal-args signal)) + riece-current-channel)))) + (riece-connect-signal + 'channel-modes-changed + (lambda (signal handback) + (riece-update-status-indicators) + (force-mode-line-update t)) + (lambda (signal) + (and riece-current-channel + (riece-identity-equal (car (riece-signal-args signal)) + riece-current-channel)))) + (riece-connect-signal + 'channel-operators-changed + (lambda (signal handback) + (riece-emit-signal 'user-list-changed riece-current-channel)) + (lambda (signal) + (and riece-current-channel + (riece-identity-equal (car (riece-signal-args signal)) + riece-current-channel)))) + (riece-connect-signal + 'channel-speakers-changed + (lambda (signal handback) + (riece-emit-signal 'user-list-changed riece-current-channel)) + (lambda (signal) + (and riece-current-channel + (riece-identity-equal (car (riece-signal-args signal)) + riece-current-channel)))) + (riece-connect-signal + 'buffer-freeze-changed + (lambda (signal handback) + (riece-update-status-indicators) + (force-mode-line-update t)))) + (defun riece-update-user-list-buffer () (save-excursion - (set-buffer riece-user-list-buffer) (if (and riece-current-channel (riece-channel-p (riece-identity-prefix riece-current-channel))) (let* ((users - (with-current-buffer (process-buffer (riece-server-process - (riece-identity-server - riece-current-channel))) + (riece-with-server-buffer (riece-identity-server + riece-current-channel) (riece-channel-get-users (riece-identity-prefix riece-current-channel)))) (inhibit-read-only t) @@ -74,9 +243,17 @@ Local to the buffer in `riece-buffer-list'.") "\n") (setq users (cdr users))))))) +(defun riece-format-identity-for-channel-list-buffer (index identity) + (or (run-hook-with-args-until-success + 'riece-format-identity-for-channel-list-buffer-functions index identity) + (concat (format "%2d:%c" index + (if (riece-identity-equal identity riece-current-channel) + ?* + ? )) + (riece-format-identity identity)))) + (defun riece-update-channel-list-buffer () (save-excursion - (set-buffer riece-channel-list-buffer) (let ((inhibit-read-only t) buffer-read-only (index 1) @@ -85,21 +262,12 @@ Local to the buffer in `riece-buffer-list'.") (riece-kill-all-overlays) (while channels (if (car channels) - (insert (riece-format-channel-list-line - index (car channels)))) + (insert (riece-format-identity-for-channel-list-buffer + index (car channels)) + "\n")) (setq index (1+ index) channels (cdr channels)))))) -(defun riece-format-channel-list-line (index channel) - (or (run-hook-with-args-until-success - 'riece-format-channel-list-line-functions index channel) - (concat (format "%2d:%c" index - (if (riece-identity-equal channel riece-current-channel) - ?* - ? )) - (riece-format-identity channel) - "\n"))) - (defun riece-update-channel-indicator () (setq riece-channel-indicator (if riece-current-channel @@ -118,24 +286,40 @@ Local to the buffer in `riece-buffer-list'.") (riece-format-identity riece-current-channel)) "None"))) +(defun riece-format-identity-for-channel-list-indicator (index identity) + (or (run-hook-with-args-until-success + 'riece-format-identity-for-channel-list-indicator-functions + index identity) + (let ((string (riece-format-identity identity)) + (start 0)) + ;; Escape % -> %%. + (while (string-match "%" string start) + (setq start (1+ (match-end 0)) + string (replace-match "%%" nil nil string))) + (format "%d:%s" index string)))) + (defun riece-update-channel-list-indicator () (if (and riece-current-channels ;; There is at least one channel. (delq nil (copy-sequence riece-current-channels))) - (let ((index 1)) + (let ((index 1) + pointer) (setq riece-channel-list-indicator - (mapconcat - #'identity - (delq nil - (mapcar - (lambda (channel) - (prog1 - (if channel - (format "%d:%s" index - (riece-format-identity channel))) - (setq index (1+ index)))) - riece-current-channels)) - ","))) + (delq + nil + (mapcar + (lambda (channel) + (prog1 + (if channel + (riece-format-identity-for-channel-list-indicator + index channel)) + (setq index (1+ index)))) + riece-current-channels)) + pointer riece-channel-list-indicator) + (while pointer + (if (cdr pointer) + (setcdr pointer (cons "," (cdr pointer)))) + (setq pointer (cdr (cdr pointer))))) (setq riece-channel-list-indicator "No channel"))) (defun riece-update-status-indicators () @@ -211,7 +395,8 @@ Local to the buffer in `riece-buffer-list'.") (let ((last riece-current-channel)) (setq riece-current-channel identity riece-channel-buffer (riece-channel-buffer riece-current-channel)) - (run-hook-with-args 'riece-after-switch-to-channel-functions last))) + (run-hook-with-args 'riece-after-switch-to-channel-functions last) + (riece-emit-signal 'channel-switched))) (defun riece-join-channel (identity) (unless (riece-identity-member identity riece-current-channels) @@ -241,7 +426,8 @@ Local to the buffer in `riece-buffer-list'.") (riece-switch-to-channel identity) (let ((last riece-current-channel)) (run-hook-with-args 'riece-after-switch-to-channel-functions last) - (setq riece-current-channel nil))))) + (setq riece-current-channel nil) + (riece-emit-signal 'channel-switched))))) (defun riece-part-channel (identity) (let ((pointer (riece-identity-member identity riece-current-channels))) diff --git a/lisp/riece-emacs.el b/lisp/riece-emacs.el index 0e49815..ea6be0a 100644 --- a/lisp/riece-emacs.el +++ b/lisp/riece-emacs.el @@ -91,6 +91,10 @@ (defalias 'riece-match-string-no-properties 'match-string-no-properties) +(defun riece-propertize-modeline-string (string &rest properties) + (add-text-properties string properties) + string) + (provide 'riece-emacs) ;;; riece-emacs.el ends here diff --git a/lisp/riece-filter.el b/lisp/riece-filter.el index f522c48..f888921 100644 --- a/lisp/riece-filter.el +++ b/lisp/riece-filter.el @@ -28,7 +28,6 @@ (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)) diff --git a/lisp/riece-handle.el b/lisp/riece-handle.el index edb916d..e83fbe5 100644 --- a/lisp/riece-handle.el +++ b/lisp/riece-handle.el @@ -28,7 +28,7 @@ (require 'riece-message) (require 'riece-channel) (require 'riece-naming) -(require 'riece-display) +(require 'riece-signal) (defun riece-handle-nick-message (prefix string) (let* ((old (riece-prefix-nickname prefix)) @@ -60,8 +60,7 @@ (format "%s -> %s" (riece-format-identity old-identity t) (riece-format-identity new-identity t))) - "\n")) - (riece-redisplay-buffers))) + "\n")))) (defun riece-handle-privmsg-message (prefix string) (let* ((user (riece-prefix-nickname prefix)) @@ -135,8 +134,7 @@ (riece-user-get-user-at-host user) (riece-format-identity channel-identity t))) "\n"))) - (setq channels (cdr channels))) - (riece-redisplay-buffers))) + (setq channels (cdr channels))))) (defun riece-handle-part-message (prefix string) (let* ((user (riece-prefix-nickname prefix)) @@ -173,8 +171,7 @@ (riece-format-identity channel-identity t)) message)) "\n"))) - (setq channels (cdr channels))) - (riece-redisplay-buffers))) + (setq channels (cdr channels))))) (defun riece-handle-kick-message (prefix string) (let* ((kicker (riece-prefix-nickname prefix)) @@ -210,8 +207,7 @@ (riece-format-identity user-identity t) (riece-format-identity channel-identity t)) message)) - "\n"))) - (riece-redisplay-buffers))) + "\n"))))) (defun riece-handle-quit-message (prefix string) (let* ((user (riece-prefix-nickname prefix)) @@ -252,8 +248,7 @@ (format "%s has left IRC" (riece-format-identity user-identity t)) message)) - "\n")))) - (riece-redisplay-buffers)) + "\n"))))) (defun riece-handle-kill-message (prefix string) (let* ((killer (riece-prefix-nickname prefix)) @@ -298,8 +293,7 @@ (riece-format-identity killer-identity t) (riece-format-identity user-identity t)) message)) - "\n"))) - (riece-redisplay-buffers))) + "\n"))))) (defun riece-handle-invite-message (prefix string) (let* ((user (riece-prefix-nickname prefix)) @@ -329,6 +323,8 @@ (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) + (riece-emit-signal 'channel-topic-changed + channel-identity topic) (let ((buffer (riece-channel-buffer channel-identity))) (riece-insert-change buffer @@ -346,47 +342,79 @@ (riece-format-identity channel-identity t) (riece-format-identity user-identity t) topic)) - "\n")) - (riece-redisplay-buffers)))) + "\n"))))) -(defsubst riece-parse-channel-modes (string channel) - (while (string-match "^[-+]\\([^ ]*\\) *" string) - (let ((toggle (aref string 0)) - (modes (string-to-list (match-string 1 string)))) - (setq string (substring string (match-end 0))) - (while modes - (if (and (memq (car modes) '(?O ?o ?v ?k ?l ?b ?e ?I)) - (string-match "\\([^-+][^ ]*\\) *" string)) - (let ((parameter (match-string 1 string))) - (setq string (substring string (match-end 0))) - (cond - ((eq (car modes) ?o) - (riece-channel-toggle-operator channel parameter - (eq toggle ?+))) - ((eq (car modes) ?v) - (riece-channel-toggle-speaker channel parameter - (eq toggle ?+))) - ((eq (car modes) ?b) - (riece-channel-toggle-banned channel parameter - (eq toggle ?+))) - ((eq (car modes) ?e) - (riece-channel-toggle-uninvited channel parameter - (eq toggle ?+))) - ((eq (car modes) ?I) - (riece-channel-toggle-invited channel parameter - (eq toggle ?+))))) - (riece-channel-toggle-mode channel (car modes) - (eq toggle ?+))) - (setq modes (cdr modes)))))) +(defun riece-parse-modes (string) + (let ((start 0) + result) + (while (and (string-match "[-+]\\([^ ]*\\) *" string start) + (= (match-beginning 0) start)) + (let ((toggle (eq (aref string 0) ?+)) + (modes (string-to-list (match-string 1 string)))) + (setq start (match-end 0)) + (while modes + (if (and (string-match "\\([^-+][^ ]*\\) *" string start) + (= (match-beginning 0) start)) + (setq start (match-end 0) + result (cons (list (car modes) toggle + (match-string 1 string)) + result)) + (setq result (cons (list (car modes) toggle) + result))) + (setq modes (cdr modes))))) + (nreverse result))) + +(defun riece-handle-channel-modes (channel modes) + (while modes + (cond + ((eq (car (car modes)) ?o) + (riece-channel-toggle-operator channel + (nth 2 (car modes)) + (nth 1 (car modes))) + (riece-emit-signal 'channel-operators-changed + (riece-make-identity channel + riece-server-name) + (riece-make-identity (nth 2 (car modes)) + riece-server-name) + (nth 1 (car modes)))) + ((eq (car (car modes)) ?v) + (riece-channel-toggle-speaker channel + (nth 2 (car modes)) + (nth 1 (car modes))) + (riece-emit-signal 'channel-speakers-changed + (riece-make-identity channel + riece-server-name) + (riece-make-identity (nth 2 (car modes)) + riece-server-name) + (nth 1 (car modes)))) + ((eq (car (car modes)) ?b) + (riece-channel-toggle-banned channel + (nth 2 (car modes)) + (nth 1 (car modes)))) + ((eq (car (car modes)) ?e) + (riece-channel-toggle-uninvited channel + (nth 2 (car modes)) + (nth 1 (car modes)))) + ((eq (car (car modes)) ?I) + (riece-channel-toggle-invited channel + (nth 2 (car modes)) + (nth 1 (car modes)))) + (t + (apply #'riece-channel-toggle-mode channel (car modes)))) + (setq modes (cdr modes))) + (riece-emit-signal 'channel-modes-changed + (riece-make-identity channel + riece-server-name))) (defun riece-handle-mode-message (prefix string) (let* ((user (riece-prefix-nickname prefix)) (user-identity (riece-make-identity user riece-server-name)) channel) - (when (string-match "\\([^ ]+\\) *:?" string) + (when (string-match "^\\([^ ]+\\) *:?" string) (setq channel (match-string 1 string) string (substring string (match-end 0))) - (riece-parse-channel-modes string channel) + (if (string-match (concat "^" riece-channel-regexp "$") channel) + (riece-handle-channel-modes channel (riece-parse-modes string))) (let* ((channel-identity (riece-make-identity channel riece-server-name)) (buffer (riece-channel-buffer channel-identity))) (riece-insert-change @@ -405,8 +433,7 @@ (riece-format-identity channel-identity t) (riece-format-identity user-identity t) string)) - "\n")) - (riece-redisplay-buffers))))) + "\n")))))) (provide 'riece-handle) diff --git a/lisp/riece-highlight.el b/lisp/riece-highlight.el index 8eefc61..4803efb 100644 --- a/lisp/riece-highlight.el +++ b/lisp/riece-highlight.el @@ -233,6 +233,20 @@ (setq font-lock-mode-hook nil) (turn-on-font-lock)) +(defun riece-highlight-format-identity-for-channel-list-indicator (index + identity) + (if (riece-identity-equal identity riece-current-channel) + (let ((string (riece-format-identity identity)) + (start 0) + extent) + ;; Escape % -> %%. + (while (string-match "%" string start) + (setq start (1+ (match-end 0)) + string (replace-match "%%" nil nil string))) + (list (format "%d:" index) + (riece-propertize-modeline-string + string 'face 'riece-channel-list-current-face))))) + (defun riece-highlight-insinuate () (put 'riece-channel-mode 'font-lock-defaults '(riece-dialogue-font-lock-keywords t)) @@ -245,7 +259,9 @@ (put 'riece-channel-list-mode 'font-lock-defaults '(riece-channel-list-font-lock-keywords t)) (add-hook 'riece-after-load-startup-hook - 'riece-channel-list-schedule-turn-on-font-lock)) + 'riece-channel-list-schedule-turn-on-font-lock) + (add-hook 'riece-format-identity-for-channel-list-indicator-functions + 'riece-highlight-format-identity-for-channel-list-indicator)) (provide 'riece-highlight) diff --git a/lisp/riece-history.el b/lisp/riece-history.el index aece829..6541feb 100644 --- a/lisp/riece-history.el +++ b/lisp/riece-history.el @@ -72,12 +72,26 @@ index (1+ index))) (nreverse result))) -(defun riece-history-format-channel-list-line (index channel) +(defun riece-history-format-identity-for-channel-list-buffer (index identity) (if (and (not (ring-empty-p riece-channel-history)) - (riece-identity-equal channel (ring-ref riece-channel-history 0))) + (riece-identity-equal identity (ring-ref riece-channel-history 0))) (concat (format "%2d:+" index) - (riece-format-identity channel) - "\n"))) + (riece-format-identity identity)))) + +(defun riece-history-format-identity-for-channel-list-indicator (index + identity) + (if (and (not (ring-empty-p riece-channel-history)) + (riece-identity-equal identity (ring-ref riece-channel-history 0))) + (let ((string (riece-format-identity identity)) + (start 0) + extent) + ;; Escape % -> %%. + (while (string-match "%" string start) + (setq start (1+ (match-end 0)) + string (replace-match "%%" nil nil string))) + (list (format "%d:" index) + (riece-propertize-modeline-string + string 'face 'riece-channel-list-history-face))))) ;;; (defun riece-history-requires () ;;; (if (memq 'riece-guess riece-addons) @@ -96,8 +110,10 @@ (if (and last (not (riece-identity-equal last riece-current-channel))) (ring-insert riece-channel-history last)))) - (add-hook 'riece-format-channel-list-line-functions - 'riece-history-format-channel-list-line) + (add-hook 'riece-format-identity-for-channel-list-buffer-functions + 'riece-history-format-identity-for-channel-list-buffer) + (add-hook 'riece-format-identity-for-channel-list-indicator-functions + 'riece-history-format-identity-for-channel-list-indicator) (if (memq 'riece-highlight riece-addons) (setq riece-channel-list-mark-face-alist (cons '(?+ . riece-channel-list-history-face) diff --git a/lisp/riece-message.el b/lisp/riece-message.el index c50aa1d..8db0334 100644 --- a/lisp/riece-message.el +++ b/lisp/riece-message.el @@ -117,8 +117,7 @@ ;; If you are not joined any channel, ;; switch to the target immediately. (unless riece-current-channel - (riece-switch-to-channel target)) - (riece-redisplay-buffers)) + (riece-switch-to-channel target))) (riece-channel-buffer target))) (defun riece-message-parent-buffers (message buffer) @@ -160,7 +159,7 @@ Normally they are *Dialogue* and/or *Others*." (riece-own-frozen buffer)) (with-current-buffer buffer (setq riece-freeze nil)) - (riece-update-status-indicators)) + (riece-emit-signal 'buffer-freeze-changed buffer nil)) (setq parent-buffers (riece-message-parent-buffers message buffer)) (riece-insert buffer (concat open-bracket name close-bracket diff --git a/lisp/riece-naming.el b/lisp/riece-naming.el index 7ffedac..97beb25 100644 --- a/lisp/riece-naming.el +++ b/lisp/riece-naming.el @@ -27,26 +27,27 @@ (require 'riece-globals) (require 'riece-channel) (require 'riece-user) -(require 'riece-display) +(require 'riece-signal) (defun riece-naming-assert-join (user-name channel-name) (riece-user-toggle-channel user-name channel-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) - (setq riece-join-channel-candidate nil)))) + (riece-emit-signal 'user-joined-channel + (riece-make-identity user-name + riece-server-name) + (riece-make-identity channel-name + riece-server-name))) (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) - (riece-part-channel (riece-make-identity channel-name - riece-server-name)))) + (riece-emit-signal 'user-left-channel + (riece-make-identity user-name + riece-server-name) + (riece-make-identity channel-name + riece-server-name))) (defun riece-naming-assert-rename (old-name new-name) (if (riece-identity-equal-no-server old-name riece-real-nickname) @@ -62,21 +63,31 @@ (setcar user new-name)) (setq channels (cdr channels))) (riece-rename-user old-name new-name)) - ;; Rename the channel buffer. - (let* ((old-identity (riece-make-identity old-name riece-server-name)) - (new-identity (riece-make-identity new-name riece-server-name)) - (pointer (riece-identity-member old-identity riece-current-channels))) - (when pointer - (setcar pointer new-identity) - (with-current-buffer (riece-channel-buffer old-identity) - (rename-buffer (riece-channel-buffer-name new-identity) t) - (setq riece-channel-buffer-alist - (cons (cons new-identity (current-buffer)) - (delq (riece-identity-assoc old-identity - riece-channel-buffer-alist) - riece-channel-buffer-alist)))) - (if (riece-identity-equal old-identity riece-current-channel) - (riece-switch-to-channel new-identity))))) + (riece-emit-signal 'user-renamed + (riece-make-identity old-name riece-server-name) + (riece-make-identity new-name riece-server-name))) + +(defun riece-naming-assert-channel-users (users channel-name) + (let ((channel-identity (riece-make-identity channel-name + riece-server-name)) + user-identity-list) + (while users + (riece-user-toggle-channel (car (car users)) channel-name t) + (riece-channel-toggle-user channel-name (car (car users)) t) + (if (memq ?o (cdr (car users))) + (riece-channel-toggle-operator channel-name (car (car users)) t) + (if (memq ?v (cdr (car users))) + (riece-channel-toggle-speaker channel-name (car (car users)) t) + (riece-channel-toggle-operator channel-name (car (car users)) nil) + (riece-channel-toggle-speaker channel-name (car (car users)) nil))) + (setq user-identity-list + (cons (cons (riece-make-identity (car (car users)) + riece-server-name) + (cdr (car users))) + user-identity-list) + users (cdr users))) + (riece-emit-signal 'user-list-changed + (riece-make-identity channel-name riece-server-name)))) (provide 'riece-naming) diff --git a/lisp/riece-ndcc.el b/lisp/riece-ndcc.el index 0466040..10efdc4 100644 --- a/lisp/riece-ndcc.el +++ b/lisp/riece-ndcc.el @@ -25,7 +25,6 @@ (require 'riece-globals) (require 'riece-options) -(require 'riece-display) (require 'calc) diff --git a/lisp/riece-signal.el b/lisp/riece-signal.el new file mode 100644 index 0000000..7fedd2f --- /dev/null +++ b/lisp/riece-signal.el @@ -0,0 +1,109 @@ +;;; riece-signal.el --- "signal-slot" abstraction for routing display events +;; Copyright (C) 1998-2003 Daiki Ueno + +;; Author: Daiki Ueno +;; Created: 1998-09-28 +;; Keywords: IRC, riece + +;; This file is part of Riece. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; This module implements Qt like "signal-slot" abstraction for +;;; routing display events. + +;;; Code: + +(defvar riece-signal-slot-obarray + (make-vector 31 0)) + +(defun riece-make-slot (function &optional filter handback) + "Make an instance of slot object. +Arguments are corresponding to callback function, filter function, and +a handback object, respectively. +This function is for internal use only." + (vector function filter handback)) + +(defun riece-slot-function (slot) + "Return the callback function of SLOT. +This function is for internal use only." + (aref slot 0)) + +(defun riece-slot-filter (slot) + "Return the filter function of SLOT. +This function is for internal use only." + (aref slot 1)) + +(defun riece-slot-handback (slot) + "Return the handback object of SLOT. +This function is for internal use only." + (aref slot 2)) + +(defun riece-make-signal (name args) + "Make an instance of signal object. +The 1st arguments is the name of the signal and the rest of arguments +are the data of the signal. +This function is for internal use only." + (vector name args)) + +(defun riece-signal-name (signal) + "Return the name of SIGNAL." + (aref signal 0)) + +(defun riece-signal-args (signal) + "Return the data of SIGNAL." + (aref signal 1)) + +(defun riece-connect-signal (signal-name function &optional filter handback) + "Add SLOT as a listener of a signal identified by SIGNAL-NAME." + (let ((symbol (intern (symbol-name signal-name) riece-signal-slot-obarray))) + (set symbol (cons (riece-make-slot function filter handback) + (if (boundp symbol) + (symbol-value symbol)))))) + +(defun riece-emit-signal (signal-name &rest args) + "Emit SIGNAL." + (let ((symbol (intern-soft (symbol-name signal-name) + riece-signal-slot-obarray)) + signal + slots) + (when symbol + (setq signal (riece-make-signal signal-name args) + slots (symbol-value symbol)) + (while slots + (condition-case error + (if (or (null (riece-slot-filter (car slots))) + (condition-case error + (funcall (riece-slot-filter (car slots)) signal) + (error + (if riece-debug + (message + "Error occurred in signal filter for \"%S\": %S" + signal-name error))) + nil)) + (funcall (riece-slot-function (car slots)) + signal (riece-slot-handback (car slots)))) + (error + (if riece-debug + (message "Error occurred in slot function for \"%S\": %S" + signal-name error)))) + (setq slots (cdr slots)))))) + +(provide 'riece-signal) + +;;; riece-signal.el ends here diff --git a/lisp/riece-unread.el b/lisp/riece-unread.el index 1356385..b2b2a28 100644 --- a/lisp/riece-unread.el +++ b/lisp/riece-unread.el @@ -35,6 +35,7 @@ (require 'riece-message) (require 'riece-commands) +(require 'riece-signal) (eval-when-compile (require 'riece-highlight)) @@ -68,18 +69,30 @@ riece-unread-channels)) (setq riece-unread-channels (cons (riece-message-target message) riece-unread-channels)) - (riece-redisplay-buffers))) + (riece-emit-signal 'channel-list-changed))) (defun riece-unread-after-switch-to-channel-function (last) (setq riece-unread-channels (delete riece-current-channel riece-unread-channels))) -(defun riece-unread-format-channel-list-line (index channel) - (if (riece-identity-member channel riece-unread-channels) +(defun riece-unread-format-identity-for-channel-list-buffer (index identity) + (if (riece-identity-member identity riece-unread-channels) (concat (format "%2d:!" index) - (riece-format-identity channel) - "\n"))) + (riece-format-identity identity)))) + +(defun riece-unread-format-identity-for-channel-list-indicator (index identity) + (if (riece-identity-member identity riece-unread-channels) + (let ((string (riece-format-identity identity)) + (start 0) + extent) + ;; Escape % -> %%. + (while (string-match "%" string start) + (setq start (1+ (match-end 0)) + string (replace-match "%%" nil nil string))) + (list (format "%d:" index) + (riece-propertize-modeline-string + string 'face 'riece-channel-list-unread-face))))) (defun riece-unread-switch-to-channel () (interactive) @@ -112,8 +125,10 @@ 'riece-unread-after-display-message-function) (add-hook 'riece-after-switch-to-channel-functions 'riece-unread-after-switch-to-channel-function) - (add-hook 'riece-format-channel-list-line-functions - 'riece-unread-format-channel-list-line) + (add-hook 'riece-format-identity-for-channel-list-buffer-functions + 'riece-unread-format-identity-for-channel-list-buffer) + (add-hook 'riece-format-identity-for-channel-list-indicator-functions + 'riece-unread-format-identity-for-channel-list-indicator) (define-key riece-command-mode-map "\C-c\C-u" 'riece-unread-switch-to-channel) (define-key riece-dialogue-mode-map diff --git a/lisp/riece-xemacs.el b/lisp/riece-xemacs.el index b1d7349..119cabe 100644 --- a/lisp/riece-xemacs.el +++ b/lisp/riece-xemacs.el @@ -117,6 +117,11 @@ (defun riece-match-string-no-properties (number &optional string) (format "%s" (match-string number string))) +(defun riece-propertize-modeline-string (string &rest properties) + (let ((extent (make-extent nil nil))) + (set-extent-properties extent properties) + (cons extent string))) + (provide 'riece-xemacs) ;;; riece-xemacs.el ends here diff --git a/lisp/riece-xface.el b/lisp/riece-xface.el index 8663214..dbb8a27 100644 --- a/lisp/riece-xface.el +++ b/lisp/riece-xface.el @@ -37,32 +37,33 @@ (defvar lsdb-insert-x-face-function) (defun riece-xface-update-user-list-buffer () - (save-excursion - (set-buffer riece-user-list-buffer) - (riece-scan-property-region - 'riece-identity (point-min)(point-max) - (lambda (start end) - (let ((records (riece-lsdb-lookup-records (get-text-property - start 'riece-identity))) - xface) - (while (and records - (null xface)) - (setq xface (nth 1 (assq 'x-face (car records))) - records (cdr records))) - (if (and xface - (not (eq (char-after end) ? ))) - (let ((inhibit-read-only t) - buffer-read-only) - (goto-char end) - (insert " ") - (funcall lsdb-insert-x-face-function xface)))))))) + (riece-scan-property-region + 'riece-identity (point-min)(point-max) + (lambda (start end) + (let ((records (riece-lsdb-lookup-records (get-text-property + start 'riece-identity))) + xface) + (while (and records + (null xface)) + (setq xface (nth 1 (assq 'x-face (car records))) + records (cdr records))) + (if (and xface + (not (eq (char-after end) ? ))) + (let ((inhibit-read-only t) + buffer-read-only) + (goto-char end) + (insert " ") + (funcall lsdb-insert-x-face-function xface))))))) (defun riece-xface-requires () '(riece-lsdb)) (defun riece-xface-insinuate () - (add-hook 'riece-update-buffer-functions - 'riece-xface-update-user-list-buffer t)) + (add-hook 'riece-startup-hook + (lambda () + (with-current-buffer riece-user-list-buffer + (add-hook 'riece-update-buffer-functions + 'riece-xface-update-user-list-buffer t))))) (provide 'riece-xface) diff --git a/lisp/riece.el b/lisp/riece.el index 997db0a..a8e101c 100644 --- a/lisp/riece.el +++ b/lisp/riece.el @@ -284,6 +284,7 @@ If optional argument CONFIRM is non-nil, ask which IRC server to connect." (riece-shrink-buffer (car buffers))) (setq buffers (cdr buffers)))))))) (switch-to-buffer riece-command-buffer) + (riece-display-connect-signals) (riece-redisplay-buffers) (riece-open-server riece-server "") (let ((server-list riece-startup-server-list)) -- 2.25.1