;;; liece.el --- IRC client for Emacsen ;; Copyright (C) 1998-2000 Daiki Ueno ;; Author: Daiki Ueno ;; Created: 1998-09-28 ;; Revised: 2000-03-20 ;; Keywords: IRC, liece ;; This file is part of Liece. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; ;;; Code: (require 'liece-inlines) (require 'liece-handle) (require 'liece-filter) (require 'liece-hilit) (require 'liece-intl) (require 'liece-menu) (require 'liece-window) (require 'liece-tcp) (if (featurep 'xemacs) (require 'liece-xemacs) (require 'liece-emacs)) (require 'liece-commands) (autoload 'mule-caesar-region "mule-caesar" nil t) (autoload 'liece-command-browse-url "liece-url" nil t) (autoload 'liece-command-dcc-send "liece-dcc" nil t) (autoload 'liece-command-dcc-receive "liece-dcc" nil t) (autoload 'liece-command-dcc-list "liece-dcc" nil t) (autoload 'liece-command-dcc-chat-listen "liece-dcc" nil t) (autoload 'liece-command-dcc-chat-connect "liece-dcc" nil t) (autoload 'liece-command-dcc-accept "liece-dcc" nil t) (autoload 'liece-command-mail-compose "liece-mail" nil t) (autoload 'liece-command-submit-bug-report "liece-mail" nil t) (eval-and-compile (defvar liece-server-keyword-map '((:host (getenv "IRCSERVER")) (:service liece-service) (:password liece-password) (:prescript) (:prescript-delay) (:type liece-tcp-connection-type) (:relay)) "Mapping from keywords to default values. All keywords that can be used must be listed here.")) (add-hook 'kill-emacs-hook 'liece-command-quit) (defvar liece-tmp-server-name nil "Temporaly server name.") (defvar liece-buffer-last-check-time nil) (defvar liece-timers-list-initialized-p nil "Are liece internal timers in place?") (defconst liece-obarray-size 1327 "The size of obarray used by liece on channelname and username space. For efficiency this should be prime. See documentation of intern and `make-vector' for more information. Here is a list of some small primes... 13, 29, 37, 47, 59, 71, 89, 107, 131, 163, 197, 239, 293, 353, 431, 521, 631, 761, 919, 1103, 1327, 1597, 1931, 2333, 2801, 3371, 4049, 4861, 5839, 7013, 8419, 10103, 12143, 14591, 17519, 21023, 25229, 30293, 36353, 43627, 52361, 62851, 75431, 90523, 108631, 130363, 156437, 187751, 225307, 270371, 324449, 389357, 467237, 560689, 672827, 807403, 968897, 1162687, 1395263, 1674319, 2009191, 2411033, 2893249.") (defvar liece-channel-list-mode-map (make-sparse-keymap)) (defvar liece-nick-mode-map (make-sparse-keymap)) (defvar liece-client-query-map (make-sparse-keymap)) (defvar liece-dcc-map (make-sparse-keymap)) (defvar liece-friends-map (make-sparse-keymap)) (defvar liece-dialogue-mode-map (let ((keymap (make-keymap))) (suppress-keymap keymap 'nodigit) keymap)) (defvar liece-command-mode-map (make-keymap)) (defvar liece-command-map (make-sparse-keymap)) (defvar liece-command-mode-syntax-table nil) (put 'liece-command-mode 'mode-class 'special) (put 'liece-dialogue-mode 'mode-class 'special) (put 'liece-channel-list-mode 'mode-class 'special) (put 'liece-nick-mode 'mode-class 'special) (put 'liece-channel-mode 'derived-mode-parent 'liece-dialogue-mode) (put 'liece-others-mode 'derived-mode-parent 'liece-dialogue-mode) (defvar liece-buffer-mode-alist '((liece-dialogue-buffer liece-dialogue-mode) (liece-others-buffer liece-others-mode) (liece-channel-list-buffer liece-channel-list-mode) (liece-private-buffer liece-dialogue-mode) (liece-KILLS-buffer) (liece-IGNORED-buffer) (liece-WALLOPS-buffer))) (eval-and-compile (dotimes (n 20) (fset (intern (format "liece-switch-to-channel-no-%d" (1+ n))) `(lambda () (interactive) (funcall #'liece-switch-to-channel-no ,n))))) (defvar liece-select-keys '("1" liece-switch-to-channel-no-1 "2" liece-switch-to-channel-no-2 "3" liece-switch-to-channel-no-3 "4" liece-switch-to-channel-no-4 "5" liece-switch-to-channel-no-5 "6" liece-switch-to-channel-no-6 "7" liece-switch-to-channel-no-7 "8" liece-switch-to-channel-no-8 "9" liece-switch-to-channel-no-9 "0" liece-switch-to-channel-no-10 "\C-c1" liece-switch-to-channel-no-11 "\C-c2" liece-switch-to-channel-no-12 "\C-c3" liece-switch-to-channel-no-13 "\C-c4" liece-switch-to-channel-no-14 "\C-c5" liece-switch-to-channel-no-15 "\C-c6" liece-switch-to-channel-no-16 "\C-c7" liece-switch-to-channel-no-17 "\C-c8" liece-switch-to-channel-no-18 "\C-c9" liece-switch-to-channel-no-19 "\C-c0" liece-switch-to-channel-no-20)) ;;; Keymap macros. -- borrowd from `gnus-util.el'. (defmacro liece-local-set-keys (&rest plist) "Set the keys in PLIST in the current keymap." `(liece-define-keys-1 (current-local-map) ',plist)) (defmacro liece-define-keys (keymap &rest plist) "Assign KEYMAP keys from PLIST." `(liece-define-keys-1 ',keymap ',plist)) (defmacro liece-define-keys-safe (keymap &rest plist) "Assign KEYMAP keys from PLIST without overwriting previous definitions." `(liece-define-keys-1 ',keymap ',plist t)) (put 'liece-define-keys 'lisp-indent-function 1) (put 'liece-define-keys-safe 'lisp-indent-function 1) (put 'liece-local-set-keys 'lisp-indent-function 1) (defun liece-define-keys-1 (keymap plist &optional safe) "Assign KEYMAP keys from PLIST. If optional argument SAFE is nil, overwrite previous definitions." (unless keymap (error "Can't set keys in a null keymap")) (cond ((symbolp keymap) (setq keymap (symbol-value keymap))) ((keymapp keymap)) ((listp keymap) (set (car keymap) nil) (define-prefix-command (car keymap)) (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap)) (setq keymap (symbol-value (car keymap))))) (let (key) (while plist (when (symbolp (setq key (pop plist))) (setq key (symbol-value key))) (if (or (not safe) (eq (lookup-key keymap key) 'undefined)) (define-key keymap key (pop plist)) (pop plist))))) (when t (liece-define-keys liece-dialogue-mode-map "\177" scroll-down [delete] scroll-down [backspace] scroll-down [return] scroll-up " " scroll-up "$" end-of-buffer "/" liece-command-generic ">" end-of-buffer "<" beginning-of-buffer "|" liece-command-show-last-kill "a" liece-command-away "b" liece-command-submit-bug-report "B" liece-dialogue-beep "c" liece-command-point-back-to-command-buffer "f" liece-command-finger "F" liece-dialogue-freeze "O" liece-dialogue-own-freeze "i" liece-command-invite "j" liece-command-join "k" liece-command-kill "\C-k" liece-command-kick "l" liece-command-list "L" liece-command-load-vars "S" liece-command-save-vars "m" liece-dialogue-enter-message "M" liece-command-modec "n" liece-command-nickname "o" other-window "p" liece-command-mta-private "P" liece-command-toggle-private "q" liece-command-quit "r" liece-command-reconfigure-windows "x" liece-command-tag-region "t" liece-command-topic "T" liece-command-timestamp "\C-t" liece-command-find-timestamp "v" liece-command-browse-url "w" liece-command-who) (liece-define-keys (liece-client-query-map "\C-c" liece-dialogue-mode-map) "a" liece-command-ctcp-action "v" liece-command-ctcp-version "u" liece-command-ctcp-userinfo "h" liece-command-ctcp-help "c" liece-command-ctcp-clientinfo "g" liece-command-ctcp-generic "p" liece-command-ctcp-ping "t" liece-command-ctcp-time "x" liece-command-ctcp-x-face "X" liece-command-ctcp-x-face-from-xbm-file "U" liece-command-ctcp-userinfo-from-minibuffer) (liece-define-keys (liece-dcc-map "\C-d" liece-dialogue-mode-map) "s" liece-command-dcc-send "r" liece-command-dcc-receive "l" liece-command-dcc-list "cl" liece-command-dcc-chat-listen "cc" liece-command-dcc-chat-connect "g" liece-command-dcc-accept) (liece-define-keys (liece-friends-map "\C-i" liece-dialogue-mode-map) " " liece-command-ison "a" liece-command-activate-friends "d" liece-command-deactivate-friends "s" liece-command-display-friends) (liece-define-keys liece-command-mode-map "\r" liece-command-enter-message [tab] liece-command-complete [(meta control c) >] liece-command-push [(meta control c) <] liece-command-pop) (liece-define-keys (liece-command-map "\C-c" liece-command-mode-map) "\177" liece-command-scroll-down [delete] liece-command-scroll-down [backspace] liece-command-scroll-down " " liece-command-scroll-up "$" liece-command-end-of-buffer ">" liece-command-next-channel "<" liece-command-previous-channel "a" liece-command-away "\C-f" liece-command-freeze "\C-j" liece-command-next-channel "\C-n" liece-command-names "\C-u" liece-command-unread-channel "l" liece-command-list "L" liece-command-load-vars "M" liece-command-own-freeze "\C-m" liece-command-modec "o" liece-command-set-operators "O" liece-command-toggle-nick-buffer-mode "\C-o" liece-command-toggle-channel-buffer-mode "\C-p" liece-command-part "r" liece-command-reconfigure-windows "\C-r" mule-caesar-region "s" liece-command-set-window-style "S" liece-command-save-vars "v" liece-command-set-voices "\C-v" liece-command-browse-url "\C-y" liece-command-yank-send) (set-keymap-parent liece-command-map liece-dialogue-mode-map) (liece-define-keys liece-nick-mode-map "o" liece-command-set-operators "v" liece-command-set-voices "f" liece-command-finger " " liece-command-nick-scroll-up "\177" liece-command-nick-scroll-down [delete] liece-command-nick-scroll-down [backspace] liece-command-nick-scroll-down "m" liece-command-mail-compose "c" liece-command-point-back-to-command-buffer) (liece-define-keys liece-channel-list-mode-map ">" liece-command-next-channel "<" liece-command-previous-channel "u" liece-command-unread-channel "o" other-window "c" liece-command-point-back-to-command-buffer) (liece-define-keys-1 liece-dialogue-mode-map liece-select-keys) (liece-define-keys-1 liece-channel-list-mode-map liece-select-keys)) ;;;###liece-autoload (defmacro liece-server-opened () "Return server process status. Return non-nil if stream is opened." '(and liece-server-process (memq (process-status liece-server-process) '(open run)))) (defun liece-start-server (&optional confirm) "Open network stream to remote irc server. If optional argument CONFIRM is non-nil, ask the host that the server is running on." (when (or confirm (null (or liece-server (setq liece-server (getenv "IRCSERVER"))))) (setq liece-server (completing-read (_ "IRC server: ") liece-server-alist))) (unless (listp liece-server) (let ((entry (assoc liece-server liece-server-alist))) (if entry (if (listp (cdr entry)) (setq liece-server (cdr entry)) (setq liece-server (liece-server-parse-string (cdr entry)))) (let ((plist (liece-server-parse-string liece-server))) (set-alist 'liece-server-alist liece-server plist) (setq liece-save-variables-are-dirty t) (setq liece-server plist))))) (when (or (and confirm liece-ask-for-nickname) (null liece-nickname)) (setq liece-nickname (read-string (_ "Enter your nickname: ") liece-nickname))) (let ((host (liece-server-host))) (liece-message (_ "Connecting to IRC server on %s...") host) (liece-open-server liece-server liece-service))) (defun liece-close-server-internal () "Close connection to chat server." (if (liece-server-opened) (delete-process liece-server-process)) (if liece-server-buffer (kill-buffer liece-server-buffer)) (setq liece-server-buffer nil liece-server-process nil liece-server nil)) ;;;###liece-autoload (defun liece-close-server (&optional quit-string) "Close chat server." (unwind-protect (progn ;; Unset default sentinel function before closing connection. (when (and liece-server-process (eq 'liece-sentinel (process-sentinel liece-server-process))) (set-process-sentinel liece-server-process nil)) (if (liece-server-opened) (if quit-string (liece-send "QUIT :%s" quit-string) (liece-send "QUIT")))) (liece-close-server-internal) ;; Save settings to the `~/.liece/init.el' file. (if liece-save-variables-are-dirty (liece-command-save-vars)) ;; Reset everything. (liece-clear-system) (liece-window-configuration-pop) ;; Allow the user to do things after cleaning up. (run-hooks 'liece-exit-hook))) (defmacro liece-server-keyword-bind (plist &rest body) "Return a `let' form that binds all variables in PLIST. After this is done, BODY will be executed in the scope of the `let' form. The variables bound and their default values are described by the `liece-server-keyword-map' variable." `(let ,(mapcar (lambda (keyword) (list (intern (substring (symbol-name (car keyword)) 1)) (if (cadr keyword) `(or (plist-get ,plist ',(car keyword)) ,(cadr keyword)) `(plist-get ,plist ',(car keyword))))) liece-server-keyword-map) ,@body)) (put 'liece-server-keyword-bind 'lisp-indent-function 1) (put 'liece-server-keyword-bind 'edebug-form-spec '(form body)) (defun liece-server-parse-string (string) "Convert a STRING set as `liece-server' and return a property list." (when (or (string-match "^\\[\\([^]]+\\)\\]:?\\([0-9]*\\)" string) (string-match "^\\([^:]+\\):?\\([0-9]*\\)" string)) (let ((host (match-string 1 string)) (service (match-string 2 string)) (password (substring string (match-end 0))) plist) (push `(:host ,host) plist) (unless (string= service "") (push `(:service ,(string-to-int service)) plist)) (cond ((string= password ":") (setq liece-ask-for-password t)) ((string= password "")) (t (push `(:password ,(substring password 1)) plist))) (apply #'nconc plist)))) (defun liece-open-server (host &optional service) "Open chat server on HOST. If HOST is nil, use value of environment variable \"IRCSERVER\". If optional argument SERVICE is non-nil, open by the service name." (liece-server-keyword-bind host (when prescript (if (fboundp prescript) (funcall prescript) (call-process shell-file-name nil nil nil shell-command-switch prescript)) (when prescript-delay (sleep-for prescript-delay))) (if password (setq liece-ask-for-password nil liece-password password)) (if (and (memq type '(rlogin telnet)) relay) (setq liece-tcp-relay-host relay)) (setq liece-tmp-server-name host) (setq liece-server-process (liece-open-server-internal host service type)) (setq liece-after-registration nil) (liece-maybe-poll) (if (null (liece-wait-for-response "^:[^ ]+ [4P][5O][1N][ G]")) (progn ;; We have to close connection here, since the function ;; `liece-server-opened' may return incorrect status. (liece-close-server-internal) (error (_ "Connection to %s timed out") host)) (set-process-sentinel liece-server-process 'liece-sentinel) (set-process-filter liece-server-process 'liece-filter) (if (or liece-ask-for-password liece-reconnect-with-password) (let ((password (liece-read-passwd (_ "Server Password: ")))) (or (string= password "") (setq liece-password password)))) (if liece-password (liece-send "PASS %s" liece-password)) (setq liece-reconnect-with-password nil) (liece-send "USER %s * * :%s" (or (user-real-login-name) "Nobody") (if (and liece-name (not (string= liece-name ""))) liece-name "No Name")) (liece-send "NICK %s" liece-nickname) ;; We have to set `liece-real-nickname' here because IRC server doesn't ;; notify the real nickname to the user. (or liece-real-nickname (setq liece-real-nickname (truncate-string liece-nickname liece-nick-max-length))) (setq liece-nickname-last liece-real-nickname liece-nick-accepted 'sent liece-after-registration t)))) (defun liece-open-server-internal (host &optional service type) "Open connection to chat server on HOST by SERVICE (default is irc). Optional argument TYPE specifies connection types such as `program'." (let ((liece-tcp-connection-type type) process) (as-binary-process (setq process (liece-open-network-stream "IRC" " *IRC*" host (or service "irc")))) (setq liece-server-buffer (process-buffer process)) (save-excursion (set-buffer liece-server-buffer) (set-buffer-multibyte nil) (kill-all-local-variables) (buffer-disable-undo) (erase-buffer)) process)) (defun liece-initialize-timers () "Initialise internal timers." (dolist (timer liece-timers) (if (caddr timer) (cancel-timer (caddr timer)) (let ((handler (car timer)) (interval (cadr timer))) (and (liece-functionp handler) (symbolp interval) (boundp interval) (setq interval (symbol-value interval)) (setcdr (cdr timer) (list (run-at-time 1 interval handler))))))) (setq liece-timers-list-initialized-p t)) (defun liece-read-variables-files (&optional file) "Read variables FILEs." (and (not (file-directory-p liece-directory)) (file-exists-p liece-directory) (yes-or-no-p "Upgrade the location of the data files? ") (let ((file (expand-file-name (make-temp-name "liece") temporary-file-directory))) (unwind-protect (progn (rename-file liece-directory file 'ok-if-exists) (make-directory liece-directory) (copy-file file (expand-file-name (file-name-nondirectory liece-variables-file) liece-directory))) (ignore-errors (delete-file file))))) (or (file-directory-p liece-directory) (make-directory liece-directory)) (let ((files (if file (progn (setq liece-variables-file file liece-variables-files (list file))) liece-variables-files))) (dolist (file files) (if (file-readable-p (expand-file-name file)) (load (expand-file-name file) t))))) ;;;###autoload (defun liece (&optional confirm) "Connect to the IRC server and start chatting. If optional argument CONFIRM is non-nil, ask which IRC server to connect. If already connected, just pop up the windows." (interactive "P") (liece-read-variables-files (car command-line-args-left)) (pop command-line-args-left) (run-hooks 'liece-after-load-startup-hook) ;; Save initial state of window configuration. (when (interactive-p) (liece-window-configuration-push)) (unless liece-intl-message-alist (liece-intl-load-catalogue)) (if (liece-server-opened) (liece-configure-windows) (switch-to-buffer (liece-get-buffer-create liece-command-buffer)) (unless (eq major-mode 'liece-command-mode) (liece-command-mode)) (liece-start-server confirm) (let (buffer-read-only) (unless liece-keep-buffers (erase-buffer)) (sit-for 0)) (liece-initialize-buffers) (liece-configure-windows) (setq liece-current-channels nil) (let ((startup-channels (if liece-startup-channel (list liece-startup-channel) liece-startup-channel-list))) (dolist (chnl startup-channels) (if (listp chnl) (liece-command-join (car chnl) (cadr chnl)) (liece-command-join chnl)))) (unless (string-equal liece-away-message "") (liece-command-away liece-away-message)) (run-hooks 'liece-startup-hook) (setq liece-obarray (or liece-obarray (make-vector liece-obarray-size nil))) (unless liece-timers-list-initialized-p (liece-initialize-timers)) (liece-command-timestamp) (message (substitute-command-keys "Type \\[describe-mode] for help")))) ;;;###liece-autoload (defun liece-command-mode () "Major mode for Liece. Normal edit function are available. Typing Return or Linefeed enters the current line in the dialogue. The following special commands are available: For a list of the generic commands type \\[liece-command-generic] ? RET. \\{liece-command-mode-map}" (interactive) (kill-all-local-variables) (setq liece-nick-alist (list (list liece-nickname)) major-mode 'liece-command-mode mode-name "Commands" liece-privmsg-partner nil liece-private-indicator nil liece-away-indicator "-" liece-beep-indicator "-" liece-freeze-indicator "-" liece-own-freeze-indicator "-" mode-line-buffer-identification (liece-mode-line-buffer-identification '("Liece: " mode-line-modified liece-private-indicator liece-away-indicator "-- " liece-current-channel " " liece-real-nickname))) (liece-suppress-mode-line-format) (use-local-map liece-command-mode-map) (when liece-display-frame-title (make-local-variable 'frame-title-format) (setq frame-title-format 'liece-channel-status-indicator)) (unless liece-blink-parens (make-local-variable 'blink-matching-paren) (setq blink-matching-paren nil)) (unless liece-command-mode-syntax-table (setq liece-command-mode-syntax-table (copy-syntax-table (syntax-table))) (set-syntax-table liece-command-mode-syntax-table) (mapcar (lambda (c) (modify-syntax-entry c "w")) "^[]{}'`")) (run-hooks 'liece-command-mode-hook)) ;;;###liece-autoload (defun liece-dialogue-mode () "Major mode for displaying the IRC dialogue. All normal editing commands are turned off. Instead, these commands are available: \\{liece-dialogue-mode-map}" (kill-all-local-variables) (make-local-variable 'liece-beep) (make-local-variable 'liece-beep-indicator) (make-local-variable 'liece-freeze) (make-local-variable 'liece-freeze-indicator) (make-local-variable 'liece-own-freeze) (make-local-variable 'liece-own-freeze-indicator) (make-local-variable 'tab-stop-list) (setq liece-beep liece-default-beep liece-beep-indicator (if liece-beep "B" "-") liece-freeze liece-default-freeze liece-freeze-indicator (if liece-freeze "F" "-") liece-own-freeze liece-default-own-freeze liece-own-freeze-indicator (if liece-own-freeze "M" "-") major-mode 'liece-dialogue-mode mode-name "Dialogue" mode-line-buffer-identification (liece-mode-line-buffer-identification '("Liece: " mode-line-modified liece-away-indicator liece-beep-indicator liece-freeze-indicator liece-own-freeze-indicator " " liece-channels-indicator " ")) buffer-read-only t tab-stop-list liece-tab-stop-list) (liece-suppress-mode-line-format) (use-local-map liece-dialogue-mode-map) (buffer-disable-undo) (unless liece-keep-buffers (erase-buffer)) (run-hooks 'liece-dialogue-mode-hook)) ;;;###liece-autoload (define-derived-mode liece-others-mode liece-dialogue-mode "Others" "Major mode for displaying the IRC others message except current channel. All normal editing commands are turned off. Instead, these commands are available: \\{liece-others-mode-map}") ;;;###liece-autoload (define-derived-mode liece-channel-mode liece-dialogue-mode "Channel" "Major mode for displaying the IRC current channel buffer. All normal editing commands are turned off. Instead, these commands are available: \\{liece-channel-mode-map}" (setq mode-line-buffer-identification (liece-mode-line-buffer-identification '("Liece: " mode-line-modified liece-away-indicator liece-beep-indicator liece-freeze-indicator liece-own-freeze-indicator " " liece-channel-indicator)))) ;;;###liece-autoload (defun liece-channel-list-mode () "Major mode for displaying channel list. All normal editing commands are turned off." (kill-all-local-variables) (setq major-mode 'liece-channel-list-mode mode-name "Channels" mode-line-buffer-identification (liece-mode-line-buffer-identification '("Liece: " liece-command-buffer-mode-indicator " ")) truncate-lines t buffer-read-only t) (use-local-map liece-channel-list-mode-map) (run-hooks 'liece-channel-list-mode-hook)) ;;;###liece-autoload (defun liece-nick-mode () "Major mode for displaying members in the IRC current channel buffer. All normal editing commands are turned off. Instead, these commands are available: \\{liece-nick-mode-map}" (kill-all-local-variables) (setq mode-line-modified "--- " major-mode 'liece-nick-mode mode-name "Liece Channel member" mode-line-buffer-identification (liece-mode-line-buffer-identification '("Liece: " liece-channel-indicator " ")) truncate-lines t buffer-read-only t) (if (boundp 'transient-mark-mode) (set (make-local-variable 'transient-mark-mode) t)) (use-local-map liece-nick-mode-map) (run-hooks 'liece-nick-mode-hook)) (fset 'liece-dialogue-beep 'liece-command-beep) (fset 'liece-dialogue-freeze 'liece-command-freeze) (fset 'liece-dialogue-own-freeze 'liece-command-own-freeze) (defun liece-initialize-buffers () "Initialize buffers." (dolist (spec liece-buffer-mode-alist) (let ((buffer (symbol-value (car spec))) (mode (cadr spec))) (or (get-buffer buffer) (save-excursion (set-buffer (liece-get-buffer-create buffer)) (or (eq major-mode mode) (null mode) (funcall mode))))))) ;;;###liece-autoload (defun liece-clear-system () "Clear all Liece variables and buffers." (interactive) (dolist (buffer liece-buffer-list) (when (and (get-buffer buffer) (buffer-live-p buffer)) (funcall liece-buffer-dispose-function buffer))) (if (vectorp liece-obarray) (dotimes (i liece-obarray-size) (aset liece-obarray i nil))) (dolist (timer liece-timers) (if (caddr timer) (cancel-timer (caddr timer))) (if (cdr timer) (setcdr (cdr timer) nil))) (setq liece-channel-buffer-alist nil liece-nick-buffer-alist nil liece-current-channels nil liece-current-channel nil liece-current-chat-partners nil liece-current-chat-partner nil liece-timers-list-initialized-p nil liece-friends-last nil liece-polling 0 liece-channel-indicator "No channel")) (defun liece-wait-for-response (regexp &optional timeout) "Wait for server response which match REGEXP. Optional argument TIMEOUT specifies connection timeout." (save-excursion (let ((status t) (wait t) (timeout (or timeout liece-connection-timeout))) (set-buffer liece-server-buffer) (with-timeout (timeout nil) (while wait (liece-accept-response) (goto-char (point-min)) (cond ((looking-at "ERROR") (setq status nil wait nil)) ((looking-at ".") (setq wait nil)))) ;; Save status message. (end-of-line) (setq liece-status-message-string (buffer-substring (point-min) (point))) (when status (while wait (goto-char (point-max)) (forward-line -1) (if (looking-at regexp) (setq wait 0) (liece-message (_ "Reading...")) (liece-accept-response)))) ;; Successfully received server response. t)))) (defun liece-accept-process-output (process &optional timeout) "Wait for output from PROCESS and message some dots. Optional argument TIMEOUT specifies connection timeout." (save-excursion (set-buffer liece-server-buffer) (accept-process-output process (or timeout 1)))) (defun liece-accept-response () "Read response of server. Only used at startup time." (unless (liece-server-opened) (cond ((not liece-reconnect-automagic) (error "Liece: Connection closed")) (liece-grow-tail (let ((liece-nickname (concat liece-nickname liece-grow-tail))) (liece))) (t (liece)))) (condition-case code (liece-accept-process-output liece-server-process) (error (or (string-equal "select error: Invalid argument" (nth 1 code)) (signal (car code) (cdr code)))))) (defmacro liece-replace-internal (buffer match defstring oldstring newstring) "Helper function only used from `liece-replace'. Replace in buffer or list of buffers BUFFER with matching MATCH. Argument DEFSTRING used when no matches are there. Argument OLDSTRING is replaced with NEWSTRING." `(save-excursion (set-buffer (get-buffer ,buffer)) (let (buffer-read-only (inhibit-read-only t)) (goto-char (point-max)) (previous-line liece-compress-treshold) (save-match-data (if (not (re-search-forward ,match nil t)) (liece-insert ,buffer ,defstring) (while (re-search-forward ,match nil t)) (beginning-of-line) (if (re-search-forward ,oldstring nil t) (replace-match ,newstring nil t) (liece-insert ,buffer ,defstring)) (liece-insert ,buffer "")))))) ;;;###liece-autoload (defun liece-replace (buffer match defstring oldstring newstring) "Replace in buffer or list of buffers BUFFER with matching MATCH. Argument DEFSTRING used when no matches are there. Argument OLDSTRING is replaced with NEWSTRING." (unless (listp buffer) (setq buffer (list buffer))) (dolist (buf buffer) (when (get-buffer buf) (liece-replace-internal buf match defstring oldstring newstring)))) (defun liece-check-buffers () "Check if there is a buffer larger than `liece-buffer-max-size'. If such a buffer is found, shrink it." (let ((liece-buffer-check-interval 0)) (when (> liece-buffer-max-size 0) (save-excursion (dolist (buffer liece-channel-buffer-alist) (set-buffer (cdr buffer)) (when (< liece-buffer-max-size (buffer-size)) (let ((inhibit-read-only t) buffer-read-only) (delete-region (point-min) (progn (goto-char (- (buffer-size) liece-buffer-min-size)) (beginning-of-line -1) (point))) (garbage-collect) (setq liece-buffer-last-check-time (current-time))))))))) (defun liece-check-buffers-if-interval-expired () "Timer handler for `liece-check-buffers'. Only used from `liece-before-insert-functions'." (and (> liece-buffer-check-interval 0) (or (null liece-buffer-last-check-time) (> (liece-time-difference (current-time) liece-buffer-last-check-time) liece-buffer-check-interval)) (liece-check-buffers))) (defun liece-refresh-buffer-window (buffer) "Center point in window of BUFFER and redisplay frame." (let ((window (liece-get-buffer-window buffer)) (last-point (point-max))) ;; skip last white spaces (while (memq (char-before last-point) '(?\n ?\t ?\ )) (setq last-point (1- last-point))) (when (and window (not (pos-visible-in-window-p last-point window))) (save-selected-window (select-window window) (goto-char last-point) (recenter (- (or liece-scroll-step 1))))))) (defmacro liece-save-point (&rest body) "Execute BODY, then goto the point that was around before BODY." (let ((liece-save-point (liece-gensym "lsp"))) `(let ((,liece-save-point (point-marker))) (unwind-protect (progn ,@body) (goto-char ,liece-save-point) (set-marker ,liece-save-point nil))))) (defvar liece-before-insert-functions '(liece-check-buffers-if-interval-expired liece-command-timestamp-if-interval-expired)) (defun liece-insert-internal (buffer string) "Helper function only used from `liece-insert'. Insert before point of BUFFER STRING with decorating." (run-hooks 'liece-before-insert-functions) (with-current-buffer (liece-get-buffer-create buffer) (or (eq (derived-mode-class major-mode) 'liece-dialogue-mode) (liece-dialogue-mode)) (liece-save-point (let ((inhibit-read-only t) buffer-read-only (from (goto-char (point-max)))) (unless (liece-is-message-ignored string (current-buffer)) (and liece-display-time (not (string-equal string "")) (liece-insert-time-string)) (insert string) (run-hook-with-args 'liece-after-insert-functions from (point))))) (unless (liece-frozen (current-buffer)) (liece-refresh-buffer-window (current-buffer))))) ;;;###liece-autoload (defun liece-insert (buffer string) "Insert before point of BUFFER STRING with decorating." (or (listp buffer) (setq buffer (list buffer))) (dolist (buf buffer) (when (get-buffer buf) (liece-insert-internal buf string)))) (provide 'liece) ;;; liece.el ends here