1 ;;; liece.el --- IRC client for Emacsen
2 ;; Copyright (C) 1998-2000 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
7 ;; Keywords: IRC, liece
9 ;; This file is part of Liece.
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)
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.
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.
32 (require 'liece-inlines)
33 (require 'liece-handle)
34 (require 'liece-filter)
35 (require 'liece-hilit)
38 (require 'liece-window)
40 (if (featurep 'xemacs)
41 (require 'liece-xemacs)
42 (require 'liece-emacs))
43 (require 'liece-commands)
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)
57 (defvar liece-server-keyword-map
58 '((:host (getenv "IRCSERVER"))
59 (:service liece-service)
60 (:password liece-password)
63 (:type liece-tcp-connection-type)
65 "Mapping from keywords to default values.
66 All keywords that can be used must be listed here."))
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) )
73 (add-hook 'liece-before-kill-emacs-hook 'liece-command-quit)
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?")
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...
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.")
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))
98 (defvar liece-dialogue-mode-map
99 (let ((keymap (make-keymap)))
100 (suppress-keymap keymap 'nodigit)
103 (defvar liece-command-mode-map (make-keymap))
104 (defvar liece-command-map (make-sparse-keymap))
106 (defvar liece-command-mode-syntax-table nil)
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)
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)
121 (liece-IGNORED-buffer)
122 (liece-WALLOPS-buffer)))
126 (fset (intern (format "liece-switch-to-channel-no-%d" (1+ n)))
129 (funcall #'liece-switch-to-channel-no ,n)))))
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))
153 ;;; Keymap macros. -- borrowd from `gnus-util.el'.
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))
159 (defmacro liece-define-keys (keymap &rest plist)
160 "Assign KEYMAP keys from PLIST."
161 `(liece-define-keys-1 ',keymap ',plist))
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))
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)
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."
175 (error "Can't set keys in a null keymap"))
178 (setq keymap (symbol-value 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)))))
187 (when (symbolp (setq key (pop plist)))
188 (setq key (symbol-value key)))
190 (eq (lookup-key keymap key) 'undefined))
191 (define-key keymap key (pop plist))
195 (liece-define-keys liece-dialogue-mode-map
198 [backspace] scroll-down
202 "/" liece-command-generic
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
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)
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)
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)
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)
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)
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)
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)
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
325 "c" liece-command-point-back-to-command-buffer)
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))
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)
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
342 (if (liece-server-opened)
343 ;; Stream is already opened.
346 (when (or confirm (null liece-server))
348 (completing-read (_ "IRC server: ") liece-server-alist)))
350 liece-ask-for-nickname
352 (read-string (_ "Enter your nickname: ") liece-nickname)))
353 ;; If no server name is given, local host is assumed.
355 (stringp liece-server)
356 (string-equal liece-server "")
357 (setq liece-server (system-name)))
358 (let ((host (liece-server-host)))
360 (_ "Connecting to IRC server on %s...") host)
362 ((liece-open-server liece-server liece-service))
363 ((and (stringp liece-status-message-string)
364 (> (length liece-status-message-string) 0))
365 ;; Show valuable message if available.
366 (error liece-status-message-string))
367 (t (error (_ "Cannot open IRC server on %s") host))))))
369 (defun liece-close-server-internal ()
370 "Close connection to chat server."
371 (if (liece-server-opened)
372 (delete-process liece-server-process))
373 (if liece-server-buffer
374 (kill-buffer liece-server-buffer))
375 (setq liece-server-buffer nil
376 liece-server-process nil
380 (defun liece-close-server (&optional quit-string)
384 ;; Unset default sentinel function before closing connection.
385 (when (and liece-server-process
387 (process-sentinel liece-server-process)))
388 (set-process-sentinel liece-server-process nil))
389 ;; We cannot send QUIT command unless the process is running.
390 (when (liece-server-opened)
392 (liece-send "QUIT :%s" quit-string)
393 (liece-send "QUIT"))))
394 (liece-close-server-internal)))
396 (defmacro liece-server-keyword-bind (plist &rest body)
397 "Return a `let' form that binds all variables in PLIST.
398 After this is done, BODY will be executed in the scope
401 The variables bound and their default values are described by
402 the `liece-server-keyword-map' variable."
405 (list (intern (substring (symbol-name (car keyword)) 1))
407 `(or (plist-get plist ',(car keyword))
409 `(plist-get plist ',(car keyword)))))
410 liece-server-keyword-map)
413 (put 'liece-server-keyword-bind 'lisp-indent-function 1)
414 (put 'liece-server-keyword-bind 'edebug-form-spec '(form body))
416 (defun liece-server-parse-string (string)
417 "Convert a STRING set as `liece-server' and return a property list."
418 (when (or (string-match "^\\[\\([^]]+\\)\\]:?\\([0-9]*\\)" string)
419 (string-match "^\\([^:]+\\):?\\([0-9]*\\)" string))
420 (let ((host (match-string 1 string))
421 (service (match-string 2 string))
422 (password (substring string (match-end 0)))
424 (push `(:host ,host) plist)
425 (unless (string= service "")
426 (push `(:service ,(string-to-int service)) plist))
428 ((string= password ":")
429 (setq liece-ask-for-password t))
430 ((string= password ""))
431 (t (push `(:password ,(substring password 1)) plist)))
432 (apply #'nconc plist))))
434 (defun liece-open-server (host &optional service)
435 "Open chat server on HOST.
436 If HOST is nil, use value of environment variable \"IRCSERVER\".
437 If optional argument SERVICE is non-nil, open by the service name."
438 (let* ((host (or host (getenv "IRCSERVER")))
442 (or (cdr (string-assoc-ignore-case host liece-server-alist))
443 (liece-server-parse-string host))))
445 (setq liece-status-message-string "")
446 (when (stringp plist) ;; Old style server entry...
447 (setq plist (liece-server-parse-string host)))
448 (when (and (stringp host)
449 (null (string-assoc-ignore-case host liece-server-alist)))
450 (push (cons host plist) liece-server-alist)
451 (setq liece-save-variables-are-dirty t))
452 (liece-server-keyword-bind plist
453 ;; Execute preconnecting script
455 (if (fboundp prescript)
457 (call-process shell-file-name nil nil nil
458 shell-command-switch prescript))
459 (when prescript-delay
460 (sleep-for prescript-delay)))
462 (setq liece-ask-for-password nil
463 liece-password password))
464 (if (and (memq type '(rlogin telnet)) relay)
465 (setq liece-tcp-relay-host relay))
466 (setq liece-tmp-server-name host);; temporary
467 (liece-message (_ "Connecting to IRC server %s...") host)
470 (setq liece-status-message-string
471 (_ "IRC server is not specified.")))
472 ((liece-open-server-internal host service type)
473 (setq liece-after-registration nil)
475 (setq status (liece-wait-for-response "^:[^ ]+ [4P][5O][1N][ G]"))
478 (setq liece-status-message-string
479 (format (_ "Connection to %s timed out") host))
480 ;; We have to close connection here, since the function
481 ;; `liece-server-opened' may return incorrect status.
482 (liece-close-server-internal))
483 (setq liece-after-registration t)
484 (set-process-sentinel liece-server-process 'liece-sentinel)
485 (set-process-filter liece-server-process 'liece-filter)
486 (if (or liece-ask-for-password liece-reconnect-with-password)
487 (let ((passwd-echo ?*) password)
488 (setq password (read-passwd (_ "Server Password: ")))
489 (or (string= password "")
490 (setq liece-password password))))
492 (liece-send "PASS %s" liece-password))
493 (setq liece-reconnect-with-password nil)
494 (liece-send "USER %s * * :%s"
495 (or (user-real-login-name) "Nobody")
496 (if (and liece-name (not (string= liece-name "")))
499 (or liece-real-nickname
500 (setq liece-real-nickname liece-nickname))
501 (setq liece-real-nickname
502 (truncate-string liece-real-nickname liece-nick-max-length)
503 liece-nickname-last liece-real-nickname
504 liece-nick-accepted 'sent
505 liece-after-registration t)
506 (liece-send "NICK %s" liece-real-nickname)))))
509 (defun liece-open-server-internal (host &optional service type)
510 "Open connection to chat server on HOST by SERVICE (default is irc).
511 Optional argument TYPE specifies connection types such as `program'."
512 ;; canonicalize host representation
513 (unless (string-match "^[^\\[]" host)
514 (setq host (substring host 1 (1- (length host)))))
515 (condition-case error
517 (let ((liece-tcp-connection-type type))
519 (setq liece-server-process
520 (liece-open-network-stream
521 "IRC" " *IRC*" host (or service "irc"))))
522 (setq liece-server-buffer (process-buffer liece-server-process))
523 (set-buffer liece-server-buffer)
524 (set-buffer-multibyte nil)
525 (kill-all-local-variables)
526 (buffer-disable-undo)
528 (setq liece-server-name host)
529 (run-hooks 'liece-server-hook)
530 ;; return the server process
531 liece-server-process))
533 (setq liece-status-message-string (cadr error)
534 liece-server-process nil))))
536 (defun liece-initialize-timers ()
537 "Initialise internal timers."
538 (dolist (timer liece-timers)
540 (cancel-timer (caddr timer))
541 (let ((handler (car timer)) (interval (cadr timer)))
542 (and (liece-functionp handler)
543 (symbolp interval) (boundp interval)
544 (setq interval (symbol-value interval))
546 (list (run-at-time 1 interval handler)))))))
547 (setq liece-timers-list-initialized-p t))
549 (defun liece-read-variables-files (&optional file)
550 "Read variables FILEs."
551 (and (not (file-directory-p liece-directory))
552 (file-exists-p liece-directory)
553 (yes-or-no-p "Upgrade the location of the data files? ")
556 (make-temp-name "liece") temporary-file-directory)))
559 (rename-file liece-directory file 'ok-if-exists)
560 (make-directory liece-directory)
561 (copy-file file (expand-file-name
562 (file-name-nondirectory liece-variables-file)
564 (ignore-errors (delete-file file)))))
565 (or (file-directory-p liece-directory)
566 (make-directory liece-directory))
567 (let ((files (if file
569 (setq liece-variables-file file
570 liece-variables-files (list file)))
571 liece-variables-files)))
573 (if (file-readable-p (expand-file-name file))
574 (load (expand-file-name file) t)))))
577 (defun liece (&optional confirm)
578 "Connect to the IRC server and start chatting.
579 If optional argument CONFIRM is non-nil, ask which IRC server to connect.
580 If already connected, just pop up the windows."
582 (liece-read-variables-files
583 (car command-line-args-left))
584 (pop command-line-args-left)
585 (run-hooks 'liece-after-load-startup-hook)
586 ;; Save initial state of window configuration.
587 (when (interactive-p)
588 (liece-window-configuration-push))
589 (unless liece-intl-message-alist
590 (liece-intl-load-catalogue))
591 (if (liece-server-opened)
592 (liece-configure-windows)
596 (liece-get-buffer-create liece-command-buffer))
597 (unless (eq major-mode 'liece-command-mode)
598 (liece-command-mode))
599 (liece-start-server confirm))
600 (if (not (liece-server-opened))
602 ;; IRC server is successfully open.
603 (with-current-buffer liece-command-buffer
604 (setq mode-line-process (concat " " (liece-server-host))))
605 (let (buffer-read-only)
606 (unless liece-keep-buffers
610 (liece-initialize-buffers)
611 (liece-configure-windows)
612 (setq liece-current-channels nil)
614 (liece-current-channel
615 (liece-command-join liece-current-channel))
616 (liece-startup-channel
617 (liece-command-join liece-startup-channel))
618 (liece-startup-channel-list
619 (dolist (chnl liece-startup-channel-list)
621 (liece-command-join (car chnl) (cadr chnl))
622 (liece-command-join chnl)))))
623 (unless (string-equal liece-away-message "")
624 (liece-command-away liece-away-message))
625 (run-hooks 'liece-startup-hook)
627 (or liece-obarray (make-vector liece-obarray-size nil)))
628 (unless liece-timers-list-initialized-p
629 (liece-initialize-timers))
630 (liece-command-timestamp)
631 (message (substitute-command-keys
632 "Type \\[describe-mode] for help"))))))
635 (defun liece-command-mode ()
636 "Major mode for Liece. Normal edit function are available.
637 Typing Return or Linefeed enters the current line in the dialogue.
638 The following special commands are available:
639 For a list of the generic commands type \\[liece-command-generic] ? RET.
640 \\{liece-command-mode-map}"
642 (kill-all-local-variables)
644 (setq liece-nick-alist (list (list liece-nickname))
645 major-mode 'liece-command-mode
647 liece-privmsg-partner nil
648 liece-private-indicator nil
649 liece-away-indicator "-"
650 liece-beep-indicator "-"
651 liece-freeze-indicator "-"
652 liece-own-freeze-indicator "-"
653 mode-line-buffer-identification
654 (liece-mode-line-buffer-identification
657 liece-private-indicator
659 "-- " liece-current-channel " " liece-real-nickname)))
660 (liece-suppress-mode-line-format)
661 (use-local-map liece-command-mode-map)
663 (when liece-display-frame-title
664 (make-local-variable 'frame-title-format)
665 (setq frame-title-format 'liece-channel-status-indicator))
667 (unless liece-blink-parens
668 (make-local-variable 'blink-matching-paren)
669 (setq blink-matching-paren nil))
671 (unless liece-command-mode-syntax-table
672 (setq liece-command-mode-syntax-table
673 (copy-syntax-table (syntax-table)))
674 (set-syntax-table liece-command-mode-syntax-table)
676 (function (lambda (c) (modify-syntax-entry c "w")))
679 (run-hooks 'liece-command-mode-hook))
682 (defun liece-dialogue-mode ()
683 "Major mode for displaying the IRC dialogue.
684 All normal editing commands are turned off.
685 Instead, these commands are available:
686 \\{liece-dialogue-mode-map}"
687 (kill-all-local-variables)
689 (make-local-variable 'liece-beep)
690 (make-local-variable 'liece-beep-indicator)
691 (make-local-variable 'liece-freeze)
692 (make-local-variable 'liece-freeze-indicator)
693 (make-local-variable 'liece-own-freeze)
694 (make-local-variable 'liece-own-freeze-indicator)
695 (make-local-variable 'tab-stop-list)
697 (setq liece-beep liece-default-beep
698 liece-beep-indicator (if liece-beep "B" "-")
699 liece-freeze liece-default-freeze
700 liece-freeze-indicator (if liece-freeze "F" "-")
701 liece-own-freeze liece-default-own-freeze
702 liece-own-freeze-indicator (if liece-own-freeze "M" "-")
704 major-mode 'liece-dialogue-mode
706 mode-line-buffer-identification
707 (liece-mode-line-buffer-identification
712 liece-freeze-indicator
713 liece-own-freeze-indicator
714 " " liece-channels-indicator " "))
716 tab-stop-list liece-tab-stop-list)
717 (liece-suppress-mode-line-format)
718 (use-local-map liece-dialogue-mode-map)
719 (buffer-disable-undo)
721 (unless liece-keep-buffers
724 (run-hooks 'liece-dialogue-mode-hook))
727 (define-derived-mode liece-others-mode liece-dialogue-mode
729 "Major mode for displaying the IRC others message except current channel.
730 All normal editing commands are turned off.
731 Instead, these commands are available:
732 \\{liece-others-mode-map}")
735 (define-derived-mode liece-channel-mode liece-dialogue-mode
737 "Major mode for displaying the IRC current channel buffer.
738 All normal editing commands are turned off.
739 Instead, these commands are available:
740 \\{liece-channel-mode-map}"
741 (setq mode-line-buffer-identification
742 (liece-mode-line-buffer-identification
747 liece-freeze-indicator
748 liece-own-freeze-indicator
750 liece-channel-indicator))))
753 (defun liece-channel-list-mode ()
754 "Major mode for displaying channel list.
755 All normal editing commands are turned off."
756 (kill-all-local-variables)
757 (setq major-mode 'liece-channel-list-mode
759 mode-line-buffer-identification
760 (liece-mode-line-buffer-identification
761 '("Liece: " liece-command-buffer-mode-indicator " "))
764 (use-local-map liece-channel-list-mode-map)
765 (run-hooks 'liece-channel-list-mode-hook))
768 (defun liece-nick-mode ()
769 "Major mode for displaying members in the IRC current channel buffer.
770 All normal editing commands are turned off.
771 Instead, these commands are available:
772 \\{liece-nick-mode-map}"
773 (kill-all-local-variables)
774 (setq mode-line-modified "--- "
775 major-mode 'liece-nick-mode
776 mode-name "Liece Channel member"
777 mode-line-buffer-identification
778 (liece-mode-line-buffer-identification
779 '("Liece: " liece-channel-indicator " "))
782 (if (boundp 'transient-mark-mode)
783 (set (make-local-variable 'transient-mark-mode) t))
784 (use-local-map liece-nick-mode-map)
785 (run-hooks 'liece-nick-mode-hook))
787 (fset 'liece-dialogue-beep 'liece-command-beep)
788 (fset 'liece-dialogue-freeze 'liece-command-freeze)
789 (fset 'liece-dialogue-own-freeze 'liece-command-own-freeze)
791 (defun liece-initialize-buffers ()
792 "Initialize buffers."
793 (dolist (spec liece-buffer-mode-alist)
794 (let ((buffer (symbol-value (car spec)))
796 (or (get-buffer buffer)
798 (set-buffer (liece-get-buffer-create buffer))
799 (or (eq major-mode mode)
804 (defun liece-clear-system ()
805 "Clear all Liece variables and buffers."
807 (dolist (buffer liece-buffer-list)
808 (when (and (get-buffer buffer) (buffer-live-p buffer))
809 (funcall liece-buffer-dispose-function buffer)))
810 (if (vectorp liece-obarray)
811 (dotimes (i liece-obarray-size)
812 (aset liece-obarray i nil)))
813 (dolist (timer liece-timers)
815 (cancel-timer (caddr timer)))
817 (setcdr (cdr timer) nil)))
818 (setq liece-channel-buffer-alist nil
819 liece-nick-buffer-alist nil
820 liece-current-channels nil
821 liece-current-channel nil
822 liece-current-chat-partners nil
823 liece-current-chat-partner nil
824 liece-timers-list-initialized-p nil
825 liece-friends-last nil
827 liece-channel-indicator "No channel"))
829 (defun liece-wait-for-response (regexp &optional timeout)
830 "Wait for server response which match REGEXP.
831 Optional argument TIMEOUT specifies connection timeout."
833 (let ((status t) (wait t) (timeout (or timeout liece-connection-timeout)))
834 (set-buffer liece-server-buffer)
835 (with-timeout (timeout nil)
837 (liece-accept-response)
838 (goto-char (point-min))
839 (cond ((looking-at "ERROR") (setq status nil wait nil))
840 ((looking-at ".") (setq wait nil))))
841 ;; Save status message.
843 (setq liece-status-message-string
844 (buffer-substring (point-min) (point)))
847 (goto-char (point-max))
849 (if (looking-at regexp)
851 (liece-message (_ "Reading..."))
852 (liece-accept-response))))
853 ;; Successfully received server response.
856 (defun liece-accept-process-output (process &optional timeout)
857 "Wait for output from PROCESS and message some dots.
858 Optional argument TIMEOUT specifies connection timeout."
860 (set-buffer liece-server-buffer)
861 (accept-process-output process (or timeout 1))))
863 (defun liece-accept-response ()
864 "Read response of server. Only used at startup time."
865 (unless (liece-server-opened)
867 ((not liece-reconnect-automagic)
868 (error "Liece: Connection closed"))
870 (let ((liece-nickname (concat liece-nickname liece-grow-tail)))
874 (liece-accept-process-output liece-server-process)
876 (or (string-equal "select error: Invalid argument" (nth 1 code))
877 (signal (car code) (cdr code))))))
879 (defmacro liece-replace-internal (buffer match defstring oldstring newstring)
880 "Helper function only used from `liece-replace'.
882 Replace in buffer or list of buffers BUFFER with matching MATCH.
883 Argument DEFSTRING used when no matches are there.
884 Argument OLDSTRING is replaced with NEWSTRING."
886 (set-buffer (get-buffer ,buffer))
887 (let (buffer-read-only (inhibit-read-only t))
888 (goto-char (point-max))
889 (previous-line liece-compress-treshold)
891 (if (not (re-search-forward ,match nil t))
892 (liece-insert ,buffer ,defstring)
893 (while (re-search-forward ,match nil t))
895 (if (re-search-forward ,oldstring nil t)
896 (replace-match ,newstring nil t)
897 (liece-insert ,buffer ,defstring))
898 (liece-insert ,buffer ""))))))
901 (defun liece-replace (buffer match defstring oldstring newstring)
902 "Replace in buffer or list of buffers BUFFER with matching MATCH.
903 Argument DEFSTRING used when no matches are there.
904 Argument OLDSTRING is replaced with NEWSTRING."
905 (unless (listp buffer)
906 (setq buffer (list buffer)))
908 (when (get-buffer buf)
909 (liece-replace-internal buf match defstring oldstring newstring))))
911 (defun liece-check-buffers ()
912 "Check if there is a buffer larger than `liece-buffer-max-size'.
913 If such a buffer is found, shrink it."
914 (let ((liece-buffer-check-interval 0))
915 (when (> liece-buffer-max-size 0)
917 (dolist (buffer liece-channel-buffer-alist)
918 (set-buffer (cdr buffer))
919 (when (< liece-buffer-max-size (buffer-size))
920 (let ((inhibit-read-only t)
922 (delete-region (point-min)
924 (goto-char (- (buffer-size)
925 liece-buffer-default-size))
926 (beginning-of-line -1)
929 (setq liece-buffer-last-check-time (current-time)))))))))
931 (defun liece-check-buffers-if-interval-expired ()
932 "Timer handler for `liece-check-buffers'.
933 Only used from `liece-before-insert-hook'."
934 (and (> liece-buffer-check-interval 0)
935 (or (null liece-buffer-last-check-time)
936 (> (liece-time-difference liece-buffer-last-check-time
938 liece-buffer-check-interval))
939 (liece-check-buffers)))
941 (defun liece-refresh-buffer-window (buffer)
942 "Center point in window of BUFFER and redisplay frame."
943 (let ((window (liece-get-buffer-window buffer)))
944 (when (and window (not (pos-visible-in-window-p (point-max) window)))
945 (save-selected-window
946 (select-window window)
947 (goto-char (point-max))
948 (if (null liece-scroll-step)
949 (recenter (- (liece-window-height window) 1))
951 (- (or liece-scroll-step
952 (1+ (/ (liece-window-height window) 2)))
953 (liece-window-height window)))
954 (set-window-start window (point))
955 (goto-char (point-max)))))))
957 (defmacro liece-save-point (&rest body)
958 "Execute BODY, then goto the point that was around before BODY."
959 (let ((liece-save-point (liece-gensym "lsp")))
960 `(let ((,liece-save-point (point-marker)))
963 (goto-char ,liece-save-point)
964 (set-marker ,liece-save-point nil)))))
966 (defvar liece-before-insert-hook
967 '(liece-check-buffers-if-interval-expired
968 liece-command-timestamp-if-interval-expired))
970 (defun liece-insert-internal (buffer string)
971 "Helper function only used from `liece-insert'.
973 Insert before point of BUFFER STRING with decorating."
974 (run-hooks 'liece-before-insert-hook)
975 (with-current-buffer (liece-get-buffer-create buffer)
976 (or (eq (derived-mode-class major-mode) 'liece-dialogue-mode)
977 (liece-dialogue-mode))
979 (let ((inhibit-read-only t)
981 (from (goto-char (point-max))))
982 (unless (liece-is-message-ignored string (current-buffer))
983 (and liece-display-time (not (string-equal string ""))
984 (liece-insert-time-string))
986 (run-hook-with-args 'liece-insert-hook from (point)))))
987 (unless (liece-frozen (current-buffer))
988 (liece-refresh-buffer-window (current-buffer)))))
991 (defun liece-insert (buffer string)
992 "Insert before point of BUFFER STRING with decorating."
994 (setq buffer (list buffer)))
996 (when (get-buffer buf)
997 (liece-insert-internal buf string))))
1001 ;;; liece.el ends here