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