* riece.el (riece-exit): Don't disable addons.
[riece] / lisp / riece-commands.el
index 0d42b6c..26eebba 100644 (file)
 (require 'riece-complete)
 (require 'riece-layout)
 (require 'riece-display)
-(require 'riece-version)
 (require 'riece-server)
 (require 'riece-misc)
 (require 'riece-identity)
 (require 'riece-message)
 
+(autoload 'derived-mode-class "derived")
+
 ;;; Channel movement:
 (defun riece-command-switch-to-channel (channel)
   (interactive (list (riece-completing-read-identity
                      "Channel/User: " riece-current-channels nil t)))
-  (unless (equal channel riece-current-channels)
-    (riece-switch-to-channel channel)
-    (riece-redisplay-buffers)))
+  (unless (equal channel riece-current-channel)
+    (riece-switch-to-channel channel)))
 
 (defun riece-command-switch-to-channel-by-number (number)
   (interactive
@@ -189,11 +189,10 @@ the layout to the selected layout-name."
      (riece-check-channel-commands-are-usable t)
      (list (completing-read
            "User: "
-           (mapcar #'list
-                   (riece-with-server-buffer
-                       (riece-identity-server riece-current-channel)
-                     (riece-channel-get-users
-                      (riece-identity-prefix riece-current-channel)))))
+           (riece-with-server-buffer
+               (riece-identity-server riece-current-channel)
+             (riece-channel-get-users (riece-identity-prefix
+                                       riece-current-channel))))
           (if current-prefix-arg
               (read-string "Message: ")))))
   (riece-send-string
@@ -253,7 +252,8 @@ the layout to the selected layout-name."
          (channel
           (if current-prefix-arg
               (riece-completing-read-identity
-               "Channel/User: " riece-current-channels)
+               "Channel/User: "
+               (riece-get-identities-on-server (riece-current-server-name)))
             (riece-check-channel-commands-are-usable t)
             riece-current-channel))
          (riece-overriding-server-name (riece-identity-server channel))
@@ -278,87 +278,67 @@ the layout to the selected layout-name."
   (interactive
    (progn
      (riece-check-channel-commands-are-usable t)
-     (let ((operators
-           (riece-with-server-buffer
-               (riece-identity-server riece-current-channel)
-             (riece-channel-get-operators
-              (riece-identity-prefix riece-current-channel))))
-          (completion-ignore-case t)
-          users)
-       (if current-prefix-arg
-          (setq users (riece-completing-read-multiple
-                       "Users"
-                       (mapcar #'list operators)))
-        (setq users (riece-completing-read-multiple
-                     "Users"
-                     (delq nil (mapcar
-                                (lambda (user)
-                                  (unless (member user operators)
-                                    (list user)))
-                                (riece-with-server-buffer
-                                    (riece-identity-server
-                                     riece-current-channel)
-                                  (riece-channel-get-users
-                                   (riece-identity-prefix
-                                    riece-current-channel))))))))
-       (list users current-prefix-arg))))
+     (let ((completion-ignore-case t))
+       (list (riece-completing-read-multiple
+             "Users"
+             (riece-with-server-buffer
+                 (riece-identity-server riece-current-channel)
+               (riece-channel-get-users (riece-identity-prefix
+                                        riece-current-channel)))
+             (if current-prefix-arg
+                 (lambda (user)
+                   (memq ?o (cdr user)))
+               (lambda (user)
+                 (not (memq ?o (cdr user))))))
+            current-prefix-arg))))
   (let (group)
     (while users
       (setq group (cons (car users) group)
            users (cdr users))
-      (if (or (= (length group) 3)
-             (null users))
-         (riece-send-string
-          (format "MODE %s %c%s %s\r\n"
-                  (riece-identity-prefix riece-current-channel)
-                  (if current-prefix-arg
-                      ?-
-                    ?+)
-                  (make-string (length group) ?o)
-                  (mapconcat #'identity group " ")))))))
+      (when (or (= (length group) 3)
+               (null users))
+       (riece-send-string
+        (format "MODE %s %c%s %s\r\n"
+                (riece-identity-prefix riece-current-channel)
+                (if current-prefix-arg
+                    ?-
+                  ?+)
+                (make-string (length group) ?o)
+                (mapconcat #'identity (nreverse group) " ")))
+       (setq group nil)))))
 
 (defun riece-command-set-speakers (users &optional arg)
   (interactive
    (progn
      (riece-check-channel-commands-are-usable t)
-     (let ((speakers
-           (riece-with-server-buffer
-               (riece-identity-server riece-current-channel)
-             (riece-channel-get-speakers
-              (riece-identity-prefix riece-current-channel))))
-          (completion-ignore-case t)
-          users)
-       (if current-prefix-arg
-          (setq users (riece-completing-read-multiple
-                       "Users"
-                       (mapcar #'list speakers)))
-        (setq users (riece-completing-read-multiple
-                     "Users"
-                     (delq nil (mapcar
-                                (lambda (user)
-                                  (unless (member user speakers)
-                                    (list user)))
-                                (riece-with-server-buffer
-                                    (riece-identity-server
-                                     riece-current-channel)
-                                  (riece-channel-get-users
-                                   (riece-identity-prefix
-                                    riece-current-channel))))))))
-       (list users current-prefix-arg))))
+     (let ((completion-ignore-case t))
+       (list (riece-completing-read-multiple
+             "Users"
+             (riece-with-server-buffer
+                 (riece-identity-server riece-current-channel)
+               (riece-channel-get-users (riece-identity-prefix
+                                         riece-current-channel)))
+             (if current-prefix-arg
+                 (lambda (user)
+                   (memq ?v (cdr user)))
+               (lambda (user)
+                 (not (memq ?v (cdr user))))))
+            current-prefix-arg))))
   (let (group)
     (while users
       (setq group (cons (car users) group)
            users (cdr users))
-      (if (or (= (length group) 3)
-             (null users))
-         (riece-send-string
-          (format "MODE %s %c%s %s\r\n"
-                  (riece-identity-prefix riece-current-channel)
-                  (if current-prefix-arg
-                      ?-
-                    ?+)
-                  (make-string (length group) ?v)
-                  (mapconcat #'identity group " ")))))))
+      (when (or (= (length group) 3)
+               (null users))
+       (riece-send-string
+        (format "MODE %s %c%s %s\r\n"
+                (riece-identity-prefix riece-current-channel)
+                (if current-prefix-arg
+                    ?-
+                  ?+)
+                (make-string (length group) ?v)
+                (mapconcat #'identity (nreverse group) " ")))
+       (setq group nil)))))
 
 (defun riece-command-send-message (message notice)
   "Send MESSAGE to the current channel."
@@ -437,8 +417,7 @@ the layout to the selected layout-name."
     (if pointer
        (riece-command-switch-to-channel (car pointer))
       (riece-join-channel target)
-      (riece-switch-to-channel target)
-      (riece-redisplay-buffers))))
+      (riece-switch-to-channel target))))
 
 (defun riece-command-join (target &optional key)
   (interactive
@@ -449,9 +428,11 @@ the layout to the selected layout-name."
                               riece-join-channel-candidate)))
                 (riece-completing-read-identity
                  (format "Channel/User (default %s): " default)
-                 riece-current-channels nil nil nil nil default))
+                 (riece-get-identities-on-server (riece-current-server-name))
+                 nil nil nil nil default))
             (riece-completing-read-identity
-             "Channel/User: " riece-current-channels)))
+             "Channel/User: "
+             (riece-get-identities-on-server (riece-current-server-name)))))
          key)
      (if (and current-prefix-arg
              (riece-channel-p (riece-identity-prefix target)))
@@ -495,8 +476,7 @@ the layout to the selected layout-name."
   (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))
+       (riece-part-channel target))
     (error "You are not talking with %s" target)))
 
 (defun riece-command-change-nickname (nickname)
@@ -507,48 +487,50 @@ the layout to the selected layout-name."
 (defun riece-command-scroll-down (lines)
   "Scroll LINES down dialogue buffer from command buffer."
   (interactive "P")
-  (let ((other-window-scroll-buffer
-        (if riece-channel-buffer-mode
-            riece-channel-buffer
-          riece-dialogue-buffer)))
-    (when (get-buffer-window other-window-scroll-buffer)
-      (condition-case nil
-         (scroll-other-window-down lines)
-       (beginning-of-buffer
-        (message "Beginning of buffer"))))))
+  (let ((buffer (if (and riece-channel-buffer-mode
+                        riece-current-channel)
+                   riece-channel-buffer
+                 riece-dialogue-buffer)))
+    (if (get-buffer-window buffer)
+       (condition-case nil
+           (let ((other-window-scroll-buffer buffer))
+             (scroll-other-window-down lines))
+         (beginning-of-buffer
+          (message "Beginning of buffer"))))))
 
 (defun riece-command-scroll-up (lines)
   "Scroll LINES up dialogue buffer from command buffer."
   (interactive "P")
-  (let* ((other-window-scroll-buffer
-         (if riece-channel-buffer-mode
-             riece-channel-buffer
-           riece-dialogue-buffer)))
-    (when (get-buffer-window other-window-scroll-buffer)
-      (condition-case nil
-         (scroll-other-window lines)
-       (end-of-buffer
-        (message "End of buffer"))))))
-
-(defun riece-command-nick-scroll-down (lines)
-  "Scroll LINES down nick buffer from command buffer."
+  (let ((buffer (if (and riece-channel-buffer-mode
+                        riece-current-channel)
+                   riece-channel-buffer
+                 riece-dialogue-buffer)))
+    (if (get-buffer-window buffer)
+       (condition-case nil
+           (let ((other-window-scroll-buffer buffer))
+             (scroll-other-window lines))
+         (end-of-buffer
+          (message "End of buffer"))))))
+
+(defun riece-command-user-list-scroll-down (lines)
+  "Scroll LINES down user list buffer from command buffer."
   (interactive "P")
-  (let ((other-window-scroll-buffer riece-user-list-buffer))
-    (when (get-buffer-window other-window-scroll-buffer)
+  (if (get-buffer-window riece-user-list-buffer)
       (condition-case nil
-         (scroll-other-window-down lines)
+         (let ((other-window-scroll-buffer riece-user-list-buffer))
+           (scroll-other-window-down lines))
        (beginning-of-buffer
-        (message "Beginning of buffer"))))))
+        (message "Beginning of buffer")))))
 
-(defun riece-command-nick-scroll-up (lines)
-  "Scroll LINES up nick buffer from command buffer."
+(defun riece-command-user-list-scroll-up (lines)
+  "Scroll LINES up user list buffer from command buffer."
   (interactive "P")
-  (let* ((other-window-scroll-buffer riece-user-list-buffer))
-    (when (get-buffer-window other-window-scroll-buffer)
+  (if (get-buffer-window riece-user-list-buffer)
       (condition-case nil
-         (scroll-other-window lines)
+         (let ((other-window-scroll-buffer riece-user-list-buffer))
+           (scroll-other-window lines))
        (end-of-buffer
-        (message "End of buffer"))))))
+        (message "End of buffer")))))
 
 (defun riece-command-toggle-away (&optional message)
   "Mark yourself as being away."
@@ -557,58 +539,72 @@ the layout to the selected layout-name."
                                            (riece-current-nickname))
                   (riece-user-get-away (riece-identity-prefix
                                         (riece-current-nickname)))))
