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

   1 ;;; riece-commands.el --- commands available in command buffer -*- lexical-binding: t -*-
   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 (defvar riece-temp-minibuffer-message)
 312 (defvar riece-overriding-server-name)
 313 (defun riece-command-change-mode (channel change)
 314   (interactive
 315    (let* ((completion-ignore-case t)
 316           (channel
 317            (if current-prefix-arg
 318                (riece-completing-read-identity
 319                 (riece-mcat "Change mode for channel/user: ")
 320                 (riece-get-identities-on-server (riece-current-server-name))
 321                 nil nil nil nil nil t)
 322              (riece-check-channel-commands-are-usable t)
 323              riece-current-channel))
 324           (riece-overriding-server-name (riece-identity-server channel))
 325           (riece-temp-minibuffer-message
 326            (concat (riece-mcat "[Available modes: ")
 327                    (riece-with-server-buffer (riece-identity-server channel)
 328                      (if (riece-channel-p (riece-identity-prefix channel))
 329                          (if riece-supported-channel-modes
 330                              (apply #'string riece-supported-channel-modes))
 331                        (if riece-supported-user-modes
 332                            (apply #'string riece-supported-user-modes))))
 333                    "]")))
 334      (list channel
 335            (read-from-minibuffer
 336             (concat (riece-concat-channel-modes
 337                      channel (riece-mcat "Mode (? for help)")) ": ")
 338             nil riece-minibuffer-map))))
 339   (if (equal change "")
 340       (riece-send-string (format "MODE %s\r\n"
 341                                  (riece-identity-prefix channel)))
 342     (riece-send-string (format "MODE %s %s\r\n"
 343                                (riece-identity-prefix channel)
 344                                change))))
 345
 346 (defun riece-command-set-operators (users &optional _arg)
 347   (interactive
 348    (progn
 349      (riece-check-channel-commands-are-usable t)
 350      (let ((completion-ignore-case t))
 351        (list (riece-completing-read-multiple
 352               (if current-prefix-arg
 353                   (riece-mcat "Unset +o for users")
 354                 (riece-mcat "Set +o for users"))
 355               (riece-with-server-buffer
 356                   (riece-identity-server riece-current-channel)
 357                 (riece-channel-get-users (riece-identity-prefix
 358                                          riece-current-channel)))
 359               (if current-prefix-arg
 360                   (lambda (user)
 361                     (memq ?o (cdr user)))
 362                 (lambda (user)
 363                   (not (memq ?o (cdr user))))))
 364              current-prefix-arg))))
 365   (let (group)
 366     (while users
 367       (setq group (cons (car users) group)
 368             users (cdr users))
 369       (when (or (= (length group) 3)
 370                 (null users))
 371         (riece-send-string
 372          (format "MODE %s %c%s %s\r\n"
 373                  (riece-identity-prefix riece-current-channel)
 374                  (if current-prefix-arg
 375                      ?-
 376                    ?+)
 377                  (make-string (length group) ?o)
 378                  (mapconcat #'identity (nreverse group) " ")))
 379         (setq group nil)))))
 380
 381 (defun riece-command-set-speakers (users &optional _arg)
 382   (interactive
 383    (progn
 384      (riece-check-channel-commands-are-usable t)
 385      (let ((completion-ignore-case t))
 386        (list (riece-completing-read-multiple
 387               (if current-prefix-arg
 388                   (riece-mcat "Unset +v for users")
 389                 (riece-mcat "Set +v for users"))
 390               (riece-with-server-buffer
 391                   (riece-identity-server riece-current-channel)
 392                 (riece-channel-get-users (riece-identity-prefix
 393                                           riece-current-channel)))
 394               (if current-prefix-arg
 395                   (lambda (user)
 396                     (memq ?v (cdr user)))
 397                 (lambda (user)
 398                   (not (memq ?v (cdr user))))))
 399              current-prefix-arg))))
 400   (let (group)
 401     (while users
 402       (setq group (cons (car users) group)
 403             users (cdr users))
 404       (when (or (= (length group) 3)
 405                 (null users))
 406         (riece-send-string
 407          (format "MODE %s %c%s %s\r\n"
 408                  (riece-identity-prefix riece-current-channel)
 409                  (if current-prefix-arg
 410                      ?-
 411                    ?+)
 412                  (make-string (length group) ?v)
 413                  (mapconcat #'identity (nreverse group) " ")))
 414         (setq group nil)))))
 415
 416 (defun riece-command-send-message (message notice)
 417   "Send MESSAGE to the current channel."
 418   (run-hooks 'riece-command-send-message-hook)
 419   (if (equal message "")
 420       (error (riece-mcat "No text to send")))
 421   (riece-check-channel-commands-are-usable)
 422   (if notice
 423       (progn
 424         (riece-send-string
 425          (format "NOTICE %s :%s\r\n"
 426                  (riece-identity-prefix riece-current-channel)
 427                  message)
 428          riece-current-channel)
 429         (riece-display-message
 430          (riece-make-message (riece-current-nickname) riece-current-channel
 431                              message 'notice t)))
 432     (riece-send-string
 433      (format "PRIVMSG %s :%s\r\n"
 434              (riece-identity-prefix riece-current-channel)
 435              message)
 436      riece-current-channel)
 437     (riece-display-message
 438      (riece-make-message (riece-current-nickname) riece-current-channel
 439                          message nil t))))
 440
 441 (defun riece-command-enter-message ()
 442   "Send the current line to the current channel."
 443   (interactive)
 444   (riece-command-send-message (buffer-substring
 445                                (riece-line-beginning-position)
 446                                (riece-line-end-position))
 447                               nil)
 448   (forward-line 1)
 449   (when (eobp)
 450     (insert "\n")))
 451
 452
 453 (defun riece-command-enter-message-as-notice ()
 454   "Send the current line to the current channel as NOTICE."
 455   (interactive)
 456   (riece-command-send-message (buffer-substring
 457                                (riece-line-beginning-position)
 458                                (riece-line-end-position))
 459                               t)
 460   (forward-line 1)
 461   (when (eobp)
 462     (insert "\n")))
 463
 464 (defun riece-command-enter-message-to-user (user)
 465   "Send the current line to USER."
 466   (interactive
 467    (if (and (bolp) (eolp))
 468        (error "No text to send")
 469      (let ((completion-ignore-case t))
 470        (list (riece-completing-read-identity
 471               (riece-mcat "Message to user: ")
 472               (riece-get-users-on-server (riece-current-server-name))
 473               nil nil nil nil nil t)))))
 474   (let ((text (buffer-substring
 475                (riece-line-beginning-position)
 476                (riece-line-end-position))))
 477     (riece-send-string
 478      (format "PRIVMSG %s :%s\r\n" (riece-identity-prefix user) text)
 479      user)
 480     (riece-display-message
 481      (riece-make-message (riece-current-nickname) user text nil t)))
 482   (forward-line 1)
 483   (when (eobp)
 484     (insert "\n")))
 485
 486 (defun riece-command-join-channel (target key)
 487   (unless (riece-server-opened (riece-identity-server target))
 488     (error "%s" (substitute-command-keys
 489                  "Type \\[riece-command-open-server] to open server.")))
 490   (riece-send-string (if key
 491                          (format "JOIN %s :%s\r\n"
 492                                  (riece-identity-prefix target)
 493                                  key)
 494                        (format "JOIN %s\r\n"
 495                                (riece-identity-prefix target)))
 496                      target))
 497
 498 (defun riece-command-join-partner (target)
 499   (let ((pointer (riece-identity-member target riece-current-channels)))
 500     (if pointer
 501         (riece-command-switch-to-channel (car pointer))
 502       (riece-join-channel target)
 503       (riece-switch-to-channel target))))
 504
 505 (defun riece-command-join (target)
 506   (interactive
 507    (let ((completion-ignore-case t))
 508      (list
 509       (if riece-join-channel-candidate
 510           (let ((default (riece-format-identity
 511                           riece-join-channel-candidate)))
 512             (riece-completing-read-identity
 513              (format (riece-mcat "Join channel/user (default %s): ") default)
 514              (riece-get-identities-on-server (riece-current-server-name))
 515              nil nil nil nil default))
 516         (riece-completing-read-identity
 517          (riece-mcat "Join channel/user: ")
 518          (riece-get-identities-on-server (riece-current-server-name)))))))
 519   (let ((pointer (riece-identity-member target riece-current-channels)))
 520     (if pointer
 521         (riece-command-switch-to-channel (car pointer))
 522       (if (riece-channel-p (riece-identity-prefix target))
 523           (riece-command-join-channel target nil)
 524         (riece-command-join-partner target)))))
 525
 526 (defun riece-command-part-channel (target message)
 527   (unless (riece-server-opened (riece-identity-server target))
 528     (error "%s" (substitute-command-keys
 529                  "Type \\[riece-command-open-server] to open server.")))
 530   (riece-send-string (if message
 531                          (format "PART %s :%s\r\n"
 532                                  (riece-identity-prefix target)
 533                                  message)
 534                        (format "PART %s\r\n"
 535                                (riece-identity-prefix target)))
 536                      target))
 537
 538 (defun riece-command-part (target &optional message)
 539   (interactive
 540    (progn
 541      (riece-check-channel-commands-are-usable)
 542      (let* ((completion-ignore-case t)
 543             (target
 544              (riece-completing-read-identity
 545               (format (riece-mcat "Part from channel/user (default %s): ")
 546                       (riece-format-identity riece-current-channel))
 547               riece-current-channels nil nil nil nil
 548               (riece-format-identity riece-current-channel)))
 549             (message
 550              (if current-prefix-arg
 551                  (read-string (riece-mcat "Message: "))
 552                riece-part-message)))
 553        (list target message))))
 554   (if (riece-identity-member target riece-current-channels)
 555       (if (riece-channel-p (riece-identity-prefix target))
 556           (riece-command-part-channel target message)
 557         (riece-part-channel target))
 558     (error "You are not talking with %s" target)))
 559
 560 (defun riece-command-change-nickname (nickname)
 561   "Change your nickname to NICK."
 562   (interactive "sEnter your nickname: ")
 563   (riece-send-string (format "NICK %s\r\n" nickname)))
 564
 565 (defun riece-command-scroll-down (lines)
 566   "Scroll LINES down dialogue buffer from command buffer."
 567   (interactive "P")
 568   (let ((buffer (if (and riece-channel-buffer-mode
 569                          riece-current-channel)
 570                     riece-channel-buffer
 571                   riece-dialogue-buffer)))
 572     (if (get-buffer-window buffer)
 573         (condition-case nil
 574             (let ((other-window-scroll-buffer buffer))
 575               (scroll-other-window-down lines))
 576           (beginning-of-buffer
 577            (message (riece-mcat "Beginning of buffer")))))))
 578
 579 (defun riece-command-scroll-up (lines)
 580   "Scroll LINES up dialogue buffer from command buffer."
 581   (interactive "P")
 582   (let ((buffer (if (and riece-channel-buffer-mode
 583                          riece-current-channel)
 584                     riece-channel-buffer
 585                   riece-dialogue-buffer)))
 586     (if (get-buffer-window buffer)
 587         (condition-case nil
 588             (let ((other-window-scroll-buffer buffer))
 589               (scroll-other-window lines))
 590           (end-of-buffer
 591            (message (riece-mcat "End of buffer")))))))
 592
 593 (defun riece-command-user-list-scroll-down (lines)
 594   "Scroll LINES down user list buffer from command buffer."
 595   (interactive "P")
 596   (if (get-buffer-window riece-user-list-buffer)
 597       (condition-case nil
 598           (let ((other-window-scroll-buffer riece-user-list-buffer))
 599             (scroll-other-window-down lines))
 600         (beginning-of-buffer
 601          (message (riece-mcat "Beginning of buffer"))))))
 602
 603 (defun riece-command-user-list-scroll-up (lines)
 604   "Scroll LINES up user list buffer from command buffer."
 605   (interactive "P")
 606   (if (get-buffer-window riece-user-list-buffer)
 607       (condition-case nil
 608           (let ((other-window-scroll-buffer riece-user-list-buffer))
 609             (scroll-other-window lines))
 610         (end-of-buffer
 611          (message (riece-mcat "End of buffer"))))))
 612
 613 (defun riece-command-toggle-away (&optional message)
 614   "Mark yourself as being away."
 615   (interactive
 616    (if (and (not (riece-with-server-buffer (riece-identity-server
 617                                             (riece-current-nickname))
 618                    (riece-user-get-away (riece-identity-prefix
 619                                          (riece-current-nickname)))))
 620             current-prefix-arg)
 621        (list (read-from-minibuffer
 622               (riece-mcat "Away message: ") (cons (or riece-away-message "")
 623                                                   0)))))
 624   (if (riece-with-server-buffer (riece-identity-server
 625                                  (riece-current-nickname))
 626         (riece-user-get-away (riece-identity-prefix
 627                               (riece-current-nickname))))
 628       (riece-send-string "AWAY\r\n")
 629     (riece-send-string (format "AWAY :%s\r\n" (or message
 630                                                   riece-away-message)))))
 631
 632 (defun riece-command-toggle-freeze (&optional arg)
 633   "Prevent automatic scrolling of the dialogue window.
 634 If prefix argument ARG is non-nil, toggle frozen status."
 635   (interactive "P")
 636   (with-current-buffer (if (riece-derived-mode-p 'riece-dialogue-mode)
 637                            (current-buffer)
 638                          (if (and riece-channel-buffer-mode
 639                                   riece-channel-buffer)
 640                              riece-channel-buffer
 641                            riece-dialogue-buffer))
 642     (setq riece-freeze (if arg
 643                            (< 0 (prefix-numeric-value arg))
 644                          (not riece-freeze)))
 645     (riece-emit-signal 'buffer-freeze-changed
 646                        (current-buffer) riece-freeze)))
 647
 648 (defun riece-command-toggle-own-freeze (&optional arg)
 649   "Prevent automatic scrolling of the dialogue window.
 650 The difference from `riece-command-freeze' is that your messages are hidden.
 651 If prefix argument ARG is non-nil, toggle frozen status."
 652   (interactive "P")
 653   (with-current-buffer (if (riece-derived-mode-p 'riece-dialogue-mode)
 654                            (current-buffer)
 655                          (if (and riece-channel-buffer-mode
 656                                   riece-channel-buffer)
 657                              riece-channel-buffer
 658                            riece-dialogue-buffer))
 659     (if (if arg
 660             (< 0 (prefix-numeric-value arg))
 661           (not (eq riece-freeze 'own)))
 662         (setq riece-freeze 'own)
 663       (setq riece-freeze nil))
 664     (riece-emit-signal 'buffer-freeze-changed
 665                        (current-buffer) riece-freeze)))
 666
 667 (eval-when-compile
 668   (autoload 'riece-exit "riece"))
 669 (defun riece-command-quit (&optional arg)
 670   "Quit IRC."
 671   (interactive "P")
 672   (if (null riece-server-process-alist)
 673       (progn
 674         (message (riece-mcat "No server process"))
 675         (ding))
 676     (if (y-or-n-p (riece-mcat "Really quit IRC? "))
 677         (let ((message
 678                (if arg
 679                    (read-string (riece-mcat "Message: "))
 680                  riece-quit-message))
 681               (alist riece-server-process-alist))
 682           (while alist
 683             (riece-quit-server-process (cdr (car alist)) message)
 684             (setq alist (cdr alist)))))))
 685
 686 (defun riece-command-raw (command)
 687   "Enter raw IRC command, which is sent to the server."
 688   (interactive "sIRC command: ")
 689   (riece-send-string (concat command "\r\n")))
 690
 691 (defun riece-command-beginning-of-buffer ()
 692   "Scroll channel buffer to the beginning."
 693   (interactive)
 694   (let (buffer window)
 695     (setq buffer (if riece-channel-buffer-mode
 696                      riece-channel-buffer
 697                    riece-dialogue-buffer))
 698     (or (setq window (get-buffer-window buffer))
 699         (setq window (get-buffer-window riece-dialogue-buffer)
 700               buffer riece-dialogue-buffer))
 701     (when window
 702       (save-selected-window
 703         (select-window window)
 704         (goto-char (point-min))))))
 705
 706 (defun riece-command-end-of-buffer ()
 707   "Scroll channel buffer to the end."
 708   (interactive)
 709   (let (buffer window)
 710     (setq buffer (if riece-channel-buffer-mode
 711                      riece-channel-buffer
 712                    riece-dialogue-buffer))
 713     (or (setq window (get-buffer-window buffer))
 714         (setq window (get-buffer-window riece-dialogue-buffer)
 715               buffer riece-dialogue-buffer))
 716     (when window
 717       (save-selected-window
 718         (select-window window)
 719         (goto-char (point-max))))))
 720
 721 (defun riece-command-copy-region (start end)
 722   "Move current region between START and END to `kill-ring'."
 723   (interactive "r")
 724   (kill-new (buffer-substring-no-properties start end)))
 725
 726 (defun riece-command-complete-user ()
 727   "Complete a user name in the current buffer."
 728   (interactive)
 729   (let* ((completion-ignore-case t)
 730          (table (mapcar (lambda (user)
 731                           (list (riece-format-identity user t)))
 732                         (riece-get-users-on-server
 733                          (riece-current-server-name))))
 734          (current (or (current-word) ""))
 735          (completion (try-completion current table))
 736          (all (all-completions current table)))
 737     (if (eq completion t)
 738         nil
 739       (if (null completion)
 740           (message (riece-mcat "Can't find completion for \"%s\"") current)
 741         (if (equal current completion)
 742             (with-output-to-temp-buffer "*Help*"
 743               (display-completion-list all))
 744           (re-search-forward "\\>" nil t)
 745           (delete-region (point) (- (point) (length current)))
 746           (insert completion))))))
 747
 748 (defun riece-command-open-server (server-name)
 749   (interactive
 750    (list (completing-read (riece-mcat "Open server: ") riece-server-alist)))
 751   (if (riece-server-process server-name)
 752       (error "%s is already opened" server-name))
 753   (riece-open-server
 754    (riece-server-name-to-server server-name)
 755    server-name))
 756
 757 (defun riece-command-close-server (server-name &optional message)
 758   (interactive
 759    (list (completing-read (riece-mcat "Close server: ")
 760                           riece-server-process-alist)
 761          (if current-prefix-arg
 762              (read-string (riece-mcat "Message: "))
 763            riece-quit-message)))
 764   (let ((process (riece-server-process server-name)))
 765     (unless process
 766       (error "%s is not opened" server-name))
 767     (riece-quit-server-process process message)))
 768
 769 (defun riece-command-universal-server-name-argument ()
 770   (interactive)
 771   (let* ((riece-overriding-server-name
 772           (completing-read (riece-mcat "Server: ") riece-server-process-alist))
 773          (command
 774           (key-binding (read-key-sequence
 775                         (format (riece-mcat "Command to execute on \"%s\":")
 776                                 riece-overriding-server-name)))))
 777     (message "")
 778     (call-interactively command)))
 779
 780 (eval-when-compile
 781   (autoload 'riece-save-variables-files "riece"))
 782 (defun riece-command-save-variables ()
 783   "Save `riece-variables-file'."
 784   (interactive)
 785   (if (or riece-save-variables-are-dirty
 786           (y-or-n-p (riece-mcat "No changes made.  Save anyway? ")))
 787       (riece-save-variables-files)))
 788
 789 (provide 'riece-commands)
 790
 791 ;;; riece-commands.el ends here