;;; Code:
(require 'liece-inlines)
-(require 'liece-crypt)
(require 'liece-handle)
(require 'liece-filter)
(require 'liece-hilit)
(: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)
(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
(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)
"/" 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
+ "B" liece-dialogue-beep
"c" liece-command-point-back-to-command-buffer
"f" liece-command-finger
"F" liece-dialogue-freeze
"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)
"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
(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
">" 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
"\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
(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)
"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."
liece-server nil))
;;;###liece-autoload
-(defun liece-close-server ()
+(defun liece-close-server (&optional quit-string)
"Close chat server."
(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)))
+ (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.
(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))
"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 ((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-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-to-width 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."
(liece-intl-load-catalogue))
(if (liece-server-opened)
(liece-configure-windows)
- (unwind-protect
- (progn
- (switch-to-buffer
- (liece-get-buffer-create liece-command-buffer))
- (unless (eq major-mode 'liece-command-mode)
- (liece-command-mode))
- (liece-start-server confirm))
- (if (not (liece-server-opened))
- (liece-command-quit)
- ;; IRC server is successfully open.
- (with-current-buffer liece-command-buffer
- (setq mode-line-process (concat " " (liece-server-host))))
- (let (buffer-read-only)
- (unless liece-keep-buffers
- (erase-buffer))
- (sit-for 0))
-
- (liece-set-crypt-indicator)
- (liece-crypt-initialize)
-
- (liece-initialize-buffers)
- (liece-configure-windows)
- (setq liece-current-channels nil)
- (cond
- (liece-current-channel
- (liece-command-join liece-current-channel))
- (liece-startup-channel
- (liece-command-join liece-startup-channel))
- (liece-startup-channel-list
- (dolist (chnl liece-startup-channel-list)
- (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"))))))
+ (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 ()
(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"
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
mode-line-modified
liece-private-indicator
liece-away-indicator
- liece-crypt-indicator
- "- " liece-current-channel " " liece-real-nickname)))
+ "-- " liece-current-channel " " liece-real-nickname)))
(liece-suppress-mode-line-format)
(use-local-map liece-command-mode-map)
(copy-syntax-table (syntax-table)))
(set-syntax-table liece-command-mode-syntax-table)
(mapcar
- (function (lambda (c) (modify-syntax-entry c "w")))
+ (lambda (c) (modify-syntax-entry c "w"))
"^[]{}'`"))
(run-hooks 'liece-command-mode-hook))
\\{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-freeze liece-default-freeze
+ (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" "-")
'("Liece: "
mode-line-modified
liece-away-indicator
- liece-crypt-indicator
+ liece-beep-indicator
liece-freeze-indicator
liece-own-freeze-indicator
" " liece-channels-indicator " "))
'("Liece: "
mode-line-modified
liece-away-indicator
- liece-crypt-indicator
+ liece-beep-indicator
liece-freeze-indicator
liece-own-freeze-indicator
" "
(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)
(set-buffer (liece-get-buffer-create buffer))
(or (eq major-mode mode)
(null mode)
- (funcall mode)))))
- ))
+ (funcall mode)))))))
;;;###liece-autoload
(defun liece-clear-system ()
(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)))
(delete-region (point-min)
(progn
(goto-char (- (buffer-size)
- liece-buffer-default-size))
+ liece-buffer-min-size))
(beginning-of-line -1)
(point)))
(garbage-collect)
(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
- (current-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)))
- (when (and window (not (pos-visible-in-window-p (point-max) window)))
+ (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 (point-max))
- (if (null liece-scroll-step)
- (recenter (- (liece-window-height window) 1))
- (vertical-motion
- (- (or liece-scroll-step
- (1+ (/ (liece-window-height window) 2)))
- (liece-window-height window)))
- (set-window-start window (point))
- (goto-char (point-max)))))))
+ (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."
(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))
"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))
(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)))))
projects / elisp / liece.git / blobdiff