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 (autoload 'liece-command-ctcp-action "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) mode)
 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           (when (= (length run) liece-compress-mode-length)
 501             (liece-command-qualify-nicks ?o run (not arg))
 502             (setq run nil)))
 503       (when run
 504         (liece-command-qualify-nicks ?o run (not arg))))))
 505
 506 (defun liece-command-set-voices (nicks &optional arg)
 507   (interactive
 508    (let ((voices (liece-channel-get-voices))
 509          (completion-ignore-case t)
 510          nicks)
 511      (if current-prefix-arg
 512          (setq nicks (liece-minibuffer-completing-read-multiple
 513                       (_ "Forbid to speak: ") (list-to-alist voices)))
 514        (setq voices (append voices (liece-channel-get-operators))
 515              nicks (liece-channel-get-nicks)
 516              nicks (filter-elements nick nicks
 517                      (not (liece-nick-member nick voices)))
 518              nicks (liece-minibuffer-completing-read-multiple
 519                     (_ "Allow to speak: ") (list-to-alist nicks))))
 520      (list nicks current-prefix-arg)))
 521   (let (run)
 522     (unwind-protect
 523         (dolist (nick nicks)
 524           (push nick run)
 525           (when (= (length run) liece-compress-mode-length)
 526             (liece-command-qualify-nicks ?v run (not arg))
 527             (setq run nil)))
 528       (when run
 529         (liece-command-qualify-nicks ?v run (not arg))))))
 530
 531 (defun liece-command-message (address message)
 532   "Send ADDRESS a private MESSAGE."
 533   (interactive
 534    (let ((completion-ignore-case t) address)
 535      (setq address
 536            (liece-channel-virtual
 537             (liece-minibuffer-completing-read
 538              (_ "Private message to: ")
 539              (append liece-nick-alist liece-channel-alist)
 540              nil nil nil nil liece-privmsg-partner)))
 541      (list address
 542            (read-string
 543             (format
 544              (_ "Private message to %s: ")
 545              address)))))
 546   (if (funcall liece-message-empty-predicate message)
 547       (progn (liece-message (_ "No text to send")) nil)
 548     (let ((chnl (liece-channel-real address)))
 549       (liece-send "PRIVMSG %s :%s" chnl message)
 550       (if (liece-channel-p chnl)
 551           (liece-own-channel-message message
 552                                      (liece-channel-virtual address))
 553         (liece-own-private-message message address)))))
 554
 555 (defun liece-command-mta-private (partner)
 556   "Send a private message (current line) to PARTNER."
 557   (interactive
 558    (let ((completion-ignore-case t))
 559      (setq liece-privmsg-partner
 560            (liece-channel-virtual
 561             (liece-minibuffer-completing-read
 562              (_ "To whom: ")
 563              (append liece-nick-alist liece-channel-alist)
 564              nil nil nil nil liece-privmsg-partner)))
 565      (list liece-privmsg-partner)))
 566   (let ((message (buffer-substring (progn (beginning-of-line) (point))
 567                                    (progn (end-of-line) (point)))))
 568     (if (> (length message) 0)
 569         (progn
 570           (liece-command-message liece-privmsg-partner message)
 571           (liece-next-line 1))
 572       (liece-message (_ "No text to send")))))
 573
 574 (defun liece-command-names (&optional expr)
 575   "List the nicknames of the current IRC users on given EXPR.
 576 With an Control-U as argument, only the current channel is listed.
 577 With - as argument, list all channels."
 578   (interactive
 579    (if (or current-prefix-arg (null liece-current-channel))
 580        (if (eq current-prefix-arg '-)
 581            (list current-prefix-arg))
 582      (let ((completion-ignore-case t) expr)
 583        (setq expr (liece-minibuffer-completing-read
 584                       (_ "Names on channel: ")
 585                       liece-channel-alist nil nil nil nil liece-current-channel))
 586        (unless (string-equal "" expr)
 587          (list expr)))))
 588   (when (or (and (eq expr '-)
 589                  (y-or-n-p
 590                   (_ "Do you really query NAMES without argument?")))
 591             (not (or expr
 592                      (if liece-current-channel
 593                          (setq expr (liece-channel-real
 594                                      liece-current-channel))))))
 595     (setq expr ""))
 596   (when expr
 597     (liece-send "NAMES %s" expr)))
 598
 599 (defun liece-command-nickname (nick)
 600   "Set your nickname to NICK."
 601   (interactive "sEnter your nickname: ")
 602   (let ((nickname (truncate-string nick liece-nick-max-length)))
 603     (if (zerop (length nickname))
 604         (liece-message (_ "illegal nickname \"%s\"; not changed") nickname)
 605       (liece-send "NICK %s" nick))))
 606
 607 (defun liece-command-who (&optional expr)
 608   "Lists tue users that match the given expression EXPR.
 609 If you enter only Control-U as argument, list the current channel.
 610 With - as argument, list all users."
 611   (interactive
 612    (if (or current-prefix-arg (null liece-current-channel))
 613        (if (eq current-prefix-arg '-)
 614            (list current-prefix-arg))
 615      (let ((completion-ignore-case t) expr)
 616        (setq expr (completing-read
 617                    (_ "WHO expression: ")
 618                    (append liece-channel-alist liece-nick-alist)))
 619        (unless (string-equal "" expr)
 620          (list expr)))))
 621   (when (or (and (eq expr '-)
 622                  (y-or-n-p
 623                   (_ "Do you really query WHO without argument?")))
 624             (not (or expr
 625                      (if liece-current-channel
 626                          (setq expr (liece-channel-real
 627                                      liece-current-channel))))))
 628     (setq expr ""))
 629   (when expr
 630     (liece-send "WHO %s" expr)
 631     (setq liece-who-expression expr)))
 632
 633 (defun liece-command-finger (finger-nick-var &optional server)
 634   "Get information about a specific user FINGER-NICK-VAR.
 635 If called with optional argument SERVER or any prefix argument,
 636 query information to the foreign server."
 637   (interactive
 638    (let (finger-nick-var (completion-ignore-case t))
 639      (setq finger-nick-var
 640            (completing-read (_ "Finger whom: ") liece-nick-alist))
 641      (list finger-nick-var (and current-prefix-arg finger-nick-var))))
 642   (if server
 643       (liece-send "WHOIS %s %s" server finger-nick-var)
 644     (liece-send "WHOIS %s" finger-nick-var)))
 645
 646 (defun liece-command-topic (topic)
 647   "Change TOPIC of the current channel."
 648   (interactive
 649    (list (read-from-minibuffer
 650           "Topic: " (cons (or (liece-channel-get-topic) "") 0))))
 651   (liece-send "TOPIC %s :%s"
 652               (liece-channel-real liece-current-channel) topic))
 653
 654 (defun liece-command-invite (&optional invite-nick-var invite-channel-var)
 655   "Invite INVITE-NICK-VAR to INVITE-CHANNEL-VAR."
 656   (interactive
 657    (let ((completion-ignore-case t) invite-channel-var invite-nick-var)
 658      (if current-prefix-arg
 659          (setq invite-channel-var
 660                (liece-channel-virtual
 661                 (completing-read
 662                  (_ "Invite channel: ")
 663                  (list-to-alist liece-current-channels)))))
 664      (setq invite-nick-var
 665            (completing-read
 666             (_ "Invite whom: ")
 667             liece-nick-alist))
 668      (list invite-nick-var invite-channel-var)))
 669   (or invite-channel-var
 670       (setq invite-channel-var liece-current-channel))
 671   (liece-send "INVITE %s %s"
 672                invite-nick-var (liece-channel-real invite-channel-var)))
 673
 674 (defun liece-command-away (awaymsg)
 675   "Mark/unmark yourself as being away.
 676 Leave message AWAYMSG."
 677   (interactive "sAway message: ")
 678   (liece-send "AWAY :%s" awaymsg)
 679   (setq liece-away-message awaymsg))
 680
 681 (defun liece-command-scroll-down (lines)
 682   "Scroll LINES down dialogue buffer from command buffer."
 683   (interactive "P")
 684   (let ((other-window-scroll-buffer
 685          (if liece-channel-buffer-mode
 686              liece-channel-buffer
 687            liece-dialogue-buffer)))
 688     (when (liece-get-buffer-window other-window-scroll-buffer)
 689       (condition-case nil
 690           (scroll-other-window-down lines)
 691         (beginning-of-buffer
 692          (message "Beginning of buffer"))))))
 693
 694 (defun liece-command-scroll-up (lines)
 695   "Scroll LINES up dialogue buffer from command buffer."
 696   (interactive "P")
 697   (let* ((other-window-scroll-buffer
 698           (if liece-channel-buffer-mode
 699               liece-channel-buffer
 700             liece-dialogue-buffer)))
 701     (when (liece-get-buffer-window other-window-scroll-buffer)
 702       (condition-case nil
 703           (scroll-other-window lines)
 704         (end-of-buffer
 705          (message "End of buffer"))))))
 706
 707 (defun liece-command-nick-scroll-down (lines)
 708   "Scroll LINES down nick buffer from command buffer."
 709   (interactive "P")
 710   (let ((other-window-scroll-buffer liece-nick-buffer))
 711     (when (liece-get-buffer-window other-window-scroll-buffer)
 712       (condition-case nil
 713           (scroll-other-window-down lines)
 714         (beginning-of-buffer
 715          (message "Beginning of buffer"))))))
 716
 717 (defun liece-command-nick-scroll-up (lines)
 718   "Scroll LINES up nick buffer from command buffer."
 719   (interactive "P")
 720   (let* ((other-window-scroll-buffer liece-nick-buffer))
 721     (when (liece-get-buffer-window other-window-scroll-buffer)
 722       (condition-case nil
 723           (scroll-other-window lines)
 724         (end-of-buffer
 725          (message "End of buffer"))))))
 726
 727 (defun liece-command-freeze (&optional arg)
 728   "Prevent automatic scrolling of the dialogue window.
 729 If prefix argument ARG is non-nil, toggle frozen status."
 730   (interactive "P")
 731   (liece-freeze (if liece-channel-buffer-mode
 732                     liece-channel-buffer
 733                   liece-dialogue-buffer)
 734                 (if arg (prefix-numeric-value arg))))
 735
 736 (defun liece-command-own-freeze (&optional arg)
 737   "Prevent automatic scrolling of the dialogue window.
 738 The difference from `liece-command-freeze' is that your messages are hidden.
 739 If prefix argument ARG is non-nil, toggle frozen status."
 740   (interactive "P")
 741   (liece-own-freeze (if liece-channel-buffer-mode
 742                         liece-channel-buffer
 743                       liece-dialogue-buffer)
 744                     (if arg (prefix-numeric-value arg))))
 745
 746 (defun liece-command-beep (&optional arg)
 747   "Toggle the automatic beep notice when the channel message is received."
 748   (interactive "P")
 749   (liece-set-beep (if liece-channel-buffer-mode
 750                       liece-channel-buffer
 751                     liece-dialogue-buffer)
 752                   (if arg (prefix-numeric-value arg))))
 753
 754 (defun liece-command-quit (&optional arg)
 755   "Quit IRC.
 756 If prefix argument ARG is non-nil, leave signoff message."
 757   (interactive "P")
 758   (when (and (liece-server-opened)
 759              (y-or-n-p (_ "Quit IRC? ")))
 760     (message "")
 761     (let ((quit-string
 762            (if arg (read-string (_ "Signoff message: "))
 763              (or liece-signoff-message
 764                  (product-name (product-find 'liece-version))))))
 765       (liece-close-server quit-string))))
 766
 767 (defun liece-command-generic (message)
 768   "Enter a generic IRC MESSAGE, which is sent to the server.
 769 A ? lists the useful generic messages."
 770   (interactive "sIRC command (? to help): ")
 771   (if (string-equal message "?")
 772       (with-output-to-temp-buffer "*IRC Help*"
 773         (princ "The following generic IRC messages may be of interest to you:
 774 TOPIC <new topic>               set the topic of your channel
 775 INVITE <nickname>               invite another user to join your channel
 776 LINKS                           lists the currently reachable IRC servers
 777 SUMMON <user@host>              invites an user not currently in IRC
 778 USERS <host>                    lists the users on a host
 779 AWAY <reason>                   marks you as not really actively using IRC
 780                                 (an empty reason clears it)
 781 WALL <message>                  send to everyone on IRC
 782 NAMES <channel>                 lists users per channel
 783 "))
 784     (liece-send "%s" message)))
 785
 786 (defun liece-command-irc-compatible ()
 787   "If entered at column 0, allow you to enter a generic IRC message."
 788   (interactive)
 789   (if (zerop (current-column))
 790       (call-interactively (function liece-command-generic))
 791     (self-insert-command 1)))
 792
 793 (defun liece-command-yank-send (&optional arg)
 794   "Send message from yank buffer.
 795 Prefix argument ARG is regarded as distance from yank pointer."
 796   (interactive)
 797   (when (y-or-n-p (_ "Really SEND from Yank Buffer?"))
 798     (save-restriction
 799       (narrow-to-region (point) (point))
 800       (insert (car kill-ring-yank-pointer))
 801       (goto-char (point-min))
 802       (while (eobp)
 803         (liece-command-enter-message)
 804         (set-buffer liece-command-buffer)))))
 805
 806 (defun liece-command-complete ()
 807   "Complete word before point from userlist."
 808   (interactive)
 809   (let ((completion-ignore-case t)
 810         (alist (if liece-current-channel
 811                    (list-to-alist (liece-channel-get-nicks))
 812                  liece-nick-alist))
 813         candidate completion all)
 814     (setq candidate (current-word)
 815           completion (try-completion candidate alist)
 816           all (all-completions candidate alist))
 817     (liece-minibuffer-finalize-completion completion candidate all)))
 818
 819 (defun liece-command-load-vars ()
 820   "Load configuration from liece-variables-file."
 821   (interactive)
 822   (let ((nick liece-real-nickname))
 823     (unwind-protect
 824         (liece-read-variables-files)
 825       (setq liece-real-nickname nick)
 826       (liece-command-reconfigure-windows))))
 827
 828 (defun liece-command-save-vars ()
 829   "Save current settings to `liece-variables-file'."
 830   (interactive)
 831   (let* ((output-buffer
 832           (find-file-noselect
 833            (expand-file-name liece-variables-file)))
 834          output-marker p)
 835     (save-excursion
 836       (set-buffer output-buffer)
 837       (goto-char (point-min))
 838       (cond ((re-search-forward "^;; Saved Settings *\n" nil 'move)
 839              (setq p (match-beginning 0))
 840              (goto-char p)
 841              (or (re-search-forward
 842                   "^;; End of Saved Settings *\\(\n\\|\\'\\)" nil t)
 843                  (error
 844                   (concat "can't find END of saved state in "
 845                           liece-variables-file)))
 846              (delete-region p (match-end 0)))
 847             (t
 848              (goto-char (point-max))
 849              (insert "\n")))
 850       (setq output-marker (point-marker))
 851       (let ((print-readably t)
 852             (print-escape-newlines t)
 853             (standard-output output-marker))
 854         (princ ";; Saved Settings\n")
 855         (dolist (var liece-saved-forms)
 856           (if (symbolp var)
 857               (prin1 (list 'setq var
 858                            (let ((val (symbol-value var)))
 859                              (if (memq val '(t nil))
 860                                  val
 861                                (list 'quote val)))))
 862             (setq var (eval var))
 863             (cond ((eq (car-safe var) 'progn)
 864                    (while (setq var (cdr var))
 865                      (prin1 (car var))
 866                      (princ "\n")
 867                      (if (cdr var) (princ "  "))))
 868                   (var
 869                    (prin1 "xx")(prin1 var))))
 870           (if var (princ "\n")))
 871         (princ "\n")
 872         (princ ";; End of Saved Settings\n")))
 873     (set-marker output-marker nil)
 874     (save-excursion
 875       (set-buffer output-buffer)
 876       (save-buffer)))
 877   (setq liece-save-variables-are-dirty nil))
 878
 879 (defun liece-command-reconfigure-windows ()
 880   "Rearrange window splitting."
 881   (interactive)
 882   (let ((command-window (liece-get-buffer-window liece-command-buffer))
 883         (dialogue-window (liece-get-buffer-window liece-dialogue-buffer))
 884         (obuffer (current-buffer)))
 885     (if (and command-window dialogue-window)
 886         (let ((ch (window-height command-window))
 887               (dh (window-height dialogue-window)))
 888           (delete-window command-window)
 889           (pop-to-buffer liece-dialogue-buffer)
 890           (enlarge-window (+ ch dh (- dh))))
 891       (pop-to-buffer liece-dialogue-buffer))
 892     (liece-configure-windows)
 893     (if liece-one-buffer-mode
 894         (pop-to-buffer liece-dialogue-buffer)
 895       (pop-to-buffer obuffer))))
 896
 897 (defun liece-command-end-of-buffer ()
 898   "Get end of the dialogue buffer."
 899   (interactive)
 900   (let (buffer window)
 901     (setq buffer (if liece-channel-buffer-mode
 902                      liece-channel-buffer
 903                    liece-dialogue-buffer))
 904     (or (setq window (liece-get-buffer-window buffer))
 905         (setq window (liece-get-buffer-window liece-dialogue-buffer)
 906               buffer liece-dialogue-buffer))
 907     (when window
 908       (save-selected-window
 909         (select-window window)
 910         (goto-char (point-max))))))
 911
 912 (defun liece-command-private-conversation (arg)
 913   "Toggle between private conversation mode and channel mode.
 914 User can then join and part to a private conversation as he would
 915 join or part to a channel.
 916
 917 If there are no private conversations or argument is given user is
 918 prompted the partner/channel (return as partner/channel means toggle
 919 mode, the current channel and current chat partner are not altered)
 920 Argument ARG is prefix argument of toggle status."
 921   (interactive
 922    (let ((completion-ignore-case t))
 923      (list
 924       (if current-prefix-arg
 925           ;; prefixed, ask where to continue
 926           (if (eq liece-command-buffer-mode 'chat)
 927               (liece-minibuffer-completing-read
 928                (_ "Return to channel: ")
 929                (append liece-channel-alist liece-nick-alist)
 930                nil nil nil nil liece-current-channel)
 931             (completing-read
 932              (_ "Start private conversation with: ")
 933              liece-nick-alist nil nil))
 934         ;; no prefix, see if going to chat
 935         (if (eq liece-command-buffer-mode 'channel)
 936             ;; and if we have chat partner, select that
 937             (if liece-current-chat-partner
 938                 liece-current-chat-partner
 939               (completing-read
 940                (_ "Start private conversation with: ")
 941                liece-nick-alist )))))))
 942
 943   (liece-toggle-command-buffer-mode)
 944   (if (and arg (not (string-equal arg "")))
 945       (liece-command-join arg))
 946   (liece-set-channel-indicator)
 947   ;; refresh mode line
 948   (force-mode-line-update))
 949
 950 (defun liece-command-next-channel ()
 951   "Select next channel or chat partner, and *DONT* rotate list."
 952   (interactive)
 953   (let ((rest (copy-sequence
 954                (if (eq liece-command-buffer-mode 'chat)
 955                    liece-current-chat-partners
 956                  liece-current-channels)))
 957         (chnl (if (eq liece-command-buffer-mode 'chat)
 958                   liece-current-chat-partner
 959                 liece-current-channel)))
 960     (liece-switch-to-channel
 961      (or (cadr (liece-channel-member chnl (delq nil rest)))
 962          (car (delq nil rest))
 963          chnl))))
 964
 965 (defun liece-command-previous-channel ()
 966   "Select previous channel or chat partner, and *DONT* rotate list."
 967   (interactive)
 968   (let ((rest
 969          (reverse
 970           (if (eq liece-command-buffer-mode 'chat)
 971               liece-current-chat-partners
 972             liece-current-channels)))
 973         (chnl
 974          (if (eq liece-command-buffer-mode 'chat)
 975              liece-current-chat-partner
 976            liece-current-channel)))
 977     (liece-switch-to-channel
 978      (or (cadr (liece-channel-member chnl (delq nil rest)))
 979          (car (delq nil rest))
 980          chnl))))
 981
 982 (defun liece-command-unread-channel ()
 983   "Select unread channel or chat partner."
 984   (interactive)
 985   (let ((chnl (car liece-channel-unread-list)))
 986     (if chnl
 987         (liece-switch-to-channel chnl)
 988       (liece-message (_ "No unread channel or chat partner.")))))
 989
 990 (defun liece-command-push ()
 991   "Select next channel or chat partner, and rotate list."
 992   (interactive)
 993   (let* ((rest
 994           (if (eq liece-command-buffer-mode 'chat)
 995               liece-current-chat-partners
 996             liece-current-channels))
 997          (temp (car (last rest)))
 998          (len (length rest)))
 999     (unwind-protect
1000         (while (< 1 len)
1001           (setcar (nthcdr (1- len) rest) (nth (- len 2) rest))
1002           (decf len))
1003       (when rest
1004         (setcar rest temp)))
1005     (liece-channel-change)))
1006
1007 (defun liece-command-pop ()
1008   "Select previous channel or chat partner, and rotate list."
1009   (interactive)
1010   (let* ((rest
1011           (if (eq liece-command-buffer-mode 'chat)
1012               liece-current-chat-partners
1013             liece-current-channels))
1014          (temp (car rest))
1015          (len (length rest)))
1016     (unwind-protect
1017         (dotimes (i len)
1018           (setcar (nthcdr i rest) (nth (1+ i) rest)))
1019       (when rest
1020         (setcar (last rest) temp)))
1021     (liece-channel-change)))
1022
1023 (defvar liece-redisplay-buffer-functions
1024   '(liece-channel-redisplay-buffer
1025     liece-nick-redisplay-buffer
1026     liece-channel-list-redisplay-buffer))
1027
1028 (defun liece-switch-to-channel (chnl)
1029   "Switch the current channel to CHNL."
1030   (if (liece-channel-p (liece-channel-real chnl))
1031       (progn
1032         (liece-toggle-command-buffer-mode 'channel)
1033         (setq liece-current-channel chnl)
1034         (liece-set-channel-indicator))
1035     (liece-toggle-command-buffer-mode 'chat)
1036     (setq liece-current-chat-partner chnl)
1037     (liece-set-channel-indicator))
1038   (save-excursion
1039     (run-hook-with-args 'liece-redisplay-buffer-functions chnl)))
1040
1041 (defun liece-switch-to-channel-no (num)
1042   "Switch the current channel to NUM."
1043   (let* ((mode liece-command-buffer-mode)
1044          (chnls (if (eq mode 'chat)
1045                     liece-current-chat-partners
1046                   liece-current-channels)))
1047     (if (and (integerp num)
1048              (stringp (nth num chnls)))
1049         (let ((chnl (nth num chnls)))
1050           (if (eq mode 'chat)
1051               (progn
1052                 (liece-toggle-command-buffer-mode 'chat)
1053                 (setq liece-current-chat-partner chnl)
1054                 (liece-set-channel-indicator))
1055             (liece-toggle-command-buffer-mode 'channel)
1056             (setq liece-current-channel chnl)
1057             (liece-set-channel-indicator))
1058           (save-excursion
1059             (run-hook-with-args 'liece-redisplay-buffer-functions chnl)))
1060       (message "Invalid channel!"))))
1061
1062 (defun liece-command-ping ()
1063   "Send PING to server."
1064   (interactive)
1065   (if (stringp liece-server-name)
1066       (liece-send "PING %s" liece-server-name)))
1067
1068 (defun liece-command-ison (nicks)
1069   "IsON users NICKS."
1070   (interactive
1071    (let (nicks (completion-ignore-case t))
1072      (setq nicks (liece-minibuffer-completing-read-multiple
1073                   "IsON" liece-nick-alist))
1074      (list nicks)))
1075   (liece-send "ISON :%s" (mapconcat #'identity nicks " ")))
1076
1077 (defun liece-command-activate-friends (nicks)
1078   "Register NICKS to the frinends list."
1079   (interactive
1080    (let (nicks (completion-ignore-case t))
1081      (setq nicks
1082            (liece-minibuffer-completing-read-multiple
1083             (_ "Friend")
1084             (filter-elements nick liece-nick-alist
1085               (not (string-list-member-ignore-case
1086                     (car nick) liece-friends)))))
1087      (list nicks)))
1088   (setq liece-friends (append nicks liece-friends)))
1089
1090 (defun liece-command-deactivate-friends ()
1091   "Clear current friends list."
1092   (interactive)
1093   (setq liece-friends nil))
1094
1095 (defun liece-command-display-friends ()
1096   "Display status of the friends."
1097   (interactive)
1098   (with-output-to-temp-buffer " *IRC Friends*"
1099     (set-buffer standard-output)
1100     (insert "Friends status: \n\n")
1101     (dolist (friend liece-friends)
1102       (if (string-list-member-ignore-case friend liece-friends-last)
1103           (insert "+ " friend "\n")
1104         (insert "- " friend "\n")))))
1105
1106 (defun liece-command-show-last-kill ()
1107   "Dig last kill from KILL and show it."
1108   (interactive)
1109   (liece-insert-info
1110    (append liece-D-buffer liece-O-buffer)
1111    (save-excursion
1112      (set-buffer liece-KILLS-buffer)
1113      (goto-char (point-max))
1114      (forward-line -1)
1115      (concat (buffer-substring (point) (point-max)) "\n"))))
1116
1117 (defun liece-command-toggle-private ()
1118   "Toggle private mode / channel mode."
1119   (interactive)
1120   (case (prog1 liece-command-buffer-mode
1121           (liece-toggle-command-buffer-mode))
1122     (chat
1123      (if liece-current-channel
1124          (liece-switch-to-channel liece-current-channel))
1125      (setq liece-command-buffer-mode-indicator "Channels"))
1126     (channel
1127      (if liece-current-chat-partner
1128          (liece-switch-to-channel liece-current-chat-partner))
1129      (setq liece-command-buffer-mode-indicator "Partners")))
1130   (liece-channel-change))
1131
1132 (defun liece-command-tag-region (start end)
1133   "Move current region between START and END to `kill-ring'."
1134   (interactive
1135    (if (region-active-p)
1136        (list (region-beginning)(region-end))
1137      (list (line-beginning-position)(line-end-position))))
1138   (static-if (fboundp 'extent-property)
1139       (kill-ring-save start end)
1140     (let ((start (set-marker (make-marker) start))
1141           (end (set-marker (make-marker) end))
1142           (inhibit-read-only t)
1143           buffer-read-only
1144           buffer-undo-list)
1145       (liece-remove-properties-region start end)
1146       (kill-ring-save start end)
1147       (push nil buffer-undo-list)
1148       (undo))))
1149
1150 (provide 'liece-commands)
1151
1152 ;;; liece-commands.el ends here