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