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