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