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