'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.
riece-user
riece-misc
+ riece-signal
+
;; riece-layout ---> riece-display
riece-layout
riece-display
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 \
(require 'riece-version)
(require 'riece-misc)
-(require 'riece-display)
(require 'riece-highlight)
(defface riece-ctcp-action-face
(require 'riece-channel)
(require 'riece-misc)
(require 'riece-layout)
+(require 'riece-signal)
(defvar riece-channel-buffer-format "*Channel:%s*"
"Format of channel message buffer.")
riece-update-channel-list-indicator)
"Functions to update modeline indicators.")
-;;; Qt like "signal-slot" abstraction for routing display events.
-(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))))))
-
(defun riece-display-connect-signals ()
(riece-connect-signal
+ 'riece-update-buffer
+ (lambda (signal handback)
+ (save-excursion
+ (set-buffer (car (riece-signal-args signal)))
+ (run-hooks 'riece-update-buffer-functions))))
+ (riece-connect-signal
'riece-switch-to-channel
(lambda (signal handback)
(riece-update-status-indicators)
(riece-update-channel-indicator)
(riece-update-long-channel-indicator)
+ (riece-update-channel-list-indicator)
(force-mode-line-update t)
- (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))
+ (riece-emit-signal 'riece-update-buffer riece-user-list-buffer)
+ (riece-emit-signal 'riece-update-buffer riece-channel-list-buffer)
(save-excursion
(riece-redraw-layout))))
(riece-connect-signal
'riece-naming-assert-channel-users
(lambda (signal handback)
- (save-excursion
- (set-buffer riece-user-list-buffer)
- (run-hooks 'riece-update-buffer-functions))))
+ (riece-emit-signal 'riece-update-buffer riece-user-list-buffer)))
(riece-connect-signal
'riece-naming-assert-join
(lambda (signal handback)
- (save-excursion
- (set-buffer riece-user-list-buffer)
- (run-hooks 'riece-update-buffer-functions)))
+ (riece-emit-signal 'riece-update-buffer riece-user-list-buffer))
(lambda (signal)
(and riece-current-channel
(riece-identity-equal (nth 1 (riece-signal-args signal))
(riece-connect-signal
'riece-naming-assert-part
(lambda (signal handback)
- (save-excursion
- (set-buffer riece-user-list-buffer)
- (run-hooks 'riece-update-buffer-functions)))
+ (riece-emit-signal 'riece-update-buffer riece-user-list-buffer))
(lambda (signal)
(and riece-current-channel
(riece-identity-equal (nth 1 (riece-signal-args signal))
(riece-connect-signal
'riece-naming-assert-rename
(lambda (signal handback)
- (save-excursion
- (set-buffer riece-user-list-buffer)
- (run-hooks 'riece-update-buffer-functions)))
+ (riece-emit-signal 'riece-update-buffer riece-user-list-buffer))
(lambda (signal)
(and riece-current-channel
(equal (riece-identity-server (nth 1 (riece-signal-args signal)))
(riece-identity-equal (car (riece-signal-args signal))
riece-current-channel))))
(riece-connect-signal
+ 'riece-naming-assert-rename
+ (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
'riece-user-toggle-away
(lambda (signal handback)
(riece-update-status-indicators)
(riece-identity-equal (car (riece-signal-args signal))
riece-current-channel))))
(riece-connect-signal
- 'riece-channel-toggle-modes
+ 'riece-channel-set-modes
(lambda (signal handback)
(riece-update-status-indicators)
(force-mode-line-update t))
(riece-connect-signal
'riece-channel-toggle-operator
(lambda (signal handback)
- (save-excursion
- (set-buffer riece-user-list-buffer)
- (run-hooks 'riece-update-buffer-functions)))
+ (riece-emit-signal 'riece-update-buffer riece-user-list-buffer))
(lambda (signal)
(and riece-current-channel
(riece-identity-equal (car (riece-signal-args signal))
(riece-connect-signal
'riece-channel-toggle-speaker
(lambda (signal handback)
- (save-excursion
- (set-buffer riece-user-list-buffer)
- (run-hooks 'riece-update-buffer-functions)))
+ (riece-emit-signal 'riece-update-buffer riece-user-list-buffer))
(lambda (signal)
(and riece-current-channel
(riece-identity-equal (car (riece-signal-args signal))
(riece-kill-all-overlays)
(while channels
(if (car channels)
- (insert (riece-format-channel-list-line
- index (car channels))))
+ (insert (riece-format-channel-list-line index (car channels))
+ "\n"))
(setq index (1+ index)
channels (cdr channels))))))
(if (riece-identity-equal channel riece-current-channel)
?*
? ))
- (riece-format-identity channel)
- "\n")))
+ (riece-format-identity channel))))
(defun riece-update-channel-indicator ()
(setq riece-channel-indicator
(lambda (channel)
(prog1
(if channel
- (format "%d:%s" index
- (riece-format-identity channel)))
+ (riece-format-channel-list-line index channel))
(setq index (1+ index))))
riece-current-channels))
",")))
(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))
(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))
topic))
"\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 ?+))
- (riece-emit-signal 'riece-channel-toggle-operator
- (riece-make-identity channel
- riece-server-name)
- (riece-make-identity parameter
- riece-server-name)
- (eq toggle ?+)))
- ((eq (car modes) ?v)
- (riece-channel-toggle-speaker channel parameter
- (eq toggle ?+))
- (riece-emit-signal 'riece-channel-toggle-speaker
- (riece-make-identity channel
- riece-server-name)
- (riece-make-identity parameter
- riece-server-name)
- (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)))
- (riece-emit-signal 'riece-channel-toggle-modes
+(defun riece-parse-modes (string)
+ (let (result)
+ (while (string-match "^[-+]\\([^ ]*\\) *" string)
+ (let ((toggle (eq (aref string 0) ?+))
+ (modes (string-to-list (match-string 1 string))))
+ (setq string (substring string (match-end 0)))
+ (while modes
+ (if (string-match "\\([^-+][^ ]*\\) *" string)
+ (setq 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)
+ (apply #'riece-channel-toggle-operator channel (cdr (car modes)))
+ (riece-emit-signal 'riece-channel-toggle-operator
(riece-make-identity channel
riece-server-name)
- modes toggle))))
+ (riece-make-identity (nth 2 (car modes))
+ riece-server-name)
+ (nth 1 (car modes))))
+ ((eq (car (car modes)) ?v)
+ (apply #'riece-channel-toggle-speaker channel (cdr (car modes)))
+ (riece-emit-signal 'riece-channel-toggle-speaker
+ (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)
+ (apply #'riece-channel-toggle-banned channel (cdr (car modes))))
+ ((eq (car (car modes)) ?e)
+ (apply #'riece-channel-toggle-uninvited channel (cdr (car modes))))
+ ((eq (car (car modes)) ?I)
+ (apply #'riece-channel-toggle-invited channel (cdr (car modes))))
+ (t
+ (apply #'riece-channel-toggle-mode channel (cdr (car modes)))))
+ (setq modes (cdr modes)))
+ (riece-emit-signal 'riece-channel-set-modes
+ (riece-make-identity channel
+ riece-server-name)))
(defun riece-handle-mode-message (prefix string)
(let* ((user (riece-prefix-nickname prefix))
(setq channel (match-string 1 string)
string (substring string (match-end 0)))
(if (string-match (concat "^" riece-channel-regexp "$") channel)
- (riece-parse-channel-modes string 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
(if (and (not (ring-empty-p riece-channel-history))
(riece-identity-equal channel (ring-ref riece-channel-history 0)))
(concat (format "%2d:+" index)
- (riece-format-identity channel)
- "\n")))
+ (riece-format-identity channel))))
;;; (defun riece-history-requires ()
;;; (if (memq 'riece-guess riece-addons)
(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)
(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)))))
- (riece-emit-signal 'riece-naming-assert-rename
- old-identity new-identity)))
+ (riece-emit-signal 'riece-naming-assert-rename
+ (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
(require 'riece-globals)
(require 'riece-options)
-(require 'riece-display)
(require 'calc)
--- /dev/null
+;;; riece-signal.el --- "signal-slot" abstraction for routing display events
+;; Copyright (C) 1998-2003 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; 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
(require 'riece-message)
(require 'riece-commands)
+(require 'riece-signal)
(eval-when-compile (require 'riece-highlight))
riece-unread-channels))
(setq riece-unread-channels
(cons (riece-message-target message) riece-unread-channels))
- (riece-emit-signal 'riece-unread-channel-list-update)))
+ (riece-emit-signal 'riece-update-buffer riece-channel-list-buffer)))
(defun riece-unread-after-switch-to-channel-function (last)
(setq riece-unread-channels
(defun riece-unread-format-channel-list-line (index channel)
(if (riece-identity-member channel riece-unread-channels)
(concat (format "%2d:!" index)
- (riece-format-identity channel)
- "\n")))
+ (riece-format-identity channel))))
(defun riece-unread-switch-to-channel ()
(interactive)
;;; (if (memq 'riece-guess riece-addons)
;;; (add-hook 'riece-guess-channel-try-functions
;;; 'riece-guess-channel-from-unread))
- (riece-connect-signal
- 'riece-unread-channel-list-update
- (lambda (signal handback)
- (save-excursion
- (set-buffer riece-channel-list-buffer)
- (run-hooks 'riece-update-buffer-functions)))))
+ )
(provide 'riece-unread)
(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)
projects / elisp / riece.git / commitdiff