lisp/liece.el

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