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           (if (listp (cdr entry))
 350               (setq liece-server (cdr entry))
 351             (setq liece-server (liece-server-parse-string (cdr entry))))
 352         (let ((plist (liece-server-parse-string liece-server)))
 353           (set-alist 'liece-server-alist liece-server plist)
 354           (setq liece-save-variables-are-dirty t)
 355           (setq liece-server 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     (setq liece-server-process (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   (let ((liece-tcp-connection-type type)
 485         process)
 486     (as-binary-process
 487      (setq process
 488            (liece-open-network-stream
 489             "IRC" " *IRC*" host (or service "irc"))))
 490     (setq liece-server-buffer (process-buffer process))
 491     (save-excursion
 492       (set-buffer liece-server-buffer)
 493       (set-buffer-multibyte nil)
 494       (kill-all-local-variables)
 495       (buffer-disable-undo)
 496       (erase-buffer))
 497     process))
 498
 499 (defun liece-initialize-timers ()
 500   "Initialise internal timers."
 501   (dolist (timer liece-timers)
 502     (if (caddr timer)
 503         (cancel-timer (caddr timer))
 504       (let ((handler (car timer)) (interval (cadr timer)))
 505         (and (liece-functionp handler)
 506              (symbolp interval) (boundp interval)
 507              (setq interval (symbol-value interval))
 508              (setcdr (cdr timer)
 509                      (list (run-at-time 1 interval handler)))))))
 510   (setq liece-timers-list-initialized-p t))
 511
 512 (defun liece-read-variables-files (&optional file)
 513   "Read variables FILEs."
 514   (and (not (file-directory-p liece-directory))
 515        (file-exists-p liece-directory)
 516        (yes-or-no-p "Upgrade the location of the data files? ")
 517        (let ((file
 518               (expand-file-name
 519                (make-temp-name "liece") temporary-file-directory)))
 520          (unwind-protect
 521              (progn
 522                (rename-file liece-directory file 'ok-if-exists)
 523                (make-directory liece-directory)
 524                (copy-file file (expand-file-name
 525                                 (file-name-nondirectory liece-variables-file)
 526                                 liece-directory)))
 527            (ignore-errors (delete-file file)))))
 528   (or (file-directory-p liece-directory)
 529       (make-directory liece-directory))
 530   (let ((files (if file
 531                    (progn
 532                      (setq liece-variables-file file
 533                            liece-variables-files (list file)))
 534                  liece-variables-files)))
 535     (dolist (file files)
 536       (if (file-readable-p (expand-file-name file))
 537           (load (expand-file-name file) t)))))
 538
 539 ;;;###autoload
 540 (defun liece (&optional confirm)
 541   "Connect to the IRC server and start chatting.
 542 If optional argument CONFIRM is non-nil, ask which IRC server to connect.
 543 If already connected, just pop up the windows."
 544   (interactive "P")
 545   (liece-read-variables-files
 546    (car command-line-args-left))
 547   (pop command-line-args-left)
 548   (run-hooks 'liece-after-load-startup-hook)
 549   ;; Save initial state of window configuration.
 550   (when (interactive-p)
 551     (liece-window-configuration-push))
 552   (unless liece-intl-message-alist
 553     (liece-intl-load-catalogue))
 554   (if (liece-server-opened)
 555       (liece-configure-windows)
 556     (unwind-protect
 557         (progn
 558           (switch-to-buffer
 559            (liece-get-buffer-create liece-command-buffer))
 560           (unless (eq major-mode 'liece-command-mode)
 561             (liece-command-mode))
 562           (unless (liece-server-opened)
 563             (liece-start-server confirm)))
 564       (if (not (liece-server-opened))
 565           (liece-command-quit)
 566         ;; IRC server is successfully open.
 567         (with-current-buffer liece-command-buffer
 568           (setq mode-line-process (concat " " (liece-server-host))))
 569         (let (buffer-read-only)
 570           (unless liece-keep-buffers
 571             (erase-buffer))
 572           (sit-for 0))
 573
 574         (liece-initialize-buffers)
 575         (liece-configure-windows)
 576         (setq liece-current-channels nil)
 577         (cond
 578          (liece-current-channel
 579           (liece-command-join liece-current-channel))
 580          (liece-startup-channel
 581           (liece-command-join liece-startup-channel))
 582          (liece-startup-channel-list
 583           (dolist (chnl liece-startup-channel-list)
 584             (if (listp chnl)
 585                 (liece-command-join (car chnl) (cadr chnl))
 586               (liece-command-join chnl)))))
 587         (unless (string-equal liece-away-message "")
 588           (liece-command-away liece-away-message))
 589         (run-hooks 'liece-startup-hook)
 590         (setq liece-obarray
 591               (or liece-obarray (make-vector liece-obarray-size nil)))
 592         (unless liece-timers-list-initialized-p
 593           (liece-initialize-timers))
 594         (liece-command-timestamp)
 595         (message (substitute-command-keys
 596                   "Type \\[describe-mode] for help"))))))
 597
 598 ;;;###liece-autoload
 599 (defun liece-command-mode ()
 600   "Major mode for Liece.  Normal edit function are available.
 601 Typing Return or Linefeed enters the current line in the dialogue.
 602 The following special commands are available:
 603 For a list of the generic commands type \\[liece-command-generic] ? RET.
 604 \\{liece-command-mode-map}"
 605   (interactive)
 606   (kill-all-local-variables)
 607
 608   (setq liece-nick-alist (list (list liece-nickname))
 609         major-mode 'liece-command-mode
 610         mode-name "Commands"
 611         liece-privmsg-partner nil
 612         liece-private-indicator nil
 613         liece-away-indicator "-"
 614         liece-beep-indicator "-"
 615         liece-freeze-indicator "-"
 616         liece-own-freeze-indicator "-"
 617         mode-line-buffer-identification
 618         (liece-mode-line-buffer-identification
 619          '("Liece: "
 620            mode-line-modified
 621            liece-private-indicator
 622            liece-away-indicator
 623            "-- " liece-current-channel " " liece-real-nickname)))
 624   (liece-suppress-mode-line-format)
 625   (use-local-map liece-command-mode-map)
 626
 627   (when liece-display-frame-title
 628     (make-local-variable 'frame-title-format)
 629     (setq frame-title-format 'liece-channel-status-indicator))
 630
 631   (unless liece-blink-parens
 632     (make-local-variable 'blink-matching-paren)
 633     (setq blink-matching-paren nil))
 634
 635   (unless liece-command-mode-syntax-table
 636     (setq liece-command-mode-syntax-table
 637           (copy-syntax-table (syntax-table)))
 638     (set-syntax-table liece-command-mode-syntax-table)
 639     (mapcar
 640      (function (lambda (c) (modify-syntax-entry c "w")))
 641      "^[]{}'`"))
 642
 643   (run-hooks 'liece-command-mode-hook))
 644
 645 ;;;###liece-autoload
 646 (defun liece-dialogue-mode ()
 647   "Major mode for displaying the IRC dialogue.
 648 All normal editing commands are turned off.
 649 Instead, these commands are available:
 650 \\{liece-dialogue-mode-map}"
 651   (kill-all-local-variables)
 652
 653   (make-local-variable 'liece-beep)
 654   (make-local-variable 'liece-beep-indicator)
 655   (make-local-variable 'liece-freeze)
 656   (make-local-variable 'liece-freeze-indicator)
 657   (make-local-variable 'liece-own-freeze)
 658   (make-local-variable 'liece-own-freeze-indicator)
 659   (make-local-variable 'tab-stop-list)
 660
 661   (setq liece-beep liece-default-beep
 662         liece-beep-indicator (if liece-beep "B" "-")
 663         liece-freeze liece-default-freeze
 664         liece-freeze-indicator (if liece-freeze "F" "-")
 665         liece-own-freeze liece-default-own-freeze
 666         liece-own-freeze-indicator (if liece-own-freeze "M" "-")
 667
 668         major-mode 'liece-dialogue-mode
 669         mode-name "Dialogue"
 670         mode-line-buffer-identification
 671         (liece-mode-line-buffer-identification
 672          '("Liece: "
 673            mode-line-modified
 674            liece-away-indicator
 675            liece-beep-indicator
 676            liece-freeze-indicator
 677            liece-own-freeze-indicator
 678            " " liece-channels-indicator " "))
 679         buffer-read-only t
 680         tab-stop-list liece-tab-stop-list)
 681   (liece-suppress-mode-line-format)
 682   (use-local-map liece-dialogue-mode-map)
 683   (buffer-disable-undo)
 684
 685   (unless liece-keep-buffers
 686     (erase-buffer))
 687
 688   (run-hooks 'liece-dialogue-mode-hook))
 689
 690 ;;;###liece-autoload
 691 (define-derived-mode liece-others-mode liece-dialogue-mode
 692   "Others"
 693   "Major mode for displaying the IRC others message except current channel.
 694 All normal editing commands are turned off.
 695 Instead, these commands are available:
 696 \\{liece-others-mode-map}")
 697
 698 ;;;###liece-autoload
 699 (define-derived-mode liece-channel-mode liece-dialogue-mode
 700   "Channel"
 701   "Major mode for displaying the IRC current channel buffer.
 702 All normal editing commands are turned off.
 703 Instead, these commands are available:
 704 \\{liece-channel-mode-map}"
 705   (setq mode-line-buffer-identification
 706         (liece-mode-line-buffer-identification
 707          '("Liece: "
 708            mode-line-modified
 709            liece-away-indicator
 710            liece-beep-indicator
 711            liece-freeze-indicator
 712            liece-own-freeze-indicator
 713            " "
 714            liece-channel-indicator))))
 715
 716 ;;;###liece-autoload
 717 (defun liece-channel-list-mode ()
 718   "Major mode for displaying channel list.
 719 All normal editing commands are turned off."
 720   (kill-all-local-variables)
 721   (setq major-mode 'liece-channel-list-mode
 722         mode-name "Channels"
 723         mode-line-buffer-identification
 724         (liece-mode-line-buffer-identification
 725          '("Liece: " liece-command-buffer-mode-indicator " "))
 726         truncate-lines t
 727         buffer-read-only t)
 728   (use-local-map liece-channel-list-mode-map)
 729   (run-hooks 'liece-channel-list-mode-hook))
 730
 731 ;;;###liece-autoload
 732 (defun liece-nick-mode ()
 733   "Major mode for displaying members in the IRC current channel buffer.
 734 All normal editing commands are turned off.
 735 Instead, these commands are available:
 736 \\{liece-nick-mode-map}"
 737   (kill-all-local-variables)
 738   (setq mode-line-modified "--- "
 739         major-mode 'liece-nick-mode
 740         mode-name "Liece Channel member"
 741         mode-line-buffer-identification
 742         (liece-mode-line-buffer-identification
 743          '("Liece: " liece-channel-indicator " "))
 744         truncate-lines t
 745         buffer-read-only t)
 746   (if (boundp 'transient-mark-mode)
 747       (set (make-local-variable 'transient-mark-mode) t))
 748   (use-local-map liece-nick-mode-map)
 749   (run-hooks 'liece-nick-mode-hook))
 750
 751 (fset 'liece-dialogue-beep 'liece-command-beep)
 752 (fset 'liece-dialogue-freeze 'liece-command-freeze)
 753 (fset 'liece-dialogue-own-freeze 'liece-command-own-freeze)
 754
 755 (defun liece-initialize-buffers ()
 756   "Initialize buffers."
 757   (dolist (spec liece-buffer-mode-alist)
 758     (let ((buffer (symbol-value (car spec)))
 759           (mode (cadr spec)))
 760       (or (get-buffer buffer)
 761           (save-excursion
 762             (set-buffer (liece-get-buffer-create buffer))
 763             (or (eq major-mode mode)
 764                 (null mode)
 765                 (funcall mode)))))))
 766
 767 ;;;###liece-autoload
 768 (defun liece-clear-system ()
 769   "Clear all Liece variables and buffers."
 770   (interactive)
 771   (dolist (buffer liece-buffer-list)
 772     (when (and (get-buffer buffer) (buffer-live-p buffer))
 773       (funcall liece-buffer-dispose-function buffer)))
 774   (if (vectorp liece-obarray)
 775       (dotimes (i liece-obarray-size)
 776         (aset liece-obarray i nil)))
 777   (dolist (timer liece-timers)
 778     (if (caddr timer)
 779         (cancel-timer (caddr timer)))
 780     (if (cdr timer)
 781         (setcdr (cdr timer) nil)))
 782   (setq liece-channel-buffer-alist nil
 783         liece-nick-buffer-alist nil
 784         liece-current-channels nil
 785         liece-current-channel nil
 786         liece-current-chat-partners nil
 787         liece-current-chat-partner nil
 788         liece-timers-list-initialized-p nil
 789         liece-friends-last nil
 790         liece-polling 0
 791         liece-channel-indicator "No channel"))
 792
 793 (defun liece-wait-for-response (regexp &optional timeout)
 794   "Wait for server response which match REGEXP.
 795 Optional argument TIMEOUT specifies connection timeout."
 796   (save-excursion
 797     (let ((status t) (wait t) (timeout (or timeout liece-connection-timeout)))
 798       (set-buffer liece-server-buffer)
 799       (with-timeout (timeout nil)
 800         (while wait
 801           (liece-accept-response)
 802           (goto-char (point-min))
 803           (cond ((looking-at "ERROR") (setq status nil wait nil))
 804                 ((looking-at ".") (setq wait nil))))
 805         ;; Save status message.
 806         (end-of-line)
 807         (setq liece-status-message-string
 808               (buffer-substring (point-min) (point)))
 809         (when status
 810           (while wait
 811             (goto-char (point-max))
 812             (forward-line -1)
 813             (if (looking-at regexp)
 814                 (setq wait 0)
 815               (liece-message (_ "Reading..."))
 816               (liece-accept-response))))
 817         ;; Successfully received server response.
 818         t))))
 819
 820 (defun liece-accept-process-output (process &optional timeout)
 821   "Wait for output from PROCESS and message some dots.
 822 Optional argument TIMEOUT specifies connection timeout."
 823   (save-excursion
 824     (set-buffer liece-server-buffer)
 825     (accept-process-output process (or timeout 1))))
 826
 827 (defun liece-accept-response ()
 828   "Read response of server.  Only used at startup time."
 829   (unless (liece-server-opened)
 830     (cond
 831      ((not liece-reconnect-automagic)
 832       (error "Liece: Connection closed"))
 833      (liece-grow-tail
 834       (let ((liece-nickname (concat liece-nickname liece-grow-tail)))
 835         (liece)))
 836      (t (liece))))
 837   (condition-case code
 838       (liece-accept-process-output liece-server-process)
 839     (error
 840      (or (string-equal "select error: Invalid argument" (nth 1 code))
 841          (signal (car code) (cdr code))))))
 842
 843 (defmacro liece-replace-internal (buffer match defstring oldstring newstring)
 844   "Helper function only used from `liece-replace'.
 845
 846 Replace in buffer or list of buffers BUFFER with matching MATCH.
 847 Argument DEFSTRING used when no matches are there.
 848 Argument OLDSTRING is replaced with NEWSTRING."
 849   `(save-excursion
 850      (set-buffer (get-buffer ,buffer))
 851      (let (buffer-read-only (inhibit-read-only t))
 852        (goto-char (point-max))
 853        (previous-line liece-compress-treshold)
 854        (save-match-data
 855          (if (not (re-search-forward ,match nil t))
 856              (liece-insert ,buffer ,defstring)
 857            (while (re-search-forward ,match nil t))
 858            (beginning-of-line)
 859            (if (re-search-forward ,oldstring nil t)
 860                (replace-match ,newstring nil t)
 861              (liece-insert ,buffer ,defstring))
 862            (liece-insert ,buffer ""))))))
 863
 864 ;;;###liece-autoload
 865 (defun liece-replace (buffer match defstring oldstring newstring)
 866   "Replace in buffer or list of buffers BUFFER with matching MATCH.
 867 Argument DEFSTRING used when no matches are there.
 868 Argument OLDSTRING is replaced with NEWSTRING."
 869   (unless (listp buffer)
 870     (setq buffer (list buffer)))
 871   (dolist (buf buffer)
 872     (when (get-buffer buf)
 873       (liece-replace-internal buf match defstring oldstring newstring))))
 874
 875 (defun liece-check-buffers ()
 876   "Check if there is a buffer larger than `liece-buffer-max-size'.
 877 If such a buffer is found, shrink it."
 878   (let ((liece-buffer-check-interval 0))
 879     (when (> liece-buffer-max-size 0)
 880       (save-excursion
 881         (dolist (buffer liece-channel-buffer-alist)
 882           (set-buffer (cdr buffer))
 883           (when (< liece-buffer-max-size (buffer-size))
 884             (let ((inhibit-read-only t)
 885                   buffer-read-only)
 886               (delete-region (point-min)
 887                              (progn
 888                                (goto-char (- (buffer-size)
 889                                              liece-buffer-default-size))
 890                                (beginning-of-line -1)
 891                                (point)))
 892               (garbage-collect)
 893               (setq liece-buffer-last-check-time (current-time)))))))))
 894
 895 (defun liece-check-buffers-if-interval-expired ()
 896   "Timer handler for `liece-check-buffers'.
 897 Only used from `liece-before-insert-functions'."
 898   (and (> liece-buffer-check-interval 0)
 899        (or (null liece-buffer-last-check-time)
 900            (> (liece-time-difference liece-buffer-last-check-time
 901                                      (current-time))
 902               liece-buffer-check-interval))
 903        (liece-check-buffers)))
 904
 905 (defun liece-refresh-buffer-window (buffer)
 906   "Center point in window of BUFFER and redisplay frame."
 907   (let ((window (liece-get-buffer-window buffer)))
 908     (when (and window (not (pos-visible-in-window-p (point-max) window)))
 909       (save-selected-window
 910         (select-window window)
 911         (goto-char (point-max))
 912         (if (null liece-scroll-step)
 913             (recenter (- (liece-window-height window) 1))
 914           (vertical-motion
 915            (- (or liece-scroll-step
 916                   (1+ (/ (liece-window-height window) 2)))
 917               (liece-window-height window)))
 918           (set-window-start window (point))
 919           (goto-char (point-max)))))))
 920
 921 (defmacro liece-save-point (&rest body)
 922   "Execute BODY, then goto the point that was around before BODY."
 923   (let ((liece-save-point (liece-gensym "lsp")))
 924     `(let ((,liece-save-point (point-marker)))
 925        (unwind-protect
 926            (progn ,@body)
 927          (goto-char ,liece-save-point)
 928          (set-marker ,liece-save-point nil)))))
 929
 930 (defvar liece-before-insert-functions
 931   '(liece-check-buffers-if-interval-expired
 932     liece-command-timestamp-if-interval-expired))
 933
 934 (defun liece-insert-internal (buffer string)
 935   "Helper function only used from `liece-insert'.
 936
 937 Insert before point of BUFFER STRING with decorating."
 938   (run-hooks 'liece-before-insert-functions)
 939   (with-current-buffer (liece-get-buffer-create buffer)
 940     (or (eq (derived-mode-class major-mode) 'liece-dialogue-mode)
 941         (liece-dialogue-mode))
 942     (liece-save-point
 943      (let ((inhibit-read-only t)
 944            buffer-read-only
 945            (from (goto-char (point-max))))
 946        (unless (liece-is-message-ignored string (current-buffer))
 947          (and liece-display-time (not (string-equal string ""))
 948               (liece-insert-time-string))
 949          (insert string)
 950          (run-hook-with-args 'liece-after-insert-functions from (point)))))
 951     (unless (liece-frozen (current-buffer))
 952       (liece-refresh-buffer-window (current-buffer)))))
 953
 954 ;;;###liece-autoload
 955 (defun liece-insert (buffer string)
 956   "Insert before point of BUFFER STRING with decorating."
 957   (or (listp buffer)
 958       (setq buffer (list buffer)))
 959   (dolist (buf buffer)
 960     (when (get-buffer buf)
 961       (liece-insert-internal buf string))))
 962
 963 (provide 'liece)
 964
 965 ;;; liece.el ends here