* riece-button.el (riece-button-requires): Abolish.

[riece] / lisp / riece-server.el

diff --git a/lisp/riece-server.el b/lisp/riece-server.el
index 859cf1e..c552180 100644 (file)
--- a/lisp/riece-server.el
+++ b/lisp/riece-server.el
@@ -26,10 +26,9 @@
 
 (require 'riece-options)
 (require 'riece-globals)               ;for server local variables.
 
 (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-coding)                        ;riece-default-coding-system
 (require 'riece-identity)

-(require 'riece-display)
+(require 'riece-compat)

 
 (eval-and-compile
   (defvar riece-server-keyword-map
 
 (eval-and-compile
   (defvar riece-server-keyword-map


@@ -38,8 +37,8 @@
       (:nickname riece-nickname)
       (:username riece-username)
       (:password)
       (:nickname riece-nickname)
       (:username riece-username)
       (:password)

-      (:function #'open-network-stream)
-      (:coding-system riece-default-coding-system))
+      (:function riece-default-open-connection-function)
+      (:coding riece-default-coding-system))

     "Mapping from keywords to default values.
 All keywords that can be used must be listed here."))
 
     "Mapping from keywords to default values.
 All keywords that can be used must be listed here."))
 


@@ -63,32 +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))
 
 (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)
-  "Open network stream to remote irc server.
-If optional argument CONFIRM is non-nil, ask the host that the server
-is running on."
-  (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)
 (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)


@@ -114,30 +87,84 @@ is running on."
            riece-save-variables-are-dirty t))
     (cdr entry)))
 
            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)
+  (cdr (assoc server-name riece-server-process-alist)))
+
+(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)
+(put 'riece-with-server-buffer 'edebug-form-spec '(form body))
+
+(defun riece-process-send-string (process string)
+  (with-current-buffer (process-buffer process)
+    (process-send-string process (riece-encode-coding-string string))))
+
+(defun riece-current-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-send-string (string)
+  (let* ((server-name (riece-current-server-name))
+        (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)
 (defun riece-open-server (server server-name)

-  "Open chat server on HOST.
-If HOST is nil, use value of environment variable \"IRCSERVER\".
-If optional argument SERVICE is non-nil, open by the service name."

   (riece-server-keyword-bind server
   (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*")
-                    host service)))
+    (let (selective-display
+         (coding-system-for-read 'binary)
+         (coding-system-for-write 'binary)
+         process)
+      (if (equal server-name "")
+         (message "Connecting to IRC server...")
+       (message "Connecting to %s..." server-name))
+      (setq process
+           (funcall function (riece-server-process-name server-name)
+                    (concat " *IRC*" server-name)
+                    host service))
+      (if (equal server-name "")
+         (message "Connecting to IRC server...done")
+       (message "Connecting to %s...done" server-name))

       (riece-reset-process-buffer process)
       (riece-reset-process-buffer process)

+      (with-current-buffer (process-buffer process)
+       (setq riece-server-name server-name))

       (set-process-sentinel process 'riece-sentinel)
       (set-process-filter process 'riece-filter)
       (set-process-sentinel process 'riece-sentinel)
       (set-process-filter process 'riece-filter)

-      (if (or password
-             riece-reconnect-with-password)
+      (if (equal server-name "")
+         (message "Logging in to IRC server...")
+       (message "Logging in to %s..." server-name))
+      (if riece-reconnect-with-password        ;password incorrect or not set.
+         (unwind-protect
+             ;; XEmacs signals an error when the keyboard cannot be grabbed.
+             (condition-case nil
+                 (setq password
+                       (if (equal server-name "")
+                           (riece-read-passwd "Password: ")
+                         (riece-read-passwd (format "Password for %s: "
+                                                    server-name))))
+               (error))
+           (setq riece-reconnect-with-password nil)))
+      (if password

          (riece-process-send-string process
          (riece-process-send-string process

-                                    (format "PASS %s\r\n"
-                                            (or password
-                                                (riece-read-passwd
-                                                 "Password: ")))))
-      (setq riece-reconnect-with-password nil)
+                                    (format "PASS %s\r\n" password)))

       (riece-process-send-string process
                                 (format "USER %s * * :%s\r\n"
                                         (user-real-login-name)
       (riece-process-send-string process
                                 (format "USER %s * * :%s\r\n"
                                         (user-real-login-name)


@@ -147,8 +174,10 @@ If optional argument SERVICE is non-nil, open by the service name."
       (with-current-buffer (process-buffer process)
        (setq riece-last-nickname riece-real-nickname
              riece-nick-accepted 'sent
       (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-server-process-alist
+           (cons (cons server-name process)
+                 riece-server-process-alist)))))

 
 (defun riece-reset-process-buffer (process)
   (save-excursion
 
 (defun riece-reset-process-buffer (process)
   (save-excursion


@@ -175,71 +204,45 @@ If optional argument SERVICE is non-nil, open by the service name."
     (buffer-disable-undo)
     (erase-buffer)))
 
     (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"))
-    (delete-process process)
-    (unless riece-debug
-      (kill-buffer (process-buffer process)))))
+(defun riece-close-server-process (process)
+  (if riece-debug
+      (delete-process process)
+    (kill-buffer (process-buffer process)))
+  (setq riece-server-process-alist
+       (delq (rassq process riece-server-process-alist)
+             riece-server-process-alist)))

 
 

-(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-server-process-opened (process)
+  (not (null (memq (process-status process) '(open run)))))

 
 (defun riece-server-opened (&optional server-name)
 
 (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))))))
-    (catch 'found
-      (while processes
-       (if (memq (process-status (car processes)) '(open run))
-           (throw 'found t))
-       (setq processes (cdr processes))))))
+  (if server-name
+      (let ((process (riece-server-process server-name)))
+       (and process
+            (riece-server-process-opened process)))
+    (let ((alist riece-server-process-alist))
+      (catch 'found
+       (while alist
+         (if (riece-server-process-opened (cdr (car alist)))
+             (throw 'found t))
+         (setq alist (cdr alist)))))))
+
+(eval-when-compile
+  (autoload 'riece-exit "riece"))
+(defun riece-quit-server-process (process &optional message)
+  (if riece-quit-timeout
+      (riece-run-at-time riece-quit-timeout nil
+                        (lambda (process)
+                          (when (rassq process riece-server-process-alist)
+                            (riece-close-server-process process)
+                            ;; If no server process is available, exit.
+                            (unless riece-server-process-alist
+                              (riece-exit))))
+                        process))
+  (riece-process-send-string process
+                            (if message
+                                (format "QUIT :%s\r\n" message)
+                              "QUIT\r\n")))

 
 (provide 'riece-server)
 
 
 (provide 'riece-server)