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

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