1 ;;; riece-commands.el --- commands available in command buffer
2 ;; Copyright (C) 1998-2003 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
6 ;; Keywords: IRC, riece
8 ;; This file is part of Riece.
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)
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.
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.
27 (require 'riece-channel)
28 (require 'riece-complete)
29 (require 'riece-layout)
30 (require 'riece-display)
31 (require 'riece-server)
33 (require 'riece-identity)
34 (require 'riece-message)
36 (autoload 'derived-mode-class "derived")
39 (defun riece-command-switch-to-channel (channel)
40 (interactive (list (riece-completing-read-identity
41 "Switch to channel/user: "
42 riece-current-channels nil t)))
43 (unless (equal channel riece-current-channel)
44 (riece-switch-to-channel channel)))
46 (defun riece-command-switch-to-channel-by-number (number)
48 (let ((command-name (symbol-name this-command)))
49 (if (string-match "[0-9]+$" command-name)
50 (list (string-to-number (match-string 0 command-name)))
51 (list (string-to-number (read-string "Switch to number: "))))))
52 (let ((channel (nth (1- number) riece-current-channels)))
54 (riece-command-switch-to-channel channel)
55 (error "No such number!"))))
60 (defalias (intern (concat "riece-command-switch-to-channel-by-number-"
61 (number-to-string number)))
62 'riece-command-switch-to-channel-by-number)
63 (setq number (1+ number)))))
65 (defun riece-command-next-channel ()
66 "Select the next channel."
68 (when (> (length riece-current-channels) 1)
69 (let ((pointer (cdr (riece-identity-member
71 riece-current-channels))))
74 (setq pointer (cdr pointer)))
76 (setq pointer riece-current-channels)
79 (setq pointer (cdr pointer))))
81 (riece-command-switch-to-channel (car pointer))
82 (error "No such channel!")))))
84 (defun riece-command-previous-channel ()
85 "Select the previous channel."
87 (when (> (length riece-current-channels) 1)
88 (let ((pointer (riece-identity-member
90 riece-current-channels))
91 (start riece-current-channels)
93 (while (and start (not (eq start pointer)))
95 (setq channel (car start)))
96 (setq start (cdr start)))
98 (setq start (copy-sequence riece-current-channels))
99 (setq start (delq nil start))
100 (and (> (length start) 1)
101 (setq channel (nth (1- (length start)) start))))
103 (riece-command-switch-to-channel channel)
104 (error "No such channel!")))))
106 (defun riece-command-select-command-buffer ()
107 "Select the command buffer."
109 (let ((window (get-buffer-window riece-command-buffer)))
111 (select-window window))))
113 (defun riece-command-configure-windows ()
115 "Reconfigure windows with the current layout."
116 (riece-redisplay-buffers t))
118 (defun riece-command-suspend-resume ()
120 "Save or restore the current window configuration."
121 (let ((entry (assq 'riece-window-configuration (frame-parameters))))
122 (modify-frame-parameters (selected-frame)
123 (list (cons 'riece-window-configuration
124 (current-window-configuration))))
126 (set-window-configuration (cdr entry))
127 (delete-other-windows))
129 (substitute-command-keys
130 "\\[riece-command-suspend-resume] to get back the last windows"))))
132 (defun riece-command-change-layout (name)
133 "Select a layout-name from all current available layouts and change
134 the layout to the selected layout-name."
135 (interactive (list (completing-read "Change layout: " riece-layout-alist)))
136 (setq riece-layout name
137 riece-save-variables-are-dirty t)
138 (riece-command-configure-windows))
140 (defun riece-command-toggle-channel-buffer-mode ()
142 (setq riece-channel-buffer-mode
143 (not riece-channel-buffer-mode)
144 riece-save-variables-are-dirty t)
145 (riece-command-configure-windows))
147 (defun riece-command-toggle-others-buffer-mode ()
149 (setq riece-others-buffer-mode
150 (not riece-others-buffer-mode)
151 riece-save-variables-are-dirty t)
152 (riece-command-configure-windows))
154 (defun riece-command-toggle-user-list-buffer-mode ()
156 (setq riece-user-list-buffer-mode
157 (not riece-user-list-buffer-mode)
158 riece-save-variables-are-dirty t)
159 (riece-command-configure-windows))
161 (defun riece-command-toggle-channel-list-buffer-mode ()
163 (setq riece-channel-list-buffer-mode
164 (not riece-channel-list-buffer-mode)
165 riece-save-variables-are-dirty t)
166 (riece-command-configure-windows))
168 (defun riece-command-finger (user &optional recurse)
170 (let* ((completion-ignore-case t)
171 (user (riece-completing-read-identity
173 (riece-get-users-on-server (riece-current-server-name))
174 nil nil nil nil nil t)))
175 (list user current-prefix-arg)))
177 (riece-send-string (format "WHOIS %s %s\r\n"
178 (riece-identity-prefix user)
179 (riece-identity-prefix user)))
180 (riece-send-string (format "WHOIS %s\r\n" (riece-identity-prefix user)))))
182 (defun riece-command-topic (topic)
185 (riece-check-channel-commands-are-usable t)
186 (list (read-from-minibuffer
187 "Set topic: " (cons (or (riece-with-server-buffer
188 (riece-identity-server
189 riece-current-channel)
190 (riece-channel-get-topic
191 (riece-identity-prefix
192 riece-current-channel)))
195 (riece-send-string (format "TOPIC %s :%s\r\n"
196 (riece-identity-prefix riece-current-channel)
199 (defun riece-command-invite (user)
201 (let ((completion-ignore-case t))
202 (riece-check-channel-commands-are-usable t)
203 (list (riece-completing-read-identity
205 (riece-get-users-on-server (riece-current-server-name))
206 nil nil nil nil nil t))))
207 (riece-send-string (format "INVITE %s %s\r\n"
208 (riece-identity-prefix user)
209 (riece-identity-prefix riece-current-channel))))
211 (defun riece-command-kick (user &optional message)
213 (let ((completion-ignore-case t))
214 (riece-check-channel-commands-are-usable t)
215 (list (completing-read
217 (riece-with-server-buffer
218 (riece-identity-server riece-current-channel)
219 (riece-channel-get-users (riece-identity-prefix
220 riece-current-channel))))
221 (if current-prefix-arg
222 (read-string "Message: ")))))
225 (format "KICK %s %s :%s\r\n"
226 (riece-identity-prefix riece-current-channel)
228 (format "KICK %s %s\r\n"
229 (riece-identity-prefix riece-current-channel)
232 (defun riece-command-names (pattern)
234 (let ((completion-ignore-case t))
235 (list (read-from-minibuffer
237 (if (and riece-current-channel
238 (riece-channel-p (riece-identity-prefix
239 riece-current-channel)))
240 (cons (riece-identity-prefix riece-current-channel)
242 (if (or (not (equal pattern ""))
243 (yes-or-no-p "Really want to query NAMES without argument? "))
244 (riece-send-string (format "NAMES %s\r\n" pattern))))
246 (defun riece-command-who (pattern)
248 (let ((completion-ignore-case t))
249 (list (read-from-minibuffer
251 (if (and riece-current-channel
252 (riece-channel-p (riece-identity-prefix
253 riece-current-channel)))
254 (cons (riece-identity-prefix riece-current-channel)
256 (if (or (not (equal pattern ""))
257 (yes-or-no-p "Really want to query WHO without argument? "))
258 (riece-send-string (format "WHO %s\r\n" pattern))))
260 (defun riece-command-list (pattern)
262 (let ((completion-ignore-case t))
263 (list (read-from-minibuffer
265 (if (and riece-current-channel
266 (riece-channel-p (riece-identity-prefix
267 riece-current-channel)))
268 (cons (riece-identity-prefix riece-current-channel)
270 (if (or (not (equal pattern ""))
271 (yes-or-no-p "Really want to query LIST without argument? "))
272 (riece-send-string (format "LIST %s\r\n" pattern))))
274 (defun riece-command-change-mode (channel change)
276 (let* ((completion-ignore-case t)
278 (if current-prefix-arg
279 (riece-completing-read-identity
280 "Change mode for channel/user: "
281 (riece-get-identities-on-server (riece-current-server-name))
282 nil nil nil nil nil t)
283 (riece-check-channel-commands-are-usable t)
284 riece-current-channel))
285 (riece-overriding-server-name (riece-identity-server channel))
286 (riece-temp-minibuffer-message
287 (concat "[Available modes: "
288 (riece-with-server-buffer (riece-identity-server channel)
289 (if (riece-channel-p (riece-identity-prefix channel))
290 (if riece-supported-channel-modes
291 (apply #'string riece-supported-channel-modes))
292 (if riece-supported-user-modes
293 (apply #'string riece-supported-user-modes))))
296 (read-from-minibuffer
297 (concat (riece-concat-channel-modes
298 channel "Mode (? for help)") ": ")
299 nil riece-minibuffer-map))))
300 (if (equal change "")
301 (riece-send-string (format "MODE %s\r\n"
302 (riece-identity-prefix channel)))
303 (riece-send-string (format "MODE %s %s\r\n"
304 (riece-identity-prefix channel)
307 (defun riece-command-set-operators (users &optional arg)
310 (riece-check-channel-commands-are-usable t)
311 (let ((completion-ignore-case t))
312 (list (riece-completing-read-multiple
313 (if current-prefix-arg
316 (riece-with-server-buffer
317 (riece-identity-server riece-current-channel)
318 (riece-channel-get-users (riece-identity-prefix
319 riece-current-channel)))
320 (if current-prefix-arg
322 (memq ?o (cdr user)))
324 (not (memq ?o (cdr user))))))
325 current-prefix-arg))))
328 (setq group (cons (car users) group)
330 (when (or (= (length group) 3)
333 (format "MODE %s %c%s %s\r\n"
334 (riece-identity-prefix riece-current-channel)
335 (if current-prefix-arg
338 (make-string (length group) ?o)
339 (mapconcat #'identity (nreverse group) " ")))
342 (defun riece-command-set-speakers (users &optional arg)
345 (riece-check-channel-commands-are-usable t)
346 (let ((completion-ignore-case t))
347 (list (riece-completing-read-multiple
348 (if current-prefix-arg
351 (riece-with-server-buffer
352 (riece-identity-server riece-current-channel)
353 (riece-channel-get-users (riece-identity-prefix
354 riece-current-channel)))
355 (if current-prefix-arg
357 (memq ?v (cdr user)))
359 (not (memq ?v (cdr user))))))
360 current-prefix-arg))))
363 (setq group (cons (car users) group)
365 (when (or (= (length group) 3)
368 (format "MODE %s %c%s %s\r\n"
369 (riece-identity-prefix riece-current-channel)
370 (if current-prefix-arg
373 (make-string (length group) ?v)
374 (mapconcat #'identity (nreverse group) " ")))
377 (defun riece-command-send-message (message notice)
378 "Send MESSAGE to the current channel."
379 (run-hooks 'riece-command-send-message-hook)
380 (if (equal message "")
381 (error "No text to send"))
382 (riece-check-channel-commands-are-usable)
386 (format "NOTICE %s :%s\r\n"
387 (riece-identity-prefix riece-current-channel)
389 (riece-display-message
390 (riece-make-message (riece-current-nickname) riece-current-channel
393 (format "PRIVMSG %s :%s\r\n"
394 (riece-identity-prefix riece-current-channel)
396 (riece-display-message
397 (riece-make-message (riece-current-nickname) riece-current-channel
400 (defun riece-command-enter-message ()
401 "Send the current line to the current channel."
403 (riece-command-send-message (buffer-substring
404 (riece-line-beginning-position)
405 (riece-line-end-position))
407 (let ((next-line-add-newlines t))
410 (defun riece-command-enter-message-as-notice ()
411 "Send the current line to the current channel as NOTICE."
413 (riece-command-send-message (buffer-substring
414 (riece-line-beginning-position)
415 (riece-line-end-position))
417 (let ((next-line-add-newlines t))
420 (defun riece-command-enter-message-to-user (user)
421 "Send the current line to USER."
423 (if (and (bolp) (eolp))
424 (error "No text to send")
425 (let ((completion-ignore-case t))
426 (list (riece-completing-read-identity
428 (riece-get-users-on-server (riece-current-server-name))
429 nil nil nil nil nil t)))))
430 (let ((text (buffer-substring
431 (riece-line-beginning-position)
432 (riece-line-end-position))))
434 (format "PRIVMSG %s :%s\r\n" (riece-identity-prefix user) text))
435 (riece-display-message
436 (riece-make-message (riece-current-nickname) user text nil t)))
437 (let ((next-line-add-newlines t))
440 (defun riece-command-join-channel (target key)
441 (let ((process (riece-server-process (riece-identity-server target))))
443 (error "%s" (substitute-command-keys
444 "Type \\[riece-command-open-server] to open server.")))
445 (riece-process-send-string process
447 (format "JOIN %s :%s\r\n"
448 (riece-identity-prefix target)
450 (format "JOIN %s\r\n"
451 (riece-identity-prefix target))))))
453 (defun riece-command-join-partner (target)
454 (let ((pointer (riece-identity-member target riece-current-channels)))
456 (riece-command-switch-to-channel (car pointer))
457 (riece-join-channel target)
458 (riece-switch-to-channel target))))
460 (defun riece-command-join (target)
462 (let ((completion-ignore-case t))
464 (if riece-join-channel-candidate
465 (let ((default (riece-format-identity
466 riece-join-channel-candidate)))
467 (riece-completing-read-identity
468 (format "Join channel/user (default %s): " default)
469 (riece-get-identities-on-server (riece-current-server-name))
470 nil nil nil nil default))
471 (riece-completing-read-identity
472 "Join channel/user: "
473 (riece-get-identities-on-server (riece-current-server-name)))))))
474 (let ((pointer (riece-identity-member target riece-current-channels)))
476 (riece-command-switch-to-channel (car pointer))
477 (if (riece-channel-p (riece-identity-prefix target))
478 (riece-command-join-channel target nil)
479 (riece-command-join-partner target)))))
481 (defun riece-command-part-channel (target message)
482 (let ((process (riece-server-process (riece-identity-server target))))
483 (riece-process-send-string process
485 (format "PART %s :%s\r\n"
486 (riece-identity-prefix target)
488 (format "PART %s\r\n"
489 (riece-identity-prefix target))))))
491 (defun riece-command-part (target &optional message)
494 (riece-check-channel-commands-are-usable)
495 (let* ((completion-ignore-case t)
497 (riece-completing-read-identity
498 (format "Part from channel/user (default %s): "
499 (riece-format-identity riece-current-channel))
500 riece-current-channels nil nil nil nil
501 (riece-format-identity riece-current-channel)))
503 (if current-prefix-arg
504 (read-string "Message: ")
505 riece-part-message)))
506 (list target message))))
507 (if (riece-identity-member target riece-current-channels)
508 (if (riece-channel-p (riece-identity-prefix target))
509 (riece-command-part-channel target message)
510 (riece-part-channel target))
511 (error "You are not talking with %s" target)))
513 (defun riece-command-change-nickname (nickname)
514 "Change your nickname to NICK."
515 (interactive "sEnter your nickname: ")
516 (riece-send-string (format "NICK %s\r\n" nickname)))
518 (defun riece-command-scroll-down (lines)
519 "Scroll LINES down dialogue buffer from command buffer."
521 (let ((buffer (if (and riece-channel-buffer-mode
522 riece-current-channel)
524 riece-dialogue-buffer)))
525 (if (get-buffer-window buffer)
527 (let ((other-window-scroll-buffer buffer))
528 (scroll-other-window-down lines))
530 (message "Beginning of buffer"))))))
532 (defun riece-command-scroll-up (lines)
533 "Scroll LINES up dialogue buffer from command buffer."
535 (let ((buffer (if (and riece-channel-buffer-mode
536 riece-current-channel)
538 riece-dialogue-buffer)))
539 (if (get-buffer-window buffer)
541 (let ((other-window-scroll-buffer buffer))
542 (scroll-other-window lines))
544 (message "End of buffer"))))))
546 (defun riece-command-user-list-scroll-down (lines)
547 "Scroll LINES down user list buffer from command buffer."
549 (if (get-buffer-window riece-user-list-buffer)
551 (let ((other-window-scroll-buffer riece-user-list-buffer))
552 (scroll-other-window-down lines))
554 (message "Beginning of buffer")))))
556 (defun riece-command-user-list-scroll-up (lines)
557 "Scroll LINES up user list buffer from command buffer."
559 (if (get-buffer-window riece-user-list-buffer)
561 (let ((other-window-scroll-buffer riece-user-list-buffer))
562 (scroll-other-window lines))
564 (message "End of buffer")))))
566 (defun riece-command-toggle-away (&optional message)
567 "Mark yourself as being away."
569 (if (and (not (riece-with-server-buffer (riece-identity-server
570 (riece-current-nickname))
571 (riece-user-get-away (riece-identity-prefix
572 (riece-current-nickname)))))
574 (list (read-from-minibuffer
575 "Away message: " (cons (or riece-away-message "") 0)))))
576 (if (riece-with-server-buffer (riece-identity-server
577 (riece-current-nickname))
578 (riece-user-get-away (riece-identity-prefix
579 (riece-current-nickname))))
580 (riece-send-string "AWAY\r\n")
581 (riece-send-string (format "AWAY :%s\r\n" (or message
582 riece-away-message)))))
584 (defun riece-command-toggle-freeze (&optional arg)
585 "Prevent automatic scrolling of the dialogue window.
586 If prefix argument ARG is non-nil, toggle frozen status."
588 (with-current-buffer (if (eq (derived-mode-class major-mode)
589 'riece-dialogue-mode)
591 (if (and riece-channel-buffer-mode
592 riece-channel-buffer)
594 riece-dialogue-buffer))
595 (setq riece-freeze (if arg
596 (< 0 (prefix-numeric-value arg))
598 (riece-emit-signal 'buffer-freeze-changed
599 (current-buffer) riece-freeze)))
601 (defun riece-command-toggle-own-freeze (&optional arg)
602 "Prevent automatic scrolling of the dialogue window.
603 The difference from `riece-command-freeze' is that your messages are hidden.
604 If prefix argument ARG is non-nil, toggle frozen status."
606 (with-current-buffer (if (eq (derived-mode-class major-mode)
607 'riece-dialogue-mode)
609 (if (and riece-channel-buffer-mode
610 riece-channel-buffer)
612 riece-dialogue-buffer))
614 (< 0 (prefix-numeric-value arg))
615 (not (eq riece-freeze 'own)))
616 (setq riece-freeze 'own)
617 (setq riece-freeze nil))
618 (riece-emit-signal 'buffer-freeze-changed
619 (current-buffer) riece-freeze)))
622 (autoload 'riece-exit "riece"))
623 (defun riece-command-quit (&optional arg)
626 (if (null riece-server-process-alist)
628 (message "No server process")
630 (if (y-or-n-p "Really quit IRC? ")
633 (read-string "Message: ")
635 (alist riece-server-process-alist))
637 (riece-quit-server-process (cdr (car alist)) message)
638 (setq alist (cdr alist)))))))
640 (defun riece-command-raw (command)
641 "Enter raw IRC command, which is sent to the server."
642 (interactive "sIRC command: ")
643 (riece-send-string (concat command "\r\n")))
645 (defun riece-command-beginning-of-buffer ()
646 "Scroll channel buffer to the beginning."
649 (setq buffer (if riece-channel-buffer-mode
651 riece-dialogue-buffer))
652 (or (setq window (get-buffer-window buffer))
653 (setq window (get-buffer-window riece-dialogue-buffer)
654 buffer riece-dialogue-buffer))
656 (save-selected-window
657 (select-window window)
658 (goto-char (point-min))))))
660 (defun riece-command-end-of-buffer ()
661 "Scroll channel buffer to the end."
664 (setq buffer (if riece-channel-buffer-mode
666 riece-dialogue-buffer))
667 (or (setq window (get-buffer-window buffer))
668 (setq window (get-buffer-window riece-dialogue-buffer)
669 buffer riece-dialogue-buffer))
671 (save-selected-window
672 (select-window window)
673 (goto-char (point-max))))))
675 (defun riece-command-copy-region (start end)
676 "Move current region between START and END to `kill-ring'."
678 (kill-new (buffer-substring-no-properties start end)))
680 (defun riece-command-complete-user ()
681 "Complete a user name in the current buffer."
683 (let* ((completion-ignore-case t)
684 (table (mapcar (lambda (user)
685 (list (riece-format-identity user t)))
686 (riece-get-users-on-server
687 (riece-current-server-name))))
688 (current (or (current-word) ""))
689 (completion (try-completion current table))
690 (all (all-completions current table)))
691 (if (eq completion t)
693 (if (null completion)
694 (message "Can't find completion for \"%s\"" current)
695 (if (equal current completion)
696 (with-output-to-temp-buffer "*Help*"
697 (display-completion-list all))
698 (re-search-forward "\\>" nil t)
699 (delete-region (point) (- (point) (length current)))
700 (insert completion))))))
702 (defun riece-command-open-server (server-name)
704 (list (completing-read "Open server: " riece-server-alist)))
705 (if (riece-server-process server-name)
706 (error "%s is already opened" server-name))
708 (riece-server-name-to-server server-name)
711 (defun riece-command-close-server (server-name &optional message)
713 (list (completing-read "Close server: " riece-server-process-alist)
714 (if current-prefix-arg
715 (read-string "Message: ")
716 riece-quit-message)))
717 (riece-quit-server-process (riece-server-process server-name) message))
719 (defun riece-command-universal-server-name-argument ()
721 (let* ((riece-overriding-server-name
722 (completing-read "Server: " riece-server-process-alist))
724 (key-binding (read-key-sequence
725 (format "Command to execute on \"%s\":"
726 riece-overriding-server-name)))))
728 (call-interactively command)))
730 (provide 'riece-commands)
732 ;;; riece-commands.el ends here