lisp/liece.el

   1 ;;; liece.el --- IRC client for Emacsen
   2 ;; Copyright (C) 1998-2000 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1998-09-28
   6 ;; Revised: 2000-03-20
   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 (require 'liece-inlines)
  33 (require 'liece-handle)
  34 (require 'liece-filter)
  35 (require 'liece-hilit)
  36 (require 'liece-intl)
  37 (require 'liece-menu)
  38 (require 'liece-window)
  39 (require 'liece-tcp)
  40 (if (featurep 'xemacs)
  41     (require 'liece-xemacs)
  42   (require 'liece-emacs))
  43 (require 'liece-commands)
  44
  45 (autoload 'mule-caesar-region "mule-caesar" nil t)
  46 (autoload 'liece-command-browse-url "liece-url" nil t)
  47 (autoload 'liece-command-dcc-send "liece-dcc" nil t)
  48 (autoload 'liece-command-dcc-receive "liece-dcc" nil t)
  49 (autoload 'liece-command-dcc-list "liece-dcc" nil t)
  50 (autoload 'liece-command-dcc-chat-listen "liece-dcc" nil t)
  51 (autoload 'liece-command-dcc-chat-connect "liece-dcc" nil t)
  52 (autoload 'liece-command-dcc-accept "liece-dcc" nil t)
  53 (autoload 'liece-command-mail-compose "liece-mail" nil t)
  54 (autoload 'liece-command-submit-bug-report "liece-mail" nil t)
  55
  56 (eval-and-compile
  57   (defvar liece-server-keyword-map
  58     '((:host (getenv "IRCSERVER"))
  59       (:service liece-service)
  60       (:password liece-password)
  61       (:prescript)
  62       (:prescript-delay)
  63       (:type liece-tcp-connection-type)
  64       (:relay))
  65     "Mapping from keywords to default values.
  66 All keywords that can be used must be listed here."))
  67
  68 (add-hook 'kill-emacs-hook 'liece-command-quit)
  69
  70 (defvar liece-tmp-server-name nil "Temporaly server name.")
  71 (defvar liece-buffer-last-check-time nil)
  72 (defvar liece-timers-list-initialized-p nil
  73   "Are liece internal timers in place?")
  74
  75 (defconst liece-obarray-size 1327
  76   "The size of obarray used by liece on channelname and username space.
  77 For efficiency this should be prime.  See documentation of intern and
  78 `make-vector' for more information.  Here is a list of some small primes...
  79
  80 13, 29, 37, 47, 59, 71, 89, 107, 131, 163, 197, 239, 293, 353, 431, 521,
  81 631, 761, 919, 1103, 1327, 1597, 1931, 2333, 2801, 3371, 4049, 4861, 5839,
  82 7013, 8419, 10103, 12143, 14591, 17519, 21023, 25229, 30293, 36353,
  83 43627, 52361, 62851, 75431, 90523, 108631, 130363, 156437, 187751,
  84 225307, 270371, 324449, 389357, 467237, 560689, 672827, 807403, 968897,
  85 1162687, 1395263, 1674319, 2009191, 2411033, 2893249.")
  86
  87 (defvar liece-channel-list-mode-map (make-sparse-keymap))
  88 (defvar liece-nick-mode-map (make-sparse-keymap))
  89 (defvar liece-client-query-map (make-sparse-keymap))
  90 (defvar liece-dcc-map (make-sparse-keymap))
  91 (defvar liece-friends-map (make-sparse-keymap))
  92
  93 (defvar liece-dialogue-mode-map
  94   (let ((keymap (make-keymap)))
  95     (suppress-keymap keymap 'nodigit)
  96     keymap))
  97
  98 (defvar liece-command-mode-map (make-keymap))
  99 (defvar liece-command-map (make-sparse-keymap))
 100
 101 (defvar liece-command-mode-syntax-table nil)
 102
 103 (put 'liece-command-mode 'mode-class 'special)
 104 (put 'liece-dialogue-mode 'mode-class 'special)
 105 (put 'liece-channel-list-mode 'mode-class 'special)
 106 (put 'liece-nick-mode 'mode-class 'special)
 107 (put 'liece-channel-mode 'derived-mode-parent 'liece-dialogue-mode)
 108 (put 'liece-others-mode 'derived-mode-parent 'liece-dialogue-mode)
 109
 110 (defvar liece-buffer-mode-alist
 111   '((liece-dialogue-buffer liece-dialogue-mode)
 112     (liece-others-buffer liece-others-mode)
 113     (liece-channel-list-buffer liece-channel-list-mode)
 114     (liece-private-buffer liece-dialogue-mode)
 115     (liece-KILLS-buffer)
 116     (liece-IGNORED-buffer)
 117     (liece-WALLOPS-buffer)))
 118
 119 (eval-and-compile
 120   (dotimes (n 20)
 121     (fset (intern (format "liece-switch-to-channel-no-%d" (1+ n)))
 122           `(lambda ()
 123              (interactive)
 124              (funcall #'liece-switch-to-channel-no ,n)))))
 125
 126 (defvar liece-select-keys
 127   '("1" liece-switch-to-channel-no-1
 128     "2" liece-switch-to-channel-no-2
 129     "3" liece-switch-to-channel-no-3
 130     "4" liece-switch-to-channel-no-4
 131     "5" liece-switch-to-channel-no-5
 132     "6" liece-switch-to-channel-no-6
 133     "7" liece-switch-to-channel-no-7
 134     "8" liece-switch-to-channel-no-8
 135     "9" liece-switch-to-channel-no-9
 136     "0" liece-switch-to-channel-no-10
 137     "\C-c1" liece-switch-to-channel-no-11
 138     "\C-c2" liece-switch-to-channel-no-12
 139     "\C-c3" liece-switch-to-channel-no-13
 140     "\C-c4" liece-switch-to-channel-no-14
 141     "\C-c5" liece-switch-to-channel-no-15
 142     "\C-c6" liece-switch-to-channel-no-16
 143     "\C-c7" liece-switch-to-channel-no-17
 144     "\C-c8" liece-switch-to-channel-no-18
 145     "\C-c9" liece-switch-to-channel-no-19
 146     "\C-c0" liece-switch-to-channel-no-20))
 147
 148 ;;; Keymap macros. -- borrowd from `gnus-util.el'.
 149
 150 (defmacro liece-local-set-keys (&rest plist)
 151   "Set the keys in PLIST in the current keymap."
 152   `(liece-define-keys-1 (current-local-map) ',plist))
 153
 154 (defmacro liece-define-keys (keymap &rest plist)
 155   "Assign KEYMAP keys from PLIST."
 156   `(liece-define-keys-1 ',keymap ',plist))
 157
 158 (defmacro liece-define-keys-safe (keymap &rest plist)
 159   "Assign KEYMAP keys from PLIST without overwriting previous definitions."
 160   `(liece-define-keys-1 ',keymap ',plist t))
 161
 162 (put 'liece-define-keys 'lisp-indent-function 1)
 163 (put 'liece-define-keys-safe 'lisp-indent-function 1)
 164 (put 'liece-local-set-keys 'lisp-indent-function 1)
 165
 166 (defun liece-define-keys-1 (keymap plist &optional safe)
 167   "Assign KEYMAP keys from PLIST.
 168 If optional argument SAFE is nil, overwrite previous definitions."
 169   (unless keymap
 170     (error "Can't set keys in a null keymap"))
 171   (cond
 172    ((symbolp keymap)
 173     (setq keymap (symbol-value keymap)))
 174    ((keymapp keymap))
 175    ((listp keymap)
 176     (set (car keymap) nil)
 177     (define-prefix-command (car keymap))
 178     (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap))
 179     (setq keymap (symbol-value (car keymap)))))
 180   (let (key)
 181     (while plist
 182       (when (symbolp (setq key (pop plist)))
 183         (setq key (symbol-value key)))
 184       (if (or (not safe)
 185               (eq (lookup-key keymap key) 'undefined))
 186           (define-key keymap key (pop plist))
 187         (pop plist)))))
 188
 189 (when t
 190   (liece-define-keys liece-dialogue-mode-map
 191     "\177" scroll-down
 192     [delete] scroll-down
 193     [backspace] scroll-down
 194     [return] scroll-up
 195     " " scroll-up
 196     "$" end-of-buffer
 197     "/" liece-command-generic
 198     ">" end-of-buffer
 199     "<" beginning-of-buffer
 200     "|" liece-command-show-last-kill
 201     "a" liece-command-away
 202     "b" liece-command-submit-bug-report
 203     "B" liece-dialogue-beep
 204     "c" liece-command-point-back-to-command-buffer
 205     "f" liece-command-finger
 206     "F" liece-dialogue-freeze
 207     "O" liece-dialogue-own-freeze
 208     "i" liece-command-invite
 209     "j" liece-command-join
 210     "k" liece-command-kill
 211     "\C-k" liece-command-kick
 212     "l" liece-command-list
 213     "L" liece-command-load-vars
 214     "S" liece-command-save-vars
 215     "m" liece-dialogue-enter-message
 216     "M" liece-command-modec
 217     "n" liece-command-nickname
 218     "o" other-window
 219     "p" liece-command-mta-private
 220     "P" liece-command-toggle-private
 221     "q" liece-command-quit
 222     "r" liece-command-reconfigure-windows
 223     "x" liece-command-tag-region
 224     "t" liece-command-topic
 225     "T" liece-command-timestamp
 226     "\C-t" liece-command-find-timestamp
 227     "v" liece-command-browse-url
 228     "w" liece-command-who)
 229
 230   (liece-define-keys (liece-client-query-map "\C-c" liece-dialogue-mode-map)
 231     "a" liece-command-ctcp-action
 232     "v" liece-command-ctcp-version
 233     "u" liece-command-ctcp-userinfo
 234     "h" liece-command-ctcp-help
 235     "c" liece-command-ctcp-clientinfo
 236     "g" liece-command-ctcp-generic
 237     "p" liece-command-ctcp-ping
 238     "t" liece-command-ctcp-time
 239     "x" liece-command-ctcp-x-face
 240     "X" liece-command-ctcp-x-face-from-xbm-file
 241     "U" liece-command-ctcp-userinfo-from-minibuffer)
 242
 243   (liece-define-keys (liece-dcc-map "\C-d" liece-dialogue-mode-map)
 244     "s" liece-command-dcc-send
 245     "r" liece-command-dcc-receive
 246     "l" liece-command-dcc-list
 247     "cl" liece-command-dcc-chat-listen
 248     "cc" liece-command-dcc-chat-connect
 249     "g" liece-command-dcc-accept)
 250
 251   (liece-define-keys (liece-friends-map "\C-i" liece-dialogue-mode-map)
 252     " " liece-command-ison
 253     "a" liece-command-activate-friends
 254     "d" liece-command-deactivate-friends
 255     "s" liece-command-display-friends)
 256
 257   (liece-define-keys liece-command-mode-map
 258     "\r" liece-command-enter-message
 259     [tab] liece-command-complete
 260     [(meta control c) >] liece-command-push
 261     [(meta control c) <] liece-command-pop)
 262
 263   (liece-define-keys (liece-command-map "\C-c" liece-command-mode-map)
 264     "\177" liece-command-scroll-down
 265     [delete] liece-command-scroll-down
 266     [backspace] liece-command-scroll-down
 267     " " liece-command-scroll-up
 268     "$" liece-command-end-of-buffer
 269     ">" liece-command-next-channel
 270     "<" liece-command-previous-channel
 271     "a" liece-command-away
 272     "\C-f" liece-command-freeze
 273     "\C-j" liece-command-next-channel
 274     "\C-n" liece-command-names
 275     "\C-u" liece-command-unread-channel
 276     "l" liece-command-list
 277     "L" liece-command-load-vars
 278     "M" liece-command-own-freeze
 279     "\C-m" liece-command-modec
 280     "o" liece-command-set-operators
 281     "O" liece-command-toggle-nick-buffer-mode
 282     "\C-o" liece-command-toggle-channel-buffer-mode
 283     "\C-p" liece-command-part
 284     "r" liece-command-reconfigure-windows
 285     "\C-r" mule-caesar-region
 286     "s" liece-command-set-window-style
 287     "S" liece-command-save-vars
 288     "v" liece-command-set-voices
 289     "\C-v" liece-command-browse-url
 290     "\C-y" liece-command-yank-send)
 291   (set-keymap-parent liece-command-map liece-dialogue-mode-map)
 292
 293   (liece-define-keys liece-nick-mode-map
 294     "o" liece-command-set-operators
 295     "v" liece-command-set-voices
 296     "f" liece-command-finger
 297     " " liece-command-nick-scroll-up
 298     "\177" liece-command-nick-scroll-down
 299     [delete] liece-command-nick-scroll-down
 300     [backspace] liece-command-nick-scroll-down
 301     "m" liece-command-mail-compose
 302     "c" liece-command-point-back-to-command-buffer)
 303
 304   (liece-define-keys liece-channel-list-mode-map
 305     ">" liece-command-next-channel
 306     "<" liece-command-previous-channel
 307     "u" liece-command-unread-channel
 308     "o" other-window
 309     "c" liece-command-point-back-to-command-buffer)
 310
 311   (liece-define-keys-1 liece-dialogue-mode-map liece-select-keys)
 312   (liece-define-keys-1 liece-channel-list-mode-map liece-select-keys))
 313
 314 ;;;###liece-autoload
 315 (defmacro liece-server-opened ()
 316   "Return server process status.
 317 Return non-nil if stream is opened."
 318   '(and liece-server-process
 319         (memq (process-status liece-server-process)
 320               '(open run))))
 321
 322 (defun liece-start-server (&optional confirm)
 323   "Open network stream to remote irc server.
 324 If optional argument CONFIRM is non-nil, ask the host that the server
 325 is running on."
 326   (when (or confirm
 327             (null (or liece-server
 328                       (setq liece-server (getenv "IRCSERVER")))))
 329     (setq liece-server (completing-read (_ "IRC server: ") liece-server-alist)))
 330   (unless (listp liece-server)
 331     (let ((entry (assoc liece-server liece-server-alist)))
 332       (if entry
 333           (if (listp (cdr entry))
 334               (setq liece-server (cdr entry))
 335             (setq liece-server (liece-server-parse-string (cdr entry))))
 336         (let ((plist (liece-server-parse-string liece-server)))
 337           (set-alist 'liece-server-alist liece-server plist)
 338           (setq liece-save-variables-are-dirty t)
 339           (setq liece-server plist)))))
 340   (when (or (and confirm liece-ask-for-nickname)
 341             (null liece-nickname))
 342     (setq liece-nickname (read-string (_ "Enter your nickname: ") liece-nickname)))
 343   (let ((host (liece-server-host)))
 344     (liece-message
 345      (_ "Connecting to IRC server on %s...") host)
 346     (liece-open-server liece-server liece-service)))
 347
 348 (defun liece-close-server-internal ()
 349   "Close connection to chat server."
 350   (if (liece-server-opened)
 351       (delete-process liece-server-process))
 352   (if liece-server-buffer
 353       (kill-buffer liece-server-buffer))
 354   (setq liece-server-buffer nil
 355         liece-server-process nil
 356         liece-server nil))
 357
 358 ;;;###liece-autoload
 359 (defun liece-close-server (&optional quit-string)
 360   "Close chat server."
 361   (unwind-protect
 362       (progn
 363         ;; Unset default sentinel function before closing connection.
 364         (when (and liece-server-process
 365                    (eq 'liece-sentinel
 366                        (process-sentinel liece-server-process)))
 367           (set-process-sentinel liece-server-process nil))
 368         (if (liece-server-opened)
 369             (if quit-string
 370                 (liece-send "QUIT :%s" quit-string)
 371               (liece-send "QUIT"))))
 372     (liece-close-server-internal)
 373     ;; Save settings to the `~/.liece/init.el' file.
 374     (if liece-save-variables-are-dirty
 375         (liece-command-save-vars))
 376     ;; Reset everything.
 377     (liece-clear-system)
 378     (liece-window-configuration-pop)
 379     ;; Allow the user to do things after cleaning up.
 380     (run-hooks 'liece-exit-hook)))
 381
 382 (defmacro liece-server-keyword-bind (plist &rest body)
 383   "Return a `let' form that binds all variables in PLIST.
 384 After this is done, BODY will be executed in the scope
 385 of the `let' form.
 386
 387 The variables bound and their default values are described by
 388 the `liece-server-keyword-map' variable."
 389   `(let ,(mapcar
 390           (lambda (keyword)
 391             (list (intern (substring (symbol-name (car keyword)) 1))
 392                   (if (cadr keyword)
 393                       `(or (plist-get ,plist ',(car keyword))
 394                            ,(cadr keyword))
 395                     `(plist-get ,plist ',(car keyword)))))
 396           liece-server-keyword-map)
 397      ,@body))
 398
 399 (put 'liece-server-keyword-bind 'lisp-indent-function 1)
 400 (put 'liece-server-keyword-bind 'edebug-form-spec '(form body))
 401
 402 (defun liece-server-parse-string (string)
 403   "Convert a STRING set as `liece-server' and return a property list."
 404   (when (or (string-match "^\\[\\([^]]+\\)\\]:?\\([0-9]*\\)" string)
 405             (string-match "^\\([^:]+\\):?\\([0-9]*\\)" string))
 406     (let ((host (match-string 1 string))
 407           (service (match-string 2 string))
 408           (password (substring string (match-end 0)))
 409           plist)
 410       (push `(:host ,host) plist)
 411       (unless (string= service "")
 412         (push `(:service ,(string-to-int service)) plist))
 413       (cond
 414        ((string= password ":")
 415         (setq liece-ask-for-password t))
 416        ((string= password ""))
 417        (t (push `(:password ,(substring password 1)) plist)))
 418       (apply #'nconc plist))))
 419
 420 (defun liece-open-server (host &optional service)
 421   "Open chat server on HOST.
 422 If HOST is nil, use value of environment variable \"IRCSERVER\".
 423 If optional argument SERVICE is non-nil, open by the service name."
 424   (liece-server-keyword-bind host
 425     (when prescript
 426       (if (fboundp prescript)
 427           (funcall prescript)
 428         (call-process shell-file-name nil nil nil
 429                       shell-command-switch prescript))
 430       (when prescript-delay
 431         (sleep-for prescript-delay)))
 432     (if password
 433         (setq liece-ask-for-password nil
 434               liece-password password))
 435     (if (and (memq type '(rlogin telnet)) relay)
 436         (setq liece-tcp-relay-host relay))
 437     (setq liece-tmp-server-name host)
 438     (setq liece-server-process (liece-open-server-internal host service type))
 439     (setq liece-after-registration nil)
 440     (liece-maybe-poll)
 441     (if (null (liece-wait-for-response "^:[^ ]+ [4P][5O][1N][ G]"))
 442         (progn
 443           ;; We have to close connection here, since the function
 444           ;;  `liece-server-opened' may return incorrect status.
 445           (liece-close-server-internal)
 446           (error (_ "Connection to %s timed out") host))
 447       (set-process-sentinel liece-server-process 'liece-sentinel)
 448       (set-process-filter liece-server-process 'liece-filter)
 449       (if (or liece-ask-for-password liece-reconnect-with-password)
 450           (let ((password
 451                  (liece-read-passwd (_ "Server Password: "))))
 452             (or (string= password "")
 453                 (setq liece-password password))))
 454       (if liece-password
 455           (liece-send "PASS %s" liece-password))
 456       (setq liece-reconnect-with-password nil)
 457       (liece-send "USER %s * * :%s"
 458                   (or (user-real-login-name) "Nobody")
 459                   (if (and liece-name (not (string= liece-name "")))
 460                       liece-name
 461                     "No Name"))
 462       (liece-send "NICK %s" liece-nickname)
 463       ;; We have to set `liece-real-nickname' here because IRC server doesn't
 464       ;; notify the real nickname to the user.
 465       (or liece-real-nickname
 466           (setq liece-real-nickname
 467                 (truncate-string liece-nickname liece-nick-max-length)))
 468       (setq liece-nickname-last liece-real-nickname
 469             liece-nick-accepted 'sent
 470             liece-after-registration t))))
 471
 472 (defun liece-open-server-internal (host &optional service type)
 473   "Open connection to chat server on HOST by SERVICE (default is irc).
 474 Optional argument TYPE specifies connection types such as `program'."
 475   (let ((liece-tcp-connection-type type)
 476         process)
 477     (as-binary-process
 478      (setq process
 479            (liece-open-network-stream
 480             "IRC" " *IRC*" host (or service "irc"))))
 481     (setq liece-server-buffer (process-buffer process))
 482     (save-excursion
 483       (set-buffer liece-server-buffer)
 484       (set-buffer-multibyte nil)
 485       (kill-all-local-variables)
 486       (buffer-disable-undo)
 487       (erase-buffer))
 488     process))
 489
 490 (defun liece-initialize-timers ()
 491   "Initialise internal timers."
 492   (dolist (timer liece-timers)
 493     (if (caddr timer)
 494         (cancel-timer (caddr timer))
 495       (let ((handler (car timer)) (interval (cadr timer)))
 496         (and (liece-functionp handler)
 497              (symbolp interval) (boundp interval)
 498              (setq interval (symbol-value interval))
 499              (setcdr (cdr timer)
 500                      (list (run-at-time 1 interval handler)))))))
 501   (setq liece-timers-list-initialized-p t))
 502
 503 (defun liece-read-variables-files (&optional file)
 504   "Read variables FILEs."
 505   (and (not (file-directory-p liece-directory))
 506        (file-exists-p liece-directory)
 507        (yes-or-no-p "Upgrade the location of the data files? ")
 508        (let ((file
 509               (expand-file-name
 510                (make-temp-name "liece") temporary-file-directory)))
 511          (unwind-protect
 512              (progn
 513                (rename-file liece-directory file 'ok-if-exists)
 514                (make-directory liece-directory)
 515                (copy-file file (expand-file-name
 516                                 (file-name-nondirectory liece-variables-file)
 517                                 liece-directory)))
 518            (ignore-errors (delete-file file)))))
 519   (or (file-directory-p liece-directory)
 520       (make-directory liece-directory))
 521   (let ((files (if file
 522                    (progn
 523                      (setq liece-variables-file file
 524                            liece-variables-files (list file)))
 525                  liece-variables-files)))
 526     (dolist (file files)
 527       (if (file-readable-p (expand-file-name file))
 528           (load (expand-file-name file) t)))))
 529
 530 ;;;###autoload
 531 (defun liece (&optional confirm)
 532   "Connect to the IRC server and start chatting.
 533 If optional argument CONFIRM is non-nil, ask which IRC server to connect.
 534 If already connected, just pop up the windows."
 535   (interactive "P")
 536   (liece-read-variables-files
 537    (car command-line-args-left))
 538   (pop command-line-args-left)
 539   (run-hooks 'liece-after-load-startup-hook)
 540   ;; Save initial state of window configuration.
 541   (when (interactive-p)
 542     (liece-window-configuration-push))
 543   (unless liece-intl-message-alist
 544     (liece-intl-load-catalogue))
 545   (if (liece-server-opened)
 546       (liece-configure-windows)
 547     (switch-to-buffer (liece-get-buffer-create liece-command-buffer))
 548     (unless (eq major-mode 'liece-command-mode)
 549       (liece-command-mode))
 550     (liece-start-server confirm)
 551     (let (buffer-read-only)
 552       (unless liece-keep-buffers
 553         (erase-buffer))
 554       (sit-for 0))
 555     (liece-initialize-buffers)
 556     (liece-configure-windows)
 557     (setq liece-current-channels nil)
 558     (let ((startup-channels
 559            (if liece-startup-channel
 560                (list liece-startup-channel)
 561              liece-startup-channel-list)))
 562       (dolist (chnl startup-channels)
 563         (if (listp chnl)
 564             (liece-command-join (car chnl) (cadr chnl))
 565           (liece-command-join chnl))))
 566     (unless (string-equal liece-away-message "")
 567       (liece-command-away liece-away-message))
 568     (run-hooks 'liece-startup-hook)
 569     (setq liece-obarray
 570           (or liece-obarray (make-vector liece-obarray-size nil)))
 571     (unless liece-timers-list-initialized-p
 572       (liece-initialize-timers))
 573     (liece-command-timestamp)
 574     (message (substitute-command-keys "Type \\[describe-mode] for help"))))
 575
 576 ;;;###liece-autoload
 577 (defun liece-command-mode ()
 578   "Major mode for Liece.  Normal edit function are available.
 579 Typing Return or Linefeed enters the current line in the dialogue.
 580 The following special commands are available:
 581 For a list of the generic commands type \\[liece-command-generic] ? RET.
 582 \\{liece-command-mode-map}"
 583   (interactive)
 584   (kill-all-local-variables)
 585
 586   (setq liece-nick-alist (list (list liece-nickname))
 587         major-mode 'liece-command-mode
 588         mode-name "Commands"
 589         liece-privmsg-partner nil
 590         liece-private-indicator nil
 591         liece-away-indicator "-"
 592         liece-beep-indicator "-"
 593         liece-freeze-indicator "-"
 594         liece-own-freeze-indicator "-"
 595         mode-line-buffer-identification
 596         (liece-mode-line-buffer-identification
 597          '("Liece: "
 598            mode-line-modified
 599            liece-private-indicator
 600            liece-away-indicator
 601            "-- " liece-current-channel " " liece-real-nickname)))
 602   (liece-suppress-mode-line-format)
 603   (use-local-map liece-command-mode-map)
 604
 605   (when liece-display-frame-title
 606     (make-local-variable 'frame-title-format)
 607     (setq frame-title-format 'liece-channel-status-indicator))
 608
 609   (unless liece-blink-parens
 610     (make-local-variable 'blink-matching-paren)
 611     (setq blink-matching-paren nil))
 612
 613   (unless liece-command-mode-syntax-table
 614     (setq liece-command-mode-syntax-table
 615           (copy-syntax-table (syntax-table)))
 616     (set-syntax-table liece-command-mode-syntax-table)
 617     (mapcar
 618      (lambda (c) (modify-syntax-entry c "w"))
 619      "^[]{}'`"))
 620
 621   (run-hooks 'liece-command-mode-hook))
 622
 623 ;;;###liece-autoload
 624 (defun liece-dialogue-mode ()
 625   "Major mode for displaying the IRC dialogue.
 626 All normal editing commands are turned off.
 627 Instead, these commands are available:
 628 \\{liece-dialogue-mode-map}"
 629   (kill-all-local-variables)
 630
 631   (make-local-variable 'liece-beep)
 632   (make-local-variable 'liece-beep-indicator)
 633   (make-local-variable 'liece-freeze)
 634   (make-local-variable 'liece-freeze-indicator)
 635   (make-local-variable 'liece-own-freeze)
 636   (make-local-variable 'liece-own-freeze-indicator)
 637   (make-local-variable 'tab-stop-list)
 638
 639   (setq liece-beep liece-default-beep
 640         liece-beep-indicator (if liece-beep "B" "-")
 641         liece-freeze liece-default-freeze
 642         liece-freeze-indicator (if liece-freeze "F" "-")
 643         liece-own-freeze liece-default-own-freeze
 644         liece-own-freeze-indicator (if liece-own-freeze "M" "-")
 645
 646         major-mode 'liece-dialogue-mode
 647         mode-name "Dialogue"
 648         mode-line-buffer-identification
 649         (liece-mode-line-buffer-identification
 650          '("Liece: "
 651            mode-line-modified
 652            liece-away-indicator
 653            liece-beep-indicator
 654            liece-freeze-indicator
 655            liece-own-freeze-indicator
 656            " " liece-channels-indicator " "))
 657         buffer-read-only t
 658         tab-stop-list liece-tab-stop-list)
 659   (liece-suppress-mode-line-format)
 660   (use-local-map liece-dialogue-mode-map)
 661   (buffer-disable-undo)
 662
 663   (unless liece-keep-buffers
 664     (erase-buffer))
 665
 666   (run-hooks 'liece-dialogue-mode-hook))
 667
 668 ;;;###liece-autoload
 669 (define-derived-mode liece-others-mode liece-dialogue-mode
 670   "Others"
 671   "Major mode for displaying the IRC others message except current channel.
 672 All normal editing commands are turned off.
 673 Instead, these commands are available:
 674 \\{liece-others-mode-map}")
 675
 676 ;;;###liece-autoload
 677 (define-derived-mode liece-channel-mode liece-dialogue-mode
 678   "Channel"
 679   "Major mode for displaying the IRC current channel buffer.
 680 All normal editing commands are turned off.
 681 Instead, these commands are available:
 682 \\{liece-channel-mode-map}"
 683   (setq mode-line-buffer-identification
 684         (liece-mode-line-buffer-identification
 685          '("Liece: "
 686            mode-line-modified
 687            liece-away-indicator
 688            liece-beep-indicator
 689            liece-freeze-indicator
 690            liece-own-freeze-indicator
 691            " "
 692            liece-channel-indicator))))
 693
 694 ;;;###liece-autoload
 695 (defun liece-channel-list-mode ()
 696   "Major mode for displaying channel list.
 697 All normal editing commands are turned off."
 698   (kill-all-local-variables)
 699   (setq major-mode 'liece-channel-list-mode
 700         mode-name "Channels"
 701         mode-line-buffer-identification
 702         (liece-mode-line-buffer-identification
 703          '("Liece: " liece-command-buffer-mode-indicator " "))
 704         truncate-lines t
 705         buffer-read-only t)
 706   (use-local-map liece-channel-list-mode-map)
 707   (run-hooks 'liece-channel-list-mode-hook))
 708
 709 ;;;###liece-autoload
 710 (defun liece-nick-mode ()
 711   "Major mode for displaying members in the IRC current channel buffer.
 712 All normal editing commands are turned off.
 713 Instead, these commands are available:
 714 \\{liece-nick-mode-map}"
 715   (kill-all-local-variables)
 716   (setq mode-line-modified "--- "
 717         major-mode 'liece-nick-mode
 718         mode-name "Liece Channel member"
 719         mode-line-buffer-identification
 720         (liece-mode-line-buffer-identification
 721          '("Liece: " liece-channel-indicator " "))
 722         truncate-lines t
 723         buffer-read-only t)
 724   (if (boundp 'transient-mark-mode)
 725       (set (make-local-variable 'transient-mark-mode) t))
 726   (use-local-map liece-nick-mode-map)
 727   (run-hooks 'liece-nick-mode-hook))
 728
 729 (fset 'liece-dialogue-beep 'liece-command-beep)
 730 (fset 'liece-dialogue-freeze 'liece-command-freeze)
 731 (fset 'liece-dialogue-own-freeze 'liece-command-own-freeze)
 732
 733 (defun liece-initialize-buffers ()
 734   "Initialize buffers."
 735   (dolist (spec liece-buffer-mode-alist)
 736     (let ((buffer (symbol-value (car spec)))
 737           (mode (cadr spec)))
 738       (or (get-buffer buffer)
 739           (save-excursion
 740             (set-buffer (liece-get-buffer-create buffer))
 741             (or (eq major-mode mode)
 742                 (null mode)
 743                 (funcall mode)))))))
 744
 745 ;;;###liece-autoload
 746 (defun liece-clear-system ()
 747   "Clear all Liece variables and buffers."
 748   (interactive)
 749   (dolist (buffer liece-buffer-list)
 750     (when (and (get-buffer buffer) (buffer-live-p buffer))
 751       (funcall liece-buffer-dispose-function buffer)))
 752   (if (vectorp liece-obarray)
 753       (dotimes (i liece-obarray-size)
 754         (aset liece-obarray i nil)))
 755   (dolist (timer liece-timers)
 756     (if (caddr timer)
 757         (cancel-timer (caddr timer)))
 758     (if (cdr timer)
 759         (setcdr (cdr timer) nil)))
 760   (setq liece-channel-buffer-alist nil
 761         liece-nick-buffer-alist nil
 762         liece-current-channels nil
 763         liece-current-channel nil
 764         liece-current-chat-partners nil
 765         liece-current-chat-partner nil
 766         liece-timers-list-initialized-p nil
 767         liece-friends-last nil
 768         liece-polling 0
 769         liece-channel-indicator "No channel"))
 770
 771 (defun liece-wait-for-response (regexp &optional timeout)
 772   "Wait for server response which match REGEXP.
 773 Optional argument TIMEOUT specifies connection timeout."
 774   (save-excursion
 775     (let ((status t) (wait t) (timeout (or timeout liece-connection-timeout)))
 776       (set-buffer liece-server-buffer)
 777       (with-timeout (timeout nil)
 778         (while wait
 779           (liece-accept-response)
 780           (goto-char (point-min))
 781           (cond ((looking-at "ERROR") (setq status nil wait nil))
 782                 ((looking-at ".") (setq wait nil))))
 783         ;; Save status message.
 784         (end-of-line)
 785         (setq liece-status-message-string
 786               (buffer-substring (point-min) (point)))
 787         (when status
 788           (while wait
 789             (goto-char (point-max))
 790             (forward-line -1)
 791             (if (looking-at regexp)
 792                 (setq wait 0)
 793               (liece-message (_ "Reading..."))
 794               (liece-accept-response))))
 795         ;; Successfully received server response.
 796         t))))
 797
 798 (defun liece-accept-process-output (process &optional timeout)
 799   "Wait for output from PROCESS and message some dots.
 800 Optional argument TIMEOUT specifies connection timeout."
 801   (save-excursion
 802     (set-buffer liece-server-buffer)
 803     (accept-process-output process (or timeout 1))))
 804
 805 (defun liece-accept-response ()
 806   "Read response of server.  Only used at startup time."
 807   (unless (liece-server-opened)
 808     (cond
 809      ((not liece-reconnect-automagic)
 810       (error "Liece: Connection closed"))
 811      (liece-grow-tail
 812       (let ((liece-nickname (concat liece-nickname liece-grow-tail)))
 813         (liece)))
 814      (t (liece))))
 815   (condition-case code
 816       (liece-accept-process-output liece-server-process)
 817     (error
 818      (or (string-equal "select error: Invalid argument" (nth 1 code))
 819          (signal (car code) (cdr code))))))
 820
 821 (defmacro liece-replace-internal (buffer match defstring oldstring newstring)
 822   "Helper function only used from `liece-replace'.
 823
 824 Replace in buffer or list of buffers BUFFER with matching MATCH.
 825 Argument DEFSTRING used when no matches are there.
 826 Argument OLDSTRING is replaced with NEWSTRING."
 827   `(save-excursion
 828      (set-buffer (get-buffer ,buffer))
 829      (let (buffer-read-only (inhibit-read-only t))
 830        (goto-char (point-max))
 831        (previous-line liece-compress-treshold)
 832        (save-match-data
 833          (if (not (re-search-forward ,match nil t))
 834              (liece-insert ,buffer ,defstring)
 835            (while (re-search-forward ,match nil t))
 836            (beginning-of-line)
 837            (if (re-search-forward ,oldstring nil t)
 838                (replace-match ,newstring nil t)
 839              (liece-insert ,buffer ,defstring))
 840            (liece-insert ,buffer ""))))))
 841
 842 ;;;###liece-autoload
 843 (defun liece-replace (buffer match defstring oldstring newstring)
 844   "Replace in buffer or list of buffers BUFFER with matching MATCH.
 845 Argument DEFSTRING used when no matches are there.
 846 Argument OLDSTRING is replaced with NEWSTRING."
 847   (unless (listp buffer)
 848     (setq buffer (list buffer)))
 849   (dolist (buf buffer)
 850     (when (get-buffer buf)
 851       (liece-replace-internal buf match defstring oldstring newstring))))
 852
 853 (defun liece-check-buffers ()
 854   "Check if there is a buffer larger than `liece-buffer-max-size'.
 855 If such a buffer is found, shrink it."
 856   (let ((liece-buffer-check-interval 0))
 857     (when (> liece-buffer-max-size 0)
 858       (save-excursion
 859         (dolist (buffer liece-channel-buffer-alist)
 860           (set-buffer (cdr buffer))
 861           (when (< liece-buffer-max-size (buffer-size))
 862             (let ((inhibit-read-only t)
 863                   buffer-read-only)
 864               (delete-region (point-min)
 865                              (progn
 866                                (goto-char (- (buffer-size)
 867                                              liece-buffer-min-size))
 868                                (beginning-of-line -1)
 869                                (point)))
 870               (garbage-collect)
 871               (setq liece-buffer-last-check-time (current-time)))))))))
 872
 873 (defun liece-check-buffers-if-interval-expired ()
 874   "Timer handler for `liece-check-buffers'.
 875 Only used from `liece-before-insert-functions'."
 876   (and (> liece-buffer-check-interval 0)
 877        (or (null liece-buffer-last-check-time)
 878            (> (liece-time-difference (current-time)
 879                                      liece-buffer-last-check-time)
 880               liece-buffer-check-interval))
 881        (liece-check-buffers)))
 882
 883 (defun liece-refresh-buffer-window (buffer)
 884   "Center point in window of BUFFER and redisplay frame."
 885   (let ((window (liece-get-buffer-window buffer))
 886         (last-point (point-max)))
 887     ;; skip last white spaces
 888     (while (memq (char-before last-point) '(?\n ?\t ?\ ))
 889       (setq last-point (1- last-point)))
 890     (when (and window (not (pos-visible-in-window-p last-point window)))
 891       (save-selected-window
 892         (select-window window)
 893         (goto-char last-point)
 894         (recenter (- (or liece-scroll-step 1)))))))
 895
 896 (defmacro liece-save-point (&rest body)
 897   "Execute BODY, then goto the point that was around before BODY."
 898   (let ((liece-save-point (liece-gensym "lsp")))
 899     `(let ((,liece-save-point (point-marker)))
 900        (unwind-protect
 901            (progn ,@body)
 902          (goto-char ,liece-save-point)
 903          (set-marker ,liece-save-point nil)))))
 904
 905 (defvar liece-before-insert-functions
 906   '(liece-check-buffers-if-interval-expired
 907     liece-command-timestamp-if-interval-expired))
 908
 909 (defun liece-insert-internal (buffer string)
 910   "Helper function only used from `liece-insert'.
 911
 912 Insert before point of BUFFER STRING with decorating."
 913   (run-hooks 'liece-before-insert-functions)
 914   (with-current-buffer (liece-get-buffer-create buffer)
 915     (or (eq (derived-mode-class major-mode) 'liece-dialogue-mode)
 916         (liece-dialogue-mode))
 917     (liece-save-point
 918      (let ((inhibit-read-only t)
 919            buffer-read-only
 920            (from (goto-char (point-max))))
 921        (unless (liece-is-message-ignored string (current-buffer))
 922          (and liece-display-time (not (string-equal string ""))
 923               (liece-insert-time-string))
 924          (insert string)
 925          (run-hook-with-args 'liece-after-insert-functions from (point)))))
 926     (unless (liece-frozen (current-buffer))
 927       (liece-refresh-buffer-window (current-buffer)))))
 928
 929 ;;;###liece-autoload
 930 (defun liece-insert (buffer string)
 931   "Insert before point of BUFFER STRING with decorating."
 932   (or (listp buffer)
 933       (setq buffer (list buffer)))
 934   (dolist (buf buffer)
 935     (when (get-buffer buf)
 936       (liece-insert-internal buf string))))
 937
 938 (provide 'liece)
 939
 940 ;;; liece.el ends here