lisp/liece-commands.el

   1 ;;; liece-commands.el --- Interactive commands in command buffer.
   2 ;; Copyright (C) 1998-2000 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1998-09-28
   6 ;; Revised: 1999-12-24
   7 ;; Keywords: IRC, liece
   8
   9 ;; This file is part of Liece.
  10
  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)
  14 ;; any later version.
  15
  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.
  20
  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.
  25
  26
  27 ;;; Commentary:
  28 ;;
  29
  30 ;;; Code:
  31
  32 (eval-when-compile
  33    (require 'liece-misc))
  34
  35 (require 'liece-channel)
  36 (require 'liece-nick)
  37 (require 'liece-coding)
  38 (require 'liece-intl)
  39 (require 'liece-minibuf)
  40
  41 (autoload 'liece-dcc-chat-send "liece-dcc")
  42
  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)
  51
  52 (defun liece-command-poll-names ()
  53   "Handler for polling NAMES."
  54   (when (liece-server-opened)
  55     (setq liece-polling
  56           (+ liece-polling
  57              (length liece-channel-alist)))
  58     (dolist (chnl liece-channel-alist)
  59       (liece-send "NAMES %s" (car chnl)))))
  60
  61 (defun liece-command-poll-friends ()
  62   "Handler for polling ISON."
  63   (and liece-friends
  64        (liece-server-opened)
  65        (liece-send "ISON %s" (mapconcat 'identity liece-friends " "))))
  66
  67 (defun liece-command-find-timestamp ()
  68   "Find recent timestamp in dialogue buffer."
  69   (interactive)
  70   (save-excursion
  71     (let ((range "")
  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)
  79                                                 (line-end-position))
  80                               "   ---   ")))
  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))))
  85
  86 (defun liece-command-keepalive ()
  87   "Handler for polling server connection."
  88   (if (not (liece-server-opened))
  89       (liece)
  90     (liece-ping-if-idle)))
  91
  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.")
  94
  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."
  99   (interactive)
 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
 106                                             (current-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)))
 112
 113 (defun liece-command-timestamp ()
 114   "Insert timestamp into dialogue buffer."
 115   (interactive)
 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))))
 121
 122 (defun liece-command-point-back-to-command-buffer ()
 123   "Set point back to command buffer."
 124   (interactive)
 125   (let ((win (liece-get-buffer-window liece-command-buffer)))
 126     (if win (select-window win))))
 127
 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)
 136       (cond
 137        ((eq liece-command-buffer-mode 'chat)
 138         (or liece-current-chat-partner
 139             (error
 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)
 144               method (aref repr 0)
 145               name (aref repr 1)
 146               target (aref repr 2))
 147         (cond ((eq method 'dcc)
 148                (liece-dcc-chat-send target message))
 149               ((eq method 'irc)
 150                (liece-send "PRIVMSG %s :%s"
 151                            liece-current-chat-partner message)))
 152         (liece-own-private-message message))
 153        (t
 154         (or liece-current-channel
 155             (error
 156              (substitute-command-keys
 157               "Type \\[liece-command-join] to join a channel")))
 158         (liece-send
 159          "PRIVMSG %s :%s"
 160          (liece-channel-real liece-current-channel) message)
 161         (liece-own-channel-message message))))))
 162
 163 (defun liece-command-enter-message ()
 164   "Enter the current line as an entry in the IRC dialogue."
 165   (interactive)
 166   (beginning-of-line)
 167   (liece-command-send-message
 168    (buffer-substring (point)(progn (end-of-line) (point))))
 169   (liece-next-line 1))
 170
 171 (defun liece-dialogue-enter-message ()
 172   "Ask for a line as an entry in the IRC dialogue on the current channel."
 173   (interactive)
 174   (let (message)
 175     (while (not (string-equal (setq message (read-string "> ")) ""))
 176       (liece-command-send-message message))))
 177
 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)
 181     (while (and nicks
 182                 (not (and
 183                       (car nick)
 184                       (liece-channel-equal join-channel-var (car nick)))))
 185       (setq nick (pop nicks)))
 186     (when nicks
 187       (setq join-channel-var
 188             (or (car (get (intern (car nick) liece-obarray) 'chnl))
 189                 join-channel-var)))
 190     (if (liece-channel-member join-channel-var liece-current-channels)
 191         (progn
 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))))
 196
 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)
 200       (progn
 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))
 206
 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."
 212   (interactive
 213    (let (join-channel-var key (completion-ignore-case t))
 214      (setq join-channel-var
 215            (if (numberp current-prefix-arg)
 216                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
 223                  (_ "Join channel: ")
 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)))
 228          (setq key
 229                (if (eq current-prefix-arg '-)
 230                    (read-string
 231                     (format (_ "Key for channel %s: ") join-channel-var))
 232                  (let ((passwd-echo ?*))
 233                    (read-passwd
 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)
 245         (if (null key)
 246             (setq key (get (intern join-channel-var liece-obarray) 'key)))
 247         (put (intern join-channel-var liece-obarray) 'key key)
 248         (if (null key)
 249             (setq key ""))
 250         (liece-command-join-channel join-channel-var key))
 251       (force-mode-line-update))))
 252
 253 (defun liece-command-part (part-channel-var &optional part-msg)
 254   "Part a PART-CHANNEL-VAR with PART-MSG."
 255   (interactive
 256    (let (part-channel-var
 257          (completion-ignore-case t)
 258          (part-msg "bye..."))
 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
 267                (_ "Part channel: ")
 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)
 275         (progn
 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))))
 287
 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."
 297   (interactive
 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))
 318                                     60))
 319                   expire (cond ((not expiretime) "")
 320                                ((>= expiretime 0)
 321                                 (format (_ " (%d min)") expiretime))
 322                                ((< expiretime 0)
 323                                 (_ " expired"))))
 324             (liece-insert liece-D-buffer
 325                            (concat " " (car ignore) expire "\n")))))
 326     ;; else not empty, check if exists
 327     (let ((ignore
 328            (string-assoc-ignore-case
 329             kill-nickname-var liece-kill-nickname)))
 330       (if ignore
 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")
 337                                        (car ignore))))
 338         ;; did not find, add to ignored ones
 339         (let ((expire-time (if (> timeout 0)
 340                                (liece-time-add (current-time)
 341                                                 (* timeout 60)))))
 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))
 347           (unless silent
 348             (liece-insert-info liece-D-buffer
 349                                 (format (_ "Ignoring %s") kill-nickname-var))
 350             (liece-insert-info liece-D-buffer
 351                                 (if (> timeout 0)
 352                                     (format " for %d minutes.\n" timeout)
 353                                   (format ".\n")))))))
 354     (setq liece-save-variables-are-dirty t)))
 355
 356 (defun liece-command-kick (nick &optional msg)
 357   "Kick this NICK out with MSG."
 358   (interactive
 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: ")))))
 366      (list nick msg)))
 367   (liece-send "KICK %s %s%s"
 368                (liece-channel-real liece-current-channel)
 369                nick (or msg "")))
 370
 371 (defun liece-command-ban (ban)
 372   "BAN this user out."
 373   (interactive
 374    (let* ((completion-ignore-case t)
 375           (nicks (liece-channel-get-nicks))
 376           (uahs (mapcar
 377                  (function
 378                   (lambda (nick)
 379                     (list
 380                      (concat nick "!" (liece-nick-get-user-at-host nick)))))
 381                  nicks))
 382           ban nick msg)
 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))))
 386      (list ban)))
 387   (liece-send "MODE %s :+b %s"
 388                (liece-channel-real liece-current-channel) ban))
 389
 390 (defun liece-command-ban-kick (ban nick &optional msg)
 391   "BAN kick this NICK out with MSG."
 392   (interactive
 393    (let* ((completion-ignore-case t)
 394           (nicks (liece-channel-get-nicks))
 395           (uahs (mapcar
 396                  (function
 397                   (lambda (nick)
 398                     (list
 399                      (concat nick "!" (liece-nick-get-user-at-host nick)))))
 400                  nicks))
 401           ban nick msg)
 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: "))))
 409        (setq msg ""))
 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)
 415                nick (or msg "")))
 416
 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."
 421   (interactive
 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
 427                       (_ "LIST channel: ")
 428                       liece-channel-alist nil nil nil nil liece-current-channel))
 429        (unless (string-equal "" channel)
 430          (list channel)))))
 431
 432   (cond ((not 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?")))
 438          (liece-send "LIST"))
 439         ((not (string-equal channel ""))
 440          (liece-send "LIST %s" (liece-channel-real channel))
 441          )))
 442
 443 (defun liece-command-modec (chnl change)
 444   "Send a MODE command to this CHNL.
 445 Argument CHANGE ."
 446   (interactive
 447    (let ((completion-ignore-case t)
 448          (chnl liece-current-channel)
 449          liece-minibuffer-complete-function prompt)
 450      (if current-prefix-arg
 451          (setq chnl
 452                (liece-minibuffer-completing-read
 453                 (_ "Channel/User: ")
 454                 (append liece-channel-alist liece-nick-alist)
 455                 nil nil nil nil liece-current-channel)))
 456      (cond
 457       ((liece-channel-p (liece-channel-real chnl))
 458        (setq prompt (format
 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)))
 463       (t
 464        (setq prompt (format
 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))
 471
 472 (defun liece-command-qualify-nicks (mode nicks val)
 473   (liece-send
 474    "MODE %s %c%s %s"
 475    (liece-channel-real liece-current-channel)
 476    (if val ?+ ?-) (make-string (length nicks) mode)
 477    (string-join nicks " ")))
 478
 479 (defun liece-command-set-operators (nicks &optional arg)
 480   (interactive
 481    (let ((opers (liece-channel-get-operators))
 482          (completion-ignore-case t)
 483          nicks)
 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)))
 495   (let (run)
 496     (unwind-protect
 497         (dolist (nick nicks)
 498           (push nick run)
 499           (when (= (length run) liece-compress-mode-length)
 500             (liece-command-qualify-nicks ?o run (not arg))
 501             (setq run nil)))
 502       (when run
 503         (liece-command-qualify-nicks ?o run (not arg))))))
 504
 505 (defun liece-command-set-voices (nicks &optional arg)
 506   (interactive
 507    (let ((voices (liece-channel-get-voices))
 508          (completion-ignore-case t)
 509          nicks)
 510      (if current-prefix-arg
 511          (setq nicks (liece-minibuffer-completing-read-multiple
 512                       (_ "Forbid to speak: ") (list-to-alist voices)))
 513        (setq voices (append voices (liece-channel-get-operators))
 514              nicks (liece-channel-get-nicks)
 515              nicks (filter-elements nick nicks
 516                      (not (liece-nick-member nick voices)))
 517              nicks (liece-minibuffer-completing-read-multiple
 518                     (_ "Allow to speak: ") (list-to-alist nicks))))
 519      (list nicks current-prefix-arg)))
 520   (let (run)
 521     (unwind-protect
 522         (dolist (nick nicks)
 523           (push nick run)
 524           (when (= (length run) liece-compress-mode-length)
 525             (liece-command-qualify-nicks ?v run (not arg))
 526             (setq run nil)))
 527       (when run
 528         (liece-command-qualify-nicks ?v run (not arg))))))
 529
 530 (defun liece-command-message (address message)
 531   "Send ADDRESS a private MESSAGE."
 532   (interactive
 533    (let ((completion-ignore-case t) address)
 534      (setq address
 535            (liece-channel-virtual
 536             (liece-minibuffer-completing-read
 537              (_ "Private message to: ")
 538              (append liece-nick-alist liece-channel-alist)
 539              nil nil nil nil liece-privmsg-partner)))
 540      (list address
 541            (read-string
 542             (format
 543              (_ "Private message to %s: ")
 544              address)))))
 545   (if (funcall liece-message-empty-predicate message)
 546       (progn (liece-message (_ "No text to send")) nil)
 547     (let ((chnl (liece-channel-real address)))
 548       (liece-send "PRIVMSG %s :%s" chnl message)
 549       (if (liece-channel-p chnl)
 550           (liece-own-channel-message message
 551                                      (liece-channel-virtual address))
 552         (liece-own-private-message message address)))))
 553
 554 (defun liece-command-mta-private (partner)
 555   "Send a private message (current line) to PARTNER."
 556   (interactive
 557    (let ((completion-ignore-case t))
 558      (setq liece-privmsg-partner
 559            (liece-channel-virtual
 560             (liece-minibuffer-completing-read
 561              (_ "To whom: ")
 562              (append liece-nick-alist liece-channel-alist)
 563              nil nil nil nil liece-privmsg-partner)))
 564      (list liece-privmsg-partner)))
 565   (let ((message (buffer-substring (progn (beginning-of-line) (point))
 566                                    (progn (end-of-line) (point)))))
 567     (if (> (length message) 0)
 568         (progn
 569           (liece-command-message liece-privmsg-partner message)
 570           (liece-next-line 1))
 571       (liece-message (_ "No text to send")))))
 572
 573 (defun liece-command-names (&optional expr)
 574   "List the nicknames of the current IRC users on given EXPR.
 575 With an Control-U as argument, only the current channel is listed.
 576 With - as argument, list all channels."
 577   (interactive
 578    (if (or current-prefix-arg (null liece-current-channel))
 579        (if (eq current-prefix-arg '-)
 580            (list current-prefix-arg))
 581      (let ((completion-ignore-case t) expr)
 582        (setq expr (liece-minibuffer-completing-read
 583                       (_ "Names on channel: ")
 584                       liece-channel-alist nil nil nil nil liece-current-channel))
 585        (unless (string-equal "" expr)
 586          (list expr)))))
 587   (when (or (and (eq expr '-)
 588                  (y-or-n-p
 589                   (_ "Do you really query NAMES without argument?")))
 590             (not (or expr
 591                      (if liece-current-channel
 592                          (setq expr (liece-channel-real
 593                                      liece-current-channel))))))
 594     (setq expr ""))
 595   (when expr
 596     (liece-send "NAMES %s" expr)))
 597
 598 (defun liece-command-nickname (nick)
 599   "Set your nickname to NICK."
 600   (interactive "sEnter your nickname: ")
 601   (let ((nickname (truncate-string nick liece-nick-max-length)))
 602     (if (zerop (length nickname))
 603         (liece-message (_ "illegal nickname \"%s\"; not changed") nickname)
 604       (liece-send "NICK %s" nick))))
 605
 606 (defun liece-command-who (&optional expr)
 607   "Lists tue users that match the given expression EXPR.
 608 If you enter only Control-U as argument, list the current channel.
 609 With - as argument, list all users."
 610   (interactive
 611    (if (or current-prefix-arg (null liece-current-channel))
 612        (if (eq current-prefix-arg '-)
 613            (list current-prefix-arg))
 614      (let ((completion-ignore-case t) expr)
 615        (setq expr (completing-read
 616                    (_ "WHO expression: ")
 617                    (append liece-channel-alist liece-nick-alist)))
 618        (unless (string-equal "" expr)
 619          (list expr)))))
 620   (when (or (and (eq expr '-)
 621                  (y-or-n-p
 622                   (_ "Do you really query WHO without argument?")))
 623             (not (or expr
 624                      (if liece-current-channel
 625                          (setq expr (liece-channel-real
 626                                      liece-current-channel))))))
 627     (setq expr ""))
 628   (when expr
 629     (liece-send "WHO %s" expr)
 630     (setq liece-who-expression expr)))
 631
 632 (defun liece-command-finger (finger-nick-var &optional server)
 633   "Get information about a specific user FINGER-NICK-VAR.
 634 If called with optional argument SERVER or any prefix argument,
 635 query information to the foreign server."
 636   (interactive
 637    (let (finger-nick-var (completion-ignore-case t))
 638      (setq finger-nick-var
 639            (completing-read (_ "Finger whom: ") liece-nick-alist))
 640      (list finger-nick-var (and current-prefix-arg finger-nick-var))))
 641   (if server
 642       (liece-send "WHOIS %s %s" server finger-nick-var)
 643     (liece-send "WHOIS %s" finger-nick-var)))
 644
 645 (defun liece-command-topic (topic)
 646   "Change TOPIC of the current channel."
 647   (interactive
 648    (list (read-from-minibuffer
 649           "Topic: " (cons (or (liece-channel-get-topic) "") 0))))
 650   (liece-send "TOPIC %s :%s"
 651               (liece-channel-real liece-current-channel) topic))
 652
 653 (defun liece-command-invite (&optional invite-nick-var invite-channel-var)
 654   "Invite INVITE-NICK-VAR to INVITE-CHANNEL-VAR."
 655   (interactive
 656    (let ((completion-ignore-case t) invite-channel-var invite-nick-var)
 657      (if current-prefix-arg
 658          (setq invite-channel-var
 659                (liece-channel-virtual
 660                 (completing-read
 661                  (_ "Invite channel: ")
 662                  (list-to-alist liece-current-channels)))))
 663      (setq invite-nick-var
 664            (completing-read
 665             (_ "Invite whom: ")
 666             liece-nick-alist))
 667      (list invite-nick-var invite-channel-var)))
 668   (or invite-channel-var
 669       (setq invite-channel-var liece-current-channel))
 670   (liece-send "INVITE %s %s"
 671                invite-nick-var (liece-channel-real invite-channel-var)))
 672
 673 (defun liece-command-away (awaymsg)
 674   "Mark/unmark yourself as being away.
 675 Leave message AWAYMSG."
 676   (interactive "sAway message: ")
 677   (liece-send "AWAY :%s" awaymsg)
 678   (setq liece-away-message awaymsg))
 679
 680 (defun liece-command-scroll-down (lines)
 681   "Scroll LINES down dialogue buffer from command buffer."
 682   (interactive "P")
 683   (let ((other-window-scroll-buffer
 684          (if liece-channel-buffer-mode
 685              liece-channel-buffer
 686            liece-dialogue-buffer)))
 687     (when (liece-get-buffer-window other-window-scroll-buffer)
 688       (condition-case nil
 689           (scroll-other-window-down lines)
 690         (beginning-of-buffer
 691          (message "Beginning of buffer"))))))
 692
 693 (defun liece-command-scroll-up (lines)
 694   "Scroll LINES up dialogue buffer from command buffer."
 695   (interactive "P")
 696   (let* ((other-window-scroll-buffer
 697           (if liece-channel-buffer-mode
 698               liece-channel-buffer
 699             liece-dialogue-buffer)))
 700     (when (liece-get-buffer-window other-window-scroll-buffer)
 701       (condition-case nil
 702           (scroll-other-window lines)
 703         (end-of-buffer
 704          (message "End of buffer"))))))
 705
 706 (defun liece-command-nick-scroll-down (lines)
 707   "Scroll LINES down nick buffer from command buffer."
 708   (interactive "P")
 709   (let ((other-window-scroll-buffer liece-nick-buffer))
 710     (when (liece-get-buffer-window other-window-scroll-buffer)
 711       (condition-case nil
 712           (scroll-other-window-down lines)
 713         (beginning-of-buffer
 714          (message "Beginning of buffer"))))))
 715
 716 (defun liece-command-nick-scroll-up (lines)
 717   "Scroll LINES up nick buffer from command buffer."
 718   (interactive "P")
 719   (let* ((other-window-scroll-buffer liece-nick-buffer))
 720     (when (liece-get-buffer-window other-window-scroll-buffer)
 721       (condition-case nil
 722           (scroll-other-window lines)
 723         (end-of-buffer
 724          (message "End of buffer"))))))
 725
 726 (defun liece-command-freeze (&optional arg)
 727   "Prevent automatic scrolling of the dialogue window.
 728 If prefix argument ARG is non-nil, toggle frozen status."
 729   (interactive "P")
 730   (liece-freeze (if liece-channel-buffer-mode
 731                     liece-channel-buffer
 732                   liece-dialogue-buffer)
 733                 (if arg (prefix-numeric-value arg))))
 734
 735 (defun liece-command-own-freeze (&optional arg)
 736   "Prevent automatic scrolling of the dialogue window.
 737 The difference from `liece-command-freeze' is that your messages are hidden.
 738 If prefix argument ARG is non-nil, toggle frozen status."
 739   (interactive "P")
 740   (liece-own-freeze (if liece-channel-buffer-mode
 741                         liece-channel-buffer
 742                       liece-dialogue-buffer)
 743                     (if arg (prefix-numeric-value arg))))
 744
 745 (defun liece-command-beep (&optional arg)
 746   "Toggle the automatic beep notice when the channel message is received."
 747   (interactive "P")
 748   (liece-set-beep (if liece-channel-buffer-mode
 749                       liece-channel-buffer
 750                     liece-dialogue-buffer)
 751                   (if arg (prefix-numeric-value arg))))
 752
 753 (defun liece-command-quit (&optional arg)
 754   "Quit IRC.
 755 If prefix argument ARG is non-nil, leave signoff message."
 756   (interactive "P")
 757   (when (and (liece-server-opened)
 758              (y-or-n-p (_ "Quit IRC? ")))
 759     (message "")
 760     (let ((quit-string
 761            (if arg (read-string (_ "Signoff message: "))
 762              (or liece-signoff-message
 763                  (product-name (product-find 'liece-version))))))
 764       (liece-close-server quit-string))))
 765
 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
 782 "))
 783     (liece-send "%s" message)))
 784
 785 (defun liece-command-irc-compatible ()
 786   "If entered at column 0, allow you to enter a generic IRC message."
 787   (interactive)
 788   (if (zerop (current-column))
 789       (call-interactively (function liece-command-generic))
 790     (self-insert-command 1)))
 791
 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."
 795   (interactive)
 796   (when (y-or-n-p (_ "Really SEND from Yank Buffer?"))
 797     (save-restriction
 798       (narrow-to-region (point) (point))
 799       (insert (car kill-ring-yank-pointer))
 800       (goto-char (point-min))
 801       (while (eobp)
 802         (liece-command-enter-message)
 803         (set-buffer liece-command-buffer)))))
 804
 805 (defun liece-command-complete ()
 806   "Complete word before point from userlist."
 807   (interactive)
 808   (let ((completion-ignore-case t)
 809         (alist (if liece-current-channel
 810                    (list-to-alist (liece-channel-get-nicks))
 811                  liece-nick-alist))
 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)))
 817
 818 (defun liece-command-load-vars ()
 819   "Load configuration from liece-variables-file."
 820   (interactive)
 821   (let ((nick liece-real-nickname))
 822     (unwind-protect
 823         (liece-read-variables-files)
 824       (setq liece-real-nickname nick)
 825       (liece-command-reconfigure-windows))))
 826
 827 (defun liece-command-save-vars ()
 828   "Save current settings to `liece-variables-file'."
 829   (interactive)
 830   (let* ((output-buffer
 831           (find-file-noselect
 832            (expand-file-name liece-variables-file)))
 833          output-marker p)
 834     (save-excursion
 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))
 839              (goto-char p)
 840              (or (re-search-forward
 841                   "^;; End of Saved Settings *\\(\n\\|\\'\\)" nil t)
 842                  (error
 843                   (concat "can't find END of saved state in "
 844                           liece-variables-file)))
 845              (delete-region p (match-end 0)))
 846             (t
 847              (goto-char (point-max))
 848              (insert "\n")))
 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)
 855           (if (symbolp var)
 856               (prin1 (list 'setq var
 857                            (let ((val (symbol-value var)))
 858                              (if (memq val '(t nil))
 859                                  val
 860                                (list 'quote val)))))
 861             (setq var (eval var))
 862             (cond ((eq (car-safe var) 'progn)
 863                    (while (setq var (cdr var))
 864                      (prin1 (car var))
 865                      (princ "\n")
 866                      (if (cdr var) (princ "  "))))
 867                   (var
 868                    (prin1 "xx")(prin1 var))))
 869           (if var (princ "\n")))
 870         (princ "\n")
 871         (princ ";; End of Saved Settings\n")))
 872     (set-marker output-marker nil)
 873     (save-excursion
 874       (set-buffer output-buffer)
 875       (save-buffer)))
 876   (setq liece-save-variables-are-dirty nil))
 877
 878 (defun liece-command-reconfigure-windows ()
 879   "Rearrange window splitting."
 880   (interactive)
 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))))
 895
 896 (defun liece-command-end-of-buffer ()
 897   "Get end of the dialogue buffer."
 898   (interactive)
 899   (let (buffer window)
 900     (setq buffer (if liece-channel-buffer-mode
 901                      liece-channel-buffer
 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))
 906     (when window
 907       (save-selected-window
 908         (select-window window)
 909         (goto-char (point-max))))))
 910
 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.
 915
 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."
 920   (interactive
 921    (let ((completion-ignore-case t))
 922      (list
 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)
 930             (completing-read
 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
 938               (completing-read
 939                (_ "Start private conversation with: ")
 940                liece-nick-alist )))))))
 941
 942   (liece-toggle-command-buffer-mode)
 943   (if (and arg (not (string-equal arg "")))
 944       (liece-command-join arg))
 945   (liece-set-channel-indicator)
 946   ;; refresh mode line
 947   (force-mode-line-update))
 948
 949 (defun liece-command-next-channel ()
 950   "Select next channel or chat partner, and *DONT* rotate list."
 951   (interactive)
 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))
 962          chnl))))
 963
 964 (defun liece-command-previous-channel ()
 965   "Select previous channel or chat partner, and *DONT* rotate list."
 966   (interactive)
 967   (let ((rest
 968          (reverse
 969           (if (eq liece-command-buffer-mode 'chat)
 970               liece-current-chat-partners
 971             liece-current-channels)))
 972         (chnl
 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))
 979          chnl))))
 980
 981 (defun liece-command-unread-channel ()
 982   "Select unread channel or chat partner."
 983   (interactive)
 984   (let ((chnl (car liece-channel-unread-list)))
 985     (if chnl
 986         (liece-switch-to-channel chnl)
 987       (liece-message (_ "No unread channel or chat partner.")))))
 988
 989 (defun liece-command-push ()
 990   "Select next channel or chat partner, and rotate list."
 991   (interactive)
 992   (let* ((rest
 993           (if (eq liece-command-buffer-mode 'chat)
 994               liece-current-chat-partners
 995             liece-current-channels))
 996          (temp (car (last rest)))
 997          (len (length rest)))
 998     (unwind-protect
 999         (while (< 1 len)
1000           (setcar (nthcdr (1- len) rest) (nth (- len 2) rest))
1001           (decf len))
1002       (when rest
1003         (setcar rest temp)))
1004     (liece-channel-change)))
1005
1006 (defun liece-command-pop ()
1007   "Select previous channel or chat partner, and rotate list."
1008   (interactive)
1009   (let* ((rest
1010           (if (eq liece-command-buffer-mode 'chat)
1011               liece-current-chat-partners
1012             liece-current-channels))
1013          (temp (car rest))
1014          (len (length rest)))
1015     (unwind-protect
1016         (dotimes (i len)
1017           (setcar (nthcdr i rest) (nth (1+ i) rest)))
1018       (when rest
1019         (setcar (last rest) temp)))
1020     (liece-channel-change)))
1021
1022 (defvar liece-redisplay-buffer-functions
1023   '(liece-channel-redisplay-buffer
1024     liece-nick-redisplay-buffer
1025     liece-channel-list-redisplay-buffer))
1026
1027 (defun liece-switch-to-channel (chnl)
1028   "Switch the current channel to CHNL."
1029   (if (liece-channel-p (liece-channel-real chnl))
1030       (progn
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))
1037   (save-excursion
1038     (run-hook-with-args 'liece-redisplay-buffer-functions chnl)))
1039
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)))
1049           (if (eq mode 'chat)
1050               (progn
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))
1057           (save-excursion
1058             (run-hook-with-args 'liece-redisplay-buffer-functions chnl)))
1059       (message "Invalid channel!"))))
1060
1061 (defun liece-command-ping ()
1062   "Send PING to server."
1063   (interactive)
1064   (if (stringp liece-server-name)
1065       (liece-send "PING %s" liece-server-name)))
1066
1067 (defun liece-command-ison (nicks)
1068   "IsON users NICKS."
1069   (interactive
1070    (let (nicks (completion-ignore-case t))
1071      (setq nicks (liece-minibuffer-completing-read-multiple
1072                   "IsON" liece-nick-alist))
1073      (list nicks)))
1074   (liece-send "ISON :%s" (mapconcat #'identity nicks " ")))
1075
1076 (defun liece-command-activate-friends (nicks)
1077   "Register NICKS to the frinends list."
1078   (interactive
1079    (let (nicks (completion-ignore-case t))
1080      (setq nicks
1081            (liece-minibuffer-completing-read-multiple
1082             (_ "Friend")
1083             (filter-elements nick liece-nick-alist
1084               (not (string-list-member-ignore-case
1085                     (car nick) liece-friends)))))
1086      (list nicks)))
1087   (setq liece-friends (append nicks liece-friends)))
1088
1089 (defun liece-command-deactivate-friends ()
1090   "Clear current friends list."
1091   (interactive)
1092   (setq liece-friends nil))
1093
1094 (defun liece-command-display-friends ()
1095   "Display status of the friends."
1096   (interactive)
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")))))
1104
1105 (defun liece-command-show-last-kill ()
1106   "Dig last kill from KILL and show it."
1107   (interactive)
1108   (liece-insert-info
1109    (append liece-D-buffer liece-O-buffer)
1110    (save-excursion
1111      (set-buffer liece-KILLS-buffer)
1112      (goto-char (point-max))
1113      (forward-line -1)
1114      (concat (buffer-substring (point) (point-max)) "\n"))))
1115
1116 (defun liece-command-toggle-private ()
1117   "Toggle private mode / channel mode."
1118   (interactive)
1119   (case (prog1 liece-command-buffer-mode
1120           (liece-toggle-command-buffer-mode))
1121     (chat
1122      (if liece-current-channel
1123          (liece-switch-to-channel liece-current-channel))
1124      (setq liece-command-buffer-mode-indicator "Channels"))
1125     (channel
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))
1130
1131 (defun liece-command-tag-region (start end)
1132   "Move current region between START and END to `kill-ring'."
1133   (interactive
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)
1142           buffer-read-only
1143           buffer-undo-list)
1144       (liece-remove-properties-region start end)
1145       (kill-ring-save start end)
1146       (push nil buffer-undo-list)
1147       (undo))))
1148
1149 (provide 'liece-commands)
1150
1151 ;;; liece-commands.el ends here