* riece-options.el (riece-channel-history-length): New user option.
[riece] / lisp / riece-server.el
index b80d333..25d67a4 100644 (file)
 
 (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)
+(require 'riece-compat)
 
 (eval-and-compile
   (defvar riece-server-keyword-map
@@ -39,7 +38,7 @@
       (:username riece-username)
       (:password)
       (:function #'open-network-stream)
-      (:coding-system riece-default-coding-system))
+      (:coding riece-default-coding-system))
     "Mapping from keywords to default values.
 All keywords that can be used must be listed here."))
 
@@ -63,29 +62,6 @@ the `riece-server-keyword-map' variable."
 (put 'riece-server-keyword-bind 'lisp-indent-function 1)
 (put 'riece-server-keyword-bind 'edebug-form-spec '(form body))
 
-(defun riece-start-server (server &optional server-name)
-  (if server-name
-      (message "Connecting to IRC server on %s..." server-name)
-    (message "Connecting to IRC server..."))
-  (prog1 (riece-open-server server server-name)
-    (if server-name
-       (message "Connecting to IRC server on %s...done" server-name)
-      (message "Connecting to IRC server...done"))))
-
-(defun riece-clear-system ()
-  (while riece-buffer-list
-    (if (and (get-buffer (car riece-buffer-list))
-            (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
-       riece-current-channel nil
-       riece-channel-indicator "None"
-       riece-channel-list-indicator "No channel")
-  (delete-other-windows))
-
 (defun riece-server-parse-string (string)
   "Convert a STRING set as `riece-server' and return a property list."
   (when (or (string-match "^\\[\\([^]]+\\)\\]:?\\([0-9]*\\)" string)
@@ -111,20 +87,58 @@ the `riece-server-keyword-map' variable."
            riece-save-variables-are-dirty t))
     (cdr entry)))
 
+(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* ((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 "")
+                     "")))))
+        (process (riece-server-process 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"
-                    (get-buffer-create
-                     (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)
-      (setq riece-server-name server-name)
+      (with-current-buffer (process-buffer process)
+       (setq riece-server-name server-name))
       (set-process-sentinel process 'riece-sentinel)
       (set-process-filter process 'riece-filter)
       (if (or password
@@ -143,8 +157,12 @@ the `riece-server-keyword-map' variable."
       (with-current-buffer (process-buffer process)
        (setq riece-last-nickname riece-real-nickname
              riece-nick-accepted 'sent
-             riece-coding-system coding-system))
-      process)))
+             riece-coding-system coding))
+      (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
@@ -171,71 +189,30 @@ 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))
-  (when (memq (process-status process) '(open run))
-    (riece-process-send-string process
-                              (if quit-message
-                                  (format "QUIT :%s\r\n" quit-message)
-                                "QUIT\r\n"))
-    (unless riece-debug
-      (kill-buffer (process-buffer process))))
-  (delete-process 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)))
+(defun riece-close-server-process (process)
+  (if riece-debug
+      (delete-process process)
+    (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))))))
+
+(defun riece-quit-server-process (process &optional message)
+  (run-at-time riece-quit-timeout nil
+              (lambda (process)
+                (if (memq process riece-process-list)
+                    (kill-process (process-buffer process))))
+              process)
+  (riece-process-send-string process
+                            (if message
+                                (format "QUIT :%s\r\n" message)
+                              "QUIT\r\n")))
 
 (provide 'riece-server)