;;; rcirc.el --- default, simple IRC client.
-;; Copyright (C) 2005 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Ryan Yeske
;; URL: http://www.nongnu.org/rcirc
;; This file 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
+;; 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
;;; Commentary:
-;; rcirc is an Internet Relay Chat (IRC) client for Emacs
+;; Internet Relay Chat (IRC) is a form of instant communication over
+;; the Internet. It is mainly designed for group (many-to-many)
+;; communication in discussion forums called channels, but also allows
+;; one-to-one communication.
-;; IRC is a form of instant communication over the Internet. It is
-;; mainly designed for group (many-to-many) communication in
-;; discussion forums called channels, but also allows one-to-one
-;; communication.
+;; Rcirc has simple defaults and clear and consistent behaviour.
+;; Message arrival timestamps, activity notification on the modeline,
+;; message filling, nick completion, and keepalive pings are all
+;; enabled by default, but can easily be adjusted or turned off. Each
+;; discussion takes place in its own buffer and there is a single
+;; server buffer per connection.
;; Open a new irc connection with:
;; M-x irc RET
+;;; Todo:
+
;;; Code:
(require 'ring)
(require 'time-date)
(eval-when-compile (require 'cl))
-(defvar rcirc-server "irc.freenode.net"
- "The default server to connect to.")
+(defgroup rcirc nil
+ "Simple IRC client."
+ :version "22.1"
+ :prefix "rcirc-"
+ :link '(custom-manual "(rcirc)")
+ :group 'applications)
+
+(defcustom rcirc-server-alist
+ '(("irc.freenode.net" :channels ("#rcirc")))
+ "An alist of IRC connections to establish when running `rcirc'.
+Each element looks like (SERVER-NAME PARAMETERS).
+
+SERVER-NAME is a string describing the server to connect
+to.
+
+The optional PARAMETERS come in pairs PARAMETER VALUE.
+
+The following parameters are recognized:
+
+`:nick'
+
+VALUE must be a string. If absent, `rcirc-default-nick' is used
+for this connection.
-(defvar rcirc-port 6667
- "The default port to connect to.")
+`:port'
-(defvar rcirc-nick (user-login-name)
- "Your nick.")
+VALUE must be a number or string. If absent,
+`rcirc-default-port' is used.
-(defvar rcirc-user-name (user-login-name)
- "Your user name sent to the server when connecting.")
+`:user-name'
-(defvar rcirc-user-full-name (if (string= (user-full-name) "")
- rcirc-user-name
- (user-full-name))
- "The full name sent to the server when connecting.")
+VALUE must be a string. If absent, `rcirc-default-user-name' is
+used.
-(defvar rcirc-startup-channels-alist nil
- "Alist of channels to join at startup.
-Each element looks like (REGEXP . CHANNEL-LIST).")
+`:full-name'
-(defvar rcirc-fill-flag t
- "*Non-nil means fill messages printed in channel buffers.")
+VALUE must be a string. If absent, `rcirc-default-full-name' is
+used.
-(defvar rcirc-fill-column nil
- "*If non-nil, fill to this column, otherwise use value of `fill-column'.")
+`:channels'
-(defvar rcirc-fill-prefix nil
+VALUE must be a list of strings describing which channels to join
+when connecting to this server. If absent, no channels will be
+connected to automatically."
+ :type '(alist :key-type string
+ :value-type (plist :options ((nick string)
+ (port integer)
+ (user-name string)
+ (full-name string)
+ (channels (repeat string)))))
+ :group 'rcirc)
+
+(defcustom rcirc-default-port 6667
+ "The default port to connect to."
+ :type 'integer
+ :group 'rcirc)
+
+(defcustom rcirc-default-nick (user-login-name)
+ "Your nick."
+ :type 'string
+ :group 'rcirc)
+
+(defcustom rcirc-default-user-name (user-login-name)
+ "Your user name sent to the server when connecting."
+ :type 'string
+ :group 'rcirc)
+
+(defcustom rcirc-default-full-name (if (string= (user-full-name) "")
+ rcirc-default-user-name
+ (user-full-name))
+ "The full name sent to the server when connecting."
+ :type 'string
+ :group 'rcirc)
+
+(defcustom rcirc-fill-flag t
+ "*Non-nil means line-wrap messages printed in channel buffers."
+ :type 'boolean
+ :group 'rcirc)
+
+(defcustom rcirc-fill-column nil
+ "*Column beyond which automatic line-wrapping should happen.
+If nil, use value of `fill-column'. If 'frame-width, use the
+maximum frame width."
+ :type '(choice (const :tag "Value of `fill-column'")
+ (const :tag "Full frame width" frame-width)
+ (integer :tag "Number of columns"))
+ :group 'rcirc)
+
+(defcustom rcirc-fill-prefix nil
"*Text to insert before filled lines.
If nil, calculate the prefix dynamically to line up text
-underneath each nick.")
+underneath each nick."
+ :type '(choice (const :tag "Dynamic" nil)
+ (string :tag "Prefix text"))
+ :group 'rcirc)
+
+(defvar rcirc-ignore-buffer-activity-flag nil
+ "If non-nil, ignore activity in this buffer.")
+(make-variable-buffer-local 'rcirc-ignore-buffer-activity-flag)
-(defvar rcirc-ignore-channel-activity nil
- "If non-nil, ignore activity in this channel.")
-(make-variable-buffer-local 'rcirc-ignore-channel-activity)
+(defvar rcirc-low-priority-flag nil
+ "If non-nil, activity in this buffer is considered low priority.")
+(make-variable-buffer-local 'rcirc-low-priority-flag)
-(defvar rcirc-ignore-all-activity-flag nil
- "*Non-nil means track activity, but do not display it in the modeline.")
+(defvar rcirc-omit-mode nil
+ "Non-nil if Rcirc-Omit mode is enabled.
+Use the command `rcirc-omit-mode' to change this variable.")
+(make-variable-buffer-local 'rcirc-omit-mode)
-(defvar rcirc-time-format "%H:%M "
+(defcustom rcirc-time-format "%H:%M "
"*Describes how timestamps are printed.
-Used as the first arg to `format-time-string'.")
+Used as the first arg to `format-time-string'."
+ :type 'string
+ :group 'rcirc)
-(defvar rcirc-input-ring-size 1024
- "*Size of input history ring.")
+(defcustom rcirc-input-ring-size 1024
+ "*Size of input history ring."
+ :type 'integer
+ :group 'rcirc)
-(defvar rcirc-read-only-flag t
- "*Non-nil means make text in irc buffers read-only.")
+(defcustom rcirc-read-only-flag t
+ "*Non-nil means make text in IRC buffers read-only."
+ :type 'boolean
+ :group 'rcirc)
-(defvar rcirc-buffer-maximum-lines nil
+(defcustom rcirc-buffer-maximum-lines nil
"*The maximum size in lines for rcirc buffers.
Channel buffers are truncated from the top to be no greater than this
-number. If zero or nil, no truncating is done.")
+number. If zero or nil, no truncating is done."
+ :type '(choice (const :tag "No truncation" nil)
+ (integer :tag "Number of lines"))
+ :group 'rcirc)
-(defvar rcirc-authinfo-file-name
- "~/.rcirc-authinfo"
- "File containing rcirc authentication passwords.
-The file consists of a single list, with each element itself a
-list with a SERVER-REGEXP string, a NICK-REGEXP string, a METHOD
-and the remaining method specific ARGUMENTS. The valid METHOD
-symbols are `nickserv', `chanserv' and `bitlbee'.
+(defcustom rcirc-scroll-show-maximum-output t
+ "*If non-nil, scroll buffer to keep the point at the bottom of
+the window."
+ :type 'boolean
+ :group 'rcirc)
+
+(defcustom rcirc-authinfo nil
+ "List of authentication passwords.
+Each element of the list is a list with a SERVER-REGEXP string
+and a method symbol followed by method specific arguments.
+
+The valid METHOD symbols are `nickserv', `chanserv' and
+`bitlbee'.
The required ARGUMENTS for each METHOD symbol are:
- `nickserv': PASSWORD
- `chanserv': CHANNEL PASSWORD
- `bitlbee': PASSWORD
+ `nickserv': NICK PASSWORD
+ `chanserv': NICK CHANNEL PASSWORD
+ `bitlbee': NICK PASSWORD
Example:
- ((\"freenode\" \"bob\" nickserv \"p455w0rd\")
- (\"freenode\" \"bob\" chanserv \"#bobland\" \"passwd99\")
- (\"bitlbee\" \"robert\" bitlbee \"sekrit\"))")
+ ((\"freenode\" nickserv \"bob\" \"p455w0rd\")
+ (\"freenode\" chanserv \"bob\" \"#bobland\" \"passwd99\")
+ (\"bitlbee\" bitlbee \"robert\" \"sekrit\"))"
+ :type '(alist :key-type (string :tag "Server")
+ :value-type (choice (list :tag "NickServ"
+ (const nickserv)
+ (string :tag "Nick")
+ (string :tag "Password"))
+ (list :tag "ChanServ"
+ (const chanserv)
+ (string :tag "Nick")
+ (string :tag "Channel")
+ (string :tag "Password"))
+ (list :tag "BitlBee"
+ (const bitlbee)
+ (string :tag "Nick")
+ (string :tag "Password"))))
+ :group 'rcirc)
-(defvar rcirc-auto-authenticate-flag (file-readable-p rcirc-authinfo-file-name)
+(defcustom rcirc-auto-authenticate-flag t
"*Non-nil means automatically send authentication string to server.
-See also `rcirc-authinfo-file-name'.")
-
-(defvar rcirc-print-hooks nil
- "Hook run after text is printed.
-Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT.")
+See also `rcirc-authinfo'."
+ :type 'boolean
+ :group 'rcirc)
-(defvar rcirc-prompt "%n> "
- "Prompt string to use in irc buffers.
+(defcustom rcirc-prompt "> "
+ "Prompt string to use in IRC buffers.
The following replacements are made:
%n is your nick.
%s is the server.
%t is the buffer target, a channel or a user.
-Setting this alone will not affect the prompt;
-use `rcirc-update-prompt' after changing this variable.")
+Setting this alone will not affect the prompt;
+use either M-x customize or also call `rcirc-update-prompt'."
+ :type 'string
+ :set 'rcirc-set-changed
+ :initialize 'custom-initialize-default
+ :group 'rcirc)
+
+(defcustom rcirc-keywords nil
+ "List of keywords to highlight in message text."
+ :type '(repeat string)
+ :group 'rcirc)
+
+(defcustom rcirc-ignore-list ()
+ "List of ignored nicks.
+Use /ignore to list them, use /ignore NICK to add or remove a nick."
+ :type '(repeat string)
+ :group 'rcirc)
+
+(defvar rcirc-ignore-list-automatic ()
+ "List of ignored nicks added to `rcirc-ignore-list' because of renaming.
+When an ignored person renames, their nick is added to both lists.
+Nicks will be removed from the automatic list on follow-up renamings or
+parts.")
+
+(defcustom rcirc-bright-nicks nil
+ "List of nicks to be emphasized.
+See `rcirc-bright-nick' face."
+ :type '(repeat string)
+ :group 'rcirc)
+
+(defcustom rcirc-dim-nicks nil
+ "List of nicks to be deemphasized.
+See `rcirc-dim-nick' face."
+ :type '(repeat string)
+ :group 'rcirc)
+
+(defcustom rcirc-print-hooks nil
+ "Hook run after text is printed.
+Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT."
+ :type 'hook
+ :group 'rcirc)
+
+(defcustom rcirc-always-use-server-buffer-flag nil
+ "Non-nil means messages without a channel target will go to the server buffer."
+ :type 'boolean
+ :group 'rcirc)
+
+(defcustom rcirc-decode-coding-system 'utf-8
+ "Coding system used to decode incoming irc messages."
+ :type 'coding-system
+ :group 'rcirc)
+
+(defcustom rcirc-encode-coding-system 'utf-8
+ "Coding system used to encode outgoing irc messages."
+ :type 'coding-system
+ :group 'rcirc)
+
+(defcustom rcirc-coding-system-alist nil
+ "Alist to decide a coding system to use for a channel I/O operation.
+The format is ((PATTERN . VAL) ...).
+PATTERN is either a string or a cons of strings.
+If PATTERN is a string, it is used to match a target.
+If PATTERN is a cons of strings, the car part is used to match a
+target, and the cdr part is used to match a server.
+VAL is either a coding system or a cons of coding systems.
+If VAL is a coding system, it is used for both decoding and encoding
+messages.
+If VAL is a cons of coding systems, the car part is used for decoding,
+and the cdr part is used for encoding."
+ :type '(alist :key-type (choice (string :tag "Channel Regexp")
+ (cons (string :tag "Channel Regexp")
+ (string :tag "Server Regexp")))
+ :value-type (choice coding-system
+ (cons (coding-system :tag "Decode")
+ (coding-system :tag "Encode"))))
+ :group 'rcirc)
+
+(defcustom rcirc-multiline-major-mode 'fundamental-mode
+ "Major-mode function to use in multiline edit buffers."
+ :type 'function
+ :group 'rcirc)
+
+(defvar rcirc-nick nil)
(defvar rcirc-prompt-start-marker nil)
(defvar rcirc-prompt-end-marker nil)
(defvar rcirc-nick-table nil)
+(defvar rcirc-nick-syntax-table
+ (let ((table (make-syntax-table text-mode-syntax-table)))
+ (mapc (lambda (c) (modify-syntax-entry c "w" table))
+ "[]\\`_^{|}-")
+ (modify-syntax-entry ?' "_" table)
+ table)
+ "Syntax table which includes all nick characters as word constituents.")
+
+;; each process has an alist of (target . buffer) pairs
+(defvar rcirc-buffer-alist nil)
+
(defvar rcirc-activity nil
- "List of channels with unviewed activity.")
+ "List of buffers with unviewed activity.")
(defvar rcirc-activity-string ""
"String displayed in modeline representing `rcirc-activity'.")
(put 'rcirc-activity-string 'risky-local-variable t)
-(defvar rcirc-process nil
- "The server process associated with this buffer.")
+(defvar rcirc-server-buffer nil
+ "The server buffer associated with this channel buffer.")
(defvar rcirc-target nil
"The channel or user associated with this buffer.")
-(defvar rcirc-channels nil
- "Joined channels.")
-
-(defvar rcirc-private-chats nil
- "Private chats open.")
-
(defvar rcirc-urls nil
"List of urls seen in the current buffer.")
+(put 'rcirc-urls 'permanent-local t)
-(defvar rcirc-keepalive-seconds 60
- "Number of seconds between keepalive pings.")
+(defvar rcirc-timeout-seconds 600
+ "Kill connection after this many seconds if there is no activity.")
+(defconst rcirc-id-string (concat "rcirc on GNU Emacs " emacs-version))
\f
-(defun rcirc-version (&optional here)
- "Return rcirc version string.
-If optional argument HERE is non-nil, insert string at point."
- (interactive "P")
- (let ((version "rcirc.el 0.9 $Revision: 1.4 $"))
- (if here
- (insert version)
- (if (interactive-p)
- (message "%s" version)
- version))))
-
(defvar rcirc-startup-channels nil)
+
;;;###autoload
-(defun rcirc (&optional server port nick channels)
- "Connect to IRC.
-
-If any of the the optional SERVER, PORT, NICK or CHANNELS are not
-supplied, they are taken from the variables `rcirc-server',
-`rcirc-port', `rcirc-nick', and `rcirc-startup-channels',
-respectively."
- (interactive (list (read-string "IRC Server: " rcirc-server)
- (read-string "IRC Port: " (number-to-string rcirc-port))
- (read-string "IRC Nick: " rcirc-nick)))
- (or server (setq server rcirc-server))
- (or port (setq port rcirc-port))
- (or nick (setq nick rcirc-nick))
- (or channels
- (setq channels
- (if (interactive-p)
- (delete ""
- (split-string
- (read-string "Channels: "
+(defun rcirc (arg)
+ "Connect to all servers in `rcirc-server-alist'.
+
+Do not connect to a server if it is already connected.
+
+If ARG is non-nil, instead prompt for connection parameters."
+ (interactive "P")
+ (if arg
+ (let* ((server (completing-read "IRC Server: "
+ rcirc-server-alist
+ nil nil
+ (caar rcirc-server-alist)))
+ (server-plist (cdr (assoc-string server rcirc-server-alist)))
+ (port (read-string "IRC Port: "
+ (number-to-string
+ (or (plist-get server-plist 'port)
+ rcirc-default-port))))
+ (nick (read-string "IRC Nick: "
+ (or (plist-get server-plist 'nick)
+ rcirc-default-nick)))
+ (channels (split-string
+ (read-string "IRC Channels: "
(mapconcat 'identity
- (rcirc-startup-channels server)
+ (plist-get server-plist
+ 'channels)
" "))
- "[, ]+"))
- (rcirc-startup-channels server))))
- (or global-mode-string (setq global-mode-string '("")))
- (and (not (memq 'rcirc-activity-string global-mode-string))
- (setq global-mode-string
- (append global-mode-string '(rcirc-activity-string))))
- (add-hook 'window-configuration-change-hook 'rcirc-update-activity)
- (rcirc-connect server port nick rcirc-user-name rcirc-user-full-name
- channels))
+ "[, ]+" t)))
+ (rcirc-connect server port nick rcirc-default-user-name
+ rcirc-default-full-name
+ channels))
+ ;; connect to servers in `rcirc-server-alist'
+ (let (connected-servers)
+ (dolist (c rcirc-server-alist)
+ (let ((server (car c))
+ (nick (or (plist-get (cdr c) :nick) rcirc-default-nick))
+ (port (or (plist-get (cdr c) :port) rcirc-default-port))
+ (user-name (or (plist-get (cdr c) :user-name)
+ rcirc-default-user-name))
+ (full-name (or (plist-get (cdr c) :full-name)
+ rcirc-default-full-name))
+ (channels (plist-get (cdr c) :channels)))
+ (when server
+ (let (connected)
+ (dolist (p (rcirc-process-list))
+ (when (string= server (process-name p))
+ (setq connected p)))
+ (if (not connected)
+ (condition-case e
+ (rcirc-connect server port nick user-name
+ full-name channels)
+ (quit (message "Quit connecting to %s" server)))
+ (with-current-buffer (process-buffer connected)
+ (setq connected-servers
+ (cons (process-contact (get-buffer-process
+ (current-buffer)) :host)
+ connected-servers))))))))
+ (when connected-servers
+ (message "Already connected to %s"
+ (concat (mapconcat 'identity (butlast connected-servers) ", ")
+ ", and " (car (last connected-servers))))))))
;;;###autoload
(defalias 'irc 'rcirc)
\f
(defvar rcirc-process-output nil)
-(defvar rcirc-last-buffer nil)
(defvar rcirc-topic nil)
(defvar rcirc-keepalive-timer nil)
-(make-variable-buffer-local 'rcirc-topic)
-(defun rcirc-connect (server port nick user-name full-name startup-channels)
- "Return a connection to SERVER on PORT.
+(defvar rcirc-last-server-message-time nil)
+(defvar rcirc-server nil) ; server provided by server
+(defvar rcirc-server-name nil) ; server name given by 001 response
+(defvar rcirc-timeout-timer nil)
+(defvar rcirc-user-disconnect nil)
+(defvar rcirc-connecting nil)
+(defvar rcirc-process nil)
-User will identify using the values of NICK, USER-NAME and
-FULL-NAME. The variable list of channel names in
-STARTUP-CHANNELS will automatically be joined on startup."
+;;;###autoload
+(defun rcirc-connect (server &optional port nick user-name full-name
+ startup-channels)
(save-excursion
(message "Connecting to %s..." server)
(let* ((inhibit-eol-conversion)
- (port-number (if (stringp port)
- (string-to-number port)
- port))
- (process (open-network-stream server nil server port-number)))
+ (port-number (if port
+ (if (stringp port)
+ (string-to-number port)
+ port)
+ rcirc-default-port))
+ (nick (or nick rcirc-default-nick))
+ (user-name (or user-name rcirc-default-user-name))
+ (full-name (or full-name rcirc-default-full-name))
+ (startup-channels startup-channels)
+ (process (make-network-process :name server :host server :service port-number)))
;; set up process
(set-process-coding-system process 'raw-text 'raw-text)
- (set-process-filter process 'rcirc-filter)
- (switch-to-buffer (concat "*" (process-name process) "*"))
+ (switch-to-buffer (rcirc-generate-new-buffer-name process nil))
(set-process-buffer process (current-buffer))
- (set-process-sentinel process 'rcirc-sentinel)
(rcirc-mode process nil)
- (make-local-variable 'rcirc-nick-table)
- (setq rcirc-nick-table (make-hash-table :test 'equal))
+ (set-process-sentinel process 'rcirc-sentinel)
+ (set-process-filter process 'rcirc-filter)
+ (make-local-variable 'rcirc-process)
+ (setq rcirc-process process)
(make-local-variable 'rcirc-server)
(setq rcirc-server server)
+ (make-local-variable 'rcirc-server-name)
+ (setq rcirc-server-name server) ; update when we get 001 response
+ (make-local-variable 'rcirc-buffer-alist)
+ (setq rcirc-buffer-alist nil)
+ (make-local-variable 'rcirc-nick-table)
+ (setq rcirc-nick-table (make-hash-table :test 'equal))
(make-local-variable 'rcirc-nick)
(setq rcirc-nick nick)
(make-local-variable 'rcirc-process-output)
(setq rcirc-process-output nil)
- (make-local-variable 'rcirc-last-buffer)
- (setq rcirc-last-buffer (current-buffer))
- (make-local-variable 'rcirc-channels)
- (setq rcirc-channels nil)
- (make-local-variable 'rcirc-private-chats)
- (setq rcirc-private-chats nil)
(make-local-variable 'rcirc-startup-channels)
(setq rcirc-startup-channels startup-channels)
+ (make-local-variable 'rcirc-last-server-message-time)
+ (setq rcirc-last-server-message-time (current-time))
+ (make-local-variable 'rcirc-timeout-timer)
+ (setq rcirc-timeout-timer nil)
+ (make-local-variable 'rcirc-user-disconnect)
+ (setq rcirc-user-disconnect nil)
+ (make-local-variable 'rcirc-connecting)
+ (setq rcirc-connecting t)
+
+ (add-hook 'auto-save-hook 'rcirc-log-write)
;; identify
(rcirc-send-string process (concat "NICK " nick))
;; setup ping timer if necessary
(unless rcirc-keepalive-timer
- (setq rcirc-keepalive-timer
- (run-at-time 0 rcirc-keepalive-seconds 'rcirc-keepalive)))
+ (setq rcirc-keepalive-timer
+ (run-at-time 0 (/ rcirc-timeout-seconds 2) 'rcirc-keepalive)))
(message "Connecting to %s...done" server)
;; return process object
process)))
+(defmacro with-rcirc-process-buffer (process &rest body)
+ (declare (indent 1) (debug t))
+ `(with-current-buffer (process-buffer ,process)
+ ,@body))
+
+(defmacro with-rcirc-server-buffer (&rest body)
+ (declare (indent 0) (debug t))
+ `(with-current-buffer rcirc-server-buffer
+ ,@body))
+
(defun rcirc-keepalive ()
- "Send keep alive pings to active rcirc processes."
+ "Send keep alive pings to active rcirc processes.
+Kill processes that have not received a server message since the
+last ping."
(if (rcirc-process-list)
(mapc (lambda (process)
- (with-current-buffer (process-buffer process)
- (rcirc-send-string process (concat "PING " rcirc-server))))
+ (with-rcirc-process-buffer process
+ (when (not rcirc-connecting)
+ (rcirc-send-string process
+ (format "PRIVMSG %s :\C-aKEEPALIVE %f\C-a"
+ rcirc-nick
+ (time-to-seconds
+ (current-time)))))))
(rcirc-process-list))
+ ;; no processes, clean up timer
(cancel-timer rcirc-keepalive-timer)
(setq rcirc-keepalive-timer nil)))
-(defvar rcirc-log-buffer "*rcirc log*")
-(defvar rcirc-log-p nil
- "If non-nil, write information to `rcirc-log-buffer'.")
-(defun rcirc-log (process text)
+(defun rcirc-handler-ctcp-KEEPALIVE (process target sender message)
+ (with-rcirc-process-buffer process
+ (setq header-line-format (format "%f" (- (time-to-seconds (current-time))
+ (string-to-number message))))))
+
+(defvar rcirc-debug-buffer " *rcirc debug*")
+(defvar rcirc-debug-flag nil
+ "If non-nil, write information to `rcirc-debug-buffer'.")
+(defun rcirc-debug (process text)
"Add an entry to the debug log including PROCESS and TEXT.
-Debug text is written to `rcirc-log-buffer' if `rcirc-log-p' is
-non-nil."
- (when rcirc-log-p
+Debug text is written to `rcirc-debug-buffer' if `rcirc-debug-flag'
+is non-nil."
+ (when rcirc-debug-flag
(save-excursion
- (save-window-excursion
- (set-buffer (get-buffer-create rcirc-log-buffer))
- (goto-char (point-max))
- (insert (concat
- "["
- (format-time-string "%Y-%m-%dT%T ") (process-name process)
- "] "
- text))))))
-
+ (set-buffer (get-buffer-create rcirc-debug-buffer))
+ (goto-char (point-max))
+ (insert (concat
+ "["
+ (format-time-string "%Y-%m-%dT%T ") (process-name process)
+ "] "
+ text)))))
+
(defvar rcirc-sentinel-hooks nil
"Hook functions called when the process sentinel is called.
Functions are called with PROCESS and SENTINEL arguments.")
(defun rcirc-sentinel (process sentinel)
"Called when PROCESS receives SENTINEL."
(let ((sentinel (replace-regexp-in-string "\n" "" sentinel)))
- (rcirc-log process (format "SENTINEL: %S %S\n" process sentinel))
- (with-current-buffer (process-buffer process)
- (dolist (target (append rcirc-channels
- rcirc-private-chats
- (list (current-buffer))))
- (rcirc-print process "rcirc.el" "ERROR" target
- (format "%s: %s (%S)"
- (process-name process)
- sentinel
- (process-status process)) t)
- ;; remove the prompt from buffers
- (with-current-buffer (if (eq target (current-buffer))
- (current-buffer)
- (rcirc-get-buffer process target))
- (let ((inhibit-read-only t))
- (delete-region rcirc-prompt-start-marker
- rcirc-prompt-end-marker)))))
- (run-hook-with-args 'rcirc-sentinel-hooks process sentinel)))
+ (rcirc-debug process (format "SENTINEL: %S %S\n" process sentinel))
+ (with-rcirc-process-buffer process
+ (dolist (buffer (cons nil (mapcar 'cdr rcirc-buffer-alist)))
+ (with-current-buffer (or buffer (current-buffer))
+ (rcirc-print process "rcirc.el" "ERROR" rcirc-target
+ (format "%s: %s (%S)"
+ (process-name process)
+ sentinel
+ (process-status process)) (not rcirc-target))
+ (rcirc-disconnect-buffer)))
+ (run-hook-with-args 'rcirc-sentinel-hooks process sentinel))))
+
+(defun rcirc-disconnect-buffer (&optional buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ ;; set rcirc-target to nil for each channel so cleanup
+ ;; doesnt happen when we reconnect
+ (setq rcirc-target nil)
+ (setq mode-line-process ":disconnected")))
(defun rcirc-process-list ()
"Return a list of rcirc processes."
(let (ps)
(mapc (lambda (p)
- (when (process-buffer p)
- (with-current-buffer (process-buffer p)
+ (when (buffer-live-p (process-buffer p))
+ (with-rcirc-process-buffer p
(when (eq major-mode 'rcirc-mode)
(setq ps (cons p ps))))))
(process-list))
ps))
(defvar rcirc-receive-message-hooks nil
- "Hook functions run when a message is recieved from server.
-Function is called with PROCESS COMMAND SENDER ARGS and LINE.")
+ "Hook functions run when a message is received from server.
+Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.")
(defun rcirc-filter (process output)
"Called when PROCESS receives OUTPUT."
- (rcirc-log process output)
- (with-current-buffer (process-buffer process)
+ (rcirc-debug process output)
+ (rcirc-reschedule-timeout process)
+ (with-rcirc-process-buffer process
+ (setq rcirc-last-server-message-time (current-time))
(setq rcirc-process-output (concat rcirc-process-output output))
(when (= (aref rcirc-process-output
(1- (length rcirc-process-output))) ?\n)
(mapc (lambda (line)
(rcirc-process-server-response process line))
- (delete "" (split-string rcirc-process-output "[\n\r]")))
+ (split-string rcirc-process-output "[\n\r]" t))
(setq rcirc-process-output nil))))
-(defvar rcirc-trap-errors nil)
+(defun rcirc-reschedule-timeout (process)
+ (with-rcirc-process-buffer process
+ (when (not rcirc-connecting)
+ (with-rcirc-process-buffer process
+ (when rcirc-timeout-timer (cancel-timer rcirc-timeout-timer))
+ (setq rcirc-timeout-timer (run-at-time rcirc-timeout-seconds nil
+ 'rcirc-delete-process
+ process))))))
+
+(defun rcirc-delete-process (process)
+ (delete-process process))
+
+(defvar rcirc-trap-errors-flag t)
(defun rcirc-process-server-response (process text)
- (if rcirc-trap-errors
+ (if rcirc-trap-errors-flag
(condition-case err
(rcirc-process-server-response-1 process text)
(error
(rcirc-print process "RCIRC" "ERROR" nil
- (format "rcirc: error processing: \"%s\" %s" text err))))
+ (format "\"%s\" %s" text err) t)))
(rcirc-process-server-response-1 process text)))
(defun rcirc-process-server-response-1 (process text)
(if (string-match "^\\(:\\([^ ]+\\) \\)?\\([^ ]+\\) \\(.+\\)$" text)
- (let* ((sender (match-string 2 text))
+ (let* ((user (match-string 2 text))
+ (sender (rcirc-user-nick user))
(cmd (match-string 3 text))
(args (match-string 4 text))
(handler (intern-soft (concat "rcirc-handler-" cmd))))
(string-match "^\\([^:]*\\):?\\(.+\\)?$" args)
(let* ((args1 (match-string 1 args))
(args2 (match-string 2 args))
- (args (append (delete "" (split-string args1 " "))
- (list args2))))
+ (args (delq nil (append (split-string args1 " " t)
+ (list args2)))))
(if (not (fboundp handler))
(rcirc-handler-generic process cmd sender args text)
(funcall handler process sender args text))
process cmd sender args text)))
(message "UNHANDLED: %s" text)))
-(defun rcirc-handler-generic (process command sender args text)
+(defvar rcirc-responses-no-activity '("305" "306")
+ "Responses that don't trigger activity in the mode-line indicator.")
+
+(defun rcirc-handler-generic (process response sender args text)
"Generic server response handler."
- (rcirc-print process sender command nil
- (mapconcat 'identity (cdr args) " ")))
+ (rcirc-print process sender response nil
+ (mapconcat 'identity (cdr args) " ")
+ (not (member response rcirc-responses-no-activity))))
(defun rcirc-send-string (process string)
"Send PROCESS a STRING plus a newline."
- (let ((string (concat (encode-coding-string string
- buffer-file-coding-system)
+ (let ((string (concat (encode-coding-string string rcirc-encode-coding-system)
"\n")))
- (rcirc-log process string)
+ (unless (eq (process-status process) 'open)
+ (error "Network connection to %s is not open"
+ (process-name process)))
+ (rcirc-debug process string)
(process-send-string process string)))
-(defun rcirc-server (process)
- "Return PROCESS server, given by the 001 response."
- (with-current-buffer (process-buffer process)
- rcirc-server))
+(defun rcirc-buffer-process (&optional buffer)
+ "Return the process associated with channel BUFFER.
+With no argument or nil as argument, use the current buffer."
+ (or (get-buffer-process (if buffer
+ (with-current-buffer buffer
+ rcirc-server-buffer)
+ rcirc-server-buffer))
+ rcirc-process))
+
+(defun rcirc-server-name (process)
+ "Return PROCESS server name, given by the 001 response."
+ (with-rcirc-process-buffer process
+ (or rcirc-server-name
+ (warn "server name for process %S unknown" process))))
(defun rcirc-nick (process)
"Return PROCESS nick."
- (with-current-buffer (process-buffer process)
- rcirc-nick))
+ (with-rcirc-process-buffer process
+ (or rcirc-nick rcirc-default-nick)))
+
+(defun rcirc-buffer-nick (&optional buffer)
+ "Return the nick associated with BUFFER.
+With no argument or nil as argument, use the current buffer."
+ (with-current-buffer (or buffer (current-buffer))
+ (with-current-buffer rcirc-server-buffer
+ (or rcirc-nick rcirc-default-nick))))
-(defvar rcirc-max-message-length 450
+(defvar rcirc-max-message-length 420
"Messages longer than this value will be split.")
-(defun rcirc-send-message (process target message &optional noticep)
+(defun rcirc-send-message (process target message &optional noticep silent)
"Send TARGET associated with PROCESS a privmsg with text MESSAGE.
-If NOTICEP is non-nil, send a notice instead of privmsg."
+If NOTICEP is non-nil, send a notice instead of privmsg.
+If SILENT is non-nil, do not print the message in any irc buffer."
;; max message length is 512 including CRLF
(let* ((response (if noticep "NOTICE" "PRIVMSG"))
(oversize (> (length message) rcirc-max-message-length))
text))
(more (if oversize
(substring message rcirc-max-message-length))))
- (rcirc-print process (rcirc-nick process) response target text)
+ (rcirc-get-buffer-create process target)
(rcirc-send-string process (concat response " " target " :" text))
- (if more
- (rcirc-send-message process target more noticep))))
+ (unless silent
+ (rcirc-print process (rcirc-nick process) response target text))
+ (when more (rcirc-send-message process target more noticep))))
(defvar rcirc-input-ring nil)
(defvar rcirc-input-ring-index 0)
(defvar rcirc-nick-completions nil)
(defvar rcirc-nick-completion-start-offset nil)
+
(defun rcirc-complete-nick ()
"Cycle through nick completions from list of nicks in channel."
(interactive)
- (if (eq last-command 'rcirc-complete-nick)
+ (if (eq last-command this-command)
(setq rcirc-nick-completions
(append (cdr rcirc-nick-completions)
(list (car rcirc-nick-completions))))
rcirc-prompt-end-marker))
(setq rcirc-nick-completions
(let ((completion-ignore-case t))
- (all-completions
- (buffer-substring
+ (all-completions
+ (buffer-substring
(+ rcirc-prompt-end-marker
rcirc-nick-completion-start-offset)
(point))
(mapcar (lambda (x) (cons x nil))
- (rcirc-channel-nicks rcirc-process
- (rcirc-buffer-target)))))))
+ (rcirc-channel-nicks (rcirc-buffer-process)
+ rcirc-target))))))
(let ((completion (car rcirc-nick-completions)))
(when completion
- (delete-region (+ rcirc-prompt-end-marker
- rcirc-nick-completion-start-offset)
- (point))
+ (rcirc-put-nick-channel (rcirc-buffer-process) completion rcirc-target)
+ (delete-region (+ rcirc-prompt-end-marker
+ rcirc-nick-completion-start-offset)
+ (point))
(insert (concat completion
- (if (= (+ rcirc-prompt-end-marker
+ (if (= (+ rcirc-prompt-end-marker
rcirc-nick-completion-start-offset)
rcirc-prompt-end-marker)
": "))))))
-(defun rcirc-buffer-target (&optional buffer)
- "Return the name of target for BUFFER.
-If buffer is nil, return the target of the current buffer."
- (with-current-buffer (or buffer (current-buffer))
- rcirc-target))
+(defun set-rcirc-decode-coding-system (coding-system)
+ "Set the decode coding system used in this channel."
+ (interactive "zCoding system for incoming messages: ")
+ (setq rcirc-decode-coding-system coding-system))
+
+(defun set-rcirc-encode-coding-system (coding-system)
+ "Set the encode coding system used in this channel."
+ (interactive "zCoding system for outgoing messages: ")
+ (setq rcirc-encode-coding-system coding-system))
(defvar rcirc-mode-map (make-sparse-keymap)
"Keymap for rcirc mode.")
(define-key rcirc-mode-map (kbd "C-c C-c") 'rcirc-edit-multiline)
(define-key rcirc-mode-map (kbd "C-c C-j") 'rcirc-cmd-join)
(define-key rcirc-mode-map (kbd "C-c C-k") 'rcirc-cmd-kick)
-(define-key rcirc-mode-map (kbd "C-c C-l") 'rcirc-cmd-list)
+(define-key rcirc-mode-map (kbd "C-c C-l") 'rcirc-toggle-low-priority)
(define-key rcirc-mode-map (kbd "C-c C-d") 'rcirc-cmd-mode)
(define-key rcirc-mode-map (kbd "C-c C-m") 'rcirc-cmd-msg)
(define-key rcirc-mode-map (kbd "C-c C-r") 'rcirc-cmd-nick) ; rename
-(define-key rcirc-mode-map (kbd "C-c C-o") 'rcirc-cmd-oper)
+(define-key rcirc-mode-map (kbd "C-c C-o") 'rcirc-omit-mode)
(define-key rcirc-mode-map (kbd "C-c C-p") 'rcirc-cmd-part)
(define-key rcirc-mode-map (kbd "C-c C-q") 'rcirc-cmd-query)
(define-key rcirc-mode-map (kbd "C-c C-t") 'rcirc-cmd-topic)
(define-key rcirc-mode-map (kbd "C-c C-w") 'rcirc-cmd-whois)
(define-key rcirc-mode-map (kbd "C-c C-x") 'rcirc-cmd-quit)
(define-key rcirc-mode-map (kbd "C-c TAB") ; C-i
- 'rcirc-toggle-ignore-channel-activity)
+ 'rcirc-toggle-ignore-buffer-activity)
(define-key rcirc-mode-map (kbd "C-c C-s") 'rcirc-switch-to-server-buffer)
(define-key rcirc-mode-map (kbd "C-c C-a") 'rcirc-jump-to-first-unread-line)
-(define-key global-map (kbd "C-c `") 'rcirc-next-active-buffer)
-(define-key global-map (kbd "C-c C-@") 'rcirc-next-active-buffer)
-(define-key global-map (kbd "C-c C-SPC") 'rcirc-next-active-buffer)
+(defvar rcirc-browse-url-map (make-sparse-keymap)
+ "Keymap used for browsing URLs in `rcirc-mode'.")
+
+(define-key rcirc-browse-url-map (kbd "RET") 'rcirc-browse-url-at-point)
+(define-key rcirc-browse-url-map (kbd "<mouse-2>") 'rcirc-browse-url-at-mouse)
+
+(defvar rcirc-short-buffer-name nil
+ "Generated abbreviation to use to indicate buffer activity.")
(defvar rcirc-mode-hook nil
"Hook run when setting up rcirc buffer.")
+(defvar rcirc-last-post-time nil)
+
+(defvar rcirc-log-alist nil
+ "Alist of lines to log to disk when `rcirc-log-flag' is non-nil.
+Each element looks like (FILENAME . TEXT).")
+
(defun rcirc-mode (process target)
- "Major mode for irc channel buffers.
+ "Major mode for IRC channel buffers.
\\{rcirc-mode-map}"
(kill-all-local-variables)
(use-local-map rcirc-mode-map)
(setq mode-name "rcirc")
(setq major-mode 'rcirc-mode)
+ (setq mode-line-process nil)
(make-local-variable 'rcirc-input-ring)
(setq rcirc-input-ring (make-ring rcirc-input-ring-size))
- (make-local-variable 'rcirc-process)
- (setq rcirc-process process)
+ (make-local-variable 'rcirc-server-buffer)
+ (setq rcirc-server-buffer (process-buffer process))
(make-local-variable 'rcirc-target)
(setq rcirc-target target)
+ (make-local-variable 'rcirc-topic)
+ (setq rcirc-topic nil)
+ (make-local-variable 'rcirc-last-post-time)
+ (setq rcirc-last-post-time (current-time))
+ (make-local-variable 'fill-paragraph-function)
+ (setq fill-paragraph-function 'rcirc-fill-paragraph)
+
+ (make-local-variable 'rcirc-short-buffer-name)
+ (setq rcirc-short-buffer-name nil)
(make-local-variable 'rcirc-urls)
- (setq rcirc-urls nil)
(setq use-hard-newlines t)
- (when (rcirc-channel-p rcirc-target)
- (setq header-line-format 'rcirc-topic))
+
+ (make-local-variable 'rcirc-decode-coding-system)
+ (make-local-variable 'rcirc-encode-coding-system)
+ (dolist (i rcirc-coding-system-alist)
+ (let ((chan (if (consp (car i)) (caar i) (car i)))
+ (serv (if (consp (car i)) (cdar i) "")))
+ (when (and (string-match chan (or target ""))
+ (string-match serv (rcirc-server-name process)))
+ (setq rcirc-decode-coding-system (if (consp (cdr i)) (cadr i) (cdr i))
+ rcirc-encode-coding-system (if (consp (cdr i)) (cddr i) (cdr i))))))
;; setup the prompt and markers
(make-local-variable 'rcirc-prompt-start-marker)
(setq overlay-arrow-position (make-marker))
(set-marker overlay-arrow-position nil)
+ (setq buffer-invisibility-spec '(rcirc-ignored-user))
+
+ ;; if the user changes the major mode or kills the buffer, there is
+ ;; cleanup work to do
+ (add-hook 'change-major-mode-hook 'rcirc-change-major-mode-hook nil t)
+ (add-hook 'kill-buffer-hook 'rcirc-kill-buffer-hook nil t)
+
+ ;; add to buffer list, and update buffer abbrevs
+ (when target ; skip server buffer
+ (let ((buffer (current-buffer)))
+ (with-rcirc-process-buffer process
+ (setq rcirc-buffer-alist (cons (cons target buffer)
+ rcirc-buffer-alist))))
+ (rcirc-update-short-buffer-names))
+
(run-hooks 'rcirc-mode-hook))
-(defmacro with-rcirc-process-buffer (process &rest body)
- (declare (indent 1) (debug t))
- `(with-current-buffer (process-buffer ,process)
- ,@body))
+(defun rcirc-update-prompt (&optional all)
+ "Reset the prompt string in the current buffer.
-(defun rcirc-update-prompt ()
- "Reset the prompt string in the current buffer."
- (let ((inhibit-read-only t)
- (prompt (or rcirc-prompt "")))
- (mapc (lambda (rep)
- (setq prompt
- (replace-regexp-in-string (car rep) (cdr rep) prompt)))
- (list (cons "%n" (with-rcirc-process-buffer rcirc-process
- rcirc-nick))
- (cons "%s" (with-rcirc-process-buffer rcirc-process
- rcirc-server))
- (cons "%t" (or rcirc-target ""))))
- (save-excursion
- (delete-region rcirc-prompt-start-marker rcirc-prompt-end-marker)
- (goto-char rcirc-prompt-start-marker)
- (let ((start (point)))
- (insert-before-markers prompt)
- (set-marker rcirc-prompt-start-marker start)
- (when (not (zerop (- rcirc-prompt-end-marker
- rcirc-prompt-start-marker)))
- (add-text-properties rcirc-prompt-start-marker
- rcirc-prompt-end-marker
- (list 'face 'rcirc-prompt-face
- 'read-only t 'field t
- 'front-sticky t 'rear-nonsticky t)))))))
+If ALL is non-nil, update prompts in all IRC buffers."
+ (if all
+ (mapc (lambda (process)
+ (mapc (lambda (buffer)
+ (with-current-buffer buffer
+ (rcirc-update-prompt)))
+ (with-rcirc-process-buffer process
+ (mapcar 'cdr rcirc-buffer-alist))))
+ (rcirc-process-list))
+ (let ((inhibit-read-only t)
+ (prompt (or rcirc-prompt "")))
+ (mapc (lambda (rep)
+ (setq prompt
+ (replace-regexp-in-string (car rep) (cdr rep) prompt)))
+ (list (cons "%n" (rcirc-buffer-nick))
+ (cons "%s" (with-rcirc-server-buffer rcirc-server-name))
+ (cons "%t" (or rcirc-target ""))))
+ (save-excursion
+ (delete-region rcirc-prompt-start-marker rcirc-prompt-end-marker)
+ (goto-char rcirc-prompt-start-marker)
+ (let ((start (point)))
+ (insert-before-markers prompt)
+ (set-marker rcirc-prompt-start-marker start)
+ (when (not (zerop (- rcirc-prompt-end-marker
+ rcirc-prompt-start-marker)))
+ (add-text-properties rcirc-prompt-start-marker
+ rcirc-prompt-end-marker
+ (list 'face 'rcirc-prompt
+ 'read-only t 'field t
+ 'front-sticky t 'rear-nonsticky t))))))))
+
+(defun rcirc-set-changed (option value)
+ "Set OPTION to VALUE and do updates after a customization change."
+ (set-default option value)
+ (cond ((eq option 'rcirc-prompt)
+ (rcirc-update-prompt 'all))
+ (t
+ (error "Bad option %s" option))))
(defun rcirc-channel-p (target)
"Return t if TARGET is a channel name."
(defun rcirc-kill-buffer-hook ()
"Part the channel when killing an rcirc buffer."
(when (eq major-mode 'rcirc-mode)
- (rcirc-clear-activity (current-buffer))
- (when (and rcirc-process
- (eq (process-status rcirc-process) 'open))
+ (rcirc-clean-up-buffer "Killed buffer")))
+
+(defun rcirc-change-major-mode-hook ()
+ "Part the channel when changing the major-mode."
+ (rcirc-clean-up-buffer "Changed major mode"))
+
+(defun rcirc-clean-up-buffer (reason)
+ (let ((buffer (current-buffer)))
+ (rcirc-clear-activity buffer)
+ (when (and (rcirc-buffer-process)
+ (eq (process-status (rcirc-buffer-process)) 'open))
+ (with-rcirc-server-buffer
+ (setq rcirc-buffer-alist
+ (rassq-delete-all buffer rcirc-buffer-alist)))
+ (rcirc-update-short-buffer-names)
(if (rcirc-channel-p rcirc-target)
- (rcirc-cmd-part "" rcirc-process rcirc-target)
- ;; remove target from privchat list
- (when rcirc-target
- (let ((target (downcase rcirc-target)))
- (with-rcirc-process-buffer rcirc-process
- (setq rcirc-private-chats
- (delete target rcirc-private-chats)))))))))
-(add-hook 'kill-buffer-hook 'rcirc-kill-buffer-hook)
-
-(defun rcirc-get-buffer-name (process target)
- "Return buffer name based on PROCESS and TARGET."
- (concat (and target (downcase target)) "@" (process-name process)))
-
-(defun rcirc-get-buffer (process target &optional error)
+ (rcirc-send-string (rcirc-buffer-process)
+ (concat "PART " rcirc-target " :" reason))
+ (when rcirc-target
+ (rcirc-remove-nick-channel (rcirc-buffer-process)
+ (rcirc-buffer-nick)
+ rcirc-target))))
+ (setq rcirc-target nil)))
+
+(defun rcirc-generate-new-buffer-name (process target)
+ "Return a buffer name based on PROCESS and TARGET.
+This is used for the initial name given to IRC buffers."
+ (substring-no-properties
+ (if target
+ (concat target "@" (process-name process))
+ (concat "*" (process-name process) "*"))))
+
+(defun rcirc-get-buffer (process target &optional server)
"Return the buffer associated with the PROCESS and TARGET.
-If TARGET is nil and ERROR is nil, return the process buffer."
- (let ((buffer (and target
- (get-buffer (rcirc-get-buffer-name process target)))))
- (if (and buffer (buffer-live-p buffer))
- buffer
- (if error
- (error "Buffer associated with %s does not exist" target)
- (process-buffer process)))))
+
+If optional argument SERVER is non-nil, return the server buffer
+if there is no existing buffer for TARGET, otherwise return nil."
+ (with-rcirc-process-buffer process
+ (if (null target)
+ (current-buffer)
+ (let ((buffer (cdr (assoc-string target rcirc-buffer-alist t))))
+ (or buffer (when server (current-buffer)))))))
(defun rcirc-get-buffer-create (process target)
- "Return the buffer named associated with the PROCESS and TARGET.
-Create the buffer if it doesn't exist. If TARGET is nil, return
-the process buffer."
- (with-current-buffer (process-buffer process)
- (if (not target)
- (current-buffer)
- (let ((target (downcase target)))
- ;; add private chats to list. we dont add channels here, they
- ;; are managed by the join/part/quit handlers
- (when (and (not (rcirc-channel-p target))
- (not (member target rcirc-private-chats)))
- (with-rcirc-process-buffer process
- (setq rcirc-private-chats (cons target rcirc-private-chats))))
- ;; create and setup a buffer, or return the existing one
- (let ((bufname (rcirc-get-buffer-name process target)))
- (with-current-buffer (get-buffer-create bufname)
- (if (or (not rcirc-process)
- (not (equal (process-status rcirc-process) 'open)))
- (rcirc-mode process target)
- (setq rcirc-target target))
- (current-buffer)))))))
+ "Return the buffer associated with the PROCESS and TARGET.
+Create the buffer if it doesn't exist."
+ (let ((buffer (rcirc-get-buffer process target)))
+ (if (and buffer (buffer-live-p buffer))
+ (with-current-buffer buffer
+ (when (not rcirc-target)
+ (setq rcirc-target target))
+ buffer)
+ ;; create the buffer
+ (with-rcirc-process-buffer process
+ (let ((new-buffer (get-buffer-create
+ (rcirc-generate-new-buffer-name process target))))
+ (with-current-buffer new-buffer
+ (rcirc-mode process target))
+ (rcirc-put-nick-channel process (rcirc-nick process) target)
+ new-buffer)))))
(defun rcirc-send-input ()
"Send input to target associated with the current buffer."
(interactive)
- (if (not (eq (process-status rcirc-process) 'open))
- (error "Network connection to %s is not open"
- (process-name rcirc-process))
- ;; update last buffer
- (rcirc-set-last-buffer rcirc-process (current-buffer))
- (if (< (point) rcirc-prompt-end-marker)
- ;; copy the line down to the input area
- (progn
- (forward-line 0)
- (let ((start (if (eq (point) (point-min))
- (point)
- (if (get-text-property (1- (point)) 'hard)
- (point)
- (previous-single-property-change (point) 'hard))))
- (end (next-single-property-change (1+ (point)) 'hard)))
- (goto-char (point-max))
- (insert (replace-regexp-in-string
- "\n\\s-+" " "
- (buffer-substring-no-properties start end)))))
- ;; assume text has been read
- (when (marker-position overlay-arrow-position)
- (set-marker overlay-arrow-position nil))
- ;; process input
- (goto-char (point-max))
- (let ((target (rcirc-buffer-target))
- (start rcirc-prompt-end-marker))
- (when (not (equal 0 (- (point) start)))
- ;; delete a trailing newline
- (when (eq (point) (point-at-bol))
- (delete-backward-char 1))
- (let ((input (buffer-substring-no-properties
- rcirc-prompt-end-marker (point))))
- ;; process a /cmd
- (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" input)
- (let* ((command (match-string 1 input))
- (fun (intern-soft (concat "rcirc-cmd-" command)))
- (args (match-string 2 input)))
- (newline)
- (with-current-buffer (current-buffer)
- (delete-region rcirc-prompt-end-marker (point))
- (if (string= command "me")
- (rcirc-print rcirc-process (rcirc-nick rcirc-process)
- "ACTION" target args)
- (rcirc-print rcirc-process (rcirc-nick rcirc-process)
- "COMMAND" target input))
- (set-marker rcirc-prompt-end-marker (point))
- (if (fboundp fun)
- (funcall fun args rcirc-process target)
- (rcirc-send-string rcirc-process
- (concat command " " args)))))
- ;; send message to server
- (if (not rcirc-target)
- (message "Not joined")
- (delete-region rcirc-prompt-end-marker (point))
- (mapc (lambda (message)
- (rcirc-send-message rcirc-process target message))
- (split-string input "\n"))))
- ;; add to input-ring
- (save-excursion
- (ring-insert rcirc-input-ring input)
- (setq rcirc-input-ring-index 0))))))))
+ (if (< (point) rcirc-prompt-end-marker)
+ ;; copy the line down to the input area
+ (progn
+ (forward-line 0)
+ (let ((start (if (eq (point) (point-min))
+ (point)
+ (if (get-text-property (1- (point)) 'hard)
+ (point)
+ (previous-single-property-change (point) 'hard))))
+ (end (next-single-property-change (1+ (point)) 'hard)))
+ (goto-char (point-max))
+ (insert (replace-regexp-in-string
+ "\n\\s-+" " "
+ (buffer-substring-no-properties start end)))))
+ ;; process input
+ (goto-char (point-max))
+ (when (not (equal 0 (- (point) rcirc-prompt-end-marker)))
+ ;; delete a trailing newline
+ (when (eq (point) (point-at-bol))
+ (delete-backward-char 1))
+ (let ((input (buffer-substring-no-properties
+ rcirc-prompt-end-marker (point))))
+ (dolist (line (split-string input "\n"))
+ (rcirc-process-input-line line))
+ ;; add to input-ring
+ (save-excursion
+ (ring-insert rcirc-input-ring input)
+ (setq rcirc-input-ring-index 0))))))
+
+(defun rcirc-fill-paragraph (&optional arg)
+ (interactive "p")
+ (when (> (point) rcirc-prompt-end-marker)
+ (save-restriction
+ (narrow-to-region rcirc-prompt-end-marker (point-max))
+ (let ((fill-column rcirc-max-message-length))
+ (fill-region (point-min) (point-max))))))
+
+(defun rcirc-process-input-line (line)
+ (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" line)
+ (rcirc-process-command (match-string 1 line)
+ (match-string 2 line)
+ line)
+ (rcirc-process-message line)))
+
+(defun rcirc-process-message (line)
+ (if (not rcirc-target)
+ (message "Not joined (no target)")
+ (delete-region rcirc-prompt-end-marker (point))
+ (rcirc-send-message (rcirc-buffer-process) rcirc-target line)
+ (setq rcirc-last-post-time (current-time))))
+
+(defun rcirc-process-command (command args line)
+ (if (eq (aref command 0) ?/)
+ ;; "//text" will send "/text" as a message
+ (rcirc-process-message (substring line 1))
+ (let ((fun (intern-soft (concat "rcirc-cmd-" command)))
+ (process (rcirc-buffer-process)))
+ (newline)
+ (with-current-buffer (current-buffer)
+ (delete-region rcirc-prompt-end-marker (point))
+ (if (string= command "me")
+ (rcirc-print process (rcirc-buffer-nick)
+ "ACTION" rcirc-target args)
+ (rcirc-print process (rcirc-buffer-nick)
+ "COMMAND" rcirc-target line))
+ (set-marker rcirc-prompt-end-marker (point))
+ (if (fboundp fun)
+ (funcall fun args process rcirc-target)
+ (rcirc-send-string process
+ (concat command " :" args)))))))
(defvar rcirc-parent-buffer nil)
(defvar rcirc-window-configuration nil)
(let ((pos (1+ (- (point) rcirc-prompt-end-marker))))
(goto-char (point-max))
(let ((text (buffer-substring rcirc-prompt-end-marker (point)))
- (parent (buffer-name))
- (process rcirc-process))
+ (parent (buffer-name)))
(delete-region rcirc-prompt-end-marker (point))
(setq rcirc-window-configuration (current-window-configuration))
(pop-to-buffer (concat "*multiline " parent "*"))
- (rcirc-multiline-edit-mode)
+ (funcall rcirc-multiline-major-mode)
+ (rcirc-multiline-minor-mode 1)
(setq rcirc-parent-buffer parent)
- (setq rcirc-process process)
(insert text)
- (and (> pos 0) (goto-char pos)))))
-
-(define-derived-mode rcirc-multiline-edit-mode
- text-mode "rcirc multi"
- "Major mode for multiline edits
-\\{rcirc-multiline-edit-mode-map}"
+ (and (> pos 0) (goto-char pos))
+ (message "Type C-c C-c to return text to %s, or C-c C-k to cancel" parent))))
+
+(defvar rcirc-multiline-minor-mode-map (make-sparse-keymap)
+ "Keymap for multiline mode in rcirc.")
+(define-key rcirc-multiline-minor-mode-map
+ (kbd "C-c C-c") 'rcirc-multiline-minor-submit)
+(define-key rcirc-multiline-minor-mode-map
+ (kbd "C-x C-s") 'rcirc-multiline-minor-submit)
+(define-key rcirc-multiline-minor-mode-map
+ (kbd "C-c C-k") 'rcirc-multiline-minor-cancel)
+(define-key rcirc-multiline-minor-mode-map
+ (kbd "ESC ESC ESC") 'rcirc-multiline-minor-cancel)
+
+(define-minor-mode rcirc-multiline-minor-mode
+ "Minor mode for editing multiple lines in rcirc."
+ :init-value nil
+ :lighter " rcirc-mline"
+ :keymap rcirc-multiline-minor-mode-map
+ :global nil
+ :group 'rcirc
(make-local-variable 'rcirc-parent-buffer)
- (make-local-variable 'rcirc-process))
-
-(define-key rcirc-multiline-edit-mode-map
- (kbd "C-c C-c") 'rcirc-multiline-edit-submit)
-(define-key rcirc-multiline-edit-mode-map
- (kbd "C-x C-s") 'rcirc-multiline-edit-submit)
-(define-key rcirc-multiline-edit-mode-map
- (kbd "C-c C-k") 'rcirc-multiline-edit-cancel)
-(define-key rcirc-multiline-edit-mode-map
- (kbd "ESC ESC ESC") 'rcirc-multiline-edit-cancel)
-
-(defun rcirc-multiline-edit-submit ()
+ (put 'rcirc-parent-buffer 'permanent-local t)
+ (setq fill-column rcirc-max-message-length))
+
+(defun rcirc-multiline-minor-submit ()
"Send the text in buffer back to parent buffer."
(interactive)
- (assert (and (eq major-mode 'rcirc-multiline-edit-mode)))
- (assert rcirc-parent-buffer)
+ (untabify (point-min) (point-max))
(let ((text (buffer-substring (point-min) (point-max)))
(buffer (current-buffer))
(pos (point)))
(set-buffer rcirc-parent-buffer)
(goto-char (point-max))
(insert text)
- (goto-char (+ rcirc-prompt-end-marker (1- pos)))
(kill-buffer buffer)
- (set-window-configuration rcirc-window-configuration)))
+ (set-window-configuration rcirc-window-configuration)
+ (goto-char (+ rcirc-prompt-end-marker (1- pos)))))
-(defun rcirc-multiline-edit-cancel ()
+(defun rcirc-multiline-minor-cancel ()
"Cancel the multiline edit."
(interactive)
- (assert (and (eq major-mode 'rcirc-multiline-edit-mode)))
(kill-buffer (current-buffer))
(set-window-configuration rcirc-window-configuration))
-(defun rcirc-last-buffer (process)
- "Return the last working buffer for PROCESS.
-Used for displaying messages that don't have an explicit destination."
- (with-current-buffer (process-buffer process)
- (or (and rcirc-last-buffer
- (buffer-live-p rcirc-last-buffer)
- rcirc-last-buffer)
- (current-buffer))))
+(defun rcirc-any-buffer (process)
+ "Return a buffer for PROCESS, either the one selected or the process buffer."
+ (if rcirc-always-use-server-buffer-flag
+ (process-buffer process)
+ (let ((buffer (window-buffer (selected-window))))
+ (if (and buffer
+ (with-current-buffer buffer
+ (and (eq major-mode 'rcirc-mode)
+ (eq (rcirc-buffer-process) process))))
+ buffer
+ (process-buffer process)))))
+
+(defcustom rcirc-response-formats
+ '(("PRIVMSG" . "<%N> %m")
+ ("NOTICE" . "-%N- %m")
+ ("ACTION" . "[%N %m]")
+ ("COMMAND" . "%m")
+ ("ERROR" . "%fw!!! %m")
+ (t . "%fp*** %fs%n %r %m"))
+ "An alist of formats used for printing responses.
+The format is looked up using the response-type as a key;
+if no match is found, the default entry (with a key of `t') is used.
+
+The entry's value part should be a string, which is inserted with
+the of the following escape sequences replaced by the described values:
+
+ %m The message text
+ %n The sender's nick
+ %N The sender's nick (with face `rcirc-my-nick' or `rcirc-other-nick')
+ %r The response-type
+ %t The target
+ %fw Following text uses the face `font-lock-warning-face'
+ %fp Following text uses the face `rcirc-server-prefix'
+ %fs Following text uses the face `rcirc-server'
+ %f[FACE] Following text uses the face FACE
+ %f- Following text uses the default face
+ %% A literal `%' character"
+ :type '(alist :key-type (choice (string :tag "Type")
+ (const :tag "Default" t))
+ :value-type string)
+ :group 'rcirc)
-(defun rcirc-set-last-buffer (process buffer)
- "Set the last working buffer for PROCESS to BUFFER."
- (with-current-buffer (process-buffer process)
- (setq rcirc-last-buffer buffer)))
+(defcustom rcirc-omit-responses
+ '("JOIN" "PART" "QUIT")
+ "Responses which will be hidden when `rcirc-omit-mode' is enabled."
+ :type '(repeat string)
+ :group 'rcirc)
(defun rcirc-format-response-string (process sender response target text)
- (concat (when rcirc-time-format
- (format-time-string rcirc-time-format (current-time)))
- (cond ((or (string= response "PRIVMSG")
- (string= response "NOTICE")
- (string= response "ACTION"))
- (let (first middle end)
- (cond ((string= response "PRIVMSG")
- (setq first "<" middle "> "))
- ((string= response "NOTICE")
- (setq first "-" middle "- "))
- (t
- (setq first "[" middle " " end "]")))
- (concat first
- (rcirc-facify (rcirc-user-nick sender)
- (if (string= sender
- (rcirc-nick process))
- 'rcirc-my-nick-face
- 'rcirc-other-nick-face))
- middle
- (rcirc-mangle-text process text)
- end)))
- ((string= response "COMMAND")
- text)
- ((string= response "ERROR")
- (propertize text 'face 'font-lock-warning-face))
- (t
- (rcirc-mangle-text
- process
- (rcirc-facify
- (concat "*** "
- (when (not (string= sender (rcirc-server process)))
- (concat (rcirc-user-nick sender) " "))
- (when (zerop (string-to-number response))
- (concat response " "))
- (when (and target (not (string= target rcirc-target)))
- (concat target " "))
- text)
- 'rcirc-server-face))))))
-
-(defvar rcirc-activity-type nil)
-(make-variable-buffer-local 'rcirc-activity-type)
+ "Return a nicely-formatted response string, incorporating TEXT
+\(and perhaps other arguments). The specific formatting used
+is found by looking up RESPONSE in `rcirc-response-formats'."
+ (with-temp-buffer
+ (insert (or (cdr (assoc response rcirc-response-formats))
+ (cdr (assq t rcirc-response-formats))))
+ (goto-char (point-min))
+ (let ((start (point-min))
+ (sender (if (or (not sender)
+ (string= (rcirc-server-name process) sender))
+ ""
+ sender))
+ face)
+ (while (re-search-forward "%\\(\\(f\\(.\\)\\)\\|\\(.\\)\\)" nil t)
+ (rcirc-add-face start (match-beginning 0) face)
+ (setq start (match-beginning 0))
+ (replace-match
+ (case (aref (match-string 1) 0)
+ (?f (setq face
+ (case (string-to-char (match-string 3))
+ (?w 'font-lock-warning-face)
+ (?p 'rcirc-server-prefix)
+ (?s 'rcirc-server)
+ (t nil)))
+ "")
+ (?n sender)
+ (?N (let ((my-nick (rcirc-nick process)))
+ (save-match-data
+ (with-syntax-table rcirc-nick-syntax-table
+ (rcirc-facify sender
+ (cond ((string= sender my-nick)
+ 'rcirc-my-nick)
+ ((and rcirc-bright-nicks
+ (string-match
+ (regexp-opt rcirc-bright-nicks
+ 'words)
+ sender))
+ 'rcirc-bright-nick)
+ ((and rcirc-dim-nicks
+ (string-match
+ (regexp-opt rcirc-dim-nicks
+ 'words)
+ sender))
+ 'rcirc-dim-nick)
+ (t
+ 'rcirc-other-nick)))))))
+ (?m (propertize text 'rcirc-text text))
+ (?r response)
+ (?t (or target ""))
+ (t (concat "UNKNOWN CODE:" (match-string 0))))
+ t t nil 0)
+ (rcirc-add-face (match-beginning 0) (match-end 0) face))
+ (rcirc-add-face start (match-beginning 0) face))
+ (buffer-substring (point-min) (point-max))))
+
+(defun rcirc-target-buffer (process sender response target text)
+ "Return a buffer to print the server response."
+ (assert (not (bufferp target)))
+ (with-rcirc-process-buffer process
+ (cond ((not target)
+ (rcirc-any-buffer process))
+ ((not (rcirc-channel-p target))
+ ;; message from another user
+ (if (or (string= response "PRIVMSG")
+ (string= response "ACTION"))
+ (rcirc-get-buffer-create process (if (string= sender rcirc-nick)
+ target
+ sender))
+ (rcirc-get-buffer process target t)))
+ ((or (rcirc-get-buffer process target)
+ (rcirc-any-buffer process))))))
+
+(defvar rcirc-activity-types nil)
+(make-variable-buffer-local 'rcirc-activity-types)
+(defvar rcirc-last-sender nil)
+(make-variable-buffer-local 'rcirc-last-sender)
+
+(defcustom rcirc-log-directory "~/.emacs.d/rcirc-log"
+ "Directory to keep IRC logfiles."
+ :type 'directory
+ :group 'rcirc)
+
+(defcustom rcirc-log-flag nil
+ "Non-nil means log IRC activity to disk.
+Logfiles are kept in `rcirc-log-directory'."
+ :type 'boolean
+ :group 'rcirc)
+
(defun rcirc-print (process sender response target text &optional activity)
"Print TEXT in the buffer associated with TARGET.
Format based on SENDER and RESPONSE. If ACTIVITY is non-nil,
record activity."
- (let* ((buffer (cond ((bufferp target)
- target)
- ((not target)
- (rcirc-last-buffer process))
- ((not (rcirc-channel-p target))
- (rcirc-get-buffer-create process target))
- ((rcirc-get-buffer process target))
- (t (process-buffer process))))
- (inhibit-read-only t))
- (with-current-buffer buffer
- (let ((moving (= (point) rcirc-prompt-end-marker))
- (old-point (point-marker))
- (fill-start (marker-position rcirc-prompt-start-marker)))
-
- (unless (string= sender (rcirc-nick process))
- ;; only decode text from other senders, not ours
- (setq text (decode-coding-string text buffer-file-coding-system))
- ;; mark the line with overlay arrow
- (unless (or (marker-position overlay-arrow-position)
- (get-buffer-window (current-buffer)))
- (set-marker overlay-arrow-position
- (marker-position rcirc-prompt-start-marker))))
-
- ;; temporarily set the marker insertion-type because
- ;; insert-before-markers results in hidden text in new buffers
- (goto-char rcirc-prompt-start-marker)
- (set-marker-insertion-type rcirc-prompt-start-marker t)
- (set-marker-insertion-type rcirc-prompt-end-marker t)
- (insert
- (rcirc-format-response-string process sender response target text)
- (propertize "\n" 'hard t))
- (set-marker-insertion-type rcirc-prompt-start-marker nil)
- (set-marker-insertion-type rcirc-prompt-end-marker nil)
-
- ;; fill the text we just inserted, maybe
- (when (and rcirc-fill-flag
- (not (string= response "372"))) ;/motd
- (let ((fill-prefix
- (or rcirc-fill-prefix
- (make-string
- (+ (if rcirc-time-format
- (length (format-time-string
- rcirc-time-format))
- 0)
- (cond ((or (string= response "PRIVMSG")
- (string= response "NOTICE"))
- (+ (length (rcirc-user-nick sender))
- 2)) ; <>
- ((string= response "ACTION")
- (+ (length (rcirc-user-nick sender))
- 1)) ; [
- (t 3)) ; ***
- 1)
- ? )))
- (fill-column (or rcirc-fill-column fill-column)))
- (fill-region fill-start rcirc-prompt-start-marker 'left t)))
-
- ;; truncate buffer if it is very long
- (save-excursion
- (when (and rcirc-buffer-maximum-lines
- (> rcirc-buffer-maximum-lines 0)
- (= (forward-line (- rcirc-buffer-maximum-lines)) 0))
- (delete-region (point-min) (point))))
-
- ;; set inserted text to be read-only
- (when rcirc-read-only-flag
- (put-text-property rcirc-prompt-start-marker fill-start 'read-only t)
- (let ((inhibit-read-only t))
- (put-text-property rcirc-prompt-start-marker fill-start
- 'front-sticky t)
- (put-text-property (1- (point)) (point) 'rear-nonsticky t)))
-
- ;; set the window point for buffers show in windows
- (walk-windows (lambda (w)
- (unless (eq (selected-window) w)
- (when (and (eq (current-buffer)
+ (or text (setq text ""))
+ (unless (and (or (member sender rcirc-ignore-list)
+ (member (with-syntax-table rcirc-nick-syntax-table
+ (when (string-match "^\\([^/]\\w*\\)[:,]" text)
+ (match-string 1 text)))
+ rcirc-ignore-list))
+ (not (string= sender (rcirc-nick process))))
+ (let* ((buffer (rcirc-target-buffer process sender response target text))
+ (inhibit-read-only t))
+ (with-current-buffer buffer
+ (let ((moving (= (point) rcirc-prompt-end-marker))
+ (old-point (point-marker))
+ (fill-start (marker-position rcirc-prompt-start-marker)))
+
+ (unless (string= sender (rcirc-nick process))
+ ;; only decode text from other senders, not ours
+ (setq text (decode-coding-string text rcirc-decode-coding-system))
+ ;; mark the line with overlay arrow
+ (unless (or (marker-position overlay-arrow-position)
+ (get-buffer-window (current-buffer))
+ (member response rcirc-omit-responses))
+ (set-marker overlay-arrow-position
+ (marker-position rcirc-prompt-start-marker))))
+
+ ;; temporarily set the marker insertion-type because
+ ;; insert-before-markers results in hidden text in new buffers
+ (goto-char rcirc-prompt-start-marker)
+ (set-marker-insertion-type rcirc-prompt-start-marker t)
+ (set-marker-insertion-type rcirc-prompt-end-marker t)
+
+ (let ((start (point)))
+ (insert (rcirc-format-response-string process sender response nil
+ text)
+ (propertize "\n" 'hard t))
+
+ ;; squeeze spaces out of text before rcirc-text
+ (fill-region fill-start
+ (1- (or (next-single-property-change fill-start
+ 'rcirc-text)
+ rcirc-prompt-end-marker)))
+
+ ;; run markup functions
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start rcirc-prompt-start-marker)
+ (goto-char (or (next-single-property-change start 'rcirc-text)
+ (point)))
+ (when (rcirc-buffer-process)
+ (save-excursion (rcirc-markup-timestamp sender response))
+ (dolist (fn rcirc-markup-text-functions)
+ (save-excursion (funcall fn sender response)))
+ (save-excursion (rcirc-markup-fill sender response)))
+
+ (when rcirc-read-only-flag
+ (add-text-properties (point-min) (point-max)
+ '(read-only t front-sticky t))))
+ ;; make text omittable
+ (when (and (member response rcirc-omit-responses)
+ (> start (point-min)))
+ (put-text-property (1- start) (1- rcirc-prompt-start-marker)
+ 'invisible 'rcirc-omit))))
+
+ (set-marker-insertion-type rcirc-prompt-start-marker nil)
+ (set-marker-insertion-type rcirc-prompt-end-marker nil)
+
+ ;; truncate buffer if it is very long
+ (save-excursion
+ (when (and rcirc-buffer-maximum-lines
+ (> rcirc-buffer-maximum-lines 0)
+ (= (forward-line (- rcirc-buffer-maximum-lines)) 0))
+ (delete-region (point-min) (point))))
+
+ ;; set the window point for buffers show in windows
+ (walk-windows (lambda (w)
+ (when (and (not (eq (selected-window) w))
+ (eq (current-buffer)
(window-buffer w))
- (>= (window-point w)
+ (>= (window-point w)
rcirc-prompt-end-marker))
- (set-window-point w (point-max)))))
- nil t)
-
- ;; restore the point
- (goto-char (if moving rcirc-prompt-end-marker old-point))
-
- ;; flush undo (can we do something smarter here?)
- (buffer-disable-undo)
- (buffer-enable-undo))
-
- ;; record modeline activity
- (when activity
- (let ((nick-match
- (string-match (concat "\\b"
- (regexp-quote (rcirc-nick process))
- "\\b")
- text)))
- (when (or (not rcirc-ignore-channel-activity)
- ;; always notice when our nick is mentioned, even
- ;; if ignoring channel activity
- nick-match)
- (rcirc-record-activity
- (current-buffer)
- (when (or nick-match (not (rcirc-channel-p rcirc-target)))
- 'nick)))))
-
- (run-hook-with-args 'rcirc-print-hooks
- process sender response target text))))
-
-(defun rcirc-startup-channels (server)
- "Return the list of startup channels for server."
- (let (channels)
- (dolist (i rcirc-startup-channels-alist)
- (if (string-match (car i) server)
- (setq channels (append channels (cdr i)))))
- channels))
+ (set-window-point w (point-max))))
+ nil t)
+
+ ;; restore the point
+ (goto-char (if moving rcirc-prompt-end-marker old-point))
+
+ ;; keep window on bottom line if it was already there
+ (when rcirc-scroll-show-maximum-output
+ (walk-windows (lambda (w)
+ (when (eq (window-buffer w) (current-buffer))
+ (with-current-buffer (window-buffer w)
+ (when (eq major-mode 'rcirc-mode)
+ (with-selected-window w
+ (when (<= (- (window-height)
+ (count-screen-lines (window-point)
+ (window-start))
+ 1)
+ 0)
+ (recenter -1)))))))
+ nil t))
+
+ ;; flush undo (can we do something smarter here?)
+ (buffer-disable-undo)
+ (buffer-enable-undo))
+
+ ;; record modeline activity
+ (when (and activity
+ (not rcirc-ignore-buffer-activity-flag)
+ (not (and rcirc-dim-nicks sender
+ (string-match (regexp-opt rcirc-dim-nicks) sender)
+ (rcirc-channel-p target))))
+ (rcirc-record-activity (current-buffer)
+ (when (not (rcirc-channel-p rcirc-target))
+ 'nick)))
+
+ (when rcirc-log-flag
+ (rcirc-log process sender response target text))
+
+ (sit-for 0) ; displayed text before hook
+ (run-hook-with-args 'rcirc-print-hooks
+ process sender response target text)))))
+
+(defun rcirc-log (process sender response target text)
+ "Record line in `rcirc-log', to be later written to disk."
+ (let* ((filename (rcirc-generate-new-buffer-name process target))
+ (cell (assoc-string filename rcirc-log-alist))
+ (line (concat (format-time-string rcirc-time-format)
+ (substring-no-properties
+ (rcirc-format-response-string process sender
+ response target text))
+ "\n")))
+ (if cell
+ (setcdr cell (concat (cdr cell) line))
+ (setq rcirc-log-alist
+ (cons (cons filename line) rcirc-log-alist)))))
+
+(defun rcirc-log-write ()
+ "Flush `rcirc-log-alist' data to disk.
+
+Log data is written to `rcirc-log-directory'."
+ (make-directory rcirc-log-directory t)
+ (dolist (cell rcirc-log-alist)
+ (with-temp-buffer
+ (insert (cdr cell))
+ (write-region (point-min) (point-max)
+ (concat rcirc-log-directory "/" (car cell))
+ t 'quiet)))
+ (setq rcirc-log-alist nil))
(defun rcirc-join-channels (process channels)
"Join CHANNELS."
(save-window-excursion
- (mapc (lambda (channel)
- (with-current-buffer (process-buffer process)
- (let (rcirc-last-buffer) ; make sure /join text is
- ; printed in server buffer
- (rcirc-print process (rcirc-nick process) "COMMAND"
- nil (concat "/join " channel)))
- (rcirc-cmd-join channel process)))
- channels)))
+ (dolist (channel channels)
+ (with-rcirc-process-buffer process
+ (rcirc-cmd-join channel process)))))
\f
;;; nick management
+(defvar rcirc-nick-prefix-chars "~&@%+")
(defun rcirc-user-nick (user)
"Return the nick from USER. Remove any non-nick junk."
- (if (string-match "^[@%+]?\\([^! ]+\\)!?" (or user ""))
- (match-string 1 user)
- user))
-
-(defun rcirc-user-non-nick (user)
- "Return the non-nick portion of USER."
- (if (string-match "^[@+]?[^! ]+!?\\(.*\\)" (or user ""))
- (match-string 1 user)
- user))
+ (save-match-data
+ (if (string-match (concat "^[" rcirc-nick-prefix-chars
+ "]?\\([^! ]+\\)!?") (or user ""))
+ (match-string 1 user)
+ user)))
(defun rcirc-nick-channels (process nick)
"Return list of channels for NICK."
- (let ((nick (rcirc-user-nick nick)))
- (with-current-buffer (process-buffer process)
- (mapcar (lambda (x) (car x))
- (gethash nick rcirc-nick-table)))))
+ (with-rcirc-process-buffer process
+ (mapcar (lambda (x) (car x))
+ (gethash nick rcirc-nick-table))))
(defun rcirc-put-nick-channel (process nick channel)
"Add CHANNEL to list associated with NICK."
- (with-current-buffer (process-buffer process)
- (let* ((nick (rcirc-user-nick nick))
- (chans (gethash nick rcirc-nick-table))
- (record (assoc channel chans)))
- (if record
- (setcdr record (current-time))
- (puthash nick (cons (cons channel (current-time))
- chans)
- rcirc-nick-table)))))
+ (let ((nick (rcirc-user-nick nick)))
+ (with-rcirc-process-buffer process
+ (let* ((chans (gethash nick rcirc-nick-table))
+ (record (assoc-string channel chans t)))
+ (if record
+ (setcdr record (current-time))
+ (puthash nick (cons (cons channel (current-time))
+ chans)
+ rcirc-nick-table))))))
(defun rcirc-nick-remove (process nick)
"Remove NICK from table."
- (with-current-buffer (process-buffer process)
+ (with-rcirc-process-buffer process
(remhash nick rcirc-nick-table)))
(defun rcirc-remove-nick-channel (process nick channel)
"Remove the CHANNEL from list associated with NICK."
- (with-current-buffer (process-buffer process)
- (let* ((nick (rcirc-user-nick nick))
- (chans (gethash nick rcirc-nick-table))
- (newchans (assq-delete-all channel chans)))
+ (with-rcirc-process-buffer process
+ (let* ((chans (gethash nick rcirc-nick-table))
+ (newchans
+ ;; instead of assoc-string-delete-all:
+ (let ((record (assoc-string channel chans t)))
+ (when record
+ (setcar record 'delete)
+ (assq-delete-all 'delete chans)))))
(if newchans
(puthash nick newchans rcirc-nick-table)
(remhash nick rcirc-nick-table)))))
-(defun rcirc-channel-nicks (process channel)
- "Return the list of nicks in CHANNEL sorted by last activity."
- (with-current-buffer (process-buffer process)
- (let (nicks)
- (maphash
- (lambda (k v)
- (let ((record (assoc channel v)))
- (if record
- (setq nicks (cons (cons k (cdr record)) nicks)))))
- rcirc-nick-table)
- (mapcar (lambda (x) (car x))
- (sort nicks (lambda (x y) (time-less-p (cdr y) (cdr x))))))))
+(defun rcirc-channel-nicks (process target)
+ "Return the list of nicks associated with TARGET sorted by last activity."
+ (when target
+ (if (rcirc-channel-p target)
+ (with-rcirc-process-buffer process
+ (let (nicks)
+ (maphash
+ (lambda (k v)
+ (let ((record (assoc-string target v t)))
+ (if record
+ (setq nicks (cons (cons k (cdr record)) nicks)))))
+ rcirc-nick-table)
+ (mapcar (lambda (x) (car x))
+ (sort nicks (lambda (x y) (time-less-p (cdr y) (cdr x)))))))
+ (list target))))
+
+(defun rcirc-ignore-update-automatic (nick)
+ "Remove NICK from `rcirc-ignore-list'
+if NICK is also on `rcirc-ignore-list-automatic'."
+ (when (member nick rcirc-ignore-list-automatic)
+ (setq rcirc-ignore-list-automatic
+ (delete nick rcirc-ignore-list-automatic)
+ rcirc-ignore-list
+ (delete nick rcirc-ignore-list))))
\f
;;; activity tracking
-(or (assq 'rcirc-ignore-channel-activity minor-mode-alist)
- (setq minor-mode-alist
- (cons '(rcirc-ignore-channel-activity " Ignore") minor-mode-alist)))
+(defvar rcirc-track-minor-mode-map (make-sparse-keymap)
+ "Keymap for rcirc track minor mode.")
-(defun rcirc-toggle-ignore-channel-activity (&optional all)
- "Toggle the value of `rcirc-ignore-channel-activity'.
-If ALL is non-nil, instead toggle the value of
-`rcirc-ignore-all-activity-flag'."
- (interactive "P")
- (if all
+(define-key rcirc-track-minor-mode-map (kbd "C-c `") 'rcirc-next-active-buffer)
+(define-key rcirc-track-minor-mode-map (kbd "C-c C-@") 'rcirc-next-active-buffer)
+(define-key rcirc-track-minor-mode-map (kbd "C-c C-SPC") 'rcirc-next-active-buffer)
+
+;;;###autoload
+(define-minor-mode rcirc-track-minor-mode
+ "Global minor mode for tracking activity in rcirc buffers."
+ :init-value nil
+ :lighter ""
+ :keymap rcirc-track-minor-mode-map
+ :global t
+ :group 'rcirc
+ (or global-mode-string (setq global-mode-string '("")))
+ ;; toggle the mode-line channel indicator
+ (if rcirc-track-minor-mode
(progn
- (setq rcirc-ignore-all-activity-flag
- (not rcirc-ignore-all-activity-flag))
- (message (concat "Global activity "
- (if rcirc-ignore-all-activity-flag
- "hidden"
- "displayed")))
- (rcirc-update-activity-string))
- (setq rcirc-ignore-channel-activity
- (not rcirc-ignore-channel-activity)))
+ (and (not (memq 'rcirc-activity-string global-mode-string))
+ (setq global-mode-string
+ (append global-mode-string '(rcirc-activity-string))))
+ (add-hook 'window-configuration-change-hook
+ 'rcirc-window-configuration-change))
+ (setq global-mode-string
+ (delete 'rcirc-activity-string global-mode-string))
+ (remove-hook 'window-configuration-change-hook
+ 'rcirc-window-configuration-change)))
+
+(or (assq 'rcirc-ignore-buffer-activity-flag minor-mode-alist)
+ (setq minor-mode-alist
+ (cons '(rcirc-ignore-buffer-activity-flag " Ignore") minor-mode-alist)))
+(or (assq 'rcirc-low-priority-flag minor-mode-alist)
+ (setq minor-mode-alist
+ (cons '(rcirc-low-priority-flag " LowPri") minor-mode-alist)))
+(or (assq 'rcirc-omit-mode minor-mode-alist)
+ (setq minor-mode-alist
+ (cons '(rcirc-omit-mode " Omit") minor-mode-alist)))
+
+(defun rcirc-toggle-ignore-buffer-activity ()
+ "Toggle the value of `rcirc-ignore-buffer-activity-flag'."
+ (interactive)
+ (setq rcirc-ignore-buffer-activity-flag
+ (not rcirc-ignore-buffer-activity-flag))
+ (message (if rcirc-ignore-buffer-activity-flag
+ "Ignore activity in this buffer"
+ "Notice activity in this buffer"))
(force-mode-line-update))
-(defvar rcirc-switch-to-buffer-function 'switch-to-buffer
- "Function to use when switching buffers.
-Possible values are `switch-to-buffer', `pop-to-buffer', and
-`display-buffer'.")
+(defun rcirc-toggle-low-priority ()
+ "Toggle the value of `rcirc-low-priority-flag'."
+ (interactive)
+ (setq rcirc-low-priority-flag
+ (not rcirc-low-priority-flag))
+ (message (if rcirc-low-priority-flag
+ "Activity in this buffer is low priority"
+ "Activity in this buffer is normal priority"))
+ (force-mode-line-update))
+
+(defun rcirc-omit-mode ()
+ "Toggle the Rcirc-Omit mode.
+If enabled, \"uninteresting\" lines are not shown.
+Uninteresting lines are those whose responses are listed in
+`rcirc-omit-responses'."
+ (interactive)
+ (setq rcirc-omit-mode (not rcirc-omit-mode))
+ (let ((line (1- (count-screen-lines (point) (window-start)))))
+ (if rcirc-omit-mode
+ (progn
+ (add-to-invisibility-spec 'rcirc-omit)
+ (message "Rcirc-Omit mode enabled"))
+ (remove-from-invisibility-spec 'rcirc-omit)
+ (message "Rcirc-Omit mode disabled"))
+ (recenter line))
+ (force-mode-line-update))
(defun rcirc-switch-to-server-buffer ()
"Switch to the server buffer associated with current channel buffer."
(interactive)
- (funcall rcirc-switch-to-buffer-function (process-buffer rcirc-process)))
+ (switch-to-buffer rcirc-server-buffer))
(defun rcirc-jump-to-first-unread-line ()
"Move the point to the first unread line in this buffer."
(interactive)
- (when (marker-position overlay-arrow-position)
- (goto-char overlay-arrow-position)))
-
-(defvar rcirc-last-non-irc-buffer nil
- "The buffer to switch to when there is no more activity.")
+ (if (marker-position overlay-arrow-position)
+ (goto-char overlay-arrow-position)
+ (message "No unread messages")))
+
+(defun rcirc-non-irc-buffer ()
+ (let ((buflist (buffer-list))
+ buffer)
+ (while (and buflist (not buffer))
+ (with-current-buffer (car buflist)
+ (unless (or (eq major-mode 'rcirc-mode)
+ (= ?\s (aref (buffer-name) 0)) ; internal buffers
+ (get-buffer-window (current-buffer)))
+ (setq buffer (current-buffer))))
+ (setq buflist (cdr buflist)))
+ buffer))
(defun rcirc-next-active-buffer (arg)
- "Go to the ARGth rcirc buffer with activity.
-The function given by `rcirc-switch-to-buffer-function' is used to
-show the buffer."
- (interactive "p")
- (if rcirc-activity
- (progn
- (unless (eq major-mode 'rcirc-mode)
- (setq rcirc-last-non-irc-buffer (current-buffer)))
- (if (and (> arg 0)
- (<= arg (length rcirc-activity)))
- (funcall rcirc-switch-to-buffer-function
- (nth (1- arg) rcirc-activity))
- (message "Invalid arg: %d" arg)))
- (if (eq major-mode 'rcirc-mode)
- (if (not (and rcirc-last-non-irc-buffer
- (buffer-live-p rcirc-last-non-irc-buffer)))
- (message "No last buffer.")
- (funcall rcirc-switch-to-buffer-function rcirc-last-non-irc-buffer)
- (setq rcirc-last-non-irc-buffer nil))
- (message "No channel activity. Go start something."))))
+ "Switch to the next rcirc buffer with activity.
+With prefix ARG, go to the next low priority buffer with activity."
+ (interactive "P")
+ (let* ((pair (rcirc-split-activity rcirc-activity))
+ (lopri (car pair))
+ (hipri (cdr pair)))
+ (if (or (and (not arg) hipri)
+ (and arg lopri))
+ (switch-to-buffer (car (if arg lopri hipri)) t)
+ (if (eq major-mode 'rcirc-mode)
+ (switch-to-buffer (rcirc-non-irc-buffer))
+ (message (concat
+ "No IRC activity."
+ (when lopri
+ (concat
+ " Type C-u "
+ (key-description (this-command-keys))
+ " for low priority activity."))))))))
(defvar rcirc-activity-hooks nil
"Hook to be run when there is channel activity.
Functions are called with a single argument, the buffer with the
activity. Only run if the buffer is not visible and
-`rcirc-ignore-channel-activity' is non-nil.")
+`rcirc-ignore-buffer-activity-flag' is non-nil.")
-(defun rcirc-record-activity (buffer type)
+(defun rcirc-record-activity (buffer &optional type)
"Record BUFFER activity with TYPE."
(with-current-buffer buffer
- (when (not (get-buffer-window (current-buffer) t))
- (add-to-list 'rcirc-activity (current-buffer) 'append)
- (if (not rcirc-activity-type)
- (setq rcirc-activity-type type))
- (rcirc-update-activity-string)))
+ (let ((old-activity rcirc-activity)
+ (old-types rcirc-activity-types))
+ (when (not (get-buffer-window (current-buffer) t))
+ (setq rcirc-activity
+ (sort (add-to-list 'rcirc-activity (current-buffer))
+ (lambda (b1 b2)
+ (let ((t1 (with-current-buffer b1 rcirc-last-post-time))
+ (t2 (with-current-buffer b2 rcirc-last-post-time)))
+ (time-less-p t2 t1)))))
+ (pushnew type rcirc-activity-types)
+ (unless (and (equal rcirc-activity old-activity)
+ (member type old-types))
+ (rcirc-update-activity-string)))))
(run-hook-with-args 'rcirc-activity-hooks buffer))
(defun rcirc-clear-activity (buffer)
"Clear the BUFFER activity."
- (setq rcirc-activity (delete buffer rcirc-activity))
+ (setq rcirc-activity (remove buffer rcirc-activity))
(with-current-buffer buffer
- (setq rcirc-activity-type nil)))
+ (setq rcirc-activity-types nil)))
+(defun rcirc-clear-unread (buffer)
+ "Erase the last read message arrow from BUFFER."
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (set-marker overlay-arrow-position nil))))
+
+(defun rcirc-split-activity (activity)
+ "Return a cons cell with ACTIVITY split into (lopri . hipri)."
+ (let (lopri hipri)
+ (dolist (buf rcirc-activity)
+ (with-current-buffer buf
+ (if (and rcirc-low-priority-flag
+ (not (member 'nick rcirc-activity-types)))
+ (add-to-list 'lopri buf t)
+ (add-to-list 'hipri buf t))))
+ (cons lopri hipri)))
+
+(defvar rcirc-update-activity-string-hook nil
+ "Hook run whenever the activity string is updated.")
+
+;; TODO: add mouse properties
(defun rcirc-update-activity-string ()
"Update mode-line string."
- (setq rcirc-activity-string
- (if (or rcirc-ignore-all-activity-flag
- (not rcirc-activity))
- ""
- (concat " [" (mapconcat
- (lambda (b)
- (let ((s (rcirc-short-buffer-name b)))
- (with-current-buffer b
- (if (not (eq rcirc-activity-type 'nick))
- s
- (rcirc-facify s
- 'rcirc-mode-line-nick-face)))))
- rcirc-activity ",") "]"))))
+ (let* ((pair (rcirc-split-activity rcirc-activity))
+ (lopri (car pair))
+ (hipri (cdr pair)))
+ (setq rcirc-activity-string
+ (cond ((or hipri lopri)
+ (concat (and hipri "[")
+ (rcirc-activity-string hipri)
+ (and hipri lopri ",")
+ (and lopri
+ (concat "("
+ (rcirc-activity-string lopri)
+ ")"))
+ (and hipri "]")))
+ ((not (null (rcirc-process-list)))
+ "[]")
+ (t "[]")))
+ (run-hooks 'rcirc-update-activity-string-hook)))
+
+(defun rcirc-activity-string (buffers)
+ (mapconcat (lambda (b)
+ (let ((s (substring-no-properties (rcirc-short-buffer-name b))))
+ (with-current-buffer b
+ (dolist (type rcirc-activity-types)
+ (rcirc-add-face 0 (length s)
+ (case type
+ (nick 'rcirc-track-nick)
+ (keyword 'rcirc-track-keyword))
+ s)))
+ s))
+ buffers ","))
(defun rcirc-short-buffer-name (buffer)
"Return a short name for BUFFER to use in the modeline indicator."
(with-current-buffer buffer
- (or rcirc-target (process-name rcirc-process))))
+ (or rcirc-short-buffer-name (buffer-name))))
+
+(defun rcirc-visible-buffers ()
+ "Return a list of the visible buffers that are in rcirc-mode."
+ (let (acc)
+ (walk-windows (lambda (w)
+ (with-current-buffer (window-buffer w)
+ (when (eq major-mode 'rcirc-mode)
+ (push (current-buffer) acc)))))
+ acc))
+
+(defvar rcirc-visible-buffers nil)
+(defun rcirc-window-configuration-change ()
+ (unless (minibuffer-window-active-p (minibuffer-window))
+ ;; delay this until command has finished to make sure window is
+ ;; actually visible before clearing activity
+ (add-hook 'post-command-hook 'rcirc-window-configuration-change-1)))
+
+(defun rcirc-window-configuration-change-1 ()
+ ;; clear activity and overlay arrows
+ (let* ((old-activity rcirc-activity)
+ (hidden-buffers rcirc-visible-buffers))
+
+ (setq rcirc-visible-buffers (rcirc-visible-buffers))
+
+ (dolist (vbuf rcirc-visible-buffers)
+ (setq hidden-buffers (delq vbuf hidden-buffers))
+ ;; clear activity for all visible buffers
+ (rcirc-clear-activity vbuf))
+
+ ;; clear unread arrow from recently hidden buffers
+ (dolist (hbuf hidden-buffers)
+ (rcirc-clear-unread hbuf))
+
+ ;; remove any killed buffers from list
+ (setq rcirc-activity
+ (delq nil (mapcar (lambda (buf) (when (buffer-live-p buf) buf))
+ rcirc-activity)))
+ ;; update the mode-line string
+ (unless (equal old-activity rcirc-activity)
+ (rcirc-update-activity-string)))
-(defun rcirc-update-activity ()
- "Go through visible windows and remove buffers from activity list."
- (walk-windows (lambda (w) (rcirc-clear-activity (window-buffer w))))
- (rcirc-update-activity-string))
+ (remove-hook 'post-command-hook 'rcirc-window-configuration-change-1))
\f
+;;; buffer name abbreviation
+(defun rcirc-update-short-buffer-names ()
+ (let ((bufalist
+ (apply 'append (mapcar (lambda (process)
+ (with-rcirc-process-buffer process
+ rcirc-buffer-alist))
+ (rcirc-process-list)))))
+ (dolist (i (rcirc-abbreviate bufalist))
+ (when (buffer-live-p (cdr i))
+ (with-current-buffer (cdr i)
+ (setq rcirc-short-buffer-name (car i)))))))
+
+(defun rcirc-abbreviate (pairs)
+ (apply 'append (mapcar 'rcirc-rebuild-tree (rcirc-make-trees pairs))))
+
+(defun rcirc-rebuild-tree (tree &optional acc)
+ (let ((ch (char-to-string (car tree))))
+ (dolist (x (cdr tree))
+ (if (listp x)
+ (setq acc (append acc
+ (mapcar (lambda (y)
+ (cons (concat ch (car y))
+ (cdr y)))
+ (rcirc-rebuild-tree x))))
+ (setq acc (cons (cons ch x) acc))))
+ acc))
+
+(defun rcirc-make-trees (pairs)
+ (let (alist)
+ (mapc (lambda (pair)
+ (if (consp pair)
+ (let* ((str (car pair))
+ (data (cdr pair))
+ (char (unless (zerop (length str))
+ (aref str 0)))
+ (rest (unless (zerop (length str))
+ (substring str 1)))
+ (part (if char (assq char alist))))
+ (if part
+ ;; existing partition
+ (setcdr part (cons (cons rest data) (cdr part)))
+ ;; new partition
+ (setq alist (cons (if char
+ (list char (cons rest data))
+ data)
+ alist))))
+ (setq alist (cons pair alist))))
+ pairs)
+ ;; recurse into cdrs of alist
+ (mapc (lambda (x)
+ (when (and (listp x) (listp (cadr x)))
+ (setcdr x (if (> (length (cdr x)) 1)
+ (rcirc-make-trees (cdr x))
+ (setcdr x (list (cdadr x)))))))
+ alist)))
+\f
;;; /commands these are called with 3 args: PROCESS, TARGET, which is
;; the current buffer/channel/user, and ARGS, which is a string
;; containing the text following the /cmd.
-(defmacro defun-rcirc-command (command argument docstring interactive-form
+(defmacro defun-rcirc-command (command argument docstring interactive-form
&rest body)
"Define a command."
`(defun ,(intern (concat "rcirc-cmd-" (symbol-name command)))
(,@argument &optional process target)
- ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values of"
- "\nbuffer local variables `rcirc-process' and `rcirc-target',"
- "\nwill be used.")
+ ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values given"
+ "\nby `rcirc-buffer-process' and `rcirc-target' will be used.")
,interactive-form
- (let ((process (or process rcirc-process))
+ (let ((process (or process (rcirc-buffer-process)))
(target (or target rcirc-target)))
,@body)))
(if (null message)
(progn
(setq target (completing-read "Message nick: "
- (with-current-buffer
- (process-buffer rcirc-process)
- rcirc-nick-table)))
+ (with-rcirc-server-buffer
+ rcirc-nick-table)))
(when (> (length target) 0)
(setq message (read-string (format "Message %s: " target)))
(when (> (length message) 0)
(defun-rcirc-command query (nick)
"Open a private chat buffer to NICK."
(interactive (list (completing-read "Query nick: "
- (with-current-buffer
- (process-buffer rcirc-process)
- rcirc-nick-table))))
- (let ((new-buffer (eq (rcirc-get-buffer rcirc-process nick)
- (process-buffer rcirc-process))))
- (switch-to-buffer (rcirc-get-buffer-create process nick))
- (when new-buffer
+ (with-rcirc-server-buffer rcirc-nick-table))))
+ (let ((existing-buffer (rcirc-get-buffer process nick)))
+ (switch-to-buffer (or existing-buffer
+ (rcirc-get-buffer-create process nick)))
+ (when (not existing-buffer)
(rcirc-cmd-whois nick))))
-(defun-rcirc-command join (args)
+(defun-rcirc-command join (channel)
"Join CHANNEL."
(interactive "sJoin channel: ")
- (let* ((channel (car (split-string args)))
- (buffer (rcirc-get-buffer-create process channel)))
+ (let ((buffer (rcirc-get-buffer-create process
+ (car (split-string channel)))))
+ (rcirc-send-string process (concat "JOIN " channel))
(when (not (eq (selected-window) (minibuffer-window)))
- (funcall rcirc-switch-to-buffer-function buffer))
- (rcirc-send-string process (concat "JOIN " args))
- (rcirc-set-last-buffer process buffer)))
+ (switch-to-buffer buffer))))
+;; TODO: /part #channel reason, or consider removing #channel altogether
(defun-rcirc-command part (channel)
"Part CHANNEL."
(interactive "sPart channel: ")
(let ((channel (if (> (length channel) 0) channel target)))
- (rcirc-send-string process (concat "PART " channel " :" (rcirc-version)))))
+ (rcirc-send-string process (concat "PART " channel " :" rcirc-id-string))))
(defun-rcirc-command quit (reason)
"Send a quit message to server with REASON."
(interactive "sQuit reason: ")
- (rcirc-send-string process (concat "QUIT :" reason)))
+ (rcirc-send-string process (concat "QUIT :"
+ (if (not (zerop (length reason)))
+ reason
+ rcirc-id-string))))
(defun-rcirc-command nick (nick)
"Change nick to NICK."
"Request information from server about NICK."
(interactive (list
(completing-read "Whois: "
- (with-current-buffer
- (process-buffer rcirc-process)
- rcirc-nick-table))))
- (rcirc-set-last-buffer rcirc-process (current-buffer))
+ (with-rcirc-server-buffer rcirc-nick-table))))
(rcirc-send-string process (concat "WHOIS " nick)))
(defun-rcirc-command mode (args)
"Kick NICK from current channel."
(interactive (list
(concat (completing-read "Kick nick: "
- (rcirc-channel-nicks rcirc-process
- rcirc-target))
+ (rcirc-channel-nicks
+ (rcirc-buffer-process)
+ rcirc-target))
(read-from-minibuffer "Kick reason: "))))
(let* ((arglist (split-string arg))
- (argstring (concat (car arglist) " :"
+ (argstring (concat (car arglist) " :"
(mapconcat 'identity (cdr arglist) " "))))
(rcirc-send-string process (concat "KICK " target " " argstring))))
(if (string-match "^\\([^ ]+\\)\\s-+\\(.+\\)$" args)
(let ((target (match-string 1 args))
(request (match-string 2 args)))
- (rcirc-send-message process target
- (concat "\C-a" (upcase request) "\C-a")))
- (rcirc-print process (rcirc-nick process) "ERROR" target
+ (rcirc-send-string process
+ (format "PRIVMSG %s \C-a%s\C-a"
+ target (upcase request))))
+ (rcirc-print process (rcirc-nick process) "ERROR" nil
"usage: /ctcp NICK REQUEST")))
(defun rcirc-cmd-me (args &optional process target)
(rcirc-send-string process (format "PRIVMSG %s :\C-aACTION %s\C-a"
target args)))
+
+(defun rcirc-add-or-remove (set &optional elt)
+ (if (and elt (not (string= "" elt)))
+ (if (member-ignore-case elt set)
+ (delete elt set)
+ (cons elt set))
+ set))
+
+(defun-rcirc-command ignore (nick)
+ "Manage the ignore list.
+Ignore NICK, unignore NICK if already ignored, or list ignored
+nicks when no NICK is given. When listing ignored nicks, the
+ones added to the list automatically are marked with an asterisk."
+ (interactive "sToggle ignoring of nick: ")
+ (setq rcirc-ignore-list (rcirc-add-or-remove rcirc-ignore-list nick))
+ (rcirc-print process nil "IGNORE" target
+ (mapconcat
+ (lambda (nick)
+ (concat nick
+ (if (member nick rcirc-ignore-list-automatic)
+ "*" "")))
+ rcirc-ignore-list " ")))
+
+(defun-rcirc-command bright (nick)
+ "Manage the bright nick list."
+ (interactive "sToggle emphasis of nick: ")
+ (setq rcirc-bright-nicks (rcirc-add-or-remove rcirc-bright-nicks nick))
+ (rcirc-print process nil "BRIGHT" target
+ (mapconcat 'identity rcirc-bright-nicks " ")))
+
+(defun-rcirc-command dim (nick)
+ "Manage the dim nick list."
+ (interactive "sToggle deemphasis of nick: ")
+ (setq rcirc-dim-nicks (rcirc-add-or-remove rcirc-dim-nicks nick))
+ (rcirc-print process nil "DIM" target
+ (mapconcat 'identity rcirc-dim-nicks " ")))
+
+(defun-rcirc-command keyword (keyword)
+ "Manage the keyword list.
+Mark KEYWORD, unmark KEYWORD if already marked, or list marked
+keywords when no KEYWORD is given."
+ (interactive "sToggle highlighting of keyword: ")
+ (setq rcirc-keywords (rcirc-add-or-remove rcirc-keywords keyword))
+ (rcirc-print process nil "KEYWORD" target
+ (mapconcat 'identity rcirc-keywords " ")))
+
\f
-(defun rcirc-message-leader (sender face)
- "Return a string with SENDER propertized with FACE."
- (rcirc-facify (concat "<" (rcirc-user-nick sender) "> ") face))
-
+(defun rcirc-add-face (start end name &optional object)
+ "Add face NAME to the face text property of the text from START to END."
+ (when name
+ (let ((pos start)
+ next prop)
+ (while (< pos end)
+ (setq prop (get-text-property pos 'face object)
+ next (next-single-property-change pos 'face object end))
+ (unless (member name (get-text-property pos 'face object))
+ (add-text-properties pos next (list 'face (cons name prop)) object))
+ (setq pos next)))))
+
(defun rcirc-facify (string face)
"Return a copy of STRING with FACE property added."
- (propertize (or string "") 'face face 'rear-nonsticky t))
+ (let ((string (or string "")))
+ (rcirc-add-face 0 (length string) face string)
+ string))
-;; shy grouping must be used within this regexp
(defvar rcirc-url-regexp
- "\\b\\(?:\\(?:www\\.\\|\\(?:s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\
-\\|wais\\|mailto\\):\\)\\(?://[-a-zA-Z0-9_.]+:[0-9]*\\)?\\(?:[-a-zA-Z0-9_=!?#$\
-@~`%&*+|\\/:;.,]\\|\\w\\)+\\(?:[-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)"
- "Regexp matching URL's. Set to nil to disable URL features in rcirc.")
+ (rx-to-string
+ `(and word-boundary
+ (or (and
+ (or (and (or "http" "https" "ftp" "file" "gopher" "news"
+ "telnet" "wais" "mailto")
+ "://")
+ "www.")
+ (1+ (char "-a-zA-Z0-9_."))
+ (1+ (char "-a-zA-Z0-9_"))
+ (optional ":" (1+ (char "0-9"))))
+ (and (1+ (char "-a-zA-Z0-9_."))
+ (or ".com" ".net" ".org")
+ word-boundary))
+ (optional
+ (and "/"
+ (1+ (char "-a-zA-Z0-9_='!?#$\@~`%&*+|\\/:;.,{}[]()"))
+ (char "-a-zA-Z0-9_=#$\@~`%&*+|\\/:;{}[]()")))))
+ "Regexp matching URLs. Set to nil to disable URL features in rcirc.")
(defun rcirc-browse-url (&optional arg)
- "Prompt for url to browse based on urls in buffer."
- (interactive)
+ "Prompt for URL to browse based on URLs in buffer."
+ (interactive "P")
(let ((completions (mapcar (lambda (x) (cons x nil)) rcirc-urls))
(initial-input (car rcirc-urls))
(history (cdr rcirc-urls)))
completions nil nil initial-input 'history)
arg)))
-(defun rcirc-map-regexp (function regexp string)
- "Return a copy of STRING after calling FUNCTION for each REGEXP match.
-FUNCTION takes 3 arguments, MATCH-START, MATCH-END, and STRING."
- (let ((start 0))
- (while (string-match regexp string start)
- (setq start (match-end 0))
- (funcall function (match-beginning 0) (match-end 0) string)))
- string)
-
-(defvar rcirc-nick-syntax-table
- (let ((table (make-syntax-table text-mode-syntax-table)))
- (mapc (lambda (c) (modify-syntax-entry c "w" table))
- "[]\\`_^{|}-")
- (modify-syntax-entry ?' "_" table)
- table)
- "Syntax table which includes all nick characters as word constituents.")
+(defun rcirc-browse-url-at-point (point)
+ "Send URL at point to `browse-url'."
+ (interactive "d")
+ (let ((beg (previous-single-property-change (1+ point) 'mouse-face))
+ (end (next-single-property-change point 'mouse-face)))
+ (browse-url (buffer-substring-no-properties beg end))))
-(defun rcirc-mangle-text (process text)
- "Return TEXT with properties added based on various patterns."
- ;; ^B
- (setq text
- (rcirc-map-regexp (lambda (start end string)
- (add-text-properties
- start end
- (list 'face 'bold 'rear-nonsticky t)
- string))
- "\ 2.*?\ 2"
- text))
- (while (string-match "\\(.*\\)[\ 2\ 1]\\(.*\\)" text) ; deal with \1f
- (setq text (concat (match-string 1 text)
- (match-string 2 text))))
- ;; my nick
- (setq text
- (with-syntax-table rcirc-nick-syntax-table
- (rcirc-map-regexp (lambda (start end string)
- (add-text-properties
- start end
- (list 'face 'rcirc-nick-in-message-face
- 'rear-nonsticky t)
- string))
- (concat "\\b"
- (regexp-quote (rcirc-nick process))
- "\\b")
- text)))
- ;; urls
- (setq text
- (rcirc-map-regexp
- (lambda (start end string)
- (let ((orig-face (get-text-property start 'face string)))
- (add-text-properties start end
- (list 'face (list orig-face 'bold)
- 'rear-nonsticky t)
- string))
- (push (substring string start end) rcirc-urls))
- rcirc-url-regexp
- text))
- text)
+(defun rcirc-browse-url-at-mouse (event)
+ "Send URL at mouse click to `browse-url'."
+ (interactive "e")
+ (let ((position (event-end event)))
+ (with-current-buffer (window-buffer (posn-window position))
+ (rcirc-browse-url-at-point (posn-point position)))))
\f
+(defvar rcirc-markup-text-functions
+ '(rcirc-markup-attributes
+ rcirc-markup-my-nick
+ rcirc-markup-urls
+ rcirc-markup-keywords
+ rcirc-markup-bright-nicks
+ rcirc-markup-fill)
+
+ "List of functions used to manipulate text before it is printed.
+
+Each function takes two arguments, SENDER, RESPONSE. The buffer
+is narrowed with the text to be printed and the point is at the
+beginning of the `rcirc-text' propertized text.")
+
+(defun rcirc-markup-timestamp (sender response)
+ (goto-char (point-min))
+ (insert (rcirc-facify (format-time-string rcirc-time-format)
+ 'rcirc-timestamp)))
+
+(defun rcirc-markup-attributes (sender response)
+ (while (re-search-forward "\\([\C-b\C-_\C-v]\\).*?\\(\\1\\|\C-o\\)" nil t)
+ (rcirc-add-face (match-beginning 0) (match-end 0)
+ (case (char-after (match-beginning 1))
+ (?\C-b 'bold)
+ (?\C-v 'italic)
+ (?\C-_ 'underline)))
+ ;; keep the ^O since it could terminate other attributes
+ (when (not (eq ?\C-o (char-before (match-end 2))))
+ (delete-region (match-beginning 2) (match-end 2)))
+ (delete-region (match-beginning 1) (match-end 1))
+ (goto-char (1+ (match-beginning 1))))
+ ;; remove the ^O characters now
+ (while (re-search-forward "\C-o+" nil t)
+ (delete-region (match-beginning 0) (match-end 0))))
+
+(defun rcirc-markup-my-nick (sender response)
+ (with-syntax-table rcirc-nick-syntax-table
+ (while (re-search-forward (concat "\\b"
+ (regexp-quote (rcirc-nick
+ (rcirc-buffer-process)))
+ "\\b")
+ nil t)
+ (rcirc-add-face (match-beginning 0) (match-end 0)
+ 'rcirc-nick-in-message)
+ (when (string= response "PRIVMSG")
+ (rcirc-add-face (point-min) (point-max)
+ 'rcirc-nick-in-message-full-line)
+ (rcirc-record-activity (current-buffer) 'nick)))))
+
+(defun rcirc-markup-urls (sender response)
+ (while (re-search-forward rcirc-url-regexp nil t)
+ (let ((start (match-beginning 0))
+ (end (match-end 0)))
+ (rcirc-add-face start end 'rcirc-url)
+ (add-text-properties start end (list 'mouse-face 'highlight
+ 'keymap rcirc-browse-url-map))
+ ;; record the url
+ (push (buffer-substring-no-properties start end) rcirc-urls))))
+
+(defun rcirc-markup-keywords (sender response)
+ (when (and (string= response "PRIVMSG")
+ (not (string= sender (rcirc-nick (rcirc-buffer-process)))))
+ (let* ((target (or rcirc-target ""))
+ (keywords (delq nil (mapcar (lambda (keyword)
+ (when (not (string-match keyword
+ target))
+ keyword))
+ rcirc-keywords))))
+ (when keywords
+ (while (re-search-forward (regexp-opt keywords 'words) nil t)
+ (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-keyword)
+ (rcirc-record-activity (current-buffer) 'keyword))))))
+
+(defun rcirc-markup-bright-nicks (sender response)
+ (when (and rcirc-bright-nicks
+ (string= response "NAMES"))
+ (with-syntax-table rcirc-nick-syntax-table
+ (while (re-search-forward (regexp-opt rcirc-bright-nicks 'words) nil t)
+ (rcirc-add-face (match-beginning 0) (match-end 0)
+ 'rcirc-bright-nick)))))
+
+(defun rcirc-markup-fill (sender response)
+ (when (not (string= response "372")) ; /motd
+ (let ((fill-prefix
+ (or rcirc-fill-prefix
+ (make-string (- (point) (line-beginning-position)) ?\s)))
+ (fill-column (cond ((eq rcirc-fill-column 'frame-width)
+ (1- (frame-width)))
+ (rcirc-fill-column
+ rcirc-fill-column)
+ (t fill-column))))
+ (fill-region (point) (point-max) nil t))))
+\f
;;; handlers
;; these are called with the server PROCESS, the SENDER, which is a
;; server or a user, depending on the command, the ARGS, which is a
(defun rcirc-handler-001 (process sender args text)
(rcirc-handler-generic process "001" sender args text)
;; set the real server name
- (with-current-buffer (process-buffer process)
- (setq rcirc-server sender)
+ (with-rcirc-process-buffer process
+ (setq rcirc-connecting nil)
+ (rcirc-reschedule-timeout process)
+ (setq rcirc-server-name sender)
(setq rcirc-nick (car args))
(rcirc-update-prompt)
(when rcirc-auto-authenticate-flag (rcirc-authenticate))
- (let (rcirc-last-buffer)
- (rcirc-join-channels process rcirc-startup-channels))))
+ (rcirc-join-channels process rcirc-startup-channels)))
(defun rcirc-handler-PRIVMSG (process sender args text)
(let ((target (if (rcirc-channel-p (car args))
(car args)
- (rcirc-user-nick sender)))
+ sender))
(message (or (cadr args) "")))
(if (string-match "^\C-a\\(.*\\)\C-a$" message)
(rcirc-handler-CTCP process target sender (match-string 1 message))
(defun rcirc-handler-NOTICE (process sender args text)
(let ((target (car args))
(message (cadr args)))
- (rcirc-print process sender "NOTICE"
- (cond ((rcirc-channel-p target)
- target)
- ((string-match "^\\[\\(#[^ ]+\\)\\]" message)
- (match-string 1 message))
- (sender
- (if (string= sender (rcirc-server process))
- (process-buffer process)
- (rcirc-user-nick sender))))
- message t)
- (and sender (rcirc-put-nick-channel process sender target))))
+ (if (string-match "^\C-a\\(.*\\)\C-a$" message)
+ (rcirc-handler-CTCP-response process target sender
+ (match-string 1 message))
+ (rcirc-print process sender "NOTICE"
+ (cond ((rcirc-channel-p target)
+ target)
+ ;;; -ChanServ- [#gnu] Welcome...
+ ((string-match "\\[\\(#[^\] ]+\\)\\]" message)
+ (match-string 1 message))
+ (sender
+ (if (string= sender (rcirc-server-name process))
+ nil ; server notice
+ sender)))
+ message t))))
(defun rcirc-handler-WALLOPS (process sender args text)
- (let ((target (rcirc-user-nick sender)))
- (rcirc-print process sender "WALLOPS" target (car args) t)))
+ (rcirc-print process sender "WALLOPS" sender (car args) t))
(defun rcirc-handler-JOIN (process sender args text)
- (let ((channel (downcase (car args)))
- (nick (rcirc-user-nick sender)))
+ (let ((channel (car args)))
(rcirc-get-buffer-create process channel)
(rcirc-print process sender "JOIN" channel "")
;; print in private chat buffer if it exists
- (if (not (eq (process-buffer rcirc-process)
- (rcirc-get-buffer rcirc-process nick)))
- (rcirc-print process sender "JOIN" nick channel))
+ (when (rcirc-get-buffer (rcirc-buffer-process) sender)
+ (rcirc-print process sender "JOIN" sender channel))
- (rcirc-put-nick-channel process sender channel)
- (if (string= nick (rcirc-nick process))
- (setq rcirc-channels (cons channel rcirc-channels)))))
+ (rcirc-put-nick-channel process sender channel)))
;; PART and KICK are handled the same way
(defun rcirc-handler-PART-or-KICK (process response channel sender nick args)
- (rcirc-print process sender response channel (concat channel " " args))
-
- ;; print in private chat buffer if it exists
- (when (not (eq (process-buffer rcirc-process)
- (rcirc-get-buffer rcirc-process nick)))
- (rcirc-print process sender response nick (concat channel " " args)))
-
+ (rcirc-ignore-update-automatic nick)
(if (not (string= nick (rcirc-nick process)))
;; this is someone else leaving
- (rcirc-remove-nick-channel process nick channel)
- ;; this is us leaving
- (mapc (lambda (n)
- (rcirc-remove-nick-channel process n channel))
- (rcirc-channel-nicks process channel))
- (setq rcirc-channels (delete channel rcirc-channels))
- (with-current-buffer (rcirc-get-buffer process channel)
- (setq rcirc-target nil))))
+ (rcirc-remove-nick-channel process nick channel)
+ ;; this is us leaving
+ (mapc (lambda (n)
+ (rcirc-remove-nick-channel process n channel))
+ (rcirc-channel-nicks process channel))
+
+ ;; if the buffer is still around, make it inactive
+ (let ((buffer (rcirc-get-buffer process channel)))
+ (when buffer
+ (rcirc-disconnect-buffer buffer)))))
(defun rcirc-handler-PART (process sender args text)
- (rcirc-handler-PART-or-KICK process "PART"
- (car args) sender (rcirc-user-nick sender)
- (cadr args)))
+ (let* ((channel (car args))
+ (reason (cadr args))
+ (message (concat channel " " reason)))
+ (rcirc-print process sender "PART" channel message)
+ ;; print in private chat buffer if it exists
+ (when (rcirc-get-buffer (rcirc-buffer-process) sender)
+ (rcirc-print process sender "PART" sender message))
+
+ (rcirc-handler-PART-or-KICK process "PART" channel sender sender reason)))
(defun rcirc-handler-KICK (process sender args text)
- (rcirc-handler-PART-or-KICK process "KICK" (car args) sender (cadr args)
- (caddr args)))
+ (let* ((channel (car args))
+ (nick (cadr args))
+ (reason (caddr args))
+ (message (concat nick " " channel " " reason)))
+ (rcirc-print process sender "KICK" channel message t)
+ ;; print in private chat buffer if it exists
+ (when (rcirc-get-buffer (rcirc-buffer-process) nick)
+ (rcirc-print process sender "KICK" nick message))
+
+ (rcirc-handler-PART-or-KICK process "KICK" channel sender nick reason)))
(defun rcirc-handler-QUIT (process sender args text)
- (let ((nick (rcirc-user-nick sender)))
- (mapc (lambda (channel)
- (rcirc-print process sender "QUIT" channel (apply 'concat args)))
- (rcirc-nick-channels process nick))
+ (rcirc-ignore-update-automatic sender)
+ (mapc (lambda (channel)
+ (rcirc-print process sender "QUIT" channel (apply 'concat args)))
+ (rcirc-nick-channels process sender))
- ;; print in private chat buffer if it exists
- (if (not (eq (process-buffer rcirc-process)
- (rcirc-get-buffer rcirc-process nick)))
- (rcirc-print process sender "QUIT" nick (apply 'concat args)))
+ ;; print in private chat buffer if it exists
+ (when (rcirc-get-buffer (rcirc-buffer-process) sender)
+ (rcirc-print process sender "QUIT" sender (apply 'concat args)))
- (rcirc-nick-remove process nick)))
+ (rcirc-nick-remove process sender))
(defun rcirc-handler-NICK (process sender args text)
- (let* ((old-nick (rcirc-user-nick sender))
+ (let* ((old-nick sender)
(new-nick (car args))
(channels (rcirc-nick-channels process old-nick)))
+ ;; update list of ignored nicks
+ (rcirc-ignore-update-automatic old-nick)
+ (when (member old-nick rcirc-ignore-list)
+ (add-to-list 'rcirc-ignore-list new-nick)
+ (add-to-list 'rcirc-ignore-list-automatic new-nick))
;; print message to nick's channels
(dolist (target channels)
(rcirc-print process sender "NICK" target new-nick))
;; update private chat buffer, if it exists
- (with-current-buffer (rcirc-get-buffer process old-nick)
- (when (not (equal (process-buffer rcirc-process)
- (current-buffer)))
- (rcirc-print process sender "NICK" old-nick new-nick)
- (setq rcirc-target new-nick)
- (rename-buffer (rcirc-get-buffer-name process new-nick))))
+ (let ((chat-buffer (rcirc-get-buffer process old-nick)))
+ (when chat-buffer
+ (with-current-buffer chat-buffer
+ (rcirc-print process sender "NICK" old-nick new-nick)
+ (setq rcirc-target new-nick)
+ (rename-buffer (rcirc-generate-new-buffer-name process new-nick)))))
;; remove old nick and add new one
- (with-current-buffer (process-buffer process)
+ (with-rcirc-process-buffer process
(let ((v (gethash old-nick rcirc-nick-table)))
(remhash old-nick rcirc-nick-table)
(puthash new-nick v rcirc-nick-table))
;; if this is our nick...
(when (string= old-nick rcirc-nick)
(setq rcirc-nick new-nick)
- ;; update prompts
- (mapc (lambda (target)
- (with-current-buffer (rcirc-get-buffer process target)
- (rcirc-update-prompt)))
- (append rcirc-channels rcirc-private-chats))
+ (rcirc-update-prompt t)
;; reauthenticate
(when rcirc-auto-authenticate-flag (rcirc-authenticate))))))
(defun rcirc-handler-PING (process sender args text)
- (rcirc-send-string process (concat "PONG " (car args))))
+ (rcirc-send-string process (concat "PONG :" (car args))))
(defun rcirc-handler-PONG (process sender args text)
;; do nothing
(with-current-buffer (rcirc-get-buffer process (car args))
(setq rcirc-topic topic))))
+(defvar rcirc-nick-away-alist nil)
+(defun rcirc-handler-301 (process sender args text)
+ "RPL_AWAY"
+ (let* ((nick (cadr args))
+ (rec (assoc-string nick rcirc-nick-away-alist))
+ (away-message (caddr args)))
+ (when (or (not rec)
+ (not (string= (cdr rec) away-message)))
+ ;; away message has changed
+ (rcirc-handler-generic process "AWAY" nick (cdr args) text)
+ (if rec
+ (setcdr rec away-message)
+ (setq rcirc-nick-away-alist (cons (cons nick away-message)
+ rcirc-nick-away-alist))))))
+
(defun rcirc-handler-332 (process sender args text)
"RPL_TOPIC"
- (with-current-buffer (rcirc-get-buffer process (cadr args))
- (setq rcirc-topic (caddr args))))
+ (let ((buffer (or (rcirc-get-buffer process (cadr args))
+ (rcirc-get-temp-buffer-create process (cadr args)))))
+ (with-current-buffer buffer
+ (setq rcirc-topic (caddr args)))))
(defun rcirc-handler-333 (process sender args text)
"Not in rfc1459.txt"
- (with-current-buffer (rcirc-get-buffer process (cadr args))
- (let ((setter (caddr args))
- (time (current-time-string
- (seconds-to-time
- (string-to-number (cadddr args))))))
- (rcirc-print process sender "TOPIC" (cadr args)
- (format "%s (%s on %s)" rcirc-topic setter time)))))
+ (let ((buffer (or (rcirc-get-buffer process (cadr args))
+ (rcirc-get-temp-buffer-create process (cadr args)))))
+ (with-current-buffer buffer
+ (let ((setter (caddr args))
+ (time (current-time-string
+ (seconds-to-time
+ (string-to-number (cadddr args))))))
+ (rcirc-print process sender "TOPIC" (cadr args)
+ (format "%s (%s on %s)" rcirc-topic setter time))))))
(defun rcirc-handler-477 (process sender args text)
"ERR_NOCHANMODES"
;; print in private chat buffers if they exist
(mapc (lambda (nick)
- (when (not (eq (process-buffer rcirc-process)
- (rcirc-get-buffer rcirc-process nick)))
- (rcirc-print process sender "MODE" nick msg)))
- (cddr args))))
+ (when (rcirc-get-buffer process nick)
+ (rcirc-print process sender "MODE" nick msg)))
+ (cddr args))))
(defun rcirc-get-temp-buffer-create (process channel)
"Return a buffer based on PROCESS and CHANNEL."
(defun rcirc-handler-353 (process sender args text)
"RPL_NAMREPLY"
- (let ((channel (downcase (caddr args))))
+ (let ((channel (caddr args)))
(mapc (lambda (nick)
(rcirc-put-nick-channel process nick channel))
- (delete "" (split-string (cadddr args) " ")))
+ (split-string (cadddr args) " " t))
(with-current-buffer (rcirc-get-temp-buffer-create process channel)
(goto-char (point-max))
(insert (car (last args)) " "))))
"ERR_NICKNAMEINUSE"
(rcirc-handler-generic process "433" sender args text)
(let* ((new-nick (concat (cadr args) "`")))
- (with-current-buffer (process-buffer process)
+ (with-rcirc-process-buffer process
(rcirc-cmd-nick new-nick nil process))))
(defun rcirc-authenticate ()
"Send authentication to process associated with current buffer.
-Passwords are read from `rcirc-authinfo-file-name' (which see)."
+Passwords are stored in `rcirc-authinfo' (which see)."
(interactive)
- (let ((password-alist
- (with-temp-buffer
- (insert-file-contents-literally rcirc-authinfo-file-name)
- (goto-char (point-min))
- (read (current-buffer)))))
- (with-current-buffer (process-buffer rcirc-process)
- (dolist (i password-alist)
- (let ((server (car i))
- (nick (cadr i))
- (method (caddr i))
- (args (cdddr i)))
- (when (and (string-match server rcirc-server)
- (string-match nick rcirc-nick))
- (cond ((equal method 'nickserv)
- (rcirc-send-string
- rcirc-process
- (concat
- "PRIVMSG nickserv :identify "
- (car args))))
- ((equal method 'chanserv)
- (rcirc-send-string
- rcirc-process
- (concat
- "PRIVMSG chanserv :identify "
- (car args) " " (cadr args))))
- ((equal method 'bitlbee)
- (rcirc-send-string
- rcirc-process
- (concat "PRIVMSG #bitlbee :identify " (car args))))
- (t
- (message "No %S authentication method defined"
- method)))))))))
-
+ (with-rcirc-server-buffer
+ (dolist (i rcirc-authinfo)
+ (let ((process (rcirc-buffer-process))
+ (server (car i))
+ (nick (caddr i))
+ (method (cadr i))
+ (args (cdddr i)))
+ (when (and (string-match server rcirc-server)
+ (string-match nick rcirc-nick))
+ (cond ((equal method 'nickserv)
+ (rcirc-send-string
+ process
+ (concat
+ "PRIVMSG nickserv :identify "
+ (car args))))
+ ((equal method 'chanserv)
+ (rcirc-send-string
+ process
+ (concat
+ "PRIVMSG chanserv :identify "
+ (car args) " " (cadr args))))
+ ((equal method 'bitlbee)
+ (rcirc-send-string
+ process
+ (concat "PRIVMSG &bitlbee :identify " (car args))))
+ (t
+ (message "No %S authentication method defined"
+ method))))))))
+
(defun rcirc-handler-INVITE (process sender args text)
(rcirc-print process sender "INVITE" nil (mapconcat 'identity args " ") t))
(if (string-match "^\\([^ ]+\\) *\\(.*\\)$" text)
(let* ((request (upcase (match-string 1 text)))
(args (match-string 2 text))
- (nick (rcirc-user-nick sender))
(handler (intern-soft (concat "rcirc-handler-ctcp-" request))))
(if (not (fboundp handler))
- (rcirc-print process sender "ERROR" target
- (format "unhandled ctcp: %s" text))
+ (rcirc-print process sender "ERROR" target
+ (format "%s sent unsupported ctcp: %s" sender text)
+ t)
(funcall handler process target sender args)
- (if (not (string= request "ACTION"))
+ (unless (or (string= request "ACTION")
+ (string= request "KEEPALIVE"))
(rcirc-print process sender "CTCP" target
- (format "%s" text)))))))
+ (format "%s" text) t))))))
(defun rcirc-handler-ctcp-VERSION (process target sender args)
(rcirc-send-string process
- (concat "NOTICE " (rcirc-user-nick sender)
- " :\C-aVERSION " (rcirc-version)
- " - http://www.nongnu.org/rcirc"
+ (concat "NOTICE " sender
+ " :\C-aVERSION " rcirc-id-string
"\C-a")))
(defun rcirc-handler-ctcp-ACTION (process target sender args)
(defun rcirc-handler-ctcp-TIME (process target sender args)
(rcirc-send-string process
- (concat "NOTICE " (rcirc-user-nick sender)
+ (concat "NOTICE " sender
" :\C-aTIME " (current-time-string) "\C-a")))
-\f
-(defface rcirc-my-nick-face
- '((((type tty) (class color)) (:foreground "blue" :weight bold))
- (((class color) (background light)) (:foreground "Blue"))
- (((class color) (background dark)) (:foreground "LightSkyBlue"))
- (t (:inverse-video t :bold t)))
- "The rcirc face used to highlight my messages."
- :group 'rcirc)
-(defface rcirc-other-nick-face
- '((((type tty) (class color)) (:foreground "yellow" :weight light))
- (((class grayscale) (background light))
- (:foreground "Gray90" :bold t :italic t))
+(defun rcirc-handler-CTCP-response (process target sender message)
+ (rcirc-print process sender "CTCP" nil message t))
+\f
+(defgroup rcirc-faces nil
+ "Faces for rcirc."
+ :group 'rcirc
+ :group 'faces)
+
+(defface rcirc-my-nick ; font-lock-function-name-face
+ '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 8)) (:foreground "blue" :weight bold))
+ (t (:inverse-video t :weight bold)))
+ "The face used to highlight my messages."
+ :group 'rcirc-faces)
+
+(defface rcirc-other-nick ; font-lock-variable-name-face
+ '((((class grayscale) (background light))
+ (:foreground "Gray90" :weight bold :slant italic))
(((class grayscale) (background dark))
- (:foreground "DimGray" :bold t :italic t))
- (((class color) (background light)) (:foreground "DarkGoldenrod"))
- (((class color) (background dark)) (:foreground "LightGoldenrod"))
- (t (:bold t :italic t)))
- "The rcirc face used to highlight other messages."
- :group 'rcirc)
-
-(defface rcirc-server-face
- '((((type tty pc) (class color) (background light)) (:foreground "red"))
- (((type tty pc) (class color) (background dark)) (:foreground "red1"))
- (((class grayscale) (background light))
- (:foreground "DimGray" :bold t :italic t))
+ (:foreground "DimGray" :weight bold :slant italic))
+ (((class color) (min-colors 88) (background light)) (:foreground "DarkGoldenrod"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "LightGoldenrod"))
+ (((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
+ (((class color) (min-colors 8)) (:foreground "yellow" :weight light))
+ (t (:weight bold :slant italic)))
+ "The face used to highlight other messages."
+ :group 'rcirc-faces)
+
+(defface rcirc-bright-nick
+ '((((class grayscale) (background light))
+ (:foreground "LightGray" :weight bold :underline t))
(((class grayscale) (background dark))
- (:foreground "LightGray" :bold t :italic t))
- (((class color) (background light)) (:foreground "gray40"))
- (((class color) (background dark)) (:foreground "chocolate1"))
- (t (:bold t :italic t)))
- "The rcirc face used to highlight server messages."
- :group 'rcirc)
-
-(defface rcirc-nick-in-message-face
- '((((type tty) (class color)) (:foreground "cyan" :weight bold))
- (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
- (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
- (((class color) (background light)) (:foreground "Purple"))
- (((class color) (background dark)) (:foreground "Cyan"))
- (t (:bold t)))
- "The rcirc face used to highlight instances of nick within messages."
- :group 'rcirc)
+ (:foreground "Gray50" :weight bold :underline t))
+ (((class color) (min-colors 88) (background light)) (:foreground "CadetBlue"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "Aquamarine"))
+ (((class color) (min-colors 16) (background light)) (:foreground "CadetBlue"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine"))
+ (((class color) (min-colors 8)) (:foreground "magenta"))
+ (t (:weight bold :underline t)))
+ "Face used for nicks matched by `rcirc-bright-nicks'."
+ :group 'rcirc-faces)
+
+(defface rcirc-dim-nick
+ '((t :inherit default))
+ "Face used for nicks in `rcirc-dim-nicks'."
+ :group 'rcirc-faces)
+
+(defface rcirc-server ; font-lock-comment-face
+ '((((class grayscale) (background light))
+ (:foreground "DimGray" :weight bold :slant italic))
+ (((class grayscale) (background dark))
+ (:foreground "LightGray" :weight bold :slant italic))
+ (((class color) (min-colors 88) (background light))
+ (:foreground "Firebrick"))
+ (((class color) (min-colors 88) (background dark))
+ (:foreground "chocolate1"))
+ (((class color) (min-colors 16) (background light))
+ (:foreground "red"))
+ (((class color) (min-colors 16) (background dark))
+ (:foreground "red1"))
+ (((class color) (min-colors 8) (background light))
+ )
+ (((class color) (min-colors 8) (background dark))
+ )
+ (t (:weight bold :slant italic)))
+ "The face used to highlight server messages."
+ :group 'rcirc-faces)
+
+(defface rcirc-server-prefix ; font-lock-comment-delimiter-face
+ '((default :inherit rcirc-server)
+ (((class grayscale)))
+ (((class color) (min-colors 16)))
+ (((class color) (min-colors 8) (background light))
+ :foreground "red")
+ (((class color) (min-colors 8) (background dark))
+ :foreground "red1"))
+ "The face used to highlight server prefixes."
+ :group 'rcirc-faces)
+
+(defface rcirc-timestamp
+ '((t (:inherit default)))
+ "The face used to highlight timestamps."
+ :group 'rcirc-faces)
+
+(defface rcirc-nick-in-message ; font-lock-keyword-face
+ '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold))
+ (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
+ (((class color) (min-colors 88) (background light)) (:foreground "Purple"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1"))
+ (((class color) (min-colors 16) (background light)) (:foreground "Purple"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "Cyan"))
+ (((class color) (min-colors 8)) (:foreground "cyan" :weight bold))
+ (t (:weight bold)))
+ "The face used to highlight instances of your nick within messages."
+ :group 'rcirc-faces)
+
+(defface rcirc-nick-in-message-full-line
+ '((t (:bold t)))
+ "The face used emphasize the entire message when your nick is mentioned."
+ :group 'rcirc-faces)
-(defface rcirc-prompt-face
- '((((background dark)) (:foreground "cyan"))
+(defface rcirc-prompt ; comint-highlight-prompt
+ '((((min-colors 88) (background dark)) (:foreground "cyan1"))
+ (((background dark)) (:foreground "cyan"))
(t (:foreground "dark blue")))
- "The rcirc face to use to highlight prompts."
- :group 'rcirc)
+ "The face used to highlight prompts."
+ :group 'rcirc-faces)
+
+(defface rcirc-track-nick
+ '((((type tty)) (:inherit default))
+ (t (:inverse-video t)))
+ "The face used in the mode-line when your nick is mentioned."
+ :group 'rcirc-faces)
+
+(defface rcirc-track-keyword
+ '((t (:bold t )))
+ "The face used in the mode-line when keywords are mentioned."
+ :group 'rcirc-faces)
-(defface rcirc-mode-line-nick-face
+(defface rcirc-url
'((t (:bold t)))
- "The rcirc face used indicate activity directed at you."
- :group 'rcirc)
+ "The face used to highlight urls."
+ :group 'rcirc-faces)
+
+(defface rcirc-keyword
+ '((t (:inherit highlight)))
+ "The face used to highlight keywords."
+ :group 'rcirc-faces)
+
\f
-;; When using M-x flyspell-mode, only check words past the input marker
+;; When using M-x flyspell-mode, only check words after the prompt
(put 'rcirc-mode 'flyspell-mode-predicate 'rcirc-looking-at-input)
(defun rcirc-looking-at-input ()
"Returns true if point is past the input marker."