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)
68 (message "Connecting to IRC server on %s..." server-name)
69 (message "Connecting to IRC server..."))
70 (prog1 (riece-open-server server server-name)
72 (message "Connecting to IRC server on %s...done" server-name)
73 (message "Connecting to IRC server...done"))))
75 (defun riece-clear-system ()
76 (while riece-buffer-list
77 (if (and (get-buffer (car riece-buffer-list))
78 (buffer-live-p (car riece-buffer-list)))
79 (funcall riece-buffer-dispose-function (car riece-buffer-list)))
80 (setq riece-buffer-list (cdr riece-buffer-list)))
81 (setq riece-channel-buffer-alist nil
82 riece-user-list-buffer-alist nil
83 riece-current-channels nil
84 riece-current-channel nil
85 riece-channel-indicator "None"
86 riece-channel-list-indicator "No channel")
87 (delete-other-windows))
89 (defun riece-server-parse-string (string)
90 "Convert a STRING set as `riece-server' and return a property list."
91 (when (or (string-match "^\\[\\([^]]+\\)\\]:?\\([0-9]*\\)" string)
92 (string-match "^\\([^:]+\\):?\\([0-9]*\\)" string))
93 (let ((host (match-string 1 string))
94 (service (match-string 2 string))
95 (password (substring string (match-end 0)))
97 (setq plist (cons `(:host ,host) plist))
98 (unless (equal service "")
99 (setq plist (cons `(:service ,(string-to-int service)) plist)))
100 (unless (equal password "")
101 (setq plist (cons `(:password ,(substring password 1)) plist)))
102 (apply #'nconc plist))))
104 (defun riece-server-name-to-server (server-name)
105 (let ((entry (assoc server-name riece-server-alist)))
107 (unless (listp (cdr entry))
108 (setcdr entry (riece-server-parse-string (cdr entry))))
109 (setq entry (cons server-name (riece-server-parse-string server-name))
110 riece-server-alist (cons entry riece-server-alist)
111 riece-save-variables-are-dirty t))
114 (defun riece-open-server (server server-name)
115 (riece-server-keyword-bind server
116 (let* (selective-display
117 (coding-system-for-read 'binary)
118 (coding-system-for-write 'binary)
120 (funcall function "IRC"
123 (format " *IRC*%s" server-name)
126 (riece-reset-process-buffer process)
127 (setq riece-server-name server-name)
128 (set-process-sentinel process 'riece-sentinel)
129 (set-process-filter process 'riece-filter)
131 riece-reconnect-with-password)
132 (riece-process-send-string process
133 (format "PASS %s\r\n"
137 (riece-process-send-string process
138 (format "USER %s * * :%s\r\n"
139 (user-real-login-name)
141 "No information given")))
142 (riece-process-send-string process (format "NICK %s\r\n" nickname))
143 (with-current-buffer (process-buffer process)
144 (setq riece-last-nickname riece-real-nickname
145 riece-nick-accepted 'sent
146 riece-coding-system coding-system))
149 (defun riece-reset-process-buffer (process)
151 (set-buffer (process-buffer process))
152 (if (fboundp 'set-buffer-multibyte)
153 (set-buffer-multibyte nil))
154 (kill-all-local-variables)
155 (make-local-variable 'riece-real-nickname)
156 (make-local-variable 'riece-last-nickname)
157 (make-local-variable 'riece-nick-accepted)
158 (make-local-variable 'riece-real-server-name)
159 (make-local-variable 'riece-real-userhost)
160 (make-local-variable 'riece-user-at-host)
161 (make-local-variable 'riece-user-at-host-type)
162 (make-local-variable 'riece-supported-user-modes)
163 (make-local-variable 'riece-supported-channel-modes)
164 (make-local-variable 'riece-channel-filter)
165 (make-local-variable 'riece-server-name)
166 (make-local-variable 'riece-read-point)
167 (setq riece-read-point (point-min))
168 (make-local-variable 'riece-obarray)
169 (setq riece-obarray (make-vector riece-obarray-size 0))
170 (make-local-variable 'riece-coding-system)
171 (buffer-disable-undo)
174 (defun riece-close-server-process (process &optional quit-message)
175 (if (eq 'riece-filter (process-filter process))
176 (set-process-filter process nil))
177 (if (eq 'riece-sentinel (process-sentinel process))
178 (set-process-sentinel process nil))
179 (when (memq (process-status process) '(open run))
180 (riece-process-send-string process
182 (format "QUIT :%s\r\n" quit-message)
185 (kill-buffer (process-buffer process))))
186 (delete-process process))
189 (autoload 'riece-exit "riece"))
190 (defun riece-close-server (server-name &optional quit-message)
191 ;; Remove channels which belong to the server.
192 (let ((riece-overriding-server-name server-name)
193 (channels riece-current-channels))
195 (if (and (car channels)
196 (equal (riece-identity-server (car channels))
198 (riece-part-channel (car channels)))
199 (setq channels (cdr channels)))
200 (riece-redisplay-buffers))
204 (let ((entry (assoc server-name riece-server-process-alist)))
205 (setq process (cdr entry)
206 riece-server-process-alist
207 (delq entry riece-server-process-alist)))
208 (setq process riece-server-process
209 riece-server-process nil))
210 (riece-close-server-process process quit-message)
211 ;; If no server process is available, exit.
212 (if (and (null riece-server-process)
213 (null riece-server-process-alist))
216 (defun riece-close-all-server (&optional quit-message)
218 (delq nil (cons riece-server-process
219 (mapcar #'cdr riece-server-process-alist)))))
221 (riece-close-server-process (car process-list) quit-message)
222 (setq process-list (cdr process-list)))
223 (setq riece-server-process nil
224 riece-server-process-alist nil)
227 (defun riece-server-opened (&optional server-name)
231 (cdr (assoc server-name riece-server-process-alist))
232 (cons riece-server-process
233 (mapcar #'cdr riece-server-process-alist))))))
236 (if (memq (process-status (car processes)) '(open run))
238 (setq processes (cdr processes))))))
240 (provide 'riece-server)
242 ;;; riece-server.el ends here