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