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