From 88d78939e002191f54bf8843107a24a81a7e9055 Mon Sep 17 00:00:00 2001 From: ueno Date: Sun, 8 Jun 2003 07:59:04 +0000 Subject: [PATCH] * riece-filter.el (riece-handle-numeric-reply): Don't decode messages. (riece-handle-message): Ditto. (riece-sentinel): Clear system here. * riece-server.el (riece-server-process-name): New function. (riece-server-process): New function. (riece-close-server): Abolish. * riece-identity.el: Adopt vector object representation for identity objects. (riece-with-identity-buffer): New macro. (riece-decode-identity): New function. (riece-encode-identity): New function. * riece-channel.el: Assume that we are already in the server buffer. * riece-user.el: Likewise. --- lisp/ChangeLog | 25 ++++++ lisp/riece-300.el | 58 +++++++------- lisp/riece-channel.el | 106 +++++++++++-------------- lisp/riece-commands.el | 167 +++++++++++++++++++++++---------------- lisp/riece-ctcp.el | 25 +++--- lisp/riece-display.el | 147 +++++++++++++++++----------------- lisp/riece-filter.el | 59 ++++++++------ lisp/riece-handle.el | 206 +++++++++++++++++++++++++----------------------- lisp/riece-identity.el | 141 +++++++++++---------------------- lisp/riece-message.el | 33 ++++---- lisp/riece-misc.el | 67 ++++++++-------- lisp/riece-naming.el | 14 ++-- lisp/riece-options.el | 10 --- lisp/riece-rdcc.el | 7 +- lisp/riece-server.el | 144 +++++++++++++++------------------ lisp/riece-unread.el | 4 +- lisp/riece-user.el | 94 +++++++++------------- lisp/riece.el | 12 +-- 18 files changed, 637 insertions(+), 682 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2639d1f..6c4ae6a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,28 @@ +2003-06-08 Daiki Ueno + + * riece-filter.el (riece-handle-numeric-reply): Don't decode messages. + (riece-handle-message): Ditto. + (riece-sentinel): Clear system here. + + * riece-server.el (riece-server-process-name): New function. + (riece-server-process): New function. + (riece-close-server): Abolish. + + * riece-identity.el: Adopt vector object representation for + identity objects. + (riece-with-identity-buffer): New macro. + (riece-decode-identity): New function. + (riece-encode-identity): New function. + + * riece-globals.el (riece-process-list): New variable. + (riece-server-process-alist): Abolish. + (riece-channel-buffer-alist): Abolish. + (riece-user-list-buffer-alist): Abolish. + (riece-short-channel-indicator): New variable. + + * riece-channel.el: Assume that we are already in the server buffer. + * riece-user.el: Likewise. + 2003-06-06 OHASHI Akira * riece-ndcc.el (riece-ndcc-server-sentinel): Close a parenthesis. diff --git a/lisp/riece-300.el b/lisp/riece-300.el index da7b073..d7e60ad 100644 --- a/lisp/riece-300.el +++ b/lisp/riece-300.el @@ -79,7 +79,8 @@ (concat "^\\(" riece-user-regexp "\\) :") string) (let ((user (match-string 1 string)) - (message (substring string (match-end 0)))) + (message (riece-decode-coding-string + (substring string (match-end 0))))) (riece-user-toggle-away user t) (riece-insert-info (list riece-dialogue-buffer riece-others-buffer) @@ -111,7 +112,7 @@ (riece-concat-server-name (format "%s is %s (%s@%s)" (match-string 1 string) - (substring string (match-end 0)) + (riece-decode-coding-string (substring string (match-end 0))) (match-string 2 string) (match-string 3 string))) "\n")))) @@ -191,10 +192,11 @@ (if (string-match "^\\([^ ]+\\) \\([0-9]+\\) :" string) (let* ((channel (match-string 1 string)) (visible (match-string 2 string)) - (topic (substring string (match-end 0)))) - (let ((buffer (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist)))) + (topic (riece-decode-coding-string + (substring string (match-end 0))))) + (riece-channel-set-topic (riece-get-channel channel) topic) + (let ((buffer (riece-channel-buffer-name + (riece-make-identity channel riece-server-name)))) (riece-insert-info buffer (concat visible " users, topic: " topic "\n")) (riece-insert-info @@ -204,7 +206,8 @@ riece-dialogue-buffer) (concat (riece-concat-server-name - (format "%s users on %s, topic: %s" visible channel topic)) + (format "%s users on %s, topic: %s" visible + (riece-decode-coding-string channel) topic)) "\n")))))) (defun riece-handle-324-message (prefix number name string) @@ -217,9 +220,8 @@ (while modes (riece-channel-toggle-mode channel (car modes) (eq toggle ?+)) (setq modes (cdr modes))) - (let ((buffer (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist)))) + (let ((buffer (riece-channel-buffer-name + (riece-make-identity channel riece-server-name)))) (riece-insert-info buffer (concat "Mode: " mode-string "\n")) (riece-insert-info (if (and riece-channel-buffer-mode @@ -228,7 +230,8 @@ riece-dialogue-buffer) (concat (riece-concat-server-name - (format "Mode for %s: %s" channel mode-string)) + (format "Mode for %s: %s" (riece-decode-coding-string channel) + mode-string)) "\n"))) (riece-update-channel-indicator) (force-mode-line-update t)))) @@ -236,10 +239,10 @@ (defun riece-handle-set-topic (prefix number name string remove) (if (string-match "^\\([^ ]+\\) :" string) (let* ((channel (match-string 1 string)) - (message (substring string (match-end 0))) - (buffer (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist)))) + (message (riece-decode-coding-string + (substring string (match-end 0)))) + (buffer (riece-channel-buffer-name + (riece-make-identity channel riece-server-name)))) (if remove (riece-channel-set-topic (riece-get-channel channel) nil) (riece-channel-set-topic (riece-get-channel channel) message) @@ -251,23 +254,23 @@ riece-dialogue-buffer) (concat (riece-concat-server-name - (format "Topic for %s: %s" channel message)) + (format "Topic for %s: %s" (riece-decode-coding-string channel) + message)) "\n")) (riece-update-channel-indicator))))) (defun riece-handle-331-message (prefix number name string) - (riece-handle-set-topic prefix name name string t)) + (riece-handle-set-topic prefix number name string t)) (defun riece-handle-332-message (prefix number name string) - (riece-handle-set-topic prefix name name string nil)) + (riece-handle-set-topic prefix number name string nil)) (defun riece-handle-341-message (prefix number name string) (if (string-match "^\\([^ ]+\\) " string) (let* ((channel (match-string 1 string)) (user (substring string (match-end 0))) - (buffer (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist)))) + (buffer (riece-channel-buffer-name + (riece-make-identity channel riece-server-name)))) (riece-insert-info buffer (concat "Inviting " user "\n")) (riece-insert-info (if (and riece-channel-buffer-mode @@ -276,7 +279,8 @@ riece-dialogue-buffer) (concat (riece-concat-server-name - (format "Inviting %s to %s" user channel)) + (format "Inviting %s to %s" user + (riece-decode-coding-string channel))) "\n"))))) (defun riece-handle-352-message (prefix number name string) @@ -290,10 +294,10 @@ (operator (not (null (match-beginning 7)))) (flag (match-string 8 string)) (hops (match-string 9 string)) - (name (substring string (match-end 0))) - (buffer (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist)))) + (name (riece-decode-coding-string + (substring string (match-end 0)))) + (buffer (riece-channel-buffer-name + (riece-make-identity channel riece-server-name)))) (riece-naming-assert-join nick channel) (riece-user-toggle-away user away) (riece-user-toggle-operator user operator) @@ -324,7 +328,7 @@ (concat (riece-concat-server-name (format "%s %10s = %s (%s) [%s, %s, %s hops, on %s]\n" - channel + (riece-decode-coding-string channel) (concat (if (memq flag '(?@ ?+)) (char-to-string flag) diff --git a/lisp/riece-channel.el b/lisp/riece-channel.el index 5e9971a..a6f3d6e 100644 --- a/lisp/riece-channel.el +++ b/lisp/riece-channel.el @@ -38,25 +38,21 @@ ;;; Channel object: (defun riece-find-channel (name) "Get a channel object named NAME from the server buffer." - (riece-with-server-buffer - (let ((symbol (intern-soft (riece-identity-canonicalize-prefix - (riece-identity-prefix name)) - riece-obarray))) - (if symbol - (symbol-value symbol))))) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name) + riece-obarray))) + (if symbol + (symbol-value symbol)))) (defun riece-forget-channel (name) - (riece-with-server-buffer - (let ((symbol (intern-soft (riece-identity-canonicalize-prefix - (riece-identity-prefix name)) - riece-obarray))) - (when symbol - (makunbound symbol) - (unintern (symbol-name symbol) riece-obarray))))) - -(defun riece-make-channel (&optional users operators speakers - topic modes banned invited uninvited - key) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name) + riece-obarray))) + (when symbol + (makunbound symbol) + (unintern (symbol-name symbol) riece-obarray)))) + +(defun riece-make-channel (users operators speakers + topic modes banned invited uninvited + key) "Make an instance of channel object. Arguments are appropriate to channel users, operators, speakers \(+v), topic, modes, banned users, invited users, uninvited users, and @@ -64,16 +60,13 @@ the channel key, respectively." (vector users operators speakers topic modes banned invited uninvited)) (defun riece-get-channel (name) - (riece-with-server-buffer - (let ((symbol (intern-soft (riece-identity-canonicalize-prefix - (riece-identity-prefix name)) - riece-obarray))) - (if symbol - (symbol-value symbol) - (set (intern (riece-identity-canonicalize-prefix - (riece-identity-prefix name)) - riece-obarray) - (riece-make-channel)))))) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name) + riece-obarray))) + (if symbol + (symbol-value symbol) + (set (intern (riece-identity-canonicalize-prefix name) + riece-obarray) + (riece-make-channel nil nil nil nil nil nil nil nil nil))))) (defun riece-channel-users (channel) "Return the users of CHANNEL." @@ -147,55 +140,46 @@ the channel key, respectively." "Set the key of CHANNEL to VALUE." (aset channel 8 value)) -(defun riece-channel-get-users (&optional name) +(defun riece-channel-get-users (name) "Return channel's users as list." - (riece-channel-users - (riece-get-channel (or name riece-current-channel)))) + (riece-channel-users (riece-get-channel name))) -(defun riece-channel-get-operators (&optional name) +(defun riece-channel-get-operators (name) "Return channel's operators as list." - (riece-channel-operators - (riece-get-channel (or name riece-current-channel)))) + (riece-channel-operators (riece-get-channel name))) -(defun riece-channel-get-speakers (&optional name) +(defun riece-channel-get-speakers (name) "Return channel's speakers as list." - (riece-channel-speakers - (riece-get-channel (or name riece-current-channel)))) + (riece-channel-speakers (riece-get-channel name))) -(defun riece-channel-get-topic (&optional name) +(defun riece-channel-get-topic (name) "Return channel's topic." - (riece-channel-topic - (riece-get-channel (or name riece-current-channel)))) + (riece-channel-topic (riece-get-channel name))) -(defun riece-channel-get-modes (&optional name) +(defun riece-channel-get-modes (name) "Return channel's modes as list." - (riece-channel-modes - (riece-get-channel (or name riece-current-channel)))) + (riece-channel-modes (riece-get-channel name))) -(defun riece-channel-get-banned (&optional name) +(defun riece-channel-get-banned (name) "Return channel's banned users as list." - (riece-channel-banned - (riece-get-channel (or name riece-current-channel)))) + (riece-channel-banned (riece-get-channel name))) -(defun riece-channel-get-invited (&optional name) +(defun riece-channel-get-invited (name) "Return channel's invited users as list." - (riece-channel-invited - (riece-get-channel (or name riece-current-channel)))) + (riece-channel-invited (riece-get-channel name))) -(defun riece-channel-get-uninvited (&optional name) +(defun riece-channel-get-uninvited (name) "Return channel's uninvited users as list." - (riece-channel-uninvited - (riece-get-channel (or name riece-current-channel)))) + (riece-channel-uninvited (riece-get-channel name))) -(defun riece-channel-get-key (&optional name) +(defun riece-channel-get-key (name) "Return channel's key." - (riece-channel-key - (riece-get-channel (or name riece-current-channel)))) + (riece-channel-key (riece-get-channel name))) ;;; Functions called from `riece-handle-mode-message': (defun riece-channel-toggle-mode (name mode flag) "Add or remove channel MODE of channel." - (let* ((channel (riece-get-channel (or name riece-current-channel))) + (let* ((channel (riece-get-channel name)) (modes (riece-channel-modes channel))) (if flag (unless (memq mode modes) @@ -205,7 +189,7 @@ the channel key, respectively." (defun riece-channel-toggle-banned (name pattern flag) "Add or remove banned PATTERN of channel." - (let* ((channel (riece-get-channel (or name riece-current-channel))) + (let* ((channel (riece-get-channel name)) (banned (riece-channel-banned channel))) (if flag (unless (member pattern banned) @@ -215,7 +199,7 @@ the channel key, respectively." (defun riece-channel-toggle-invited (name pattern flag) "Add or remove invited PATTERN of channel." - (let* ((channel (riece-get-channel (or name riece-current-channel))) + (let* ((channel (riece-get-channel name)) (invited (riece-channel-invited channel))) (if flag (unless (member pattern invited) @@ -225,7 +209,7 @@ the channel key, respectively." (defun riece-channel-toggle-uninvited (name pattern flag) "Add or remove uninvited PATTERN to channel." - (let* ((channel (riece-get-channel (or name riece-current-channel))) + (let* ((channel (riece-get-channel name)) (uninvited (riece-channel-uninvited channel))) (if flag (unless (member pattern uninvited) @@ -236,7 +220,7 @@ the channel key, respectively." (defun riece-channel-toggle-user (name user flag) "Add or remove an user to channel." - (let* ((channel (riece-get-channel (or name riece-current-channel))) + (let* ((channel (riece-get-channel name)) (users (riece-channel-users channel))) (if flag (unless (member user users) @@ -246,7 +230,7 @@ the channel key, respectively." (defun riece-channel-toggle-operator (name user flag) "Add or remove an operator to channel." - (let* ((channel (riece-get-channel (or name riece-current-channel))) + (let* ((channel (riece-get-channel name)) (operators (riece-channel-operators channel))) (if flag (unless (member user operators) @@ -256,7 +240,7 @@ the channel key, respectively." (defun riece-channel-toggle-speaker (name user flag) "Add or remove an speaker to channel." - (let* ((channel (riece-get-channel (or name riece-current-channel))) + (let* ((channel (riece-get-channel name)) (speakers (riece-channel-speakers channel))) (if flag (unless (member user speakers) diff --git a/lisp/riece-commands.el b/lisp/riece-commands.el index 2b32033..5f282e0 100644 --- a/lisp/riece-commands.el +++ b/lisp/riece-commands.el @@ -35,10 +35,8 @@ ;;; Channel movement: (defun riece-command-switch-to-channel (channel) - (interactive - (list (completing-read "Channel/User: " - (mapcar #'list riece-current-channels) - nil t))) + (interactive (list (riece-completing-read-identity + "Channel/User: " riece-current-channels nil t))) (riece-switch-to-channel channel) (riece-command-configure-windows)) @@ -153,8 +151,10 @@ (defun riece-command-topic (topic) (interactive (list (read-from-minibuffer - "Topic: " (cons (or (riece-channel-get-topic - riece-current-channel) + "Topic: " (cons (or (riece-with-identity-buffer riece-current-channel + (riece-channel-get-topic + (riece-identity-prefix + riece-current-channel))) "") 0)))) (riece-send-string (format "TOPIC %s :%s\r\n" @@ -165,7 +165,8 @@ (interactive (let ((completion-ignore-case t)) (unless (and riece-current-channel - (riece-channel-p riece-current-channel)) + (riece-channel-p (riece-identity-prefix + riece-current-channel))) (error "Not on a channel")) (list (completing-read "User: " @@ -178,7 +179,8 @@ (interactive (let ((completion-ignore-case t)) (unless (and riece-current-channel - (riece-channel-p riece-current-channel)) + (riece-channel-p (riece-identity-prefix + riece-current-channel))) (error "Not on a channel")) (list (completing-read "User: " @@ -201,8 +203,9 @@ (list (read-from-minibuffer "Pattern: " (if (and riece-current-channel - (riece-channel-p riece-current-channel)) - (cons (riece-identity-prefix riece-current-channel) + (riece-channel-p (riece-identity-prefix + riece-current-channel))) + (cons (riece-decode-identity riece-current-channel t) 0)))))) (if (or (not (equal pattern "")) (yes-or-no-p "Really want to query NAMES without argument? ")) @@ -214,8 +217,9 @@ (list (read-from-minibuffer "Pattern: " (if (and riece-current-channel - (riece-channel-p riece-current-channel)) - (cons (riece-identity-prefix riece-current-channel) + (riece-channel-p (riece-identity-prefix + riece-current-channel))) + (cons (riece-decode-identity riece-current-channel t) 0)))))) (if (or (not (equal pattern "")) (yes-or-no-p "Really want to query WHO without argument? ")) @@ -227,8 +231,9 @@ (list (read-from-minibuffer "Pattern: " (if (and riece-current-channel - (riece-channel-p riece-current-channel)) - (cons (riece-identity-prefix riece-current-channel) + (riece-channel-p (riece-identity-prefix + riece-current-channel))) + (cons (riece-decode-identity riece-current-channel t) 0)))))) (if (or (not (equal pattern "")) (yes-or-no-p "Really want to query LIST without argument? ")) @@ -239,30 +244,32 @@ (let* ((completion-ignore-case t) (channel (if current-prefix-arg - (completing-read - "Channel/User: " - (mapcar #'list riece-current-channels)) + (riece-completing-read-identity + "Channel/User: " riece-current-channels) riece-current-channel)) (riece-overriding-server-name (riece-identity-server channel)) (riece-temp-minibuffer-message (concat "[Available modes: " - (riece-with-server-buffer - (if (and (riece-channel-p channel) - riece-supported-channel-modes) - (apply #'string riece-supported-channel-modes) - (if (and (not (riece-channel-p channel)) - riece-supported-user-modes) - (apply #'string riece-supported-user-modes)))) + (riece-with-server-buffer (riece-identity-server channel) + (if (riece-channel-p (riece-identity-prefix channel)) + (if riece-supported-channel-modes + (apply #'string riece-supported-channel-modes)) + (if riece-supported-user-modes + (apply #'string riece-supported-user-modes)))) "]"))) (list channel (read-from-minibuffer - (concat (riece-concat-modes channel "Mode (? for help)") ": ") + (concat (riece-concat-channel-modes + channel "Mode (? for help)") ": ") nil riece-minibuffer-map)))) (riece-send-string (format "MODE %s :%s\r\n" channel change))) (defun riece-command-set-operators (users &optional arg) (interactive - (let ((operators (riece-channel-get-operators riece-current-channel)) + (let ((operators + (riece-with-identity-buffer riece-current-channel + (riece-channel-get-operators + (riece-identity-prefix riece-current-channel)))) (completion-ignore-case t) users) (if current-prefix-arg @@ -271,11 +278,15 @@ (mapcar #'list operators))) (setq users (riece-completing-read-multiple "Users" - (delq nil (mapcar (lambda (user) - (unless (member user operators) - (list user))) - (riece-channel-get-users - riece-current-channel)))))) + (delq nil (mapcar + (lambda (user) + (unless (member user operators) + (list user))) + (riece-with-identity-buffer + riece-current-channel + (riece-channel-get-users + (riece-identity-prefix + riece-current-channel)))))))) (list users current-prefix-arg))) (let (group) (while users @@ -294,7 +305,10 @@ (defun riece-command-set-speakers (users &optional arg) (interactive - (let ((speakers (riece-channel-get-speakers riece-current-channel)) + (let ((speakers + (riece-with-identity-buffer riece-current-channel + (riece-channel-get-speakers + (riece-identity-prefix riece-current-channel)))) (completion-ignore-case t) users) (if current-prefix-arg @@ -303,11 +317,15 @@ (mapcar #'list speakers))) (setq users (riece-completing-read-multiple "Users" - (delq nil (mapcar (lambda (user) - (unless (member user speakers) - (list user))) - (riece-channel-get-users - riece-current-channel)))))) + (delq nil (mapcar + (lambda (user) + (unless (member user speakers) + (list user))) + (riece-with-identity-buffer + riece-current-channel + (riece-channel-get-users + (riece-identity-prefix + riece-current-channel)))))))) (list users current-prefix-arg))) (let (group) (while users @@ -365,11 +383,7 @@ (next-line 1))) (defun riece-command-join-channel (target key) - (let ((server-name (riece-identity-server target)) - process) - (if server-name - (setq process (cdr (assoc server-name riece-server-process-alist))) - (setq process riece-server-process)) + (let ((process (riece-server-process (riece-identity-server target)))) (unless process (error "%s" (substitute-command-keys "Type \\[riece-command-open-server] to open server."))) @@ -382,7 +396,7 @@ (riece-identity-prefix target)))))) (defun riece-command-join-partner (target) - (let ((pointer (riece-identity-member-safe target riece-current-channels))) + (let ((pointer (riece-identity-member target riece-current-channels))) (if pointer (riece-command-switch-to-channel (car pointer)) (riece-join-channel target) @@ -393,27 +407,23 @@ (interactive (let ((completion-ignore-case t) (target - (completing-read "Channel/User: " - (mapcar #'list riece-current-channels))) + (riece-completing-read-identity + "Channel/User: " riece-current-channels)) key) (if (and current-prefix-arg (riece-channel-p target)) (setq key (riece-read-passwd (format "Key for %s: " target)))) (list target key))) - (let ((pointer (riece-identity-member-safe target riece-current-channels))) + (let ((pointer (riece-identity-member target riece-current-channels))) (if pointer (riece-command-switch-to-channel (car pointer)) - (if (riece-channel-p target) + (if (riece-channel-p (riece-identity-prefix target)) (riece-command-join-channel target key) (riece-command-join-partner target))))) (defun riece-command-part-channel (target message) - (let ((server-name (riece-identity-server target)) - process) - (if server-name - (setq process (cdr (assoc server-name riece-server-process-alist))) - (setq process riece-server-process)) + (let ((process (riece-server-process (riece-identity-server target)))) (unless process (error "%s" (substitute-command-keys "Type \\[riece-command-open-server] to open server."))) @@ -429,16 +439,15 @@ (interactive (let ((completion-ignore-case t) (target - (completing-read "Channel/User: " - (mapcar #'list riece-current-channels) - nil t (cons riece-current-channel 0))) + (riece-completing-read-identity + "Channel/User: " riece-current-channels)) message) (if (and current-prefix-arg - (riece-channel-p target)) + (riece-channel-p (riece-identity-prefix target))) (setq message (read-string "Message: "))) (list target message))) - (if (riece-identity-member-safe target riece-current-channels) - (if (riece-channel-p target) + (if (riece-identity-member target riece-current-channels) + (if (riece-channel-p (riece-identity-prefix target)) (riece-command-part-channel target message) (riece-part-channel target) (riece-redisplay-buffers)) @@ -546,8 +555,14 @@ If prefix argument ARG is non-nil, toggle frozen status." (if arg (read-string "Message: ") (or riece-quit-message - (riece-extended-version))))) - (riece-close-all-server message)))) + (riece-extended-version)))) + (process-list riece-process-list)) + (while process-list + (riece-process-send-string (car process-list) + (if message + (format "QUIT :%s\r\n" message) + "QUIT\r\n")) + (setq process-list (cdr process-list)))))) (defun riece-command-raw (command) "Enter raw IRC command, which is sent to the server." @@ -577,26 +592,40 @@ If prefix argument ARG is non-nil, toggle frozen status." (defun riece-command-open-server (server-name) (interactive (list (completing-read "Server: " riece-server-alist))) - (if (assoc server-name riece-server-process-alist) - (error "%s is already opened" server-name) - (riece-open-server - (riece-server-name-to-server server-name) - server-name))) + (if (riece-server-process server-name) + (error "%s is already opened" server-name)) + (riece-open-server + (riece-server-name-to-server server-name) + server-name)) (defun riece-command-close-server (server-name &optional message) (interactive - (list (completing-read "Server: " riece-server-process-alist) + (list (completing-read + "Server: " + (mapcar + (lambda (process) + (with-current-buffer (process-buffer process) + riece-server-name)) + riece-process-list)) (if current-prefix-arg (read-string "Message: ") (or riece-quit-message (riece-extended-version))))) - (riece-close-server server-name message)) + (riece-process-send-string (riece-server-process server-name) + (if message + (format "QUIT :%s\r\n" message) + "QUIT\r\n"))) (defun riece-command-universal-server-name-argument () (interactive) (let* ((riece-overriding-server-name - (completing-read "Server: " - riece-server-process-alist)) + (completing-read + "Server: " + (mapcar + (lambda (process) + (with-current-buffer (process-buffer process) + riece-server-name)) + riece-process-list))) (command (key-binding (read-key-sequence (format "Command to execute on \"%s\":" diff --git a/lisp/riece-ctcp.el b/lisp/riece-ctcp.el index 1110ca2..78a4dae 100644 --- a/lisp/riece-ctcp.el +++ b/lisp/riece-ctcp.el @@ -83,9 +83,8 @@ (defun riece-handle-ctcp-version-request (prefix target string) (let ((buffer (if (riece-channel-p target) - (cdr (riece-identity-assoc - (riece-make-identity target) - riece-channel-buffer-alist)))) + (riece-channel-buffer-name + (riece-make-identity target riece-server-name)))) (user (riece-prefix-nickname prefix))) (riece-send-string (format "NOTICE %s :\1VERSION %s\1\r\n" user (riece-extended-version))) @@ -105,9 +104,8 @@ (defun riece-handle-ctcp-ping-request (prefix target string) (let ((buffer (if (riece-channel-p target) - (cdr (riece-identity-assoc - (riece-make-identity target) - riece-channel-buffer-alist)))) + (riece-channel-buffer-name + (riece-make-identity target riece-server-name)))) (user (riece-prefix-nickname prefix))) (riece-send-string (if string @@ -129,9 +127,8 @@ (defun riece-handle-ctcp-clientinfo-request (prefix target string) (let ((buffer (if (riece-channel-p target) - (cdr (riece-identity-assoc - (riece-make-identity target) - riece-channel-buffer-alist)))) + (riece-channel-buffer-name + (riece-make-identity target riece-server-name)))) (user (riece-prefix-nickname prefix))) (riece-send-string (format "NOTICE %s :\1CLIENTINFO %s\1\r\n" @@ -166,9 +163,8 @@ (defun riece-handle-ctcp-action-request (prefix target string) (let ((buffer (if (riece-channel-p target) - (cdr (riece-identity-assoc - (riece-make-identity target) - riece-channel-buffer-alist)))) + (riece-channel-buffer-name + (riece-make-identity target riece-server-name)))) (user (riece-prefix-nickname prefix))) (riece-insert-change buffer (concat user " " string "\n")) (riece-insert-change @@ -292,9 +288,8 @@ (riece-send-string (format "PRIVMSG %s :\1ACTION %s\1\r\n" (riece-identity-prefix channel) action)) - (let ((buffer (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist)))) + (let ((buffer (riece-channel-buffer-name + (riece-make-identity channel riece-server-name)))) (riece-insert-change buffer (concat (riece-identity-prefix (riece-current-nickname)) " " action "\n")) diff --git a/lisp/riece-display.el b/lisp/riece-display.el index be46a46..a64db31 100644 --- a/lisp/riece-display.el +++ b/lisp/riece-display.el @@ -33,6 +33,7 @@ riece-update-channel-list-buffer riece-update-status-indicators riece-update-channel-indicator + riece-update-short-channel-indicator riece-update-channel-list-indicator)) (defcustom riece-configure-windows-function #'riece-configure-windows @@ -52,7 +53,8 @@ (and riece-user-list-buffer-mode riece-current-channel ;; User list buffer is nuisance for private conversation. - (riece-channel-p riece-current-channel)))) + (riece-channel-p (riece-identity-prefix + riece-current-channel))))) ;; Can't expand minibuffer to full frame. (if (eq (selected-window) (minibuffer-window)) (other-window 1)) @@ -111,24 +113,28 @@ (defun riece-update-user-list-buffer () (if (and riece-user-list-buffer - (get-buffer riece-user-list-buffer)) + (get-buffer riece-user-list-buffer) + riece-current-channel + (riece-channel-p (riece-identity-prefix riece-current-channel))) (save-excursion - (set-buffer riece-user-list-buffer) - (when (and riece-current-channel - (riece-channel-p riece-current-channel)) - (let ((inhibit-read-only t) - buffer-read-only - (users (riece-channel-get-users riece-current-channel)) - (operators (riece-channel-get-operators riece-current-channel)) - (speakers (riece-channel-get-speakers riece-current-channel))) - (erase-buffer) - (while users - (if (member (car users) operators) - (insert "@" (car users) "\n") - (if (member (car users) speakers) - (insert "+" (car users) "\n") - (insert " " (car users) "\n"))) - (setq users (cdr users)))))))) + (set-buffer (process-buffer (riece-server-process + (riece-identity-server + riece-current-channel)))) + (let* ((inhibit-read-only t) + buffer-read-only + (channel (riece-identity-prefix riece-current-channel)) + (users (riece-channel-get-users channel)) + (operators (riece-channel-get-operators channel)) + (speakers (riece-channel-get-speakers channel))) + (set-buffer riece-user-list-buffer) + (erase-buffer) + (while users + (if (member (car users) operators) + (insert "@" (car users) "\n") + (if (member (car users) speakers) + (insert "+" (car users) "\n") + (insert " " (car users) "\n"))) + (setq users (cdr users))))))) (defun riece-update-channel-list-buffer () (if (and riece-channel-list-buffer @@ -142,20 +148,27 @@ (erase-buffer) (while channels (if (car channels) - (insert (format "%2d: %s\n" index (car channels)))) + (insert (format "%2d: %s\n" index + (riece-decode-identity (car channels))))) (setq index (1+ index) channels (cdr channels))))))) (defun riece-update-channel-indicator () (setq riece-channel-indicator (if riece-current-channel - (riece-concat-current-channel-modes - (if (and riece-current-channel - (riece-channel-p riece-current-channel) - (riece-channel-get-topic riece-current-channel)) - (concat riece-current-channel ": " - (riece-channel-get-topic riece-current-channel)) - riece-current-channel)) + (if (riece-channel-p (riece-identity-prefix riece-current-channel)) + (riece-concat-channel-modes + riece-current-channel + (riece-concat-channel-topic + riece-current-channel + (riece-decode-identity riece-current-channel))) + riece-current-channel) + "None"))) + +(defun riece-update-short-channel-indicator () + (setq riece-short-channel-indicator + (if riece-current-channel + (riece-decode-identity riece-current-channel) "None"))) (defun riece-update-channel-list-indicator () @@ -170,26 +183,28 @@ (mapcar (lambda (channel) (prog1 (if channel - (format "%d:%s" index channel)) + (format "%d:%s" index + (riece-decode-identity channel))) (setq index (1+ index)))) riece-current-channels)) ","))) (setq riece-channel-list-indicator "No channel"))) (defun riece-update-status-indicators () - (with-current-buffer riece-command-buffer - (riece-with-server-buffer - (setq riece-away-indicator - (if (and riece-real-nickname - (riece-user-get-away riece-real-nickname)) - "A" - "-") - riece-operator-indicator - (if (and riece-real-nickname - (riece-user-get-operator riece-real-nickname)) - "O" - "-") - riece-user-indicator riece-real-nickname))) + (if riece-current-channel + (with-current-buffer riece-command-buffer + (riece-with-server-buffer (riece-identity-server riece-current-channel) + (setq riece-away-indicator + (if (and riece-real-nickname + (riece-user-get-away riece-real-nickname)) + "A" + "-") + riece-operator-indicator + (if (and riece-real-nickname + (riece-user-get-operator riece-real-nickname)) + "O" + "-") + riece-user-indicator riece-real-nickname)))) (setq riece-freeze-indicator (with-current-buffer (if (and riece-channel-buffer-mode riece-channel-buffer) @@ -206,11 +221,14 @@ (force-mode-line-update t) (run-hooks 'riece-update-buffers-hook)) +(defun riece-channel-buffer-name (identity) + (format riece-channel-buffer-format (riece-decode-identity identity))) + (eval-when-compile (autoload 'riece-channel-mode "riece")) (defun riece-channel-buffer-create (identity) (with-current-buffer - (riece-get-buffer-create (format riece-channel-buffer-format identity)) + (riece-get-buffer-create (riece-channel-buffer-name identity)) (unless (eq major-mode 'riece-channel-mode) (riece-channel-mode) (let (buffer-read-only) @@ -221,11 +239,14 @@ "\n")))) (current-buffer))) +(defun riece-user-list-buffer-name (identity) + (format riece-user-list-buffer-format (riece-decode-identity identity))) + (eval-when-compile (autoload 'riece-user-list-mode "riece")) (defun riece-user-list-buffer-create (identity) (with-current-buffer - (riece-get-buffer-create (format riece-user-list-buffer-format identity)) + (riece-get-buffer-create (riece-user-list-buffer-name identity)) (unless (eq major-mode 'riece-user-list-mode) (riece-user-list-mode)) (current-buffer))) @@ -234,33 +255,19 @@ (setq riece-last-channel riece-current-channel riece-current-channel identity riece-channel-buffer - (cdr (riece-identity-assoc - identity riece-channel-buffer-alist)) - riece-user-list-buffer - (cdr (riece-identity-assoc - identity riece-user-list-buffer-alist))) + (get-buffer (riece-channel-buffer-name identity)) + riece-user-list-buffer + (get-buffer (riece-user-list-buffer-name identity))) (run-hooks 'riece-channel-switch-hook)) -(defun riece-join-channel (channel-name) - (let ((identity (riece-make-identity channel-name))) - (unless (riece-identity-member - identity riece-current-channels) - (setq riece-current-channels - (riece-identity-assign-binding - identity riece-current-channels - riece-default-channel-binding))) - (unless (riece-identity-assoc - identity riece-channel-buffer-alist) - (let ((buffer (riece-channel-buffer-create identity))) - (setq riece-channel-buffer-alist - (cons (cons identity buffer) - riece-channel-buffer-alist)))) - (unless (riece-identity-assoc - identity riece-user-list-buffer-alist) - (let ((buffer (riece-user-list-buffer-create identity))) - (setq riece-user-list-buffer-alist - (cons (cons identity buffer) - riece-user-list-buffer-alist)))))) +(defun riece-join-channel (identity) + (unless (riece-identity-member identity riece-current-channels) + (setq riece-current-channels + (riece-identity-assign-binding + identity riece-current-channels + riece-default-channel-binding))) + (riece-channel-buffer-create identity) + (riece-user-list-buffer-create identity)) (defun riece-switch-to-nearest-channel (pointer) (let ((start riece-current-channels) @@ -279,10 +286,8 @@ (setq riece-last-channel riece-current-channel riece-current-channel nil)))) -(defun riece-part-channel (channel-name) - (let* ((identity (riece-make-identity channel-name)) - (pointer (riece-identity-member - identity riece-current-channels))) +(defun riece-part-channel (identity) + (let ((pointer (riece-identity-member identity riece-current-channels))) (if pointer (setcar pointer nil)) (if (riece-identity-equal identity riece-current-channel) diff --git a/lisp/riece-filter.el b/lisp/riece-filter.el index c6eba72..bf61aa0 100644 --- a/lisp/riece-filter.el +++ b/lisp/riece-filter.el @@ -27,6 +27,8 @@ (require 'riece-handle) (require 'riece-misc) (require 'riece-server) ;riece-close-server +(require 'riece-identity) +(require 'riece-display) (defun riece-handle-numeric-reply (prefix number name string) (let ((base-number (* (/ number 100) 100)) @@ -43,8 +45,7 @@ (if (and function (symbol-function function)) (condition-case error - (funcall function prefix number name - (riece-decode-coding-string string)) + (funcall function prefix number name string) (error (if riece-debug (message "Error occurred in `%S': %S" function error))))))) @@ -55,7 +56,8 @@ (list riece-dialogue-buffer riece-others-buffer) (concat client-prefix (riece-concat-server-name - (mapconcat #'identity (riece-split-parameters string) " ")) + (mapconcat #'riece-decode-coding-string + (riece-split-parameters string) " ")) "\n"))) (defun riece-handle-message (prefix message string) @@ -64,8 +66,7 @@ (riece-user-set-user-at-host (riece-get-user (substring prefix 0 (match-beginning 0))) (riece-parse-user-at-host (substring prefix (1+ (match-beginning 0)))))) - (setq message (downcase message) - string (riece-decode-coding-string string)) + (setq message (downcase message)) (let ((function (intern-soft (concat "riece-handle-" message "-message"))) (hook (intern (concat "riece-" message "-hook"))) (after-hook (intern (concat "riece-after-" message "-hook")))) @@ -123,34 +124,46 @@ (forward-line))))) (eval-when-compile - (autoload 'riece "riece")) + (autoload 'riece-exit "riece")) (defun riece-sentinel (process status) (if riece-reconnect-with-password (unwind-protect - (if (eq process riece-server-process) - (riece) ;Need to initialize system. - (let ((server-name - (car (rassq process riece-server-process-alist)))) - (riece-close-server server-name) - (riece-open-server - (riece-server-name-to-server server-name) - server-name))) + (let ((server-name + (with-current-buffer (process-buffer process) + riece-server-name))) + (riece-close-server-process process) + (riece-open-server + (if (equal server-name "") + riece-server + (riece-server-name-to-server server-name)) + server-name)) (setq riece-reconnect-with-password nil)) (let ((server-name (with-current-buffer (process-buffer process) riece-server-name))) (if (and (process-id process) ;not a network connection (string-match "^exited abnormally with code \\([0-9]+\\)" status)) - (if server-name - (message "Connection to \"%s\" closed: %s" - server-name (match-string 1 status)) - (message "Connection closed: %s" (match-string 1 status))) - (if server-name + (if (equal server-name "") + (message "Connection closed: %s" (match-string 1 status)) (message "Connection to \"%s\" closed: %s" - server-name (substring status 0 (1- (length status)))) - (message "Connection closed: %s" - (substring status 0 (1- (length status)))))) - (riece-close-server server-name)))) + server-name (match-string 1 status))) + (if (equal server-name "") + (message "Connection closed: %s" + (substring status 0 (1- (length status)))) + (message "Connection to \"%s\" closed: %s" + server-name (substring status 0 (1- (length status)))))) + (let ((riece-overriding-server-name server-name) + (channels riece-current-channels)) + (while channels + (if (and (car channels) + (equal (riece-identity-server (car channels)) + server-name)) + (setcar channels nil)) + (setq channels (cdr channels)))) + (riece-close-server-process process) + ;; If no server process is available, exit. + (unless riece-process-list + (riece-exit))))) (provide 'riece-filter) diff --git a/lisp/riece-handle.el b/lisp/riece-handle.el index 371c407..d30ca9d 100644 --- a/lisp/riece-handle.el +++ b/lisp/riece-handle.el @@ -37,25 +37,31 @@ (visible (riece-identity-member riece-current-channel channels))) (riece-naming-assert-rename old new) (let ((pointer (riece-identity-member - (riece-make-identity old) + (riece-make-identity old riece-server-name) riece-current-channels))) (when pointer - (setcar pointer (riece-make-identity new)) - (setcar (riece-identity-assoc (riece-make-identity old) - riece-channel-buffer-alist) - (riece-make-identity new)) - (setcar (riece-identity-assoc (riece-make-identity old) - riece-user-list-buffer-alist) - (riece-make-identity new)) - (if (riece-identity-equal (riece-make-identity old) + (setcar pointer (riece-make-identity new riece-server-name)) + (with-current-buffer (riece-channel-buffer-name + (riece-make-identity + old riece-server-name)) + (rename-buffer (riece-channel-buffer-name + (riece-make-identity new riece-server-name)))) + (with-current-buffer (riece-user-list-buffer-name + (riece-make-identity + old riece-server-name)) + (rename-buffer (riece-user-list-buffer-name + (riece-make-identity new riece-server-name)))) + (if (riece-identity-equal (riece-make-identity + old riece-server-name) riece-current-channel) - (riece-switch-to-channel (riece-make-identity new))) - (setq channels (cons (riece-make-identity new) channels)))) + (riece-switch-to-channel (riece-make-identity + new riece-server-name))) + (setq channels (cons (riece-make-identity new riece-server-name) + channels)))) (riece-insert-change (mapcar (lambda (channel) - (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist))) + (riece-channel-buffer-name + (riece-make-identity channel riece-server-name))) channels) (format "%s -> %s\n" old new)) (riece-insert-change (if visible @@ -71,27 +77,31 @@ (let* ((user (riece-prefix-nickname prefix)) (parameters (riece-split-parameters string)) (targets (split-string (car parameters) ",")) - (message (nth 1 parameters))) - (unless (equal message "") ;not ignored by server? - (riece-display-message - (riece-make-message user (riece-make-identity (car targets)) - message))))) + (message (riece-decode-coding-string (nth 1 parameters)))) + (riece-display-message + (riece-make-message (riece-make-identity user + riece-server-name) + (riece-make-identity (car targets) + riece-server-name) + message)))) (defun riece-handle-notice-message (prefix string) (let* ((user (if prefix (riece-prefix-nickname prefix))) (parameters (riece-split-parameters string)) (targets (split-string (car parameters) ",")) - (message (nth 1 parameters))) - (unless (equal message "") ;not ignored by server? - (if user - (riece-display-message - (riece-make-message user (riece-make-identity (car targets)) - message 'notice)) - ;; message from server - (riece-insert-notice - (list riece-dialogue-buffer riece-others-buffer) - (concat (riece-concat-server-name message) "\n")))))) + (message (riece-decode-coding-string (nth 1 parameters)))) + (if user + (riece-display-message + (riece-make-message (riece-make-identity user + riece-server-name) + (riece-make-identity (car targets) + riece-server-name) + message 'notice)) + ;; message from server + (riece-insert-notice + (list riece-dialogue-buffer riece-others-buffer) + (concat (riece-concat-server-name message) "\n"))))) (defun riece-handle-ping-message (prefix string) (riece-send-string (format "PONG :%s\r\n" @@ -106,16 +116,16 @@ (riece-naming-assert-join user (car channels)) ;;XXX (if (riece-identity-equal-no-server user riece-real-nickname) - (riece-switch-to-channel (riece-make-identity (car channels)))) - (let ((buffer (cdr (riece-identity-assoc - (riece-make-identity (car channels)) - riece-channel-buffer-alist)))) + (riece-switch-to-channel (riece-make-identity (car channels) + riece-server-name))) + (let ((buffer (riece-channel-buffer-name + (riece-make-identity (car channels) riece-server-name)))) (riece-insert-change buffer (format "%s (%s) has joined %s\n" user (riece-user-get-user-at-host user) - (car channels))) + (riece-decode-coding-string (car channels)))) (riece-insert-change (if (and riece-channel-buffer-mode (not (eq buffer riece-channel-buffer))) @@ -126,7 +136,7 @@ (format "%s (%s) has joined %s" user (riece-user-get-user-at-host user) - (car channels))) + (riece-decode-coding-string (car channels)))) "\n"))) (setq channels (cdr channels))) (riece-redisplay-buffers))) @@ -135,17 +145,17 @@ (let* ((user (riece-prefix-nickname prefix)) (parameters (riece-split-parameters string)) (channels (split-string (car parameters) ",")) - (message (nth 1 parameters))) + (message (riece-decode-coding-string (nth 1 parameters)))) (while channels (riece-naming-assert-part user (car channels)) - (let ((buffer (cdr (riece-identity-assoc - (riece-make-identity (car channels)) - riece-channel-buffer-alist)))) + (let ((buffer (riece-channel-buffer-name + (riece-make-identity (car channels) riece-server-name)))) (riece-insert-change buffer (concat (riece-concat-message - (format "%s has left %s" user (car channels)) + (format "%s has left %s" + user (riece-decode-coding-string (car channels))) message) "\n")) (riece-insert-change @@ -156,7 +166,8 @@ (concat (riece-concat-server-name (riece-concat-message - (format "%s has left %s" user (car channels)) + (format "%s has left %s" + user (riece-decode-coding-string (car channels))) message)) "\n"))) (setq channels (cdr channels))) @@ -167,16 +178,16 @@ (parameters (riece-split-parameters string)) (channel (car parameters)) (user (nth 1 parameters)) - (message (nth 2 parameters))) + (message (riece-decode-coding-string (nth 2 parameters)))) (riece-naming-assert-part user channel) - (let ((buffer (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist)))) + (let ((buffer (riece-channel-buffer-name + (riece-make-identity channel riece-server-name)))) (riece-insert-change buffer (concat (riece-concat-message - (format "%s kicked %s out from %s" kicker user channel) + (format "%s kicked %s out from %s" + kicker user (riece-decode-coding-string channel)) message) "\n")) (riece-insert-change @@ -187,7 +198,8 @@ (concat (riece-concat-server-name (riece-concat-message - (format "%s kicked %s out from %s\n" kicker user channel) + (format "%s kicked %s out from %s\n" + kicker user (riece-decode-coding-string channel)) message)) "\n"))) (riece-redisplay-buffers))) @@ -196,52 +208,50 @@ (let* ((user (riece-prefix-nickname prefix)) (channels (copy-sequence (riece-user-get-channels user))) (pointer channels) - (message (car (riece-split-parameters string)))) - ;; If you are quitting, no need to cleanup. - (unless (riece-identity-equal-no-server user riece-real-nickname) - ;; You were talking with the user. - (if (riece-identity-member (riece-make-identity user) - riece-current-channels) - (riece-part-channel user)) ;XXX - (setq pointer channels) - (while pointer - (riece-naming-assert-part user (car pointer)) - (setq pointer (cdr pointer))) - (let ((buffers - (mapcar - (lambda (channel) - (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist))) - channels))) - (riece-insert-change buffers - (concat (riece-concat-message - (format "%s has left IRC" user) - message) - "\n")) - (riece-insert-change (if (and riece-channel-buffer-mode - (not (memq riece-channel-buffer - buffers))) - (list riece-dialogue-buffer - riece-others-buffer) - riece-dialogue-buffer) - (concat - (riece-concat-server-name - (riece-concat-message - (format "%s has left IRC" user) - message)) - "\n")))) - (riece-redisplay-buffers))) + (message (riece-decode-coding-string + (car (riece-split-parameters string))))) + ;; You were talking with the user. + (if (riece-identity-member (riece-make-identity user riece-server-name) + riece-current-channels) + (riece-part-channel user)) ;XXX + (setq pointer channels) + (while pointer + (riece-naming-assert-part user (car pointer)) + (setq pointer (cdr pointer))) + (let ((buffers + (mapcar + (lambda (channel) + (riece-channel-buffer-name + (riece-make-identity channel riece-server-name))) + channels))) + (riece-insert-change buffers + (concat (riece-concat-message + (format "%s has left IRC" user) + message) + "\n")) + (riece-insert-change (if (and riece-channel-buffer-mode + (not (memq riece-channel-buffer + buffers))) + (list riece-dialogue-buffer + riece-others-buffer) + riece-dialogue-buffer) + (concat + (riece-concat-server-name + (riece-concat-message + (format "%s has left IRC" user) + message)) + "\n")))) + (riece-redisplay-buffers)) (defun riece-handle-kill-message (prefix string) (let* ((killer (riece-prefix-nickname prefix)) (parameters (riece-split-parameters string)) (user (car parameters)) - (message (nth 1 parameters)) + (message (riece-decode-coding-string (nth 1 parameters))) (channels (copy-sequence (riece-user-get-channels user))) pointer) ;; You were talking with the user. - (if (riece-identity-member (riece-make-identity user) + (if (riece-identity-member (riece-make-identity user riece-server-name) riece-current-channels) (riece-part-channel user)) ;XXX (setq pointer channels) @@ -251,9 +261,8 @@ (let ((buffers (mapcar (lambda (channel) - (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist))) + (riece-channel-buffer-name + (riece-make-identity channel riece-server-name))) channels))) (riece-insert-change buffers (concat (riece-concat-message @@ -282,18 +291,18 @@ (list riece-dialogue-buffer riece-others-buffer) (concat (riece-concat-server-name - (format "%s invites you to %s" user channel)) + (format "%s invites you to %s" + user (riece-decode-coding-string channel))) "\n")))) (defun riece-handle-topic-message (prefix string) (let* ((user (riece-prefix-nickname prefix)) (parameters (riece-split-parameters string)) (channel (car parameters)) - (topic (nth 1 parameters))) + (topic (riece-decode-coding-string (nth 1 parameters)))) (riece-channel-set-topic (riece-get-channel channel) topic) - (let ((buffer (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist)))) + (let ((buffer (riece-channel-buffer-name + (riece-make-identity channel riece-server-name)))) (riece-insert-change buffer (format "Topic by %s: %s\n" user topic)) @@ -304,7 +313,8 @@ riece-dialogue-buffer) (concat (riece-concat-server-name - (format "Topic on %s by %s: %s" channel user topic)) + (format "Topic on %s by %s: %s" + (riece-decode-coding-string channel) user topic)) "\n")) (riece-redisplay-buffers)))) @@ -345,9 +355,8 @@ (setq channel (match-string 1 string) string (substring string (match-end 0))) (riece-parse-channel-modes string channel) - (let ((buffer (cdr (riece-identity-assoc - (riece-make-identity channel) - riece-channel-buffer-alist)))) + (let ((buffer (riece-channel-buffer-name + (riece-make-identity channel riece-server-name)))) (riece-insert-change buffer (format "Mode by %s: %s\n" user string)) @@ -358,7 +367,8 @@ riece-dialogue-buffer) (concat (riece-concat-server-name - (format "Mode on %s by %s: %s" channel user string)) + (format "Mode on %s by %s: %s" + (riece-decode-coding-string channel) user string)) "\n")) (riece-redisplay-buffers))))) diff --git a/lisp/riece-identity.el b/lisp/riece-identity.el index 8f5c39d..1f58e02 100644 --- a/lisp/riece-identity.el +++ b/lisp/riece-identity.el @@ -25,48 +25,20 @@ ;;; Code: (require 'riece-globals) - -(defun riece-find-server-name () - (or riece-overriding-server-name - ;already in the server buffer - (if (local-variable-p 'riece-server-name (current-buffer)) - riece-server-name - (if riece-current-channel - (riece-identity-server riece-current-channel))))) - -(defun riece-find-server-process () - (let ((server-name (riece-find-server-name))) - (if server-name - (cdr (assoc server-name riece-server-process-alist)) - riece-server-process))) - -(defmacro riece-with-server-buffer (&rest body) - `(let ((process (riece-find-server-process))) - (if process - (with-current-buffer (process-buffer process) - ,@body) - (error "Server closed.")))) +(require 'riece-coding) +(require 'riece-server) (defun riece-identity-prefix (identity) "Return the component sans its server from IDENTITY." - (if (string-match " " identity) - (substring identity 0 (match-beginning 0)) - identity)) + (aref identity 0)) (defun riece-identity-server (identity) "Return the server component in IDENTITY." - (if (string-match " " identity) - (substring identity (match-end 0)))) + (aref identity 1)) -(defun riece-make-identity (prefix &optional server) +(defun riece-make-identity (prefix server) "Make an identity object from PREFIX and SERVER." - (if (riece-identity-server prefix) - prefix - (unless server - (setq server (riece-find-server-name))) - (if server - (concat prefix " " server) - prefix))) + (vector prefix server)) (defun riece-identity-equal (ident1 ident2) "Return t, if IDENT1 and IDENT2 is equal." @@ -77,18 +49,6 @@ (riece-identity-server ident1) (riece-identity-server ident2)))) -(defun riece-identity-equal-safe (ident1 ident2) - "Return t, if IDENT1 and IDENT2 is equal. -The only difference with `riece-identity-equal', this function appends -server name before comparison." - (riece-identity-equal - (if (riece-identity-server ident1) - ident1 - (riece-make-identity ident1)) - (if (riece-identity-server ident2) - ident2 - (riece-make-identity ident2)))) - (defun riece-identity-canonicalize-prefix (prefix) "Canonicalize identity PREFIX. This function downcases PREFIX first, then does special treatment for @@ -119,57 +79,26 @@ RFC2812, 2.2 \"Character codes\" says: (equal (riece-identity-canonicalize-prefix prefix1) (riece-identity-canonicalize-prefix prefix2))) -(defun riece-identity-equal-no-server-safe (prefix1 prefix2) - "Return t, if IDENT1 and IDENT2 is equal without server. -The only difference with `riece-identity-no-server', this function removes -server name before comparison." - (equal (riece-identity-canonicalize-prefix - (riece-identity-prefix prefix1)) - (riece-identity-canonicalize-prefix - (riece-identity-prefix prefix2)))) - (defun riece-identity-member (elt list) "Return non-nil if an identity ELT is an element of LIST." (catch 'found (while list - (if (and (stringp (car list)) + (if (and (vectorp (car list)) (riece-identity-equal (car list) elt)) (throw 'found list) (setq list (cdr list)))))) -(defun riece-identity-member-safe (elt list) - "Return non-nil if an identity ELT is an element of LIST. -The only difference with `riece-identity-member', this function uses -`riece-identity-equal-safe' for comparison." - (catch 'found - (while list - (if (and (stringp (car list)) - (riece-identity-equal-safe (car list) elt)) - (throw 'found list) - (setq list (cdr list)))))) - (defun riece-identity-member-no-server (elt list) "Return non-nil if an identity ELT is an element of LIST. The only difference with `riece-identity-member', this function doesn't take server names into account." (catch 'found (while list - (if (and (stringp (car list)) + (if (and (vectorp (car list)) (riece-identity-equal-no-server (car list) elt)) (throw 'found list) (setq list (cdr list)))))) -(defun riece-identity-member-no-server-safe (elt list) - "Return non-nil if an identity ELT is an element of LIST. -The only difference with `riece-identity-member-no-server', this function uses -`riece-identity-equal-no-server-safe' for comparison." - (catch 'found - (while list - (if (and (stringp (car list)) - (riece-identity-equal-no-server-safe (car list) elt)) - (throw 'found list) - (setq list (cdr list)))))) - (defun riece-identity-assoc (elt alist) "Return non-nil if an identity ELT matches the car of an element of ALIST." (catch 'found @@ -178,18 +107,8 @@ The only difference with `riece-identity-member-no-server', this function uses (throw 'found (car alist)) (setq alist (cdr alist)))))) -(defun riece-identity-assoc-safe (elt alist) - "Return non-nil if an identity ELT matches the car of an element of ALIST. -The only difference with `riece-identity-assoc', this function uses -`riece-identity-equal-safe' for comparison." - (catch 'found - (while alist - (if (riece-identity-equal-safe (car (car alist)) elt) - (throw 'found (car alist)) - (setq alist (cdr alist)))))) - (defun riece-identity-assign-binding (item list binding) - (let ((slot (riece-identity-member-safe item binding)) + (let ((slot (riece-identity-member item binding)) pointer) (unless list ;we need at least one room (setq list (list nil))) @@ -208,11 +127,43 @@ The only difference with `riece-identity-assoc', this function uses (setcar pointer item) list)) -(defun riece-current-nickname () - "Return the current nickname." - (riece-with-server-buffer - (if riece-real-nickname - (riece-make-identity riece-real-nickname)))) +(defmacro riece-with-identity-buffer (identity &rest body) + `(let ((process (riece-server-process (riece-identity-server ,identity)))) + (if process + (with-current-buffer (process-buffer process) + ,@body) + (error "Server closed.")))) + +(put 'riece-with-identity-buffer 'lisp-indent-function 1) + +(defun riece-decode-identity (identity &optional prefix-only) + (riece-with-identity-buffer identity + (let ((prefix (riece-decode-coding-string + (riece-identity-prefix identity))) + (server (riece-identity-server identity))) + (if (equal server "") + prefix + (concat prefix " " server))))) + +(defun riece-encode-identity (string) + (let ((prefix (if (string-match " " string) + (substring string 0 (match-beginning 0)) + string)) + (server (if (string-match " " string) + (substring string (match-end 0)) + ""))) + (riece-with-server-buffer server + (riece-make-identity (riece-encode-coding-string prefix) server)))) + +(defun riece-completing-read-identity (prompt table + &optional predicate must-match) + (riece-encode-identity + (completing-read + prompt + (mapcar (lambda (channel) + (list (riece-decode-identity channel))) + table) + predicate must-match))) (provide 'riece-identity) diff --git a/lisp/riece-message.el b/lisp/riece-message.el index 073710c..661909c 100644 --- a/lisp/riece-message.el +++ b/lisp/riece-message.el @@ -85,11 +85,10 @@ (defun riece-message-make-name (message) "Makes local identity for MESSAGE." - (riece-identity-prefix - (if (and (riece-message-private-p message) - (riece-message-own-p message)) - (riece-message-target message) - (riece-message-speaker message)))) + (if (and (riece-message-private-p message) + (riece-message-own-p message)) + (riece-identity-prefix (riece-message-target message)) + (riece-identity-prefix (riece-message-speaker message)))) (defun riece-message-make-global-name (message) "Makes global identity for MESSAGE." @@ -97,7 +96,7 @@ (if (riece-message-own-p message) (riece-identity-prefix (riece-message-target message)) (riece-identity-prefix (riece-message-speaker message))) - (concat (riece-identity-prefix (riece-message-target message)) ":" + (concat (riece-decode-identity (riece-message-target message) t) ":" (riece-identity-prefix (riece-message-speaker message))))) (defun riece-message-buffer (message) @@ -107,16 +106,15 @@ (riece-current-nickname)) (riece-message-speaker message) (riece-message-target message))) - (entry (riece-identity-assoc target riece-channel-buffer-alist))) - (unless entry + (buffer (riece-channel-buffer-name target))) + (unless (get-buffer buffer) (riece-join-channel target) ;; If you are not joined any channel, ;; switch to the target immediately. (unless riece-current-channel (riece-switch-to-channel target)) - (riece-redisplay-buffers) - (setq entry (riece-identity-assoc target riece-channel-buffer-alist))) - (cdr entry))) + (riece-redisplay-buffers)) + buffer)) (defun riece-message-parent-buffers (message buffer) "Return the parents of BUFFER where MESSAGE should appear. @@ -193,7 +191,8 @@ Currently possible values are `action' and `notice'." (defun riece-message-private-p (message) "Return t if MESSAGE is a private message." (if (riece-message-own-p message) - (not (riece-channel-p (riece-message-target message))) + (not (riece-channel-p (riece-identity-prefix + (riece-message-target message)))) (riece-identity-equal (riece-message-target message) (riece-current-nickname)))) @@ -201,9 +200,13 @@ Currently possible values are `action' and `notice'." (defun riece-message-external-p (message) "Return t if MESSAGE is from outside the channel." (not (riece-identity-member - (riece-message-target message) - (mapcar #'riece-make-identity - (riece-user-get-channels (riece-message-speaker message)))))) + (riece-message-speaker message) + (let ((target (riece-message-target message))) + (riece-with-identity-buffer target + (mapcar + (lambda (user) + (riece-make-identity user (riece-identity-server target))) + (riece-channel-get-users (riece-identity-prefix target)))))))) (defun riece-own-channel-message (message &optional channel type) "Display MESSAGE as you sent to CHNL." diff --git a/lisp/riece-misc.el b/lisp/riece-misc.el index 9d2d735..6b04b3e 100644 --- a/lisp/riece-misc.el +++ b/lisp/riece-misc.el @@ -29,6 +29,7 @@ (require 'riece-identity) (require 'riece-version) (require 'riece-channel) +(require 'riece-server) (require 'riece-user) (defun riece-get-buffer-create (name) @@ -78,16 +79,11 @@ (with-current-buffer buffer (eq riece-freeze 'own))) -(defun riece-process-send-string (process string) - (with-current-buffer (process-buffer process) - (process-send-string process (riece-encode-coding-string string)))) - -(defun riece-send-string (string) - (let ((process (riece-find-server-process))) - (unless process - (error "%s" (substitute-command-keys - "Type \\[riece-command-open-server] to open server."))) - (riece-process-send-string process string))) +(defun riece-current-nickname () + "Return the current nickname." + (riece-with-server-buffer (riece-identity-server riece-current-channel) + (if riece-real-nickname + (riece-make-identity riece-real-nickname riece-server-name)))) (defun riece-split-parameters (string) (if (eq ?: (aref string 0)) @@ -104,19 +100,19 @@ (setq parameters (nconc parameters (list string)))) parameters))) -(defun riece-concat-modes (target string) - (let ((modes - (if (riece-channel-p target) - (riece-channel-get-modes target) - (riece-user-get-modes target)))) - (if modes - (concat string " [" (apply #'string modes) "]") - string))) +(defun riece-concat-channel-topic (target string) + (riece-with-identity-buffer target + (let ((topic (riece-channel-get-topic (riece-identity-prefix target)))) + (if topic + (concat string ": " topic) + string)))) -(defsubst riece-concat-current-channel-modes (string) - (if riece-current-channel - (riece-concat-modes riece-current-channel string) - string)) +(defun riece-concat-channel-modes (target string) + (riece-with-identity-buffer target + (let ((modes (riece-channel-get-modes (riece-identity-prefix target)))) + (if modes + (concat string " [" (apply #'string modes) "]") + string)))) (defun riece-concat-message (string message) (if (or (null message) @@ -125,10 +121,9 @@ (concat string " (" message ")"))) (defun riece-concat-server-name (string) - (riece-with-server-buffer - (if riece-server-name - (concat string " (from " riece-server-name ")") - string))) + (if (equal riece-server-name "") + string + (concat string " (from " riece-server-name ")"))) (defun riece-prefix-user-at-host (prefix) (if (string-match "!" prefix) @@ -159,16 +154,16 @@ user-at-host)) (defun riece-get-users-on-server () - (riece-with-server-buffer - (let (users) - (mapatoms - (lambda (atom) - (unless (riece-channel-p (symbol-name atom)) - (setq users (cons (symbol-name atom) users)))) - riece-obarray) - (if (member riece-real-nickname users) - users - (cons riece-real-nickname users))))) + (riece-with-server-buffer (riece-identity-server riece-current-channel) + (let (users) + (mapatoms + (lambda (atom) + (unless (riece-channel-p (symbol-name atom)) + (setq users (cons (symbol-name atom) users)))) + riece-obarray) + (if (member riece-real-nickname users) + users + (cons riece-real-nickname users))))) (provide 'riece-misc) diff --git a/lisp/riece-naming.el b/lisp/riece-naming.el index 51f8029..0bfc08b 100644 --- a/lisp/riece-naming.el +++ b/lisp/riece-naming.el @@ -31,25 +31,21 @@ (defun riece-naming-assert-join (user-name channel-name) (if (riece-identity-equal-no-server user-name riece-real-nickname) - (riece-join-channel channel-name)) + (riece-join-channel (riece-make-identity channel-name + riece-server-name))) (riece-user-toggle-channel user-name channel-name t) (riece-channel-toggle-user channel-name user-name t)) (defun riece-naming-assert-part (user-name channel-name) (if (riece-identity-equal-no-server user-name riece-real-nickname) (progn - (riece-part-channel channel-name) + (riece-part-channel (riece-make-identity channel-name + riece-server-name)) (riece-forget-channel channel-name)) (riece-user-toggle-channel user-name channel-name nil) (riece-channel-toggle-user channel-name user-name nil) (riece-channel-toggle-operator channel-name user-name nil) - (riece-channel-toggle-speaker channel-name user-name nil) - (if (riece-identity-equal-safe user-name (riece-current-nickname)) - (let* ((identity (riece-make-identity channel-name)) - (pointer (riece-identity-member-safe - identity riece-current-channels))) - (if pointer - (setcar pointer nil)))))) + (riece-channel-toggle-speaker channel-name user-name nil))) (defun riece-naming-assert-rename (old-name new-name) (if (riece-identity-equal-no-server old-name riece-real-nickname) diff --git a/lisp/riece-options.el b/lisp/riece-options.el index aa86dbb..333fd5c 100644 --- a/lisp/riece-options.el +++ b/lisp/riece-options.el @@ -68,11 +68,6 @@ :type '(repeat integer) :group 'riece-looks) -(defcustom riece-inhibit-startup-message nil - "If non-nil, the startup message will not be displayed." - :group 'riece-looks - :type 'boolean) - (defcustom riece-directory "~/.riece" "Where to look for data files." :type 'directory @@ -182,11 +177,6 @@ way is to put Riece variables on .emacs or file loaded from there." :type 'string :group 'riece-server) -(defcustom riece-startup-channel-list nil - "A list of channels to join automatically at startup." - :type '(repeat (string :tag "Startup Channel")) - :group 'riece-channel) - (defcustom riece-retry-with-new-nickname nil "When nickname has already been in use, grow-tail automatically." :type 'boolean diff --git a/lisp/riece-rdcc.el b/lisp/riece-rdcc.el index 5b4e891..f984d23 100644 --- a/lisp/riece-rdcc.el +++ b/lisp/riece-rdcc.el @@ -265,9 +265,8 @@ puts(\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" (port (string-to-number (match-string 3 message))) (size (string-to-number (match-string 4 message))) (buffer (if (riece-channel-p target) - (cdr (riece-identity-assoc - (riece-make-identity target) - riece-channel-buffer-alist)))) + (riece-channel-buffer-name + (riece-make-identity target riece-server-name)))) (user (riece-prefix-nickname prefix))) (setq riece-rdcc-requests (cons (list user file address port size) @@ -284,7 +283,7 @@ puts(\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{" user (riece-strip-user-at-host (riece-prefix-user-at-host prefix)) - target)) + (riece-decode-coding-string target))) "\n"))) t))) diff --git a/lisp/riece-server.el b/lisp/riece-server.el index 20aedf8..c5a016a 100644 --- a/lisp/riece-server.el +++ b/lisp/riece-server.el @@ -26,10 +26,7 @@ (require 'riece-options) (require 'riece-globals) ;for server local variables. -(require 'riece-misc) ;riece-process-send-string, etc. (require 'riece-coding) ;riece-default-coding-system -(require 'riece-identity) -(require 'riece-display) (eval-and-compile (defvar riece-server-keyword-map @@ -69,12 +66,14 @@ the `riece-server-keyword-map' variable." (buffer-live-p (car riece-buffer-list))) (funcall riece-buffer-dispose-function (car riece-buffer-list))) (setq riece-buffer-list (cdr riece-buffer-list))) - (setq riece-channel-buffer-alist nil - riece-user-list-buffer-alist nil - riece-current-channels nil + (setq riece-current-channels nil riece-current-channel nil + riece-user-indicator nil riece-channel-indicator "None" - riece-channel-list-indicator "No channel") + riece-channel-list-indicator "No channel" + riece-away-indicator "-" + riece-operator-indicator "-" + riece-freeze-indicator "-") (delete-other-windows)) (defun riece-server-parse-string (string) @@ -102,19 +101,55 @@ the `riece-server-keyword-map' variable." riece-save-variables-are-dirty t)) (cdr entry))) -(defun riece-open-server (server &optional server-name) - (if server-name - (message "Connecting to %s..." server-name) - (message "Connecting to IRC server...")) +(defun riece-find-server-name () + (or riece-overriding-server-name + ;already in the server buffer + (if (local-variable-p 'riece-server-name (current-buffer)) + riece-server-name + (if riece-current-channel + (riece-identity-server riece-current-channel) + (if (riece-server-opened "") + ""))))) + +(defun riece-server-process-name (server-name) + (if (equal server-name "") + "IRC" + (format "IRC<%s>" server-name))) + +(defun riece-server-process (server-name) + (get-process (riece-server-process-name server-name))) + +(defmacro riece-with-server-buffer (server-name &rest body) + `(let ((process (riece-server-process ,server-name))) + (if process + (with-current-buffer (process-buffer process) + ,@body) + (error "Server closed.")))) + +(put 'riece-with-server-buffer 'lisp-indent-function 1) + +(defun riece-process-send-string (process string) + (with-current-buffer (process-buffer process) + (process-send-string process (riece-encode-coding-string string)))) + +(defun riece-send-string (string) + (let ((process (riece-server-process (riece-find-server-name)))) + (unless process + (error "%s" (substitute-command-keys + "Type \\[riece-command-open-server] to open server."))) + (riece-process-send-string process string))) + +(defun riece-open-server (server server-name) + (if (equal server-name "") + (message "Connecting to IRC server...") + (message "Connecting to %s..." server-name)) (riece-server-keyword-bind server (let* (selective-display (coding-system-for-read 'binary) (coding-system-for-write 'binary) (process - (funcall function "IRC" - (if server-name - (format " *IRC*%s" server-name) - " *IRC*") + (funcall function (riece-server-process-name server-name) + (concat " *IRC*" server-name) host service))) (riece-reset-process-buffer process) (with-current-buffer (process-buffer process) @@ -138,14 +173,11 @@ the `riece-server-keyword-map' variable." (setq riece-last-nickname riece-real-nickname riece-nick-accepted 'sent riece-coding-system coding)) - (if server-name - (setq riece-server-process-alist - (cons (cons server-name process) - riece-server-process-alist)) - (setq riece-server-process process)))) - (if server-name - (message "Connecting to %s...done" server-name) - (message "Connecting to IRC server...done"))) + (setq riece-process-list + (cons process riece-process-list)))) + (if (equal server-name "") + (message "Connecting to IRC server...done") + (message "Connecting to %s...done" server-name))) (defun riece-reset-process-buffer (process) (save-excursion @@ -172,71 +204,19 @@ the `riece-server-keyword-map' variable." (buffer-disable-undo) (erase-buffer))) -(defun riece-close-server-process (process &optional quit-message) - (if (eq 'riece-filter (process-filter process)) - (set-process-filter process nil)) - (if (eq 'riece-sentinel (process-sentinel process)) - (set-process-sentinel process nil)) - (if (memq (process-status process) '(open run)) - (riece-process-send-string process - (if quit-message - (format "QUIT :%s\r\n" quit-message) - "QUIT\r\n"))) +(defun riece-close-server-process (process) (if riece-debug (delete-process process) - (kill-buffer (process-buffer process)))) - -(eval-when-compile - (autoload 'riece-exit "riece")) -(defun riece-close-server (server-name &optional quit-message) - ;; Remove channels which belong to the server. - (let ((riece-overriding-server-name server-name) - (channels riece-current-channels)) - (while channels - (if (and (car channels) - (equal (riece-identity-server (car channels)) - server-name)) - (riece-part-channel (car channels))) - (setq channels (cdr channels))) - (riece-redisplay-buffers)) - ;; Close now. - (let (process) - (if server-name - (let ((entry (assoc server-name riece-server-process-alist))) - (setq process (cdr entry) - riece-server-process-alist - (delq entry riece-server-process-alist))) - (setq process riece-server-process - riece-server-process nil)) - (riece-close-server-process process quit-message) - ;; If no server process is available, exit. - (if (and (null riece-server-process) - (null riece-server-process-alist)) - (riece-exit)))) - -(defun riece-close-all-server (&optional quit-message) - (let ((process-list - (delq nil (cons riece-server-process - (mapcar #'cdr riece-server-process-alist))))) - (while process-list - (riece-close-server-process (car process-list) quit-message) - (setq process-list (cdr process-list))) - (setq riece-server-process nil - riece-server-process-alist nil) - (riece-exit))) + (kill-buffer (process-buffer process))) + (setq riece-process-list (delq process riece-process-list))) (defun riece-server-opened (&optional server-name) - (let ((processes - (delq nil - (if server-name - (cdr (assoc server-name riece-server-process-alist)) - (cons riece-server-process - (mapcar #'cdr riece-server-process-alist)))))) + (let ((process-list riece-process-list)) (catch 'found - (while processes - (if (memq (process-status (car processes)) '(open run)) + (while process-list + (if (memq (process-status (car process-list)) '(open run)) (throw 'found t)) - (setq processes (cdr processes)))))) + (setq process-list (cdr process-list)))))) (provide 'riece-server) diff --git a/lisp/riece-unread.el b/lisp/riece-unread.el index d2e3100..97e165e 100644 --- a/lisp/riece-unread.el +++ b/lisp/riece-unread.el @@ -62,7 +62,9 @@ (let ((channel (match-string 3))) (replace-match (concat "\\1" - (if (member channel riece-unread-channels) + (if (member (save-match-data + (riece-encode-identity channel)) + riece-unread-channels) "!" " ") "\\3")))) diff --git a/lisp/riece-user.el b/lisp/riece-user.el index 323e276..811867d 100644 --- a/lisp/riece-user.el +++ b/lisp/riece-user.el @@ -31,54 +31,43 @@ ;;; User object: (defun riece-find-user (name) "Get a user object named NAME from the server buffer." - (riece-with-server-buffer - (let ((symbol (intern-soft (riece-identity-canonicalize-prefix - (riece-identity-prefix name)) - riece-obarray))) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name) + riece-obarray))) (if symbol - (symbol-value symbol))))) + (symbol-value symbol)))) (defun riece-forget-user (name) - (riece-with-server-buffer - (let ((symbol (intern-soft (riece-identity-canonicalize-prefix - (riece-identity-prefix name))))) - (when symbol - (makunbound symbol) - (unintern (symbol-name symbol) riece-obarray))))) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name)))) + (when symbol + (makunbound symbol) + (unintern (symbol-name symbol) riece-obarray)))) (defun riece-rename-user (old-name new-name) - (riece-with-server-buffer - (unless (equal (riece-identity-canonicalize-prefix - (riece-identity-prefix old-name)) - (riece-identity-canonicalize-prefix - (riece-identity-prefix new-name))) - (let ((symbol (intern-soft (riece-identity-canonicalize-prefix - (riece-identity-prefix old-name)) - riece-obarray))) - (when symbol - (set (intern (riece-identity-canonicalize-prefix - (riece-identity-prefix new-name)) - riece-obarray) - (symbol-value symbol)) - (makunbound symbol) - (unintern (symbol-name symbol) riece-obarray)))))) - -(defun riece-make-user (&optional channels user-at-host modes away operator) + (unless (equal (riece-identity-canonicalize-prefix old-name) + (riece-identity-canonicalize-prefix new-name)) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix old-name) + riece-obarray))) + (when symbol + (set (intern (riece-identity-canonicalize-prefix new-name) + riece-obarray) + (symbol-value symbol)) + (makunbound symbol) + (unintern (symbol-name symbol) riece-obarray))))) + +(defun riece-make-user (channels user-at-host modes away operator) "Make an instance of user object. Arguments are appropriate to joined channels, user-at-host, mode, and away status, respectively." (vector channels user-at-host modes away operator)) (defun riece-get-user (name) - (riece-with-server-buffer - (let ((symbol (intern-soft (riece-identity-canonicalize-prefix - (riece-identity-prefix name)) - riece-obarray))) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name) + riece-obarray))) (if symbol (symbol-value symbol) - (set (intern (riece-identity-canonicalize-prefix - (riece-identity-prefix name)) riece-obarray) - (riece-make-user)))))) + (set (intern (riece-identity-canonicalize-prefix name) + riece-obarray) + (riece-make-user nil nil nil nil nil))))) (defun riece-user-channels (user) "Return joined channels of USER." @@ -120,29 +109,24 @@ away status, respectively." "Set the operator status of USER to VALUE." (aset user 4 value)) -(defun riece-user-get-channels (&optional name) - (riece-user-channels - (riece-get-user (or name riece-real-nickname)))) +(defun riece-user-get-channels (name) + (riece-user-channels (riece-get-user name))) -(defun riece-user-get-user-at-host (&optional name) - (riece-user-user-at-host - (riece-get-user (or name riece-real-nickname)))) +(defun riece-user-get-user-at-host (name) + (riece-user-user-at-host (riece-get-user name))) -(defun riece-user-get-modes (&optional name) - (riece-user-modes - (riece-get-user (or name riece-real-nickname)))) +(defun riece-user-get-modes (name) + (riece-user-modes (riece-get-user name))) -(defun riece-user-get-away (&optional name) - (riece-user-away - (riece-get-user (or name riece-real-nickname)))) +(defun riece-user-get-away (name) + (riece-user-away (riece-get-user name))) -(defun riece-user-get-operator (&optional name) - (riece-user-operator - (riece-get-user (or name riece-real-nickname)))) +(defun riece-user-get-operator (name) + (riece-user-operator (riece-get-user name))) (defun riece-user-toggle-channel (name channel flag) "Add or remove the joined channel of user." - (let* ((user (riece-get-user (or name (riece-current-nickname)))) + (let* ((user (riece-get-user name)) (channels (riece-user-channels user))) (if flag (unless (member channel channels) @@ -152,7 +136,7 @@ away status, respectively." (defun riece-user-toggle-mode (name mode flag) "Add or remove user MODE of user." - (let* ((user (riece-get-user (or name (riece-current-nickname)))) + (let* ((user (riece-get-user name)) (modes (riece-user-modes user))) (if flag (unless (memq mode modes) @@ -161,12 +145,10 @@ away status, respectively." (riece-user-set-modes user (delq mode modes)))))) (defun riece-user-toggle-away (name flag) - (riece-user-set-away - (riece-get-user (or name (riece-current-nickname))) flag)) + (riece-user-set-away (riece-get-user name) flag)) (defun riece-user-toggle-operator (name flag) - (riece-user-set-operator - (riece-get-user (or name (riece-current-nickname))) flag)) + (riece-user-set-operator (riece-get-user name) flag)) (provide 'riece-user) diff --git a/lisp/riece.el b/lisp/riece.el index 11303ef..4493f41 100644 --- a/lisp/riece.el +++ b/lisp/riece.el @@ -255,16 +255,9 @@ If already connected, just pop up the windows." (setq riece-server (completing-read "Server: " riece-server-alist))) (if (stringp riece-server) (setq riece-server (riece-server-name-to-server riece-server))) - (riece-open-server riece-server) (riece-create-buffers) (riece-configure-windows) - (let ((channel-list riece-startup-channel-list)) - (while channel-list - (if (listp (car channel-list)) - (riece-command-join (car (car channel-list)) - (cadr (car channel-list))) - (riece-command-join (car channel-list))) - (setq channel-list (cdr channel-list)))) + (riece-open-server riece-server "") (run-hooks 'riece-startup-hook) (message "%s" (substitute-command-keys "Type \\[describe-mode] for help")))) @@ -298,7 +291,7 @@ For a list of the generic commands type \\[riece-command-generic] ? RET. " " riece-user-indicator " " - riece-current-channel))) + riece-short-channel-indicator))) (riece-simplify-mode-line-format) (use-local-map riece-command-mode-map) @@ -337,7 +330,6 @@ Instead, these commands are available: riece-channel-list-indicator " ")) buffer-read-only t tab-stop-list riece-tab-stop-list) - (riece-update-status-indicators) (riece-simplify-mode-line-format) (use-local-map riece-dialogue-mode-map) (buffer-disable-undo) -- 1.7.10.4