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 (autoload 'liece-window-configuration-pop "liece-window")
  43
  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-clientinfo "liece-ctcp" nil t)
  47 (autoload 'liece-command-ctcp-ping "liece-ctcp" nil t)
  48 (autoload 'liece-command-ctcp-time "liece-ctcp" nil t)
  49 (autoload 'liece-command-ctcp-x-face "liece-ctcp" nil t)
  50 (autoload 'liece-command-ctcp-comment "liece-ctcp" nil t)
  51 (autoload 'liece-command-ctcp-help "liece-ctcp" nil t)
  52
  53 (defun liece-command-poll-names ()
  54   "Handler for polling NAMES."
  55   (when (liece-server-opened)
  56     (setq liece-polling
  57           (+ liece-polling
  58              (length liece-channel-alist)))
  59     (dolist (chnl liece-channel-alist)
  60       (liece-send "NAMES %s" (car chnl)))))
  61
  62 (defun liece-command-poll-friends ()
  63   "Handler for polling ISON."
  64   (and liece-friends
  65        (liece-server-opened)
  66        (liece-send "ISON %s" (mapconcat 'identity liece-friends " "))))
  67
  68 (defun liece-command-find-timestamp ()
  69   "Find recent timestamp in dialogue buffer."
  70   (interactive)
  71   (save-excursion
  72     (let ((range "")
  73           (regexp (concat "^\\(" liece-time-prefix-regexp "\\)?"
  74                           (regexp-quote liece-timestamp-prefix))))
  75       (unless (eq 'liece-dialogue-mode (derived-mode-class major-mode))
  76         (set-buffer liece-dialogue-buffer)
  77         (goto-char (point-max)))
  78       (if (re-search-backward regexp (point-min) t)
  79           (setq range (concat (buffer-substring (match-end 0)
  80                                                 (line-end-position))
  81                               "   ---   ")))
  82       (if (re-search-forward regexp (point-max) t)
  83           (setq range (concat range (buffer-substring (match-end 0)
  84                                                       (line-end-position)))))
  85       (liece-message range))))
  86
  87 (defun liece-command-keepalive ()
  88   "Handler for polling server connection."
  89   (if (not (liece-server-opened))
  90       (liece)
  91     (liece-ping-if-idle)))
  92
  93 (defvar liece-last-timestamp-time nil "Last time timestamp was inserted.")
  94 (defvar liece-last-timestamp-no-cons-p nil "Last timestamp was no-cons.")
  95
  96 (defun liece-command-timestamp-if-interval-expired (&optional no-cons)
  97   "If interval timer has expired, insert timestamp into dialogue buffer.
  98 And save variables into `liece-variable-file' if there are variables to save.
  99 Optional argument NO-CONS specifies timestamp format is cons cell."
 100   (interactive)
 101   (when (and (not (and no-cons
 102                        liece-last-timestamp-no-cons-p))
 103              (numberp liece-timestamp-interval)
 104              (> liece-timestamp-interval 0)
 105              (or (null liece-last-timestamp-time)
 106                  (> (liece-time-difference liece-last-timestamp-time
 107                                             (current-time))
 108                     liece-timestamp-interval)))
 109     (if liece-save-variables-are-dirty
 110         (liece-command-save-vars))
 111     (liece-command-timestamp)
 112     (setq liece-last-timestamp-no-cons-p no-cons)))
 113
 114 (defun liece-command-timestamp ()
 115   "Insert timestamp into dialogue buffer."
 116   (interactive)
 117   (let ((stamp (format liece-timestamp-format
 118                        (funcall liece-format-time-function (current-time))))
 119         (liece-timestamp-interval 0))
 120     (liece-insert liece-D-buffer (concat stamp "\n"))
 121     (setq liece-last-timestamp-time (current-time))))
 122
 123 (defun liece-command-point-back-to-command-buffer ()
 124   "Set point back to command buffer."
 125   (interactive)
 126   (let ((win (liece-get-buffer-window liece-command-buffer)))
 127     (if win (select-window win))))
 128
 129 (defun liece-command-send-message (message)
 130   "Send MESSAGE to current chat partner of current channel."
 131   (if (string-equal message "")
 132       (progn (liece-message (_ "No text to send")) nil)
 133     (let ((addr (if (eq liece-command-buffer-mode 'chat)
 134                     liece-current-chat-partner
 135                   liece-current-channel))
 136           repr method name target)
 137       (cond
 138        ((eq liece-command-buffer-mode 'chat)
 139         (or liece-current-chat-partner
 140             (error
 141              (substitute-command-keys
 142               "Type \\[liece-command-join] to start private conversation")))
 143         (setq repr (liece-channel-parse-representation
 144                     liece-current-chat-partner)
 145               method (aref repr 0)
 146               name (aref repr 1)
 147               target (aref repr 2))
 148         (cond ((eq method 'dcc)
 149                (liece-dcc-chat-send target message))
 150               ((eq method 'irc)
 151                (liece-send "PRIVMSG %s :%s"
 152                            liece-current-chat-partner message)))
 153         (liece-own-private-message message))
 154        (t
 155         (or liece-current-channel
 156             (error
 157              (substitute-command-keys
 158               "Type \\[liece-command-join] to join a channel")))
 159         (liece-send
 160          "PRIVMSG %s :%s"
 161          (liece-channel-real liece-current-channel) message)
 162         (liece-own-channel-message message))))))
 163
 164 (defun liece-command-enter-message ()
 165   "Enter the current line as an entry in the IRC dialogue."
 166   (interactive)
 167   (beginning-of-line)
 168   (liece-command-send-message
 169    (buffer-substring (point)(progn (end-of-line) (point))))
 170   (liece-next-line 1))
 171
 172 (defun liece-dialogue-enter-message ()
 173   "Ask for a line as an entry in the IRC dialogue on the current channel."
 174   (interactive)
 175   (let (message)
 176     (while (not (string-equal (setq message (read-string "> ")) ""))
 177       (liece-command-send-message message))))
 178
 179 (defun liece-command-join-channel (join-channel-var key)
 180   "Join a JOIN-CHANNEL-VAR with KEY."
 181   (let ((nicks liece-nick-alist) nick)
 182     (while (and nicks
 183                 (not (and
 184                       (car nick)
 185                       (liece-channel-equal join-channel-var (car nick)))))
 186       (setq nick (pop nicks)))
 187     (when nicks
 188       (setq join-channel-var
 189             (or (car (get (intern (car nick) liece-obarray) 'chnl))
 190                 join-channel-var)))
 191     (if (liece-channel-member join-channel-var liece-current-channels)
 192         (progn
 193           (setq liece-current-channel join-channel-var)
 194           (liece-switch-to-channel liece-current-channel)
 195           (liece-channel-change))
 196       (liece-send "JOIN %s %s" (liece-channel-real join-channel-var) key))))
 197
 198 (defun liece-command-join-partner (join-channel-var)
 199   "Join a JOIN-CHANNEL-VAR."
 200   (if (liece-channel-member join-channel-var liece-current-chat-partners)
 201       (progn
 202         (setq liece-current-chat-partner join-channel-var)
 203         (liece-switch-to-channel liece-current-chat-partner))
 204     (setq liece-current-chat-partner join-channel-var)
 205     (liece-channel-join liece-current-chat-partner))
 206   (liece-channel-change))
 207
 208 (defun liece-command-join (join-channel-var &optional key)
 209   "Join a JOIN-CHANNEL-VAR with KEY.
 210 If user nickname is given join the same set of channels as the specified user.
 211 If command-buffer is in chat-mode, start private conversation
 212 with specified user."
 213   (interactive
 214    (let (join-channel-var key (completion-ignore-case t))
 215      (setq join-channel-var
 216            (if (numberp current-prefix-arg)
 217                current-prefix-arg
 218              (liece-channel-virtual
 219               (if (eq liece-command-buffer-mode 'chat)
 220                   (liece-minibuffer-completing-read
 221                    (_ "Start private conversation with: ")
 222                    liece-nick-alist nil nil nil nil liece-privmsg-partner)
 223                 (liece-minibuffer-completing-read
 224                  (_ "Join channel: ")
 225                  (append liece-channel-alist liece-nick-alist)
 226                  nil nil nil nil liece-default-channel-candidate)))))
 227      (if (and current-prefix-arg
 228               (not (numberp current-prefix-arg)))
 229          (setq key
 230                (if (eq current-prefix-arg '-)
 231                    (read-string
 232                     (format (_ "Key for channel %s: ") join-channel-var))
 233                  (let ((passwd-echo ?*))
 234                    (read-passwd
 235                     (format (_ "Key for channel %s: ") join-channel-var))))))
 236      (list join-channel-var key)))
 237   (let ((real-chnl (liece-channel-real join-channel-var)))
 238     (if (numberp join-channel-var)
 239         (liece-switch-to-channel-no join-channel-var)
 240       (setq liece-default-channel-candidate nil)
 241       (if (liece-channel-p real-chnl)
 242           (liece-toggle-command-buffer-mode 'channel)
 243         (liece-toggle-command-buffer-mode 'chat))
 244       (if (eq liece-command-buffer-mode 'chat)
 245           (liece-command-join-partner join-channel-var)
 246         (if (null key)
 247             (setq key (get (intern join-channel-var liece-obarray) 'key)))
 248         (put (intern join-channel-var liece-obarray) 'key key)
 249         (if (null key)
 250             (setq key ""))
 251         (liece-command-join-channel join-channel-var key))
 252       (force-mode-line-update))))
 253
 254 (defun liece-command-part (part-channel-var &optional part-msg)
 255   "Part a PART-CHANNEL-VAR with PART-MSG."
 256   (interactive
 257    (let (part-channel-var
 258          (completion-ignore-case t)
 259          (part-msg "bye..."))
 260      (setq part-channel-var
 261            (liece-channel-virtual
 262             (if (eq liece-command-buffer-mode 'chat)
 263                 (liece-minibuffer-completing-read
 264                  (_ "End private conversation with: ")
 265                  (list-to-alist liece-current-chat-partners)
 266                  nil nil nil nil liece-current-chat-partner)
 267               (liece-minibuffer-completing-read
 268                (_ "Part channel: ")
 269                (list-to-alist liece-current-channels)
 270                nil nil nil nil liece-current-channel))))
 271      (when current-prefix-arg
 272        (setq part-msg (read-string (_ "Part Message: "))))
 273      (list part-channel-var part-msg)))
 274   (let ((real-chnl (liece-channel-real part-channel-var)))
 275     (if (liece-channel-p real-chnl)
 276         (progn
 277           (if (liece-channel-member part-channel-var liece-current-channels)
 278               (setq liece-current-channel part-channel-var))
 279           (liece-send "PART %s :%s" real-chnl part-msg)
 280           (setq liece-default-channel-candidate part-channel-var))
 281       (setq liece-current-chat-partners
 282             (liece-channel-remove part-channel-var
 283                                   liece-current-chat-partners)
 284             liece-current-chat-partner
 285             (car liece-current-chat-partners))
 286       (liece-set-channel-indicator)
 287       (liece-channel-part part-channel-var))))
 288
 289 (defun liece-command-kill (kill-nickname-var &optional timeout silent)
 290   "Ignore messages from KILL-NICKNAME-VAR.
 291 Username can be given as case insensitive regular expression of form
 292 \".*@.*\.sub.domain\".
 293 If already ignoring him/her, toggle.
 294 If `liece-variables-file' is defined and the file is writable,
 295 settings are updated automatically for future sessions.
 296 Optional argument TIMEOUT says expiration.
 297 If SILENT is non-nil, don't notify current status."
 298   (interactive
 299    (let (kill-nickname-var timeout (completion-ignore-case t))
 300      (setq kill-nickname-var (completing-read
 301                               (_ "Ignore nickname or regexp: ")
 302                               (append liece-nick-alist
 303                                       liece-kill-nickname)))
 304      (or (string-equal "" kill-nickname-var)
 305          (string-assoc-ignore-case kill-nickname-var liece-kill-nickname)
 306          (setq timeout (string-to-int (read-from-minibuffer
 307                                        (_ "Timeout [RET for none]: ")))))
 308      (list kill-nickname-var timeout)))
 309   ;; empty, just list them
 310   (if (string-equal "" kill-nickname-var)
 311       (with-current-buffer liece-dialogue-buffer
 312         (let ((ignores liece-kill-nickname) (time (current-time))
 313               buffer-read-only expire expiretime)
 314           (goto-char (point-max))
 315           (liece-insert-info liece-D-buffer (_ "Currently ignoring:"))
 316           (dolist (ignore ignores)
 317             (setq expiretime (if (cdr ignore)
 318                                  (/ (liece-time-difference time (cdr ignore))
 319                                     60))
 320                   expire (cond ((not expiretime) "")
 321                                ((>= expiretime 0)
 322                                 (format (_ " (%d min)") expiretime))
 323                                ((< expiretime 0)
 324                                 (_ " expired"))))
 325             (liece-insert liece-D-buffer
 326                            (concat " " (car ignore) expire "\n")))))
 327     ;; else not empty, check if exists
 328     (let ((ignore
 329            (string-assoc-ignore-case
 330             kill-nickname-var liece-kill-nickname)))
 331       (if ignore
 332           (when (setq ignore (string-assoc-ignore-case
 333                               (car ignore) liece-kill-nickname))
 334             (setq liece-kill-nickname
 335                   (delq ignore liece-kill-nickname))
 336             (liece-insert-info liece-D-buffer
 337                                (format (_ "No longer ignoring: %s.\n")
 338                                        (car ignore))))
 339         ;; did not find, add to ignored ones
 340         (let ((expire-time (if (> timeout 0)
 341                                (liece-time-add (current-time)
 342                                                 (* timeout 60)))))
 343           (and silent (> timeout 0)
 344                (setcar (cdr (cdr expire-time)) -1))
 345           (setq liece-kill-nickname
 346                 (cons (cons kill-nickname-var expire-time)
 347                       liece-kill-nickname))
 348           (unless silent
 349             (liece-insert-info liece-D-buffer
 350                                 (format (_ "Ignoring %s") kill-nickname-var))
 351             (liece-insert-info liece-D-buffer
 352                                 (if (> timeout 0)
 353                                     (format " for %d minutes.\n" timeout)
 354                                   (format ".\n")))))))
 355     (setq liece-save-variables-are-dirty t)))
 356
 357 (defun liece-command-kick (nick &optional msg)
 358   "Kick this NICK out with MSG."
 359   (interactive
 360    (let ((completion-ignore-case t)
 361          (nicks (liece-channel-get-nicks)) nick msg)
 362      (setq nick (completing-read
 363                  (_ "Kick out nickname: ")
 364                  (list-to-alist nicks)))
 365      (if current-prefix-arg
 366          (setq msg (concat " :" (read-string (_ "Kick Message: ")))))
 367      (list nick msg)))
 368   (liece-send "KICK %s %s%s"
 369                (liece-channel-real liece-current-channel)
 370                nick (or msg "")))
 371
 372 (defun liece-command-ban (ban)
 373   "BAN this user out."
 374   (interactive
 375    (let* ((completion-ignore-case t)
 376           (nicks (liece-channel-get-nicks))
 377           (uahs (mapcar
 378                  (function
 379                   (lambda (nick)
 380                     (list
 381                      (concat nick "!" (liece-nick-get-user-at-host nick)))))
 382                  nicks))
 383           ban nick msg)
 384      (setq ban (liece-minibuffer-completing-read
 385                 (_ "Ban pattern: ") uahs nil nil nil nil
 386                 (concat nick "!" (liece-nick-get-user-at-host nick))))
 387      (list ban)))
 388   (liece-send "MODE %s :+b %s"
 389                (liece-channel-real liece-current-channel) ban))
 390
 391 (defun liece-command-ban-kick (ban nick &optional msg)
 392   "BAN kick this NICK out with MSG."
 393   (interactive
 394    (let* ((completion-ignore-case t)
 395           (nicks (liece-channel-get-nicks))
 396           (uahs (mapcar
 397                  (function
 398                   (lambda (nick)
 399                     (list
 400                      (concat nick "!" (liece-nick-get-user-at-host nick)))))
 401                  nicks))
 402           ban nick msg)
 403      (setq nick (completing-read (_ "Kick out nickname: ")
 404                                  (list-to-alist nicks))
 405            ban (liece-minibuffer-completing-read
 406                 (_ "Ban pattern: ") uahs nil nil nil nil
 407                 (concat nick "!" (liece-nick-get-user-at-host nick))))
 408      (if current-prefix-arg
 409          (setq msg (concat " :" (read-string (_ "Kick Message: "))))
 410        (setq msg ""))
 411      (list ban nick msg)))
 412   (liece-send "MODE %s :+b %s"
 413                (liece-channel-real liece-current-channel) ban)
 414   (liece-send "KICK %s %s%s"
 415                (liece-channel-real liece-current-channel)
 416                nick (or msg "")))
 417
 418 (defun liece-command-list (&optional channel)
 419   "List the given CHANNEL and its topics.
 420 If you enter only Control-U as argument, list the current channel.
 421 With - as argument, list all channels."
 422   (interactive
 423    (if (or current-prefix-arg (null liece-current-channel))
 424        (if (eq current-prefix-arg '-)
 425            (list current-prefix-arg))
 426      (let ((completion-ignore-case t) channel)
 427        (setq channel (liece-minibuffer-completing-read
 428                       (_ "LIST channel: ")
 429                       liece-channel-alist nil nil nil nil liece-current-channel))
 430        (unless (string-equal "" channel)
 431          (list channel)))))
 432
 433   (cond ((not channel)
 434          (if liece-current-channel
 435              (liece-send "LIST %s"
 436                           (liece-channel-real liece-current-channel))))
 437         ((and (eq channel '-)
 438               (y-or-n-p (_ "Do you really query LIST without argument?")))
 439          (liece-send "LIST"))
 440         ((not (string-equal channel ""))
 441          (liece-send "LIST %s" (liece-channel-real channel))
 442          )))
 443
 444 (defun liece-command-modec (chnl change)
 445   "Send a MODE command to this CHNL.
 446 Argument CHANGE ."
 447   (interactive
 448    (let ((completion-ignore-case t)
 449          (chnl liece-current-channel)
 450          liece-minibuffer-complete-function prompt)
 451      (if current-prefix-arg
 452          (setq chnl
 453                (liece-minibuffer-completing-read
 454                 (_ "Channel/User: ")
 455                 (append liece-channel-alist liece-nick-alist)
 456                 nil nil nil nil liece-current-channel)))
 457      (cond
 458       ((liece-channel-p (liece-channel-real chnl))
 459        (setq prompt (format
 460                      (_ "Mode for channel %s [%s]: ")
 461                      chnl (or (liece-channel-get-modes chnl) ""))
 462              liece-minibuffer-complete-function
 463              (function liece-minibuffer-complete-channel-modes)))
 464       (t
 465        (setq prompt (format
 466                      (_ "Mode for user %s [%s]: ")
 467                      chnl (or (liece-nick-get-modes chnl) ""))
 468              liece-minibuffer-complete-function
 469              (function liece-minibuffer-complete-user-modes))))
 470      (list chnl (read-from-minibuffer prompt nil liece-minibuffer-map))))
 471   (liece-send "MODE %s %s" (liece-channel-real chnl) change))
 472
 473 (defun liece-command-qualify-nicks (mode nicks val)
 474   (liece-send
 475    "MODE %s %c%s %s"
 476    (liece-channel-real liece-current-channel)
 477    (if val ?+ ?-) (make-string (length nicks) ?o)
 478    (string-join nicks " ")))
 479
 480 (defun liece-command-set-operators (nicks &optional arg)
 481   (interactive
 482    (let ((opers (liece-channel-get-operators))
 483          (completion-ignore-case t)
 484          nicks)
 485      (if current-prefix-arg
 486          (setq nicks (liece-minibuffer-completing-read-multiple
 487                       (_ "Divest operational privilege from: ")
 488                       (list-to-alist opers)))
 489        (setq nicks (liece-channel-get-nicks)
 490              nicks (filter-elements nick nicks
 491                      (not (liece-nick-member nick opers)))
 492              nicks (liece-minibuffer-completing-read-multiple
 493                     (_ "Assign operational privilege to: ")
 494                     (list-to-alist nicks))))
 495      (list nicks current-prefix-arg)))
 496   (let (run)
 497     (unwind-protect
 498         (dolist (nick nicks)
 499           (push nick run)
 500           (if (= (length run) liece-compress-mode-length)
 501               (liece-command-qualify-nicks ?o run (not arg))))
 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           (if (= (length run) liece-compress-mode-length)
 525               (liece-command-qualify-nicks ?v run (not arg))))
 526       (when run
 527         (liece-command-qualify-nicks ?v run (not arg))))))
 528
 529 (defun liece-command-message (address message)
 530   "Send ADDRESS a private MESSAGE."
 531   (interactive
 532    (let ((completion-ignore-case t) address)
 533      (setq address
 534            (liece-channel-virtual
 535             (liece-minibuffer-completing-read
 536              (_ "Private message to: ")
 537              (append liece-nick-alist liece-channel-alist)
 538              nil nil nil nil liece-privmsg-partner)))
 539      (list address
 540            (read-string
 541             (format
 542              (_ "Private message to %s: ")
 543              address)))))
 544   (if (funcall liece-message-empty-predicate message)
 545       (progn (liece-message (_ "No text to send")) nil)
 546     (let ((chnl (liece-channel-real address)))
 547       (liece-send "PRIVMSG %s :%s" chnl message)
 548       (if (liece-channel-p chnl)
 549           (liece-own-channel-message message
 550                                      (liece-channel-virtual address))
 551         (liece-own-private-message message address)))))
 552
 553 (defun liece-command-mta-private (partner)
 554   "Send a private message (current line) to PARTNER."
 555   (interactive
 556    (let ((completion-ignore-case t))
 557      (setq liece-privmsg-partner
 558            (liece-channel-virtual
 559             (liece-minibuffer-completing-read
 560              (_ "To whom: ")
 561              (append liece-nick-alist liece-channel-alist)
 562              nil nil nil nil liece-privmsg-partner)))
 563      (list liece-privmsg-partner)))
 564   (let ((message (buffer-substring (progn (beginning-of-line) (point))
 565                                    (progn (end-of-line) (point)))))
 566     (if (> (length message) 0)
 567         (progn
 568           (liece-command-message liece-privmsg-partner message)
 569           (liece-next-line 1))
 570       (liece-message (_ "No text to send")))))
 571
 572 (defun liece-command-names (&optional expr)
 573   "List the nicknames of the current IRC users on given EXPR.
 574 With an Control-U as argument, only the current channel is listed.
 575 With - as argument, list all channels."
 576   (interactive
 577    (if (or current-prefix-arg (null liece-current-channel))
 578        (if (eq current-prefix-arg '-)
 579            (list current-prefix-arg))
 580      (let ((completion-ignore-case t) expr)
 581        (setq expr (liece-minibuffer-completing-read
 582                       (_ "Names on channel: ")
 583                       liece-channel-alist nil nil nil nil liece-current-channel))
 584        (unless (string-equal "" expr)
 585          (list expr)))))
 586   (when (or (and (eq expr '-)
 587                  (y-or-n-p
 588                   (_ "Do you really query NAMES without argument?")))
 589             (not (or expr
 590                      (if liece-current-channel
 591                          (setq expr (liece-channel-real
 592                                      liece-current-channel))))))
 593     (setq expr ""))
 594   (when expr
 595     (liece-send "NAMES %s" expr)))
 596
 597 (defun liece-command-nickname (nick)
 598   "Set your nickname to NICK."
 599   (interactive "sEnter your nickname: ")
 600   (let ((nickname (truncate-string nick liece-nick-max-length)))
 601     (if (zerop (length nickname))
 602         (liece-message (_ "illegal nickname \"%s\"; not changed") nickname)
 603       (liece-send "NICK %s" nick))))
 604
 605 (defun liece-command-who (&optional expr)
 606   "Lists tue users that match the given expression EXPR.
 607 If you enter only Control-U as argument, list the current channel.
 608 With - as argument, list all users."
 609   (interactive
 610    (if (or current-prefix-arg (null liece-current-channel))
 611        (if (eq current-prefix-arg '-)
 612            (list current-prefix-arg))
 613      (let ((completion-ignore-case t) expr)
 614        (setq expr (completing-read
 615                    (_ "WHO expression: ")
 616                    (append liece-channel-alist liece-nick-alist)))
 617        (unless (string-equal "" expr)
 618          (list expr)))))
 619   (when (or (and (eq expr '-)
 620                  (y-or-n-p
 621                   (_ "Do you really query WHO without argument?")))
 622             (not (or expr
 623                      (if liece-current-channel
 624                          (setq expr (liece-channel-real
 625                                      liece-current-channel))))))
 626     (setq expr ""))
 627   (when expr
 628     (liece-send "WHO %s" expr)
 629     (setq liece-who-expression expr)))
 630
 631 (defun liece-command-finger (finger-nick-var &optional server)
 632   "Get information about a specific user FINGER-NICK-VAR.
 633 If called with optional argument SERVER or any prefix argument,
 634 query information to the foreign server."
 635   (interactive
 636    (let (finger-nick-var (completion-ignore-case t))
 637      (setq finger-nick-var
 638            (completing-read (_ "Finger whom: ") liece-nick-alist))
 639      (list finger-nick-var (and current-prefix-arg finger-nick-var))))
 640   (if server
 641       (liece-send "WHOIS %s %s" server finger-nick-var)
 642     (liece-send "WHOIS %s" finger-nick-var)))
 643
 644 (defun liece-command-topic (topic)
 645   "Change TOPIC of the current channel."
 646   (interactive
 647    (list (read-from-minibuffer
 648           "Topic: " (cons (or (liece-channel-get-topic) "") 0))))
 649   (liece-send "TOPIC %s :%s"
 650               (liece-channel-real liece-current-channel) topic))
 651
 652 (defun liece-command-invite (&optional invite-nick-var invite-channel-var)
 653   "Invite INVITE-NICK-VAR to INVITE-CHANNEL-VAR."
 654   (interactive
 655    (let ((completion-ignore-case t) invite-channel-var invite-nick-var)
 656      (if current-prefix-arg
 657          (setq invite-channel-var
 658                (liece-channel-virtual
 659                 (completing-read
 660                  (_ "Invite channel: ")
 661                  (list-to-alist liece-current-channels)))))
 662      (setq invite-nick-var
 663            (completing-read
 664             (_ "Invite whom: ")
 665             liece-nick-alist))
 666      (list invite-nick-var invite-channel-var)))
 667   (or invite-channel-var
 668       (setq invite-channel-var liece-current-channel))
 669   (liece-send "INVITE %s %s"
 670                invite-nick-var (liece-channel-real invite-channel-var)))
 671
 672 (defun liece-command-away (awaymsg)
 673   "Mark/unmark yourself as being away.
 674 Leave message AWAYMSG."
 675   (interactive "sAway message: ")
 676   (liece-send "AWAY :%s" awaymsg)
 677   (setq liece-away-message awaymsg))
 678
 679 (defun liece-command-scroll-down (lines)
 680   "Scroll LINES down dialogue buffer from command buffer."
 681   (interactive "P")
 682   (let ((other-window-scroll-buffer
 683          (if liece-channel-buffer-mode
 684              liece-channel-buffer
 685            liece-dialogue-buffer)))
 686     (when (liece-get-buffer-window other-window-scroll-buffer)
 687       (condition-case nil
 688           (scroll-other-window-down lines)
 689         (beginning-of-buffer
 690          (message "Beginning of buffer"))))))
 691
 692 (defun liece-command-scroll-up (lines)
 693   "Scroll LINES up dialogue buffer from command buffer."
 694   (interactive "P")
 695   (let* ((other-window-scroll-buffer
 696           (if liece-channel-buffer-mode
 697               liece-channel-buffer
 698             liece-dialogue-buffer)))
 699     (when (liece-get-buffer-window other-window-scroll-buffer)
 700       (condition-case nil
 701           (scroll-other-window lines)
 702         (end-of-buffer
 703          (message "End of buffer"))))))
 704
 705 (defun liece-command-nick-scroll-down (lines)
 706   "Scroll LINES down nick buffer from command buffer."
 707   (interactive "P")
 708   (let ((other-window-scroll-buffer liece-nick-buffer))
 709     (when (liece-get-buffer-window other-window-scroll-buffer)
 710       (condition-case nil
 711           (scroll-other-window-down lines)
 712         (beginning-of-buffer
 713          (message "Beginning of buffer"))))))
 714
 715 (defun liece-command-nick-scroll-up (lines)
 716   "Scroll LINES up nick buffer from command buffer."
 717   (interactive "P")
 718   (let* ((other-window-scroll-buffer liece-nick-buffer))
 719     (when (liece-get-buffer-window other-window-scroll-buffer)
 720       (condition-case nil
 721           (scroll-other-window lines)
 722         (end-of-buffer
 723          (message "End of buffer"))))))
 724
 725 (defun liece-command-freeze (&optional arg)
 726   "Prevent automatic scrolling of the dialogue window.
 727 If prefix argument ARG is non-nil, toggle frozen status."
 728   (interactive "P")
 729   (liece-freeze (if liece-channel-buffer-mode
 730                     liece-channel-buffer
 731                   liece-dialogue-buffer)
 732                 (if arg (prefix-numeric-value arg))))
 733
 734 (defun liece-command-own-freeze (&optional arg)
 735   "Prevent automatic scrolling of the dialogue window.
 736 The difference from `liece-command-freeze' is that your messages are hidden.
 737 If prefix argument ARG is non-nil, toggle frozen status."
 738   (interactive "P")
 739   (liece-own-freeze (if liece-channel-buffer-mode
 740                         liece-channel-buffer
 741                       liece-dialogue-buffer)
 742                     (if arg (prefix-numeric-value arg))))
 743
 744 (defun liece-command-beep (&optional arg)
 745   "Toggle the automatic beep notice when the channel message is received."
 746   (interactive "P")
 747   (liece-set-beep (if liece-channel-buffer-mode
 748                       liece-channel-buffer
 749                     liece-dialogue-buffer)
 750                   (if arg (prefix-numeric-value arg))))
 751
 752 (defun liece-command-quit (&optional arg)
 753   "Quit IRC.
 754 If prefix argument ARG is non-nil, leave signoff message."
 755   (interactive "P")
 756   (when (and (liece-server-opened)
 757              (y-or-n-p (_ "Quit IRC? ")))
 758     (message "")
 759     (let ((quit-string
 760            (if arg (read-string (_ "Signoff message: "))
 761              (or liece-signoff-message
 762                  (product-name (product-find 'liece-version))))))
 763       (liece-close-server quit-string))
 764     (liece-clear-system)
 765     (if liece-save-variables-are-dirty
 766         (liece-command-save-vars))
 767     (if (interactive-p)
 768         (liece-window-configuration-pop))
 769     (run-hooks 'liece-exit-hook)))
 770
 771 (defun liece-command-generic (message)
 772   "Enter a generic IRC MESSAGE, which is sent to the server.
 773 A ? lists the useful generic messages."
 774   (interactive "sIRC command (? to help): ")
 775   (if (string-equal message "?")
 776       (with-output-to-temp-buffer "*IRC Help*"
 777         (princ "The following generic IRC messages may be of interest to you:
 778 TOPIC <new topic>               set the topic of your channel
 779 INVITE <nickname>               invite another user to join your channel
 780 LINKS                           lists the currently reachable IRC servers
 781 SUMMON <user@host>              invites an user not currently in IRC
 782 USERS <host>                    lists the users on a host
 783 AWAY <reason>                   marks you as not really actively using IRC
 784                                 (an empty reason clears it)
 785 WALL <message>                  send to everyone on IRC
 786 NAMES <channel>                 lists users per channel
 787 "))
 788     (liece-send "%s" message)))
 789
 790 (defun liece-command-irc-compatible ()
 791   "If entered at column 0, allow you to enter a generic IRC message."
 792   (interactive)
 793   (if (zerop (current-column))
 794       (call-interactively (function liece-command-generic))
 795     (self-insert-command 1)))
 796
 797 (defun liece-command-yank-send (&optional arg)
 798   "Send message from yank buffer.
 799 Prefix argument ARG is regarded as distance from yank pointer."
 800   (interactive)
 801   (when (y-or-n-p (_ "Really SEND from Yank Buffer?"))
 802     (save-restriction
 803       (narrow-to-region (point) (point))
 804       (insert (car kill-ring-yank-pointer))
 805       (goto-char (point-min))
 806       (while (eobp)
 807         (liece-command-enter-message)
 808         (set-buffer liece-command-buffer)))))
 809
 810 (defun liece-command-complete ()
 811   "Complete word before point from userlist."
 812   (interactive)
 813   (let ((completion-ignore-case t)
 814         (alist (if liece-current-channel
 815                    (list-to-alist (liece-channel-get-nicks))
 816                  liece-nick-alist))
 817         candidate completion all)
 818     (setq candidate (current-word)
 819           completion (try-completion candidate alist)
 820           all (all-completions candidate alist))
 821     (liece-minibuffer-finalize-completion completion candidate all)))
 822
 823 (defun liece-command-load-vars ()
 824   "Load configuration from liece-variables-file."
 825   (interactive)
 826   (let ((nick liece-real-nickname))
 827     (unwind-protect
 828         (liece-read-variables-files)
 829       (setq liece-real-nickname nick)
 830       (liece-command-reconfigure-windows))))
 831
 832 (defun liece-command-save-vars ()
 833   "Save current settings to `liece-variables-file'."
 834   (interactive)
 835   (let* ((output-buffer
 836           (find-file-noselect
 837            (expand-file-name liece-variables-file)))
 838          output-marker p)
 839     (save-excursion
 840       (set-buffer output-buffer)
 841       (goto-char (point-min))
 842       (cond ((re-search-forward "^;; Saved Settings *\n" nil 'move)
 843              (setq p (match-beginning 0))
 844              (goto-char p)
 845              (or (re-search-forward
 846                   "^;; End of Saved Settings *\\(\n\\|\\'\\)" nil t)
 847                  (error
 848                   (concat "can't find END of saved state in "
 849                           liece-variables-file)))
 850              (delete-region p (match-end 0)))
 851             (t
 852              (goto-char (point-max))
 853              (insert "\n")))
 854       (setq output-marker (point-marker))
 855       (let ((print-readably t)
 856             (print-escape-newlines t)
 857             (standard-output output-marker))
 858         (princ ";; Saved Settings\n")
 859         (dolist (var liece-saved-forms)
 860           (if (symbolp var)
 861               (prin1 (list 'setq var
 862                            (let ((val (symbol-value var)))
 863                              (if (memq val '(t nil))
 864                                  val
 865                                (list 'quote val)))))
 866             (setq var (eval var))
 867             (cond ((eq (car-safe var) 'progn)
 868                    (while (setq var (cdr var))
 869                      (prin1 (car var))
 870                      (princ "\n")
 871                      (if (cdr var) (princ "  "))))
 872                   (var
 873                    (prin1 "xx")(prin1 var))))
 874           (if var (princ "\n")))
 875         (princ "\n")
 876         (princ ";; End of Saved Settings\n")))
 877     (set-marker output-marker nil)
 878     (save-excursion
 879       (set-buffer output-buffer)
 880       (save-buffer)))
 881   (setq liece-save-variables-are-dirty nil))
 882
 883 (defun liece-command-reconfigure-windows ()
 884   "Rearrange window splitting."
 885   (interactive)
 886   (let ((command-window (liece-get-buffer-window liece-command-buffer))
 887         (dialogue-window (liece-get-buffer-window liece-dialogue-buffer))
 888         (obuffer (current-buffer)))
 889     (if (and command-window dialogue-window)
 890         (let ((ch (window-height command-window))
 891               (dh (window-height dialogue-window)))
 892           (delete-window command-window)
 893           (pop-to-buffer liece-dialogue-buffer)
 894           (enlarge-window (+ ch dh (- dh))))
 895       (pop-to-buffer liece-dialogue-buffer))
 896     (liece-configure-windows)
 897     (if liece-one-buffer-mode
 898         (pop-to-buffer liece-dialogue-buffer)
 899       (pop-to-buffer obuffer))))
 900
 901 (defun liece-command-end-of-buffer ()
 902   "Get end of the dialogue buffer."
 903   (interactive)
 904   (let (buffer window)
 905     (setq buffer (if liece-channel-buffer-mode
 906                      liece-channel-buffer
 907                    liece-dialogue-buffer))
 908     (or (setq window (liece-get-buffer-window buffer))
 909         (setq window (liece-get-buffer-window liece-dialogue-buffer)
 910               buffer liece-dialogue-buffer))
 911     (when window
 912       (save-selected-window
 913         (select-window window)
 914         (goto-char (point-max))))))
 915
 916 (defun liece-command-private-conversation (arg)
 917   "Toggle between private conversation mode and channel mode.
 918 User can then join and part to a private conversation as he would
 919 join or part to a channel.
 920
 921 If there are no private conversations or argument is given user is
 922 prompted the partner/channel (return as partner/channel means toggle
 923 mode, the current channel and current chat partner are not altered)
 924 Argument ARG is prefix argument of toggle status."
 925   (interactive
 926    (let ((completion-ignore-case t))
 927      (list
 928       (if current-prefix-arg
 929           ;; prefixed, ask where to continue
 930           (if (eq liece-command-buffer-mode 'chat)
 931               (liece-minibuffer-completing-read
 932                (_ "Return to channel: ")
 933                (append liece-channel-alist liece-nick-alist)
 934                nil nil nil nil liece-current-channel)
 935             (completing-read
 936              (_ "Start private conversation with: ")
 937              liece-nick-alist nil nil))
 938         ;; no prefix, see if going to chat
 939         (if (eq liece-command-buffer-mode 'channel)
 940             ;; and if we have chat partner, select that
 941             (if liece-current-chat-partner
 942                 liece-current-chat-partner
 943               (completing-read
 944                (_ "Start private conversation with: ")
 945                liece-nick-alist )))))))
 946
 947   (liece-toggle-command-buffer-mode)
 948   (if (and arg (not (string-equal arg "")))
 949       (liece-command-join arg))
 950   (liece-set-channel-indicator)
 951   ;; refresh mode line
 952   (force-mode-line-update))
 953
 954 (defun liece-command-next-channel ()
 955   "Select next channel or chat partner, and *DONT* rotate list."
 956   (interactive)
 957   (let ((rest (copy-sequence
 958                (if (eq liece-command-buffer-mode 'chat)
 959                    liece-current-chat-partners
 960                  liece-current-channels)))
 961         (chnl (if (eq liece-command-buffer-mode 'chat)
 962                   liece-current-chat-partner
 963                 liece-current-channel)))
 964     (liece-switch-to-channel
 965      (or (cadr (liece-channel-member chnl (delq nil rest)))
 966          (car (delq nil rest))
 967          chnl))))
 968
 969 (defun liece-command-previous-channel ()
 970   "Select previous channel or chat partner, and *DONT* rotate list."
 971   (interactive)
 972   (let ((rest
 973          (reverse
 974           (if (eq liece-command-buffer-mode 'chat)
 975               liece-current-chat-partners
 976             liece-current-channels)))
 977         (chnl
 978          (if (eq liece-command-buffer-mode 'chat)
 979              liece-current-chat-partner
 980            liece-current-channel)))
 981     (liece-switch-to-channel
 982      (or (cadr (liece-channel-member chnl (delq nil rest)))
 983          (car (delq nil rest))
 984          chnl))))
 985
 986 (defun liece-command-unread-channel ()
 987   "Select unread channel or chat partner."
 988   (interactive)
 989   (let ((chnl (car liece-channel-unread-list)))
 990     (if chnl
 991         (liece-switch-to-channel chnl)
 992       (liece-message (_ "No unread channel or chat partner.")))))
 993
 994 (defun liece-command-push ()
 995   "Select next channel or chat partner, and rotate list."
 996   (interactive)
 997   (let* ((rest
 998           (if (eq liece-command-buffer-mode 'chat)
 999               liece-current-chat-partners
1000             liece-current-channels))
1001          (temp (car (last rest)))
1002          (len (length rest)))
1003     (unwind-protect
1004         (while (< 1 len)
1005           (setcar (nthcdr (1- len) rest) (nth (- len 2) rest))
1006           (decf len))
1007       (when rest
1008         (setcar rest temp)))
1009     (liece-channel-change)))
1010
1011 (defun liece-command-pop ()
1012   "Select previous channel or chat partner, and rotate list."
1013   (interactive)
1014   (let* ((rest
1015           (if (eq liece-command-buffer-mode 'chat)
1016               liece-current-chat-partners
1017             liece-current-channels))
1018          (temp (car rest))
1019          (len (length rest)))
1020     (unwind-protect
1021         (dotimes (i len)
1022           (setcar (nthcdr i rest) (nth (1+ i) rest)))
1023       (when rest
1024         (setcar (last rest) temp)))
1025     (liece-channel-change)))
1026
1027 (defvar liece-redisplay-buffer-functions
1028   '(liece-channel-redisplay-buffer
1029     liece-nick-redisplay-buffer
1030     liece-channel-list-redisplay-buffer))
1031
1032 (defun liece-switch-to-channel (chnl)
1033   "Switch the current channel to CHNL."
1034   (if (liece-channel-p (liece-channel-real chnl))
1035       (progn
1036         (liece-toggle-command-buffer-mode 'channel)
1037         (setq liece-current-channel chnl)
1038         (liece-set-channel-indicator))
1039     (liece-toggle-command-buffer-mode 'chat)
1040     (setq liece-current-chat-partner chnl)
1041     (liece-set-channel-indicator))
1042   (save-excursion
1043     (run-hook-with-args 'liece-redisplay-buffer-functions chnl)))
1044
1045 (defun liece-switch-to-channel-no (num)
1046   "Switch the current channel to NUM."
1047   (let* ((mode liece-command-buffer-mode)
1048          (chnls (if (eq mode 'chat)
1049                     liece-current-chat-partners
1050                   liece-current-channels)))
1051     (if (and (integerp num)
1052              (stringp (nth num chnls)))
1053         (let ((chnl (nth num chnls)))
1054           (if (eq mode 'chat)
1055               (progn
1056                 (liece-toggle-command-buffer-mode 'chat)
1057                 (setq liece-current-chat-partner chnl)
1058                 (liece-set-channel-indicator))
1059             (liece-toggle-command-buffer-mode 'channel)
1060             (setq liece-current-channel chnl)
1061             (liece-set-channel-indicator))
1062           (save-excursion
1063             (run-hook-with-args 'liece-redisplay-buffer-functions chnl)))
1064       (message "Invalid channel!"))))
1065
1066 (defun liece-command-ping ()
1067   "Send PING to server."
1068   (interactive)
1069   (if (stringp liece-server-name)
1070       (liece-send "PING %s" liece-server-name)))
1071
1072 (defun liece-command-ison (nicks)
1073   "IsON users NICKS."
1074   (interactive
1075    (let (nicks (completion-ignore-case t))
1076      (setq nicks (liece-minibuffer-completing-read-multiple
1077                   "IsON" liece-nick-alist))
1078      (list nicks)))
1079   (liece-send "ISON :%s" (mapconcat #'identity nicks " ")))
1080
1081 (defun liece-command-activate-friends (nicks)
1082   "Register NICKS to the frinends list."
1083   (interactive
1084    (let (nicks (completion-ignore-case t))
1085      (setq nicks
1086            (liece-minibuffer-completing-read-multiple
1087             (_ "Friend")
1088             (filter-elements nick liece-nick-alist
1089               (not (string-list-member-ignore-case
1090                     (car nick) liece-friends)))))
1091      (list nicks)))
1092   (setq liece-friends (append nicks liece-friends)))
1093
1094 (defun liece-command-deactivate-friends ()
1095   "Clear current friends list."
1096   (interactive)
1097   (setq liece-friends nil))
1098
1099 (defun liece-command-display-friends ()
1100   "Display status of the friends."
1101   (interactive)
1102   (with-output-to-temp-buffer " *IRC Friends*"
1103     (set-buffer standard-output)
1104     (insert "Friends status: \n\n")
1105     (dolist (friend liece-friends)
1106       (if (string-list-member-ignore-case friend liece-friends-last)
1107           (insert "+ " friend "\n")
1108         (insert "- " friend "\n")))))
1109
1110 (defun liece-command-show-last-kill ()
1111   "Dig last kill from KILL and show it."
1112   (interactive)
1113   (liece-insert-info
1114    (append liece-D-buffer liece-O-buffer)
1115    (save-excursion
1116      (set-buffer liece-KILLS-buffer)
1117      (goto-char (point-max))
1118      (forward-line -1)
1119      (concat (buffer-substring (point) (point-max)) "\n"))))
1120
1121 (defun liece-command-toggle-private ()
1122   "Toggle private mode / channel mode."
1123   (interactive)
1124   (case (prog1 liece-command-buffer-mode
1125           (liece-toggle-command-buffer-mode))
1126     (chat
1127      (if liece-current-channel
1128          (liece-switch-to-channel liece-current-channel))
1129      (setq liece-command-buffer-mode-indicator "Channels"))
1130     (channel
1131      (if liece-current-chat-partner
1132          (liece-switch-to-channel liece-current-chat-partner))
1133      (setq liece-command-buffer-mode-indicator "Partners")))
1134   (liece-channel-change))
1135
1136 (defun liece-command-tag-region (start end)
1137   "Move current region between START and END to `kill-ring'."
1138   (interactive
1139    (if (region-active-p)
1140        (list (region-beginning)(region-end))
1141      (list (line-beginning-position)(line-end-position))))
1142   (static-if (fboundp 'extent-property)
1143       (kill-ring-save start end)
1144     (let ((start (set-marker (make-marker) start))
1145           (end (set-marker (make-marker) end))
1146           (inhibit-read-only t)
1147           buffer-read-only
1148           buffer-undo-list)
1149       (liece-remove-properties-region start end)
1150       (kill-ring-save start end)
1151       (push nil buffer-undo-list)
1152       (undo))))
1153
1154 (provide 'liece-commands)
1155
1156 ;;; liece-commands.el ends here