1 ;;; liece-commands.el --- Interactive commands in command buffer.
2 ;; Copyright (C) 1998-2000 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
7 ;; Keywords: IRC, liece
9 ;; This file is part of Liece.
11 ;; This program is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
33 (require 'liece-crypt)
34 (require 'liece-misc))
36 (require 'liece-channel)
38 (require 'liece-coding)
40 (require 'liece-minibuf)
42 (autoload 'liece-dcc-chat-send "liece-dcc")
43 (autoload 'liece-window-configuration-pop "liece-window")
45 (autoload 'liece-command-ctcp-version "liece-ctcp" nil t)
46 (autoload 'liece-command-ctcp-userinfo "liece-ctcp" nil t)
47 (autoload 'liece-command-ctcp-clientinfo "liece-ctcp" nil t)
48 (autoload 'liece-command-ctcp-ping "liece-ctcp" nil t)
49 (autoload 'liece-command-ctcp-time "liece-ctcp" nil t)
50 (autoload 'liece-command-ctcp-x-face "liece-ctcp" nil t)
51 (autoload 'liece-command-ctcp-comment "liece-ctcp" nil t)
52 (autoload 'liece-command-ctcp-help "liece-ctcp" nil t)
54 (defun liece-command-poll-names ()
55 "Handler for polling NAMES."
56 (when (liece-server-opened)
59 (length liece-channel-alist)))
60 (dolist (chnl liece-channel-alist)
61 (liece-send "NAMES %s" (car chnl)))))
63 (defun liece-command-poll-friends ()
64 "Handler for polling ISON."
67 (liece-send "ISON %s" (mapconcat 'identity liece-friends " "))))
69 (defun liece-command-find-timestamp ()
70 "Find recent timestamp in dialogue buffer."
74 (regexp (concat "^\\(" liece-time-prefix-regexp "\\)?"
75 (regexp-quote liece-timestamp-prefix))))
76 (unless (eq 'liece-dialogue-mode (derived-mode-class major-mode))
77 (set-buffer liece-dialogue-buffer)
78 (goto-char (point-max)))
79 (if (re-search-backward regexp (point-min) t)
80 (setq range (concat (buffer-substring (match-end 0)
83 (if (re-search-forward regexp (point-max) t)
84 (setq range (concat range (buffer-substring (match-end 0)
85 (line-end-position)))))
86 (liece-message range))))
88 (defun liece-command-keepalive ()
89 "Handler for polling server connection."
90 (if (not (liece-server-opened))
92 (liece-ping-if-idle)))
94 (defvar liece-last-timestamp-time nil "Last time timestamp was inserted.")
95 (defvar liece-last-timestamp-no-cons-p nil "Last timestamp was no-cons.")
97 (defun liece-command-timestamp-if-interval-expired (&optional no-cons)
98 "If interval timer has expired, insert timestamp into dialogue buffer.
99 And save variables into `liece-variable-file' if there are variables to save.
100 Optional argument NO-CONS specifies timestamp format is cons cell."
102 (when (and (not (and no-cons
103 liece-last-timestamp-no-cons-p))
104 (numberp liece-timestamp-interval)
105 (> liece-timestamp-interval 0)
106 (or (null liece-last-timestamp-time)
107 (> (liece-time-difference liece-last-timestamp-time
109 liece-timestamp-interval)))
110 (if liece-save-variables-are-dirty
111 (liece-command-save-vars))
112 (liece-command-timestamp)
113 (setq liece-last-timestamp-no-cons-p no-cons)))
115 (defun liece-command-timestamp ()
116 "Insert timestamp into dialogue buffer."
118 (let ((stamp (format liece-timestamp-format
119 (funcall liece-format-time-function (current-time))))
120 (liece-timestamp-interval 0))
121 (liece-insert liece-D-buffer (concat stamp "\n"))
122 (setq liece-last-timestamp-time (current-time))))
124 (defun liece-command-point-back-to-command-buffer ()
125 "Set point back to command buffer."
127 (let ((win (liece-get-buffer-window liece-command-buffer)))
128 (if win (select-window win))))
130 (defun liece-command-send-message
131 (message &optional arg key)
132 "Send MESSAGE to current chat partner of current channel.
133 If argument ARG is non-nil message will be encrypted with KEY."
135 (setq liece-crypt-mode-active (not liece-crypt-mode-active)))
136 (if (string-equal message "")
137 (progn (liece-message (_ "No text to send")) nil)
138 (let ((addr (if (eq liece-command-buffer-mode 'chat)
139 liece-current-chat-partner
140 liece-current-channel))
141 repr method name target
143 (with-liece-encryption (msg addr arg key)
145 ((eq liece-command-buffer-mode 'chat)
146 (if (null liece-current-chat-partner)
148 (substitute-command-keys
149 "Type \\[liece-command-join] to start private conversation"))
150 (setq repr (liece-channel-parse-representation
151 liece-current-chat-partner)
154 target (aref repr 2))
155 (cond ((eq method 'dcc)
156 (liece-dcc-chat-send target msg))
158 (liece-send "PRIVMSG %s :%s"
159 liece-current-chat-partner msg)))
160 (liece-own-private-message message)))
161 ((not liece-current-channel)
163 (message (substitute-command-keys
164 "Type \\[liece-command-join] to join a channel")))
168 (liece-channel-real liece-current-channel) msg)
169 (liece-own-channel-message message))))
172 (defun liece-enter-message (&optional arg key)
173 "Enter the current line as an entry in the IRC dialogue.
174 If argument ARG is non-nil message will be encrypted with KEY."
176 (if (liece-command-send-message
177 (buffer-substring (point)(progn (end-of-line) (point)))
179 (liece-next-line 1)))
181 (defun liece-command-enter-message (&optional arg key)
182 "Enter the current line as an entry in the IRC dialogue.
183 If the prefix argument ARG is non-nil, message will be encrypted with KEY."
185 (let ((completion-ignore-case t))
186 (and (if current-prefix-arg
187 (not liece-crypt-mode-active)
188 liece-crypt-mode-active)
192 (_ "Encrypt message with key [RET for none]: ")
194 liece-crypt-encryption-keys))))))
195 (liece-enter-message arg (if (string-equal key "") nil key)))
197 (defun liece-dialogue-enter-message ()
198 "Ask for a line as an entry in the IRC dialogue on the current channel."
201 (while (not (string-equal (setq message (read-string "> ")) ""))
202 (liece-command-send-message message))))
204 (defun liece-command-inline ()
205 "Send current line as a message to the IRC server."
208 (liece-send (buffer-substring (point)(progn (end-of-line) (point))))
211 (defun liece-command-join-channel (join-channel-var key)
212 "Join a JOIN-CHANNEL-VAR with KEY."
213 (let ((nicks liece-nick-alist) nick)
217 (liece-channel-equal join-channel-var (car nick)))))
218 (setq nick (pop nicks)))
220 (setq join-channel-var
221 (or (car (get (intern (car nick) liece-obarray) 'chnl))
223 (if (liece-channel-member join-channel-var liece-current-channels)
225 (setq liece-current-channel join-channel-var)
226 (liece-switch-to-channel liece-current-channel)
227 (liece-channel-change))
228 (liece-send "JOIN %s %s" (liece-channel-real join-channel-var) key))))
230 (defun liece-command-join-partner (join-channel-var)
231 "Join a JOIN-CHANNEL-VAR."
232 (if (liece-channel-member join-channel-var liece-current-chat-partners)
234 (setq liece-current-chat-partner join-channel-var)
235 (liece-switch-to-channel liece-current-chat-partner))
236 (setq liece-current-chat-partner join-channel-var)
237 (liece-channel-join liece-current-chat-partner))
238 (liece-channel-change))
240 (defun liece-command-join (join-channel-var &optional key)
241 "Join a JOIN-CHANNEL-VAR with KEY.
242 If user nickname is given join the same set of channels as the specified user.
243 If command-buffer is in chat-mode, start private conversation
244 with specified user."
246 (let (join-channel-var key (completion-ignore-case t))
247 (setq join-channel-var
248 (if (numberp current-prefix-arg)
250 (liece-channel-virtual
251 (if (eq liece-command-buffer-mode 'chat)
252 (liece-minibuffer-completing-default-read
253 (_ "Start private conversation with: ")
255 nil nil liece-privmsg-partner)
256 (liece-minibuffer-completing-default-read
258 (append liece-channel-alist liece-nick-alist)
259 nil nil liece-default-channel-candidate)))))
260 (if (and current-prefix-arg
261 (not (numberp current-prefix-arg)))
263 (if (eq current-prefix-arg '-)
265 (format (_ "Key for channel %s: ") join-channel-var))
266 (let ((passwd-echo ?*))
268 (format (_ "Key for channel %s: ") join-channel-var))))))
269 (list join-channel-var key)))
270 (let ((real-chnl (liece-channel-real join-channel-var)))
271 (if (numberp join-channel-var)
272 (liece-switch-to-channel-no join-channel-var)
273 (setq liece-default-channel-candidate nil)
274 (if (liece-channel-p real-chnl)
275 (liece-toggle-command-buffer-mode 'channel)
276 (liece-toggle-command-buffer-mode 'chat))
277 (if (eq liece-command-buffer-mode 'chat)
278 (liece-command-join-partner join-channel-var)
280 (setq key (get (intern join-channel-var liece-obarray) 'key)))
281 (put (intern join-channel-var liece-obarray) 'key key)
284 (liece-command-join-channel join-channel-var key))
285 (force-mode-line-update))))
287 (defun liece-command-part (part-channel-var &optional part-msg)
288 "Part a PART-CHANNEL-VAR with PART-MSG."
290 (let (part-channel-var
291 (completion-ignore-case t)
293 (setq part-channel-var
294 (liece-channel-virtual
295 (if (eq liece-command-buffer-mode 'chat)
296 (liece-minibuffer-completing-default-read
297 (_ "End private conversation with: ")
298 (list-to-alist liece-current-chat-partners)
299 nil nil liece-current-chat-partner)
300 (liece-minibuffer-completing-default-read
302 (list-to-alist liece-current-channels)
303 nil nil liece-current-channel))))
304 (when current-prefix-arg
305 (setq part-msg (read-string (_ "Part Message: "))))
306 (list part-channel-var part-msg)))
307 (let ((real-chnl (liece-channel-real part-channel-var)))
308 (if (liece-channel-p real-chnl)
310 (if (liece-channel-member part-channel-var liece-current-channels)
311 (setq liece-current-channel part-channel-var))
312 (liece-send "PART %s :%s" real-chnl part-msg)
313 (setq liece-default-channel-candidate part-channel-var))
314 (setq liece-current-chat-partners
315 (liece-channel-remove part-channel-var
316 liece-current-chat-partners)
317 liece-current-chat-partner
318 (car liece-current-chat-partners))
319 (liece-set-channel-indicator)
320 (liece-set-crypt-indicator)
321 (liece-channel-part part-channel-var))))
323 (defun liece-command-kill (kill-nickname-var &optional timeout silent)
324 "Ignore messages from KILL-NICKNAME-VAR.
325 Username can be given as case insensitive regular expression of form
326 \".*@.*\.sub.domain\".
327 If already ignoring him/her, toggle.
328 If `liece-variables-file' is defined and the file is writable,
329 settings are updated automatically for future sessions.
330 Optional argument TIMEOUT says expiration.
331 If SILENT is non-nil, don't notify current status."
333 (let (kill-nickname-var timeout (completion-ignore-case t))
334 (setq kill-nickname-var (completing-read
335 (_ "Ignore nickname or regexp: ")
336 (append liece-nick-alist
337 liece-kill-nickname)))
338 (or (string-equal "" kill-nickname-var)
339 (string-assoc-ignore-case kill-nickname-var liece-kill-nickname)
340 (setq timeout (string-to-int (read-from-minibuffer
341 (_ "Timeout [RET for none]: ")))))
342 (list kill-nickname-var timeout)))
343 ;; empty, just list them
344 (if (string-equal "" kill-nickname-var)
345 (with-current-buffer liece-dialogue-buffer
346 (let ((ignores liece-kill-nickname) (time (current-time))
347 buffer-read-only expire expiretime)
348 (goto-char (point-max))
349 (liece-insert-info liece-D-buffer (_ "Currently ignoring:"))
350 (dolist (ignore ignores)
351 (setq expiretime (if (cdr ignore)
352 (/ (liece-time-difference time (cdr ignore))
354 expire (cond ((not expiretime) "")
356 (format (_ " (%d min)") expiretime))
359 (liece-insert liece-D-buffer
360 (concat " " (car ignore) expire "\n")))))
361 ;; else not empty, check if exists
363 (string-assoc-ignore-case
364 kill-nickname-var liece-kill-nickname)))
366 (when (setq ignore (string-assoc-ignore-case
367 (car ignore) liece-kill-nickname))
368 (setq liece-kill-nickname
369 (delq ignore liece-kill-nickname))
370 (liece-insert-info liece-D-buffer
371 (format (_ "No longer ignoring: %s.\n")
373 ;; did not find, add to ignored ones
374 (let ((expire-time (if (> timeout 0)
375 (liece-time-add (current-time)
377 (and silent (> timeout 0)
378 (setcar (cdr (cdr expire-time)) -1))
379 (setq liece-kill-nickname
380 (cons (cons kill-nickname-var expire-time)
381 liece-kill-nickname))
383 (liece-insert-info liece-D-buffer
384 (format (_ "Ignoring %s") kill-nickname-var))
385 (liece-insert-info liece-D-buffer
387 (format " for %d minutes.\n" timeout)
389 (setq liece-save-variables-are-dirty t)))
391 (defun liece-command-kick (nick &optional msg)
392 "Kick this NICK out with MSG."
394 (let ((completion-ignore-case t)
395 (nicks (liece-channel-get-nicks)) nick msg)
396 (setq nick (completing-read
397 (_ "Kick out nickname: ")
398 (list-to-alist nicks)))
399 (if current-prefix-arg
400 (setq msg (concat " :" (read-string (_ "Kick Message: ")))))
402 (liece-send "KICK %s %s%s"
403 (liece-channel-real liece-current-channel)
406 (defun liece-command-ban (ban)
409 (let* ((completion-ignore-case t)
410 (nicks (liece-channel-get-nicks))
415 (concat nick "!" (liece-nick-get-user-at-host nick)))))
418 (setq ban (liece-minibuffer-completing-default-read
419 (_ "Ban pattern: ") uahs nil nil
420 (concat nick "!" (liece-nick-get-user-at-host nick))))
422 (liece-send "MODE %s :+b %s"
423 (liece-channel-real liece-current-channel) ban))
425 (defun liece-command-ban-kick (ban nick &optional msg)
426 "BAN kick this NICK out with MSG."
428 (let* ((completion-ignore-case t)
429 (nicks (liece-channel-get-nicks))
434 (concat nick "!" (liece-nick-get-user-at-host nick)))))
437 (setq nick (completing-read (_ "Kick out nickname: ")
438 (list-to-alist nicks))
439 ban (liece-minibuffer-completing-default-read
440 (_ "Ban pattern: ") uahs nil nil
441 (concat nick "!" (liece-nick-get-user-at-host nick))))
442 (if current-prefix-arg
443 (setq msg (concat " :" (read-string (_ "Kick Message: "))))
445 (list ban nick msg)))
446 (liece-send "MODE %s :+b %s"
447 (liece-channel-real liece-current-channel) ban)
448 (liece-send "KICK %s %s%s"
449 (liece-channel-real liece-current-channel)
452 (defun liece-command-list (&optional channel)
453 "List the given CHANNEL and its topics.
454 If you enter only Control-U as argument, list the current channel.
455 With - as argument, list all channels."
457 (if (or current-prefix-arg (null liece-current-channel))
458 (if (eq current-prefix-arg '-)
459 (list current-prefix-arg))
460 (let ((completion-ignore-case t) channel)
461 (setq channel (liece-minibuffer-completing-default-read
463 liece-channel-alist nil nil liece-current-channel))
464 (unless (string-equal "" channel)
468 (if liece-current-channel
469 (liece-send "LIST %s"
470 (liece-channel-real liece-current-channel))))
471 ((and (eq channel '-)
472 (y-or-n-p (_ "Do you really query LIST without argument?")))
474 ((not (string-equal channel ""))
475 (liece-send "LIST %s" (liece-channel-real channel))
478 (defun liece-command-lusers ()
479 "List the number of users and servers."
481 (liece-send "LUSERS"))
483 (defun liece-command-modec (chnl change)
484 "Send a MODE command to this CHNL.
487 (let ((completion-ignore-case t)
488 (chnl liece-current-channel)
489 liece-minibuffer-complete-function prompt)
490 (if current-prefix-arg
492 (liece-minibuffer-completing-default-read
494 (append liece-channel-alist liece-nick-alist)
495 nil nil liece-current-channel)))
497 ((liece-channel-p (liece-channel-real chnl))
499 (_ "Mode for channel %s [%s]: ")
500 chnl (or (liece-channel-get-modes chnl) ""))
501 liece-minibuffer-complete-function
502 (function liece-minibuffer-complete-channel-modes)))
505 (_ "Mode for user %s [%s]: ")
506 chnl (or (liece-nick-get-modes chnl) ""))
507 liece-minibuffer-complete-function
508 (function liece-minibuffer-complete-user-modes))))
509 (list chnl (read-from-minibuffer prompt nil liece-minibuffer-map))))
510 (liece-send "MODE %s %s" (liece-channel-real chnl) change))
512 (defun liece-command-mode+o (opers)
513 "Send a MODE +o OPERS command."
515 (let ((opers (liece-channel-get-operators)) oper
516 (nicks (liece-channel-get-nicks))
517 (completion-ignore-case t))
518 (setq nicks (filter-elements
520 (not (liece-nick-member nick opers)))
521 opers (liece-minibuffer-completing-sequential-read
522 (_ "Set Operator for") 0
523 (list-to-alist nicks)))
528 (when (= (length ops) liece-compress-mode-length)
529 (liece-send "MODE %s +%s %s"
530 (liece-channel-real liece-current-channel)
531 (string-times "o" liece-compress-mode-length)
532 (string-join ops " "))
535 (liece-send "MODE %s +%s %s"
536 (liece-channel-real liece-current-channel)
537 (string-times "o" (length ops))
538 (string-join ops " ")))))
540 (defun liece-command-mode-o (opers)
541 "Send a MODE -o OPERS command."
543 (let ((completion-ignore-case t)
544 (opers (liece-channel-get-operators)) oper nicks)
545 (setq nicks (liece-minibuffer-completing-sequential-read
546 (_ "Unset Operator for") 0
547 (list-to-alist opers)))
552 (when (= (length ops) liece-compress-mode-length)
553 (liece-send "MODE %s -%s %s"
554 (liece-channel-real liece-current-channel)
555 (string-times "o" liece-compress-mode-length)
556 (string-join ops " "))
559 (liece-send "MODE %s -%s %s"
560 (liece-channel-real liece-current-channel)
561 (string-times "o" (length ops))
562 (string-join ops " ")))))
564 (defun liece-command-mode+v (voices)
565 "Send a MODE +v VOICES command."
567 (let ((voices (append (liece-channel-get-voices)
568 (liece-channel-get-operators)))
570 (nicks (liece-channel-get-nicks))
571 (completion-ignore-case t)
573 (setq nicks (filter-elements nick nicks
574 (not (string-assoc-ignore-case nick voices)))
575 voices (liece-minibuffer-completing-sequential-read
576 (_ "Set Voice for") 0 (list-to-alist nicks)))
579 (dolist (voice voices)
581 (when (= (length vcs) liece-compress-mode-length)
582 (liece-send "MODE %s +%s %s"
583 (liece-channel-real liece-current-channel)
584 (string-times "v" liece-compress-mode-length)
585 (string-join vcs " "))
588 (liece-send "MODE %s +%s %s"
589 (liece-channel-real liece-current-channel)
590 (string-times "v" (length vcs))
591 (string-join vcs " ")))))
593 (defun liece-command-mode-v (voices)
594 "Send a MODE -v VOICES command."
596 (let ((completion-ignore-case t)
597 (voices (liece-channel-get-voices)) voice nicks)
598 (setq nicks (liece-minibuffer-completing-sequential-read
599 (_ "Unset Voice for") 0 (list-to-alist voices)))
602 (dolist (voice voices)
604 (when (= (length vcs) liece-compress-mode-length)
605 (liece-send "MODE %s -%s %s"
606 (liece-channel-real liece-current-channel)
607 (string-times "v" liece-compress-mode-length)
608 (string-join vcs " "))
611 (liece-send "MODE %s -%s %s"
612 (liece-channel-real liece-current-channel)
613 (string-times "v" (length vcs))
614 (string-join vcs " ")))))
616 (defun liece-command-message (address message &optional arg key)
617 "Send ADDRESS a private MESSAGE.
618 If argument ARG is non-nil message will be encrypted with KEY."
620 (let ((completion-ignore-case t) address)
622 (liece-channel-virtual
623 (liece-minibuffer-completing-default-read
624 (_ "Private message to: ")
625 (append liece-nick-alist liece-channel-alist)
626 nil nil liece-privmsg-partner)))
630 (_ "Private message to %s: ")
632 (if current-prefix-arg
633 (not liece-crypt-mode-active)
634 liece-crypt-mode-active)
636 (if (funcall liece-message-empty-predicate message)
637 (progn (liece-message (_ "No text to send")) nil)
638 (let ((chnl (liece-channel-real address)) (msg message))
639 (with-liece-encryption (msg address arg key)
640 (liece-send "PRIVMSG %s :%s" chnl msg)
641 (if (liece-channel-p chnl)
642 (liece-own-channel-message message
643 (liece-channel-virtual address))
644 (liece-own-private-message message address)))
647 ;; Added at mta@tut.fi's request...
648 ;; Does not support encryption (yet!?)
650 (defun liece-command-mta-private (partner)
651 "Send a private message (current line) to PARTNER."
653 (let ((completion-ignore-case t))
654 (setq liece-privmsg-partner
655 (liece-channel-virtual
656 (liece-minibuffer-completing-default-read
658 (append liece-nick-alist liece-channel-alist)
659 nil nil liece-privmsg-partner)))
660 (list liece-privmsg-partner)))
661 (let ((message (buffer-substring (progn (beginning-of-line) (point))
662 (progn (end-of-line) (point)))))
663 (if (> (length message) 0)
665 (liece-command-message liece-privmsg-partner message)
667 (liece-message (_ "No text to send")))))
669 (defun liece-command-names (&optional channel)
670 "List the nicknames of the current IRC users on given CHANNEL.
671 With an Control-U as argument, only the current channel is listed.
672 With - as argument, list all channels."
674 (if (or current-prefix-arg (null liece-current-channel))
675 (if (eq current-prefix-arg '-)
676 (list current-prefix-arg))
677 (let ((completion-ignore-case t) channel)
678 (setq channel (liece-minibuffer-completing-default-read
679 (_ "Names on channel: ")
680 liece-channel-alist nil nil liece-current-channel))
681 (unless (string-equal "" channel)
685 (liece-send "NAMES %s"
686 (liece-channel-real liece-current-channel)))
687 ((and (eq channel '-)
688 (y-or-n-p (_ "Do you really query NAMES without argument?")))
689 (liece-send "NAMES"))
691 (liece-send "NAMES %s" (liece-channel-real channel)))))
693 (defun liece-command-nickname (nick)
694 "Set your nickname to NICK."
695 (interactive "sEnter your nickname: ")
696 (let ((nickname (truncate-string nick liece-nick-max-length)))
697 (if (zerop (length nickname))
698 (liece-message (_ "illegal nickname \"%s\"; not changed") nickname)
699 (liece-send "NICK %s" nick))))
701 (defun liece-command-who (&optional expr)
702 "Lists tue users that match the given expression EXPR.
703 If you enter only Control-U as argument, list the current channel.
704 With - as argument, list all users."
706 (if (or current-prefix-arg (null liece-current-channel))
707 (if (eq current-prefix-arg '-)
708 (list current-prefix-arg))
709 (let ((completion-ignore-case t) expr)
710 (setq expr (liece-minibuffer-completing-default-read
711 (_ "WHO expression: ")
712 (append liece-channel-alist liece-nick-alist)))
713 (unless (string-equal "" expr)
717 (liece-send "WHO %s" (liece-channel-real liece-current-channel)))
719 (y-or-n-p (_ "Do you really query WHO without argument?")))
722 (liece-send "WHO %s" expr)
723 (setq liece-who-expression expr))))
725 (defun liece-command-finger (finger-nick-var &optional server)
726 "Get information about a specific user FINGER-NICK-VAR.
727 If called with optional argument SERVER or any prefix argument,
728 query information to the foreign server."
730 (let (finger-nick-var (completion-ignore-case t))
731 (setq finger-nick-var
732 (completing-read (_ "Finger whom: ") liece-nick-alist))
733 (list finger-nick-var (and current-prefix-arg finger-nick-var))))
735 (liece-send "WHOIS %s %s" server finger-nick-var)
736 (liece-send "WHOIS %s" finger-nick-var)))
738 (defun liece-command-topic (topic)
739 "Change TOPIC of the current channel."
741 (list (read-from-minibuffer
742 "Topic: " (cons (or (liece-channel-get-topic) "") 0))))
743 (liece-send "TOPIC %s :%s"
744 (liece-channel-real liece-current-channel) topic))
746 (defun liece-command-invite (&optional invite-nick-var invite-channel-var)
747 "Invite INVITE-NICK-VAR to INVITE-CHANNEL-VAR."
749 (let ((completion-ignore-case t) invite-channel-var invite-nick-var)
750 (if current-prefix-arg
751 (setq invite-channel-var
752 (liece-channel-virtual
754 (_ "Invite channel: ")
755 (list-to-alist liece-current-channels)))))
756 (setq invite-nick-var
760 (list invite-nick-var invite-channel-var)))
761 (or invite-channel-var
762 (setq invite-channel-var liece-current-channel))
763 (liece-send "INVITE %s %s"
764 invite-nick-var (liece-channel-real invite-channel-var)))
766 (defun liece-command-away (awaymsg)
767 "Mark/unmark yourself as being away.
768 Leave message AWAYMSG."
769 (interactive "sAway message: ")
770 (liece-send "AWAY :%s" awaymsg)
771 (setq liece-away-message awaymsg))
773 (defun liece-command-scroll-down (lines)
774 "Scroll LINES down dialogue buffer from command buffer."
776 (let ((other-window-scroll-buffer
777 (if liece-channel-buffer-mode
779 liece-dialogue-buffer)))
780 (when (liece-get-buffer-window other-window-scroll-buffer)
782 (scroll-other-window-down lines)
784 (message "Beginning of buffer"))))))
786 (defun liece-command-scroll-up (lines)
787 "Scroll LINES up dialogue buffer from command buffer."
789 (let* ((other-window-scroll-buffer
790 (if liece-channel-buffer-mode
792 liece-dialogue-buffer)))
793 (when (liece-get-buffer-window other-window-scroll-buffer)
795 (scroll-other-window lines)
797 (message "End of buffer"))))))
799 (defun liece-command-nick-scroll-down (lines)
800 "Scroll LINES down nick buffer from command buffer."
802 (let ((other-window-scroll-buffer liece-nick-buffer))
803 (when (liece-get-buffer-window other-window-scroll-buffer)
805 (scroll-other-window-down lines)
807 (message "Beginning of buffer"))))))
809 (defun liece-command-nick-scroll-up (lines)
810 "Scroll LINES up nick buffer from command buffer."
812 (let* ((other-window-scroll-buffer liece-nick-buffer))
813 (when (liece-get-buffer-window other-window-scroll-buffer)
815 (scroll-other-window lines)
817 (message "End of buffer"))))))
819 (defun liece-command-toggle-crypt (&optional arg)
820 "Toggle crypt status.
821 If prefix argument ARG is non-nil, force set crypt status."
824 (setq liece-crypt-mode-active (prefix-numeric-value arg))
825 (if liece-crypt-mode-active
826 (setq liece-crypt-mode-active nil)
827 (setq liece-crypt-mode-active t)))
828 (liece-set-crypt-indicator)
829 (switch-to-buffer (current-buffer)))
831 (defun liece-command-freeze (&optional arg)
832 "Prevent automatic scrolling of the dialogue window.
833 If prefix argument ARG is non-nil, toggle frozen status."
835 (liece-freeze (if liece-channel-buffer-mode
837 liece-dialogue-buffer)
838 (if arg (prefix-numeric-value arg))))
840 (defun liece-command-own-freeze (&optional arg)
841 "Prevent automatic scrolling of the dialogue window.
842 The difference from `liece-command-freeze' is that your messages are hidden.
843 If prefix argument ARG is non-nil, toggle frozen status."
845 (liece-own-freeze (if liece-channel-buffer-mode
847 liece-dialogue-buffer)
848 (if arg (prefix-numeric-value arg))))
850 (defun liece-command-quit (&optional arg)
852 If prefix argument ARG is non-nil, leave signoff message."
854 (when (and (liece-server-opened)
855 (y-or-n-p (_ "Quit IRC? ")))
858 (if arg (read-string (_ "Signoff message: "))
859 (or liece-signoff-message
860 (product-name (product-find 'liece-version))))))
861 (liece-send "QUIT :%s" quit-string))
864 (if liece-save-variables-are-dirty
865 (liece-command-save-vars))
867 (liece-window-configuration-pop))
868 (run-hooks 'liece-exit-hook)))
870 (defun liece-command-generic (message)
871 "Enter a generic IRC MESSAGE, which is sent to the server.
872 A ? lists the useful generic messages."
873 (interactive "sIRC command (? to help): ")
874 (if (string-equal message "?")
875 (with-output-to-temp-buffer "*IRC Help*"
876 (princ "The following generic IRC messages may be of interest to you:
877 TOPIC <new topic> set the topic of your channel
878 INVITE <nickname> invite another user to join your channel
879 LINKS lists the currently reachable IRC servers
880 SUMMON <user@host> invites an user not currently in IRC
881 USERS <host> lists the users on a host
882 AWAY <reason> marks you as not really actively using IRC
883 (an empty reason clears it)
884 WALL <message> send to everyone on IRC
885 NAMES <channel> lists users per channel
887 (liece-send "%s" message)))
889 (defun liece-command-irc-compatible ()
890 "If entered at column 0, allow you to enter a generic IRC message."
892 (if (zerop (current-column))
893 (call-interactively (function liece-command-generic))
894 (self-insert-command 1)))
896 (defun liece-command-exec (command)
897 "Execute COMMAND, stdout to dialogue."
898 (interactive "sShell command: ")
899 (shell-command command t)
900 (let ((opoint (point)))
901 (while (< (point) (mark))
902 (liece-command-enter-message)
903 (set-buffer liece-command-buffer))
904 (push-mark opoint t)))
906 (defun liece-command-yank-send (&optional arg)
907 "Send message from yank buffer.
908 Prefix argument ARG is regarded as distance from yank pointer."
910 (when (y-or-n-p (_ "Really SEND from Yank Buffer?"))
912 (narrow-to-region (point) (point))
913 (insert (car kill-ring-yank-pointer))
914 (goto-char (point-min))
916 (liece-command-enter-message)
917 (set-buffer liece-command-buffer)))))
919 (defun liece-command-complete ()
920 "Complete word before point from userlist."
922 (let ((completion-ignore-case t)
923 (alist (if liece-current-channel
924 (list-to-alist (liece-channel-get-nicks))
926 candidate completion all)
927 (setq candidate (current-word)
928 completion (try-completion candidate alist)
929 all (all-completions candidate alist))
930 (liece-minibuffer-finalize-completion completion candidate all)))
932 (defun liece-command-load-vars ()
933 "Load configuration from liece-variables-file."
935 (let ((nick liece-real-nickname))
937 (liece-read-variables-files)
938 (setq liece-real-nickname nick)
939 (liece-command-reconfigure-windows))))
941 (defun liece-command-save-vars ()
942 "Save current settings to `liece-variables-file'."
944 (let* ((output-buffer
946 (expand-file-name liece-variables-file)))
949 (set-buffer output-buffer)
950 (goto-char (point-min))
951 (cond ((re-search-forward "^;; Saved Settings *\n" nil 'move)
952 (setq p (match-beginning 0))
954 (or (re-search-forward
955 "^;; End of Saved Settings *\\(\n\\|\\'\\)" nil t)
957 (concat "can't find END of saved state in "
958 liece-variables-file)))
959 (delete-region p (match-end 0)))
961 (goto-char (point-max))
963 (setq output-marker (point-marker))
964 (let ((print-readably t)
965 (print-escape-newlines t)
966 (standard-output output-marker))
967 (princ ";; Saved Settings\n")
968 (dolist (var liece-saved-forms)
970 (prin1 (list 'setq var
971 (let ((val (symbol-value var)))
972 (if (memq val '(t nil))
974 (list 'quote val)))))
975 (setq var (eval var))
976 (cond ((eq (car-safe var) 'progn)
977 (while (setq var (cdr var))
980 (if (cdr var) (princ " "))))
982 (prin1 "xx")(prin1 var))))
983 (if var (princ "\n")))
985 (princ ";; End of Saved Settings\n")))
986 (set-marker output-marker nil)
988 (set-buffer output-buffer)
990 (setq liece-save-variables-are-dirty nil))
992 (defun liece-command-reconfigure-windows ()
993 "Rearrange window splitting."
995 (let ((command-window (liece-get-buffer-window liece-command-buffer))
996 (dialogue-window (liece-get-buffer-window liece-dialogue-buffer))
997 (obuffer (current-buffer)))
998 (if (and command-window dialogue-window)
999 (let ((ch (window-height command-window))
1000 (dh (window-height dialogue-window)))
1001 (delete-window command-window)
1002 (pop-to-buffer liece-dialogue-buffer)
1003 (enlarge-window (+ ch dh (- dh))))
1004 (pop-to-buffer liece-dialogue-buffer))
1005 (liece-configure-windows)
1006 (if liece-one-buffer-mode
1007 (pop-to-buffer liece-dialogue-buffer)
1008 (pop-to-buffer obuffer))))
1010 (defun liece-command-end-of-buffer ()
1011 "Get end of the dialogue buffer."
1013 (let (buffer window)
1014 (setq buffer (if liece-channel-buffer-mode
1015 liece-channel-buffer
1016 liece-dialogue-buffer))
1017 (or (setq window (liece-get-buffer-window buffer))
1018 (setq window (liece-get-buffer-window liece-dialogue-buffer)
1019 buffer liece-dialogue-buffer))
1021 (save-selected-window
1022 (select-window window)
1023 (goto-char (point-max))))))
1025 (defun liece-command-private-conversation (arg)
1026 "Toggle between private conversation mode and channel mode.
1027 User can then join and part to a private conversation as he would
1028 join or part to a channel.
1030 If there are no private conversations or argument is given user is
1031 prompted the partner/channel (return as partner/channel means toggle
1032 mode, the current channel and current chat partner are not altered)
1033 Argument ARG is prefix argument of toggle status."
1035 (let ((completion-ignore-case t))
1037 (if current-prefix-arg
1038 ;; prefixed, ask where to continue
1039 (if (eq liece-command-buffer-mode 'chat)
1040 (liece-minibuffer-completing-default-read
1041 (_ "Return to channel: ")
1042 (append liece-channel-alist liece-nick-alist)
1043 nil nil liece-current-channel)
1045 (_ "Start private conversation with: ")
1046 liece-nick-alist nil nil))
1047 ;; no prefix, see if going to chat
1048 (if (eq liece-command-buffer-mode 'channel)
1049 ;; and if we have chat partner, select that
1050 (if liece-current-chat-partner
1051 liece-current-chat-partner
1053 (_ "Start private conversation with: ")
1054 liece-nick-alist )))))))
1056 (liece-toggle-command-buffer-mode)
1057 (if (and arg (not (string-equal arg "")))
1058 (liece-command-join arg))
1059 (liece-set-channel-indicator)
1060 (liece-set-crypt-indicator)
1061 ;; refresh mode line
1062 (force-mode-line-update))
1064 (defun liece-command-next-channel ()
1065 "Select next channel or chat partner, and *DONT* rotate list."
1067 (let ((rest (copy-sequence
1068 (if (eq liece-command-buffer-mode 'chat)
1069 liece-current-chat-partners
1070 liece-current-channels)))
1071 (chnl (if (eq liece-command-buffer-mode 'chat)
1072 liece-current-chat-partner
1073 liece-current-channel)))
1074 (liece-switch-to-channel
1075 (or (cadr (liece-channel-member chnl (delq nil rest)))
1076 (car (delq nil rest))
1079 (defun liece-command-previous-channel ()
1080 "Select previous channel or chat partner, and *DONT* rotate list."
1084 (if (eq liece-command-buffer-mode 'chat)
1085 liece-current-chat-partners
1086 liece-current-channels)))
1088 (if (eq liece-command-buffer-mode 'chat)
1089 liece-current-chat-partner
1090 liece-current-channel)))
1091 (liece-switch-to-channel
1092 (or (cadr (liece-channel-member chnl (delq nil rest)))
1093 (car (delq nil rest))
1096 (defun liece-command-push ()
1097 "Select next channel or chat partner, and rotate list."
1100 (if (eq liece-command-buffer-mode 'chat)
1101 liece-current-chat-partners
1102 liece-current-channels))
1103 (temp (car (last rest)))
1104 (len (length rest)))
1107 (setcar (nthcdr (1- len) rest) (nth (- len 2) rest))
1110 (setcar rest temp)))
1111 (liece-channel-change)))
1113 (defun liece-command-pop ()
1114 "Select previous channel or chat partner, and rotate list."
1117 (if (eq liece-command-buffer-mode 'chat)
1118 liece-current-chat-partners
1119 liece-current-channels))
1121 (len (length rest)))
1124 (setcar (nthcdr i rest) (nth (1+ i) rest)))
1126 (setcar (last rest) temp)))
1127 (liece-channel-change)))
1129 (defvar liece-redisplay-buffer-functions
1130 '(liece-channel-redisplay-buffer
1131 liece-nick-redisplay-buffer
1132 liece-channel-list-redisplay-buffer))
1134 (defun liece-switch-to-channel (chnl)
1135 "Switch the current channel to CHNL."
1136 (if (liece-channel-p (liece-channel-real chnl))
1138 (liece-toggle-command-buffer-mode 'channel)
1139 (setq liece-current-channel chnl)
1140 (liece-set-channel-indicator))
1141 (liece-toggle-command-buffer-mode 'chat)
1142 (setq liece-current-chat-partner chnl)
1143 (liece-set-channel-indicator))
1145 (run-hook-with-args 'liece-redisplay-buffer-functions chnl))
1146 (liece-set-crypt-indicator)
1149 (defun liece-switch-to-channel-no (num)
1150 "Switch the current channel to NUM."
1151 (let* ((mode liece-command-buffer-mode)
1152 (chnls (if (eq mode 'chat)
1153 liece-current-chat-partners
1154 liece-current-channels)))
1155 (if (and (integerp num)
1156 (stringp (nth num chnls)))
1157 (let ((chnl (nth num chnls)))
1160 (liece-toggle-command-buffer-mode 'chat)
1161 (setq liece-current-chat-partner chnl)
1162 (liece-set-channel-indicator))
1163 (liece-toggle-command-buffer-mode 'channel)
1164 (setq liece-current-channel chnl)
1165 (liece-set-channel-indicator))
1167 (run-hook-with-args 'liece-redisplay-buffer-functions chnl))
1168 (liece-set-crypt-indicator)
1170 (message "Invalid channel!")
1173 (defun liece-command-ping ()
1174 "Send PING to server."
1176 (if (stringp liece-server-name)
1177 (liece-send "PING %s" liece-server-name)))
1179 (defun liece-command-ison (nicks)
1182 (let (nicks (completion-ignore-case t))
1183 (setq nicks (liece-minibuffer-completing-sequential-read
1184 "IsON" 0 liece-nick-alist))
1186 (liece-send "ISON :%s" (mapconcat #'identity nicks " ")))
1188 (defun liece-command-activate-friends (nicks)
1189 "Register NICKS to the frinends list."
1191 (let (nicks (completion-ignore-case t))
1193 (liece-minibuffer-completing-sequential-read
1195 (filter-elements nick liece-nick-alist
1196 (not (string-list-member-ignore-case
1197 (car nick) liece-friends)))))
1199 (setq liece-friends (append nicks liece-friends)))
1201 (defun liece-command-deactivate-friends ()
1202 "Clear current friends list."
1204 (setq liece-friends nil))
1206 (defun liece-command-display-friends ()
1207 "Display status of the friends."
1209 (with-output-to-temp-buffer " *IRC Friends*"
1210 (set-buffer standard-output)
1211 (insert "Friends status: \n\n")
1212 (dolist (friend liece-friends)
1213 (if (string-list-member-ignore-case friend liece-friends-last)
1214 (insert "+ " friend "\n")
1215 (insert "- " friend "\n")))))
1217 (defun liece-command-userhost (nicks)
1218 "Ask for the hostnames of NICKS."
1220 (let (nicks (completion-ignore-case t))
1221 (setq nicks (liece-minibuffer-completing-sequential-read
1222 (_ "Userhost nick") 0
1223 (list-to-alist liece-nick-alist)))
1225 (liece-send "USERHOST :%s" (mapconcat 'identity nicks ",")))
1227 (defun liece-command-show-last-kill ()
1228 "Dig last kill from KILL and show it."
1231 (append liece-D-buffer liece-O-buffer)
1233 (set-buffer liece-KILLS-buffer)
1234 (goto-char (point-max))
1236 (concat (buffer-substring (point) (point-max)) "\n"))))
1238 (defun liece-command-toggle-private ()
1239 "Toggle private mode / channel mode."
1241 (case (prog1 liece-command-buffer-mode
1242 (liece-toggle-command-buffer-mode))
1244 (if liece-current-channel
1245 (liece-switch-to-channel liece-current-channel))
1246 (setq liece-command-buffer-mode-indicator "Channels"))
1248 (if liece-current-chat-partner
1249 (liece-switch-to-channel liece-current-chat-partner))
1250 (setq liece-command-buffer-mode-indicator "Partners")))
1251 (liece-channel-change))
1253 (defun liece-command-tag-region (start end)
1254 "Move current region between START and END to `kill-ring'."
1256 (if (region-active-p)
1257 (list (region-beginning)(region-end))
1258 (list (line-beginning-position)(line-end-position))))
1259 (static-if (fboundp 'extent-property)
1260 (kill-ring-save start end)
1261 (let ((start (set-marker (make-marker) start))
1262 (end (set-marker (make-marker) end))
1263 (inhibit-read-only t)
1266 (liece-remove-properties-region start end)
1267 (kill-ring-save start end)
1268 (push nil buffer-undo-list)
1271 (provide 'liece-commands)
1273 ;;; liece-commands.el ends here