-           (or (null riece-away-message)
-               current-prefix-arg))
-       (let ((message (read-string "Away message: ")))
-        (list message))))
-  (if message
-      (riece-send-string (format "AWAY :%s\r\n" message))
-    (riece-send-string "AWAY\r\n")))
+           current-prefix-arg)
+       (list (read-from-minibuffer
+             "Away message: " (cons (or riece-away-message "") 0)))))
+  (if (riece-with-server-buffer (riece-identity-server
+                                (riece-current-nickname))
+       (riece-user-get-away (riece-identity-prefix
+                             (riece-current-nickname))))
+      (riece-send-string "AWAY\r\n")
+    (riece-send-string (format "AWAY :%s\r\n" (or message
+                                                 riece-away-message)))))
 
 (defun riece-command-toggle-freeze (&optional arg)
   "Prevent automatic scrolling of the dialogue window.
 If prefix argument ARG is non-nil, toggle frozen status."
   (interactive "P")
-  (with-current-buffer (if (and riece-channel-buffer-mode
-                               riece-channel-buffer)
-                          riece-channel-buffer
-                        riece-dialogue-buffer)
+  (with-current-buffer (if (eq (derived-mode-class major-mode)
+                              'riece-dialogue-mode)
+                          (current-buffer)
+                        (if (and riece-channel-buffer-mode
+                                 riece-channel-buffer)
+                            riece-channel-buffer
+                          riece-dialogue-buffer))
     (setq riece-freeze (if arg
                           (< 0 (prefix-numeric-value arg))
-                        (not riece-freeze))))
-  (riece-update-status-indicators)
-  (force-mode-line-update t))
+                        (not riece-freeze)))
+    (riece-emit-signal 'buffer-freeze-changed
+                      (current-buffer) riece-freeze)))
 
 (defun riece-command-toggle-own-freeze (&optional arg)
   "Prevent automatic scrolling of the dialogue window.
 The difference from `riece-command-freeze' is that your messages are hidden.
 If prefix argument ARG is non-nil, toggle frozen status."
   (interactive "P")
-  (with-current-buffer (if (and riece-channel-buffer-mode
-                               riece-channel-buffer)
-                          riece-channel-buffer
-                        riece-dialogue-buffer)
+  (with-current-buffer (if (eq (derived-mode-class major-mode)
+                              'riece-dialogue-mode)
+                          (current-buffer)
+                        (if (and riece-channel-buffer-mode
+                                 riece-channel-buffer)
+                            riece-channel-buffer
+                          riece-dialogue-buffer))
     (if (if arg
            (< 0 (prefix-numeric-value arg))
          (not (eq riece-freeze 'own)))
        (setq riece-freeze 'own)
-      (setq riece-freeze nil)))
-  (riece-update-status-indicators)
-  (force-mode-line-update t))
+      (setq riece-freeze nil))
+    (riece-emit-signal 'buffer-freeze-changed
+                      (current-buffer) riece-freeze)))
 
+(eval-when-compile
+  (autoload 'riece-exit "riece"))
 (defun riece-command-quit (&optional arg)
   "Quit IRC."
   (interactive "P")
-  (if (y-or-n-p "Really quit IRC? ")
-      (let ((message
-            (if arg
-                (read-string "Message: ")
-              (or riece-quit-message
-                  (riece-extended-version))))
-           (alist riece-server-process-alist))
-       (while alist
-         (riece-quit-server-process (cdr (car alist)) message)
-         (setq alist (cdr alist))))))
+  (if (null riece-server-process-alist)
+      (progn
+       (message "No server process")
+       (ding))
+    (if (y-or-n-p "Really quit IRC? ")
+       (let ((message
+              (if arg
+                  (read-string "Message: ")
+              riece-quit-message))
+             (alist riece-server-process-alist))
+         (while alist
+           (riece-quit-server-process (cdr (car alist)) message)
+           (setq alist (cdr alist)))))))
 
 (defun riece-command-raw (command)
   "Enter raw IRC command, which is sent to the server."
@@ -635,6 +631,27 @@ If prefix argument ARG is non-nil, toggle frozen status."
   (interactive "r")
   (kill-new (buffer-substring-no-properties start end)))
 
+(defun riece-command-complete-user ()
+  "Complete a user name in the current buffer."
+  (interactive)
+  (let* ((completion-ignore-case t)
+        (table (mapcar (lambda (user)
+                         (list (riece-format-identity user t)))
+                       (riece-get-users-on-server
+                        (riece-current-server-name))))
+        (current (current-word))
+        (completion (try-completion current table))
+        (all (all-completions current table)))
+    (if (eq completion t)
+       nil
+      (if (null completion)
+         (message "Can't find completion for \"%s\"" current)
+       (if (equal current completion)
+           (with-output-to-temp-buffer "*Help*"
+             (display-completion-list all))
+         (delete-region (point) (- (point) (length current)))
+         (insert completion))))))
+  
 (defun riece-command-open-server (server-name)
   (interactive
    (list (completing-read "Server: " riece-server-alist)))
@@ -649,8 +666,7 @@ If prefix argument ARG is non-nil, toggle frozen status."
    (list (completing-read "Server: " riece-server-process-alist)
         (if current-prefix-arg
             (read-string "Message: ")
-          (or riece-quit-message
-              (riece-extended-version)))))
+          riece-quit-message)))
   (riece-quit-server-process (riece-server-process server-name) message))
 
 (defun riece-command-universal-server-name-argument ()