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-change-mode (channel change)
200 (let* ((completion-ignore-case t)
202 (if current-prefix-arg
205 (mapcar #'list riece-current-channels))
206 riece-current-channel))
207 (riece-overriding-server-name (riece-identity-server channel))
208 (riece-temp-minibuffer-message
209 (concat "[Available modes: "
210 (riece-with-server-buffer
211 (if (and (riece-channel-p channel)
212 riece-supported-channel-modes)
213 (apply #'string riece-supported-channel-modes)
214 (if (and (not (riece-channel-p channel))
215 riece-supported-user-modes)
216 (apply #'string riece-supported-user-modes))))
219 (read-from-minibuffer
220 (concat (riece-concat-modes channel "Mode (? for help)") ": ")
221 nil riece-minibuffer-map))))
222 (riece-send-string (format "MODE %s :%s\r\n" channel change)))
224 (defun riece-command-set-operators (users &optional arg)
226 (let ((operators (riece-channel-get-operators riece-current-channel))
227 (completion-ignore-case t)
229 (if current-prefix-arg
230 (setq users (riece-completing-read-multiple
232 (mapcar #'list operators)))
233 (setq users (riece-completing-read-multiple
235 (delq nil (mapcar (lambda (user)
236 (unless (member user operators)
238 (riece-channel-get-users
239 riece-current-channel))))))
240 (list users current-prefix-arg)))
243 (push (pop users) group)
244 (if (or (= (length group) 3)
247 (format "MODE %s %c%s %s\r\n"
248 (riece-identity-prefix riece-current-channel)
249 (if current-prefix-arg
252 (make-string (length group) ?o)
253 (mapconcat #'identity group " ")))))))
255 (defun riece-command-set-speakers (users &optional arg)
257 (let ((speakers (riece-channel-get-speakers riece-current-channel))
258 (completion-ignore-case t)
260 (if current-prefix-arg
261 (setq users (riece-completing-read-multiple
263 (mapcar #'list speakers)))
264 (setq users (riece-completing-read-multiple
266 (delq nil (mapcar (lambda (user)
267 (unless (member user speakers)
269 (riece-channel-get-users
270 riece-current-channel))))))
271 (list users current-prefix-arg)))
274 (push (pop users) group)
275 (if (or (= (length group) 3)
278 (format "MODE %s %c%s %s\r\n"
279 (riece-identity-prefix riece-current-channel)
280 (if current-prefix-arg
283 (make-string (length group) ?v)
284 (mapconcat #'identity group " ")))))))
286 (defun riece-command-send-message (message)
287 "Send MESSAGE to the current channel."
288 (if (equal message "")
289 (error "No text to send"))
290 (unless riece-current-channel
291 (error (substitute-command-keys
292 "Type \\[riece-command-join] to join a channel")))
294 (format "PRIVMSG %s :%s\r\n"
295 (riece-identity-prefix riece-current-channel)
297 (riece-own-channel-message message))
299 (defun riece-command-enter-message ()
300 "Send the current line to the current channel."
302 (riece-command-send-message (buffer-substring
303 (riece-line-beginning-position)
304 (riece-line-end-position)))
305 (let ((next-line-add-newlines t))
308 (defun riece-command-join-channel (target key)
309 (let ((server-name (riece-identity-server target))
312 (setq process (cdr (assoc server-name riece-server-process-alist)))
313 (setq process riece-server-process))
315 (error "%s" (substitute-command-keys
316 "Type \\[riece-command-open-server] to open server.")))
317 (riece-process-send-string process
319 (format "JOIN %s :%s\r\n"
320 (riece-identity-prefix target)
322 (format "JOIN %s\r\n"
323 (riece-identity-prefix target))))))
325 (defun riece-command-join-partner (target)
326 (let ((pointer (riece-identity-member target riece-current-channels)))
328 (riece-command-switch-to-channel (car pointer))
329 (riece-join-channel target)
330 (riece-switch-to-channel target)
331 (riece-redisplay-buffers))))
333 (defun riece-command-join (target &optional key)
335 (let ((completion-ignore-case t)
337 (completing-read "Channel/user: "
338 (mapcar #'list riece-current-channels)))
340 (if (and current-prefix-arg
341 (riece-channel-p target))
343 (riece-read-passwd (format "Key for %s: " target))))
345 (let ((pointer (riece-identity-member target riece-current-channels)))
347 (riece-command-switch-to-channel (car pointer))
348 (if (riece-channel-p target)
349 (riece-command-join-channel target key)
350 (riece-command-join-partner target)))))
352 (defun riece-command-part-channel (target message)
353 (let ((server-name (riece-identity-server target))
356 (setq process (cdr (assoc server-name riece-server-process-alist)))
357 (setq process riece-server-process))
359 (error "%s" (substitute-command-keys
360 "Type \\[riece-command-open-server] to open server.")))
361 (riece-process-send-string process
363 (format "PART %s :%s\r\n"
364 (riece-identity-prefix target)
366 (format "PART %s\r\n"
367 (riece-identity-prefix target))))))
369 (defun riece-command-part (target &optional message)
371 (let ((completion-ignore-case t)
373 (completing-read "Channel/user: "
374 (mapcar #'list riece-current-channels)
375 nil t (cons riece-current-channel 0)))
377 (if (and current-prefix-arg
378 (riece-channel-p target))
379 (setq message (read-string "Message: ")))
380 (list target message)))
381 (if (riece-identity-member target riece-current-channels)
382 (if (riece-channel-p target)
383 (riece-command-part-channel target message)
384 (riece-part-channel target)
385 (riece-redisplay-buffers))
386 (error "You are not talking with %s" target)))
388 (defun riece-command-change-nickname (nickname)
389 "Change your nickname to NICK."
390 (interactive "sEnter your nickname: ")
391 (riece-send-string (format "NICK %s\r\n" nickname)))
393 (defun riece-command-scroll-down (lines)
394 "Scroll LINES down dialogue buffer from command buffer."
396 (let ((other-window-scroll-buffer
397 (if riece-channel-buffer-mode
399 riece-dialogue-buffer)))
400 (when (get-buffer-window other-window-scroll-buffer)
402 (scroll-other-window-down lines)
404 (message "Beginning of buffer"))))))
406 (defun riece-command-scroll-up (lines)
407 "Scroll LINES up dialogue buffer from command buffer."
409 (let* ((other-window-scroll-buffer
410 (if riece-channel-buffer-mode
412 riece-dialogue-buffer)))
413 (when (get-buffer-window other-window-scroll-buffer)
415 (scroll-other-window lines)
417 (message "End of buffer"))))))
419 (defun riece-command-nick-scroll-down (lines)
420 "Scroll LINES down nick buffer from command buffer."
422 (let ((other-window-scroll-buffer riece-user-list-buffer))
423 (when (get-buffer-window other-window-scroll-buffer)
425 (scroll-other-window-down lines)
427 (message "Beginning of buffer"))))))
429 (defun riece-command-nick-scroll-up (lines)
430 "Scroll LINES up nick buffer from command buffer."
432 (let* ((other-window-scroll-buffer riece-user-list-buffer))
433 (when (get-buffer-window other-window-scroll-buffer)
435 (scroll-other-window lines)
437 (message "End of buffer"))))))
439 (defun riece-command-toggle-away (&optional message)
440 "Mark yourself as being away."
442 (if current-prefix-arg
443 (let ((message (read-string "Away message: ")))
446 (riece-send-string (format "AWAY :%s\r\n" message))
447 (riece-send-string "AWAY\r\n")))
449 (defun riece-command-toggle-freeze (&optional arg)
450 "Prevent automatic scrolling of the dialogue window.
451 If prefix argument ARG is non-nil, toggle frozen status."
453 (riece-freeze (if riece-channel-buffer-mode
455 riece-dialogue-buffer)
456 (if arg (prefix-numeric-value arg))))
458 (defun riece-command-toggle-own-freeze (&optional arg)
459 "Prevent automatic scrolling of the dialogue window.
460 The difference from `riece-command-freeze' is that your messages are hidden.
461 If prefix argument ARG is non-nil, toggle frozen status."
463 (riece-own-freeze (if riece-channel-buffer-mode
465 riece-dialogue-buffer)
466 (if arg (prefix-numeric-value arg))))
468 (defun riece-command-quit (&optional arg)
471 (if (y-or-n-p "Really quit IRC? ")
474 (read-string "Message: ")
475 (or riece-quit-message
476 (riece-extended-version)))))
477 (riece-close-all-server message))))
479 (defun riece-command-raw (command)
480 "Enter raw IRC command, which is sent to the server."
481 (interactive "sIRC command: ")
482 (riece-send-string (concat command "\r\n")))
484 (defun riece-command-end-of-buffer ()
485 "Get end of the dialogue buffer."
488 (setq buffer (if riece-channel-buffer-mode
490 riece-dialogue-buffer))
491 (or (setq window (get-buffer-window buffer))
492 (setq window (get-buffer-window riece-dialogue-buffer)
493 buffer riece-dialogue-buffer))
495 (save-selected-window
496 (select-window window)
497 (goto-char (point-max))))))
499 (defun riece-command-copy-region (start end)
500 "Move current region between START and END to `kill-ring'."
502 (kill-new (buffer-substring-no-properties start end)))
504 (defun riece-command-open-server (server-name)
506 (list (completing-read "Server: " riece-server-alist)))
507 (let ((process (riece-start-server
508 (riece-server-name-to-server server-name)
510 (with-current-buffer (process-buffer process)
511 (setq riece-server-name server-name))
512 (push (cons server-name process) riece-server-process-alist)))
514 (defun riece-command-close-server (server-name &optional message)
516 (list (completing-read "Server: " riece-server-process-alist)
517 (if current-prefix-arg
518 (read-string "Message: ")
519 (or riece-quit-message
520 (riece-extended-version)))))
521 (riece-close-server server-name message))
523 (defun riece-command-universal-server-name-argument ()
525 (let* ((riece-overriding-server-name
526 (completing-read "Server: "
527 riece-server-process-alist))
529 (key-binding (read-key-sequence
530 (format "Command to execute on \"%s\":"
531 riece-overriding-server-name)))))
533 (call-interactively command)))
535 (provide 'riece-commands)
537 ;;; riece-commands.el ends here