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 (eval-when-compile (require 'riece-inlines))
29 (require 'riece-channel)
30 (require 'riece-complete)
31 (require 'riece-display)
32 (require 'riece-version)
33 (require 'riece-server)
35 (require 'riece-identity)
36 (require 'riece-message)
39 (defun riece-command-switch-to-channel (channel)
41 (list (completing-read "Channel/user: "
42 (mapcar #'list riece-current-channels)
44 (riece-switch-to-channel channel)
45 (riece-command-configure-windows))
47 (defun riece-command-switch-to-channel-by-number (number)
49 (let ((command-name (symbol-name this-command)))
50 (if (string-match "[0-9]+$" command-name)
51 (list (string-to-number (match-string 0 command-name)))
52 (list (string-to-number (read-string "Number: "))))))
53 (let ((channels riece-current-channels)
58 (setq index (1+ index)))
59 (setq channels (cdr channels)))
61 (riece-command-switch-to-channel (car channels))
62 (error "No such number!"))))
67 (defalias (intern (concat "riece-command-switch-to-channel-by-number-"
68 (number-to-string number)))
69 'riece-command-switch-to-channel-by-number)
70 (setq number (1+ number)))))
72 (defun riece-command-next-channel ()
73 "Select the next channel."
75 (let ((pointer (cdr (string-list-member-ignore-case
77 riece-current-channels))))
80 (setq pointer (cdr pointer)))
82 (riece-command-switch-to-channel (car pointer))
83 (error "No such channel!"))))
85 (defun riece-command-previous-channel ()
86 "Select the previous channel."
88 (let ((pointer (string-list-member-ignore-case
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 (riece-command-switch-to-channel channel)
99 (error "No such channel!"))))
101 (defun riece-command-select-command-buffer ()
102 "Select the command buffer."
104 (let ((window (get-buffer-window riece-command-buffer)))
106 (select-window window))))
108 (defun riece-command-configure-windows ()
110 (riece-redisplay-buffers t))
112 (defun riece-command-toggle-channel-buffer-mode ()
114 (setq riece-channel-buffer-mode
115 (not riece-channel-buffer-mode))
116 (riece-command-configure-windows))
118 (defun riece-command-toggle-user-list-buffer-mode ()
120 (setq riece-user-list-buffer-mode
121 (not riece-user-list-buffer-mode))
122 (riece-command-configure-windows))
124 (defun riece-command-toggle-channel-list-buffer-mode ()
126 (setq riece-channel-list-buffer-mode
127 (not riece-channel-list-buffer-mode))
128 (riece-command-configure-windows))
130 (defun riece-get-users-on-server ()
131 (riece-with-server-buffer
135 (unless (riece-channel-p (symbol-name atom))
136 (push (symbol-name atom) users)))
138 (if (member riece-real-nickname users)
140 (cons riece-real-nickname users)))))
142 (defun riece-command-finger (user &optional recurse)
144 (let* ((completion-ignore-case t)
145 (user (completing-read
147 (mapcar #'list (riece-get-users-on-server)))))
148 (list user current-prefix-arg)))
150 (riece-send-string (format "WHOIS %s %s\r\n" user user))
151 (riece-send-string (format "WHOIS %s\r\n" user))))
153 (defun riece-command-topic (topic)
155 (list (read-from-minibuffer
156 "Topic: " (cons (or (riece-channel-get-topic
157 riece-current-channel)
160 (riece-send-string (format "TOPIC %s :%s\r\n"
161 (riece-identity-prefix riece-current-channel)
164 (defun riece-command-invite (user)
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
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))))
177 (defun riece-command-kick (user &optional message)
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
185 (mapcar #'list (riece-channel-get-users
186 riece-current-channel)))
187 (if current-prefix-arg
188 (read-string "Message: ")))))
191 (format "KICK %s %s :%s\r\n"
192 (riece-identity-prefix riece-current-channel)
194 (format "KICK %s %s\r\n"
195 (riece-identity-prefix riece-current-channel)
198 (defun riece-command-names (pattern)
200 (let ((completion-ignore-case t))
201 (list (read-from-minibuffer
203 (if (and riece-current-channel
204 (riece-channel-p riece-current-channel))
205 (cons (riece-identity-prefix riece-current-channel)
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))))
211 (defun riece-command-who (pattern)
213 (let ((completion-ignore-case t))
214 (list (read-from-minibuffer
216 (if (and riece-current-channel
217 (riece-channel-p riece-current-channel))
218 (cons (riece-identity-prefix riece-current-channel)
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))))
224 (defun riece-command-change-mode (channel change)
226 (let* ((completion-ignore-case t)
228 (if current-prefix-arg
231 (mapcar #'list riece-current-channels))
232 riece-current-channel))
233 (riece-overriding-server-name (riece-identity-server channel))
234 (riece-temp-minibuffer-message
235 (concat "[Available modes: "
236 (riece-with-server-buffer
237 (if (and (riece-channel-p channel)
238 riece-supported-channel-modes)
239 (apply #'string riece-supported-channel-modes)
240 (if (and (not (riece-channel-p channel))
241 riece-supported-user-modes)
242 (apply #'string riece-supported-user-modes))))
245 (read-from-minibuffer
246 (concat (riece-concat-modes channel "Mode (? for help)") ": ")
247 nil riece-minibuffer-map))))
248 (riece-send-string (format "MODE %s :%s\r\n" channel change)))
250 (defun riece-command-set-operators (users &optional arg)
252 (let ((operators (riece-channel-get-operators riece-current-channel))
253 (completion-ignore-case t)
255 (if current-prefix-arg
256 (setq users (riece-completing-read-multiple
258 (mapcar #'list operators)))
259 (setq users (riece-completing-read-multiple
261 (delq nil (mapcar (lambda (user)
262 (unless (member user operators)
264 (riece-channel-get-users
265 riece-current-channel))))))
266 (list users current-prefix-arg)))
269 (push (pop users) group)
270 (if (or (= (length group) 3)
273 (format "MODE %s %c%s %s\r\n"
274 (riece-identity-prefix riece-current-channel)
275 (if current-prefix-arg
278 (make-string (length group) ?o)
279 (mapconcat #'identity group " ")))))))
281 (defun riece-command-set-speakers (users &optional arg)
283 (let ((speakers (riece-channel-get-speakers riece-current-channel))
284 (completion-ignore-case t)
286 (if current-prefix-arg
287 (setq users (riece-completing-read-multiple
289 (mapcar #'list speakers)))
290 (setq users (riece-completing-read-multiple
292 (delq nil (mapcar (lambda (user)
293 (unless (member user speakers)
295 (riece-channel-get-users
296 riece-current-channel))))))
297 (list users current-prefix-arg)))
300 (push (pop users) group)
301 (if (or (= (length group) 3)
304 (format "MODE %s %c%s %s\r\n"
305 (riece-identity-prefix riece-current-channel)
306 (if current-prefix-arg
309 (make-string (length group) ?v)
310 (mapconcat #'identity group " ")))))))
312 (defun riece-command-send-message (message)
313 "Send MESSAGE to the current channel."
314 (if (equal message "")
315 (error "No text to send"))
316 (unless riece-current-channel
317 (error (substitute-command-keys
318 "Type \\[riece-command-join] to join a channel")))
320 (format "PRIVMSG %s :%s\r\n"
321 (riece-identity-prefix riece-current-channel)
323 (riece-own-channel-message message))
325 (defun riece-command-enter-message ()
326 "Send the current line to the current channel."
328 (riece-command-send-message (buffer-substring
329 (riece-line-beginning-position)
330 (riece-line-end-position)))
331 (let ((next-line-add-newlines t))
334 (defun riece-command-join-channel (target key)
335 (let ((server-name (riece-identity-server target))
338 (setq process (cdr (assoc server-name riece-server-process-alist)))
339 (setq process riece-server-process))
341 (error "%s" (substitute-command-keys
342 "Type \\[riece-command-open-server] to open server.")))
343 (riece-process-send-string process
345 (format "JOIN %s :%s\r\n"
346 (riece-identity-prefix target)
348 (format "JOIN %s\r\n"
349 (riece-identity-prefix target))))))
351 (defun riece-command-join-partner (target)
352 (let ((pointer (riece-identity-member target riece-current-channels)))
354 (riece-command-switch-to-channel (car pointer))
355 (riece-join-channel target)
356 (riece-switch-to-channel target)
357 (riece-redisplay-buffers))))
359 (defun riece-command-join (target &optional key)
361 (let ((completion-ignore-case t)
363 (completing-read "Channel/user: "
364 (mapcar #'list riece-current-channels)))
366 (if (and current-prefix-arg
367 (riece-channel-p target))
369 (riece-read-passwd (format "Key for %s: " target))))
371 (let ((pointer (riece-identity-member target riece-current-channels)))
373 (riece-command-switch-to-channel (car pointer))
374 (if (riece-channel-p target)
375 (riece-command-join-channel target key)
376 (riece-command-join-partner target)))))
378 (defun riece-command-part-channel (target message)
379 (let ((server-name (riece-identity-server target))
382 (setq process (cdr (assoc server-name riece-server-process-alist)))
383 (setq process riece-server-process))
385 (error "%s" (substitute-command-keys
386 "Type \\[riece-command-open-server] to open server.")))
387 (riece-process-send-string process
389 (format "PART %s :%s\r\n"
390 (riece-identity-prefix target)
392 (format "PART %s\r\n"
393 (riece-identity-prefix target))))))
395 (defun riece-command-part (target &optional message)
397 (let ((completion-ignore-case t)
399 (completing-read "Channel/user: "
400 (mapcar #'list riece-current-channels)
401 nil t (cons riece-current-channel 0)))
403 (if (and current-prefix-arg
404 (riece-channel-p target))
405 (setq message (read-string "Message: ")))
406 (list target message)))
407 (if (riece-identity-member target riece-current-channels)
408 (if (riece-channel-p target)
409 (riece-command-part-channel target message)
410 (riece-part-channel target)
411 (riece-redisplay-buffers))
412 (error "You are not talking with %s" target)))
414 (defun riece-command-change-nickname (nickname)
415 "Change your nickname to NICK."
416 (interactive "sEnter your nickname: ")
417 (riece-send-string (format "NICK %s\r\n" nickname)))
419 (defun riece-command-scroll-down (lines)
420 "Scroll LINES down dialogue buffer from command buffer."
422 (let ((other-window-scroll-buffer
423 (if riece-channel-buffer-mode
425 riece-dialogue-buffer)))
426 (when (get-buffer-window other-window-scroll-buffer)
428 (scroll-other-window-down lines)
430 (message "Beginning of buffer"))))))
432 (defun riece-command-scroll-up (lines)
433 "Scroll LINES up dialogue buffer from command buffer."
435 (let* ((other-window-scroll-buffer
436 (if riece-channel-buffer-mode
438 riece-dialogue-buffer)))
439 (when (get-buffer-window other-window-scroll-buffer)
441 (scroll-other-window lines)
443 (message "End of buffer"))))))
445 (defun riece-command-nick-scroll-down (lines)
446 "Scroll LINES down nick buffer from command buffer."
448 (let ((other-window-scroll-buffer riece-user-list-buffer))
449 (when (get-buffer-window other-window-scroll-buffer)
451 (scroll-other-window-down lines)
453 (message "Beginning of buffer"))))))
455 (defun riece-command-nick-scroll-up (lines)
456 "Scroll LINES up nick buffer from command buffer."
458 (let* ((other-window-scroll-buffer riece-user-list-buffer))
459 (when (get-buffer-window other-window-scroll-buffer)
461 (scroll-other-window lines)
463 (message "End of buffer"))))))
465 (defun riece-command-toggle-away (&optional message)
466 "Mark yourself as being away."
468 (if current-prefix-arg
469 (let ((message (read-string "Away message: ")))
472 (riece-send-string (format "AWAY :%s\r\n" message))
473 (riece-send-string "AWAY\r\n")))
475 (defun riece-command-toggle-freeze (&optional arg)
476 "Prevent automatic scrolling of the dialogue window.
477 If prefix argument ARG is non-nil, toggle frozen status."
479 (riece-freeze (if riece-channel-buffer-mode
481 riece-dialogue-buffer)
482 (if arg (prefix-numeric-value arg))))
484 (defun riece-command-toggle-own-freeze (&optional arg)
485 "Prevent automatic scrolling of the dialogue window.
486 The difference from `riece-command-freeze' is that your messages are hidden.
487 If prefix argument ARG is non-nil, toggle frozen status."
489 (riece-own-freeze (if riece-channel-buffer-mode
491 riece-dialogue-buffer)
492 (if arg (prefix-numeric-value arg))))
494 (defun riece-command-quit (&optional arg)
497 (if (y-or-n-p "Really quit IRC? ")
500 (read-string "Message: ")
501 (or riece-quit-message
502 (riece-extended-version)))))
503 (riece-close-all-server message))))
505 (defun riece-command-raw (command)
506 "Enter raw IRC command, which is sent to the server."
507 (interactive "sIRC command: ")
508 (riece-send-string (concat command "\r\n")))
510 (defun riece-command-end-of-buffer ()
511 "Get end of the dialogue buffer."
514 (setq buffer (if riece-channel-buffer-mode
516 riece-dialogue-buffer))
517 (or (setq window (get-buffer-window buffer))
518 (setq window (get-buffer-window riece-dialogue-buffer)
519 buffer riece-dialogue-buffer))
521 (save-selected-window
522 (select-window window)
523 (goto-char (point-max))))))
525 (defun riece-command-copy-region (start end)
526 "Move current region between START and END to `kill-ring'."
528 (kill-new (buffer-substring-no-properties start end)))
530 (defun riece-command-open-server (server-name)
532 (list (completing-read "Server: " riece-server-alist)))
533 (let ((process (riece-start-server
534 (riece-server-name-to-server server-name)
536 (with-current-buffer (process-buffer process)
537 (setq riece-server-name server-name))
538 (push (cons server-name process) riece-server-process-alist)))
540 (defun riece-command-close-server (server-name &optional message)
542 (list (completing-read "Server: " riece-server-process-alist)
543 (if current-prefix-arg
544 (read-string "Message: ")
545 (or riece-quit-message
546 (riece-extended-version)))))
547 (riece-close-server server-name message))
549 (defun riece-command-universal-server-name-argument ()
551 (let* ((riece-overriding-server-name
552 (completing-read "Server: "
553 riece-server-process-alist))
555 (key-binding (read-key-sequence
556 (format "Command to execute on \"%s\":"
557 riece-overriding-server-name)))))
559 (call-interactively command)))
561 (provide 'riece-commands)
563 ;;; riece-commands.el ends here