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