From: ueno Date: Fri, 27 Feb 2004 03:36:56 +0000 (+0000) Subject: * riece.el (riece): Setup signal slots. X-Git-Tag: signal-slot-mergepoint~20 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=40a04aa891bb0401c3193dd1b09ac57f3fb22c82;p=elisp%2Friece.git * 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. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d7cb0c7..4c44e75 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,46 @@ +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 diff --git a/lisp/riece-300.el b/lisp/riece-300.el index cb22cf8..bf1f52f 100644 --- a/lisp/riece-300.el +++ b/lisp/riece-300.el @@ -220,7 +220,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 +231,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-names (nreverse users) channel) (let* ((channel-identity (riece-make-identity channel riece-server-name)) (buffer (riece-channel-buffer channel-identity))) @@ -258,8 +253,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) @@ -415,8 +409,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..3b3561d 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 @@ -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) diff --git a/lisp/riece-display.el b/lisp/riece-display.el index c137681..77759ca 100644 --- a/lisp/riece-display.el +++ b/lisp/riece-display.el @@ -97,24 +97,102 @@ are the data of the signal." (while slots (condition-case error (if (or (null (riece-slot-filter (car slots))) - (funcall (riece-slot-filter (car slots)) signal)) + (condition-case error + (funcall (riece-slot-filter (car slots)) signal) + (if riece-debug + (message + "Error occurred in signal filter for \"%S\": %S" + (riece-signal-name signal) 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 signal \"%S\": %S" + (message "Error occurred in slot function for \"%S\": %S" (riece-signal-name signal) error)))) (setq slots (cdr slots)))))) +(defun riece-display-connect-signals () + (riece-connect-signal + 'switch-to-channel + (riece-make-slot + (lambda (signal handback) + (riece-update-status-indicators) + (riece-update-channel-indicator) + (riece-update-long-channel-indicator) + (save-excursion + (set-buffer riece-user-list-buffer) + (run-hooks 'riece-update-buffer-functions)) + (save-excursion + (set-buffer riece-channel-list-buffer) + (run-hooks 'riece-update-buffer-functions)) + (save-excursion + (riece-redraw-layout))))) + (riece-connect-signal + 'names + (riece-make-slot + (lambda (signal handback) + (save-excursion + (set-buffer riece-user-list-buffer) + (run-hooks 'riece-update-buffer-functions))))) + (riece-connect-signal + 'join + (riece-make-slot + (lambda (signal handback) + (save-excursion + (set-buffer riece-user-list-buffer) + (run-hooks 'riece-update-buffer-functions))) + (lambda (signal) + (and (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 + 'part + (riece-make-slot + (lambda (signal handback) + (save-excursion + (set-buffer riece-user-list-buffer) + (run-hooks 'riece-update-buffer-functions))) + (lambda (signal) + (and (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 + 'rename + (riece-make-slot + (lambda (signal handback) + (save-excursion + (set-buffer riece-user-list-buffer) + (run-hooks 'riece-update-buffer-functions))) + (lambda (signal) + (and (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 + 'rename + (riece-make-slot + (lambda (signal handback) + (riece-update-status-indicators) + (riece-update-channel-indicator)) + (lambda (signal) + (riece-identity-equal (nth 1 (riece-signal-args signal)) + (riece-current-nickname)))))) + (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) @@ -137,7 +215,6 @@ are the data of the signal." (defun riece-update-channel-list-buffer () (save-excursion - (set-buffer riece-channel-list-buffer) (let ((inhibit-read-only t) buffer-read-only (index 1) @@ -272,7 +349,8 @@ are the data of the signal." (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 (riece-make-signal 'switch-to-channel)))) (defun riece-join-channel (identity) (unless (riece-identity-member identity riece-current-channels) @@ -302,7 +380,8 @@ are the data of the signal." (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 (riece-make-signal 'switch-to-channel)))))) (defun riece-part-channel (identity) (let ((pointer (riece-identity-member identity riece-current-channels))) diff --git a/lisp/riece-handle.el b/lisp/riece-handle.el index edb916d..8d835cc 100644 --- a/lisp/riece-handle.el +++ b/lisp/riece-handle.el @@ -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)) @@ -346,8 +340,7 @@ (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) @@ -405,8 +398,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-message.el b/lisp/riece-message.el index c50aa1d..4105e77 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) diff --git a/lisp/riece-naming.el b/lisp/riece-naming.el index 7ffedac..e35e107 100644 --- a/lisp/riece-naming.el +++ b/lisp/riece-naming.el @@ -32,21 +32,32 @@ (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)))) + (let ((user-identity (riece-make-identity user-name + riece-server-name)) + (channel-identity (riece-make-identity channel-name + riece-server-name))) + (when (riece-identity-equal-no-server user-name riece-real-nickname) + (riece-join-channel channel-identity) + (riece-switch-to-channel channel-identity) + (setq riece-join-channel-candidate nil)) + (riece-emit-signal (riece-make-signal 'join + user-identity + channel-identity)))) (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)))) + (let ((user-identity (riece-make-identity user-name + riece-server-name)) + (channel-identity (riece-make-identity channel-name + riece-server-name))) + (if (riece-identity-equal-no-server user-name riece-real-nickname) + (riece-part-channel channel-identity)) + (riece-emit-signal (riece-make-signal 'part + user-identity + channel-identity)))) (defun riece-naming-assert-rename (old-name new-name) (if (riece-identity-equal-no-server old-name riece-real-nickname) @@ -76,7 +87,37 @@ riece-channel-buffer-alist) riece-channel-buffer-alist)))) (if (riece-identity-equal old-identity riece-current-channel) - (riece-switch-to-channel new-identity))))) + (riece-switch-to-channel new-identity))) + (riece-emit-signal (riece-make-signal 'rename old-identity new-identity)))) + +(defun riece-naming-assert-names (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))) + (setq user-identity-list + (cons (riece-make-identity (car (car users)) + riece-server-name) + user-identity-list)) + (when (riece-identity-equal-no-server (car (car users)) + riece-real-nickname) + (riece-join-channel channel-identity) + (riece-switch-to-channel channel-identity) + (setq riece-join-channel-candidate nil)) + (setq users (cdr users))) + (riece-emit-signal (riece-make-signal 'names + (nreverse user-identity-list) + channel-identity)))) (provide 'riece-naming) diff --git a/lisp/riece-unread.el b/lisp/riece-unread.el index 1356385..a460662 100644 --- a/lisp/riece-unread.el +++ b/lisp/riece-unread.el @@ -67,8 +67,7 @@ (riece-identity-member (riece-message-target message) riece-unread-channels)) (setq riece-unread-channels - (cons (riece-message-target message) riece-unread-channels)) - (riece-redisplay-buffers))) + (cons (riece-message-target message) riece-unread-channels)))) (defun riece-unread-after-switch-to-channel-function (last) (setq riece-unread-channels 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))