cgit.sxemacs.org Git - riece/blob - lisp/riece-commands.el

   1 ;;; riece-commands.el --- commands available in command buffer
   2 ;; Copyright (C) 1998-2003 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1998-09-28
   6 ;; Keywords: IRC, riece
   7
   8 ;; This file is part of Riece.
   9
  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)
  13 ;; any later version.
  14
  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.
  19
  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., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Code:
  26
  27 (require 'riece-channel)
  28 (require 'riece-complete)
  29 (require 'riece-layout)
  30 (require 'riece-display)
  31 (require 'riece-server)
  32 (require 'riece-misc)
  33 (require 'riece-identity)
  34 (require 'riece-message)
  35 (require 'riece-mcat)
  36
  37 ;;; Channel movement:
  38 (defun riece-command-switch-to-channel (channel)
  39   (interactive (list (riece-completing-read-identity
  40                       (riece-mcat "Switch to channel/user: ")
  41                       riece-current-channels nil t)))
  42   (unless (equal channel riece-current-channel)
  43     (riece-switch-to-channel channel)))
  44
  45 (defun riece-command-switch-to-channel-by-number (number)
  46   (interactive
  47    (let ((command-name (symbol-name this-command)))
  48      (if (string-match "[0-9]+$" command-name)
  49          (list (string-to-number (match-string 0 command-name)))
  50        (list (string-to-number (read-string (riece-mcat "Switch to number: ")))))))
  51   (let ((channel (nth (1- number) riece-current-channels)))
  52     (if channel
  53         (riece-command-switch-to-channel channel)
  54       (error "No such number!"))))
  55
  56 (eval-and-compile
  57   (let ((number 1))
  58     (while (<= number 20)
  59       (defalias (intern (concat "riece-command-switch-to-channel-by-number-"
  60                                 (number-to-string number)))
  61         'riece-command-switch-to-channel-by-number)
  62       (setq number (1+ number)))))
  63
  64 (defun riece-command-next-channel ()
  65   "Select the next channel."
  66   (interactive)
  67   (when (> (length riece-current-channels) 1)
  68     (let ((pointer (cdr (riece-identity-member
  69                          riece-current-channel
  70                          riece-current-channels))))
  71       (while (and pointer
  72                   (null (car pointer)))
  73         (setq pointer (cdr pointer)))
  74       (when (null pointer)
  75         (setq pointer riece-current-channels)
  76         (while (and pointer
  77                     (null (car pointer)))
  78           (setq pointer (cdr pointer))))
  79       (if (car pointer)
  80           (riece-command-switch-to-channel (car pointer))
  81         (error "No such channel!")))))
  82
  83 (defun riece-command-previous-channel ()
  84   "Select the previous channel."
  85   (interactive)
  86   (when (> (length riece-current-channels) 1)
  87     (let ((pointer (riece-identity-member
  88                     riece-current-channel
  89                     riece-current-channels))
  90           (start riece-current-channels)
  91           channel)
  92       (while (and start (not (eq start pointer)))
  93         (if (car start)
  94             (setq channel (car start)))
  95         (setq start (cdr start)))
  96       (when (null channel)
  97         (setq start (copy-sequence riece-current-channels))
  98         (setq start (delq nil start))
  99         (and (> (length start) 1)
 100              (setq channel (nth (1- (length start)) start))))
 101       (if channel
 102           (riece-command-switch-to-channel channel)
 103         (error "No such channel!")))))
 104
 105 (defun riece-command-select-command-buffer ()
 106   "Select the command buffer."
 107   (interactive)
 108   (let ((window (get-buffer-window riece-command-buffer)))
 109     (if window
 110         (select-window window))))
 111
 112 (defun riece-command-configure-windows ()
 113   (interactive)
 114   "Reconfigure windows with the current layout."
 115   (riece-redisplay-buffers t))
 116
 117 (defun riece-command-suspend-resume ()
 118   (interactive)
 119   "Save or restore the current window configuration."
 120   (let ((entry (assq 'riece-window-configuration (frame-parameters))))
 121     (modify-frame-parameters (selected-frame)
 122                              (list (cons 'riece-window-configuration
 123                                          (current-window-configuration))))
 124     (if (cdr entry)
 125         (set-window-configuration (cdr entry))
 126       (delete-other-windows))
 127     (message
 128      (substitute-command-keys
 129       "\\[riece-command-suspend-resume] to get back the last windows"))))
 130
 131 (defun riece-command-change-layout (name)
 132   "Select a layout-name from all current available layouts and change
 133 the layout to the selected layout-name."
 134   (interactive (list (completing-read (riece-mcat "Change layout: ")
 135                                       riece-layout-alist)))
 136   (setq riece-layout name
 137         riece-save-variables-are-dirty t)
 138   (riece-command-configure-windows))
 139
 140 (defun riece-command-toggle-channel-buffer-mode ()
 141   (interactive)
 142   (setq riece-channel-buffer-mode
 143         (not riece-channel-buffer-mode)
 144         riece-save-variables-are-dirty t)
 145   (riece-command-configure-windows))
 146
 147 (defun riece-command-toggle-others-buffer-mode ()
 148   (interactive)
 149   (setq riece-others-buffer-mode
 150         (not riece-others-buffer-mode)
 151         riece-save-variables-are-dirty t)
 152   (riece-command-configure-windows))
 153
 154 (defun riece-command-toggle-user-list-buffer-mode ()
 155   (interactive)
 156   (setq riece-user-list-buffer-mode
 157         (not riece-user-list-buffer-mode)
 158         riece-save-variables-are-dirty t)
 159   (riece-command-configure-windows))
 160
 161 (defun riece-command-toggle-channel-list-buffer-mode ()
 162   (interactive)
 163   (setq riece-channel-list-buffer-mode
 164         (not riece-channel-list-buffer-mode)
 165         riece-save-variables-are-dirty t)
 166   (riece-command-configure-windows))
 167
 168 (defun riece-command-finger (user &optional recurse)
 169   (interactive
 170    (let* ((completion-ignore-case t)
 171           (user (riece-completing-read-identity
 172                  (riece-mcat "Finger user: ")
 173                  (riece-get-users-on-server (riece-current-server-name))
 174                  nil nil nil nil nil t)))
 175      (list user current-prefix-arg)))
 176   (if recurse
 177       (riece-send-string (format "WHOIS %s %s\r\n"
 178                                  (riece-identity-prefix user)
 179                                  (riece-identity-prefix user)))
 180     (riece-send-string (format "WHOIS %s\r\n" (riece-identity-prefix user)))))
 181
 182 (defun riece-command-topic (topic)
 183   (interactive
 184    (progn
 185      (riece-check-channel-commands-are-usable t)
 186      (list (read-from-minibuffer
 187             (riece-mcat "Set topic: ")
 188             (cons (or (riece-with-server-buffer
 189                           (riece-identity-server
 190                            riece-current-channel)
 191                         (riece-channel-get-topic
 192                          (riece-identity-prefix
 193                           riece-current-channel)))
 194                       "")
 195                   0)))))
 196   (riece-send-string (format "TOPIC %s :%s\r\n"
 197                              (riece-identity-prefix riece-current-channel)
 198                              topic)
 199                      riece-current-channel))
 200
 201 (defun riece-command-invite (user)
 202   (interactive
 203    (let ((completion-ignore-case t))
 204      (riece-check-channel-commands-are-usable t)
 205      (list (riece-completing-read-identity
 206             (riece-mcat "Invite user: ")
 207             (riece-get-users-on-server (riece-current-server-name))
 208             nil nil nil nil nil t))))
 209   (riece-send-string (format "INVITE %s :%s\r\n"
 210                              (riece-identity-prefix user)
 211                              (riece-identity-prefix riece-current-channel))))
 212
 213 (defun riece-command-kick (user &optional message)
 214   (interactive
 215    (let ((completion-ignore-case t))
 216      (riece-check-channel-commands-are-usable t)
 217      (list (completing-read
 218             (riece-mcat "Kick user: ")
 219             (riece-with-server-buffer
 220                 (riece-identity-server riece-current-channel)
 221               (riece-channel-get-users (riece-identity-prefix
 222                                         riece-current-channel))))
 223            (if current-prefix-arg
 224                (read-string "Message: ")))))
 225   (riece-send-string
 226    (if message
 227        (format "KICK %s %s :%s\r\n"
 228                (riece-identity-prefix riece-current-channel)
 229                user message)
 230      (format "KICK %s %s\r\n"
 231              (riece-identity-prefix riece-current-channel)
 232              user))
 233    riece-current-channel))
 234
 235 (defun riece-command-kick-with-ban (user pattern &optional message)
 236   (interactive
 237    (let ((completion-ignore-case t)
 238          user)
 239      (riece-check-channel-commands-are-usable t)
 240      (riece-with-server-buffer (riece-identity-server riece-current-channel)
 241        (setq user (completing-read
 242                    (riece-mcat "Kick user: ")
 243                    (riece-channel-get-users (riece-identity-prefix
 244                                              riece-current-channel))))
 245        (list
 246         user
 247         (read-from-minibuffer
 248          (riece-mcat "Ban pattern: ")
 249          (concat user "!" (riece-user-get-user-at-host user)))
 250         (if current-prefix-arg
 251             (read-string "Message: "))))))
 252   (riece-send-string (format "MODE %s :+b %s\r\n"
 253                              (riece-identity-prefix riece-current-channel)
 254                              pattern)
 255                      riece-current-channel)
 256   (riece-send-string
 257    (if message
 258        (format "KICK %s %s :%s\r\n"
 259                (riece-identity-prefix riece-current-channel)
 260                user message)
 261      (format "KICK %s %s\r\n"
 262              (riece-identity-prefix riece-current-channel)
 263              user))
 264    riece-current-channel))
 265
 266 (defun riece-command-names (pattern)
 267   (interactive
 268    (let ((completion-ignore-case t))
 269      (list (read-from-minibuffer
 270             (riece-mcat "NAMES pattern: ")
 271             (if (and riece-current-channel
 272                      (riece-channel-p (riece-identity-prefix
 273                                        riece-current-channel)))
 274                 (cons (riece-identity-prefix riece-current-channel)
 275                       0))))))
 276   (if (or (not (equal pattern ""))
 277           (yes-or-no-p (riece-mcat
 278                         "Really want to query NAMES without argument? ")))
 279       (riece-send-string (format "NAMES %s\r\n" pattern))))
 280
 281 (defun riece-command-who (pattern)
 282   (interactive
 283    (let ((completion-ignore-case t))
 284      (list (read-from-minibuffer
 285             (riece-mcat "WHO pattern: ")
 286             (if (and riece-current-channel
 287                      (riece-channel-p (riece-identity-prefix
 288                                        riece-current-channel)))
 289                 (cons (riece-identity-prefix riece-current-channel)
 290                       0))))))
 291   (if (or (not (equal pattern ""))
 292           (yes-or-no-p (riece-mcat
 293                         "Really want to query WHO without argument? ")))
 294       (riece-send-string (format "WHO %s\r\n" pattern))))
 295
 296 (defun riece-command-list (pattern)
 297   (interactive
 298    (let ((completion-ignore-case t))
 299      (list (read-from-minibuffer
 300             (riece-mcat "LIST pattern: ")
 301             (if (and riece-current-channel
 302                      (riece-channel-p (riece-identity-prefix
 303                                        riece-current-channel)))
 304                 (cons (riece-identity-prefix riece-current-channel)
 305                       0))))))
 306   (if (or (not (equal pattern ""))
 307           (yes-or-no-p (riece-mcat
 308                         "Really want to query LIST without argument? ")))
 309       (riece-send-string (format "LIST %s\r\n" pattern))))
 310
 311 (defun riece-command-change-mode (channel change)
 312   (interactive
 313    (let* ((completion-ignore-case t)
 314           (channel
 315            (if current-prefix-arg
 316                (riece-completing-read-identity
 317                 (riece-mcat "Change mode for channel/user: ")
 318                 (riece-get-identities-on-server (riece-current-server-name))
 319                 nil nil nil nil nil t)
 320              (riece-check-channel-commands-are-usable t)
 321              riece-current-channel))
 322           (riece-overriding-server-name (riece-identity-server channel))
 323           (riece-temp-minibuffer-message
 324            (concat (riece-mcat "[Available modes: ")
 325                    (riece-with-server-buffer (riece-identity-server channel)
 326                      (if (riece-channel-p (riece-identity-prefix channel))
 327                          (if riece-supported-channel-modes
 328                              (apply #'string riece-supported-channel-modes))
 329                        (if riece-supported-user-modes
 330                            (apply #'string riece-supported-user-modes))))
 331                    "]")))
 332      (list channel
 333            (read-from-minibuffer
 334             (concat (riece-concat-channel-modes
 335                      channel (riece-mcat "Mode (? for help)")) ": ")
 336             nil riece-minibuffer-map))))
 337   (if (equal change "")
 338       (riece-send-string (format "MODE %s\r\n"
 339                                  (riece-identity-prefix channel)))
 340     (riece-send-string (format "MODE %s %s\r\n"
 341                                (riece-identity-prefix channel)
 342                                change))))
 343
 344 (defun riece-command-set-operators (users &optional arg)
 345   (interactive
 346    (progn
 347      (riece-check-channel-commands-are-usable t)
 348      (let ((completion-ignore-case t))
 349        (list (riece-completing-read-multiple
 350               (if current-prefix-arg
 351                   (riece-mcat "Unset +o for users")
 352                 (riece-mcat "Set +o for users"))
 353               (riece-with-server-buffer
 354                   (riece-identity-server riece-current-channel)
 355                 (riece-channel-get-users (riece-identity-prefix
 356                                          riece-current-channel)))
 357               (if current-prefix-arg
 358                   (lambda (user)
 359                     (memq ?o (cdr user)))
 360                 (lambda (user)
 361                   (not (memq ?o (cdr user))))))
 362              current-prefix-arg))))
 363   (let (group)
 364     (while users
 365       (setq group (cons (car users) group)
 366             users (cdr users))
 367       (when (or (= (length group) 3)
 368                 (null users))
 369         (riece-send-string
 370          (format "MODE %s %c%s %s\r\n"
 371                  (riece-identity-prefix riece-current-channel)
 372                  (if current-prefix-arg
 373                      ?-
 374                    ?+)
 375                  (make-string (length group) ?o)
 376                  (mapconcat #'identity (nreverse group) " ")))
 377         (setq group nil)))))
 378
 379 (defun riece-command-set-speakers (users &optional arg)
 380   (interactive
 381    (progn
 382      (riece-check-channel-commands-are-usable t)
 383      (let ((completion-ignore-case t))
 384        (list (riece-completing-read-multiple
 385               (if current-prefix-arg
 386                   (riece-mcat "Unset +v for users")
 387                 (riece-mcat "Set +v for users"))
 388               (riece-with-server-buffer
 389                   (riece-identity-server riece-current-channel)
 390                 (riece-channel-get-users (riece-identity-prefix
 391                                           riece-current-channel)))
 392               (if current-prefix-arg
 393                   (lambda (user)
 394                     (memq ?v (cdr user)))
 395                 (lambda (user)
 396                   (not (memq ?v (cdr user))))))
 397              current-prefix-arg))))
 398   (let (group)
 399     (while users
 400       (setq group (cons (car users) group)
 401             users (cdr users))
 402       (when (or (= (length group) 3)
 403                 (null users))
 404         (riece-send-string
 405          (format "MODE %s %c%s %s\r\n"
 406                  (riece-identity-prefix riece-current-channel)
 407                  (if current-prefix-arg
 408                      ?-
 409                    ?+)
 410                  (make-string (length group) ?v)
 411                  (mapconcat #'identity (nreverse group) " ")))
 412         (setq group nil)))))
 413
 414 (defun riece-command-send-message (message notice)
 415   "Send MESSAGE to the current channel."
 416   (run-hooks 'riece-command-send-message-hook)
 417   (if (equal message "")
 418       (error (riece-mcat "No text to send")))
 419   (riece-check-channel-commands-are-usable)
 420   (if notice
 421       (progn
 422         (riece-send-string
 423          (format "NOTICE %s :%s\r\n"
 424                  (riece-identity-prefix riece-current-channel)
 425                  message)
 426          riece-current-channel)
 427         (riece-display-message
 428          (riece-make-message (riece-current-nickname) riece-current-channel
 429                              message 'notice t)))
 430     (riece-send-string
 431      (format "PRIVMSG %s :%s\r\n"
 432              (riece-identity-prefix riece-current-channel)
 433              message)
 434      riece-current-channel)
 435     (riece-display-message
 436      (riece-make-message (riece-current-nickname) riece-current-channel
 437                          message nil t))))
 438
 439 (defun riece-command-enter-message ()
 440   "Send the current line to the current channel."
 441   (interactive)
 442   (riece-command-send-message (buffer-substring
 443                                (riece-line-beginning-position)
 444                                (riece-line-end-position))
 445                               nil)
 446   (if (> (forward-line) 0)
 447       (insert "\n")))
 448
 449 (defun riece-command-enter-message-as-notice ()
 450   "Send the current line to the current channel as NOTICE."
 451   (interactive)
 452   (riece-command-send-message (buffer-substring
 453                                (riece-line-beginning-position)
 454                                (riece-line-end-position))
 455                               t)
 456   (if (> (forward-line) 0)
 457       (insert "\n")))
 458
 459 (defun riece-command-enter-message-to-user (user)
 460   "Send the current line to USER."
 461   (interactive
 462    (if (and (bolp) (eolp))
 463        (error "No text to send")
 464      (let ((completion-ignore-case t))
 465        (list (riece-completing-read-identity
 466               (riece-mcat "Message to user: ")
 467               (riece-get-users-on-server (riece-current-server-name))
 468               nil nil nil nil nil t)))))
 469   (let ((text (buffer-substring
 470                (riece-line-beginning-position)
 471                (riece-line-end-position))))
 472     (riece-send-string
 473      (format "PRIVMSG %s :%s\r\n" (riece-identity-prefix user) text)
 474      user)
 475     (riece-display-message
 476      (riece-make-message (riece-current-nickname) user text nil t)))
 477   (if (> (forward-line) 0)
 478       (insert "\n")))
 479
 480 (defun riece-command-join-channel (target key)
 481   (unless (riece-server-opened (riece-identity-server target))
 482     (error "%s" (substitute-command-keys
 483                  "Type \\[riece-command-open-server] to open server.")))
 484   (riece-send-string (if key
 485                          (format "JOIN %s :%s\r\n"
 486                                  (riece-identity-prefix target)
 487                                  key)
 488                        (format "JOIN %s\r\n"
 489                                (riece-identity-prefix target)))
 490                      target))
 491
 492 (defun riece-command-join-partner (target)
 493   (let ((pointer (riece-identity-member target riece-current-channels)))
 494     (if pointer
 495         (riece-command-switch-to-channel (car pointer))
 496       (riece-join-channel target)
 497       (riece-switch-to-channel target))))
 498
 499 (defun riece-command-join (target)
 500   (interactive
 501    (let ((completion-ignore-case t))
 502      (list
 503       (if riece-join-channel-candidate
 504           (let ((default (riece-format-identity
 505                           riece-join-channel-candidate)))
 506             (riece-completing-read-identity
 507              (format (riece-mcat "Join channel/user (default %s): ") default)
 508              (riece-get-identities-on-server (riece-current-server-name))
 509              nil nil nil nil default))
 510         (riece-completing-read-identity
 511          (riece-mcat "Join channel/user: ")
 512          (riece-get-identities-on-server (riece-current-server-name)))))))
 513   (let ((pointer (riece-identity-member target riece-current-channels)))
 514     (if pointer
 515         (riece-command-switch-to-channel (car pointer))
 516       (if (riece-channel-p (riece-identity-prefix target))
 517           (riece-command-join-channel target nil)
 518         (riece-command-join-partner target)))))
 519
 520 (defun riece-command-part-channel (target message)
 521   (unless (riece-server-opened (riece-identity-server target))
 522     (error "%s" (substitute-command-keys
 523                  "Type \\[riece-command-open-server] to open server.")))
 524   (riece-send-string (if message
 525                          (format "PART %s :%s\r\n"
 526                                  (riece-identity-prefix target)
 527                                  message)
 528                        (format "PART %s\r\n"
 529                                (riece-identity-prefix target)))
 530                      target))
 531
 532 (defun riece-command-part (target &optional message)
 533   (interactive
 534    (progn
 535      (riece-check-channel-commands-are-usable)
 536      (let* ((completion-ignore-case t)
 537             (target
 538              (riece-completing-read-identity
 539               (format (riece-mcat "Part from channel/user (default %s): ")
 540                       (riece-format-identity riece-current-channel))
 541               riece-current-channels nil nil nil nil
 542               (riece-format-identity riece-current-channel)))
 543             (message
 544              (if current-prefix-arg
 545                  (read-string (riece-mcat "Message: "))
 546                riece-part-message)))
 547        (list target message))))
 548   (if (riece-identity-member target riece-current-channels)
 549       (if (riece-channel-p (riece-identity-prefix target))
 550           (riece-command-part-channel target message)
 551         (riece-part-channel target))
 552     (error "You are not talking with %s" target)))
 553
 554 (defun riece-command-change-nickname (nickname)
 555   "Change your nickname to NICK."
 556   (interactive "sEnter your nickname: ")
 557   (riece-send-string (format "NICK %s\r\n" nickname)))
 558
 559 (defun riece-command-scroll-down (lines)
 560   "Scroll LINES down dialogue buffer from command buffer."
 561   (interactive "P")
 562   (let ((buffer (if (and riece-channel-buffer-mode
 563                          riece-current-channel)
 564                     riece-channel-buffer
 565                   riece-dialogue-buffer)))
 566     (if (get-buffer-window buffer)
 567         (condition-case nil
 568             (let ((other-window-scroll-buffer buffer))
 569               (scroll-other-window-down lines))
 570           (beginning-of-buffer
 571            (message (riece-mcat "Beginning of buffer")))))))
 572
 573 (defun riece-command-scroll-up (lines)
 574   "Scroll LINES up dialogue buffer from command buffer."
 575   (interactive "P")
 576   (let ((buffer (if (and riece-channel-buffer-mode
 577                          riece-current-channel)
 578                     riece-channel-buffer
 579                   riece-dialogue-buffer)))
 580     (if (get-buffer-window buffer)
 581         (condition-case nil
 582             (let ((other-window-scroll-buffer buffer))
 583               (scroll-other-window lines))
 584           (end-of-buffer
 585            (message (riece-mcat "End of buffer")))))))
 586
 587 (defun riece-command-user-list-scroll-down (lines)
 588   "Scroll LINES down user list buffer from command buffer."
 589   (interactive "P")
 590   (if (get-buffer-window riece-user-list-buffer)
 591       (condition-case nil
 592           (let ((other-window-scroll-buffer riece-user-list-buffer))
 593             (scroll-other-window-down lines))
 594         (beginning-of-buffer
 595          (message (riece-mcat "Beginning of buffer"))))))
 596
 597 (defun riece-command-user-list-scroll-up (lines)
 598   "Scroll LINES up user list buffer from command buffer."
 599   (interactive "P")
 600   (if (get-buffer-window riece-user-list-buffer)
 601       (condition-case nil
 602           (let ((other-window-scroll-buffer riece-user-list-buffer))
 603             (scroll-other-window lines))
 604         (end-of-buffer
 605          (message (riece-mcat "End of buffer"))))))
 606
 607 (defun riece-command-toggle-away (&optional message)
 608   "Mark yourself as being away."
 609   (interactive
 610    (if (and (not (riece-with-server-buffer (riece-identity-server
 611                                             (riece-current-nickname))
 612                    (riece-user-get-away (riece-identity-prefix
 613                                          (riece-current-nickname)))))
 614             current-prefix-arg)
 615        (list (read-from-minibuffer
 616               (riece-mcat "Away message: ") (cons (or riece-away-message "")
 617                                                   0)))))
 618   (if (riece-with-server-buffer (riece-identity-server
 619                                  (riece-current-nickname))
 620         (riece-user-get-away (riece-identity-prefix
 621                               (riece-current-nickname))))
 622       (riece-send-string "AWAY\r\n")
 623     (riece-send-string (format "AWAY :%s\r\n" (or message
 624                                                   riece-away-message)))))
 625
 626 (defun riece-command-toggle-freeze (&optional arg)
 627   "Prevent automatic scrolling of the dialogue window.
 628 If prefix argument ARG is non-nil, toggle frozen status."
 629   (interactive "P")
 630   (with-current-buffer (if (riece-derived-mode-p 'riece-dialogue-mode)
 631                            (current-buffer)
 632                          (if (and riece-channel-buffer-mode
 633                                   riece-channel-buffer)
 634                              riece-channel-buffer
 635                            riece-dialogue-buffer))
 636     (setq riece-freeze (if arg
 637                            (< 0 (prefix-numeric-value arg))
 638                          (not riece-freeze)))
 639     (riece-emit-signal 'buffer-freeze-changed
 640                        (current-buffer) riece-freeze)))
 641
 642 (defun riece-command-toggle-own-freeze (&optional arg)
 643   "Prevent automatic scrolling of the dialogue window.
 644 The difference from `riece-command-freeze' is that your messages are hidden.
 645 If prefix argument ARG is non-nil, toggle frozen status."
 646   (interactive "P")
 647   (with-current-buffer (if (riece-derived-mode-p 'riece-dialogue-mode)
 648                            (current-buffer)
 649                          (if (and riece-channel-buffer-mode
 650                                   riece-channel-buffer)
 651                              riece-channel-buffer
 652                            riece-dialogue-buffer))
 653     (if (if arg
 654             (< 0 (prefix-numeric-value arg))
 655           (not (eq riece-freeze 'own)))
 656         (setq riece-freeze 'own)
 657       (setq riece-freeze nil))
 658     (riece-emit-signal 'buffer-freeze-changed
 659                        (current-buffer) riece-freeze)))
 660
 661 (eval-when-compile
 662   (autoload 'riece-exit "riece"))
 663 (defun riece-command-quit (&optional arg)
 664   "Quit IRC."
 665   (interactive "P")
 666   (if (null riece-server-process-alist)
 667       (progn
 668         (message (riece-mcat "No server process"))
 669         (ding))
 670     (if (y-or-n-p (riece-mcat "Really quit IRC? "))
 671         (let ((message
 672                (if arg
 673                    (read-string (riece-mcat "Message: "))
 674                  riece-quit-message))
 675               (alist riece-server-process-alist))
 676           (while alist
 677             (riece-quit-server-process (cdr (car alist)) message)
 678             (setq alist (cdr alist)))))))
 679
 680 (defun riece-command-raw (command)
 681   "Enter raw IRC command, which is sent to the server."
 682   (interactive "sIRC command: ")
 683   (riece-send-string (concat command "\r\n")))
 684
 685 (defun riece-command-beginning-of-buffer ()
 686   "Scroll channel buffer to the beginning."
 687   (interactive)
 688   (let (buffer window)
 689     (setq buffer (if riece-channel-buffer-mode
 690                      riece-channel-buffer
 691                    riece-dialogue-buffer))
 692     (or (setq window (get-buffer-window buffer))
 693         (setq window (get-buffer-window riece-dialogue-buffer)
 694               buffer riece-dialogue-buffer))
 695     (when window
 696       (save-selected-window
 697         (select-window window)
 698         (goto-char (point-min))))))
 699
 700 (defun riece-command-end-of-buffer ()
 701   "Scroll channel buffer to the end."
 702   (interactive)
 703   (let (buffer window)
 704     (setq buffer (if riece-channel-buffer-mode
 705                      riece-channel-buffer
 706                    riece-dialogue-buffer))
 707     (or (setq window (get-buffer-window buffer))
 708         (setq window (get-buffer-window riece-dialogue-buffer)
 709               buffer riece-dialogue-buffer))
 710     (when window
 711       (save-selected-window
 712         (select-window window)
 713         (goto-char (point-max))))))
 714
 715 (defun riece-command-copy-region (start end)
 716   "Move current region between START and END to `kill-ring'."
 717   (interactive "r")
 718   (kill-new (buffer-substring-no-properties start end)))
 719
 720 (defun riece-command-complete-user ()
 721   "Complete a user name in the current buffer."
 722   (interactive)
 723   (let* ((completion-ignore-case t)
 724          (table (mapcar (lambda (user)
 725                           (list (riece-format-identity user t)))
 726                         (riece-get-users-on-server
 727                          (riece-current-server-name))))
 728          (current (or (current-word) ""))
 729          (completion (try-completion current table))
 730          (all (all-completions current table)))
 731     (if (eq completion t)
 732         nil
 733       (if (null completion)
 734           (message (riece-mcat "Can't find completion for \"%s\"") current)
 735         (if (equal current completion)
 736             (with-output-to-temp-buffer "*Help*"
 737               (display-completion-list all))
 738           (re-search-forward "\\>" nil t)
 739           (delete-region (point) (- (point) (length current)))
 740           (insert completion))))))
 741
 742 (defun riece-command-open-server (server-name)
 743   (interactive
 744    (list (completing-read (riece-mcat "Open server: ") riece-server-alist)))
 745   (if (riece-server-process server-name)
 746       (error "%s is already opened" server-name))
 747   (riece-open-server
 748    (riece-server-name-to-server server-name)
 749    server-name))
 750
 751 (defun riece-command-close-server (server-name &optional message)
 752   (interactive
 753    (list (completing-read (riece-mcat "Close server: ")
 754                           riece-server-process-alist)
 755          (if current-prefix-arg
 756              (read-string (riece-mcat "Message: "))
 757            riece-quit-message)))
 758   (let ((process (riece-server-process server-name)))
 759     (unless process
 760       (error "%s is not opened" server-name))
 761     (riece-quit-server-process process message)))
 762
 763 (defun riece-command-universal-server-name-argument ()
 764   (interactive)
 765   (let* ((riece-overriding-server-name
 766           (completing-read (riece-mcat "Server: ") riece-server-process-alist))
 767          (command
 768           (key-binding (read-key-sequence
 769                         (format (riece-mcat "Command to execute on \"%s\":")
 770                                 riece-overriding-server-name)))))
 771     (message "")
 772     (call-interactively command)))
 773
 774 (eval-when-compile
 775   (autoload 'riece-save-variables-files "riece"))
 776 (defun riece-command-save-variables ()
 777   "Save `riece-variables-file'."
 778   (interactive)
 779   (if (or riece-save-variables-are-dirty
 780           (y-or-n-p (riece-mcat "No changes made.  Save anyway? ")))
 781       (riece-save-variables-files)))
 782
 783 (provide 'riece-commands)
 784
 785 ;;; riece-commands.el ends here