ddb353d9b708af1938ff5ea6324d2e7e0d32bbe0
[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., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
24
25 ;;; Code:
26
27 (require 'riece-channel)
28 (require 'riece-complete)
29 (require 'riece-layout)
30 (require 'riece-display)
31 (require 'riece-server)
32 (require 'riece-misc)
33 (require 'riece-identity)
34 (require 'riece-message)
35 (require 'riece-mcat)
36
37 ;;; Channel movement:
38 (defun riece-command-switch-to-channel (channel)
39   (interactive (list (riece-completing-read-identity
40                       (riece-mcat "Switch to channel/user: ")
41                       riece-current-channels nil t)))
42   (unless (equal channel riece-current-channel)
43     (riece-switch-to-channel channel)))
44
45 (defun riece-command-switch-to-channel-by-number (number)
46   (interactive
47    (let ((command-name (symbol-name this-command)))
48      (if (string-match "[0-9]+$" command-name)
49          (list (string-to-number (match-string 0 command-name)))
50        (list (string-to-number (read-string (riece-mcat "Switch to number: ")))))))
51   (let ((channel (nth (1- number) riece-current-channels)))
52     (if channel
53         (riece-command-switch-to-channel channel)
54       (error "No such number!"))))
55
56 (eval-and-compile
57   (let ((number 1))
58     (while (<= number 20)
59       (defalias (intern (concat "riece-command-switch-to-channel-by-number-"
60                                 (number-to-string number)))
61         'riece-command-switch-to-channel-by-number)
62       (setq number (1+ number)))))
63
64 (defun riece-command-next-channel ()
65   "Select the next channel."
66   (interactive)
67   (when (> (length riece-current-channels) 1)
68     (let ((pointer (cdr (riece-identity-member
69                          riece-current-channel
70                          riece-current-channels))))
71       (while (and pointer
72                   (null (car pointer)))
73         (setq pointer (cdr pointer)))
74       (when (null pointer)
75         (setq pointer riece-current-channels)
76         (while (and pointer
77                     (null (car pointer)))
78           (setq pointer (cdr pointer))))
79       (if (car pointer)
80           (riece-command-switch-to-channel (car pointer))
81         (error "No such channel!")))))
82
83 (defun riece-command-previous-channel ()
84   "Select the previous channel."
85   (interactive)
86   (when (> (length riece-current-channels) 1)
87     (let ((pointer (riece-identity-member
88                     riece-current-channel
89                     riece-current-channels))
90           (start riece-current-channels)
91           channel)
92       (while (and start (not (eq start pointer)))
93         (if (car start)
94             (setq channel (car start)))
95         (setq start (cdr start)))
96       (when (null channel)
97         (setq start (copy-sequence riece-current-channels))
98         (setq start (delq nil start))
99         (and (> (length start) 1)
100              (setq channel (nth (1- (length start)) start))))
101       (if channel
102           (riece-command-switch-to-channel channel)
103         (error "No such channel!")))))
104
105 (defun riece-command-select-command-buffer ()
106   "Select the command buffer."
107   (interactive)
108   (let ((window (get-buffer-window riece-command-buffer)))
109     (if window
110         (select-window window))))
111
112 (defun riece-command-configure-windows ()
113   (interactive)
114   "Reconfigure windows with the current layout."
115   (riece-redisplay-buffers t))
116
117 (defun riece-command-suspend-resume ()
118   (interactive)
119   "Save or restore the current window configuration."
120   (let ((entry (assq 'riece-window-configuration (frame-parameters))))
121     (modify-frame-parameters (selected-frame)
122                              (list (cons 'riece-window-configuration
123                                          (current-window-configuration))))
124     (if (cdr entry)
125         (set-window-configuration (cdr entry))
126       (delete-other-windows))
127     (message
128      (substitute-command-keys
129       "\\[riece-command-suspend-resume] to get back the last windows"))))
130
131 (defun riece-command-change-layout (name)
132   "Select a layout-name from all current available layouts and change
133 the layout to the selected layout-name."
134   (interactive (list (completing-read (riece-mcat "Change layout: ")
135                                       riece-layout-alist)))
136   (setq riece-layout name
137         riece-save-variables-are-dirty t)
138   (riece-command-configure-windows))
139
140 (defun riece-command-toggle-channel-buffer-mode ()
141   (interactive)
142   (setq riece-channel-buffer-mode
143         (not riece-channel-buffer-mode)
144         riece-save-variables-are-dirty t)
145   (riece-command-configure-windows))
146
147 (defun riece-command-toggle-others-buffer-mode ()
148   (interactive)
149   (setq riece-others-buffer-mode
150         (not riece-others-buffer-mode)
151         riece-save-variables-are-dirty t)
152   (riece-command-configure-windows))
153
154 (defun riece-command-toggle-user-list-buffer-mode ()
155   (interactive)
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))
160
161 (defun riece-command-toggle-channel-list-buffer-mode ()
162   (interactive)
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))
167
168 (defun riece-command-finger (user &optional recurse)
169   (interactive
170    (let* ((completion-ignore-case t)
171           (user (riece-completing-read-identity
172                  (riece-mcat "Finger user: ")
173                  (riece-get-users-on-server (riece-current-server-name))
174                  nil nil nil nil nil t)))
175      (list user current-prefix-arg)))
176   (if recurse
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)))))
181
182 (defun riece-command-topic (topic)
183   (interactive
184    (progn
185      (riece-check-channel-commands-are-usable t)
186      (list (read-from-minibuffer
187             (riece-mcat "Set topic: ")
188             (cons (or (riece-with-server-buffer
189                           (riece-identity-server
190                            riece-current-channel)
191                         (riece-channel-get-topic
192                          (riece-identity-prefix
193                           riece-current-channel)))
194                       "")
195                   0)))))
196   (riece-send-string (format "TOPIC %s :%s\r\n"
197                              (riece-identity-prefix riece-current-channel)
198                              topic)
199                      riece-current-channel))
200
201 (defun riece-command-invite (user)
202   (interactive
203    (let ((completion-ignore-case t))
204      (riece-check-channel-commands-are-usable t)
205      (list (riece-completing-read-identity
206             (riece-mcat "Invite user: ")
207             (riece-get-users-on-server (riece-current-server-name))
208             nil nil nil nil nil t))))
209   (riece-send-string (format "INVITE %s :%s\r\n"
210                              (riece-identity-prefix user)
211                              (riece-identity-prefix riece-current-channel))))
212
213 (defun riece-command-kick (user &optional message)
214   (interactive
215    (let ((completion-ignore-case t))
216      (riece-check-channel-commands-are-usable t)
217      (list (completing-read
218             (riece-mcat "Kick user: ")
219             (riece-with-server-buffer
220                 (riece-identity-server riece-current-channel)
221               (riece-channel-get-users (riece-identity-prefix
222                                         riece-current-channel))))
223            (if current-prefix-arg
224                (read-string "Message: ")))))
225   (riece-send-string
226    (if message
227        (format "KICK %s %s :%s\r\n"
228                (riece-identity-prefix riece-current-channel)
229                user message)
230      (format "KICK %s %s\r\n"
231              (riece-identity-prefix riece-current-channel)
232              user))
233    riece-current-channel))
234
235 (defun riece-command-kick-with-ban (user pattern &optional message)
236   (interactive
237    (let ((completion-ignore-case t)
238          user)
239      (riece-check-channel-commands-are-usable t)
240      (riece-with-server-buffer (riece-identity-server riece-current-channel)
241        (setq user (completing-read
242                    (riece-mcat "Kick user: ")
243                    (riece-channel-get-users (riece-identity-prefix
244                                              riece-current-channel))))
245        (list
246         user
247         (read-from-minibuffer
248          (riece-mcat "Ban pattern: ")
249          (concat user "!" (riece-user-get-user-at-host user)))
250         (if current-prefix-arg
251             (read-string "Message: "))))))
252   (riece-send-string (format "MODE %s :+b %s\r\n"
253                              (riece-identity-prefix riece-current-channel)
254                              pattern)
255                      riece-current-channel)
256   (riece-send-string
257    (if message
258        (format "KICK %s %s :%s\r\n"
259                (riece-identity-prefix riece-current-channel)
260                user message)
261      (format "KICK %s %s\r\n"
262              (riece-identity-prefix riece-current-channel)
263              user))
264    riece-current-channel))
265
266 (defun riece-command-names (pattern)
267   (interactive
268    (let ((completion-ignore-case t))
269      (list (read-from-minibuffer
270             (riece-mcat "NAMES pattern: ")
271             (if (and riece-current-channel
272                      (riece-channel-p (riece-identity-prefix
273                                        riece-current-channel)))
274                 (cons (riece-identity-prefix riece-current-channel)
275                       0))))))
276   (if (or (not (equal pattern ""))
277           (yes-or-no-p (riece-mcat
278                         "Really want to query NAMES without argument? ")))
279       (riece-send-string (format "NAMES %s\r\n" pattern))))
280
281 (defun riece-command-who (pattern)
282   (interactive
283    (let ((completion-ignore-case t))
284      (list (read-from-minibuffer
285             (riece-mcat "WHO pattern: ")
286             (if (and riece-current-channel
287                      (riece-channel-p (riece-identity-prefix
288                                        riece-current-channel)))
289                 (cons (riece-identity-prefix riece-current-channel)
290                       0))))))
291   (if (or (not (equal pattern ""))
292           (yes-or-no-p (riece-mcat
293                         "Really want to query WHO without argument? ")))
294       (riece-send-string (format "WHO %s\r\n" pattern))))
295
296 (defun riece-command-list (pattern)
297   (interactive
298    (let ((completion-ignore-case t))
299      (list (read-from-minibuffer
300             (riece-mcat "LIST pattern: ")
301             (if (and riece-current-channel
302                      (riece-channel-p (riece-identity-prefix
303                                        riece-current-channel)))
304                 (cons (riece-identity-prefix riece-current-channel)
305                       0))))))
306   (if (or (not (equal pattern ""))
307           (yes-or-no-p (riece-mcat
308                         "Really want to query LIST without argument? ")))
309       (riece-send-string (format "LIST %s\r\n" pattern))))
310
311 (defun riece-command-change-mode (channel change)
312   (interactive
313    (let* ((completion-ignore-case t)
314           (channel
315            (if current-prefix-arg
316                (riece-completing-read-identity
317                 (riece-mcat "Change mode for channel/user: ")
318                 (riece-get-identities-on-server (riece-current-server-name))
319                 nil nil nil nil nil t)
320              (riece-check-channel-commands-are-usable t)
321              riece-current-channel))
322           (riece-overriding-server-name (riece-identity-server channel))
323           (riece-temp-minibuffer-message
324            (concat (riece-mcat "[Available modes: ")
325                    (riece-with-server-buffer (riece-identity-server channel)
326                      (if (riece-channel-p (riece-identity-prefix channel))
327                          (if riece-supported-channel-modes
328                              (apply #'string riece-supported-channel-modes))
329                        (if riece-supported-user-modes
330                            (apply #'string riece-supported-user-modes))))
331                    "]")))
332      (list channel
333            (read-from-minibuffer
334             (concat (riece-concat-channel-modes
335                      channel (riece-mcat "Mode (? for help)")) ": ")
336             nil riece-minibuffer-map))))
337   (if (equal change "")
338       (riece-send-string (format "MODE %s\r\n"
339                                  (riece-identity-prefix channel)))
340     (riece-send-string (format "MODE %s %s\r\n"
341                                (riece-identity-prefix channel)
342                                change))))
343
344 (defun riece-command-set-operators (users &optional arg)
345   (interactive
346    (progn
347      (riece-check-channel-commands-are-usable t)
348      (let ((completion-ignore-case t))
349        (list (riece-completing-read-multiple
350               (if current-prefix-arg
351                   (riece-mcat "Unset +o for users")
352                 (riece-mcat "Set +o for users"))
353               (riece-with-server-buffer
354                   (riece-identity-server riece-current-channel)
355                 (riece-channel-get-users (riece-identity-prefix
356                                          riece-current-channel)))
357               (if current-prefix-arg
358                   (lambda (user)
359                     (memq ?o (cdr user)))
360                 (lambda (user)
361                   (not (memq ?o (cdr user))))))
362              current-prefix-arg))))
363   (let (group)
364     (while users
365       (setq group (cons (car users) group)
366             users (cdr users))
367       (when (or (= (length group) 3)
368                 (null users))
369         (riece-send-string
370          (format "MODE %s %c%s %s\r\n"
371                  (riece-identity-prefix riece-current-channel)
372                  (if current-prefix-arg
373                      ?-
374                    ?+)
375                  (make-string (length group) ?o)
376                  (mapconcat #'identity (nreverse group) " ")))
377         (setq group nil)))))
378
379 (defun riece-command-set-speakers (users &optional arg)
380   (interactive
381    (progn
382      (riece-check-channel-commands-are-usable t)
383      (let ((completion-ignore-case t))
384        (list (riece-completing-read-multiple
385               (if current-prefix-arg
386                   (riece-mcat "Unset +v for users")
387                 (riece-mcat "Set +v for users"))
388               (riece-with-server-buffer
389                   (riece-identity-server riece-current-channel)
390                 (riece-channel-get-users (riece-identity-prefix
391                                           riece-current-channel)))
392               (if current-prefix-arg
393                   (lambda (user)
394                     (memq ?v (cdr user)))
395                 (lambda (user)
396                   (not (memq ?v (cdr user))))))
397              current-prefix-arg))))
398   (let (group)
399     (while users
400       (setq group (cons (car users) group)
401             users (cdr users))
402       (when (or (= (length group) 3)
403                 (null users))
404         (riece-send-string
405          (format "MODE %s %c%s %s\r\n"
406                  (riece-identity-prefix riece-current-channel)
407                  (if current-prefix-arg
408                      ?-
409                    ?+)
410                  (make-string (length group) ?v)
411                  (mapconcat #'identity (nreverse group) " ")))
412         (setq group nil)))))
413
414 (defun riece-command-send-message (message notice)
415   "Send MESSAGE to the current channel."
416   (run-hooks 'riece-command-send-message-hook)
417   (if (equal message "")
418       (error (riece-mcat "No text to send")))
419   (riece-check-channel-commands-are-usable)
420   (if notice
421       (progn
422         (riece-send-string
423          (format "NOTICE %s :%s\r\n"
424                  (riece-identity-prefix riece-current-channel)
425                  message)
426          riece-current-channel)
427         (riece-display-message
428          (riece-make-message (riece-current-nickname) riece-current-channel
429                              message 'notice t)))
430     (riece-send-string
431      (format "PRIVMSG %s :%s\r\n"
432              (riece-identity-prefix riece-current-channel)
433              message)
434      riece-current-channel)
435     (riece-display-message
436      (riece-make-message (riece-current-nickname) riece-current-channel
437                          message nil t))))
438
439 (defun riece-command-enter-message ()
440   "Send the current line to the current channel."
441   (interactive)
442   (riece-command-send-message (buffer-substring
443                                (riece-line-beginning-position)
444                                (riece-line-end-position))
445                               nil)
446   (if (> (forward-line) 0)
447       (insert "\n")))
448
449 (defun riece-command-enter-message-as-notice ()
450   "Send the current line to the current channel as NOTICE."
451   (interactive)
452   (riece-command-send-message (buffer-substring
453                                (riece-line-beginning-position)
454                                (riece-line-end-position))
455                               t)
456   (if (> (forward-line) 0)
457       (insert "\n")))
458
459 (defun riece-command-enter-message-to-user (user)
460   "Send the current line to USER."
461   (interactive
462    (if (and (bolp) (eolp))
463        (error "No text to send")
464      (let ((completion-ignore-case t))
465        (list (riece-completing-read-identity
466               (riece-mcat "Message to user: ")
467               (riece-get-users-on-server (riece-current-server-name))
468               nil nil nil nil nil t)))))
469   (let ((text (buffer-substring
470                (riece-line-beginning-position)
471                (riece-line-end-position))))
472     (riece-send-string
473      (format "PRIVMSG %s :%s\r\n" (riece-identity-prefix user) text)
474      user)
475     (riece-display-message
476      (riece-make-message (riece-current-nickname) user text nil t)))
477   (if (> (forward-line) 0)
478       (insert "\n")))
479
480 (defun riece-command-join-channel (target key)
481   (unless (riece-server-opened (riece-identity-server target))
482     (error "%s" (substitute-command-keys
483                  "Type \\[riece-command-open-server] to open server.")))
484   (riece-send-string (if key
485                          (format "JOIN %s :%s\r\n"
486                                  (riece-identity-prefix target)
487                                  key)
488                        (format "JOIN %s\r\n"
489                                (riece-identity-prefix target)))
490                      target))
491
492 (defun riece-command-join-partner (target)
493   (let ((pointer (riece-identity-member target riece-current-channels)))
494     (if pointer
495         (riece-command-switch-to-channel (car pointer))
496       (riece-join-channel target)
497       (riece-switch-to-channel target))))
498
499 (defun riece-command-join (target)
500   (interactive
501    (let ((completion-ignore-case t))
502      (list
503       (if riece-join-channel-candidate
504           (let ((default (riece-format-identity
505                           riece-join-channel-candidate)))
506             (riece-completing-read-identity
507              (format (riece-mcat "Join channel/user (default %s): ") default)
508              (riece-get-identities-on-server (riece-current-server-name))
509              nil nil nil nil default))
510         (riece-completing-read-identity
511          (riece-mcat "Join channel/user: ")
512          (riece-get-identities-on-server (riece-current-server-name)))))))
513   (let ((pointer (riece-identity-member target riece-current-channels)))
514     (if pointer
515         (riece-command-switch-to-channel (car pointer))
516       (if (riece-channel-p (riece-identity-prefix target))
517           (riece-command-join-channel target nil)
518         (riece-command-join-partner target)))))
519
520 (defun riece-command-part-channel (target message)
521   (unless (riece-server-opened (riece-identity-server target))
522     (error "%s" (substitute-command-keys
523                  "Type \\[riece-command-open-server] to open server.")))
524   (riece-send-string (if message
525                          (format "PART %s :%s\r\n"
526                                  (riece-identity-prefix target)
527                                  message)
528                        (format "PART %s\r\n"
529                                (riece-identity-prefix target)))
530                      target))
531
532 (defun riece-command-part (target &optional message)
533   (interactive
534    (progn
535      (riece-check-channel-commands-are-usable)
536      (let* ((completion-ignore-case t)
537             (target
538              (riece-completing-read-identity
539               (format (riece-mcat "Part from channel/user (default %s): ")
540                       (riece-format-identity riece-current-channel))
541               riece-current-channels nil nil nil nil
542               (riece-format-identity riece-current-channel)))
543             (message
544              (if current-prefix-arg
545                  (read-string (riece-mcat "Message: "))
546                riece-part-message)))
547        (list target message))))
548   (if (riece-identity-member target riece-current-channels)
549       (if (riece-channel-p (riece-identity-prefix target))
550           (riece-command-part-channel target message)
551         (riece-part-channel target))
552     (error "You are not talking with %s" target)))
553
554 (defun riece-command-change-nickname (nickname)
555   "Change your nickname to NICK."
556   (interactive "sEnter your nickname: ")
557   (riece-send-string (format "NICK %s\r\n" nickname)))
558
559 (defun riece-command-scroll-down (lines)
560   "Scroll LINES down dialogue buffer from command buffer."
561   (interactive "P")
562   (let ((buffer (if (and riece-channel-buffer-mode
563                          riece-current-channel)
564                     riece-channel-buffer
565                   riece-dialogue-buffer)))
566     (if (get-buffer-window buffer)
567         (condition-case nil
568             (let ((other-window-scroll-buffer buffer))
569               (scroll-other-window-down lines))
570           (beginning-of-buffer
571            (message (riece-mcat "Beginning of buffer")))))))
572
573 (defun riece-command-scroll-up (lines)
574   "Scroll LINES up dialogue buffer from command buffer."
575   (interactive "P")
576   (let ((buffer (if (and riece-channel-buffer-mode
577                          riece-current-channel)
578                     riece-channel-buffer
579                   riece-dialogue-buffer)))
580     (if (get-buffer-window buffer)
581         (condition-case nil
582             (let ((other-window-scroll-buffer buffer))
583               (scroll-other-window lines))
584           (end-of-buffer
585            (message (riece-mcat "End of buffer")))))))
586
587 (defun riece-command-user-list-scroll-down (lines)
588   "Scroll LINES down user list buffer from command buffer."
589   (interactive "P")
590   (if (get-buffer-window riece-user-list-buffer)
591       (condition-case nil
592           (let ((other-window-scroll-buffer riece-user-list-buffer))
593             (scroll-other-window-down lines))
594         (beginning-of-buffer
595          (message (riece-mcat "Beginning of buffer"))))))
596
597 (defun riece-command-user-list-scroll-up (lines)
598   "Scroll LINES up user list buffer from command buffer."
599   (interactive "P")
600   (if (get-buffer-window riece-user-list-buffer)
601       (condition-case nil
602           (let ((other-window-scroll-buffer riece-user-list-buffer))
603             (scroll-other-window lines))
604         (end-of-buffer
605          (message (riece-mcat "End of buffer"))))))
606
607 (defun riece-command-toggle-away (&optional message)
608   "Mark yourself as being away."
609   (interactive
610    (if (and (not (riece-with-server-buffer (riece-identity-server
611                                             (riece-current-nickname))
612                    (riece-user-get-away (riece-identity-prefix
613                                          (riece-current-nickname)))))
614             current-prefix-arg)
615        (list (read-from-minibuffer
616               (riece-mcat "Away message: ") (cons (or riece-away-message "")
617                                                   0)))))
618   (if (riece-with-server-buffer (riece-identity-server
619                                  (riece-current-nickname))
620         (riece-user-get-away (riece-identity-prefix
621                               (riece-current-nickname))))
622       (riece-send-string "AWAY\r\n")
623     (riece-send-string (format "AWAY :%s\r\n" (or message
624                                                   riece-away-message)))))
625
626 (defun riece-command-toggle-freeze (&optional arg)
627   "Prevent automatic scrolling of the dialogue window.
628 If prefix argument ARG is non-nil, toggle frozen status."
629   (interactive "P")
630   (with-current-buffer (if (riece-derived-mode-p 'riece-dialogue-mode)
631                            (current-buffer)
632                          (if (and riece-channel-buffer-mode
633                                   riece-channel-buffer)
634                              riece-channel-buffer
635                            riece-dialogue-buffer))
636     (setq riece-freeze (if arg
637                            (< 0 (prefix-numeric-value arg))
638                          (not riece-freeze)))
639     (riece-emit-signal 'buffer-freeze-changed
640                        (current-buffer) riece-freeze)))
641
642 (defun riece-command-toggle-own-freeze (&optional arg)
643   "Prevent automatic scrolling of the dialogue window.
644 The difference from `riece-command-freeze' is that your messages are hidden.
645 If prefix argument ARG is non-nil, toggle frozen status."
646   (interactive "P")
647   (with-current-buffer (if (riece-derived-mode-p 'riece-dialogue-mode)
648                            (current-buffer)
649                          (if (and riece-channel-buffer-mode
650                                   riece-channel-buffer)
651                              riece-channel-buffer
652                            riece-dialogue-buffer))
653     (if (if arg
654             (< 0 (prefix-numeric-value arg))
655           (not (eq riece-freeze 'own)))
656         (setq riece-freeze 'own)
657       (setq riece-freeze nil))
658     (riece-emit-signal 'buffer-freeze-changed
659                        (current-buffer) riece-freeze)))
660
661 (eval-when-compile
662   (autoload 'riece-exit "riece"))
663 (defun riece-command-quit (&optional arg)
664   "Quit IRC."
665   (interactive "P")
666   (if (null riece-server-process-alist)
667       (progn
668         (message (riece-mcat "No server process"))
669         (ding))
670     (if (y-or-n-p (riece-mcat "Really quit IRC? "))
671         (let ((message
672                (if arg
673                    (read-string (riece-mcat "Message: "))
674                  riece-quit-message))
675               (alist riece-server-process-alist))
676           (while alist
677             (riece-quit-server-process (cdr (car alist)) message)
678             (setq alist (cdr alist)))))))
679
680 (defun riece-command-raw (command)
681   "Enter raw IRC command, which is sent to the server."
682   (interactive "sIRC command: ")
683   (riece-send-string (concat command "\r\n")))
684
685 (defun riece-command-beginning-of-buffer ()
686   "Scroll channel buffer to the beginning."
687   (interactive)
688   (let (buffer window)
689     (setq buffer (if riece-channel-buffer-mode
690                      riece-channel-buffer
691                    riece-dialogue-buffer))
692     (or (setq window (get-buffer-window buffer))
693         (setq window (get-buffer-window riece-dialogue-buffer)
694               buffer riece-dialogue-buffer))
695     (when window
696       (save-selected-window
697         (select-window window)
698         (goto-char (point-min))))))
699
700 (defun riece-command-end-of-buffer ()
701   "Scroll channel buffer to the end."
702   (interactive)
703   (let (buffer window)
704     (setq buffer (if riece-channel-buffer-mode
705                      riece-channel-buffer
706                    riece-dialogue-buffer))
707     (or (setq window (get-buffer-window buffer))
708         (setq window (get-buffer-window riece-dialogue-buffer)
709               buffer riece-dialogue-buffer))
710     (when window
711       (save-selected-window
712         (select-window window)
713         (goto-char (point-max))))))
714
715 (defun riece-command-copy-region (start end)
716   "Move current region between START and END to `kill-ring'."
717   (interactive "r")
718   (kill-new (buffer-substring-no-properties start end)))
719
720 (defun riece-command-complete-user ()
721   "Complete a user name in the current buffer."
722   (interactive)
723   (let* ((completion-ignore-case t)
724          (table (mapcar (lambda (user)
725                           (list (riece-format-identity user t)))
726                         (riece-get-users-on-server
727                          (riece-current-server-name))))
728          (current (or (current-word) ""))
729          (completion (try-completion current table))
730          (all (all-completions current table)))
731     (if (eq completion t)
732         nil
733       (if (null completion)
734           (message (riece-mcat "Can't find completion for \"%s\"") current)
735         (if (equal current completion)
736             (with-output-to-temp-buffer "*Help*"
737               (display-completion-list all))
738           (re-search-forward "\\>" nil t)
739           (delete-region (point) (- (point) (length current)))
740           (insert completion))))))
741
742 (defun riece-command-open-server (server-name)
743   (interactive
744    (list (completing-read (riece-mcat "Open server: ") riece-server-alist)))
745   (if (riece-server-process server-name)
746       (error "%s is already opened" server-name))
747   (riece-open-server
748    (riece-server-name-to-server server-name)
749    server-name))
750
751 (defun riece-command-close-server (server-name &optional message)
752   (interactive
753    (list (completing-read (riece-mcat "Close server: ")
754                           riece-server-process-alist)
755          (if current-prefix-arg
756              (read-string (riece-mcat "Message: "))
757            riece-quit-message)))
758   (let ((process (riece-server-process server-name)))
759     (unless process
760       (error "%s is not opened" server-name))
761     (riece-quit-server-process process message)))
762
763 (defun riece-command-universal-server-name-argument ()
764   (interactive)
765   (let* ((riece-overriding-server-name
766           (completing-read (riece-mcat "Server: ") riece-server-process-alist))
767          (command
768           (key-binding (read-key-sequence
769                         (format (riece-mcat "Command to execute on \"%s\":")
770                                 riece-overriding-server-name)))))
771     (message "")
772     (call-interactively command)))
773
774 (eval-when-compile
775   (autoload 'riece-save-variables-files "riece"))
776 (defun riece-command-save-variables ()
777   "Save `riece-variables-file'."
778   (interactive)
779   (if (or riece-save-variables-are-dirty
780           (y-or-n-p (riece-mcat "No changes made.  Save anyway? ")))
781       (riece-save-variables-files)))
782
783 (provide 'riece-commands)
784
785 ;;; riece-commands.el ends here