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