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