1 ;;; riece-server.el --- functions to open and close servers
2 ;; Copyright (C) 1998-2003 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
6 ;; Keywords: IRC, riece
8 ;; This file is part of Riece.
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 (require 'riece-options)
28 (require 'riece-globals) ;for server local variables.
29 (require 'riece-misc) ;riece-process-send-string, etc.
30 (require 'riece-coding) ;riece-default-coding-system
31 (require 'riece-identity)
32 (require 'riece-display)
35 (defvar riece-server-keyword-map
38 (:nickname riece-nickname)
39 (:username riece-username)
41 (:function #'open-network-stream)
42 (:coding-system riece-default-coding-system))
43 "Mapping from keywords to default values.
44 All keywords that can be used must be listed here."))
46 (defmacro riece-server-keyword-bind (plist &rest body)
47 "Return a `let' form that binds all variables in PLIST.
48 After this is done, BODY will be executed in the scope
51 The variables bound and their default values are described by
52 the `riece-server-keyword-map' variable."
55 (list (intern (substring (symbol-name (car keyword)) 1))
57 `(or (plist-get ,plist ',(car keyword))
59 `(plist-get ,plist ',(car keyword)))))
60 riece-server-keyword-map)
63 (put 'riece-server-keyword-bind 'lisp-indent-function 1)
64 (put 'riece-server-keyword-bind 'edebug-form-spec '(form body))
66 (defun riece-start-server (server &optional server-name)
67 "Open network stream to remote irc server.
68 If optional argument CONFIRM is non-nil, ask the host that the server
71 (message "Connecting to IRC server on %s..." server-name)
72 (message "Connecting to IRC server..."))
73 (prog1 (riece-open-server server server-name)
75 (message "Connecting to IRC server on %s...done" server-name)
76 (message "Connecting to IRC server...done"))))
78 (defun riece-clear-system ()
79 (while riece-buffer-list
80 (if (and (get-buffer (car riece-buffer-list))
81 (buffer-live-p (car riece-buffer-list)))
82 (funcall riece-buffer-dispose-function (car riece-buffer-list)))
83 (setq riece-buffer-list (cdr riece-buffer-list)))
84 (setq riece-channel-buffer-alist nil
85 riece-user-list-buffer-alist nil
86 riece-current-channels nil
87 riece-current-channel nil
88 riece-channel-indicator "None"
89 riece-channel-list-indicator "No channel")
90 (delete-other-windows))
92 (defun riece-server-parse-string (string)
93 "Convert a STRING set as `riece-server' and return a property list."
94 (when (or (string-match "^\\[\\([^]]+\\)\\]:?\\([0-9]*\\)" string)
95 (string-match "^\\([^:]+\\):?\\([0-9]*\\)" string))
96 (let ((host (match-string 1 string))
97 (service (match-string 2 string))
98 (password (substring string (match-end 0)))
100 (push `(:host ,host) plist)
101 (unless (equal service "")
102 (push `(:service ,(string-to-int service)) plist))
103 (unless (equal password "")
104 (push `(:password ,(substring password 1)) plist))
105 (apply #'nconc plist))))
107 (defun riece-server-name-to-server (server-name)
108 (let ((entry (assoc server-name riece-server-alist)))
110 (unless (listp (cdr entry))
111 (setcdr entry (riece-server-parse-string (cdr entry))))
112 (setq entry (cons server-name (riece-server-parse-string server-name)))
113 (push entry riece-server-alist)
114 (setq riece-save-variables-are-dirty t))
117 (defun riece-open-server (server server-name)
118 "Open chat server on HOST.
119 If HOST is nil, use value of environment variable \"IRCSERVER\".
120 If optional argument SERVICE is non-nil, open by the service name."
121 (riece-server-keyword-bind server
122 (let* (selective-display
123 (coding-system-for-read 'binary)
124 (coding-system-for-write 'binary)
126 (funcall function "IRC" (if server-name
127 (format " *IRC*%s" server-name)
130 (riece-reset-process-buffer process)
131 (set-process-sentinel process 'riece-sentinel)
132 (set-process-filter process 'riece-filter)
134 riece-reconnect-with-password)
135 (riece-process-send-string process
136 (format "PASS %s\r\n"
140 (setq riece-reconnect-with-password nil)
141 (riece-process-send-string process
142 (format "USER %s * * :%s\r\n"
143 (user-real-login-name)
145 "No information given")))
146 (riece-process-send-string process (format "NICK %s\r\n" nickname))
147 (with-current-buffer (process-buffer process)
148 (setq riece-last-nickname riece-real-nickname
149 riece-nick-accepted 'sent
150 riece-coding-system coding-system))
153 (defun riece-reset-process-buffer (process)
155 (set-buffer (process-buffer process))
156 (if (fboundp 'set-buffer-multibyte)
157 (set-buffer-multibyte nil))
158 (kill-all-local-variables)
159 (make-local-variable 'riece-real-nickname)
160 (make-local-variable 'riece-last-nickname)
161 (make-local-variable 'riece-nick-accepted)
162 (make-local-variable 'riece-real-server-name)
163 (make-local-variable 'riece-real-userhost)
164 (make-local-variable 'riece-user-at-host)
165 (make-local-variable 'riece-user-at-host-type)
166 (make-local-variable 'riece-supported-user-modes)
167 (make-local-variable 'riece-supported-channel-modes)
168 (make-local-variable 'riece-channel-filter)
169 (make-local-variable 'riece-server-name)
170 (make-local-variable 'riece-read-point)
171 (setq riece-read-point (point-min))
172 (make-local-variable 'riece-obarray)
173 (setq riece-obarray (make-vector riece-obarray-size 0))
174 (make-local-variable 'riece-coding-system)
175 (buffer-disable-undo)
178 (defun riece-close-server-process (process &optional quit-message)
179 (if (eq 'riece-filter (process-filter process))
180 (set-process-filter process nil))
181 (if (eq 'riece-sentinel (process-sentinel process))
182 (set-process-sentinel process nil))
183 (when (memq (process-status process) '(open run))
184 (riece-process-send-string process
186 (format "QUIT :%s\r\n" quit-message)
188 (delete-process process)
190 (kill-buffer (process-buffer process)))))
193 (autoload 'riece-exit "riece"))
194 (defun riece-close-server (server-name &optional quit-message)
195 ;; Remove channels which belong to the server.
196 (let ((riece-overriding-server-name server-name)
197 (channels riece-current-channels))
199 (if (equal (riece-identity-server (car channels))
201 (riece-part-channel (car channels)))
202 (setq channels (cdr channels)))
203 (riece-redisplay-buffers))
207 (let ((entry (assoc server-name riece-server-process-alist)))
208 (setq process (cdr entry)
209 riece-server-process-alist
210 (delq entry riece-server-process-alist)))
211 (setq process riece-server-process
212 riece-server-process nil))
213 (riece-close-server-process process quit-message)
214 ;; If no server process is available, exit.
215 (if (and (null riece-server-process)
216 (null riece-server-process-alist))
219 (defun riece-close-all-server (&optional quit-message)
221 (delq nil (cons riece-server-process
222 (mapcar #'cdr riece-server-process-alist)))))
224 (riece-close-server-process (car process-list) quit-message)
225 (setq process-list (cdr process-list)))
226 (setq riece-server-process nil
227 riece-server-process-alist nil)
230 (defun riece-server-opened (&optional server-name)
234 (cdr (assoc server-name riece-server-process-alist))
235 (cons riece-server-process
236 (mapcar #'cdr riece-server-process-alist))))))
239 (if (memq (process-status (car processes)) '(open run))
241 (setq processes (cdr processes))))))
243 (provide 'riece-server)
245 ;;; riece-server.el ends here