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. -- borrowd from `gnus-util.el'.
150 (defmacro liece-local-set-keys (&rest plist)
151 "Set the keys in PLIST in the current keymap."
152 `(liece-define-keys-1 (current-local-map) ',plist))
154 (defmacro liece-define-keys (keymap &rest plist)
155 "Assign KEYMAP keys from PLIST."
156 `(liece-define-keys-1 ',keymap ',plist))
158 (defmacro liece-define-keys-safe (keymap &rest plist)
159 "Assign KEYMAP keys from PLIST without overwriting previous definitions."
160 `(liece-define-keys-1 ',keymap ',plist t))
162 (put 'liece-define-keys 'lisp-indent-function 1)
163 (put 'liece-define-keys-safe 'lisp-indent-function 1)
164 (put 'liece-local-set-keys 'lisp-indent-function 1)
166 (defun liece-define-keys-1 (keymap plist &optional safe)
167 "Assign KEYMAP keys from PLIST.
168 If optional argument SAFE is nil, overwrite previous definitions."
170 (error "Can't set keys in a null keymap"))
173 (setq keymap (symbol-value keymap)))
176 (set (car keymap) nil)
177 (define-prefix-command (car keymap))
178 (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap))
179 (setq keymap (symbol-value (car keymap)))))
182 (when (symbolp (setq key (pop plist)))
183 (setq key (symbol-value key)))
185 (eq (lookup-key keymap key) 'undefined))
186 (define-key keymap key (pop plist))
190 (liece-define-keys liece-dialogue-mode-map
193 [backspace] scroll-down
197 "/" liece-command-generic
199 "<" beginning-of-buffer
200 "|" liece-command-show-last-kill
201 "a" liece-command-away
202 "b" liece-command-submit-bug-report
203 "B" liece-dialogue-beep
204 "c" liece-command-point-back-to-command-buffer
205 "f" liece-command-finger
206 "F" liece-dialogue-freeze
207 "O" liece-dialogue-own-freeze
208 "i" liece-command-invite
209 "j" liece-command-join
210 "k" liece-command-kill
211 "\C-k" liece-command-kick
212 "l" liece-command-list
213 "L" liece-command-load-vars
214 "S" liece-command-save-vars
215 "m" liece-dialogue-enter-message
216 "M" liece-command-modec
217 "n" liece-command-nickname
219 "p" liece-command-mta-private
220 "P" liece-command-toggle-private
221 "q" liece-command-quit
222 "r" liece-command-reconfigure-windows
223 "x" liece-command-tag-region
224 "t" liece-command-topic
225 "T" liece-command-timestamp
226 "\C-t" liece-command-find-timestamp
227 "v" liece-command-browse-url
228 "w" liece-command-who)
230 (liece-define-keys (liece-client-query-map "\C-c" liece-dialogue-mode-map)
231 "a" liece-command-ctcp-action
232 "v" liece-command-ctcp-version
233 "u" liece-command-ctcp-userinfo
234 "h" liece-command-ctcp-help
235 "c" liece-command-ctcp-clientinfo
236 "g" liece-command-ctcp-generic
237 "p" liece-command-ctcp-ping
238 "t" liece-command-ctcp-time
239 "x" liece-command-ctcp-x-face
240 "X" liece-command-ctcp-x-face-from-xbm-file
241 "U" liece-command-ctcp-userinfo-from-minibuffer)
243 (liece-define-keys (liece-dcc-map "\C-d" liece-dialogue-mode-map)
244 "s" liece-command-dcc-send
245 "r" liece-command-dcc-receive
246 "l" liece-command-dcc-list
247 "cl" liece-command-dcc-chat-listen
248 "cc" liece-command-dcc-chat-connect
249 "g" liece-command-dcc-accept)
251 (liece-define-keys (liece-friends-map "\C-i" liece-dialogue-mode-map)
252 " " liece-command-ison
253 "a" liece-command-activate-friends
254 "d" liece-command-deactivate-friends
255 "s" liece-command-display-friends)
257 (liece-define-keys liece-command-mode-map
258 "\r" liece-command-enter-message
259 [tab] liece-command-complete
260 [(meta control c) >] liece-command-push
261 [(meta control c) <] liece-command-pop)
263 (liece-define-keys (liece-command-map "\C-c" liece-command-mode-map)
264 "\177" liece-command-scroll-down
265 [delete] liece-command-scroll-down
266 [backspace] liece-command-scroll-down
267 " " liece-command-scroll-up
268 "$" liece-command-end-of-buffer
269 ">" liece-command-next-channel
270 "<" liece-command-previous-channel
271 "a" liece-command-away
272 "\C-f" liece-command-freeze
273 "\C-j" liece-command-next-channel
274 "\C-n" liece-command-names
275 "\C-u" liece-command-unread-channel
276 "l" liece-command-list
277 "L" liece-command-load-vars
278 "M" liece-command-own-freeze
279 "\C-m" liece-command-modec
280 "o" liece-command-set-operators
281 "O" liece-command-toggle-nick-buffer-mode
282 "\C-o" liece-command-toggle-channel-buffer-mode
283 "\C-p" liece-command-part
284 "r" liece-command-reconfigure-windows
285 "\C-r" mule-caesar-region
286 "s" liece-command-set-window-style
287 "S" liece-command-save-vars
288 "v" liece-command-set-voices
289 "\C-v" liece-command-browse-url
290 "\C-y" liece-command-yank-send)
291 (set-keymap-parent liece-command-map liece-dialogue-mode-map)
293 (liece-define-keys liece-nick-mode-map
294 "o" liece-command-set-operators
295 "v" liece-command-set-voices
296 "f" liece-command-finger
297 " " liece-command-nick-scroll-up
298 "\177" liece-command-nick-scroll-down
299 [delete] liece-command-nick-scroll-down
300 [backspace] liece-command-nick-scroll-down
301 "m" liece-command-mail-compose
302 "c" liece-command-point-back-to-command-buffer)
304 (liece-define-keys liece-channel-list-mode-map
305 ">" liece-command-next-channel
306 "<" liece-command-previous-channel
307 "u" liece-command-unread-channel
309 "c" liece-command-point-back-to-command-buffer)
311 (liece-define-keys-1 liece-dialogue-mode-map liece-select-keys)
312 (liece-define-keys-1 liece-channel-list-mode-map liece-select-keys))
315 (defmacro liece-server-opened ()
316 "Return server process status.
317 Return non-nil if stream is opened."
318 '(and liece-server-process
319 (memq (process-status liece-server-process)
322 (defun liece-start-server (&optional confirm)
323 "Open network stream to remote irc server.
324 If optional argument CONFIRM is non-nil, ask the host that the server
327 (null (or liece-server
328 (setq liece-server (getenv "IRCSERVER")))))
329 (setq liece-server (completing-read (_ "IRC server: ") liece-server-alist)))
330 (unless (listp liece-server)
331 (let ((entry (assoc liece-server liece-server-alist)))
333 (if (listp (cdr entry))
334 (setq liece-server (cdr entry))
335 (setq liece-server (liece-server-parse-string (cdr entry))))
336 (let ((plist (liece-server-parse-string liece-server)))
337 (set-alist 'liece-server-alist liece-server plist)
338 (setq liece-save-variables-are-dirty t)
339 (setq liece-server plist)))))
340 (when (or (and confirm liece-ask-for-nickname)
341 (null liece-nickname))
342 (setq liece-nickname (read-string (_ "Enter your nickname: ") liece-nickname)))
343 (let ((host (liece-server-host)))
345 (_ "Connecting to IRC server on %s...") host)
346 (liece-open-server liece-server liece-service)))
348 (defun liece-close-server-internal ()
349 "Close connection to chat server."
350 (if (liece-server-opened)
351 (delete-process liece-server-process))
352 (if liece-server-buffer
353 (kill-buffer liece-server-buffer))
354 (setq liece-server-buffer nil
355 liece-server-process nil
359 (defun liece-close-server ()
363 ;; Unset default sentinel function before closing connection.
364 (when (and liece-server-process
366 (process-sentinel liece-server-process)))
367 (set-process-sentinel liece-server-process nil))
368 (if (liece-server-opened)
369 (liece-command-quit)))
370 (liece-close-server-internal)
371 ;; Save settings to the `~/.liece/init.el' file.
372 (if liece-save-variables-are-dirty
373 (liece-command-save-vars))
376 (liece-window-configuration-pop)
377 ;; Allow the user to do things after cleaning up.
378 (run-hooks 'liece-exit-hook)))
380 (defmacro liece-server-keyword-bind (plist &rest body)
381 "Return a `let' form that binds all variables in PLIST.
382 After this is done, BODY will be executed in the scope
385 The variables bound and their default values are described by
386 the `liece-server-keyword-map' variable."
389 (list (intern (substring (symbol-name (car keyword)) 1))
391 `(or (plist-get ,plist ',(car keyword))
393 `(plist-get ,plist ',(car keyword)))))
394 liece-server-keyword-map)
397 (put 'liece-server-keyword-bind 'lisp-indent-function 1)
398 (put 'liece-server-keyword-bind 'edebug-form-spec '(form body))
400 (defun liece-server-parse-string (string)
401 "Convert a STRING set as `liece-server' and return a property list."
402 (when (or (string-match "^\\[\\([^]]+\\)\\]:?\\([0-9]*\\)" string)
403 (string-match "^\\([^:]+\\):?\\([0-9]*\\)" string))
404 (let ((host (match-string 1 string))
405 (service (match-string 2 string))
406 (password (substring string (match-end 0)))
408 (push `(:host ,host) plist)
409 (unless (string= service "")
410 (push `(:service ,(string-to-int service)) plist))
412 ((string= password ":")
413 (setq liece-ask-for-password t))
414 ((string= password ""))
415 (t (push `(:password ,(substring password 1)) plist)))
416 (apply #'nconc plist))))
418 (defun liece-open-server (host &optional service)
419 "Open chat server on HOST.
420 If HOST is nil, use value of environment variable \"IRCSERVER\".
421 If optional argument SERVICE is non-nil, open by the service name."
422 (liece-server-keyword-bind host
424 (if (fboundp prescript)
426 (call-process shell-file-name nil nil nil
427 shell-command-switch prescript))
428 (when prescript-delay
429 (sleep-for prescript-delay)))
431 (setq liece-ask-for-password nil
432 liece-password password))
433 (if (and (memq type '(rlogin telnet)) relay)
434 (setq liece-tcp-relay-host relay))
435 (setq liece-tmp-server-name host)
436 (setq liece-server-process (liece-open-server-internal host service type))
437 (setq liece-after-registration nil)
439 (if (null (liece-wait-for-response "^:[^ ]+ [4P][5O][1N][ G]"))
441 ;; We have to close connection here, since the function
442 ;; `liece-server-opened' may return incorrect status.
443 (liece-close-server-internal)
444 (error (_ "Connection to %s timed out") host))
445 (set-process-sentinel liece-server-process 'liece-sentinel)
446 (set-process-filter liece-server-process 'liece-filter)
447 (if (or liece-ask-for-password liece-reconnect-with-password)
448 (let ((passwd-echo ?*) password)
449 (setq password (read-passwd (_ "Server Password: ")))
450 (or (string= password "")
451 (setq liece-password password))))
453 (liece-send "PASS %s" liece-password))
454 (setq liece-reconnect-with-password nil)
455 (liece-send "USER %s * * :%s"
456 (or (user-real-login-name) "Nobody")
457 (if (and liece-name (not (string= liece-name "")))
460 (liece-send "NICK %s" liece-nickname)
461 ;; We have to set `liece-real-nickname' here because IRC server doesn't
462 ;; notify the real nickname to the user.
463 (or liece-real-nickname
464 (setq liece-real-nickname
465 (truncate-string liece-nickname liece-nick-max-length)))
466 (setq liece-nickname-last liece-real-nickname
467 liece-nick-accepted 'sent
468 liece-after-registration t))))
470 (defun liece-open-server-internal (host &optional service type)
471 "Open connection to chat server on HOST by SERVICE (default is irc).
472 Optional argument TYPE specifies connection types such as `program'."
473 (let ((liece-tcp-connection-type type)
477 (liece-open-network-stream
478 "IRC" " *IRC*" host (or service "irc"))))
479 (setq liece-server-buffer (process-buffer process))
481 (set-buffer liece-server-buffer)
482 (set-buffer-multibyte nil)
483 (kill-all-local-variables)
484 (buffer-disable-undo)
488 (defun liece-initialize-timers ()
489 "Initialise internal timers."
490 (dolist (timer liece-timers)
492 (cancel-timer (caddr timer))
493 (let ((handler (car timer)) (interval (cadr timer)))
494 (and (liece-functionp handler)
495 (symbolp interval) (boundp interval)
496 (setq interval (symbol-value interval))
498 (list (run-at-time 1 interval handler)))))))
499 (setq liece-timers-list-initialized-p t))
501 (defun liece-read-variables-files (&optional file)
502 "Read variables FILEs."
503 (and (not (file-directory-p liece-directory))
504 (file-exists-p liece-directory)
505 (yes-or-no-p "Upgrade the location of the data files? ")
508 (make-temp-name "liece") temporary-file-directory)))
511 (rename-file liece-directory file 'ok-if-exists)
512 (make-directory liece-directory)
513 (copy-file file (expand-file-name
514 (file-name-nondirectory liece-variables-file)
516 (ignore-errors (delete-file file)))))
517 (or (file-directory-p liece-directory)
518 (make-directory liece-directory))
519 (let ((files (if file
521 (setq liece-variables-file file
522 liece-variables-files (list file)))
523 liece-variables-files)))
525 (if (file-readable-p (expand-file-name file))
526 (load (expand-file-name file) t)))))
529 (defun liece (&optional confirm)
530 "Connect to the IRC server and start chatting.
531 If optional argument CONFIRM is non-nil, ask which IRC server to connect.
532 If already connected, just pop up the windows."
534 (liece-read-variables-files
535 (car command-line-args-left))
536 (pop command-line-args-left)
537 (run-hooks 'liece-after-load-startup-hook)
538 ;; Save initial state of window configuration.
539 (when (interactive-p)
540 (liece-window-configuration-push))
541 (unless liece-intl-message-alist
542 (liece-intl-load-catalogue))
543 (if (liece-server-opened)
544 (liece-configure-windows)
548 (liece-get-buffer-create liece-command-buffer))
549 (unless (eq major-mode 'liece-command-mode)
550 (liece-command-mode))
551 (unless (liece-server-opened)
552 (liece-start-server confirm)))
553 (if (not (liece-server-opened))
555 ;; IRC server is successfully open.
556 (with-current-buffer liece-command-buffer
557 (setq mode-line-process (concat " " (liece-server-host))))
558 (let (buffer-read-only)
559 (unless liece-keep-buffers
563 (liece-initialize-buffers)
564 (liece-configure-windows)
565 (setq liece-current-channels nil)
567 (liece-current-channel
568 (liece-command-join liece-current-channel))
569 (liece-startup-channel
570 (liece-command-join liece-startup-channel))
571 (liece-startup-channel-list
572 (dolist (chnl liece-startup-channel-list)
574 (liece-command-join (car chnl) (cadr chnl))
575 (liece-command-join chnl)))))
576 (unless (string-equal liece-away-message "")
577 (liece-command-away liece-away-message))
578 (run-hooks 'liece-startup-hook)
580 (or liece-obarray (make-vector liece-obarray-size nil)))
581 (unless liece-timers-list-initialized-p
582 (liece-initialize-timers))
583 (liece-command-timestamp)
584 (message (substitute-command-keys
585 "Type \\[describe-mode] for help"))))))
588 (defun liece-command-mode ()
589 "Major mode for Liece. Normal edit function are available.
590 Typing Return or Linefeed enters the current line in the dialogue.
591 The following special commands are available:
592 For a list of the generic commands type \\[liece-command-generic] ? RET.
593 \\{liece-command-mode-map}"
595 (kill-all-local-variables)
597 (setq liece-nick-alist (list (list liece-nickname))
598 major-mode 'liece-command-mode
600 liece-privmsg-partner nil
601 liece-private-indicator nil
602 liece-away-indicator "-"
603 liece-beep-indicator "-"
604 liece-freeze-indicator "-"
605 liece-own-freeze-indicator "-"
606 mode-line-buffer-identification
607 (liece-mode-line-buffer-identification
610 liece-private-indicator
612 "-- " liece-current-channel " " liece-real-nickname)))
613 (liece-suppress-mode-line-format)
614 (use-local-map liece-command-mode-map)
616 (when liece-display-frame-title
617 (make-local-variable 'frame-title-format)
618 (setq frame-title-format 'liece-channel-status-indicator))
620 (unless liece-blink-parens
621 (make-local-variable 'blink-matching-paren)
622 (setq blink-matching-paren nil))
624 (unless liece-command-mode-syntax-table
625 (setq liece-command-mode-syntax-table
626 (copy-syntax-table (syntax-table)))
627 (set-syntax-table liece-command-mode-syntax-table)
629 (function (lambda (c) (modify-syntax-entry c "w")))
632 (run-hooks 'liece-command-mode-hook))
635 (defun liece-dialogue-mode ()
636 "Major mode for displaying the IRC dialogue.
637 All normal editing commands are turned off.
638 Instead, these commands are available:
639 \\{liece-dialogue-mode-map}"
640 (kill-all-local-variables)
642 (make-local-variable 'liece-beep)
643 (make-local-variable 'liece-beep-indicator)
644 (make-local-variable 'liece-freeze)
645 (make-local-variable 'liece-freeze-indicator)
646 (make-local-variable 'liece-own-freeze)
647 (make-local-variable 'liece-own-freeze-indicator)
648 (make-local-variable 'tab-stop-list)
650 (setq liece-beep liece-default-beep
651 liece-beep-indicator (if liece-beep "B" "-")
652 liece-freeze liece-default-freeze
653 liece-freeze-indicator (if liece-freeze "F" "-")
654 liece-own-freeze liece-default-own-freeze
655 liece-own-freeze-indicator (if liece-own-freeze "M" "-")
657 major-mode 'liece-dialogue-mode
659 mode-line-buffer-identification
660 (liece-mode-line-buffer-identification
665 liece-freeze-indicator
666 liece-own-freeze-indicator
667 " " liece-channels-indicator " "))
669 tab-stop-list liece-tab-stop-list)
670 (liece-suppress-mode-line-format)
671 (use-local-map liece-dialogue-mode-map)
672 (buffer-disable-undo)
674 (unless liece-keep-buffers
677 (run-hooks 'liece-dialogue-mode-hook))
680 (define-derived-mode liece-others-mode liece-dialogue-mode
682 "Major mode for displaying the IRC others message except current channel.
683 All normal editing commands are turned off.
684 Instead, these commands are available:
685 \\{liece-others-mode-map}")
688 (define-derived-mode liece-channel-mode liece-dialogue-mode
690 "Major mode for displaying the IRC current channel buffer.
691 All normal editing commands are turned off.
692 Instead, these commands are available:
693 \\{liece-channel-mode-map}"
694 (setq mode-line-buffer-identification
695 (liece-mode-line-buffer-identification
700 liece-freeze-indicator
701 liece-own-freeze-indicator
703 liece-channel-indicator))))
706 (defun liece-channel-list-mode ()
707 "Major mode for displaying channel list.
708 All normal editing commands are turned off."
709 (kill-all-local-variables)
710 (setq major-mode 'liece-channel-list-mode
712 mode-line-buffer-identification
713 (liece-mode-line-buffer-identification
714 '("Liece: " liece-command-buffer-mode-indicator " "))
717 (use-local-map liece-channel-list-mode-map)
718 (run-hooks 'liece-channel-list-mode-hook))
721 (defun liece-nick-mode ()
722 "Major mode for displaying members in the IRC current channel buffer.
723 All normal editing commands are turned off.
724 Instead, these commands are available:
725 \\{liece-nick-mode-map}"
726 (kill-all-local-variables)
727 (setq mode-line-modified "--- "
728 major-mode 'liece-nick-mode
729 mode-name "Liece Channel member"
730 mode-line-buffer-identification
731 (liece-mode-line-buffer-identification
732 '("Liece: " liece-channel-indicator " "))
735 (if (boundp 'transient-mark-mode)
736 (set (make-local-variable 'transient-mark-mode) t))
737 (use-local-map liece-nick-mode-map)
738 (run-hooks 'liece-nick-mode-hook))
740 (fset 'liece-dialogue-beep 'liece-command-beep)
741 (fset 'liece-dialogue-freeze 'liece-command-freeze)
742 (fset 'liece-dialogue-own-freeze 'liece-command-own-freeze)
744 (defun liece-initialize-buffers ()
745 "Initialize buffers."
746 (dolist (spec liece-buffer-mode-alist)
747 (let ((buffer (symbol-value (car spec)))
749 (or (get-buffer buffer)
751 (set-buffer (liece-get-buffer-create buffer))
752 (or (eq major-mode mode)
757 (defun liece-clear-system ()
758 "Clear all Liece variables and buffers."
760 (dolist (buffer liece-buffer-list)
761 (when (and (get-buffer buffer) (buffer-live-p buffer))
762 (funcall liece-buffer-dispose-function buffer)))
763 (if (vectorp liece-obarray)
764 (dotimes (i liece-obarray-size)
765 (aset liece-obarray i nil)))
766 (dolist (timer liece-timers)
768 (cancel-timer (caddr timer)))
770 (setcdr (cdr timer) nil)))
771 (setq liece-channel-buffer-alist nil
772 liece-nick-buffer-alist nil
773 liece-current-channels nil
774 liece-current-channel nil
775 liece-current-chat-partners nil
776 liece-current-chat-partner nil
777 liece-timers-list-initialized-p nil
778 liece-friends-last nil
780 liece-channel-indicator "No channel"))
782 (defun liece-wait-for-response (regexp &optional timeout)
783 "Wait for server response which match REGEXP.
784 Optional argument TIMEOUT specifies connection timeout."
786 (let ((status t) (wait t) (timeout (or timeout liece-connection-timeout)))
787 (set-buffer liece-server-buffer)
788 (with-timeout (timeout nil)
790 (liece-accept-response)
791 (goto-char (point-min))
792 (cond ((looking-at "ERROR") (setq status nil wait nil))
793 ((looking-at ".") (setq wait nil))))
794 ;; Save status message.
796 (setq liece-status-message-string
797 (buffer-substring (point-min) (point)))
800 (goto-char (point-max))
802 (if (looking-at regexp)
804 (liece-message (_ "Reading..."))
805 (liece-accept-response))))
806 ;; Successfully received server response.
809 (defun liece-accept-process-output (process &optional timeout)
810 "Wait for output from PROCESS and message some dots.
811 Optional argument TIMEOUT specifies connection timeout."
813 (set-buffer liece-server-buffer)
814 (accept-process-output process (or timeout 1))))
816 (defun liece-accept-response ()
817 "Read response of server. Only used at startup time."
818 (unless (liece-server-opened)
820 ((not liece-reconnect-automagic)
821 (error "Liece: Connection closed"))
823 (let ((liece-nickname (concat liece-nickname liece-grow-tail)))
827 (liece-accept-process-output liece-server-process)
829 (or (string-equal "select error: Invalid argument" (nth 1 code))
830 (signal (car code) (cdr code))))))
832 (defmacro liece-replace-internal (buffer match defstring oldstring newstring)
833 "Helper function only used from `liece-replace'.
835 Replace in buffer or list of buffers BUFFER with matching MATCH.
836 Argument DEFSTRING used when no matches are there.
837 Argument OLDSTRING is replaced with NEWSTRING."
839 (set-buffer (get-buffer ,buffer))
840 (let (buffer-read-only (inhibit-read-only t))
841 (goto-char (point-max))
842 (previous-line liece-compress-treshold)
844 (if (not (re-search-forward ,match nil t))
845 (liece-insert ,buffer ,defstring)
846 (while (re-search-forward ,match nil t))
848 (if (re-search-forward ,oldstring nil t)
849 (replace-match ,newstring nil t)
850 (liece-insert ,buffer ,defstring))
851 (liece-insert ,buffer ""))))))
854 (defun liece-replace (buffer match defstring oldstring newstring)
855 "Replace in buffer or list of buffers BUFFER with matching MATCH.
856 Argument DEFSTRING used when no matches are there.
857 Argument OLDSTRING is replaced with NEWSTRING."
858 (unless (listp buffer)
859 (setq buffer (list buffer)))
861 (when (get-buffer buf)
862 (liece-replace-internal buf match defstring oldstring newstring))))
864 (defun liece-check-buffers ()
865 "Check if there is a buffer larger than `liece-buffer-max-size'.
866 If such a buffer is found, shrink it."
867 (let ((liece-buffer-check-interval 0))
868 (when (> liece-buffer-max-size 0)
870 (dolist (buffer liece-channel-buffer-alist)
871 (set-buffer (cdr buffer))
872 (when (< liece-buffer-max-size (buffer-size))
873 (let ((inhibit-read-only t)
875 (delete-region (point-min)
877 (goto-char (- (buffer-size)
878 liece-buffer-default-size))
879 (beginning-of-line -1)
882 (setq liece-buffer-last-check-time (current-time)))))))))
884 (defun liece-check-buffers-if-interval-expired ()
885 "Timer handler for `liece-check-buffers'.
886 Only used from `liece-before-insert-functions'."
887 (and (> liece-buffer-check-interval 0)
888 (or (null liece-buffer-last-check-time)
889 (> (liece-time-difference liece-buffer-last-check-time
891 liece-buffer-check-interval))
892 (liece-check-buffers)))
894 (defun liece-refresh-buffer-window (buffer)
895 "Center point in window of BUFFER and redisplay frame."
896 (let ((window (liece-get-buffer-window buffer)))
897 (when (and window (not (pos-visible-in-window-p (point-max) window)))
898 (save-selected-window
899 (select-window window)
900 (goto-char (point-max))
901 (if (null liece-scroll-step)
902 (recenter (- (liece-window-height window) 1))
904 (- (or liece-scroll-step
905 (1+ (/ (liece-window-height window) 2)))
906 (liece-window-height window)))
907 (set-window-start window (point))
908 (goto-char (point-max)))))))
910 (defmacro liece-save-point (&rest body)
911 "Execute BODY, then goto the point that was around before BODY."
912 (let ((liece-save-point (liece-gensym "lsp")))
913 `(let ((,liece-save-point (point-marker)))
916 (goto-char ,liece-save-point)
917 (set-marker ,liece-save-point nil)))))
919 (defvar liece-before-insert-functions
920 '(liece-check-buffers-if-interval-expired
921 liece-command-timestamp-if-interval-expired))
923 (defun liece-insert-internal (buffer string)
924 "Helper function only used from `liece-insert'.
926 Insert before point of BUFFER STRING with decorating."
927 (run-hooks 'liece-before-insert-functions)
928 (with-current-buffer (liece-get-buffer-create buffer)
929 (or (eq (derived-mode-class major-mode) 'liece-dialogue-mode)
930 (liece-dialogue-mode))
932 (let ((inhibit-read-only t)
934 (from (goto-char (point-max))))
935 (unless (liece-is-message-ignored string (current-buffer))
936 (and liece-display-time (not (string-equal string ""))
937 (liece-insert-time-string))
939 (run-hook-with-args 'liece-after-insert-functions from (point)))))
940 (unless (liece-frozen (current-buffer))
941 (liece-refresh-buffer-window (current-buffer)))))
944 (defun liece-insert (buffer string)
945 "Insert before point of BUFFER STRING with decorating."
947 (setq buffer (list buffer)))
949 (when (get-buffer buf)
950 (liece-insert-internal buf string))))
954 ;;; liece.el ends here