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 (&optional user channel)
166 (let ((completion-ignore-case t)
168 (if current-prefix-arg
172 (mapcar #'list riece-current-channels))))
173 (list (completing-read
175 (mapcar #'list (riece-get-users-on-server)))
178 (riece-send-string (format "INVITE %s %s\r\n"
179 user (riece-identity-prefix channel)))
180 (riece-send-string (format "INVITE %s %s\r\n"
181 user (riece-identity-prefix
182 riece-current-channel)))))
184 (defun riece-command-change-mode (channel change)
186 (let* ((completion-ignore-case t)
188 (if current-prefix-arg
191 (mapcar #'list riece-current-channels))
192 riece-current-channel))
193 (riece-overriding-server-name (riece-identity-server channel))
194 (riece-temp-minibuffer-message
195 (concat "[Available modes: "
196 (riece-with-server-buffer
197 (if (and (riece-channel-p channel)
198 riece-supported-channel-modes)
199 (apply #'string riece-supported-channel-modes)
200 (if (and (not (riece-channel-p channel))
201 riece-supported-user-modes)
202 (apply #'string riece-supported-user-modes))))
205 (read-from-minibuffer
206 (concat (riece-concat-modes channel "Mode (? for help)") ": ")
207 nil riece-minibuffer-map))))
208 (riece-send-string (format "MODE %s :%s\r\n" channel change)))
210 (defun riece-command-set-operators (users &optional arg)
212 (let ((operators (riece-channel-get-operators riece-current-channel))
213 (completion-ignore-case t)
215 (if current-prefix-arg
216 (setq users (riece-completing-read-multiple
218 (mapcar #'list operators)))
219 (setq users (riece-completing-read-multiple
221 (delq nil (mapcar (lambda (user)
222 (unless (member user operators)
224 (riece-channel-get-users
225 riece-current-channel))))))
226 (list users current-prefix-arg)))
229 (push (pop users) group)
230 (if (or (= (length group) 3)
233 (format "MODE %s %c%s %s\r\n"
234 (riece-identity-prefix riece-current-channel)
235 (if current-prefix-arg
238 (make-string (length group) ?o)
239 (mapconcat #'identity group " ")))))))
241 (defun riece-command-set-speakers (users &optional arg)
243 (let ((speakers (riece-channel-get-speakers riece-current-channel))
244 (completion-ignore-case t)
246 (if current-prefix-arg
247 (setq users (riece-completing-read-multiple
249 (mapcar #'list speakers)))
250 (setq users (riece-completing-read-multiple
252 (delq nil (mapcar (lambda (user)
253 (unless (member user speakers)
255 (riece-channel-get-users
256 riece-current-channel))))))
257 (list users current-prefix-arg)))
260 (push (pop users) group)
261 (if (or (= (length group) 3)
264 (format "MODE %s %c%s %s\r\n"
265 (riece-identity-prefix riece-current-channel)
266 (if current-prefix-arg
269 (make-string (length group) ?v)
270 (mapconcat #'identity group " ")))))))
272 (defun riece-command-send-message (message)
273 "Send MESSAGE to the current channel."
274 (if (equal message "")
275 (error "No text to send"))
276 (unless riece-current-channel
277 (error (substitute-command-keys
278 "Type \\[riece-command-join] to join a channel")))
280 (format "PRIVMSG %s :%s\r\n"
281 (riece-identity-prefix riece-current-channel)
283 (riece-own-channel-message message))
285 (defun riece-command-enter-message ()
286 "Send the current line to the current channel."
288 (riece-command-send-message (buffer-substring
289 (riece-line-beginning-position)
290 (riece-line-end-position)))
291 (let ((next-line-add-newlines t))
294 (defun riece-command-join-channel (target key)
295 (let ((server-name (riece-identity-server target))
298 (setq process (cdr (assoc server-name riece-server-process-alist)))
299 (setq process riece-server-process))
301 (error "%s" (substitute-command-keys
302 "Type \\[riece-command-open-server] to open server.")))
303 (riece-process-send-string process
305 (format "JOIN %s :%s\r\n"
306 (riece-identity-prefix target)
308 (format "JOIN %s\r\n"
309 (riece-identity-prefix target))))))
311 (defun riece-command-join-partner (target)
312 (let ((pointer (riece-identity-member target riece-current-channels)))
314 (riece-command-switch-to-channel (car pointer))
315 (riece-join-channel target)
316 (riece-switch-to-channel target)
317 (riece-redisplay-buffers))))
319 (defun riece-command-join (target &optional key)
321 (let ((completion-ignore-case t)
323 (completing-read "Channel/user: "
324 (mapcar #'list riece-current-channels)))
326 (if (and current-prefix-arg
327 (riece-channel-p target))
329 (riece-read-passwd (format "Key for %s: " target))))
331 (let ((pointer (riece-identity-member target riece-current-channels)))
333 (riece-command-switch-to-channel (car pointer))
334 (if (riece-channel-p target)
335 (riece-command-join-channel target key)
336 (riece-command-join-partner target)))))
338 (defun riece-command-part-channel (target message)
339 (let ((server-name (riece-identity-server target))
342 (setq process (cdr (assoc server-name riece-server-process-alist)))
343 (setq process riece-server-process))
345 (error "%s" (substitute-command-keys
346 "Type \\[riece-command-open-server] to open server.")))
347 (riece-process-send-string process
349 (format "PART %s :%s\r\n"
350 (riece-identity-prefix target)
352 (format "PART %s\r\n"
353 (riece-identity-prefix target))))))
355 (defun riece-command-part (target &optional message)
357 (let ((completion-ignore-case t)
359 (completing-read "Channel/user: "
360 (mapcar #'list riece-current-channels)
361 nil t (cons riece-current-channel 0)))
363 (if (and current-prefix-arg
364 (riece-channel-p target))
365 (setq message (read-string "Message: ")))
366 (list target message)))
367 (if (riece-identity-member target riece-current-channels)
368 (if (riece-channel-p target)
369 (riece-command-part-channel target message)
370 (riece-part-channel target)
371 (riece-redisplay-buffers))
372 (error "You are not talking with %s" target)))
374 (defun riece-command-change-nickname (nickname)
375 "Change your nickname to NICK."
376 (interactive "sEnter your nickname: ")
377 (riece-send-string (format "NICK %s\r\n" nickname)))
379 (defun riece-command-scroll-down (lines)
380 "Scroll LINES down dialogue buffer from command buffer."
382 (let ((other-window-scroll-buffer
383 (if riece-channel-buffer-mode
385 riece-dialogue-buffer)))
386 (when (get-buffer-window other-window-scroll-buffer)
388 (scroll-other-window-down lines)
390 (message "Beginning of buffer"))))))
392 (defun riece-command-scroll-up (lines)
393 "Scroll LINES up dialogue buffer from command buffer."
395 (let* ((other-window-scroll-buffer
396 (if riece-channel-buffer-mode
398 riece-dialogue-buffer)))
399 (when (get-buffer-window other-window-scroll-buffer)
401 (scroll-other-window lines)
403 (message "End of buffer"))))))
405 (defun riece-command-nick-scroll-down (lines)
406 "Scroll LINES down nick buffer from command buffer."
408 (let ((other-window-scroll-buffer riece-user-list-buffer))
409 (when (get-buffer-window other-window-scroll-buffer)
411 (scroll-other-window-down lines)
413 (message "Beginning of buffer"))))))
415 (defun riece-command-nick-scroll-up (lines)
416 "Scroll LINES up nick buffer from command buffer."
418 (let* ((other-window-scroll-buffer riece-user-list-buffer))
419 (when (get-buffer-window other-window-scroll-buffer)
421 (scroll-other-window lines)
423 (message "End of buffer"))))))
425 (defun riece-command-toggle-away (&optional message)
426 "Mark yourself as being away."
428 (if current-prefix-arg
429 (let ((message (read-string "Away message: ")))
432 (riece-send-string (format "AWAY :%s\r\n" message))
433 (riece-send-string "AWAY\r\n")))
435 (defun riece-command-toggle-freeze (&optional arg)
436 "Prevent automatic scrolling of the dialogue window.
437 If prefix argument ARG is non-nil, toggle frozen status."
439 (riece-freeze (if riece-channel-buffer-mode
441 riece-dialogue-buffer)
442 (if arg (prefix-numeric-value arg))))
444 (defun riece-command-toggle-own-freeze (&optional arg)
445 "Prevent automatic scrolling of the dialogue window.
446 The difference from `riece-command-freeze' is that your messages are hidden.
447 If prefix argument ARG is non-nil, toggle frozen status."
449 (riece-own-freeze (if riece-channel-buffer-mode
451 riece-dialogue-buffer)
452 (if arg (prefix-numeric-value arg))))
454 (defun riece-command-quit (&optional arg)
457 (if (y-or-n-p "Really quit IRC? ")
460 (read-string "Message: ")
461 (or riece-quit-message
462 (riece-extended-version)))))
463 (riece-close-all-server message))))
465 (defun riece-command-raw (command)
466 "Enter raw IRC command, which is sent to the server."
467 (interactive "sIRC command: ")
468 (riece-send-string (concat command "\r\n")))
470 (defun riece-command-end-of-buffer ()
471 "Get end of the dialogue buffer."
474 (setq buffer (if riece-channel-buffer-mode
476 riece-dialogue-buffer))
477 (or (setq window (get-buffer-window buffer))
478 (setq window (get-buffer-window riece-dialogue-buffer)
479 buffer riece-dialogue-buffer))
481 (save-selected-window
482 (select-window window)
483 (goto-char (point-max))))))
485 (defun riece-command-copy-region (start end)
486 "Move current region between START and END to `kill-ring'."
488 (kill-new (buffer-substring-no-properties start end)))
490 (defun riece-command-open-server (server-name)
492 (list (completing-read "Server: " riece-server-alist)))
493 (let ((process (riece-start-server
494 (riece-server-name-to-server server-name)
496 (with-current-buffer (process-buffer process)
497 (setq riece-server-name server-name))
498 (push (cons server-name process) riece-server-process-alist)))
500 (defun riece-command-close-server (server-name &optional message)
502 (list (completing-read "Server: " riece-server-process-alist)
503 (if current-prefix-arg
504 (read-string "Message: ")
505 (or riece-quit-message
506 (riece-extended-version)))))
507 (riece-close-server server-name message))
509 (defun riece-command-universal-server-name-argument ()
511 (let* ((riece-overriding-server-name
512 (completing-read "Server: "
513 riece-server-process-alist))
515 (key-binding (read-key-sequence
516 (format "Command to execute on \"%s\":"
517 riece-overriding-server-name)))))
519 (call-interactively command)))
521 (provide 'riece-commands)
523 ;;; riece-commands.el ends here