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 (add-hook 'kill-emacs-hook 'liece-command-quit)
70 (defvar liece-tmp-server-name nil "Temporaly server name.")
71 (defvar liece-buffer-last-check-time nil)
72 (defvar liece-timers-list-initialized-p nil
73 "Are liece internal timers in place?")
75 (defconst liece-obarray-size 1327
76 "The size of obarray used by liece on channelname and username space.
77 For efficiency this should be prime. See documentation of intern and
78 `make-vector' for more information. Here is a list of some small primes...
80 13, 29, 37, 47, 59, 71, 89, 107, 131, 163, 197, 239, 293, 353, 431, 521,
81 631, 761, 919, 1103, 1327, 1597, 1931, 2333, 2801, 3371, 4049, 4861, 5839,
82 7013, 8419, 10103, 12143, 14591, 17519, 21023, 25229, 30293, 36353,
83 43627, 52361, 62851, 75431, 90523, 108631, 130363, 156437, 187751,
84 225307, 270371, 324449, 389357, 467237, 560689, 672827, 807403, 968897,
85 1162687, 1395263, 1674319, 2009191, 2411033, 2893249.")
87 (defvar liece-channel-list-mode-map (make-sparse-keymap))
88 (defvar liece-nick-mode-map (make-sparse-keymap))
89 (defvar liece-client-query-map (make-sparse-keymap))
90 (defvar liece-dcc-map (make-sparse-keymap))
91 (defvar liece-friends-map (make-sparse-keymap))
93 (defvar liece-dialogue-mode-map
94 (let ((keymap (make-keymap)))
95 (suppress-keymap keymap 'nodigit)
98 (defvar liece-command-mode-map (make-keymap))
99 (defvar liece-command-map (make-sparse-keymap))
101 (defvar liece-command-mode-syntax-table nil)
103 (put 'liece-command-mode 'mode-class 'special)
104 (put 'liece-dialogue-mode 'mode-class 'special)
105 (put 'liece-channel-list-mode 'mode-class 'special)
106 (put 'liece-nick-mode 'mode-class 'special)
107 (put 'liece-channel-mode 'derived-mode-parent 'liece-dialogue-mode)
108 (put 'liece-others-mode 'derived-mode-parent 'liece-dialogue-mode)
110 (defvar liece-buffer-mode-alist
111 '((liece-dialogue-buffer liece-dialogue-mode)
112 (liece-others-buffer liece-others-mode)
113 (liece-channel-list-buffer liece-channel-list-mode)
114 (liece-private-buffer liece-dialogue-mode)
116 (liece-IGNORED-buffer)
117 (liece-WALLOPS-buffer)))
121 (fset (intern (format "liece-switch-to-channel-no-%d" (1+ n)))
124 (funcall #'liece-switch-to-channel-no ,n)))))
126 (defvar liece-select-keys
127 '("1" liece-switch-to-channel-no-1
128 "2" liece-switch-to-channel-no-2
129 "3" liece-switch-to-channel-no-3
130 "4" liece-switch-to-channel-no-4
131 "5" liece-switch-to-channel-no-5
132 "6" liece-switch-to-channel-no-6
133 "7" liece-switch-to-channel-no-7
134 "8" liece-switch-to-channel-no-8
135 "9" liece-switch-to-channel-no-9
136 "0" liece-switch-to-channel-no-10
137 "\C-c1" liece-switch-to-channel-no-11
138 "\C-c2" liece-switch-to-channel-no-12
139 "\C-c3" liece-switch-to-channel-no-13
140 "\C-c4" liece-switch-to-channel-no-14
141 "\C-c5" liece-switch-to-channel-no-15
142 "\C-c6" liece-switch-to-channel-no-16
143 "\C-c7" liece-switch-to-channel-no-17
144 "\C-c8" liece-switch-to-channel-no-18
145 "\C-c9" liece-switch-to-channel-no-19
146 "\C-c0" liece-switch-to-channel-no-20))
148 ;;; Keymap macros. -- borrowed from `gnus-util.el'.
149 (defmacro liece-local-set-keys (&rest plist)
150 "Set the keys in PLIST in the current keymap."
151 `(liece-define-keys-1 (current-local-map) ',plist))
153 (defmacro liece-define-keys (keymap &rest plist)
154 "Assign KEYMAP keys from PLIST."
155 `(liece-define-keys-1 ',keymap ',plist))
157 (defmacro liece-define-keys-safe (keymap &rest plist)
158 "Assign KEYMAP keys from PLIST without overwriting previous definitions."
159 `(liece-define-keys-1 ',keymap ',plist t))
161 (put 'liece-define-keys 'lisp-indent-function 1)
162 (put 'liece-define-keys-safe 'lisp-indent-function 1)
163 (put 'liece-local-set-keys 'lisp-indent-function 1)
165 (defun liece-define-keys-1 (keymap plist &optional safe)
166 "Assign KEYMAP keys from PLIST.
167 If optional argument SAFE is nil, overwrite previous definitions."
169 (error "Can't set keys in a null keymap"))
172 (setq keymap (symbol-value keymap)))
175 (set (car keymap) nil)
176 (define-prefix-command (car keymap))
177 (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap))
178 (setq keymap (symbol-value (car keymap)))))
181 (when (symbolp (setq key (pop plist)))
182 (setq key (symbol-value key)))
184 (eq (lookup-key keymap key) 'undefined))
185 (define-key keymap key (pop plist))
189 (liece-define-keys liece-dialogue-mode-map
192 [backspace] scroll-down
196 "/" liece-command-generic
198 "<" beginning-of-buffer
199 "|" liece-command-show-last-kill
200 "a" liece-command-away
201 "b" liece-command-submit-bug-report
202 "B" liece-dialogue-beep
203 "c" liece-command-point-back-to-command-buffer
204 "f" liece-command-finger
205 "F" liece-dialogue-freeze
206 "O" liece-dialogue-own-freeze
207 "i" liece-command-invite
208 "j" liece-command-join
209 "k" liece-command-kill
210 "\C-k" liece-command-kick
211 "l" liece-command-list
212 "L" liece-command-load-vars
213 "S" liece-command-save-vars
214 "m" liece-dialogue-enter-message
215 "M" liece-command-modec
216 "n" liece-command-nickname
218 "p" liece-command-mta-private
219 "P" liece-command-toggle-private
220 "q" liece-command-quit
221 "r" liece-command-reconfigure-windows
222 "x" liece-command-tag-region
223 "t" liece-command-topic
224 "T" liece-command-timestamp
225 "\C-t" liece-command-find-timestamp
226 "v" liece-command-browse-url
227 "w" liece-command-who)
229 (liece-define-keys (liece-client-query-map "\C-c" liece-dialogue-mode-map)
230 "a" liece-command-ctcp-action
231 "v" liece-command-ctcp-version
232 "u" liece-command-ctcp-userinfo
233 "h" liece-command-ctcp-help
234 "c" liece-command-ctcp-clientinfo
235 "g" liece-command-ctcp-generic
236 "p" liece-command-ctcp-ping
237 "t" liece-command-ctcp-time
238 "x" liece-command-ctcp-x-face
239 "X" liece-command-ctcp-x-face-from-xbm-file
240 "U" liece-command-ctcp-userinfo-from-minibuffer)
242 (liece-define-keys (liece-dcc-map "\C-d" liece-dialogue-mode-map)
243 "s" liece-command-dcc-send
244 "r" liece-command-dcc-receive
245 "l" liece-command-dcc-list
246 "cl" liece-command-dcc-chat-listen
247 "cc" liece-command-dcc-chat-connect
248 "g" liece-command-dcc-accept)
250 (liece-define-keys (liece-friends-map "\C-i" liece-dialogue-mode-map)
251 " " liece-command-ison
252 "a" liece-command-activate-friends
253 "d" liece-command-deactivate-friends
254 "s" liece-command-display-friends)
256 (liece-define-keys liece-command-mode-map
257 "\r" liece-command-enter-message
258 [tab] liece-command-complete
259 [(meta control c) >] liece-command-push
260 [(meta control c) <] liece-command-pop)
262 (liece-define-keys (liece-command-map "\C-c" liece-command-mode-map)
263 "\177" liece-command-scroll-down
264 [delete] liece-command-scroll-down
265 [backspace] liece-command-scroll-down
266 " " liece-command-scroll-up
267 "$" liece-command-end-of-buffer
268 ">" liece-command-next-channel
269 "<" liece-command-previous-channel
270 "a" liece-command-away
271 "\C-f" liece-command-freeze
272 "\C-j" liece-command-next-channel
273 "\C-n" liece-command-names
274 "\C-u" liece-command-unread-channel
275 "l" liece-command-list
276 "L" liece-command-load-vars
277 "M" liece-command-own-freeze
278 "\C-m" liece-command-modec
279 "o" liece-command-set-operators
280 "O" liece-command-toggle-nick-buffer-mode
281 "\C-o" liece-command-toggle-channel-buffer-mode
282 "\C-p" liece-command-part
283 "r" liece-command-reconfigure-windows
284 "\C-r" mule-caesar-region
285 "s" liece-command-set-window-style
286 "S" liece-command-save-vars
287 "v" liece-command-set-voices
288 "\C-v" liece-command-browse-url
289 "\C-y" liece-command-yank-send)
290 (set-keymap-parent liece-command-map liece-dialogue-mode-map)
292 (liece-define-keys liece-nick-mode-map
293 "o" liece-command-set-operators
294 "v" liece-command-set-voices
295 "f" liece-command-finger
296 " " liece-command-nick-scroll-up
297 "\177" liece-command-nick-scroll-down
298 [delete] liece-command-nick-scroll-down
299 [backspace] liece-command-nick-scroll-down
300 "m" liece-command-mail-compose
301 "c" liece-command-point-back-to-command-buffer)
303 (liece-define-keys liece-channel-list-mode-map
304 ">" liece-command-next-channel
305 "<" liece-command-previous-channel
306 "u" liece-command-unread-channel
308 "c" liece-command-point-back-to-command-buffer)
310 (liece-define-keys-1 liece-dialogue-mode-map liece-select-keys)
311 (liece-define-keys-1 liece-channel-list-mode-map liece-select-keys))
314 (defmacro liece-server-opened ()
315 "Return server process status.
316 Return non-nil if stream is opened."
317 '(and liece-server-process
318 (memq (process-status liece-server-process)
321 (defun liece-start-server (&optional confirm)
322 "Open network stream to remote irc server.
323 If optional argument CONFIRM is non-nil, ask the host that the server
326 (null (or liece-server
327 (setq liece-server (getenv "IRCSERVER")))))
328 (setq liece-server (completing-read (_ "IRC server: ") liece-server-alist)))
329 (unless (listp liece-server)
330 (let ((entry (assoc liece-server liece-server-alist)))
332 (if (listp (cdr entry))
333 (setq liece-server (cdr entry))
334 (setq liece-server (liece-server-parse-string (cdr entry))))
335 (let ((plist (liece-server-parse-string liece-server)))
336 (set-alist 'liece-server-alist liece-server plist)
337 (setq liece-save-variables-are-dirty t)
338 (setq liece-server plist)))))
339 (when (or (and confirm liece-ask-for-nickname)
340 (null liece-nickname))
341 (setq liece-nickname (read-string (_ "Enter your nickname: ") liece-nickname)))
342 (let ((host (liece-server-host)))
344 (_ "Connecting to IRC server on %s...") host)
345 (liece-open-server liece-server liece-service)))
347 (defun liece-close-server-internal ()
348 "Close connection to chat server."
349 (if (liece-server-opened)
350 (delete-process liece-server-process))
351 (if liece-server-buffer
352 (kill-buffer liece-server-buffer))
353 (setq liece-server-buffer nil
354 liece-server-process nil
358 (defun liece-close-server (&optional quit-string)
362 ;; Unset default sentinel function before closing connection.
363 (when (and liece-server-process
365 (process-sentinel liece-server-process)))
366 (set-process-sentinel liece-server-process nil))
367 (if (liece-server-opened)
369 (liece-send "QUIT :%s" quit-string)
370 (liece-send "QUIT"))))
371 (liece-close-server-internal)
372 ;; Save settings to the `~/.liece/init.el' file.
373 (if liece-save-variables-are-dirty
374 (liece-command-save-vars))
377 (liece-window-configuration-pop)
378 ;; Allow the user to do things after cleaning up.
379 (run-hooks 'liece-exit-hook)))
381 (defmacro liece-server-keyword-bind (plist &rest body)
382 "Return a `let' form that binds all variables in PLIST.
383 After this is done, BODY will be executed in the scope
386 The variables bound and their default values are described by
387 the `liece-server-keyword-map' variable."
390 (list (intern (substring (symbol-name (car keyword)) 1))
392 `(or (plist-get ,plist ',(car keyword))
394 `(plist-get ,plist ',(car keyword)))))
395 liece-server-keyword-map)
398 (put 'liece-server-keyword-bind 'lisp-indent-function 1)
399 (put 'liece-server-keyword-bind 'edebug-form-spec '(form body))
401 (defun liece-server-parse-string (string)
402 "Convert a STRING set as `liece-server' and return a property list."
403 (when (or (string-match "^\\[\\([^]]+\\)\\]:?\\([0-9]*\\)" string)
404 (string-match "^\\([^:]+\\):?\\([0-9]*\\)" string))
405 (let ((host (match-string 1 string))
406 (service (match-string 2 string))
407 (password (substring string (match-end 0)))
409 (push `(:host ,host) plist)
410 (unless (string= service "")
411 (push `(:service ,(string-to-int service)) plist))
413 ((string= password ":")
414 (setq liece-ask-for-password t))
415 ((string= password ""))
416 (t (push `(:password ,(substring password 1)) plist)))
417 (apply #'nconc plist))))
419 (defun liece-open-server (host &optional service)
420 "Open chat server on HOST.
421 If HOST is nil, use value of environment variable \"IRCSERVER\".
422 If optional argument SERVICE is non-nil, open by the service name."
423 (liece-server-keyword-bind host
425 (if (fboundp prescript)
427 (call-process shell-file-name nil nil nil
428 shell-command-switch prescript))
429 (when prescript-delay
430 (sleep-for prescript-delay)))
432 (setq liece-ask-for-password nil
433 liece-password password))
434 (if (and (memq type '(rlogin telnet)) relay)
435 (setq liece-tcp-relay-host relay))
436 (setq liece-tmp-server-name host)
437 (setq liece-server-process (liece-open-server-internal host service type))
438 (setq liece-after-registration nil)
440 (if (null (liece-wait-for-response "^:[^ ]+ [4P][5O][1N][ G]"))
442 ;; We have to close connection here, since the function
443 ;; `liece-server-opened' may return incorrect status.
444 (liece-close-server-internal)
445 (error (_ "Connection to %s timed out") host))
446 (set-process-sentinel liece-server-process 'liece-sentinel)
447 (set-process-filter liece-server-process 'liece-filter)
448 (if (or liece-ask-for-password liece-reconnect-with-password)
450 (liece-read-passwd (_ "Server Password: "))))
451 (or (string= password "")
452 (setq liece-password password))))
454 (liece-send "PASS %s" liece-password))
455 (setq liece-reconnect-with-password nil)
456 (liece-send "USER %s * * :%s"
457 (or (user-real-login-name) "Nobody")
458 (if (and liece-name (not (string= liece-name "")))
461 (liece-send "NICK %s" liece-nickname)
462 ;; We have to set `liece-real-nickname' here because IRC server doesn't
463 ;; notify the real nickname to the user.
464 (or liece-real-nickname
465 (setq liece-real-nickname
466 (truncate-string-to-width liece-nickname liece-nick-max-length)))
467 (setq liece-nickname-last liece-real-nickname
468 liece-nick-accepted 'sent
469 liece-after-registration t))))
471 (defun liece-open-server-internal (host &optional service type)
472 "Open connection to chat server on HOST by SERVICE (default is irc).
473 Optional argument TYPE specifies connection types such as `program'."
474 (let ((liece-tcp-connection-type type)
478 (liece-open-network-stream
479 "IRC" " *IRC*" host (or service "irc"))))
480 (setq liece-server-buffer (process-buffer process))
482 (set-buffer liece-server-buffer)
483 (set-buffer-multibyte nil)
484 (kill-all-local-variables)
485 (buffer-disable-undo)
489 (defun liece-initialize-timers ()
490 "Initialise internal timers."
491 (dolist (timer liece-timers)
493 (cancel-timer (caddr timer))
494 (let ((handler (car timer)) (interval (cadr timer)))
495 (and (liece-functionp handler)
496 (symbolp interval) (boundp interval)
497 (setq interval (symbol-value interval))
499 (list (run-at-time 1 interval handler)))))))
500 (setq liece-timers-list-initialized-p t))
502 (defun liece-read-variables-files (&optional file)
503 "Read variables FILEs."
504 (and (not (file-directory-p liece-directory))
505 (file-exists-p liece-directory)
506 (yes-or-no-p "Upgrade the location of the data files? ")
509 (make-temp-name "liece") temporary-file-directory)))
512 (rename-file liece-directory file 'ok-if-exists)
513 (make-directory liece-directory)
514 (copy-file file (expand-file-name
515 (file-name-nondirectory liece-variables-file)
517 (ignore-errors (delete-file file)))))
518 (or (file-directory-p liece-directory)
519 (make-directory liece-directory))
520 (let ((files (if file
522 (setq liece-variables-file file
523 liece-variables-files (list file)))
524 liece-variables-files)))
526 (if (file-readable-p (expand-file-name file))
527 (load (expand-file-name file) t)))))
530 (defun liece (&optional confirm)
531 "Connect to the IRC server and start chatting.
532 If optional argument CONFIRM is non-nil, ask which IRC server to connect.
533 If already connected, just pop up the windows."
535 (liece-read-variables-files
536 (car command-line-args-left))
537 (pop command-line-args-left)
538 (run-hooks 'liece-after-load-startup-hook)
539 ;; Save initial state of window configuration.
540 (when (interactive-p)
541 (liece-window-configuration-push))
542 (unless liece-intl-message-alist
543 (liece-intl-load-catalogue))
544 (if (liece-server-opened)
545 (liece-configure-windows)
546 (switch-to-buffer (liece-get-buffer-create liece-command-buffer))
547 (unless (eq major-mode 'liece-command-mode)
548 (liece-command-mode))
549 (liece-start-server confirm)
550 (let (buffer-read-only)
551 (unless liece-keep-buffers
554 (liece-initialize-buffers)
555 (liece-configure-windows)
556 (setq liece-current-channels nil)
557 (let ((startup-channels
558 (if liece-startup-channel
559 (list liece-startup-channel)
560 liece-startup-channel-list)))
561 (dolist (chnl startup-channels)
563 (liece-command-join (car chnl) (cadr chnl))
564 (liece-command-join chnl))))
565 (unless (string-equal liece-away-message "")
566 (liece-command-away liece-away-message))
567 (run-hooks 'liece-startup-hook)
569 (or liece-obarray (make-vector liece-obarray-size nil)))
570 (unless liece-timers-list-initialized-p
571 (liece-initialize-timers))
572 (liece-command-timestamp)
573 (message (substitute-command-keys "Type \\[describe-mode] for help"))))
576 (defun liece-command-mode ()
577 "Major mode for Liece. Normal edit function are available.
578 Typing Return or Linefeed enters the current line in the dialogue.
579 The following special commands are available:
580 For a list of the generic commands type \\[liece-command-generic] ? RET.
581 \\{liece-command-mode-map}"
583 (kill-all-local-variables)
585 (setq liece-nick-alist (list (list liece-nickname))
586 major-mode 'liece-command-mode
588 liece-privmsg-partner nil
589 liece-private-indicator nil
590 liece-away-indicator "-"
591 liece-beep-indicator "-"
592 liece-freeze-indicator "-"
593 liece-own-freeze-indicator "-"
594 mode-line-buffer-identification
595 (liece-mode-line-buffer-identification
598 liece-private-indicator
600 "-- " liece-current-channel " " liece-real-nickname)))
601 (liece-suppress-mode-line-format)
602 (use-local-map liece-command-mode-map)
604 (when liece-display-frame-title
605 (make-local-variable 'frame-title-format)
606 (setq frame-title-format 'liece-channel-status-indicator))
608 (unless liece-blink-parens
609 (make-local-variable 'blink-matching-paren)
610 (setq blink-matching-paren nil))
612 (unless liece-command-mode-syntax-table
613 (setq liece-command-mode-syntax-table
614 (copy-syntax-table (syntax-table)))
615 (set-syntax-table liece-command-mode-syntax-table)
617 (lambda (c) (modify-syntax-entry c "w"))
620 (run-hooks 'liece-command-mode-hook))
623 (defun liece-dialogue-mode ()
624 "Major mode for displaying the IRC dialogue.
625 All normal editing commands are turned off.
626 Instead, these commands are available:
627 \\{liece-dialogue-mode-map}"
628 (kill-all-local-variables)
630 (make-local-variable 'liece-beep)
631 (make-local-variable 'liece-beep-indicator)
632 (make-local-variable 'liece-freeze)
633 (make-local-variable 'liece-freeze-indicator)
634 (make-local-variable 'liece-own-freeze)
635 (make-local-variable 'liece-own-freeze-indicator)
636 (make-local-variable 'tab-stop-list)
638 (setq liece-beep liece-default-beep
639 liece-beep-indicator (if liece-beep "B" "-")
640 liece-freeze liece-default-freeze
641 liece-freeze-indicator (if liece-freeze "F" "-")
642 liece-own-freeze liece-default-own-freeze
643 liece-own-freeze-indicator (if liece-own-freeze "M" "-")
645 major-mode 'liece-dialogue-mode
647 mode-line-buffer-identification
648 (liece-mode-line-buffer-identification
653 liece-freeze-indicator
654 liece-own-freeze-indicator
655 " " liece-channels-indicator " "))
657 tab-stop-list liece-tab-stop-list)
658 (liece-suppress-mode-line-format)
659 (use-local-map liece-dialogue-mode-map)
660 (buffer-disable-undo)
662 (unless liece-keep-buffers
665 (run-hooks 'liece-dialogue-mode-hook))
668 (define-derived-mode liece-others-mode liece-dialogue-mode
670 "Major mode for displaying the IRC others message except current channel.
671 All normal editing commands are turned off.
672 Instead, these commands are available:
673 \\{liece-others-mode-map}")
676 (define-derived-mode liece-channel-mode liece-dialogue-mode
678 "Major mode for displaying the IRC current channel buffer.
679 All normal editing commands are turned off.
680 Instead, these commands are available:
681 \\{liece-channel-mode-map}"
682 (setq mode-line-buffer-identification
683 (liece-mode-line-buffer-identification
688 liece-freeze-indicator
689 liece-own-freeze-indicator
691 liece-channel-indicator))))
694 (defun liece-channel-list-mode ()
695 "Major mode for displaying channel list.
696 All normal editing commands are turned off."
697 (kill-all-local-variables)
698 (setq major-mode 'liece-channel-list-mode
700 mode-line-buffer-identification
701 (liece-mode-line-buffer-identification
702 '("Liece: " liece-command-buffer-mode-indicator " "))
705 (use-local-map liece-channel-list-mode-map)
706 (run-hooks 'liece-channel-list-mode-hook))
709 (defun liece-nick-mode ()
710 "Major mode for displaying members in the IRC current channel buffer.
711 All normal editing commands are turned off.
712 Instead, these commands are available:
713 \\{liece-nick-mode-map}"
714 (kill-all-local-variables)
715 (setq mode-line-modified "--- "
716 major-mode 'liece-nick-mode
717 mode-name "Liece Channel member"
718 mode-line-buffer-identification
719 (liece-mode-line-buffer-identification
720 '("Liece: " liece-channel-indicator " "))
723 (if (boundp 'transient-mark-mode)
724 (set (make-local-variable 'transient-mark-mode) t))
725 (use-local-map liece-nick-mode-map)
726 (run-hooks 'liece-nick-mode-hook))
728 (fset 'liece-dialogue-beep 'liece-command-beep)
729 (fset 'liece-dialogue-freeze 'liece-command-freeze)
730 (fset 'liece-dialogue-own-freeze 'liece-command-own-freeze)
732 (defun liece-initialize-buffers ()
733 "Initialize buffers."
734 (dolist (spec liece-buffer-mode-alist)
735 (let ((buffer (symbol-value (car spec)))
737 (or (get-buffer buffer)
739 (set-buffer (liece-get-buffer-create buffer))
740 (or (eq major-mode mode)
745 (defun liece-clear-system ()
746 "Clear all Liece variables and buffers."
748 (dolist (buffer liece-buffer-list)
749 (when (and (get-buffer buffer) (buffer-live-p buffer))
750 (funcall liece-buffer-dispose-function buffer)))
751 (if (vectorp liece-obarray)
752 (dotimes (i liece-obarray-size)
753 (aset liece-obarray i nil)))
754 (dolist (timer liece-timers)
756 (cancel-timer (caddr timer)))
758 (setcdr (cdr timer) nil)))
759 (setq liece-channel-buffer-alist nil
760 liece-nick-buffer-alist nil
761 liece-current-channels nil
762 liece-current-channel nil
763 liece-current-chat-partners nil
764 liece-current-chat-partner nil
765 liece-timers-list-initialized-p nil
766 liece-friends-last nil
768 liece-channel-indicator "No channel"))
770 (defun liece-wait-for-response (regexp &optional timeout)
771 "Wait for server response which match REGEXP.
772 Optional argument TIMEOUT specifies connection timeout."
774 (let ((status t) (wait t) (timeout (or timeout liece-connection-timeout)))
775 (set-buffer liece-server-buffer)
776 (with-timeout (timeout nil)
778 (liece-accept-response)
779 (goto-char (point-min))
780 (cond ((looking-at "ERROR") (setq status nil wait nil))
781 ((looking-at ".") (setq wait nil))))
782 ;; Save status message.
784 (setq liece-status-message-string
785 (buffer-substring (point-min) (point)))
788 (goto-char (point-max))
790 (if (looking-at regexp)
792 (liece-message (_ "Reading..."))
793 (liece-accept-response))))
794 ;; Successfully received server response.
797 (defun liece-accept-process-output (process &optional timeout)
798 "Wait for output from PROCESS and message some dots.
799 Optional argument TIMEOUT specifies connection timeout."
801 (set-buffer liece-server-buffer)
802 (accept-process-output process (or timeout 1))))
804 (defun liece-accept-response ()
805 "Read response of server. Only used at startup time."
806 (unless (liece-server-opened)
808 ((not liece-reconnect-automagic)
809 (error "Liece: Connection closed"))
811 (let ((liece-nickname (concat liece-nickname liece-grow-tail)))
815 (liece-accept-process-output liece-server-process)
817 (or (string-equal "select error: Invalid argument" (nth 1 code))
818 (signal (car code) (cdr code))))))
820 (defmacro liece-replace-internal (buffer match defstring oldstring newstring)
821 "Helper function only used from `liece-replace'.
823 Replace in buffer or list of buffers BUFFER with matching MATCH.
824 Argument DEFSTRING used when no matches are there.
825 Argument OLDSTRING is replaced with NEWSTRING."
827 (set-buffer (get-buffer ,buffer))
828 (let (buffer-read-only (inhibit-read-only t))
829 (goto-char (point-max))
830 (previous-line liece-compress-treshold)
832 (if (not (re-search-forward ,match nil t))
833 (liece-insert ,buffer ,defstring)
834 (while (re-search-forward ,match nil t))
836 (if (re-search-forward ,oldstring nil t)
837 (replace-match ,newstring nil t)
838 (liece-insert ,buffer ,defstring))
839 (liece-insert ,buffer ""))))))
842 (defun liece-replace (buffer match defstring oldstring newstring)
843 "Replace in buffer or list of buffers BUFFER with matching MATCH.
844 Argument DEFSTRING used when no matches are there.
845 Argument OLDSTRING is replaced with NEWSTRING."
846 (unless (listp buffer)
847 (setq buffer (list buffer)))
849 (when (get-buffer buf)
850 (liece-replace-internal buf match defstring oldstring newstring))))
852 (defun liece-check-buffers ()
853 "Check if there is a buffer larger than `liece-buffer-max-size'.
854 If such a buffer is found, shrink it."
855 (let ((liece-buffer-check-interval 0))
856 (when (> liece-buffer-max-size 0)
858 (dolist (buffer liece-channel-buffer-alist)
859 (set-buffer (cdr buffer))
860 (when (< liece-buffer-max-size (buffer-size))
861 (let ((inhibit-read-only t)
863 (delete-region (point-min)
865 (goto-char (- (buffer-size)
866 liece-buffer-min-size))
867 (beginning-of-line -1)
870 (setq liece-buffer-last-check-time (current-time)))))))))
872 (defun liece-check-buffers-if-interval-expired ()
873 "Timer handler for `liece-check-buffers'.
874 Only used from `liece-before-insert-functions'."
875 (and (> liece-buffer-check-interval 0)
876 (or (null liece-buffer-last-check-time)
877 (> (liece-time-difference (current-time)
878 liece-buffer-last-check-time)
879 liece-buffer-check-interval))
880 (liece-check-buffers)))
882 (defun liece-refresh-buffer-window (buffer)
883 "Center point in window of BUFFER and redisplay frame."
884 (let ((window (liece-get-buffer-window buffer))
885 (last-point (point-max)))
886 ;; skip last white spaces
887 (while (memq (char-before last-point) '(?\n ?\t ?\ ))
888 (setq last-point (1- last-point)))
889 (when (and window (not (pos-visible-in-window-p last-point window)))
890 (save-selected-window
891 (select-window window)
892 (goto-char last-point)
893 (recenter (- (or liece-scroll-step 1)))))))
895 (defmacro liece-save-point (&rest body)
896 "Execute BODY, then goto the point that was around before BODY."
897 (let ((liece-save-point (liece-gensym "lsp")))
898 `(let ((,liece-save-point (point-marker)))
901 (goto-char ,liece-save-point)
902 (set-marker ,liece-save-point nil)))))
904 (defvar liece-before-insert-functions
905 '(liece-check-buffers-if-interval-expired
906 liece-command-timestamp-if-interval-expired))
908 (defun liece-insert-internal (buffer string)
909 "Helper function only used from `liece-insert'.
911 Insert before point of BUFFER STRING with decorating."
912 (run-hooks 'liece-before-insert-functions)
913 (with-current-buffer (liece-get-buffer-create buffer)
914 (or (eq (derived-mode-class major-mode) 'liece-dialogue-mode)
915 (liece-dialogue-mode))
917 (let ((inhibit-read-only t)
919 (from (goto-char (point-max))))
920 (unless (liece-is-message-ignored string (current-buffer))
921 (and liece-display-time (not (string-equal string ""))
922 (liece-insert-time-string))
924 (run-hook-with-args 'liece-after-insert-functions from (point)))))
925 (unless (liece-frozen (current-buffer))
926 (liece-refresh-buffer-window (current-buffer)))))
929 (defun liece-insert (buffer string)
930 "Insert before point of BUFFER STRING with decorating."
932 (setq buffer (list buffer)))
934 (when (get-buffer buf)
935 (liece-insert-internal buf string))))
939 ;;; liece.el ends here