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