X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fliece.el;h=d9fa3aece32696e22bd70d51ff6de64649ed14c7;hb=847f4887c8a8d2a867c86156a4e685155096b279;hp=c5307976b7ef83b4ce369b0fba9a1b20fc73e37a;hpb=c1e20c3a73b50ab12045fd6815e3f23be020b511;p=elisp%2Fliece.git diff --git a/lisp/liece.el b/lisp/liece.el index c530797..d9fa3ae 100644 --- a/lisp/liece.el +++ b/lisp/liece.el @@ -30,7 +30,6 @@ ;;; Code: (require 'liece-inlines) -(require 'liece-crypt) (require 'liece-handle) (require 'liece-filter) (require 'liece-hilit) @@ -61,17 +60,12 @@ (:password liece-password) (:prescript) (:prescript-delay) - (:type) + (:type liece-tcp-connection-type) (:relay)) "Mapping from keywords to default values. All keywords that can be used must be listed here.")) -(defadvice save-buffers-kill-emacs - (before liece-save-buffers-kill-emacs activate) - "Prompt user to quit IRC explicitly." - (run-hooks 'liece-before-kill-emacs-hook) ) - -(add-hook 'liece-before-kill-emacs-hook 'liece-command-quit) +(add-hook 'kill-emacs-hook 'liece-command-quit) (defvar liece-tmp-server-name nil "Temporaly server name.") (defvar liece-buffer-last-check-time nil) @@ -94,7 +88,6 @@ For efficiency this should be prime. See documentation of intern and (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-crypt-map (make-sparse-keymap)) (defvar liece-friends-map (make-sparse-keymap)) (defvar liece-dialogue-mode-map @@ -121,8 +114,7 @@ For efficiency this should be prime. See documentation of intern and (liece-private-buffer liece-dialogue-mode) (liece-KILLS-buffer) (liece-IGNORED-buffer) - (liece-WALLOPS-buffer) - (liece-CRYPT-buffer liece-dialogue-mode))) + (liece-WALLOPS-buffer))) (eval-and-compile (dotimes (n 20) @@ -205,7 +197,6 @@ If optional argument SAFE is nil, overwrite previous definitions." "/" liece-command-generic ">" end-of-buffer "<" beginning-of-buffer - "!" liece-command-exec "|" liece-command-show-last-kill "a" liece-command-away "b" liece-command-submit-bug-report @@ -233,8 +224,6 @@ If optional argument SAFE is nil, overwrite previous definitions." "t" liece-command-topic "T" liece-command-timestamp "\C-t" liece-command-find-timestamp - "u" liece-command-lusers - "U" liece-command-userhost "v" liece-command-browse-url "w" liece-command-who) @@ -251,12 +240,6 @@ If optional argument SAFE is nil, overwrite previous definitions." "X" liece-command-ctcp-x-face-from-xbm-file "U" liece-command-ctcp-userinfo-from-minibuffer) - (liece-define-keys (liece-crypt-map "%" liece-dialogue-mode-map) - "t" liece-command-toggle-crypt - "k" liece-command-set-encryption-key - "a" liece-command-add-decryption-key - "d" liece-command-delete-decryption-key) - (liece-define-keys (liece-dcc-map "\C-d" liece-dialogue-mode-map) "s" liece-command-dcc-send "r" liece-command-dcc-receive @@ -273,14 +256,9 @@ If optional argument SAFE is nil, overwrite previous definitions." (liece-define-keys liece-command-mode-map "\r" liece-command-enter-message - [(meta return)] liece-command-enter-message-opposite-crypt-mode [tab] liece-command-complete [(meta control c) >] liece-command-push - [(meta control c) <] liece-command-pop - [(meta control c) o] liece-command-mode+o - [(meta control c) O] liece-command-mode-o - [(meta control c) v] liece-command-mode+v - [(meta control c) V] liece-command-mode-v) + [(meta control c) <] liece-command-pop) (liece-define-keys (liece-command-map "\C-c" liece-command-mode-map) "\177" liece-command-scroll-down @@ -291,16 +269,15 @@ If optional argument SAFE is nil, overwrite previous definitions." ">" liece-command-next-channel "<" liece-command-previous-channel "a" liece-command-away - "c" liece-command-inline - "\C-a" liece-command-previous-channel "\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-mode+o + "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 @@ -308,16 +285,14 @@ If optional argument SAFE is nil, overwrite previous definitions." "\C-r" mule-caesar-region "s" liece-command-set-window-style "S" liece-command-save-vars - "v" liece-command-mode+v + "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-mode+o - "O" liece-command-mode-o - "v" liece-command-mode+v - "V" liece-command-mode-v + "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 @@ -329,6 +304,7 @@ If optional argument SAFE is nil, overwrite previous definitions." (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) @@ -347,34 +323,27 @@ Return non-nil if stream is opened." "Open network stream to remote irc server. If optional argument CONFIRM is non-nil, ask the host that the server is running on." - (if (liece-server-opened) - ;; Stream is already opened. - nil - ;; Open IRC server. - (when (or confirm (null liece-server)) - (setq liece-server - (liece-minibuffer-completing-default-read - (_ "IRC server: ") - liece-server-alist))) - (and confirm - liece-ask-for-nickname - (setq liece-nickname - (read-string (_ "Enter your nickname: ") liece-nickname))) - ;; If no server name is given, local host is assumed. - (and - (stringp liece-server) - (string-equal liece-server "") - (setq liece-server (system-name))) - (let ((host (liece-server-host))) - (liece-message - (_ "Connecting to IRC server on %s...") host) - (cond - ((liece-open-server liece-server liece-service)) - ((and (stringp liece-status-message-string) - (> (length liece-status-message-string) 0)) - ;; Show valuable message if available. - (error liece-status-message-string)) - (t (error (_ "Cannot open IRC server on %s") host)))))) + (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." @@ -392,15 +361,21 @@ is running on." (unwind-protect (progn ;; Unset default sentinel function before closing connection. - (and - liece-server-process - (eq (quote liece-sentinel) - (process-sentinel liece-server-process)) - (set-process-sentinel liece-server-process nil)) - ;; We cannot send QUIT command unless the process is running. + (when (and liece-server-process + (eq 'liece-sentinel + (process-sentinel liece-server-process))) + (set-process-sentinel liece-server-process nil)) (if (liece-server-opened) - (liece-send "QUIT"))) - (liece-close-server-internal))) + (liece-command-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. @@ -413,9 +388,9 @@ the `liece-server-keyword-map' variable." (lambda (keyword) (list (intern (substring (symbol-name (car keyword)) 1)) (if (cadr keyword) - `(or (plist-get plist ',(car keyword)) + `(or (plist-get ,plist ',(car keyword)) ,(cadr keyword)) - `(plist-get plist ',(car keyword))))) + `(plist-get ,plist ',(car keyword))))) liece-server-keyword-map) ,@body)) @@ -444,111 +419,71 @@ the `liece-server-keyword-map' variable." "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." - (let* ((host (or host (getenv "IRCSERVER"))) - (plist - (if (listp host) - host - (or (cdr (string-assoc-ignore-case host liece-server-alist)) - (liece-server-parse-string host)))) - status) - (setq liece-status-message-string "") - (when (stringp plist) ;; Old style server entry... - (setq plist (liece-server-parse-string host))) - (when (and (stringp host) - (null (string-assoc-ignore-case host liece-server-alist))) - (push (cons host plist) liece-server-alist) - (setq liece-save-variables-are-dirty t)) - (liece-server-keyword-bind plist - ;; Execute preconnecting script - (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);; temporary - (liece-message (_ "Connecting to IRC server %s...") host) - (cond - ((null host) - (setq liece-status-message-string - (_ "IRC server is not specified."))) - ((liece-open-server-internal host service type) - (setq liece-after-registration nil) - (liece-maybe-poll) - (setq status (liece-wait-for-response "^:[^ ]+ [4P][5O][1N][ G]")) - (if (null status) - (progn - (setq liece-status-message-string - (format (_ "Connection to %s timed out") host)) - ;; We have to close connection here, since the function - ;; `liece-server-opened' may return incorrect status. - (liece-close-server-internal)) - (setq liece-after-registration t) - (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 ((passwd-echo ?*) password) - (setq password (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")) - (or liece-real-nickname - (setq liece-real-nickname liece-nickname)) + (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 ((passwd-echo ?*) password) + (setq password (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-real-nickname liece-nick-max-length) - liece-nickname-last liece-real-nickname - liece-nick-accepted 'sent - liece-after-registration t) - (liece-send "NICK %s" liece-real-nickname))))) - status)) + (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'." - (condition-case err - (save-excursion - ;; Initialize communication buffer. - (setq liece-server-buffer (liece-get-buffer-create " *IRC*")) - (set-buffer liece-server-buffer) - (set-buffer-multibyte nil) - (kill-all-local-variables) - (buffer-disable-undo) - (erase-buffer) - (cond - ((string-match "^[^\\[]" host) - (setq liece-server-process - (liece-open-network-stream-as-binary - "IRC" (current-buffer) host (or service "irc") type))) - ((not - (or - (string-match - "^\\[\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)\\]$" host) - (string-match - "^\\[\\([0-9A-Za-z]*:[0-9A-Za-z:]*\\)\\]$" host) - (string-match - "^\\[\\([0-9]+\\)\\]$" host))) - (setq liece-status-message-string - (_ "Use [nnn.nnn.nnn.nnn]") - liece-server-process nil))) - (setq liece-server-name host) - (run-hooks 'liece-server-hook) - ;; Return the server process. - liece-server-process) - (error - (setq liece-status-message-string (cadr err)) nil))) + (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." @@ -613,7 +548,8 @@ If already connected, just pop up the windows." (liece-get-buffer-create liece-command-buffer)) (unless (eq major-mode 'liece-command-mode) (liece-command-mode)) - (liece-start-server confirm)) + (unless (liece-server-opened) + (liece-start-server confirm))) (if (not (liece-server-opened)) (liece-command-quit) ;; IRC server is successfully open. @@ -624,9 +560,6 @@ If already connected, just pop up the windows." (erase-buffer)) (sit-for 0)) - (liece-set-crypt-indicator) - (liece-crypt-initialize) - (liece-initialize-buffers) (liece-configure-windows) (setq liece-current-channels nil) @@ -661,7 +594,6 @@ For a list of the generic commands type \\[liece-command-generic] ? RET. (interactive) (kill-all-local-variables) - (liece-set-crypt-indicator) (setq liece-nick-alist (list (list liece-nickname)) major-mode 'liece-command-mode mode-name "Commands" @@ -677,7 +609,6 @@ For a list of the generic commands type \\[liece-command-generic] ? RET. mode-line-modified liece-private-indicator liece-away-indicator - liece-crypt-indicator "-- " liece-current-channel " " liece-real-nickname))) (liece-suppress-mode-line-format) (use-local-map liece-command-mode-map) @@ -731,7 +662,6 @@ Instead, these commands are available: mode-line-modified liece-away-indicator liece-beep-indicator - liece-crypt-indicator liece-freeze-indicator liece-own-freeze-indicator " " liece-channels-indicator " ")) @@ -767,7 +697,6 @@ Instead, these commands are available: mode-line-modified liece-away-indicator liece-beep-indicator - liece-crypt-indicator liece-freeze-indicator liece-own-freeze-indicator " " @@ -822,8 +751,7 @@ Instead, these commands are available: (set-buffer (liece-get-buffer-create buffer)) (or (eq major-mode mode) (null mode) - (funcall mode))))) - )) + (funcall mode))))))) ;;;###liece-autoload (defun liece-clear-system () @@ -831,7 +759,7 @@ Instead, these commands are available: (interactive) (dolist (buffer liece-buffer-list) (when (and (get-buffer buffer) (buffer-live-p buffer)) - (bury-buffer buffer))) + (funcall liece-buffer-dispose-function buffer))) (if (vectorp liece-obarray) (dotimes (i liece-obarray-size) (aset liece-obarray i nil))) @@ -955,7 +883,7 @@ If such a buffer is found, shrink it." (defun liece-check-buffers-if-interval-expired () "Timer handler for `liece-check-buffers'. -Only used from `liece-before-insert-hook'." +Only used from `liece-before-insert-functions'." (and (> liece-buffer-check-interval 0) (or (null liece-buffer-last-check-time) (> (liece-time-difference liece-buffer-last-check-time @@ -988,7 +916,7 @@ Only used from `liece-before-insert-hook'." (goto-char ,liece-save-point) (set-marker ,liece-save-point nil))))) -(defvar liece-before-insert-hook +(defvar liece-before-insert-functions '(liece-check-buffers-if-interval-expired liece-command-timestamp-if-interval-expired)) @@ -996,7 +924,7 @@ Only used from `liece-before-insert-hook'." "Helper function only used from `liece-insert'. Insert before point of BUFFER STRING with decorating." - (run-hooks 'liece-before-insert-hook) + (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)) @@ -1008,7 +936,7 @@ Insert before point of BUFFER STRING with decorating." (and liece-display-time (not (string-equal string "")) (liece-insert-time-string)) (insert string) - (run-hook-with-args 'liece-insert-hook from (point))))) + (run-hook-with-args 'liece-after-insert-functions from (point))))) (unless (liece-frozen (current-buffer)) (liece-refresh-buffer-window (current-buffer)))))