lisp/liece.el

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