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-action "liece-ctcp" nil t)
44 (autoload 'liece-command-ctcp-version "liece-ctcp" nil t)
45 (autoload 'liece-command-ctcp-userinfo "liece-ctcp" nil t)
46 (autoload 'liece-command-ctcp-userinfo-from-minibuffer "liece-ctcp" nil t)
47 (autoload 'liece-command-ctcp-help "liece-ctcp" nil t)
48 (autoload 'liece-command-ctcp-clientinfo "liece-ctcp" nil t)
49 (autoload 'liece-command-ctcp-ping "liece-ctcp" nil t)
50 (autoload 'liece-command-ctcp-time "liece-ctcp" nil t)
51 (autoload 'liece-command-ctcp-x-face "liece-ctcp" nil t)
52 (autoload 'liece-command-ctcp-x-face-from-xbm-file "liece-ctcp" nil t)
53 (autoload 'liece-command-ctcp-comment "liece-ctcp" nil t)
55 (defun liece-command-poll-names ()
56 "Handler for polling NAMES."
57 (when (liece-server-opened)
60 (length liece-channel-alist)))
61 (dolist (chnl liece-channel-alist)
62 (liece-send "NAMES %s" (car chnl)))))
64 (defun liece-command-poll-friends ()
65 "Handler for polling ISON."
68 (liece-send "ISON %s" (mapconcat 'identity liece-friends " "))))
70 (defun liece-command-find-timestamp ()
71 "Find recent timestamp in dialogue buffer."
75 (regexp (concat "^\\(" liece-time-prefix-regexp "\\)?"
76 (regexp-quote liece-timestamp-prefix))))
77 (unless (eq 'liece-dialogue-mode (derived-mode-class major-mode))
78 (set-buffer liece-dialogue-buffer)
79 (goto-char (point-max)))
80 (if (re-search-backward regexp (point-min) t)
81 (setq range (concat (buffer-substring (match-end 0)
84 (if (re-search-forward regexp (point-max) t)
85 (setq range (concat range (buffer-substring (match-end 0)
86 (line-end-position)))))
87 (liece-message range))))
89 (defun liece-command-keepalive ()
90 "Handler for polling server connection."
91 (if (not (liece-server-opened))
93 (liece-ping-if-idle)))
95 (defvar liece-last-timestamp-time nil "Last time timestamp was inserted.")
96 (defvar liece-last-timestamp-no-cons-p nil "Last timestamp was no-cons.")
98 (defun liece-command-timestamp-if-interval-expired (&optional no-cons)
99 "If interval timer has expired, insert timestamp into dialogue buffer.
100 And save variables into `liece-variable-file' if there are variables to save.
101 Optional argument NO-CONS specifies timestamp format is cons cell."
103 (when (and (not (and no-cons
104 liece-last-timestamp-no-cons-p))
105 (numberp liece-timestamp-interval)
106 (> liece-timestamp-interval 0)
107 (or (null liece-last-timestamp-time)
108 (> (liece-time-difference liece-last-timestamp-time
110 liece-timestamp-interval)))
111 (if liece-save-variables-are-dirty
112 (liece-command-save-vars))
113 (liece-command-timestamp)
114 (setq liece-last-timestamp-no-cons-p no-cons)))
116 (defun liece-command-timestamp ()
117 "Insert timestamp into dialogue buffer."
119 (let ((stamp (format liece-timestamp-format
120 (funcall liece-format-time-function (current-time))))
121 (liece-timestamp-interval 0))
122 (liece-insert liece-D-buffer (concat stamp "\n"))
123 (setq liece-last-timestamp-time (current-time))))
125 (defun liece-command-point-back-to-command-buffer ()
126 "Set point back to command buffer."
128 (let ((win (liece-get-buffer-window liece-command-buffer)))
129 (if win (select-window win))))
131 (defun liece-command-send-message (message)
132 "Send MESSAGE to current chat partner of current channel."
133 (if (string-equal message "")
134 (progn (liece-message (_ "No text to send")) nil)
135 (let ((addr (if (eq liece-command-buffer-mode 'chat)
136 liece-current-chat-partner
137 liece-current-channel))
138 repr method name target)
140 ((eq liece-command-buffer-mode 'chat)
141 (or liece-current-chat-partner
143 (substitute-command-keys
144 "Type \\[liece-command-join] to start private conversation")))
145 (setq repr (liece-channel-parse-representation
146 liece-current-chat-partner)
149 target (aref repr 2))
150 (cond ((eq method 'dcc)
151 (liece-dcc-chat-send target message))
153 (liece-send "PRIVMSG %s :%s"
154 liece-current-chat-partner message)))
155 (liece-own-private-message message))
157 (or liece-current-channel
159 (substitute-command-keys
160 "Type \\[liece-command-join] to join a channel")))
163 (liece-channel-real liece-current-channel) message)
164 (liece-own-channel-message message))))))
166 (defun liece-command-enter-message ()
167 "Enter the current line as an entry in the IRC dialogue."
170 (liece-command-send-message
171 (buffer-substring (point)(progn (end-of-line) (point))))
174 (defun liece-dialogue-enter-message ()
175 "Ask for a line as an entry in the IRC dialogue on the current channel."
178 (while (not (string-equal (setq message (read-string "> ")) ""))
179 (liece-command-send-message message))))
181 (defun liece-command-join-channel (join-channel-var key)
182 "Join a JOIN-CHANNEL-VAR with KEY."
183 (let ((nicks liece-nick-alist) nick)
187 (liece-channel-equal join-channel-var (car nick)))))
188 (setq nick (pop nicks)))
190 (setq join-channel-var
191 (or (car (get (intern (car nick) liece-obarray) 'chnl))
193 (if (liece-channel-member join-channel-var liece-current-channels)
195 (setq liece-current-channel join-channel-var)
196 (liece-switch-to-channel liece-current-channel)
197 (liece-channel-change))
198 (liece-send "JOIN %s %s" (liece-channel-real join-channel-var) key))))
200 (defun liece-command-join-partner (join-channel-var)
201 "Join a JOIN-CHANNEL-VAR."
202 (if (liece-channel-member join-channel-var liece-current-chat-partners)
204 (setq liece-current-chat-partner join-channel-var)
205 (liece-switch-to-channel liece-current-chat-partner))
206 (setq liece-current-chat-partner join-channel-var)
207 (liece-channel-join liece-current-chat-partner))
208 (liece-channel-change))
210 (defun liece-command-join (join-channel-var &optional key)
211 "Join a JOIN-CHANNEL-VAR with KEY.
212 If user nickname is given join the same set of channels as the specified user.
213 If command-buffer is in chat-mode, start private conversation
214 with specified user."
216 (let (join-channel-var key (completion-ignore-case t))
217 (setq join-channel-var
218 (if (numberp current-prefix-arg)
220 (liece-channel-virtual
221 (if (eq liece-command-buffer-mode 'chat)
222 (liece-minibuffer-completing-read
223 (_ "Start private conversation with: ")
224 liece-nick-alist nil nil nil nil liece-privmsg-partner)
225 (liece-minibuffer-completing-read
227 (append liece-channel-alist liece-nick-alist)
228 nil nil nil nil liece-default-channel-candidate)))))
229 (if (and current-prefix-arg
230 (not (numberp current-prefix-arg)))
232 (if (eq current-prefix-arg '-)
234 (format (_ "Key for channel %s: ") join-channel-var))
236 (format (_ "Key for channel %s: ") join-channel-var)))))
237 (list join-channel-var key)))
238 (let ((real-chnl (liece-channel-real join-channel-var)))
239 (if (numberp join-channel-var)
240 (liece-switch-to-channel-no join-channel-var)
241 (setq liece-default-channel-candidate nil)
242 (if (liece-channel-p real-chnl)
243 (liece-toggle-command-buffer-mode 'channel)
244 (liece-toggle-command-buffer-mode 'chat))
245 (if (eq liece-command-buffer-mode 'chat)
246 (liece-command-join-partner join-channel-var)
248 (setq key (get (intern join-channel-var liece-obarray) 'key)))
249 (put (intern join-channel-var liece-obarray) 'key key)
252 (liece-command-join-channel join-channel-var key))
253 (force-mode-line-update))))
255 (defun liece-command-part (part-channel-var &optional part-msg)
256 "Part a PART-CHANNEL-VAR with PART-MSG."
258 (let (part-channel-var
259 (completion-ignore-case t)
261 (setq part-channel-var
262 (liece-channel-virtual
263 (if (eq liece-command-buffer-mode 'chat)
264 (liece-minibuffer-completing-read
265 (_ "End private conversation with: ")
266 (list-to-alist liece-current-chat-partners)
267 nil nil nil nil liece-current-chat-partner)
268 (liece-minibuffer-completing-read
270 (list-to-alist liece-current-channels)
271 nil nil nil nil liece-current-channel))))
272 (when current-prefix-arg
273 (setq part-msg (read-string (_ "Part Message: "))))
274 (list part-channel-var part-msg)))
275 (let ((real-chnl (liece-channel-real part-channel-var)))
276 (if (liece-channel-p real-chnl)
278 (if (liece-channel-member part-channel-var liece-current-channels)
279 (setq liece-current-channel part-channel-var))
280 (liece-send "PART %s :%s" real-chnl part-msg)
281 (setq liece-default-channel-candidate part-channel-var))
282 (setq liece-current-chat-partners
283 (liece-channel-remove part-channel-var
284 liece-current-chat-partners)
285 liece-current-chat-partner
286 (car liece-current-chat-partners))
287 (liece-set-channel-indicator)
288 (liece-channel-part part-channel-var))))
290 (defun liece-command-kill (kill-nickname-var &optional timeout silent)
291 "Ignore messages from KILL-NICKNAME-VAR.
292 Username can be given as case insensitive regular expression of form
293 \".*@.*\.sub.domain\".
294 If already ignoring him/her, toggle.
295 If `liece-variables-file' is defined and the file is writable,
296 settings are updated automatically for future sessions.
297 Optional argument TIMEOUT says expiration.
298 If SILENT is non-nil, don't notify current status."
300 (let (kill-nickname-var timeout (completion-ignore-case t))
301 (setq kill-nickname-var (completing-read
302 (_ "Ignore nickname or regexp: ")
303 (append liece-nick-alist
304 liece-kill-nickname)))
305 (or (string-equal "" kill-nickname-var)
306 (string-assoc-ignore-case kill-nickname-var liece-kill-nickname)
307 (setq timeout (string-to-int (read-from-minibuffer
308 (_ "Timeout [RET for none]: ")))))
309 (list kill-nickname-var timeout)))
310 ;; empty, just list them
311 (if (string-equal "" kill-nickname-var)
312 (with-current-buffer liece-dialogue-buffer
313 (let ((ignores liece-kill-nickname) (time (current-time))
314 buffer-read-only expire expiretime)
315 (goto-char (point-max))
316 (liece-insert-info liece-D-buffer (_ "Currently ignoring:"))
317 (dolist (ignore ignores)
318 (setq expiretime (if (cdr ignore)
319 (/ (liece-time-difference time (cdr ignore))
321 expire (cond ((not expiretime) "")
323 (format (_ " (%d min)") expiretime))
326 (liece-insert liece-D-buffer
327 (concat " " (car ignore) expire "\n")))))
328 ;; else not empty, check if exists
330 (string-assoc-ignore-case
331 kill-nickname-var liece-kill-nickname)))
333 (when (setq ignore (string-assoc-ignore-case
334 (car ignore) liece-kill-nickname))
335 (setq liece-kill-nickname
336 (delq ignore liece-kill-nickname))
337 (liece-insert-info liece-D-buffer
338 (format (_ "No longer ignoring: %s.\n")
340 ;; did not find, add to ignored ones
341 (let ((expire-time (if (> timeout 0)
342 (liece-time-elapsed (current-time)
344 (and silent (> timeout 0)
345 (setcar (cdr (cdr expire-time)) -1))
346 (setq liece-kill-nickname
347 (cons (cons kill-nickname-var expire-time)
348 liece-kill-nickname))
350 (liece-insert-info liece-D-buffer
351 (format (_ "Ignoring %s") kill-nickname-var))
352 (liece-insert-info liece-D-buffer
354 (format " for %d minutes.\n" timeout)
356 (setq liece-save-variables-are-dirty t)))
358 (defun liece-command-kick (nick &optional msg)
359 "Kick this NICK out with MSG."
361 (let ((completion-ignore-case t)
362 (nicks (liece-channel-get-nicks)) nick msg)
363 (setq nick (completing-read
364 (_ "Kick out nickname: ")
365 (list-to-alist nicks)))
366 (if current-prefix-arg
367 (setq msg (concat " :" (read-string (_ "Kick Message: ")))))
369 (liece-send "KICK %s %s%s"
370 (liece-channel-real liece-current-channel)
373 (defun liece-command-ban (ban)
376 (let* ((completion-ignore-case t)
377 (nicks (liece-channel-get-nicks))
382 (concat nick "!" (liece-nick-get-user-at-host nick)))))
385 (setq ban (liece-minibuffer-completing-read
386 (_ "Ban pattern: ") uahs nil nil nil nil
387 (concat nick "!" (liece-nick-get-user-at-host nick))))
389 (liece-send "MODE %s :+b %s"
390 (liece-channel-real liece-current-channel) ban))
392 (defun liece-command-ban-kick (ban nick &optional msg)
393 "BAN kick this NICK out with MSG."
395 (let* ((completion-ignore-case t)
396 (nicks (liece-channel-get-nicks))
401 (concat nick "!" (liece-nick-get-user-at-host nick)))))
404 (setq nick (completing-read (_ "Kick out nickname: ")
405 (list-to-alist nicks))
406 ban (liece-minibuffer-completing-read
407 (_ "Ban pattern: ") uahs nil nil nil nil
408 (concat nick "!" (liece-nick-get-user-at-host nick))))
409 (if current-prefix-arg
410 (setq msg (concat " :" (read-string (_ "Kick Message: "))))
412 (list ban nick msg)))
413 (liece-send "MODE %s :+b %s"
414 (liece-channel-real liece-current-channel) ban)
415 (liece-send "KICK %s %s%s"
416 (liece-channel-real liece-current-channel)
419 (defun liece-command-list (&optional channel)
420 "List the given CHANNEL and its topics.
421 If you enter only Control-U as argument, list the current channel.
422 With - as argument, list all channels."
424 (if (or current-prefix-arg (null liece-current-channel))
425 (if (eq current-prefix-arg '-)
426 (list current-prefix-arg))
427 (let ((completion-ignore-case t) channel)
428 (setq channel (liece-minibuffer-completing-read
430 liece-channel-alist nil nil nil nil liece-current-channel))
431 (unless (string-equal "" channel)
435 (if liece-current-channel
436 (liece-send "LIST %s"
437 (liece-channel-real liece-current-channel))))
438 ((and (eq channel '-)
439 (y-or-n-p (_ "Do you really query LIST without argument?")))
441 ((not (string-equal channel ""))
442 (liece-send "LIST %s" (liece-channel-real channel))
445 (defun liece-command-modec (chnl change)
446 "Send a MODE command to this CHNL.
449 (let ((completion-ignore-case t)
450 (chnl liece-current-channel)
451 liece-minibuffer-complete-function prompt)
452 (if current-prefix-arg
454 (liece-minibuffer-completing-read
456 (append liece-channel-alist liece-nick-alist)
457 nil nil nil nil liece-current-channel)))
459 ((liece-channel-p (liece-channel-real chnl))
461 (_ "Mode for channel %s [%s]: ")
462 chnl (or (liece-channel-get-modes chnl) ""))
463 liece-minibuffer-complete-function
464 (function liece-minibuffer-complete-channel-modes)))
467 (_ "Mode for user %s [%s]: ")
468 chnl (or (liece-nick-get-modes chnl) ""))
469 liece-minibuffer-complete-function
470 (function liece-minibuffer-complete-user-modes))))
471 (list chnl (read-from-minibuffer prompt nil liece-minibuffer-map))))
472 (liece-send "MODE %s %s" (liece-channel-real chnl) change))
474 (defun liece-command-qualify-nicks (mode nicks val)
477 (liece-channel-real liece-current-channel)
478 (if val ?+ ?-) (make-string (length nicks) mode)
479 (string-join nicks " ")))
481 (defun liece-command-set-operators (nicks &optional arg)
483 (let ((opers (liece-channel-get-operators))
484 (completion-ignore-case t)
486 (if current-prefix-arg
487 (setq nicks (liece-minibuffer-completing-read-multiple
488 (_ "Divest operational privilege from: ")
489 (list-to-alist opers)))
490 (setq nicks (liece-channel-get-nicks)
491 nicks (filter-elements nick nicks
492 (not (liece-nick-member nick opers)))
493 nicks (liece-minibuffer-completing-read-multiple
494 (_ "Assign operational privilege to: ")
495 (list-to-alist nicks))))
496 (list nicks current-prefix-arg)))
501 (when (= (length run) liece-compress-mode-length)
502 (liece-command-qualify-nicks ?o run (not arg))
505 (liece-command-qualify-nicks ?o run (not arg))))))
507 (defun liece-command-set-voices (nicks &optional arg)
509 (let ((voices (liece-channel-get-voices))
510 (completion-ignore-case t)
512 (if current-prefix-arg
513 (setq nicks (liece-minibuffer-completing-read-multiple
514 (_ "Forbid to speak: ") (list-to-alist voices)))
515 (setq voices (append voices (liece-channel-get-operators))
516 nicks (liece-channel-get-nicks)
517 nicks (filter-elements nick nicks
518 (not (liece-nick-member nick voices)))
519 nicks (liece-minibuffer-completing-read-multiple
520 (_ "Allow to speak: ") (list-to-alist nicks))))
521 (list nicks current-prefix-arg)))
526 (when (= (length run) liece-compress-mode-length)
527 (liece-command-qualify-nicks ?v run (not arg))
530 (liece-command-qualify-nicks ?v run (not arg))))))
532 (defun liece-command-message (address message)
533 "Send ADDRESS a private MESSAGE."
535 (let ((completion-ignore-case t) address)
537 (liece-channel-virtual
538 (liece-minibuffer-completing-read
539 (_ "Private message to: ")
540 (append liece-nick-alist liece-channel-alist)
541 nil nil nil nil liece-privmsg-partner)))
545 (_ "Private message to %s: ")
547 (if (funcall liece-message-empty-predicate message)
548 (progn (liece-message (_ "No text to send")) nil)
549 (let ((chnl (liece-channel-real address)))
550 (liece-send "PRIVMSG %s :%s" chnl message)
551 (if (liece-channel-p chnl)
552 (liece-own-channel-message message
553 (liece-channel-virtual address))
554 (liece-own-private-message message address)))))
556 (defun liece-command-mta-private (partner)
557 "Send a private message (current line) to PARTNER."
559 (let ((completion-ignore-case t))
560 (setq liece-privmsg-partner
561 (liece-channel-virtual
562 (liece-minibuffer-completing-read
564 (append liece-nick-alist liece-channel-alist)
565 nil nil nil nil liece-privmsg-partner)))
566 (list liece-privmsg-partner)))
567 (let ((message (buffer-substring (progn (beginning-of-line) (point))
568 (progn (end-of-line) (point)))))
569 (if (> (length message) 0)
571 (liece-command-message liece-privmsg-partner message)
573 (liece-message (_ "No text to send")))))
575 (defun liece-command-names (&optional expr)
576 "List the nicknames of the current IRC users on given EXPR.
577 With an Control-U as argument, only the current channel is listed.
578 With - as argument, list all channels."
580 (if (or current-prefix-arg (null liece-current-channel))
581 (if (eq current-prefix-arg '-)
582 (list current-prefix-arg))
583 (let ((completion-ignore-case t) expr)
584 (setq expr (liece-minibuffer-completing-read
585 (_ "Names on channel: ")
586 liece-channel-alist nil nil nil nil liece-current-channel))
587 (unless (string-equal "" expr)
589 (when (or (and (eq expr '-)
591 (_ "Do you really query NAMES without argument?")))
593 (if liece-current-channel
594 (setq expr (liece-channel-real
595 liece-current-channel))))))
598 (liece-send "NAMES %s" expr)))
600 (defun liece-command-nickname (nick)
601 "Set your nickname to NICK."
602 (interactive "sEnter your nickname: ")
603 (let ((nickname (truncate-string nick liece-nick-max-length)))
604 (if (zerop (length nickname))
605 (liece-message (_ "illegal nickname \"%s\"; not changed") nickname)
606 (liece-send "NICK %s" nick))))
608 (defun liece-command-who (&optional expr)
609 "Lists tue users that match the given expression EXPR.
610 If you enter only Control-U as argument, list the current channel.
611 With - as argument, list all users."
613 (if (or current-prefix-arg (null liece-current-channel))
614 (if (eq current-prefix-arg '-)
615 (list current-prefix-arg))
616 (let ((completion-ignore-case t) expr)
617 (setq expr (completing-read
618 (_ "WHO expression: ")
619 (append liece-channel-alist liece-nick-alist)))
620 (unless (string-equal "" expr)
622 (when (or (and (eq expr '-)
624 (_ "Do you really query WHO without argument?")))
626 (if liece-current-channel
627 (setq expr (liece-channel-real
628 liece-current-channel))))))
631 (liece-send "WHO %s" expr)
632 (setq liece-who-expression expr)))
634 (defun liece-command-finger (finger-nick-var &optional server)
635 "Get information about a specific user FINGER-NICK-VAR.
636 If called with optional argument SERVER or any prefix argument,
637 query information to the foreign server."
639 (let (finger-nick-var (completion-ignore-case t))
640 (setq finger-nick-var
641 (completing-read (_ "Finger whom: ") liece-nick-alist))
642 (list finger-nick-var (and current-prefix-arg finger-nick-var))))
644 (liece-send "WHOIS %s %s" server finger-nick-var)
645 (liece-send "WHOIS %s" finger-nick-var)))
647 (defun liece-command-topic (topic)
648 "Change TOPIC of the current channel."
650 (list (read-from-minibuffer
651 "Topic: " (cons (or (liece-channel-get-topic) "") 0))))
652 (liece-send "TOPIC %s :%s"
653 (liece-channel-real liece-current-channel) topic))
655 (defun liece-command-invite (&optional invite-nick-var invite-channel-var)
656 "Invite INVITE-NICK-VAR to INVITE-CHANNEL-VAR."
658 (let ((completion-ignore-case t) invite-channel-var invite-nick-var)
659 (if current-prefix-arg
660 (setq invite-channel-var
661 (liece-channel-virtual
663 (_ "Invite channel: ")
664 (list-to-alist liece-current-channels)))))
665 (setq invite-nick-var
669 (list invite-nick-var invite-channel-var)))
670 (or invite-channel-var
671 (setq invite-channel-var liece-current-channel))
672 (liece-send "INVITE %s %s"
673 invite-nick-var (liece-channel-real invite-channel-var)))
675 (defun liece-command-away (awaymsg)
676 "Mark/unmark yourself as being away.
677 Leave message AWAYMSG."
678 (interactive "sAway message: ")
679 (liece-send "AWAY :%s" awaymsg)
680 (setq liece-away-message awaymsg))
682 (defun liece-command-scroll-down (lines)
683 "Scroll LINES down dialogue buffer from command buffer."
685 (let ((other-window-scroll-buffer
686 (if liece-channel-buffer-mode
688 liece-dialogue-buffer)))
689 (when (liece-get-buffer-window other-window-scroll-buffer)
691 (scroll-other-window-down lines)
693 (message "Beginning of buffer"))))))
695 (defun liece-command-scroll-up (lines)
696 "Scroll LINES up dialogue buffer from command buffer."
698 (let* ((other-window-scroll-buffer
699 (if liece-channel-buffer-mode
701 liece-dialogue-buffer)))
702 (when (liece-get-buffer-window other-window-scroll-buffer)
704 (scroll-other-window lines)
706 (message "End of buffer"))))))
708 (defun liece-command-nick-scroll-down (lines)
709 "Scroll LINES down nick buffer from command buffer."
711 (let ((other-window-scroll-buffer liece-nick-buffer))
712 (when (liece-get-buffer-window other-window-scroll-buffer)
714 (scroll-other-window-down lines)
716 (message "Beginning of buffer"))))))
718 (defun liece-command-nick-scroll-up (lines)
719 "Scroll LINES up nick buffer from command buffer."
721 (let* ((other-window-scroll-buffer liece-nick-buffer))
722 (when (liece-get-buffer-window other-window-scroll-buffer)
724 (scroll-other-window lines)
726 (message "End of buffer"))))))
728 (defun liece-command-freeze (&optional arg)
729 "Prevent automatic scrolling of the dialogue window.
730 If prefix argument ARG is non-nil, toggle frozen status."
732 (liece-freeze (if liece-channel-buffer-mode
734 liece-dialogue-buffer)
735 (if arg (prefix-numeric-value arg))))
737 (defun liece-command-own-freeze (&optional arg)
738 "Prevent automatic scrolling of the dialogue window.
739 The difference from `liece-command-freeze' is that your messages are hidden.
740 If prefix argument ARG is non-nil, toggle frozen status."
742 (liece-own-freeze (if liece-channel-buffer-mode
744 liece-dialogue-buffer)
745 (if arg (prefix-numeric-value arg))))
747 (defun liece-command-beep (&optional arg)
748 "Toggle the automatic beep notice when the channel message is received."
750 (liece-set-beep (if liece-channel-buffer-mode
752 liece-dialogue-buffer)
753 (if arg (prefix-numeric-value arg))))
755 (defun liece-command-quit (&optional arg)
757 If prefix argument ARG is non-nil, leave signoff message."
759 (when (and (liece-server-opened)
760 (y-or-n-p (_ "Quit IRC? ")))
763 (if arg (read-string (_ "Signoff message: "))
764 (or liece-signoff-message
765 (product-name (product-find 'liece-version))))))
766 (liece-close-server quit-string))))
768 (defun liece-command-generic (message)
769 "Enter a generic IRC MESSAGE, which is sent to the server.
770 A ? lists the useful generic messages."
771 (interactive "sIRC command (? to help): ")
772 (if (string-equal message "?")
773 (with-output-to-temp-buffer "*IRC Help*"
774 (princ "The following generic IRC messages may be of interest to you:
775 TOPIC <new topic> set the topic of your channel
776 INVITE <nickname> invite another user to join your channel
777 LINKS lists the currently reachable IRC servers
778 SUMMON <user@host> invites an user not currently in IRC
779 USERS <host> lists the users on a host
780 AWAY <reason> marks you as not really actively using IRC
781 (an empty reason clears it)
782 WALL <message> send to everyone on IRC
783 NAMES <channel> lists users per channel
785 (liece-send "%s" message)))
787 (defun liece-command-irc-compatible ()
788 "If entered at column 0, allow you to enter a generic IRC message."
790 (if (zerop (current-column))
791 (call-interactively (function liece-command-generic))
792 (self-insert-command 1)))
794 (defun liece-command-yank-send (&optional arg)
795 "Send message from yank buffer.
796 Prefix argument ARG is regarded as distance from yank pointer."
798 (when (y-or-n-p (_ "Really SEND from Yank Buffer?"))
800 (narrow-to-region (point) (point))
801 (insert (car kill-ring-yank-pointer))
802 (goto-char (point-min))
804 (liece-command-enter-message)
805 (set-buffer liece-command-buffer)))))
807 (defun liece-command-complete ()
808 "Complete word before point from userlist."
810 (let ((completion-ignore-case t)
811 (alist (if liece-current-channel
812 (list-to-alist (liece-channel-get-nicks))
814 candidate completion all)
815 (setq candidate (current-word)
816 completion (try-completion candidate alist)
817 all (all-completions candidate alist))
818 (liece-minibuffer-finalize-completion completion candidate all)))
820 (defun liece-command-load-vars ()
821 "Load configuration from liece-variables-file."
823 (let ((nick liece-real-nickname))
825 (liece-read-variables-files)
826 (setq liece-real-nickname nick)
827 (liece-command-reconfigure-windows))))
829 (defun liece-command-save-vars ()
830 "Save current settings to `liece-variables-file'."
832 (let* ((output-buffer
834 (expand-file-name liece-variables-file)))
837 (set-buffer output-buffer)
838 (goto-char (point-min))
839 (cond ((re-search-forward "^;; Saved Settings *\n" nil 'move)
840 (setq p (match-beginning 0))
842 (or (re-search-forward
843 "^;; End of Saved Settings *\\(\n\\|\\'\\)" nil t)
845 (concat "can't find END of saved state in "
846 liece-variables-file)))
847 (delete-region p (match-end 0)))
849 (goto-char (point-max))
851 (setq output-marker (point-marker))
852 (let ((print-readably t)
853 (print-escape-newlines t)
854 (standard-output output-marker))
855 (princ ";; Saved Settings\n")
856 (dolist (var liece-saved-forms)
858 (prin1 (list 'setq var
859 (let ((val (symbol-value var)))
860 (if (memq val '(t nil))
862 (list 'quote val)))))
863 (setq var (eval var))
864 (cond ((eq (car-safe var) 'progn)
865 (while (setq var (cdr var))
868 (if (cdr var) (princ " "))))
870 (prin1 "xx")(prin1 var))))
871 (if var (princ "\n")))
873 (princ ";; End of Saved Settings\n")))
874 (set-marker output-marker nil)
876 (set-buffer output-buffer)
878 (setq liece-save-variables-are-dirty nil))
880 (defun liece-command-reconfigure-windows ()
881 "Rearrange window splitting."
883 (let ((command-window (liece-get-buffer-window liece-command-buffer))
884 (dialogue-window (liece-get-buffer-window liece-dialogue-buffer))
885 (obuffer (current-buffer)))
886 (if (and command-window dialogue-window)
887 (let ((ch (window-height command-window))
888 (dh (window-height dialogue-window)))
889 (delete-window command-window)
890 (pop-to-buffer liece-dialogue-buffer)
891 (enlarge-window (+ ch dh (- dh))))
892 (pop-to-buffer liece-dialogue-buffer))
893 (liece-configure-windows)
894 (if liece-one-buffer-mode
895 (pop-to-buffer liece-dialogue-buffer)
896 (pop-to-buffer obuffer))))
898 (defun liece-command-end-of-buffer ()
899 "Get end of the dialogue buffer."
902 (setq buffer (if liece-channel-buffer-mode
904 liece-dialogue-buffer))
905 (or (setq window (liece-get-buffer-window buffer))
906 (setq window (liece-get-buffer-window liece-dialogue-buffer)
907 buffer liece-dialogue-buffer))
909 (save-selected-window
910 (select-window window)
911 (goto-char (point-max))))))
913 (defun liece-command-private-conversation (arg)
914 "Toggle between private conversation mode and channel mode.
915 User can then join and part to a private conversation as he would
916 join or part to a channel.
918 If there are no private conversations or argument is given user is
919 prompted the partner/channel (return as partner/channel means toggle
920 mode, the current channel and current chat partner are not altered)
921 Argument ARG is prefix argument of toggle status."
923 (let ((completion-ignore-case t))
925 (if current-prefix-arg
926 ;; prefixed, ask where to continue
927 (if (eq liece-command-buffer-mode 'chat)
928 (liece-minibuffer-completing-read
929 (_ "Return to channel: ")
930 (append liece-channel-alist liece-nick-alist)
931 nil nil nil nil liece-current-channel)
933 (_ "Start private conversation with: ")
934 liece-nick-alist nil nil))
935 ;; no prefix, see if going to chat
936 (if (eq liece-command-buffer-mode 'channel)
937 ;; and if we have chat partner, select that
938 (if liece-current-chat-partner
939 liece-current-chat-partner
941 (_ "Start private conversation with: ")
942 liece-nick-alist )))))))
944 (liece-toggle-command-buffer-mode)
945 (if (and arg (not (string-equal arg "")))
946 (liece-command-join arg))
947 (liece-set-channel-indicator)
949 (force-mode-line-update))
951 (defun liece-command-next-channel ()
952 "Select next channel or chat partner, and *DONT* rotate list."
954 (let ((rest (copy-sequence
955 (if (eq liece-command-buffer-mode 'chat)
956 liece-current-chat-partners
957 liece-current-channels)))
958 (chnl (if (eq liece-command-buffer-mode 'chat)
959 liece-current-chat-partner
960 liece-current-channel)))
961 (liece-switch-to-channel
962 (or (cadr (liece-channel-member chnl (delq nil rest)))
963 (car (delq nil rest))
966 (defun liece-command-previous-channel ()
967 "Select previous channel or chat partner, and *DONT* rotate list."
971 (if (eq liece-command-buffer-mode 'chat)
972 liece-current-chat-partners
973 liece-current-channels)))
975 (if (eq liece-command-buffer-mode 'chat)
976 liece-current-chat-partner
977 liece-current-channel)))
978 (liece-switch-to-channel
979 (or (cadr (liece-channel-member chnl (delq nil rest)))
980 (car (delq nil rest))
983 (defun liece-command-unread-channel ()
984 "Select unread channel or chat partner."
986 (let ((chnl (car liece-channel-unread-list)))
988 (liece-switch-to-channel chnl)
989 (liece-message (_ "No unread channel or chat partner.")))))
991 (defun liece-command-push ()
992 "Select next channel or chat partner, and rotate list."
995 (if (eq liece-command-buffer-mode 'chat)
996 liece-current-chat-partners
997 liece-current-channels))
998 (temp (car (last rest)))
1002 (setcar (nthcdr (1- len) rest) (nth (- len 2) rest))
1005 (setcar rest temp)))
1006 (liece-channel-change)))
1008 (defun liece-command-pop ()
1009 "Select previous channel or chat partner, and rotate list."
1012 (if (eq liece-command-buffer-mode 'chat)
1013 liece-current-chat-partners
1014 liece-current-channels))
1016 (len (length rest)))
1019 (setcar (nthcdr i rest) (nth (1+ i) rest)))
1021 (setcar (last rest) temp)))
1022 (liece-channel-change)))
1024 (defvar liece-redisplay-buffer-functions
1025 '(liece-channel-redisplay-buffer
1026 liece-nick-redisplay-buffer
1027 liece-channel-list-redisplay-buffer))
1029 (defun liece-switch-to-channel (chnl)
1030 "Switch the current channel to CHNL."
1031 (if (liece-channel-p (liece-channel-real chnl))
1033 (liece-toggle-command-buffer-mode 'channel)
1034 (setq liece-current-channel chnl)
1035 (liece-set-channel-indicator))
1036 (liece-toggle-command-buffer-mode 'chat)
1037 (setq liece-current-chat-partner chnl)
1038 (liece-set-channel-indicator))
1040 (run-hook-with-args 'liece-redisplay-buffer-functions chnl)))
1042 (defun liece-switch-to-channel-no (num)
1043 "Switch the current channel to NUM."
1044 (let* ((mode liece-command-buffer-mode)
1045 (chnls (if (eq mode 'chat)
1046 liece-current-chat-partners
1047 liece-current-channels)))
1048 (if (and (integerp num)
1049 (stringp (nth num chnls)))
1050 (let ((chnl (nth num chnls)))
1053 (liece-toggle-command-buffer-mode 'chat)
1054 (setq liece-current-chat-partner chnl)
1055 (liece-set-channel-indicator))
1056 (liece-toggle-command-buffer-mode 'channel)
1057 (setq liece-current-channel chnl)
1058 (liece-set-channel-indicator))
1060 (run-hook-with-args 'liece-redisplay-buffer-functions chnl)))
1061 (message "Invalid channel!"))))
1063 (defun liece-command-ping ()
1064 "Send PING to server."
1066 (if (stringp liece-server-name)
1067 (liece-send "PING %s" liece-server-name)))
1069 (defun liece-command-ison (nicks)
1072 (let (nicks (completion-ignore-case t))
1073 (setq nicks (liece-minibuffer-completing-read-multiple
1074 "IsON" liece-nick-alist))
1076 (liece-send "ISON :%s" (mapconcat #'identity nicks " ")))
1078 (defun liece-command-activate-friends (nicks)
1079 "Register NICKS to the frinends list."
1081 (let (nicks (completion-ignore-case t))
1083 (liece-minibuffer-completing-read-multiple
1085 (filter-elements nick liece-nick-alist
1086 (not (string-list-member-ignore-case
1087 (car nick) liece-friends)))))
1089 (setq liece-friends (append nicks liece-friends)))
1091 (defun liece-command-deactivate-friends ()
1092 "Clear current friends list."
1094 (setq liece-friends nil))
1096 (defun liece-command-display-friends ()
1097 "Display status of the friends."
1099 (with-output-to-temp-buffer " *IRC Friends*"
1100 (set-buffer standard-output)
1101 (insert "Friends status: \n\n")
1102 (dolist (friend liece-friends)
1103 (if (string-list-member-ignore-case friend liece-friends-last)
1104 (insert "+ " friend "\n")
1105 (insert "- " friend "\n")))))
1107 (defun liece-command-show-last-kill ()
1108 "Dig last kill from KILL and show it."
1111 (append liece-D-buffer liece-O-buffer)
1113 (set-buffer liece-KILLS-buffer)
1114 (goto-char (point-max))
1116 (concat (buffer-substring (point) (point-max)) "\n"))))
1118 (defun liece-command-toggle-private ()
1119 "Toggle private mode / channel mode."
1121 (case (prog1 liece-command-buffer-mode
1122 (liece-toggle-command-buffer-mode))
1124 (if liece-current-channel
1125 (liece-switch-to-channel liece-current-channel))
1126 (setq liece-command-buffer-mode-indicator "Channels"))
1128 (if liece-current-chat-partner
1129 (liece-switch-to-channel liece-current-chat-partner))
1130 (setq liece-command-buffer-mode-indicator "Partners")))
1131 (liece-channel-change))
1133 (defun liece-command-tag-region (start end)
1134 "Move current region between START and END to `kill-ring'."
1136 (if (region-active-p)
1137 (list (region-beginning)(region-end))
1138 (list (line-beginning-position)(line-end-position))))
1139 (static-if (fboundp 'extent-property)
1140 (kill-ring-save start end)
1141 (let ((start (set-marker (make-marker) start))
1142 (end (set-marker (make-marker) end))
1143 (inhibit-read-only t)
1146 (liece-remove-properties-region start end)
1147 (kill-ring-save start end)
1148 (push nil buffer-undo-list)
1151 (provide 'liece-commands)
1153 ;;; liece-commands.el ends here