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., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Code:
  26
  27 (require 'riece-channel)
  28 (require 'riece-complete)
  29 (require 'riece-display)
  30 (require 'riece-version)
  31 (require 'riece-server)
  32 (require 'riece-misc)
  33 (require 'riece-identity)
  34 (require 'riece-message)
  35
  36 ;;; Channel movement:
  37 (defun riece-command-switch-to-channel (channel)
  38   (interactive (list (riece-completing-read-identity
  39                       "Channel/User: " riece-current-channels nil t)))
  40   (riece-switch-to-channel channel)
  41   (riece-redisplay-buffers))
  42
  43 (defun riece-command-switch-to-channel-by-number (number)
  44   (interactive
  45    (let ((command-name (symbol-name this-command)))
  46      (if (string-match "[0-9]+$" command-name)
  47          (list (string-to-number (match-string 0 command-name)))
  48        (list (string-to-number (read-string "Number: "))))))
  49   (let ((channel (nth (1- number) riece-current-channels)))
  50     (if channel
  51         (riece-command-switch-to-channel channel)
  52       (error "No such number!"))))
  53
  54 (eval-and-compile
  55   (let ((number 1))
  56     (while (<= number 20)
  57       (defalias (intern (concat "riece-command-switch-to-channel-by-number-"
  58                                 (number-to-string number)))
  59         'riece-command-switch-to-channel-by-number)
  60       (setq number (1+ number)))))
  61
  62 (defun riece-command-next-channel ()
  63   "Select the next channel."
  64   (interactive)
  65   (when (> (length riece-current-channels) 1)
  66     (let ((pointer (cdr (riece-identity-member
  67                          riece-current-channel
  68                          riece-current-channels))))
  69       (while (and pointer
  70                   (null (car pointer)))
  71         (setq pointer (cdr pointer)))
  72       (when (null pointer)
  73         (setq pointer riece-current-channels)
  74         (while (and pointer
  75                     (null (car pointer)))
  76           (setq pointer (cdr pointer))))
  77       (if (car pointer)
  78           (riece-command-switch-to-channel (car pointer))
  79         (error "No such channel!")))))
  80
  81 (defun riece-command-previous-channel ()
  82   "Select the previous channel."
  83   (interactive)
  84   (when (> (length riece-current-channels) 1)
  85     (let ((pointer (riece-identity-member
  86                     riece-current-channel
  87                     riece-current-channels))
  88           (start riece-current-channels)
  89           channel)
  90       (while (and start (not (eq start pointer)))
  91         (setq channel (car start))
  92         (setq start (cdr start)))
  93       (when (null channel)
  94         (setq start (copy-sequence riece-current-channels))
  95         (setq start (delq nil start))
  96         (and (> (length start) 1)
  97              (setq channel (nth (1- (length start)) start))))
  98       (if channel
  99           (riece-command-switch-to-channel channel)
 100         (error "No such channel!")))))
 101
 102 (defun riece-command-select-command-buffer ()
 103   "Select the command buffer."
 104   (interactive)
 105   (let ((window (get-buffer-window riece-command-buffer)))
 106     (if window
 107         (select-window window))))
 108
 109 (defun riece-command-configure-windows ()
 110   (interactive)
 111   (riece-redisplay-buffers t))
 112
 113 (defun riece-command-toggle-channel-buffer-mode ()
 114   (interactive)
 115   (setq riece-channel-buffer-mode
 116         (not riece-channel-buffer-mode)
 117         riece-save-variables-are-dirty t)
 118   (riece-command-configure-windows))
 119
 120 (defun riece-command-toggle-user-list-buffer-mode ()
 121   (interactive)
 122   (setq riece-user-list-buffer-mode
 123         (not riece-user-list-buffer-mode)
 124         riece-save-variables-are-dirty t)
 125   (riece-command-configure-windows))
 126
 127 (defun riece-command-toggle-channel-list-buffer-mode ()
 128   (interactive)
 129   (setq riece-channel-list-buffer-mode
 130         (not riece-channel-list-buffer-mode)
 131         riece-save-variables-are-dirty t)
 132   (riece-command-configure-windows))
 133
 134 (defun riece-command-finger (user &optional recurse)
 135   (interactive
 136    (let* ((completion-ignore-case t)
 137           (user (completing-read
 138                  "User: "
 139                  (mapcar #'list (riece-get-users-on-server)))))
 140      (list user current-prefix-arg)))
 141   (if recurse
 142       (riece-send-string (format "WHOIS %s %s\r\n" user user))
 143     (riece-send-string (format "WHOIS %s\r\n" user))))
 144
 145 (defun riece-command-topic (topic)
 146   (interactive
 147    (list (read-from-minibuffer
 148           "Topic: " (cons (or (riece-with-identity-buffer riece-current-channel
 149                                 (riece-channel-get-topic
 150                                  (riece-identity-prefix
 151                                   riece-current-channel)))
 152                               "")
 153                           0))))
 154   (riece-send-string (format "TOPIC %s :%s\r\n"
 155                              (riece-identity-prefix riece-current-channel)
 156                              topic)))
 157
 158 (defun riece-command-invite (user)
 159   (interactive
 160    (let ((completion-ignore-case t))
 161      (unless (and riece-current-channel
 162                   (riece-channel-p (riece-identity-prefix
 163                                     riece-current-channel)))
 164        (error "Not on a channel"))
 165      (list (completing-read
 166             "User: "
 167             (mapcar #'list (riece-get-users-on-server))))))
 168   (riece-send-string (format "INVITE %s %s\r\n"
 169                              user (riece-identity-prefix
 170                                    riece-current-channel))))
 171
 172 (defun riece-command-kick (user &optional message)
 173   (interactive
 174    (let ((completion-ignore-case t))
 175      (unless (and riece-current-channel
 176                   (riece-channel-p (riece-identity-prefix
 177                                     riece-current-channel)))
 178        (error "Not on a channel"))
 179      (list (completing-read
 180             "User: "
 181             (mapcar #'list (riece-channel-get-users
 182                             riece-current-channel)))
 183            (if current-prefix-arg
 184                (read-string "Message: ")))))
 185   (riece-send-string
 186    (if message
 187        (format "KICK %s %s :%s\r\n"
 188                (riece-identity-prefix riece-current-channel)
 189                user message)
 190      (format "KICK %s %s\r\n"
 191              (riece-identity-prefix riece-current-channel)
 192              user))))
 193
 194 (defun riece-command-names (pattern)
 195   (interactive
 196    (let ((completion-ignore-case t))
 197      (list (read-from-minibuffer
 198             "Pattern: "
 199             (if (and riece-current-channel
 200                      (riece-channel-p (riece-identity-prefix
 201                                        riece-current-channel)))
 202                 (cons (riece-decode-identity riece-current-channel t)
 203                       0))))))
 204   (if (or (not (equal pattern ""))
 205           (yes-or-no-p "Really want to query NAMES without argument? "))
 206       (riece-send-string (format "NAMES %s\r\n" pattern))))
 207
 208 (defun riece-command-who (pattern)
 209   (interactive
 210    (let ((completion-ignore-case t))
 211      (list (read-from-minibuffer
 212             "Pattern: "
 213             (if (and riece-current-channel
 214                      (riece-channel-p (riece-identity-prefix
 215                                        riece-current-channel)))
 216                 (cons (riece-decode-identity riece-current-channel t)
 217                       0))))))
 218   (if (or (not (equal pattern ""))
 219           (yes-or-no-p "Really want to query WHO without argument? "))
 220       (riece-send-string (format "WHO %s\r\n" pattern))))
 221
 222 (defun riece-command-list (pattern)
 223   (interactive
 224    (let ((completion-ignore-case t))
 225      (list (read-from-minibuffer
 226             "Pattern: "
 227             (if (and riece-current-channel
 228                      (riece-channel-p (riece-identity-prefix
 229                                        riece-current-channel)))
 230                 (cons (riece-decode-identity riece-current-channel t)
 231                       0))))))
 232   (if (or (not (equal pattern ""))
 233           (yes-or-no-p "Really want to query LIST without argument? "))
 234       (riece-send-string (format "LIST %s\r\n" pattern))))
 235
 236 (defun riece-command-change-mode (channel change)
 237   (interactive
 238    (let* ((completion-ignore-case t)
 239           (channel
 240            (if current-prefix-arg
 241                (riece-completing-read-identity
 242                 "Channel/User: " riece-current-channels)
 243              riece-current-channel))
 244           (riece-overriding-server-name (riece-identity-server channel))
 245           (riece-temp-minibuffer-message
 246            (concat "[Available modes: "
 247                    (riece-with-server-buffer (riece-identity-server channel)
 248                      (if (riece-channel-p (riece-identity-prefix channel))
 249                          (if riece-supported-channel-modes
 250                              (apply #'string riece-supported-channel-modes))
 251                        (if riece-supported-user-modes
 252                            (apply #'string riece-supported-user-modes))))
 253                    "]")))
 254      (list channel
 255            (read-from-minibuffer
 256             (concat (riece-concat-channel-modes
 257                      channel "Mode (? for help)") ": ")
 258             nil riece-minibuffer-map))))
 259   (riece-send-string (format "MODE %s :%s\r\n" (riece-identity-prefix channel)
 260                              change)))
 261
 262 (defun riece-command-set-operators (users &optional arg)
 263   (interactive
 264    (let ((operators
 265           (riece-with-identity-buffer riece-current-channel
 266             (riece-channel-get-operators
 267              (riece-identity-prefix riece-current-channel))))
 268          (completion-ignore-case t)
 269          users)
 270      (if current-prefix-arg
 271          (setq users (riece-completing-read-multiple
 272                       "Users"
 273                       (mapcar #'list operators)))
 274        (setq users (riece-completing-read-multiple
 275                     "Users"
 276                     (delq nil (mapcar
 277                                (lambda (user)
 278                                  (unless (member user operators)
 279                                    (list user)))
 280                                (riece-with-identity-buffer
 281                                    riece-current-channel
 282                                  (riece-channel-get-users
 283                                   (riece-identity-prefix
 284                                    riece-current-channel))))))))
 285      (list users current-prefix-arg)))
 286   (let (group)
 287     (while users
 288       (setq group (cons (car users) group)
 289             users (cdr users))
 290       (if (or (= (length group) 3)
 291               (null users))
 292           (riece-send-string
 293            (format "MODE %s %c%s %s\r\n"
 294                    (riece-identity-prefix riece-current-channel)
 295                    (if current-prefix-arg
 296                        ?-
 297                      ?+)
 298                    (make-string (length group) ?o)
 299                    (mapconcat #'identity group " ")))))))
 300
 301 (defun riece-command-set-speakers (users &optional arg)
 302   (interactive
 303    (let ((speakers
 304           (riece-with-identity-buffer riece-current-channel
 305             (riece-channel-get-speakers
 306              (riece-identity-prefix riece-current-channel))))
 307          (completion-ignore-case t)
 308          users)
 309      (if current-prefix-arg
 310          (setq users (riece-completing-read-multiple
 311                       "Users"
 312                       (mapcar #'list speakers)))
 313        (setq users (riece-completing-read-multiple
 314                     "Users"
 315                     (delq nil (mapcar
 316                                (lambda (user)
 317                                  (unless (member user speakers)
 318                                    (list user)))
 319                                (riece-with-identity-buffer
 320                                    riece-current-channel
 321                                  (riece-channel-get-users
 322                                   (riece-identity-prefix
 323                                    riece-current-channel))))))))
 324      (list users current-prefix-arg)))
 325   (let (group)
 326     (while users
 327       (setq group (cons (car users) group)
 328             users (cdr users))
 329       (if (or (= (length group) 3)
 330               (null users))
 331           (riece-send-string
 332            (format "MODE %s %c%s %s\r\n"
 333                    (riece-identity-prefix riece-current-channel)
 334                    (if current-prefix-arg
 335                        ?-
 336                      ?+)
 337                    (make-string (length group) ?v)
 338                    (mapconcat #'identity group " ")))))))
 339
 340 (defun riece-command-send-message (message notice)
 341   "Send MESSAGE to the current channel."
 342   (if (equal message "")
 343       (error "No text to send"))
 344   (unless riece-current-channel
 345     (error (substitute-command-keys
 346             "Type \\[riece-command-join] to join a channel")))
 347   (if notice
 348       (progn
 349         (riece-send-string
 350          (format "NOTICE %s :%s\r\n"
 351                  (riece-identity-prefix riece-current-channel)
 352                  message))
 353         (riece-display-message
 354          (riece-make-message (riece-current-nickname) riece-current-channel
 355                              message 'notice t)))
 356     (riece-send-string
 357      (format "PRIVMSG %s :%s\r\n"
 358              (riece-identity-prefix riece-current-channel)
 359              message))
 360     (riece-display-message
 361      (riece-make-message (riece-current-nickname) riece-current-channel
 362                          message nil t))))
 363
 364 (defun riece-command-enter-message ()
 365   "Send the current line to the current channel."
 366   (interactive)
 367   (riece-command-send-message (buffer-substring
 368                                (riece-line-beginning-position)
 369                                (riece-line-end-position))
 370                               nil)
 371   (let ((next-line-add-newlines t))
 372     (next-line 1)))
 373
 374 (defun riece-command-enter-message-as-notice ()
 375   "Send the current line to the current channel as NOTICE."
 376   (interactive)
 377   (riece-command-send-message (buffer-substring
 378                                (riece-line-beginning-position)
 379                                (riece-line-end-position))
 380                               t)
 381   (let ((next-line-add-newlines t))
 382     (next-line 1)))
 383
 384 (defun riece-command-join-channel (target key)
 385   (let ((process (riece-server-process (riece-identity-server target))))
 386     (unless process
 387       (error "%s" (substitute-command-keys
 388                    "Type \\[riece-command-open-server] to open server.")))
 389     (riece-process-send-string process
 390                                (if key
 391                                    (format "JOIN %s :%s\r\n"
 392                                            (riece-identity-prefix target)
 393                                            key)
 394                                  (format "JOIN %s\r\n"
 395                                          (riece-identity-prefix target))))))
 396
 397 (defun riece-command-join-partner (target)
 398   (let ((pointer (riece-identity-member target riece-current-channels)))
 399     (if pointer
 400         (riece-command-switch-to-channel (car pointer))
 401       (riece-join-channel target)
 402       (riece-switch-to-channel target)
 403       (riece-redisplay-buffers))))
 404
 405 (defun riece-command-join (target &optional key)
 406   (interactive
 407    (let ((completion-ignore-case t)
 408          (target
 409           (riece-completing-read-identity
 410            "Channel/User: " riece-current-channels))
 411          key)
 412      (if (and current-prefix-arg
 413               (riece-channel-p target))
 414          (setq key
 415                (riece-read-passwd (format "Key for %s: " target))))
 416      (list target key)))
 417   (let ((pointer (riece-identity-member target riece-current-channels)))
 418     (if pointer
 419         (riece-command-switch-to-channel (car pointer))
 420       (if (riece-channel-p (riece-identity-prefix target))
 421           (riece-command-join-channel target key)
 422         (riece-command-join-partner target)))))
 423
 424 (defun riece-command-part-channel (target message)
 425   (let ((process (riece-server-process (riece-identity-server target))))
 426     (unless process
 427       (error "%s" (substitute-command-keys
 428                    "Type \\[riece-command-open-server] to open server.")))
 429     (riece-process-send-string process
 430                                (if message
 431                                    (format "PART %s :%s\r\n"
 432                                            (riece-identity-prefix target)
 433                                            message)
 434                                  (format "PART %s\r\n"
 435                                          (riece-identity-prefix target))))))
 436
 437 (defun riece-command-part (target &optional message)
 438   (interactive
 439    (let ((completion-ignore-case t)
 440          (target
 441           (riece-completing-read-identity
 442            "Channel/User: " riece-current-channels))
 443          message)
 444      (if (and current-prefix-arg
 445               (riece-channel-p (riece-identity-prefix target)))
 446          (setq message (read-string "Message: ")))
 447      (list target message)))
 448   (if (riece-identity-member target riece-current-channels)
 449       (if (riece-channel-p (riece-identity-prefix target))
 450           (riece-command-part-channel target message)
 451         (riece-part-channel target)
 452         (riece-redisplay-buffers))
 453     (error "You are not talking with %s" target)))
 454
 455 (defun riece-command-change-nickname (nickname)
 456   "Change your nickname to NICK."
 457   (interactive "sEnter your nickname: ")
 458   (riece-send-string (format "NICK %s\r\n" nickname)))
 459
 460 (defun riece-command-scroll-down (lines)
 461   "Scroll LINES down dialogue buffer from command buffer."
 462   (interactive "P")
 463   (let ((other-window-scroll-buffer
 464          (if riece-channel-buffer-mode
 465              riece-channel-buffer
 466            riece-dialogue-buffer)))
 467     (when (get-buffer-window other-window-scroll-buffer)
 468       (condition-case nil
 469           (scroll-other-window-down lines)
 470         (beginning-of-buffer
 471          (message "Beginning of buffer"))))))
 472
 473 (defun riece-command-scroll-up (lines)
 474   "Scroll LINES up dialogue buffer from command buffer."
 475   (interactive "P")
 476   (let* ((other-window-scroll-buffer
 477           (if riece-channel-buffer-mode
 478               riece-channel-buffer
 479             riece-dialogue-buffer)))
 480     (when (get-buffer-window other-window-scroll-buffer)
 481       (condition-case nil
 482           (scroll-other-window lines)
 483         (end-of-buffer
 484          (message "End of buffer"))))))
 485
 486 (defun riece-command-nick-scroll-down (lines)
 487   "Scroll LINES down nick buffer from command buffer."
 488   (interactive "P")
 489   (let ((other-window-scroll-buffer riece-user-list-buffer))
 490     (when (get-buffer-window other-window-scroll-buffer)
 491       (condition-case nil
 492           (scroll-other-window-down lines)
 493         (beginning-of-buffer
 494          (message "Beginning of buffer"))))))
 495
 496 (defun riece-command-nick-scroll-up (lines)
 497   "Scroll LINES up nick buffer from command buffer."
 498   (interactive "P")
 499   (let* ((other-window-scroll-buffer riece-user-list-buffer))
 500     (when (get-buffer-window other-window-scroll-buffer)
 501       (condition-case nil
 502           (scroll-other-window lines)
 503         (end-of-buffer
 504          (message "End of buffer"))))))
 505
 506 (defun riece-command-toggle-away (&optional message)
 507   "Mark yourself as being away."
 508   (interactive
 509    (if (and (not (riece-user-get-away (riece-current-nickname)))
 510             (or (null riece-away-message)
 511                 current-prefix-arg))
 512        (let ((message (read-string "Away message: ")))
 513          (list message))))
 514   (if message
 515       (riece-send-string (format "AWAY :%s\r\n" message))
 516     (riece-send-string "AWAY\r\n")))
 517
 518 (defun riece-command-toggle-freeze (&optional arg)
 519   "Prevent automatic scrolling of the dialogue window.
 520 If prefix argument ARG is non-nil, toggle frozen status."
 521   (interactive "P")
 522   (with-current-buffer (if (and riece-channel-buffer-mode
 523                                 riece-channel-buffer)
 524                            riece-channel-buffer
 525                          riece-dialogue-buffer)
 526     (setq riece-freeze (if arg
 527                            (< 0 (prefix-numeric-value arg))
 528                          (not riece-freeze))))
 529   (riece-update-status-indicators)
 530   (force-mode-line-update t))
 531
 532 (defun riece-command-toggle-own-freeze (&optional arg)
 533   "Prevent automatic scrolling of the dialogue window.
 534 The difference from `riece-command-freeze' is that your messages are hidden.
 535 If prefix argument ARG is non-nil, toggle frozen status."
 536   (interactive "P")
 537   (with-current-buffer (if (and riece-channel-buffer-mode
 538                                 riece-channel-buffer)
 539                            riece-channel-buffer
 540                          riece-dialogue-buffer)
 541     (if (if arg
 542             (< 0 (prefix-numeric-value arg))
 543           (not (eq riece-freeze 'own)))
 544         (setq riece-freeze 'own)
 545       (setq riece-freeze nil)))
 546   (riece-update-status-indicators)
 547   (force-mode-line-update t))
 548
 549 (defun riece-command-quit (&optional arg)
 550   "Quit IRC."
 551   (interactive "P")
 552   (if (y-or-n-p "Really quit IRC? ")
 553       (let ((message
 554              (if arg
 555                  (read-string "Message: ")
 556                (or riece-quit-message
 557                    (riece-extended-version))))
 558             (process-list riece-process-list))
 559         (while process-list
 560           (riece-process-send-string (car process-list)
 561                                      (if message
 562                                        (format "QUIT :%s\r\n" message)
 563                                      "QUIT\r\n"))
 564           (setq process-list (cdr process-list))))))
 565
 566 (defun riece-command-raw (command)
 567   "Enter raw IRC command, which is sent to the server."
 568   (interactive "sIRC command: ")
 569   (riece-send-string (concat command "\r\n")))
 570
 571 (defun riece-command-end-of-buffer ()
 572   "Get end of the dialogue buffer."
 573   (interactive)
 574   (let (buffer window)
 575     (setq buffer (if riece-channel-buffer-mode
 576                      riece-channel-buffer
 577                    riece-dialogue-buffer))
 578     (or (setq window (get-buffer-window buffer))
 579         (setq window (get-buffer-window riece-dialogue-buffer)
 580               buffer riece-dialogue-buffer))
 581     (when window
 582       (save-selected-window
 583         (select-window window)
 584         (goto-char (point-max))))))
 585
 586 (defun riece-command-copy-region (start end)
 587   "Move current region between START and END to `kill-ring'."
 588   (interactive "r")
 589   (kill-new (buffer-substring-no-properties start end)))
 590
 591 (defun riece-command-open-server (server-name)
 592   (interactive
 593    (list (completing-read "Server: " riece-server-alist)))
 594   (if (riece-server-process server-name)
 595       (error "%s is already opened" server-name))
 596   (riece-open-server
 597    (riece-server-name-to-server server-name)
 598    server-name))
 599
 600 (defun riece-command-close-server (server-name &optional message)
 601   (interactive
 602    (list (completing-read
 603           "Server: "
 604           (mapcar
 605            (lambda (process)
 606              (with-current-buffer (process-buffer process)
 607                (list riece-server-name)))
 608            riece-process-list))
 609          (if current-prefix-arg
 610              (read-string "Message: ")
 611            (or riece-quit-message
 612                (riece-extended-version)))))
 613   (riece-process-send-string (riece-server-process server-name)
 614                              (if message
 615                                  (format "QUIT :%s\r\n" message)
 616                                "QUIT\r\n")))
 617
 618 (defun riece-command-universal-server-name-argument ()
 619   (interactive)
 620   (let* ((riece-overriding-server-name
 621           (completing-read
 622            "Server: "
 623            (mapcar
 624             (lambda (process)
 625               (with-current-buffer (process-buffer process)
 626                 (list riece-server-name)))
 627             riece-process-list)))
 628          (command
 629           (key-binding (read-key-sequence
 630                         (format "Command to execute on \"%s\":"
 631                                 riece-overriding-server-name)))))
 632     (message "")
 633     (call-interactively command)))
 634
 635 (provide 'riece-commands)
 636
 637 ;;; riece-commands.el ends here