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-misc))
35 (require 'liece-channel)
37 (require 'liece-coding)
39 (require 'liece-minibuf)
41 (autoload 'liece-dcc-chat-send "liece-dcc")
43 (autoload 'liece-command-ctcp-version "liece-ctcp" nil t)
44 (autoload 'liece-command-ctcp-userinfo "liece-ctcp" nil t)
45 (autoload 'liece-command-ctcp-clientinfo "liece-ctcp" nil t)
46 (autoload 'liece-command-ctcp-ping "liece-ctcp" nil t)
47 (autoload 'liece-command-ctcp-time "liece-ctcp" nil t)
48 (autoload 'liece-command-ctcp-x-face "liece-ctcp" nil t)
49 (autoload 'liece-command-ctcp-comment "liece-ctcp" nil t)
50 (autoload 'liece-command-ctcp-help "liece-ctcp" nil t)
52 (defun liece-command-poll-names ()
53 "Handler for polling NAMES."
54 (when (liece-server-opened)
57 (length liece-channel-alist)))
58 (dolist (chnl liece-channel-alist)
59 (liece-send "NAMES %s" (car chnl)))))
61 (defun liece-command-poll-friends ()
62 "Handler for polling ISON."
65 (liece-send "ISON %s" (mapconcat 'identity liece-friends " "))))
67 (defun liece-command-find-timestamp ()
68 "Find recent timestamp in dialogue buffer."
72 (regexp (concat "^\\(" liece-time-prefix-regexp "\\)?"
73 (regexp-quote liece-timestamp-prefix))))
74 (unless (eq 'liece-dialogue-mode (derived-mode-class major-mode))
75 (set-buffer liece-dialogue-buffer)
76 (goto-char (point-max)))
77 (if (re-search-backward regexp (point-min) t)
78 (setq range (concat (buffer-substring (match-end 0)
81 (if (re-search-forward regexp (point-max) t)
82 (setq range (concat range (buffer-substring (match-end 0)
83 (line-end-position)))))
84 (liece-message range))))
86 (defun liece-command-keepalive ()
87 "Handler for polling server connection."
88 (if (not (liece-server-opened))
90 (liece-ping-if-idle)))
92 (defvar liece-last-timestamp-time nil "Last time timestamp was inserted.")
93 (defvar liece-last-timestamp-no-cons-p nil "Last timestamp was no-cons.")
95 (defun liece-command-timestamp-if-interval-expired (&optional no-cons)
96 "If interval timer has expired, insert timestamp into dialogue buffer.
97 And save variables into `liece-variable-file' if there are variables to save.
98 Optional argument NO-CONS specifies timestamp format is cons cell."
100 (when (and (not (and no-cons
101 liece-last-timestamp-no-cons-p))
102 (numberp liece-timestamp-interval)
103 (> liece-timestamp-interval 0)
104 (or (null liece-last-timestamp-time)
105 (> (liece-time-difference liece-last-timestamp-time
107 liece-timestamp-interval)))
108 (if liece-save-variables-are-dirty
109 (liece-command-save-vars))
110 (liece-command-timestamp)
111 (setq liece-last-timestamp-no-cons-p no-cons)))
113 (defun liece-command-timestamp ()
114 "Insert timestamp into dialogue buffer."
116 (let ((stamp (format liece-timestamp-format
117 (funcall liece-format-time-function (current-time))))
118 (liece-timestamp-interval 0))
119 (liece-insert liece-D-buffer (concat stamp "\n"))
120 (setq liece-last-timestamp-time (current-time))))
122 (defun liece-command-point-back-to-command-buffer ()
123 "Set point back to command buffer."
125 (let ((win (liece-get-buffer-window liece-command-buffer)))
126 (if win (select-window win))))
128 (defun liece-command-send-message (message)
129 "Send MESSAGE to current chat partner of current channel."
130 (if (string-equal message "")
131 (progn (liece-message (_ "No text to send")) nil)
132 (let ((addr (if (eq liece-command-buffer-mode 'chat)
133 liece-current-chat-partner
134 liece-current-channel))
135 repr method name target)
137 ((eq liece-command-buffer-mode 'chat)
138 (or liece-current-chat-partner
140 (substitute-command-keys
141 "Type \\[liece-command-join] to start private conversation")))
142 (setq repr (liece-channel-parse-representation
143 liece-current-chat-partner)
146 target (aref repr 2))
147 (cond ((eq method 'dcc)
148 (liece-dcc-chat-send target message))
150 (liece-send "PRIVMSG %s :%s"
151 liece-current-chat-partner message)))
152 (liece-own-private-message message))
154 (or liece-current-channel
156 (substitute-command-keys
157 "Type \\[liece-command-join] to join a channel")))
160 (liece-channel-real liece-current-channel) message)
161 (liece-own-channel-message message))))))
163 (defun liece-command-enter-message ()
164 "Enter the current line as an entry in the IRC dialogue."
167 (liece-command-send-message
168 (buffer-substring (point)(progn (end-of-line) (point))))
171 (defun liece-dialogue-enter-message ()
172 "Ask for a line as an entry in the IRC dialogue on the current channel."
175 (while (not (string-equal (setq message (read-string "> ")) ""))
176 (liece-command-send-message message))))
178 (defun liece-command-join-channel (join-channel-var key)
179 "Join a JOIN-CHANNEL-VAR with KEY."
180 (let ((nicks liece-nick-alist) nick)
184 (liece-channel-equal join-channel-var (car nick)))))
185 (setq nick (pop nicks)))
187 (setq join-channel-var
188 (or (car (get (intern (car nick) liece-obarray) 'chnl))
190 (if (liece-channel-member join-channel-var liece-current-channels)
192 (setq liece-current-channel join-channel-var)
193 (liece-switch-to-channel liece-current-channel)
194 (liece-channel-change))
195 (liece-send "JOIN %s %s" (liece-channel-real join-channel-var) key))))
197 (defun liece-command-join-partner (join-channel-var)
198 "Join a JOIN-CHANNEL-VAR."
199 (if (liece-channel-member join-channel-var liece-current-chat-partners)
201 (setq liece-current-chat-partner join-channel-var)
202 (liece-switch-to-channel liece-current-chat-partner))
203 (setq liece-current-chat-partner join-channel-var)
204 (liece-channel-join liece-current-chat-partner))
205 (liece-channel-change))
207 (defun liece-command-join (join-channel-var &optional key)
208 "Join a JOIN-CHANNEL-VAR with KEY.
209 If user nickname is given join the same set of channels as the specified user.
210 If command-buffer is in chat-mode, start private conversation
211 with specified user."
213 (let (join-channel-var key (completion-ignore-case t))
214 (setq join-channel-var
215 (if (numberp current-prefix-arg)
217 (liece-channel-virtual
218 (if (eq liece-command-buffer-mode 'chat)
219 (liece-minibuffer-completing-read
220 (_ "Start private conversation with: ")
221 liece-nick-alist nil nil nil nil liece-privmsg-partner)
222 (liece-minibuffer-completing-read
224 (append liece-channel-alist liece-nick-alist)
225 nil nil nil nil liece-default-channel-candidate)))))
226 (if (and current-prefix-arg
227 (not (numberp current-prefix-arg)))
229 (if (eq current-prefix-arg '-)
231 (format (_ "Key for channel %s: ") join-channel-var))
232 (let ((passwd-echo ?*))
234 (format (_ "Key for channel %s: ") join-channel-var))))))
235 (list join-channel-var key)))
236 (let ((real-chnl (liece-channel-real join-channel-var)))
237 (if (numberp join-channel-var)
238 (liece-switch-to-channel-no join-channel-var)
239 (setq liece-default-channel-candidate nil)
240 (if (liece-channel-p real-chnl)
241 (liece-toggle-command-buffer-mode 'channel)
242 (liece-toggle-command-buffer-mode 'chat))
243 (if (eq liece-command-buffer-mode 'chat)
244 (liece-command-join-partner join-channel-var)
246 (setq key (get (intern join-channel-var liece-obarray) 'key)))
247 (put (intern join-channel-var liece-obarray) 'key key)
250 (liece-command-join-channel join-channel-var key))
251 (force-mode-line-update))))
253 (defun liece-command-part (part-channel-var &optional part-msg)
254 "Part a PART-CHANNEL-VAR with PART-MSG."
256 (let (part-channel-var
257 (completion-ignore-case t)
259 (setq part-channel-var
260 (liece-channel-virtual
261 (if (eq liece-command-buffer-mode 'chat)
262 (liece-minibuffer-completing-read
263 (_ "End private conversation with: ")
264 (list-to-alist liece-current-chat-partners)
265 nil nil nil nil liece-current-chat-partner)
266 (liece-minibuffer-completing-read
268 (list-to-alist liece-current-channels)
269 nil nil nil nil liece-current-channel))))
270 (when current-prefix-arg
271 (setq part-msg (read-string (_ "Part Message: "))))
272 (list part-channel-var part-msg)))
273 (let ((real-chnl (liece-channel-real part-channel-var)))
274 (if (liece-channel-p real-chnl)
276 (if (liece-channel-member part-channel-var liece-current-channels)
277 (setq liece-current-channel part-channel-var))
278 (liece-send "PART %s :%s" real-chnl part-msg)
279 (setq liece-default-channel-candidate part-channel-var))
280 (setq liece-current-chat-partners
281 (liece-channel-remove part-channel-var
282 liece-current-chat-partners)
283 liece-current-chat-partner
284 (car liece-current-chat-partners))
285 (liece-set-channel-indicator)
286 (liece-channel-part part-channel-var))))
288 (defun liece-command-kill (kill-nickname-var &optional timeout silent)
289 "Ignore messages from KILL-NICKNAME-VAR.
290 Username can be given as case insensitive regular expression of form
291 \".*@.*\.sub.domain\".
292 If already ignoring him/her, toggle.
293 If `liece-variables-file' is defined and the file is writable,
294 settings are updated automatically for future sessions.
295 Optional argument TIMEOUT says expiration.
296 If SILENT is non-nil, don't notify current status."
298 (let (kill-nickname-var timeout (completion-ignore-case t))
299 (setq kill-nickname-var (completing-read
300 (_ "Ignore nickname or regexp: ")
301 (append liece-nick-alist
302 liece-kill-nickname)))
303 (or (string-equal "" kill-nickname-var)
304 (string-assoc-ignore-case kill-nickname-var liece-kill-nickname)
305 (setq timeout (string-to-int (read-from-minibuffer
306 (_ "Timeout [RET for none]: ")))))
307 (list kill-nickname-var timeout)))
308 ;; empty, just list them
309 (if (string-equal "" kill-nickname-var)
310 (with-current-buffer liece-dialogue-buffer
311 (let ((ignores liece-kill-nickname) (time (current-time))
312 buffer-read-only expire expiretime)
313 (goto-char (point-max))
314 (liece-insert-info liece-D-buffer (_ "Currently ignoring:"))
315 (dolist (ignore ignores)
316 (setq expiretime (if (cdr ignore)
317 (/ (liece-time-difference time (cdr ignore))
319 expire (cond ((not expiretime) "")
321 (format (_ " (%d min)") expiretime))
324 (liece-insert liece-D-buffer
325 (concat " " (car ignore) expire "\n")))))
326 ;; else not empty, check if exists
328 (string-assoc-ignore-case
329 kill-nickname-var liece-kill-nickname)))
331 (when (setq ignore (string-assoc-ignore-case
332 (car ignore) liece-kill-nickname))
333 (setq liece-kill-nickname
334 (delq ignore liece-kill-nickname))
335 (liece-insert-info liece-D-buffer
336 (format (_ "No longer ignoring: %s.\n")
338 ;; did not find, add to ignored ones
339 (let ((expire-time (if (> timeout 0)
340 (liece-time-add (current-time)
342 (and silent (> timeout 0)
343 (setcar (cdr (cdr expire-time)) -1))
344 (setq liece-kill-nickname
345 (cons (cons kill-nickname-var expire-time)
346 liece-kill-nickname))
348 (liece-insert-info liece-D-buffer
349 (format (_ "Ignoring %s") kill-nickname-var))
350 (liece-insert-info liece-D-buffer
352 (format " for %d minutes.\n" timeout)
354 (setq liece-save-variables-are-dirty t)))
356 (defun liece-command-kick (nick &optional msg)
357 "Kick this NICK out with MSG."
359 (let ((completion-ignore-case t)
360 (nicks (liece-channel-get-nicks)) nick msg)
361 (setq nick (completing-read
362 (_ "Kick out nickname: ")
363 (list-to-alist nicks)))
364 (if current-prefix-arg
365 (setq msg (concat " :" (read-string (_ "Kick Message: ")))))
367 (liece-send "KICK %s %s%s"
368 (liece-channel-real liece-current-channel)
371 (defun liece-command-ban (ban)
374 (let* ((completion-ignore-case t)
375 (nicks (liece-channel-get-nicks))
380 (concat nick "!" (liece-nick-get-user-at-host nick)))))
383 (setq ban (liece-minibuffer-completing-read
384 (_ "Ban pattern: ") uahs nil nil nil nil
385 (concat nick "!" (liece-nick-get-user-at-host nick))))
387 (liece-send "MODE %s :+b %s"
388 (liece-channel-real liece-current-channel) ban))
390 (defun liece-command-ban-kick (ban nick &optional msg)
391 "BAN kick this NICK out with MSG."
393 (let* ((completion-ignore-case t)
394 (nicks (liece-channel-get-nicks))
399 (concat nick "!" (liece-nick-get-user-at-host nick)))))
402 (setq nick (completing-read (_ "Kick out nickname: ")
403 (list-to-alist nicks))
404 ban (liece-minibuffer-completing-read
405 (_ "Ban pattern: ") uahs nil nil nil nil
406 (concat nick "!" (liece-nick-get-user-at-host nick))))
407 (if current-prefix-arg
408 (setq msg (concat " :" (read-string (_ "Kick Message: "))))
410 (list ban nick msg)))
411 (liece-send "MODE %s :+b %s"
412 (liece-channel-real liece-current-channel) ban)
413 (liece-send "KICK %s %s%s"
414 (liece-channel-real liece-current-channel)
417 (defun liece-command-list (&optional channel)
418 "List the given CHANNEL and its topics.
419 If you enter only Control-U as argument, list the current channel.
420 With - as argument, list all channels."
422 (if (or current-prefix-arg (null liece-current-channel))
423 (if (eq current-prefix-arg '-)
424 (list current-prefix-arg))
425 (let ((completion-ignore-case t) channel)
426 (setq channel (liece-minibuffer-completing-read
428 liece-channel-alist nil nil nil nil liece-current-channel))
429 (unless (string-equal "" channel)
433 (if liece-current-channel
434 (liece-send "LIST %s"
435 (liece-channel-real liece-current-channel))))
436 ((and (eq channel '-)
437 (y-or-n-p (_ "Do you really query LIST without argument?")))
439 ((not (string-equal channel ""))
440 (liece-send "LIST %s" (liece-channel-real channel))
443 (defun liece-command-modec (chnl change)
444 "Send a MODE command to this CHNL.
447 (let ((completion-ignore-case t)
448 (chnl liece-current-channel)
449 liece-minibuffer-complete-function prompt)
450 (if current-prefix-arg
452 (liece-minibuffer-completing-read
454 (append liece-channel-alist liece-nick-alist)
455 nil nil nil nil liece-current-channel)))
457 ((liece-channel-p (liece-channel-real chnl))
459 (_ "Mode for channel %s [%s]: ")
460 chnl (or (liece-channel-get-modes chnl) ""))
461 liece-minibuffer-complete-function
462 (function liece-minibuffer-complete-channel-modes)))
465 (_ "Mode for user %s [%s]: ")
466 chnl (or (liece-nick-get-modes chnl) ""))
467 liece-minibuffer-complete-function
468 (function liece-minibuffer-complete-user-modes))))
469 (list chnl (read-from-minibuffer prompt nil liece-minibuffer-map))))
470 (liece-send "MODE %s %s" (liece-channel-real chnl) change))
472 (defun liece-command-qualify-nicks (mode nicks val)
475 (liece-channel-real liece-current-channel)
476 (if val ?+ ?-) (make-string (length nicks) ?o)
477 (string-join nicks " ")))
479 (defun liece-command-set-operators (nicks &optional arg)
481 (let ((opers (liece-channel-get-operators))
482 (completion-ignore-case t)
484 (if current-prefix-arg
485 (setq nicks (liece-minibuffer-completing-read-multiple
486 (_ "Divest operational privilege from: ")
487 (list-to-alist opers)))
488 (setq nicks (liece-channel-get-nicks)
489 nicks (filter-elements nick nicks
490 (not (liece-nick-member nick opers)))
491 nicks (liece-minibuffer-completing-read-multiple
492 (_ "Assign operational privilege to: ")
493 (list-to-alist nicks))))
494 (list nicks current-prefix-arg)))
499 (if (= (length run) liece-compress-mode-length)
500 (liece-command-qualify-nicks ?o run (not arg))))
502 (liece-command-qualify-nicks ?o run (not arg))))))
504 (defun liece-command-set-voices (nicks &optional arg)
506 (let ((voices (liece-channel-get-voices))
507 (completion-ignore-case t)
509 (if current-prefix-arg
510 (setq nicks (liece-minibuffer-completing-read-multiple
511 (_ "Forbid to speak: ") (list-to-alist voices)))
512 (setq voices (append voices (liece-channel-get-operators))
513 nicks (liece-channel-get-nicks)
514 nicks (filter-elements nick nicks
515 (not (liece-nick-member nick voices)))
516 nicks (liece-minibuffer-completing-read-multiple
517 (_ "Allow to speak: ") (list-to-alist nicks))))
518 (list nicks current-prefix-arg)))
523 (if (= (length run) liece-compress-mode-length)
524 (liece-command-qualify-nicks ?v run (not arg))))
526 (liece-command-qualify-nicks ?v run (not arg))))))
528 (defun liece-command-message (address message)
529 "Send ADDRESS a private MESSAGE."
531 (let ((completion-ignore-case t) address)
533 (liece-channel-virtual
534 (liece-minibuffer-completing-read
535 (_ "Private message to: ")
536 (append liece-nick-alist liece-channel-alist)
537 nil nil nil nil liece-privmsg-partner)))
541 (_ "Private message to %s: ")
543 (if (funcall liece-message-empty-predicate message)
544 (progn (liece-message (_ "No text to send")) nil)
545 (let ((chnl (liece-channel-real address)))
546 (liece-send "PRIVMSG %s :%s" chnl message)
547 (if (liece-channel-p chnl)
548 (liece-own-channel-message message
549 (liece-channel-virtual address))
550 (liece-own-private-message message address)))))
552 (defun liece-command-mta-private (partner)
553 "Send a private message (current line) to PARTNER."
555 (let ((completion-ignore-case t))
556 (setq liece-privmsg-partner
557 (liece-channel-virtual
558 (liece-minibuffer-completing-read
560 (append liece-nick-alist liece-channel-alist)
561 nil nil nil nil liece-privmsg-partner)))
562 (list liece-privmsg-partner)))
563 (let ((message (buffer-substring (progn (beginning-of-line) (point))
564 (progn (end-of-line) (point)))))
565 (if (> (length message) 0)
567 (liece-command-message liece-privmsg-partner message)
569 (liece-message (_ "No text to send")))))
571 (defun liece-command-names (&optional expr)
572 "List the nicknames of the current IRC users on given EXPR.
573 With an Control-U as argument, only the current channel is listed.
574 With - as argument, list all channels."
576 (if (or current-prefix-arg (null liece-current-channel))
577 (if (eq current-prefix-arg '-)
578 (list current-prefix-arg))
579 (let ((completion-ignore-case t) expr)
580 (setq expr (liece-minibuffer-completing-read
581 (_ "Names on channel: ")
582 liece-channel-alist nil nil nil nil liece-current-channel))
583 (unless (string-equal "" expr)
585 (when (or (and (eq expr '-)
587 (_ "Do you really query NAMES without argument?")))
589 (if liece-current-channel
590 (setq expr (liece-channel-real
591 liece-current-channel))))))
594 (liece-send "NAMES %s" expr)))
596 (defun liece-command-nickname (nick)
597 "Set your nickname to NICK."
598 (interactive "sEnter your nickname: ")
599 (let ((nickname (truncate-string nick liece-nick-max-length)))
600 (if (zerop (length nickname))
601 (liece-message (_ "illegal nickname \"%s\"; not changed") nickname)
602 (liece-send "NICK %s" nick))))
604 (defun liece-command-who (&optional expr)
605 "Lists tue users that match the given expression EXPR.
606 If you enter only Control-U as argument, list the current channel.
607 With - as argument, list all users."
609 (if (or current-prefix-arg (null liece-current-channel))
610 (if (eq current-prefix-arg '-)
611 (list current-prefix-arg))
612 (let ((completion-ignore-case t) expr)
613 (setq expr (completing-read
614 (_ "WHO expression: ")
615 (append liece-channel-alist liece-nick-alist)))
616 (unless (string-equal "" expr)
618 (when (or (and (eq expr '-)
620 (_ "Do you really query WHO without argument?")))
622 (if liece-current-channel
623 (setq expr (liece-channel-real
624 liece-current-channel))))))
627 (liece-send "WHO %s" expr)
628 (setq liece-who-expression expr)))
630 (defun liece-command-finger (finger-nick-var &optional server)
631 "Get information about a specific user FINGER-NICK-VAR.
632 If called with optional argument SERVER or any prefix argument,
633 query information to the foreign server."
635 (let (finger-nick-var (completion-ignore-case t))
636 (setq finger-nick-var
637 (completing-read (_ "Finger whom: ") liece-nick-alist))
638 (list finger-nick-var (and current-prefix-arg finger-nick-var))))
640 (liece-send "WHOIS %s %s" server finger-nick-var)
641 (liece-send "WHOIS %s" finger-nick-var)))
643 (defun liece-command-topic (topic)
644 "Change TOPIC of the current channel."
646 (list (read-from-minibuffer
647 "Topic: " (cons (or (liece-channel-get-topic) "") 0))))
648 (liece-send "TOPIC %s :%s"
649 (liece-channel-real liece-current-channel) topic))
651 (defun liece-command-invite (&optional invite-nick-var invite-channel-var)
652 "Invite INVITE-NICK-VAR to INVITE-CHANNEL-VAR."
654 (let ((completion-ignore-case t) invite-channel-var invite-nick-var)
655 (if current-prefix-arg
656 (setq invite-channel-var
657 (liece-channel-virtual
659 (_ "Invite channel: ")
660 (list-to-alist liece-current-channels)))))
661 (setq invite-nick-var
665 (list invite-nick-var invite-channel-var)))
666 (or invite-channel-var
667 (setq invite-channel-var liece-current-channel))
668 (liece-send "INVITE %s %s"
669 invite-nick-var (liece-channel-real invite-channel-var)))
671 (defun liece-command-away (awaymsg)
672 "Mark/unmark yourself as being away.
673 Leave message AWAYMSG."
674 (interactive "sAway message: ")
675 (liece-send "AWAY :%s" awaymsg)
676 (setq liece-away-message awaymsg))
678 (defun liece-command-scroll-down (lines)
679 "Scroll LINES down dialogue buffer from command buffer."
681 (let ((other-window-scroll-buffer
682 (if liece-channel-buffer-mode
684 liece-dialogue-buffer)))
685 (when (liece-get-buffer-window other-window-scroll-buffer)
687 (scroll-other-window-down lines)
689 (message "Beginning of buffer"))))))
691 (defun liece-command-scroll-up (lines)
692 "Scroll LINES up dialogue buffer from command buffer."
694 (let* ((other-window-scroll-buffer
695 (if liece-channel-buffer-mode
697 liece-dialogue-buffer)))
698 (when (liece-get-buffer-window other-window-scroll-buffer)
700 (scroll-other-window lines)
702 (message "End of buffer"))))))
704 (defun liece-command-nick-scroll-down (lines)
705 "Scroll LINES down nick buffer from command buffer."
707 (let ((other-window-scroll-buffer liece-nick-buffer))
708 (when (liece-get-buffer-window other-window-scroll-buffer)
710 (scroll-other-window-down lines)
712 (message "Beginning of buffer"))))))
714 (defun liece-command-nick-scroll-up (lines)
715 "Scroll LINES up nick buffer from command buffer."
717 (let* ((other-window-scroll-buffer liece-nick-buffer))
718 (when (liece-get-buffer-window other-window-scroll-buffer)
720 (scroll-other-window lines)
722 (message "End of buffer"))))))
724 (defun liece-command-freeze (&optional arg)
725 "Prevent automatic scrolling of the dialogue window.
726 If prefix argument ARG is non-nil, toggle frozen status."
728 (liece-freeze (if liece-channel-buffer-mode
730 liece-dialogue-buffer)
731 (if arg (prefix-numeric-value arg))))
733 (defun liece-command-own-freeze (&optional arg)
734 "Prevent automatic scrolling of the dialogue window.
735 The difference from `liece-command-freeze' is that your messages are hidden.
736 If prefix argument ARG is non-nil, toggle frozen status."
738 (liece-own-freeze (if liece-channel-buffer-mode
740 liece-dialogue-buffer)
741 (if arg (prefix-numeric-value arg))))
743 (defun liece-command-beep (&optional arg)
744 "Toggle the automatic beep notice when the channel message is received."
746 (liece-set-beep (if liece-channel-buffer-mode
748 liece-dialogue-buffer)
749 (if arg (prefix-numeric-value arg))))
751 (defun liece-command-quit (&optional arg)
753 If prefix argument ARG is non-nil, leave signoff message."
755 (when (and (liece-server-opened)
756 (y-or-n-p (_ "Quit IRC? ")))
759 (if arg (read-string (_ "Signoff message: "))
760 (or liece-signoff-message
761 (product-name (product-find 'liece-version))))))
763 (liece-send "QUIT :%s" quit-string)
764 (liece-send "QUIT")))))
766 (defun liece-command-generic (message)
767 "Enter a generic IRC MESSAGE, which is sent to the server.
768 A ? lists the useful generic messages."
769 (interactive "sIRC command (? to help): ")
770 (if (string-equal message "?")
771 (with-output-to-temp-buffer "*IRC Help*"
772 (princ "The following generic IRC messages may be of interest to you:
773 TOPIC <new topic> set the topic of your channel
774 INVITE <nickname> invite another user to join your channel
775 LINKS lists the currently reachable IRC servers
776 SUMMON <user@host> invites an user not currently in IRC
777 USERS <host> lists the users on a host
778 AWAY <reason> marks you as not really actively using IRC
779 (an empty reason clears it)
780 WALL <message> send to everyone on IRC
781 NAMES <channel> lists users per channel
783 (liece-send "%s" message)))
785 (defun liece-command-irc-compatible ()
786 "If entered at column 0, allow you to enter a generic IRC message."
788 (if (zerop (current-column))
789 (call-interactively (function liece-command-generic))
790 (self-insert-command 1)))
792 (defun liece-command-yank-send (&optional arg)
793 "Send message from yank buffer.
794 Prefix argument ARG is regarded as distance from yank pointer."
796 (when (y-or-n-p (_ "Really SEND from Yank Buffer?"))
798 (narrow-to-region (point) (point))
799 (insert (car kill-ring-yank-pointer))
800 (goto-char (point-min))
802 (liece-command-enter-message)
803 (set-buffer liece-command-buffer)))))
805 (defun liece-command-complete ()
806 "Complete word before point from userlist."
808 (let ((completion-ignore-case t)
809 (alist (if liece-current-channel
810 (list-to-alist (liece-channel-get-nicks))
812 candidate completion all)
813 (setq candidate (current-word)
814 completion (try-completion candidate alist)
815 all (all-completions candidate alist))
816 (liece-minibuffer-finalize-completion completion candidate all)))
818 (defun liece-command-load-vars ()
819 "Load configuration from liece-variables-file."
821 (let ((nick liece-real-nickname))
823 (liece-read-variables-files)
824 (setq liece-real-nickname nick)
825 (liece-command-reconfigure-windows))))
827 (defun liece-command-save-vars ()
828 "Save current settings to `liece-variables-file'."
830 (let* ((output-buffer
832 (expand-file-name liece-variables-file)))
835 (set-buffer output-buffer)
836 (goto-char (point-min))
837 (cond ((re-search-forward "^;; Saved Settings *\n" nil 'move)
838 (setq p (match-beginning 0))
840 (or (re-search-forward
841 "^;; End of Saved Settings *\\(\n\\|\\'\\)" nil t)
843 (concat "can't find END of saved state in "
844 liece-variables-file)))
845 (delete-region p (match-end 0)))
847 (goto-char (point-max))
849 (setq output-marker (point-marker))
850 (let ((print-readably t)
851 (print-escape-newlines t)
852 (standard-output output-marker))
853 (princ ";; Saved Settings\n")
854 (dolist (var liece-saved-forms)
856 (prin1 (list 'setq var
857 (let ((val (symbol-value var)))
858 (if (memq val '(t nil))
860 (list 'quote val)))))
861 (setq var (eval var))
862 (cond ((eq (car-safe var) 'progn)
863 (while (setq var (cdr var))
866 (if (cdr var) (princ " "))))
868 (prin1 "xx")(prin1 var))))
869 (if var (princ "\n")))
871 (princ ";; End of Saved Settings\n")))
872 (set-marker output-marker nil)
874 (set-buffer output-buffer)
876 (setq liece-save-variables-are-dirty nil))
878 (defun liece-command-reconfigure-windows ()
879 "Rearrange window splitting."
881 (let ((command-window (liece-get-buffer-window liece-command-buffer))
882 (dialogue-window (liece-get-buffer-window liece-dialogue-buffer))
883 (obuffer (current-buffer)))
884 (if (and command-window dialogue-window)
885 (let ((ch (window-height command-window))
886 (dh (window-height dialogue-window)))
887 (delete-window command-window)
888 (pop-to-buffer liece-dialogue-buffer)
889 (enlarge-window (+ ch dh (- dh))))
890 (pop-to-buffer liece-dialogue-buffer))
891 (liece-configure-windows)
892 (if liece-one-buffer-mode
893 (pop-to-buffer liece-dialogue-buffer)
894 (pop-to-buffer obuffer))))
896 (defun liece-command-end-of-buffer ()
897 "Get end of the dialogue buffer."
900 (setq buffer (if liece-channel-buffer-mode
902 liece-dialogue-buffer))
903 (or (setq window (liece-get-buffer-window buffer))
904 (setq window (liece-get-buffer-window liece-dialogue-buffer)
905 buffer liece-dialogue-buffer))
907 (save-selected-window
908 (select-window window)
909 (goto-char (point-max))))))
911 (defun liece-command-private-conversation (arg)
912 "Toggle between private conversation mode and channel mode.
913 User can then join and part to a private conversation as he would
914 join or part to a channel.
916 If there are no private conversations or argument is given user is
917 prompted the partner/channel (return as partner/channel means toggle
918 mode, the current channel and current chat partner are not altered)
919 Argument ARG is prefix argument of toggle status."
921 (let ((completion-ignore-case t))
923 (if current-prefix-arg
924 ;; prefixed, ask where to continue
925 (if (eq liece-command-buffer-mode 'chat)
926 (liece-minibuffer-completing-read
927 (_ "Return to channel: ")
928 (append liece-channel-alist liece-nick-alist)
929 nil nil nil nil liece-current-channel)
931 (_ "Start private conversation with: ")
932 liece-nick-alist nil nil))
933 ;; no prefix, see if going to chat
934 (if (eq liece-command-buffer-mode 'channel)
935 ;; and if we have chat partner, select that
936 (if liece-current-chat-partner
937 liece-current-chat-partner
939 (_ "Start private conversation with: ")
940 liece-nick-alist )))))))
942 (liece-toggle-command-buffer-mode)
943 (if (and arg (not (string-equal arg "")))
944 (liece-command-join arg))
945 (liece-set-channel-indicator)
947 (force-mode-line-update))
949 (defun liece-command-next-channel ()
950 "Select next channel or chat partner, and *DONT* rotate list."
952 (let ((rest (copy-sequence
953 (if (eq liece-command-buffer-mode 'chat)
954 liece-current-chat-partners
955 liece-current-channels)))
956 (chnl (if (eq liece-command-buffer-mode 'chat)
957 liece-current-chat-partner
958 liece-current-channel)))
959 (liece-switch-to-channel
960 (or (cadr (liece-channel-member chnl (delq nil rest)))
961 (car (delq nil rest))
964 (defun liece-command-previous-channel ()
965 "Select previous channel or chat partner, and *DONT* rotate list."
969 (if (eq liece-command-buffer-mode 'chat)
970 liece-current-chat-partners
971 liece-current-channels)))
973 (if (eq liece-command-buffer-mode 'chat)
974 liece-current-chat-partner
975 liece-current-channel)))
976 (liece-switch-to-channel
977 (or (cadr (liece-channel-member chnl (delq nil rest)))
978 (car (delq nil rest))
981 (defun liece-command-unread-channel ()
982 "Select unread channel or chat partner."
984 (let ((chnl (car liece-channel-unread-list)))
986 (liece-switch-to-channel chnl)
987 (liece-message (_ "No unread channel or chat partner.")))))
989 (defun liece-command-push ()
990 "Select next channel or chat partner, and rotate list."
993 (if (eq liece-command-buffer-mode 'chat)
994 liece-current-chat-partners
995 liece-current-channels))
996 (temp (car (last rest)))
1000 (setcar (nthcdr (1- len) rest) (nth (- len 2) rest))
1003 (setcar rest temp)))
1004 (liece-channel-change)))
1006 (defun liece-command-pop ()
1007 "Select previous channel or chat partner, and rotate list."
1010 (if (eq liece-command-buffer-mode 'chat)
1011 liece-current-chat-partners
1012 liece-current-channels))
1014 (len (length rest)))
1017 (setcar (nthcdr i rest) (nth (1+ i) rest)))
1019 (setcar (last rest) temp)))
1020 (liece-channel-change)))
1022 (defvar liece-redisplay-buffer-functions
1023 '(liece-channel-redisplay-buffer
1024 liece-nick-redisplay-buffer
1025 liece-channel-list-redisplay-buffer))
1027 (defun liece-switch-to-channel (chnl)
1028 "Switch the current channel to CHNL."
1029 (if (liece-channel-p (liece-channel-real chnl))
1031 (liece-toggle-command-buffer-mode 'channel)
1032 (setq liece-current-channel chnl)
1033 (liece-set-channel-indicator))
1034 (liece-toggle-command-buffer-mode 'chat)
1035 (setq liece-current-chat-partner chnl)
1036 (liece-set-channel-indicator))
1038 (run-hook-with-args 'liece-redisplay-buffer-functions chnl)))
1040 (defun liece-switch-to-channel-no (num)
1041 "Switch the current channel to NUM."
1042 (let* ((mode liece-command-buffer-mode)
1043 (chnls (if (eq mode 'chat)
1044 liece-current-chat-partners
1045 liece-current-channels)))
1046 (if (and (integerp num)
1047 (stringp (nth num chnls)))
1048 (let ((chnl (nth num chnls)))
1051 (liece-toggle-command-buffer-mode 'chat)
1052 (setq liece-current-chat-partner chnl)
1053 (liece-set-channel-indicator))
1054 (liece-toggle-command-buffer-mode 'channel)
1055 (setq liece-current-channel chnl)
1056 (liece-set-channel-indicator))
1058 (run-hook-with-args 'liece-redisplay-buffer-functions chnl)))
1059 (message "Invalid channel!"))))
1061 (defun liece-command-ping ()
1062 "Send PING to server."
1064 (if (stringp liece-server-name)
1065 (liece-send "PING %s" liece-server-name)))
1067 (defun liece-command-ison (nicks)
1070 (let (nicks (completion-ignore-case t))
1071 (setq nicks (liece-minibuffer-completing-read-multiple
1072 "IsON" liece-nick-alist))
1074 (liece-send "ISON :%s" (mapconcat #'identity nicks " ")))
1076 (defun liece-command-activate-friends (nicks)
1077 "Register NICKS to the frinends list."
1079 (let (nicks (completion-ignore-case t))
1081 (liece-minibuffer-completing-read-multiple
1083 (filter-elements nick liece-nick-alist
1084 (not (string-list-member-ignore-case
1085 (car nick) liece-friends)))))
1087 (setq liece-friends (append nicks liece-friends)))
1089 (defun liece-command-deactivate-friends ()
1090 "Clear current friends list."
1092 (setq liece-friends nil))
1094 (defun liece-command-display-friends ()
1095 "Display status of the friends."
1097 (with-output-to-temp-buffer " *IRC Friends*"
1098 (set-buffer standard-output)
1099 (insert "Friends status: \n\n")
1100 (dolist (friend liece-friends)
1101 (if (string-list-member-ignore-case friend liece-friends-last)
1102 (insert "+ " friend "\n")
1103 (insert "- " friend "\n")))))
1105 (defun liece-command-show-last-kill ()
1106 "Dig last kill from KILL and show it."
1109 (append liece-D-buffer liece-O-buffer)
1111 (set-buffer liece-KILLS-buffer)
1112 (goto-char (point-max))
1114 (concat (buffer-substring (point) (point-max)) "\n"))))
1116 (defun liece-command-toggle-private ()
1117 "Toggle private mode / channel mode."
1119 (case (prog1 liece-command-buffer-mode
1120 (liece-toggle-command-buffer-mode))
1122 (if liece-current-channel
1123 (liece-switch-to-channel liece-current-channel))
1124 (setq liece-command-buffer-mode-indicator "Channels"))
1126 (if liece-current-chat-partner
1127 (liece-switch-to-channel liece-current-chat-partner))
1128 (setq liece-command-buffer-mode-indicator "Partners")))
1129 (liece-channel-change))
1131 (defun liece-command-tag-region (start end)
1132 "Move current region between START and END to `kill-ring'."
1134 (if (region-active-p)
1135 (list (region-beginning)(region-end))
1136 (list (line-beginning-position)(line-end-position))))
1137 (static-if (fboundp 'extent-property)
1138 (kill-ring-save start end)
1139 (let ((start (set-marker (make-marker) start))
1140 (end (set-marker (make-marker) end))
1141 (inhibit-read-only t)
1144 (liece-remove-properties-region start end)
1145 (kill-ring-save start end)
1146 (push nil buffer-undo-list)
1149 (provide 'liece-commands)
1151 ;;; liece-commands.el ends here