diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe.el | 3602 |
1 files changed, 3602 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe.el new file mode 100644 index 000000000000..721044dd2aff --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe.el @@ -0,0 +1,3602 @@ +;;; circe.el --- Client for IRC in Emacs -*- lexical-binding: t -*- + +;; Copyright (C) 2005 - 2015 Jorgen Schaefer + +;; Version: 2.10 +;; Keywords: IRC, chat +;; Author: Jorgen Schaefer <forcer@forcix.cx> +;; URL: https://github.com/jorgenschaefer/circe + +;; This file is part of Circe. + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Circe is a Client for IRC in Emacs. It integrates well with the rest +;; of the editor, using standard Emacs key bindings and indicating +;; activity in channels in the status bar so it stays out of your way +;; unless you want to use it. + +;;; Code: + +(defvar circe-version "2.10" + "Circe version string.") + +(require 'circe-compat) + +(require 'ring) +(require 'timer) +(require 'lui) +(require 'lui-format) +(require 'lcs) +(require 'irc) + +;; Used to be optional. But sorry, we're in the 21st century already. +(require 'lui-irc-colors) + +;; necessary for inheriting from diff-added and diff-removed faces +(require 'diff-mode) + +(defgroup circe nil + "Yet Another Emacs IRC Client." + :prefix "circe-" + :group 'applications) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Customization Options ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;; +;;;; Faces ;;;; +;;;;;;;;;;;;;;; + +(defface circe-prompt-face + '((t (:weight bold :foreground "Black" :background "LightSeaGreen"))) + "The face for the Circe prompt." + :group 'circe) + +(defface circe-server-face + '((((type tty)) (:foreground "blue" :weight bold)) + (((background dark)) (:foreground "#5095cf")) + (((background light)) (:foreground "#3840b0")) + (t (:foreground "SteelBlue"))) + "The face used to highlight server messages." + :group 'circe) + +(defface circe-highlight-nick-face + '((default (:weight bold)) + (((type tty)) (:foreground "cyan")) + (((background dark)) (:foreground "#82e2ed")) + (((background light)) (:foreground "#0445b7")) + (t (:foreground "CadetBlue3"))) + "The face used to highlight messages directed to us." + :group 'circe) + +(defface circe-my-message-face '((t)) + "The face used to highlight our own messages." + :group 'circe) + +(defface circe-originator-face '((t)) + "The face used to highlight the originator of a message." + :group 'circe) + +(defface circe-topic-diff-new-face '((t (:inherit diff-added))) + "The face used for text added to a topic. +See the {topic-diff} parameter to `circe-format-server-topic'." + :group 'circe) + +(defface circe-topic-diff-removed-face '((t (:inherit diff-removed))) + "The face used for text removed from a topic. +See the {topic-diff} parameter to `circe-format-server-topic'." + :group 'circe) + +(defface circe-fool-face + '((((type tty)) (:foreground "grey40" :bold t)) + (t (:foreground "grey40"))) + "The face used for fools. +See `circe-fool-list'." + :group 'circe) + +;;;;;;;;;;;;;;;;;;; +;;;; Variables ;;;; +;;;;;;;;;;;;;;;;;;; + +(defcustom circe-default-nick (user-login-name) + "The default nick for circe." + :type 'string + :group 'circe) + +(defcustom circe-default-user circe-default-nick + "The default user name for circe." + :type 'string + :group 'circe) + +(defcustom circe-default-realname (if (string= (user-full-name) "") + circe-default-nick + (user-full-name)) + "The default real name for circe." + :type 'string + :group 'circe) + +(defcustom circe-default-ip-family nil + "Default IP family to use. + + 'nil - Use either IPv4 or IPv6. + + 'ipv4 - Use IPv4 + + 'ipv6 - Use IPv6" + :type '(choice (const :tag "Both" nil) + (const :tag "IPv4" ipv4) + (const :tag "IPv6" ipv6)) + :group 'circe) + +(defcustom circe-default-directory "~/" + "The value of `default-directory' for Circe buffers." + :type 'string + :group 'circe) + +(defcustom circe-network-options nil + "Network options. + +This alist maps network names to respective options. + +Common options: + + :pass - The IRC server password to use for this network, or a + function to fetch it. + :nick - The nick name to use (defaults to `circe-default-nick') + :user - The user name to use (defaults to `circe-default-user') + :realname - The real name to use (defaults to `circe-default-realname') + + :channels - A plist of channels to join (see `circe-channels'). + :server-buffer-name - Format to be used for the server buffer name + (see `circe-server-buffer-name') + + :host - The host name of the server to connect to. + :port - The port or service name for the server. + :use-tls - A boolean indicating as to whether to use TLS or + not (defaults to nil). If you set this, you'll likely + have to set :port as well. + :ip-family - Option to enforce a specific IP version + (defaults to `circe-default-ip-family') + + :nickserv-nick - The nick to authenticate with to nickserv, if configured. + (defaults to the value of :nick) + :nickserv-password - The password to use for nickserv + authentication or a function to fetch it. + + :sasl-username - The username for SASL authentication. + :sasl-password - The password for SASL authentication." + :type '(alist :key-type string :value-type plist) + :group 'circe) + +(defvar circe-network-defaults + '(("Freenode" :host "irc.freenode.net" :port (6667 . 6697) + :tls t + :nickserv-mask "^NickServ!NickServ@services\\.$" + :nickserv-identify-challenge "\C-b/msg\\s-NickServ\\s-identify\\s-<password>\C-b" + :nickserv-identify-command "PRIVMSG NickServ :IDENTIFY {nick} {password}" + :nickserv-identify-confirmation "^You are now identified for .*\\.$" + :nickserv-ghost-command "PRIVMSG NickServ :GHOST {nick} {password}" + :nickserv-ghost-confirmation "has been ghosted\\.$\\|is not online\\.$" + ) + ("Coldfront" :host "irc.coldfront.net" :port 6667 + :nickserv-mask "^NickServ!services@coldfront\\.net$" + :nickserv-identify-challenge "/msg\\s-NickServ\\s-IDENTIFY\\s-\C-_password\C-_" + :nickserv-identify-command "PRIVMSG NickServ :IDENTIFY {password}" + ) + ("Bitlbee" :host "localhost" :port 6667 + :nickserv-mask "\\(bitlbee\\|root\\)!\\(bitlbee\\|root\\)@" + :nickserv-identify-challenge "use the \x02identify\x02 command to identify yourself" + :nickserv-identify-command "PRIVMSG &bitlbee :identify {password}" + :nickserv-identify-confirmation "Password accepted, settings and accounts loaded" + :lagmon-disabled t + ) + ("OFTC" :host "irc.oftc.net" :port (6667 . 6697) + :nickserv-mask "^NickServ!services@services\\.oftc\\.net$" + :nickserv-identify-challenge "This nickname is registered and protected." + :nickserv-identify-command "PRIVMSG NickServ :IDENTIFY {password} {nick}" + :nickserv-identify-confirmation "^You are successfully identified as .*\\.$" + ) + ) + "Alist of networks and connection settings. + +See the `circe' command for details of this variable.") + +(defcustom circe-default-quit-message "Using Circe, the loveliest of all IRC clients" + "The default quit message when no other is given. + +This is sent when the server buffer is killed or when /QUIT is +given with no argument." + :type 'string + :group 'circe) + +(defcustom circe-default-part-message "Using Circe, the loveliest of all IRC clients" + "How to part when a channel buffer is killed, or when no +argument is given to /PART." + :type 'string + :group 'circe) + +(defcustom circe-auto-query-max 23 + "The maximum number of queries which are opened automatically. +If more messages arrive - typically in a flood situation - they +are displayed in the server buffer." + :type 'integer + :group 'circe) + +(defcustom circe-use-cycle-completion nil + "Whether Circe should use cycle completion. + +If this is not nil, Circe will set `completion-cycle-threshold' +to t locally in Circe buffers, enabling cycle completion for +nicks no matter what completion style you use in the rest of +Emacs. If you set this to nil, Circe will not touch your default +completion style." + :type 'boolean + :group 'circe) + +(defcustom circe-reduce-lurker-spam nil + "If enabled, Circe will stop showing some messages. + +This means that JOIN, PART, QUIT and NICK messages are not shown +for users on channels that have not spoken yet (\"lurker\"), or +haven't spoken in `circe-active-users-timeout' seconds. When they +speak for the first time, Circe displays their join time." + :type 'boolean + :group 'circe) + +(defcustom circe-active-users-timeout nil + "When non-nil, should be the number of seconds after which +active users are regarded as inactive again after speaking." + :type 'integer + :group 'circe) + +(defcustom circe-prompt-string (concat (propertize ">" + 'face 'circe-prompt-face) + " ") + "The string to initialize the prompt with. +To change the prompt dynamically or just in specific buffers, use +`lui-set-prompt' in the appropriate hooks." + :type 'string + :group 'circe) + +(defcustom circe-extra-nicks nil + "List of other nicks than your current one to highlight." + :type '(repeat string) + :group 'circe) + +(defcustom circe-highlight-nick-type 'sender + "How to highlight occurrences of our own nick. + + 'sender - Highlight the nick of the sender + (messages without a sender and your + own are highlighted with the occurrence + type instead) + 'occurrence - Highlight the occurrences of the nick + 'message - Highlight the message without the sender + 'all - Highlight the whole line" + :type '(choice (const :tag "Sender" sender) + (const :tag "Occurrences" occurrence) + (const :tag "Message" message) + (const :tag "Whole line" all)) + :group 'circe) + +(defcustom circe-inhibit-nick-highlight-function nil + "Function for inhibiting nick highlighting. +If non-nil, its value is called with the respective buffer +selected and point in the line that's about to get highlighted. +A non-nil return value inhibits any highlighting." + :type '(choice (const :tag "None" nil) + function) + :group 'circe) + +(defcustom circe-completion-suffix ": " + "A suffix for completed nicks at the beginning of a line." + :type '(choice (const :tag "The standard suffix" ": ")) + :group 'circe) + +(defcustom circe-ignore-list nil + "List of regular expressions to ignore. + +Each regular expression is matched against nick!user@host." + :type '(repeat regexp) + :group 'circe) + +(defcustom circe-fool-list nil + "List of regular expressions for fools. + +Each regular expression is matched against nick!user@host. + +Messages from such people are still inserted, but not shown. They +can be displayed using \\[lui-fool-toggle-display]." + :type '(repeat regexp) + :group 'circe) + +(defcustom circe-ignore-functions nil + "A list of functions to check whether we should ignore a message. + +These functions get three arguments: NICK, USERHOST, and BODY. If +one of them returns a non-nil value, the message is ignored." + :type 'hook + :group 'circe) + +(defcustom circe-split-line-length 440 + "The maximum length of a single message. +If a message exceeds this size, it is broken into multiple ones. + +IRC allows for lines up to 512 bytes. Two of them are CR LF. +And a typical message looks like this: + + :nicky!uhuser@host212223.dialin.fnordisp.net PRIVMSG #lazybastards :Hello! + +You can limit here the maximum length of the \"Hello!\" part. +Good luck." + :type 'integer + :group 'circe) + +(defcustom circe-server-max-reconnect-attempts 5 + "How often Circe should attempt to reconnect to the server. +If this is 0, Circe will not reconnect at all. If this is nil, +it will try to reconnect forever (not recommended)." + :type '(choice integer + (const :tag "Forever" nil)) + :group 'circe) + +(defcustom circe-netsplit-delay 60 + "The number of seconds a netsplit may be dormant. +If anything happens with a netsplit after this amount of time, +the user is re-notified." + :type 'number + :group 'circe) + +(defcustom circe-server-killed-confirmation 'ask-and-kill-all + "How to ask for confirmation when a server buffer is killed. +This can be one of the following values: + ask - Ask the user for confirmation + ask-and-kill-all - Ask the user, and kill all associated buffers + kill-all - Don't ask the user, and kill all associated buffers + nil - Kill first, ask never" + :type '(choice (const :tag "Ask before killing" ask) + (const :tag "Ask, then kill all associated buffers" + ask-and-kill-all) + (const :tag "Don't ask, then kill all associated buffers" + kill-all) + (const :tag "Don't ask" nil)) + :group 'circe) + +(defcustom circe-channel-killed-confirmation 'ask + "How to ask for confirmation when a channel buffer is killed. +This can be one of the following values: + ask - Ask the user for confirmation + nil - Don't ask, just kill" + :type '(choice (const :tag "Ask before killing" ask) + (const :tag "Don't ask" nil)) + :group 'circe) + +(defcustom circe-track-faces-priorities '(circe-highlight-nick-face + lui-highlight-face + circe-my-message-face + circe-server-face) + "A list of faces which should show up in the tracking. +The first face is kept if the new message has only lower faces, +or faces that don't show up at all." + :type '(repeat face) + :group 'circe) + +(defcustom circe-server-send-unknown-command-p nil + "Non-nil when Circe should just pass on commands it doesn't know. +E.g. /fnord foo bar would then just send \"fnord foo bar\" to the +server." + :type 'boolean + :group 'circe) + +(defcustom circe-server-connected-hook nil + "Hook run when we successfully connected to a server. +This is run from a 001 (RPL_WELCOME) message handler." + :type 'hook + :group 'circe) + +(defcustom circe-server-auto-join-default-type :immediate + "The default auto-join type to use. + +Possible options: + +:immediate - Immediately after registering on the server +:after-auth - After nickserv authentication succeeded +:after-cloak - After we have acquired a cloaked host name +:after-nick - After we regained our preferred nick, or after + nickserv authentication if we don't need to regain + it. See `circe-nickserv-ghost-style'. + +See `circe-channels' for more details." + :type '(choice (const :tag "Immediately" :immediate) + (const :tag "After Authentication" :after-auth) + (const :tag "After Cloaking" :after-cloak) + (const :tag "After Nick Regain" :after-nick)) + :group 'circe) + +;;;;;;;;;;;;;;;;; +;;;; Formats ;;;; +;;;;;;;;;;;;;;;;; + +(defgroup circe-format nil + "Format strings for Circe. +All these formats always allow the {mynick} and {chattarget} format +strings." + :prefix "circe-format-" + :group 'circe) + +(defcustom circe-format-not-tracked + '(circe-format-server-message + circe-format-server-notice + circe--irc-format-server-numeric + circe-format-server-topic + circe-format-server-rejoin + circe-format-server-lurker-activity + circe-format-server-topic-time + circe-format-server-topic-time-for-channel + circe-format-server-netmerge + circe-format-server-join + circe-format-server-join-in-channel + circe-format-server-mode-change + circe-format-server-nick-change-self + circe-format-server-nick-change + circe-format-server-nick-regain + circe-format-server-part + circe-format-server-netsplit + circe-format-server-quit-channel + circe-format-server-quit) + "A list of formats that should not trigger tracking." + :type '(repeat symbol) + :group 'circe-format) + +(defcustom circe-format-server-message "*** {body}" + "The format for generic server messages. +{body} - The body of the message." + :type 'string + :group 'circe-format) + +(defcustom circe-format-self-say "> {body}" + "The format for messages to queries or channels. +{nick} - Your nick. +{body} - The body of the message." + :type 'string + :group 'circe-format) + +(defcustom circe-format-self-action "* {nick} {body}" + "The format for actions to queries or channels. +{nick} - Your nick. +{body} - The body of the action." + :type 'string + :group 'circe-format) + +(defcustom circe-format-self-message "-> *{chattarget}* {body}" + "The format for messages sent to other people outside of queries. +{chattarget} - The target nick. +{body} - The body of the message." + :type 'string + :group 'circe-format) + +(defcustom circe-format-action "* {nick} {body}" + "The format for actions in queries or channels. +{nick} - The nick doing the action. +{body} - The body of the action." + :type 'string + :group 'circe-format) + +(defcustom circe-format-message-action "* *{nick}* {body}" + "The format for actions in messages outside of queries. +{nick} - The nick doing the action. +{body} - The body of the action." + :type 'string + :group 'circe-format) + +(defcustom circe-format-say "<{nick}> {body}" + "The format for normal channel or query talk. +{nick} - The nick talking. +{body} - The message." + :type 'string + :group 'circe-format) + +(defcustom circe-format-message "*{nick}* {body}" + "The format for a message outside of a query. +{nick} - The originator. +{body} - The message." + :type 'string + :group 'circe-format) + +(defcustom circe-format-notice "-{nick}- {body}" + "The format for a notice. +{nick} - The originator. +{body} - The notice." + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-notice "-Server Notice- {body}" + "The format for a server notice. +{body} - The notice." + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-topic "*** Topic change by {nick} ({userhost}): {new-topic}" + "The format for topic changes. + +The following format arguments are available: + + nick - The nick of the user who changed the topic + userhost - The user@host string of that user + channel - Where the topic change happened + new-topic - The new topic + old-topic - The previous topic + topic-diff - A colorized diff of the topics" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-lurker-activity + "*** First activity: {nick} joined {joindelta} ago." + "The format for the first-activity notice of a user. +{nick} - The originator. +{jointime} - The join time of the user (in seconds). +{joindelta} - The duration from joining until now." + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-rejoin + "*** Re-join: {nick} ({userinfo}), left {departuredelta} ago" + "The format for the re-join notice of a user. + +The following format arguments are available: + + nick - The nick of the user who joined + userhost - The user@host string of the user who joined + accountname - The account name, if the server supports this + realname - The real name, if the server supports this + userinfo - A combination of userhost, accountname, and realname + channel - A date string describing this time + departuretime - Time in seconds when the originator had left. + departuredelta - Description of the time delta since the originator left." + :type 'string + :group 'circe-format) + +(defcustom circe-server-buffer-name "{host}:{port}" + "The format for the server buffer name. + +The following format arguments are available: + + network - The name of the network + host - The host name of the server + port - The port number or service name + service - Alias for port" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-whois-idle-with-signon "*** {whois-nick} is {idle-duration} idle (signon on {signon-date}, {signon-ago} ago)" + "Format for RPL_WHOISIDLE messages. + +The following format arguments are available: + + whois-nick - The nick this is about + idle-seconds - The number of seconds this nick has been idle + idle-duration - A textual description of the duration of the idle time + signon-time - The time (in seconds since the epoch) when this user + signed on + signon-date - A date string describing this time + signon-ago - A textual description of the duraction since signon" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-whois-idle "*** {whois-nick} is {idle-duration} idle" + "Format for RPL_WHOISIDLE messages. + +The following format arguments are available: + + whois-nick - The nick this is about + idle-seconds - The number of seconds this nick has been idle + idle-duration - A textual description of the duration of the idle time" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-topic-time "*** Topic set by {setter} on {topic-date}, {topic-ago} ago" + "Format for RPL_TOPICWHOTIME messages for the current channel. + +The following format arguments are available: + + channel - The channel the topic is for + setter - The nick of the person who set the topic + setter-userhost - The user@host string of the person who set the topic + topic-time - The time the topic was set, in seconds since the epoch + topic-date - A date string describing this time + topic-ago - A textual description of the duration since the topic + was set" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-topic-time-for-channel "*** Topic for {channel} set by {setter} on {topic-date}, {topic-ago} ago" + "Format for RPL_TOPICWHOTIME messages for a channel we are not on. + +The following format arguments are available: + + channel - The channel the topic is for + setter - The nick of the person who set the topic + setter-userhost - The user@host string of the person who set the topic + topic-time - The time the topic was set, in seconds since the epoch + topic-date - A date string describing this time + topic-ago - A textual description of the duration since the topic + was set" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-channel-creation-time "*** Channel {channel} created on {date}, {ago} ago" + "Format for RPL_CREATIONTIME messages for the current channel. + +The following format arguments are available: + + channel - The channel the topic is for + date - A date string describing this time + ago - A textual description of the duration since the channel + was created" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-ctcp-ping "*** CTCP PING request from {nick} ({userhost}) to {target}: {body} ({ago} ago)" + "Format for CTCP PING requests. + +The following format arguments are available: + + nick - The nick of the user who sent this PING request + userhost - The user@host string of the user who sent this request + target - The target of the message, usually us, but can be a channel + body - The argument of the PING request, usually a number + ago - A textual description of the duration since the request + was sent, if parseable" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-ctcp-ping-reply "*** CTCP PING reply from {nick} ({userhost}) to {target}: {ago} ago ({body})" + "Format for CTCP PING replies. + +The following format arguments are available: + + nick - The nick of the user who sent this PING request + userhost - The user@host string of the user who sent this request + target - The target of the message, usually us, but can be a channel + body - The argument of the PING request, usually a number + ago - A textual description of the duration since the request + was sent, if parseable" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-ctcp "*** CTCP {command} request from {nick} ({userhost}) to {target}: {body}" + "Format for CTCP requests. + +The following format arguments are available: + + nick - The nick of the user who sent this PING request + userhost - The user@host string of the user who sent this request + target - The target of the message, usually us, but can be a channel + command - The CTCP command used + body - The argument of the PING request, usually a number" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-netsplit "*** Netsplit: {split} (Use /WL to see who left)" + "Format for netsplit notifications. + +The following format arguments are available: + + split - The name of the split, usually describing the servers involved" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-netmerge "*** Netmerge: {split}, split {ago} ago (Use /WL to see who's still missing)" + "Format for netmerge notifications. + +The following format arguments are available: + + split - The name of the split, usually describing the servers involved + time - The time when this split happened, in seconds + date - A date string describing this time + ago - A textual description of the duration since the split happened" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-join "*** Join: {nick} ({userinfo})" + "Format for join messages in a channel buffer. + +The following format arguments are available: + + nick - The nick of the user joining + userhost - The user@host string for the user + accountname - The account name, if the server supports this + realname - The real name, if the server supports this + userinfo - A combination of userhost, accountname, and realname + channel - The channel this user is joining" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-join-in-channel "*** Join: {nick} ({userinfo}) joined {channel}" + "Format for join messages in query buffers of the joining user. + +The following format arguments are available: + + nick - The nick of the user joining + userhost - The user@host string for the user + accountname - The account name, if the server supports this + realname - The real name, if the server supports this + userinfo - A combination of userhost, accountname, and realname + channel - The channel this user is joining" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-mode-change "*** Mode change: {change} on {target} by {setter} ({userhost})" + "Format for mode changes. + +The following format arguments are available: + + setter - The name of the split, usually describing the servers involved + userhost - The user@host string for the user + target - The target of this mode change + change - The actual changed modes" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-nick-change-self "*** Nick change: You are now known as {new-nick}" + "Format for nick changes of the current user. + +The following format arguments are available: + + old-nick - The old nick this change was from + new-nick - The new nick this change was to + userhost - The user@host string for the user" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-nick-change "*** Nick change: {old-nick} ({userhost}) is now known as {new-nick}" + "Format for nick changes of the current user. + +The following format arguments are available: + + old-nick - The old nick this change was from + new-nick - The new nick this change was to + userhost - The user@host string for the user" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-nick-regain "*** Nick regain: {old-nick} ({userhost}) is now known as {new-nick}" + "Format for nick changes of the current user. + +The following format arguments are available: + + old-nick - The old nick this change was from + new-nick - The new nick this change was to + userhost - The user@host string for the user" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-part "*** Part: {nick} ({userhost}) left {channel}: {reason}" + "Format for users parting a channel. + +The following format arguments are available: + + nick - The nick of the user who left + userhost - The user@host string for this user + channel - The channel they left + reason - The reason they gave for leaving" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-quit-channel "*** Quit: {nick} ({userhost}) left {channel}: {reason}" + "Format for users quitting from a channel. + +The following format arguments are available: + + nick - The nick of the user who left + userhost - The user@host string for this user + channel - The channel they left + reason - The reason they gave for leaving" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-quit "*** Quit: {nick} ({userhost}) left IRC: {reason}" + "Format for users quitting. + +The following format arguments are available: + + nick - The nick of the user who left + userhost - The user@host string for this user + reason - The reason they gave for leaving" + :type 'string + :group 'circe-format) + +;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Private variables ;;; +;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar circe-source-url "https://github.com/jorgenschaefer/circe" + "URL to Circe's source repository") + +(defvar circe-host nil + "The name of the server we're currently connected to.") +(make-variable-buffer-local 'circe-host) + +(defvar circe-port nil + "The port number or service name of the server.") +(make-variable-buffer-local 'circe-host) + +(defvar circe-network nil + "The network name of the server we're currently connected to.") +(make-variable-buffer-local 'circe-network) + +(defvar circe-ip-family nil + "The IP family in use. +See `make-network-process' and :family for valid values.") +(make-variable-buffer-local 'circe-ip-family) + +(defvar circe-nick nil + "Our current nick.") +(make-variable-buffer-local 'circe-nick) + +(defvar circe-user nil + "The current user name.") +(make-variable-buffer-local 'circe-user) + +(defvar circe-realname nil + "The current real name.") +(make-variable-buffer-local 'circe-realname) + +(defvar circe-pass nil + "The password for the current server or a function to recall it. + +If a function is set it will be called with the value of `circe-host'.") +(make-variable-buffer-local 'circe-pass) + +(defvar circe-sasl-username nil + "The username for SASL authentication.") +(make-variable-buffer-local 'circe-sasl-username) + +(defvar circe-sasl-password nil + "The password for SASL authentication. + +If a function is set it will be called with the value of +`circe-host'.") +(make-variable-buffer-local 'circe-sasl-password) + +(defvar circe-use-tls nil + "If non-nil, use `open-tls-stream' to connect to the server.") +(make-variable-buffer-local 'circe-use-tls) + +(defvar circe-server-process nil + "The process of the server connection.") +(make-variable-buffer-local 'circe-server-process) + +(defvar circe-server-last-active-buffer nil + "The last active circe buffer.") +(make-variable-buffer-local 'circe-server-last-active-buffer) + +(defvar circe-display-table nil + "A hash table mapping commands to their display functions.") + +(defvar circe-server-inhibit-auto-reconnect-p nil + "Non-nil when Circe should not reconnect. + +This can be set from commands to avoid reconnecting when the +server disconnects.") +(make-variable-buffer-local 'circe-server-inhibit-auto-reconnect-p) + +(defvar circe-chat-calling-server-buffer-and-target nil + "Internal variable to pass the server buffer and target to chat modes.") + +(defvar circe-chat-target nil + "The current target for the buffer. +This is either a channel or a nick name.") +(make-variable-buffer-local 'circe-chat-target) + +(defvar circe-nick-syntax-table + (let ((table (make-syntax-table text-mode-syntax-table)) + (special (string-to-list "[]\`_^{}|-"))) + (dolist (char special) + (modify-syntax-entry char "w" table)) + table) + "Syntax table to treat nicks as words. +This is not entirely accurate, as exact chars constituting a nick +can vary between networks.") + +(defvar circe-nickserv-mask nil + "The regular expression to identify the nickserv on this network. + +Matched against nick!user@host.") +(make-variable-buffer-local 'circe-nickserv-mask) + +(defvar circe-nickserv-identify-challenge nil + "A regular expression matching the nickserv challenge to identify.") +(make-variable-buffer-local 'circe-nickserv-identify-challenge) + +(defvar circe-nickserv-identify-command nil + "The IRC command to send to identify with nickserv. + +This must be a full IRC command. It accepts the following +formatting options: + + {nick} - The nick to identify as + {password} - The configured nickserv password") +(make-variable-buffer-local 'circe-nickserv-identify-command) + +(defvar circe-nickserv-identify-confirmation nil + "A regular expression matching a confirmation of authentication.") +(make-variable-buffer-local 'circe-nickserv-identify-confirmation) + +(defvar circe-nickserv-ghost-command nil + "The IRC command to send to regain/ghost your nick. + +This must be a full IRC command. It accepts the following +formatting options: + + {nick} - The nick to ghost + {password} - The configured nickserv password") +(make-variable-buffer-local 'circe-nickserv-ghost-command) + +(defvar circe-nickserv-ghost-confirmation nil + "A regular expression matching a confirmation for the GHOST command. + +This is used to know when we can set our nick to the regained one +Leave nil if regaining automatically sets your nick") +(make-variable-buffer-local 'circe-nickserv-ghost-confirmation) + +(defvar circe-nickserv-nick nil + "The nick we are registered with for nickserv. + +Do not set this variable directly. Use `circe-network-options' or +pass an argument to the `circe' function for this.") +(make-variable-buffer-local 'circe-nickserv-nick) + +(defvar circe-nickserv-password nil + "The password we use for nickserv on this network. + +Can be either a string or a unary function of the nick returning +a string. + +Do not set this variable directly. Use `circe-network-options' or +pass an argument to the `circe' function for this.") +(make-variable-buffer-local 'circe-nickserv-password) + +(defvar circe-channels nil + "The default channels to join on this server. + +Don't set this variable by hand, use `circe-network-options'. + +The value should be a list of channels to join, with optional +keywords to configure the behavior of the following channels. + +Best explained in an example: + +\(\"#emacs\" :after-auth \"#channel\" \"#channel2\") + +Possible keyword options are: + +:immediate - Immediately after registering on the server +:after-auth - After nickserv authentication succeeded +:after-cloak - After we have acquired a cloaked host name +:after-nick - After we regained our preferred nick, or after + nickserv authentication if we don't need to regain + it. See `circe-nickserv-ghost-style'. + +The default is set in `circe-server-auto-join-default-type'. + +A keyword in the first position of the channels list overrides +`circe-server-auto-join-default-type' for re-joining manually +joined channels.") +(make-variable-buffer-local 'circe-channels) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; Server Buffer Management ;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Every Circe buffer has an associated server buffer (which might be +;; the buffer itself). Circe buffers should set the +;; `circe-server-buffer' variable to the associated server buffer. + +(defun circe-server-buffer () + "Return the server buffer for the current buffer." + (let ((buf (if (eq major-mode 'circe-server-mode) + (current-buffer) + circe-server-buffer))) + (cond + ((not buf) + (error "Not in a Circe buffer")) + ((not (buffer-live-p buf)) + (error "The server buffer died, functionality is limited")) + (t + buf)))) + +(defmacro with-circe-server-buffer (&rest body) + "Run BODY with the current buffer being the current server buffer." + (declare (indent 0)) + `(with-current-buffer (circe-server-buffer) + ,@body)) + +;;;;;;;;;;;;;;;;;;;;;;; +;;; Editor Commands ;;; +;;;;;;;;;;;;;;;;;;;;;;; + +;;;###autoload +(defun circe-version () + "Display Circe's version." + (interactive) + (message "Circe %s" (circe--version))) + +(defun circe--version () + "Return Circe's version" + (let ((circe-git-version (circe--git-version))) + (if circe-git-version + (format "%s-%s" circe-version circe-git-version) + (format "%s" circe-version)))) + +(defun circe--git-version () + (let ((current-file-path (or load-file-name buffer-file-name))) + (when (or (not current-file-path) + (not (equal (file-name-nondirectory current-file-path) + "circe.el"))) + (setq current-file-path (locate-library "circe.el"))) + (let ((vcs-path (locate-dominating-file current-file-path ".git"))) + (when vcs-path + (let ((default-directory vcs-path)) + ;; chop off the trailing newline + (substring (shell-command-to-string "git rev-parse --short HEAD") + 0 -1)))))) + +;;;###autoload +(defun circe (network-or-server &rest server-options) + "Connect to IRC. + +Connect to the given network specified by NETWORK-OR-SERVER. + +When this function is called, it collects options from the +SERVER-OPTIONS argument, the user variable +`circe-network-options', and the defaults found in +`circe-network-defaults', in this order. + +If NETWORK-OR-SERVER is not found in any of these variables, the +argument is assumed to be the host name for the server, and all +relevant settings must be passed via SERVER-OPTIONS. + +All SERVER-OPTIONS are treated as variables by getting the string +\"circe-\" prepended to their name. This variable is then set +locally in the server buffer. + +See `circe-network-options' for a list of common options." + (interactive (circe--read-network-and-options)) + (let* ((options (circe--server-get-network-options network-or-server + server-options)) + (buffer (circe--server-generate-buffer options))) + (with-current-buffer buffer + (circe-server-mode) + (circe--server-set-variables options) + (circe-reconnect)) + (pop-to-buffer-same-window buffer))) + +(defun circe--read-network-and-options () + "Read a host or network name with completion. + +If it's not a network, also read some extra options. + +This uses `circe-network-defaults' and `circe-network-options' for +network names." + (let ((default-network (if (null circe-network-options) + (caar circe-network-defaults) + (caar circe-network-options))) + (networks nil) + (completion-ignore-case t) + network-or-host) + (dolist (network-spec (append circe-network-options + circe-network-defaults)) + (when (not (member (car network-spec) networks)) + (push (car network-spec) networks))) + (setq networks (sort networks 'string-lessp)) + (setq network-or-host (completing-read "Network or host: " + networks + nil nil nil nil + default-network)) + (dolist (network-name networks) + (when (equal (downcase network-or-host) + (downcase network-name)) + (setq network-or-host network-name))) + (if (member network-or-host networks) + (list network-or-host) + (list network-or-host + :host network-or-host + :port (read-number "Port: " 6667))))) + +(defun circe--server-get-network-options (network server-options) + "Combine server and network options with network defaults. + +See `circe-network-options' and `circe-network-defaults'." + (let ((options (mapcar 'circe--translate-option-names + (append server-options + (cdr (assoc network circe-network-options)) + (cdr (assoc network circe-network-defaults)) + (list :network network))))) + (when (not (plist-get options :host)) + (plist-put options :host network)) + (let ((port (plist-get options :port)) + (use-tls (plist-get options :use-tls))) + (when (consp port) + (if use-tls + (plist-put options :port (cdr port)) + (plist-put options :port (car port))))) + (dolist (required-option '(:host :port)) + (when (not (plist-get options required-option)) + (error (format "Network option %s not specified" required-option)))) + options)) + +(defun circe--translate-option-names (option) + "Translate option names to make them unique. + +Some options have multiple names, mainly for historical reasons. +Unify them here." + (cond + ((eq option :service) :port) + ((eq option :tls) :use-tls) + ((eq option :family) :ip-family) + (t option))) + +(defun circe--server-generate-buffer (options) + "Return the server buffer for the connection described in OPTIONS." + (let* ((network (plist-get options :network)) + (host (plist-get options :host)) + (port (plist-get options :port)) + (buffer-name (lui-format (or (plist-get options :server-buffer-name) + circe-server-buffer-name) + :network network + :host host + :port port + :service port))) + (generate-new-buffer buffer-name))) + +(defun circe--server-set-variables (options) + "Set buffer-local variables described in OPTIONS. + +OPTIONS is a plist as passed to `circe'. All options therein are +set as buffer-local variables. Only the first occurrence of each +variable is set." + (setq circe-nick circe-default-nick + circe-user circe-default-user + circe-realname circe-default-realname + circe-ip-family circe-default-ip-family) + (let ((done nil) + (todo options)) + (while todo + (when (not (memq (car todo) done)) + (push (car todo) done) + (let ((var (intern (format "circe-%s" + (substring (symbol-name (car todo)) 1)))) + (val (cadr todo))) + (if (boundp var) + (set (make-local-variable var) val) + (warn "Unknown option %s, ignored" (car todo))))) + (setq todo (cddr todo))))) + +(defvar circe-server-reconnect-attempts 0 + "The number of reconnect attempts that Circe has done so far. +See `circe-server-max-reconnect-attempts'.") +(make-variable-buffer-local 'circe-server-reconnect-attempts) + +(defun circe-reconnect () + "Reconnect the current server." + (interactive) + (with-circe-server-buffer + (when (or (called-interactively-p 'any) + (circe--reconnect-p)) + (setq circe-server-inhibit-auto-reconnect-p t + circe-server-reconnect-attempts (+ circe-server-reconnect-attempts + 1)) + (unwind-protect + (circe-reconnect--internal) + (setq circe-server-inhibit-auto-reconnect-p nil))))) + +(defun circe--reconnect-p () + (cond + (circe-server-inhibit-auto-reconnect-p + nil) + ((not circe-server-max-reconnect-attempts) + t) + ((<= circe-server-reconnect-attempts + circe-server-max-reconnect-attempts) + t) + (t + nil))) + +(defun circe-reconnect--internal () + "The internal function called for reconnecting unconditionally. + +Do not use this directly, use `circe-reconnect'" + (when (and circe-server-process + (process-live-p circe-server-process)) + (delete-process circe-server-process)) + (circe-display-server-message "Connecting...") + (dolist (buf (circe-server-chat-buffers)) + (with-current-buffer buf + (circe-display-server-message "Connecting..."))) + (setq circe-server-process + (irc-connect + :host circe-host + :service circe-port + :tls circe-use-tls + :ip-family circe-ip-family + :handler-table (circe-irc-handler-table) + :server-buffer (current-buffer) + :nick circe-nick + :nick-alternatives (list (circe--nick-next circe-nick) + (circe--nick-next + (circe--nick-next circe-nick))) + :user circe-user + :mode 8 + :realname circe-realname + :pass (if (functionp circe-pass) + (funcall circe-pass circe-host) + circe-pass) + :cap-req (append (when (and circe-sasl-username + circe-sasl-password) + '("sasl")) + '("extended-join")) + :nickserv-nick (or circe-nickserv-nick + circe-nick) + :nickserv-password (if (functionp circe-nickserv-password) + (funcall circe-nickserv-password circe-host) + circe-nickserv-password) + :nickserv-mask circe-nickserv-mask + :nickserv-identify-challenge circe-nickserv-identify-challenge + :nickserv-identify-command circe-nickserv-identify-command + :nickserv-identify-confirmation + circe-nickserv-identify-confirmation + :nickserv-ghost-command circe-nickserv-ghost-command + :nickserv-ghost-confirmation circe-nickserv-ghost-confirmation + :sasl-username circe-sasl-username + :sasl-password (if (functionp circe-sasl-password) + (funcall circe-sasl-password + circe-host) + circe-sasl-password) + :ctcp-version (format "Circe: Client for IRC in Emacs, version %s" + circe-version) + :ctcp-source circe-source-url + :ctcp-clientinfo "CLIENTINFO PING SOURCE TIME VERSION" + :auto-join-after-registration + (append (circe--auto-join-channel-buffers) + (circe--auto-join-list :immediate)) + :auto-join-after-host-hiding + (circe--auto-join-list :after-cloak) + :auto-join-after-nick-acquisition + (circe--auto-join-list :after-nick) + :auto-join-after-nickserv-identification + (circe--auto-join-list :after-auth) + :auto-join-after-sasl-login + (circe--auto-join-list :after-auth)))) + +(defun circe-reconnect-all () + "Reconnect all Circe connections." + (interactive) + (dolist (buf (circe-server-buffers)) + (with-current-buffer buf + (if (called-interactively-p 'any) + (call-interactively 'circe-reconnect) + (circe-reconnect))))) + +(defun circe--auto-join-list (type) + "Return the list of channels to join for type TYPE." + (let ((result nil) + (current-type circe-server-auto-join-default-type)) + (dolist (channel circe-channels) + (cond + ((keywordp channel) + (setq current-type channel)) + ((eq current-type type) + (push channel result)))) + (nreverse result))) + +(defun circe--auto-join-channel-buffers () + "Return a list of channels to join based on channel buffers. + +This includes all channel buffers of the current server, but +excludes and channel that is already listed in +`circe-channels'." + (let ((channels nil)) + (dolist (buf (circe-server-chat-buffers)) + (let ((name (with-current-buffer buf + (when (derived-mode-p 'circe-channel-mode) + circe-chat-target)))) + (when (and name + (not (member name circe-channels))) + (push name channels)))) + channels)) + +;;;;;;;;;;;;;;;;; +;;; Base Mode ;;; +;;;;;;;;;;;;;;;;; + +(defvar circe-mode-hook nil + "Hook run for any Circe mode.") + +(defvar circe-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-j") 'circe-command-JOIN) + (define-key map (kbd "C-c C-r") 'circe-reconnect) + map) + "The base keymap for all Circe modes (server, channel, query)") + +(defvar circe-server-buffer nil + "The buffer of the server associated with the current chat buffer.") +(make-variable-buffer-local 'circe-server-buffer) + +(define-derived-mode circe-mode lui-mode "Circe" + "Base mode for all Circe buffers. + +A buffer should never be in this mode directly, but rather in +modes that derive from this. + +The mode inheritance hierarchy looks like this: + +lui-mode +`-circe-mode + `-circe-server-mode + `-circe-chat-mode + `-circe-channel-mode + `-circe-query-mode" + (add-hook 'lui-pre-output-hook 'lui-irc-colors + t t) + (add-hook 'lui-pre-output-hook 'circe--output-highlight-nick + t t) + (add-hook 'completion-at-point-functions 'circe--completion-at-point + nil t) + (lui-set-prompt circe-prompt-string) + (goto-char (point-max)) + (setq lui-input-function 'circe--input + default-directory (expand-file-name circe-default-directory) + circe-server-last-active-buffer (current-buffer) + flyspell-generic-check-word-p 'circe--flyspell-check-word-p) + (when circe-use-cycle-completion + (set (make-local-variable 'completion-cycle-threshold) + t)) + ;; Tab completion should be case-insensitive + (set (make-local-variable 'completion-ignore-case) + t) + (set (make-local-variable 'tracking-faces-priorities) + circe-track-faces-priorities)) + +;;;;;;;;;;;;;;;;;;;; +;;;; Displaying ;;;; +;;;;;;;;;;;;;;;;;;;; + +(defun circe-display (format &rest keywords) + "Display FORMAT formatted with KEYWORDS in the current Circe buffer. +See `lui-format' for a description of the format. + +If FORMAT contains the word server, the resulting string receives +a `circe-server-face'. If FORMAT contains the word self, the +whole string receives a `circe-my-message-face'. If FORMAT is in +`circe-format-not-tracked', a message of this type is never +tracked by Lui. + +Keywords with the name :nick receive a `circe-originator-face'. + +It is always possible to use the mynick or target formats." + (when (not (circe--display-ignored-p format keywords)) + (let* ((name (symbol-name format)) + (face (cond + ((string-match "\\<server\\>" name) + 'circe-server-face) + ((string-match "\\<self\\>" name) + 'circe-my-message-face))) + (keywords (append `(:mynick ,(circe-nick) + :chattarget ,circe-chat-target) + (circe--display-add-nick-property + (if (and (not (null keywords)) + (null (cdr keywords))) + (car keywords) + keywords)))) + (text (lui-format format keywords))) + (when (circe--display-fool-p format keywords) + (add-face-text-property 0 (length text) + 'circe-fool-face t text) + (put-text-property 0 (length text) + 'lui-fool t + text)) + (when face + (add-face-text-property 0 (length text) + face t text)) + (lui-insert text + (memq format circe-format-not-tracked))))) + +(defun circe-display-server-message (message) + "Display MESSAGE as a server message." + (circe-display 'circe-format-server-message + :body message)) + +(defun circe--display-add-nick-property (keywords) + "Add a face to the value of the :nick property in KEYWORDS." + (let ((keyword nil)) + (mapcar (lambda (entry) + (cond + ((or (eq keyword :nick) + (eq keyword 'nick)) + (setq keyword nil) + (propertize entry 'face 'circe-originator-face)) + (t + (setq keyword entry) + entry))) + keywords))) + +(defun circe--display-ignored-p (_format keywords) + (let ((nick (plist-get keywords :nick)) + (userhost (plist-get keywords :userhost)) + (body (plist-get keywords :body))) + (circe--ignored-p nick userhost body))) + +(defun circe--display-fool-p (_format keywords) + (let ((nick (plist-get keywords :nick)) + (userhost (plist-get keywords :userhost)) + (body (plist-get keywords :body))) + (circe--fool-p nick userhost body))) + +(defun circe--ignored-p (nick userhost body) + "True if this user or message is being ignored. + +See `circe-ignore-functions' and `circe-ignore-list'. + +NICK, USER and HOST should be the sender of a the command +COMMAND, which had the arguments ARGS." + (or (run-hook-with-args-until-success 'circe-ignore-functions + nick userhost body) + (circe--ignore-matches-p nick userhost body circe-ignore-list))) + +(defun circe--fool-p (nick userhost body) + "True if this user or message is a fool. + +See `circe-fool-list'. + +NICK, USER and HOST should be the sender of a the command +COMMAND, which had the arguments ARGS." + (circe--ignore-matches-p nick userhost body circe-fool-list)) + +(defun circe--ignore-matches-p (nick userhost body patterns) + "Check if a given command does match an ignore pattern. + +A pattern matches if it either matches the user NICK!USER@HOST, +or if it matches the first word in BODY. + +PATTERNS should be the list of regular expressions." + (let ((string (format "%s!%s" nick userhost)) + (target (when (and body + (string-match "^\\([^ ]*\\)[:,]" body)) + (match-string 1 body)))) + (catch 'return + (dolist (regex patterns) + (when (string-match regex string) + (throw 'return t)) + (when (and (stringp target) + (string-match regex target)) + (throw 'return t))) + nil))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; Nick Highlighting ;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun circe--output-highlight-nick () + "Highlight the nick of the user in the buffer. + +This is used in `lui-pre-output-hook'." + (goto-char (or (text-property-any (point-min) (point-max) + 'lui-format-argument 'body) + (point-min))) + (when (or (not circe-inhibit-nick-highlight-function) + (not (funcall circe-inhibit-nick-highlight-function))) + (let* ((nick (circe-nick)) + (nicks (append (and nick (list nick)) + circe-extra-nicks))) + (when nicks + ;; Can't use \<...\> because that won't match for \<forcer-\> We + ;; might eventually use \_< ... \_> if we define symbols to be + ;; nicks \\= is necessary, because it might be found right where we + ;; are, and that might not be the beginning of a line... (We start + ;; searching from the beginning of the body) + (let ((nick-regex (concat "\\(?:^\\|\\W\\|\\=\\)" + "\\(" (regexp-opt nicks) "\\)" + "\\(?:$\\|\\W\\)"))) + (cond + ((eq circe-highlight-nick-type 'sender) + (if (text-property-any (point-min) + (point-max) + 'face 'circe-originator-face) + (when (re-search-forward nick-regex nil t) + (circe--extend-text-having-face + (point-min) (point-max) + 'circe-originator-face + 'circe-highlight-nick-face)) + (let ((circe-highlight-nick-type 'occurrence)) + (circe--output-highlight-nick)))) + ((eq circe-highlight-nick-type 'occurrence) + (while (re-search-forward nick-regex nil t) + (add-face-text-property (match-beginning 1) + (match-end 1) + 'circe-highlight-nick-face))) + ((eq circe-highlight-nick-type 'message) + (when (re-search-forward nick-regex nil t) + (let* ((start (text-property-any (point-min) + (point-max) + 'lui-format-argument 'body)) + (end (when start + (next-single-property-change start + 'lui-format-argument)))) + (when (and start end) + (add-face-text-property start end + 'circe-highlight-nick-face))))) + ((eq circe-highlight-nick-type 'all) + (when (re-search-forward nick-regex nil t) + (add-face-text-property (point-min) (point-max) + 'circe-highlight-nick-face))))))))) + +(defun circe--extend-text-having-face (from to existing new) + "Extend property values. + +In the text between FROM and TO, find any text that has its face +property set to EXISTING, and prepend NEW to the value of its +face property, when necessary by turning it into a list." + (let ((beg (text-property-any from to 'face existing))) + (while beg + (let ((end (next-single-property-change beg 'face))) + (add-face-text-property beg end new) + (setq beg (text-property-any end to 'face existing)))))) + +;;;;;;;;;;;;;;; +;;;; Input ;;;; +;;;;;;;;;;;;;;; + +(defun circe--input (str) + "Process STR as input. + +This detects commands and interprets them, or sends the input +using the /SAY command." + (set-text-properties 0 (length str) nil str) + (cond + ((string= str "") + nil) + ;; Ignore commands in multiline input + ((and (not (string-match "\n" str)) + (string-match "\\`/\\([^/ ][^ ]*\\|[^/ ]*\\) ?\\([^\n]*\\)\\'" str)) + (let* ((command (match-string 1 str)) + (args (match-string 2 str)) + (handler (intern-soft (format "circe-command-%s" + (upcase command))))) + (cond + ((string= command "") + (circe-command-SAY args)) + (handler + (funcall handler args)) + (circe-server-send-unknown-command-p + (irc-send-raw (circe-server-process) + (format "%s %s" + (upcase command) + args))) + (t + (circe-display-server-message (format "Unknown command: %s" + command)))))) + (t + (mapc #'circe-command-SAY + (circe--list-drop-right (split-string str "\n") + "^ *$"))))) + +;;;;;;;;;;;;;;;;;; +;;;; Flyspell ;;;; +;;;;;;;;;;;;;;;;;; + +(defun circe--flyspell-check-word-p () + "Return a true value if flyspell check the word before point. + +This is a suitable value for `flyspell-generic-check-word-p'. It +will also call `lui-flyspell-check-word-p'." + (cond + ((not (lui-flyspell-check-word-p)) + nil) + ((circe-channel-user-p (circe--flyspell-nick-before-point)) + nil) + (t + t))) + +(defun circe--flyspell-nick-before-point () + "Return the IRC nick before point" + (with-syntax-table circe-nick-syntax-table + (let (beg end) + (save-excursion + (forward-word -1) + (setq beg (point)) + (forward-word 1) + (setq end (point))) + (buffer-substring beg end)))) + +;;;;;;;;;;;;;;;;;;;; +;;;; Completion ;;;; +;;;;;;;;;;;;;;;;;;;; + +(defun circe--completion-at-point () + "Return a list of possible completions for the current buffer. + +This is used in `completion-at-point-functions'." + ;; Use markers so they move when input happens + (let ((start (make-marker)) + (end (make-marker))) + (set-marker end (point)) + (set-marker start + (save-excursion + (when (or (looking-back (regexp-quote + circe-completion-suffix) + (length circe-completion-suffix)) + (looking-back " " 1)) + (goto-char (match-beginning 0))) + (cond + ((<= (point) lui-input-marker) + lui-input-marker) + ((re-search-backward "\\s-" lui-input-marker t) + (1+ (point))) + (t + lui-input-marker)))) + (list start end 'circe--completion-table))) + +(defun circe--completion-table (string pred action) + "Completion table to use for Circe buffers. + +See `minibuffer-completion-table' for details." + (cond + ;; Best completion of STRING + ((eq action nil) + (try-completion string + (circe--completion-candidates + (if (= (- (point) (length string)) + lui-input-marker) + circe-completion-suffix + " ")) + pred)) + ;; A list of possible completions of STRING + ((eq action t) + (all-completions string + (circe--completion-candidates + (if (= (- (point) (length string)) + lui-input-marker) + circe-completion-suffix + " ")) + pred)) + ;; t iff STRING is a valid completion as it stands + ((eq action 'lambda) + (test-completion string + (circe--completion-candidates + (if (= (- (point) (length string)) + lui-input-marker) + circe-completion-suffix + " ")) + pred)) + ;; Boundaries + ((eq (car-safe action) 'boundaries) + `(boundaries 0 . ,(length (cdr action)))) + ;; Metadata + ((eq action 'metadata) + '(metadata (cycle-sort-function . circe--completion-sort))))) + +(defun circe--completion-clean-nick (string) + (with-temp-buffer + (insert string) + (goto-char (point-max)) + (when (or (looking-back circe-completion-suffix nil) + (looking-back " " nil)) + (replace-match "")) + (buffer-string))) + +(defun circe--completion-sort (collection) + "Sort the COLLECTION by channel activity for nicks." + (let* ((proc (circe-server-process)) + (channel (when (and circe-chat-target proc) + (irc-connection-channel proc circe-chat-target))) + (decorated (mapcar (lambda (entry) + (let* ((nick (circe--completion-clean-nick + entry)) + (user (when channel + (irc-channel-user channel nick)))) + (list (when user + (irc-user-last-activity-time user)) + (length entry) + entry))) + collection)) + (sorted (sort decorated + (lambda (a b) + (cond + ((and (car a) + (car b)) + (> (car a) + (car b))) + ((and (not (car a)) + (not (car b))) + (< (cadr a) + (cadr b))) + ((car a) + t) + (t + nil)))))) + (mapcar (lambda (entry) + (nth 2 entry)) + sorted))) + +;; FIXME: I do not know why this is here. +(defvar circe--completion-old-completion-all-sorted-completions nil + "Variable to know if we can return a cached result.") +(make-variable-buffer-local + 'circe--completion-old-completion-all-sorted-completions) +(defvar circe--completion-cache nil + "The results we can cache.") +(make-variable-buffer-local 'circe--completion-cache) + +(defun circe--completion-candidates (nick-suffix) + (if (and circe--completion-old-completion-all-sorted-completions + (eq completion-all-sorted-completions + circe--completion-old-completion-all-sorted-completions)) + circe--completion-cache + (let ((completions (append (circe--commands-list) + (mapcar (lambda (buf) + (with-current-buffer buf + circe-chat-target)) + (circe-server-channel-buffers))))) + (cond + ;; In a server buffer, complete all nicks in all channels + ((eq major-mode 'circe-server-mode) + (dolist (buf (circe-server-channel-buffers)) + (with-current-buffer buf + (dolist (nick (circe-channel-nicks)) + (setq completions (cons (concat nick nick-suffix) + completions)))))) + ;; In a channel buffer, only complete nicks in this channel + ((eq major-mode 'circe-channel-mode) + (setq completions (append (delete (concat (circe-nick) + nick-suffix) + (mapcar (lambda (nick) + (concat nick nick-suffix)) + (circe-channel-nicks))) + completions))) + ;; In a query buffer, only complete this query partner + ((eq major-mode 'circe-query-mode) + (setq completions (cons (concat circe-chat-target nick-suffix) + completions))) + ;; Else, we're doing something wrong + (t + (error "`circe-possible-completions' called outside of Circe"))) + (setq circe--completion-old-completion-all-sorted-completions + completion-all-sorted-completions + circe--completion-cache completions) + completions))) + +(defun circe--commands-list () + "Return a list of possible Circe commands." + (mapcar (lambda (symbol) + (let ((str (symbol-name symbol))) + (if (string-match "^circe-command-\\(.*\\)" str) + (concat "/" (match-string 1 str) " ") + str))) + (apropos-internal "^circe-command-"))) + +;;;;;;;;;;;;;;;;;;; +;;; Server Mode ;;; +;;;;;;;;;;;;;;;;;;; + +(defvar circe-server-mode-hook nil + "Hook run when a new Circe server buffer is created.") + +(defvar circe-server-mode-map (make-sparse-keymap) + "The key map for server mode buffers.") + +(define-derived-mode circe-server-mode circe-mode "Circe Server" + "The mode for circe server buffers. + +This buffer represents a server connection. When you kill it, the +server connection is closed. This will make all associated +buffers unusable. Be sure to use \\[circe-reconnect] if you want +to reconnect to the server. + +\\{circe-server-mode-map}" + (add-hook 'kill-buffer-hook 'circe-server-killed nil t)) + +(defun circe-server-killed () + "Run when the server buffer got killed. + +This will IRC, and ask the user whether to kill all of the +server's chat buffers." + (when circe-server-killed-confirmation + (when (not (y-or-n-p + (if (eq circe-server-killed-confirmation 'ask-and-kill-all) + "Really kill all buffers of this server? (if not, try `circe-reconnect') " + "Really kill the IRC connection? (if not, try `circe-reconnect') "))) + (error "Buffer not killed as per user request"))) + (setq circe-server-inhibit-auto-reconnect-p t) + (ignore-errors + (irc-send-QUIT circe-server-process circe-default-quit-message)) + (ignore-errors + (delete-process circe-server-process)) + (when (or (eq circe-server-killed-confirmation 'ask-and-kill-all) + (eq circe-server-killed-confirmation 'kill-all)) + (dolist (buf (circe-server-chat-buffers)) + (let ((circe-channel-killed-confirmation nil)) + (kill-buffer buf))))) + +(defun circe-server-buffers () + "Return a list of all server buffers in this Emacs instance." + (let ((result nil)) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (eq major-mode 'circe-server-mode) + (setq result (cons buf result))))) + (nreverse result))) + +(defun circe-server-process () + "Return the current server process." + (with-circe-server-buffer + circe-server-process)) + +(defun circe-server-my-nick-p (nick) + "Return non-nil when NICK is our current nick." + (let ((proc (circe-server-process))) + (when proc + (irc-current-nick-p proc nick)))) + +(defun circe-nick () + "Return our current nick." + (let ((proc (circe-server-process))) + (when proc + (irc-current-nick proc)))) + +(defun circe-server-last-active-buffer () + "Return the last active buffer of this server." + (with-circe-server-buffer + (if (and circe-server-last-active-buffer + (bufferp circe-server-last-active-buffer) + (buffer-live-p circe-server-last-active-buffer)) + circe-server-last-active-buffer + (current-buffer)))) + +;; There really ought to be a hook for this +(defadvice select-window (after circe-server-track-select-window + (window &optional norecord)) + "Remember the current buffer as the last active buffer. +This is used by Circe to know where to put spurious messages." + (with-current-buffer (window-buffer window) + (when (derived-mode-p 'circe-mode) + (let ((buf (current-buffer))) + (ignore-errors + (with-circe-server-buffer + (setq circe-server-last-active-buffer buf))))))) +(ad-activate 'select-window) + +(defun circe-reduce-lurker-spam () + "Return the value of `circe-reduce-lurker-spam'. + +This uses a buffer-local value first, then the one in the server +buffer. + +Use this instead of accessing the variable directly to enable +setting the variable through network options." + (if (local-variable-p 'circe-reduce-lurker-spam) + circe-reduce-lurker-spam + (with-circe-server-buffer + circe-reduce-lurker-spam))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; Chat Buffer Management ;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Server buffers keep track of associated chat buffers. This enables +;; us to not rely on buffer names staying the same, as well as keeping +;; buffers from different servers and even server connections apart +;; cleanly. + +(defvar circe-server-chat-buffer-table nil + "A hash table of chat buffers associated with this server.") +(make-variable-buffer-local 'circe-server-chat-buffer-table) + +(defun circe-server-get-chat-buffer (target) + "Return the chat buffer addressing TARGET, or nil if none." + (with-circe-server-buffer + (when circe-server-chat-buffer-table + (let* ((target-name (irc-isupport--case-fold (circe-server-process) + target)) + (buf (gethash target-name circe-server-chat-buffer-table))) + (if (buffer-live-p buf) + buf + (remhash target-name circe-server-chat-buffer-table) + nil))))) + +(defun circe-server-create-chat-buffer (target chat-mode) + "Return a new buffer addressing TARGET in CHAT-MODE." + (with-circe-server-buffer + (let* ((target-name (irc-isupport--case-fold (circe-server-process) + target)) + (chat-buffer (generate-new-buffer target)) + (server-buffer (current-buffer)) + (circe-chat-calling-server-buffer-and-target (cons server-buffer + target-name))) + (when (not circe-server-chat-buffer-table) + (setq circe-server-chat-buffer-table (make-hash-table :test 'equal))) + (puthash target-name chat-buffer circe-server-chat-buffer-table) + (with-current-buffer chat-buffer + (funcall chat-mode)) + chat-buffer))) + +(defun circe-server-get-or-create-chat-buffer (target chat-mode) + "Return a buffer addressing TARGET; create one in CHAT-MODE if none exists." + (let ((buf (circe-server-get-chat-buffer target))) + (if buf + buf + (circe-server-create-chat-buffer target chat-mode)))) + +(defun circe-server-remove-chat-buffer (target-or-buffer) + "Remove the buffer addressing TARGET-OR-BUFFER." + (with-circe-server-buffer + (let* ((target (if (bufferp target-or-buffer) + (circe-server-chat-buffer-target target-or-buffer) + target-or-buffer)) + (target-name (irc-isupport--case-fold (circe-server-process) + target))) + (remhash target-name circe-server-chat-buffer-table)))) + +(defun circe-server-rename-chat-buffer (old-name new-name) + "Note that the chat buffer addressing OLD-NAME now addresses NEW-NAME." + (with-circe-server-buffer + (let* ((old-target-name (irc-isupport--case-fold (circe-server-process) + old-name)) + (new-target-name (irc-isupport--case-fold (circe-server-process) + new-name)) + (buf (gethash old-target-name circe-server-chat-buffer-table))) + (when buf + (remhash old-target-name circe-server-chat-buffer-table) + (puthash new-target-name buf circe-server-chat-buffer-table) + (with-current-buffer buf + (setq circe-chat-target new-name) + (rename-buffer new-name t)))))) + +(defun circe-server-chat-buffer-target (&optional buffer) + "Return the chat target of BUFFER, or the current buffer if none." + (if buffer + (with-current-buffer buffer + circe-chat-target) + circe-chat-target)) + +(defun circe-server-chat-buffers () + "Return the list of chat buffers on this server." + (with-circe-server-buffer + (when circe-server-chat-buffer-table + (let ((buffer-list nil)) + (maphash (lambda (target-name buffer) + (if (buffer-live-p buffer) + (push buffer buffer-list) + (remhash target-name circe-server-chat-buffer-table))) + circe-server-chat-buffer-table) + buffer-list)))) + +(defun circe-server-channel-buffers () + "Return a list of all channel buffers of this server." + (let ((result nil)) + (dolist (buf (circe-server-chat-buffers)) + (with-current-buffer buf + (when (eq major-mode 'circe-channel-mode) + (setq result (cons buf result))))) + (nreverse result))) + +;;;;;;;;;;;;;;;;; +;;; Chat Mode ;;; +;;;;;;;;;;;;;;;;; + +(defvar circe-chat-mode-hook nil + "Hook run when a new chat buffer (channel or query) is created.") + +(defvar circe-chat-mode-map (make-sparse-keymap) + "Base key map for all Circe chat buffers (channel, query).") + +;; Defined here as we use it, but do not necessarily want to use the +;; full module. +(defvar lui-logging-format-arguments nil + "A list of arguments to be passed to `lui-format'. +This can be used to extend the formatting possibilities of the +file name for lui applications.") +(make-variable-buffer-local 'lui-logging-format-arguments) + +(define-derived-mode circe-chat-mode circe-mode "Circe Chat" + "The circe chat major mode. + +This is the common mode used for both queries and channels. +It should not be used directly. +TARGET is the default target to send data to. +SERVER-BUFFER is the server buffer of this chat buffer." + (setq circe-server-buffer (car circe-chat-calling-server-buffer-and-target) + circe-chat-target (cdr circe-chat-calling-server-buffer-and-target)) + (let ((network (with-circe-server-buffer + circe-network))) + (make-local-variable 'mode-line-buffer-identification) + (setq mode-line-buffer-identification + (list (format "%%b@%-8s" network))) + (setq lui-logging-format-arguments + `(:target ,circe-chat-target :network ,network))) + (when (equal circe-chat-target "#emacs-circe") + (set (make-local-variable 'lui-button-issue-tracker) + "https://github.com/jorgenschaefer/circe/issues/%s"))) + +(defun circe-chat-disconnected () + "The current buffer got disconnected." + (circe-display-server-message "Disconnected")) + +;;;;;;;;;;;;;;;;;;;; +;;; Channel Mode ;;; +;;;;;;;;;;;;;;;;;;;; + +(defvar circe-channel-mode-hook nil + "Hook run in a new channel buffer.") + +(defvar circe-channel-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-n") 'circe-command-NAMES) + (define-key map (kbd "C-c C-t") 'circe-command-CHTOPIC) + map) + "The key map for channel mode buffers.") + +(define-derived-mode circe-channel-mode circe-chat-mode "Circe Channel" + "The circe channel chat major mode. +This mode represents a channel you are talking in. + +TARGET is the default target to send data to. +SERVER-BUFFER is the server buffer of this chat buffer. + +\\{circe-channel-mode-map}" + (add-hook 'kill-buffer-hook 'circe-channel-killed nil t)) + +(defun circe-channel-killed () + "Called when the channel buffer got killed. + +If we are not on the channel being killed, do nothing. Otherwise, +if the server is live, and the user wants to kill the buffer, +send PART to the server and clean up the channel's remaining +state." + (when (buffer-live-p circe-server-buffer) + (when (and circe-channel-killed-confirmation + (not (y-or-n-p "Really leave this channel? "))) + (error "Channel not left.")) + (ignore-errors + (irc-send-PART (circe-server-process) + circe-chat-target + circe-default-part-message)) + (ignore-errors + (circe-server-remove-chat-buffer circe-chat-target)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; Channel User Tracking ;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Channel mode buffers provide some utility functions to check if a +;; given user is idle or not. + +(defun circe-channel-user-nick-regain-p (_old new) + "Return true if a nick change from OLD to NEW constitutes a nick regain. + +A nick was regained if the NEW nick was also a recent user." + (let ((channel (irc-connection-channel (circe-server-process) + circe-chat-target))) + (when channel + (irc-channel-recent-user channel new)))) + +(defun circe-channel-user-p (nick) + "Return non-nil when NICK belongs to a channel user." + (cond + ((eq major-mode 'circe-query-mode) + (irc-string-equal-p (circe-server-process) + nick + circe-chat-target)) + ((eq major-mode 'circe-channel-mode) + (let ((channel (irc-connection-channel (circe-server-process) + circe-chat-target))) + (when channel + (if (irc-channel-user channel nick) + t + nil)))))) + +(defun circe-channel-nicks () + "Return a list of nicks in the current channel." + (let* ((channel (irc-connection-channel (circe-server-process) + circe-chat-target)) + (nicks nil)) + (when channel + (maphash (lambda (_folded-nick user) + (push (irc-user-nick user) nicks)) + (irc-channel-users channel))) + nicks)) + +(defun circe-user-channels (nick) + "Return a list of channel buffers for the user named NICK." + (let* ((result nil)) + (dolist (channel (irc-connection-channel-list (circe-server-process))) + (when (irc-channel-user channel nick) + (let* ((name (irc-channel-name channel)) + (buf (circe-server-get-chat-buffer name))) + (when buf + (push buf result))))) + result)) + +(defun circe-lurker-p (nick) + "Return a true value if this nick is regarded inactive." + (let* ((channel (irc-connection-channel (circe-server-process) + circe-chat-target)) + (user (when channel + (irc-channel-user channel nick))) + (recent-user (when channel + (irc-channel-recent-user channel nick))) + (last-active (cond + (user + (irc-user-last-activity-time user)) + (recent-user + (irc-user-last-activity-time recent-user))))) + (cond + ;; If we do not track lurkers, no one is ever a lurker. + ((not (circe-reduce-lurker-spam)) + nil) + ;; We ourselves are never lurkers (in this sense). + ((circe-server-my-nick-p nick) + nil) + ;; Someone who isn't even on the channel (e.g. NickServ) isn't a + ;; lurker, either. + ((and (not user) + (not recent-user)) + nil) + ;; If someone has never been active, they most definitely *are* a + ;; lurker. + ((not last-active) + t) + ;; But if someone has been active, and we mark active users + ;; inactive again after a timeout ... + (circe-active-users-timeout + ;; They are still lurkers if their activity has been too long + ;; ago. + (> (- (float-time) + last-active) + circe-active-users-timeout)) + ;; Otherwise, they have been active and we don't mark active + ;; users inactive again, so nope, not a lurker. + (t + nil)))) + +(defun circe-lurker-rejoin-p (nick channel) + "Return true if NICK is rejoining CHANNEL. + +A user is considered to be rejoining if they were on the channel +shortly before, and were active then." + (let* ((channel (irc-connection-channel (circe-server-process) + channel)) + (user (when channel + (irc-channel-recent-user channel nick)))) + (when user + (irc-user-last-activity-time user)))) + +(defun circe-lurker-display-active (nick userhost) + "Show that this user is active if they are a lurker." + (let* ((channel (irc-connection-channel (circe-server-process) + circe-chat-target)) + (user (when channel + (irc-channel-user channel nick))) + (join-time (when user + (irc-user-join-time user)))) + (when (and (circe-lurker-p nick) + ;; If we saw them when we joined the channel, no need to + ;; say "they're suddenly active!!111one". + join-time) + (circe-display 'circe-format-server-lurker-activity + :nick nick + :userhost (or userhost "server") + :jointime join-time + :joindelta (circe-duration-string + (- (float-time) + join-time)))))) + +;;;;;;;;;;;;;;;;;; +;;; Query Mode ;;; +;;;;;;;;;;;;;;;;;; + +(defvar circe-query-mode-hook nil + "Hook run when query mode is activated.") + +(defvar circe-query-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map circe-chat-mode-map) + map) + "The key map for query mode buffers.") + +(define-derived-mode circe-query-mode circe-chat-mode "Circe Query" + "The circe query chat major mode. +This mode represents a query you are talking in. + +TARGET is the default target to send data to. +SERVER-BUFFER is the server buffer of this chat buffer. + +\\{circe-query-mode-map}" + (add-hook 'kill-buffer-hook 'circe-query-killed nil t)) + +(defun circe-query-killed () + "Called when the query buffer got killed." + (ignore-errors + (circe-server-remove-chat-buffer circe-chat-target))) + +(defun circe-query-auto-query-buffer (who) + "Return a buffer for a query with `WHO'. + +This adheres to `circe-auto-query-max'." + (or (circe-server-get-chat-buffer who) + (when (< (circe--query-count) + circe-auto-query-max) + (circe-server-get-or-create-chat-buffer who 'circe-query-mode)))) + +(defun circe--query-count () + "Return the number of queries on the current server." + (let ((num 0)) + (dolist (buf (circe-server-chat-buffers)) + (with-current-buffer buf + (when (eq major-mode 'circe-query-mode) + (setq num (+ num 1))))) + num)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; IRC Protocol Handling ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar circe--irc-handler-table nil + "The handler table for Circe's IRC connections. + +Do not use this directly. Instead, call `circe-irc-handler-table'.") + +(defun circe-irc-handler-table () + (when (not circe--irc-handler-table) + (let ((table (irc-handler-table))) + (irc-handler-add table "irc.registered" #'circe--irc-conn-registered) + (irc-handler-add table "conn.disconnected" #'circe--irc-conn-disconnected) + (irc-handler-add table nil #'circe--irc-display-event) + (irc-handle-registration table) + (irc-handle-ping-pong table) + (irc-handle-isupport table) + (irc-handle-initial-nick-acquisition table) + (irc-handle-ctcp table) + (irc-handle-state-tracking table) + (irc-handle-nickserv table) + (irc-handle-auto-join table) + (setq circe--irc-handler-table table))) + circe--irc-handler-table) + +(defun circe--irc-conn-registered (conn _event _nick) + (with-current-buffer (irc-connection-get conn :server-buffer) + (setq circe-server-reconnect-attempts 0) + (run-hooks 'circe-server-connected-hook))) + +(defun circe--irc-conn-disconnected (conn _event) + (with-current-buffer (irc-connection-get conn :server-buffer) + (dolist (buf (circe-server-chat-buffers)) + (with-current-buffer buf + (circe-chat-disconnected))) + + (circe-reconnect))) + +(defun circe--irc-display-event (conn event &optional sender &rest args) + "Display an IRC message. + +NICK, USER and HOST specify the originator of COMMAND with ARGS +as arguments." + (with-current-buffer (irc-connection-get conn :server-buffer) + (let* ((display (circe-get-display-handler event)) + (nick (when sender + (irc-userstring-nick sender))) + (userhost (when sender + (irc-userstring-userhost sender)))) + (cond + ;; Functions get called + ((functionp display) + (apply display nick userhost event args)) + ;; Lists describe patterns + ((consp display) + (circe--irc-display-format (elt display 1) + (elt display 0) + nick userhost event args)) + ;; No configured display handler, show a default + (t + (circe--irc-display-default nick userhost event args)))))) + +(defvar circe--irc-format-server-numeric "*** %s" + "The format to use for server messages. Do not set this.") + +(defun circe--irc-display-format (format target nick userhost event args) + (let* ((target+name (circe--irc-display-target target nick args)) + (target (car target+name)) + (name (cdr target+name)) + (origin (if userhost + (format "%s (%s)" nick userhost) + (format "%s" nick)))) + (with-current-buffer (or target + (circe-server-last-active-buffer)) + (let ((circe--irc-format-server-numeric + (if target + (format "*** %s" format) + (format "*** [%s] %s" name format)))) + (circe-display 'circe--irc-format-server-numeric + :nick (or nick "(unknown)") + :userhost (or userhost "server") + :origin origin + :event event + :command event + :target name + :indexed-args args))))) + +(defun circe--irc-display-target (target nick args) + "Return the target buffer and name. +The buffer might be nil if it is not alive. + +See `circe-set-display-handler' for a description of target. + +NICK and USERHOST are the originator of COMMAND which had ARGS as +arguments." + (cond + ((eq target 'nick) + (cons (circe-server-get-chat-buffer nick) + nick)) + ((numberp target) + (let ((name (nth target + args))) + (cons (circe-server-get-chat-buffer name) + name))) + ((eq target 'active) + (let ((buf (circe-server-last-active-buffer))) + (cons buf + (buffer-name buf)))) + ((eq target 'server) + (cons (current-buffer) (buffer-name))) + (t + (error "Bad target in format string: %s" target)))) + +(defun circe--irc-display-default (nick userhost event args) + (with-current-buffer (circe-server-last-active-buffer) + (let ((target (if (circe-server-my-nick-p (car args)) + "" + (format " to %s" (car args))))) + (cond + ((string-match "\\`irc.ctcpreply.\\(.*\\)\\'" event) + (circe-display-server-message + (format "CTCP %s reply from %s (%s)%s: %s" + (match-string 1 event) nick userhost target (cadr args)))) + ((string-match "\\`irc.ctcp.\\(.*\\)\\'" event) + (circe-display-server-message + (format "Unknown CTCP request %s from %s (%s)%s: %s" + (match-string 1 event) nick userhost target (cadr args)))) + (t + (circe-display-server-message + (format "[%s from %s%s] %s" + event + nick + (if userhost + (format " (%s)" userhost) + "") + (mapconcat #'identity args " ")))))))) + +(defun circe-set-display-handler (command handler) + "Set the display handler for COMMAND to HANDLER. + +A handler is either a function or a list. + +A function gets called in the server buffer with at least three +arguments, but possibly more. There's at least NICK and USERHOST +of the sender, which can be nil, and COMMAND, which is the event +which triggered this. Further arguments are arguments to the +event. + +Alternatively, the handler can be a list of two elements: + + target - The target of this message + format - The format for this string + +The target can be any of: + + 'active - The last active buffer of this server + 'nick - The nick who sent this message + 'server - The server buffer for this server + number - The index of the argument of the target + +The format is passed to `lui-format'. Possible format string +substitutions are {mynick}, {target}, {nick}, {userhost}, +{origin}, {command}, {target}, and indexed arguments for the +arguments to the IRC message." + (when (not circe-display-table) + (setq circe-display-table (make-hash-table :test 'equal))) + (puthash command handler circe-display-table)) + +(defun circe-get-display-handler (command) + "Return the display handler for COMMAND. + +See `circe-set-display-handler' for more information." + (when circe-display-table + (gethash command circe-display-table))) + +;;;;;;;;;;;;;;;; +;;; Commands ;;; +;;;;;;;;;;;;;;;; + +(defun circe-command-AWAY (reason) + "Set yourself away with REASON." + (interactive "sReason: ") + (irc-send-AWAY (circe-server-process) reason)) + +(defun circe-command-BACK (&optional ignored) + "Mark yourself not away anymore. + +Arguments are IGNORED." + (interactive) + (irc-send-AWAY (circe-server-process))) + +(defun circe-command-CHTOPIC (&optional ignored) + "Insert the topic of the current channel. + +Arguments are IGNORED." + (interactive) + (if (not circe-chat-target) + (circe-display-server-message "No target for current buffer") + (let* ((channel (irc-connection-channel (circe-server-process) + circe-chat-target)) + (topic (when channel + (irc-channel-topic channel)))) + (lui-replace-input (format "/TOPIC %s %s" + circe-chat-target (or topic "")))) + (goto-char (point-max)))) + +(defun circe-command-CLEAR (&optional ignored) + "Delete all buffer contents before the lui prompt." + (let ((inhibit-read-only t)) + (delete-region (point-min) lui-output-marker))) + +(defun circe-command-CTCP (who &optional command argument) + "Send a CTCP message to WHO containing COMMAND with ARGUMENT. +If COMMAND is not given, WHO is parsed to contain all of who, +command and argument. +If ARGUMENT is nil, it is interpreted as no argument." + (when (not command) + (if (string-match "^\\([^ ]*\\) *\\([^ ]*\\) *\\(.*\\)" who) + (setq command (upcase (match-string 2 who)) + argument (match-string 3 who) + who (match-string 1 who)) + (circe-display-server-message "Usage: /CTCP <who> <what>"))) + (when (not (string= "" command)) + (irc-send-ctcp (circe-server-process) + who + command + (if (and argument (not (equal argument ""))) + argument + nil)))) + +(defun circe-command-FOOL (line) + "Add the regex on LINE to the `circe-fool-list'." + (with-current-buffer (circe-server-last-active-buffer) + (cond + ((string-match "\\S-+" line) + (let ((regex (match-string 0 line))) + (add-to-list 'circe-fool-list regex) + (circe-display-server-message (format "Recognizing %s as a fool" + regex)))) + ((not circe-fool-list) + (circe-display-server-message "Your do not know any fools")) + (t + (circe-display-server-message "Your list of fools:") + (dolist (regex circe-fool-list) + (circe-display-server-message (format "- %s" regex))))))) + +(defun circe-command-GAWAY (reason) + "Set yourself away on all servers with reason REASON." + (interactive "sReason: ") + (dolist (buf (circe-server-buffers)) + (with-current-buffer buf + (irc-send-AWAY circe-server-process reason)))) + +(defun circe-command-GQUIT (reason) + "Quit all servers with reason REASON." + (interactive "sReason: ") + (dolist (buf (circe-server-buffers)) + (with-current-buffer buf + (when (eq (process-status circe-server-process) + 'open) + (irc-send-QUIT circe-server-process reason))))) + +(defun circe-command-HELP (&optional ignored) + "Display a list of recognized commands, nicely formatted." + (circe-display-server-message + (concat "Recognized commands are: " + (mapconcat (lambda (s) s) (circe--commands-list) "")))) + +(defun circe-command-IGNORE (line) + "Add the regex on LINE to the `circe-ignore-list'." + (with-current-buffer (circe-server-last-active-buffer) + (cond + ((string-match "\\S-+" line) + (let ((regex (match-string 0 line))) + (add-to-list 'circe-ignore-list regex) + (circe-display-server-message (format "Ignore list, meet %s" + regex)))) + ((not circe-ignore-list) + (circe-display-server-message "Your ignore list is empty")) + (t + (circe-display-server-message "Your ignore list:") + (dolist (regex circe-ignore-list) + (circe-display-server-message (format "- %s" regex))))))) + +(defun circe-command-INVITE (nick &optional channel) + "Invite NICK to CHANNEL. +When CHANNEL is not given, NICK is assumed to be a string +consisting of two words, the nick and the channel." + (interactive "sInvite who: \nsWhere: ") + (when (not channel) + (if (string-match "^\\([^ ]+\\) +\\([^ ]+\\)" nick) + (setq channel (match-string 2 nick) + nick (match-string 1 nick)) + (when (or (string= "" nick) (null nick)) + (circe-display-server-message "Usage: /INVITE <nick> <channel>")))) + (irc-send-INVITE (circe-server-process) + nick + (if (and (null channel) + (not (null nick))) + circe-chat-target + channel))) + +(defun circe-command-JOIN (channel) + "Join CHANNEL. This can also contain a key." + (interactive "sChannel: ") + (let (channels keys) + (when (string-match "^\\s-*\\([^ ]+\\)\\(:? \\([^ ]+\\)\\)?$" channel) + (setq channels (match-string 1 channel) + keys (match-string 3 channel)) + (dolist (channel (split-string channels ",")) + (pop-to-buffer + (circe-server-get-or-create-chat-buffer channel + 'circe-channel-mode))) + (irc-send-JOIN (circe-server-process) channels keys)))) + +(defun circe-command-ME (line) + "Send LINE to IRC as an action." + (interactive "sAction: ") + (if (not circe-chat-target) + (circe-display-server-message "No target for current buffer") + (circe-display 'circe-format-self-action + :body line + :nick (circe-nick)) + (irc-send-ctcp (circe-server-process) + circe-chat-target + "ACTION" line))) + +(defun circe-command-MSG (who &optional what) + "Send a message. + +Send WHO a message containing WHAT. + +If WHAT is not given, WHO should contain both the nick and the +message separated by a space." + (when (not what) + (if (string-match "^\\([^ ]*\\) \\(.*\\)" who) + (setq what (match-string 2 who) + who (match-string 1 who)) + (circe-display-server-message "Usage: /MSG <who> <what>"))) + (when what + (let ((buf (circe-query-auto-query-buffer who))) + (if buf + (with-current-buffer buf + (circe-command-SAY what) + (lui-add-input what)) + (with-current-buffer (circe-server-last-active-buffer) + (irc-send-PRIVMSG (circe-server-process) + who what) + (circe-display 'circe-format-self-message + :target who + :body what)))))) + +(defun circe-command-NAMES (&optional channel) + "List the names of the current channel or CHANNEL." + (interactive) + (let ((target (when channel + (string-trim channel)))) + (when (or (not target) + (equal target "")) + (setq target circe-chat-target)) + (if (not target) + (circe-display-server-message "No target for current buffer") + (irc-send-NAMES (circe-server-process) + target)))) + +(defun circe-command-NICK (newnick) + "Change nick to NEWNICK." + (interactive "sNew nick: ") + (let ((newnick (string-trim newnick))) + (irc-send-NICK (circe-server-process) newnick))) + +(defun circe-command-PART (reason) + "Part the current channel because of REASON." + (interactive "sReason: ") + (if (not circe-chat-target) + (circe-display-server-message "No target for current buffer") + (irc-send-PART (circe-server-process) + circe-chat-target + (if (equal "" reason) + circe-default-part-message + reason)))) + +(defun circe-command-PING (target) + "Send a CTCP PING request to TARGET." + (interactive "sWho: ") + (let ((target (string-trim target))) + (irc-send-ctcp (circe-server-process) + target + "PING" (format "%s" (float-time))))) + +(defun circe-command-QUERY (arg) + "Open a query with WHO." + ;; Eventually, this should probably be just the same as + ;; circe-command-MSG + (interactive "sQuery with: ") + (let* (who what) + (if (string-match "\\`\\s-*\\(\\S-+\\)\\s-\\(\\s-*\\S-.*\\)\\'" arg) + (setq who (match-string 1 arg) + what (match-string 2 arg)) + (setq who (string-trim arg))) + (when (string= who "") + (circe-display-server-message "Usage: /query <nick> [something to say]")) + (pop-to-buffer + (circe-server-get-or-create-chat-buffer who 'circe-query-mode)) + (when what + (circe-command-SAY what) + (lui-add-input what)))) + +(defun circe-command-QUIT (reason) + "Quit the current server giving REASON." + (interactive "sReason: ") + (with-circe-server-buffer + (setq circe-server-inhibit-auto-reconnect-p t) + (irc-send-QUIT (circe-server-process) + (if (equal "" reason) + circe-default-quit-message + reason)))) + +(defun circe-command-QUOTE (line) + "Send LINE verbatim to the server." + (interactive "Line: ") + (irc-send-raw (circe-server-process) line) + (with-current-buffer (circe-server-last-active-buffer) + (circe-display-server-message (format "Sent to server: %s" + line)))) + +(defun circe-command-SAY (line) + "Say LINE to the current target." + (interactive "sSay: ") + (if (not circe-chat-target) + (circe-display-server-message "No target for current buffer") + (dolist (line (circe--split-line line)) + (circe-display 'circe-format-self-say + :body line + :nick (circe-nick)) + (irc-send-PRIVMSG (circe-server-process) + circe-chat-target + ;; Some IRC servers give an error if there is + ;; no text at all. + (if (string= line "") + " " + line))))) + +(defun circe--split-line (longline) + "Splits LONGLINE into smaller components. + +IRC silently truncates long lines. This splits a long line into +parts that each are not longer than `circe-split-line-length'." + (if (< (length longline) + circe-split-line-length) + (list longline) + (with-temp-buffer + (insert longline) + (let ((fill-column circe-split-line-length)) + (fill-region (point-min) (point-max) + nil t)) + (split-string (buffer-string) "\n")))) + +(defun circe-command-SV (&optional ignored) + "Tell the current channel about your client and Emacs version. + +Arguments are IGNORED." + (interactive) + (circe-command-SAY (format (concat "I'm using Circe version %s " + "with %s %s (of %s)") + (circe--version) + "GNU Emacs" + emacs-version + (format-time-string "%Y-%m-%d" + emacs-build-time)))) + +(defun circe-command-TOPIC (channel &optional newtopic) + "Change the topic of CHANNEL to NEWTOPIC." + (interactive "sChannel: \nsNew topic: ") + (when (string-match "^\\s-*$" channel) + (setq channel nil)) + (when (and channel + (not newtopic) + (string-match "^\\s-*\\(\\S-+\\)\\( \\(.*\\)\\)?" channel)) + (setq newtopic (match-string 3 channel) + channel (match-string 1 channel))) + (cond + ((and channel newtopic) + (irc-send-TOPIC (circe-server-process) channel newtopic)) + (channel + (irc-send-TOPIC (circe-server-process) channel)) + (circe-chat-target + (irc-send-TOPIC (circe-server-process) circe-chat-target)) + (t + (circe-display-server-message "No channel given, and no default target.")))) + +(defun circe-command-UNFOOL (line) + "Remove the entry LINE from `circe-fool-list'." + (with-current-buffer (circe-server-last-active-buffer) + (cond + ((string-match "\\S-+" line) + (let ((regex (match-string 0 line))) + (setq circe-fool-list (delete regex circe-fool-list)) + (circe-display-server-message (format "Assuming %s is not a fool anymore" + regex)))) + (t + (circe-display-server-message + "No one is not a fool anymore? UNFOOL requires one argument"))))) + +(defun circe-command-UNIGNORE (line) + "Remove the entry LINE from `circe-ignore-list'." + (with-current-buffer (circe-server-last-active-buffer) + (cond + ((string-match "\\S-+" line) + (let ((regex (match-string 0 line))) + (setq circe-ignore-list (delete regex circe-ignore-list)) + (circe-display-server-message (format "Ignore list forgot about %s" + regex)))) + (t + (circe-display-server-message + "Who do you want to unignore? UNIGNORE requires one argument"))))) + +(defun circe-command-WHOAMI (&optional ignored) + "Request WHOIS information about yourself. + +Arguments are IGNORED." + (interactive) + (irc-send-WHOIS (circe-server-process) + (circe-nick))) + +(defun circe-command-WHOIS (whom) + "Request WHOIS information about WHOM." + (interactive "sWhois: ") + (let* ((whom-server-name (split-string whom)) + (whom (car whom-server-name)) + (server-or-name (cadr whom-server-name))) + (irc-send-WHOIS (circe-server-process) whom server-or-name))) + +(defun circe-command-WHOWAS (whom) + "Request WHOWAS information about WHOM." + (interactive "sWhois: ") + (let ((whom (string-trim whom))) + (irc-send-WHOWAS (circe-server-process) whom))) + +(defun circe-command-STATS (query) + "Request statistics from a server." + (interactive) + ;; Split string into query and server if we can + (let ((query (split-string query))) + (irc-send-STATS (circe-server-process) (car query) (cadr query)))) + +(defun circe-command-WL (&optional split) + "Show the people who left in a netsplit. +Without any arguments, shows shows the current netsplits and how +many people are missing. With an argument SPLIT, which must be a +number, it shows the missing people due to that split." + (let ((circe-netsplit-list (with-circe-server-buffer + circe-netsplit-list))) + (if (or (not split) + (and (stringp split) + (string= split ""))) + (if (null circe-netsplit-list) + (circe-display-server-message "No net split at the moment") + (let ((n 0)) + (dolist (entry circe-netsplit-list) + (circe-display-server-message (format "(%d) Missing %d people due to %s" + n + (hash-table-count (nth 3 entry)) + (car entry))) + (setq n (+ n 1))))) + (let* ((index (if (numberp split) + split + (string-to-number split))) + (entry (nth index circe-netsplit-list))) + (if (not entry) + (circe-display-server-message (format "No split number %s - use /WL to see a list" + split)) + (let ((missing nil)) + (maphash (lambda (_key value) + (setq missing (cons value missing))) + (nth 3 entry)) + (circe-display-server-message + (format "Missing people due to %s: %s" + (car entry) + (mapconcat 'identity + (sort missing + (lambda (a b) + (string< (downcase a) + (downcase b)))) + ", "))))))))) + +;;;;;;;;;;;;;;;;;;;;;;;; +;;; Display Handlers ;;; +;;;;;;;;;;;;;;;;;;;;;;;; + +(defun circe-display-ignore (_nick _userhost _command &rest _args) + "Don't show a this message. + +NICK and USERHOST are the originator of COMMAND which had ARGS as +arguments." + 'noop) + +(circe-set-display-handler "317" 'circe-display-317) +(defun circe-display-317 (_sender ignored _numeric _target nick + idletime &optional signon-time body) + "Show a 317 numeric (RPL_WHOISIDLE). + +Arguments are either of the two: + +:<server> 317 <ournick> <nick> <idle> :seconds idle +:<server> 317 <ournick> <nick> <idle> <signon> :seconds idle, signon time" + (with-current-buffer (circe-server-last-active-buffer) + (let ((seconds-idle (string-to-number idletime)) + (signon-time (when body + (string-to-number signon-time)))) + (if signon-time + (circe-display 'circe-format-server-whois-idle-with-signon + :whois-nick nick + :idle-seconds seconds-idle + :idle-duration (circe-duration-string seconds-idle) + :signon-time signon-time + :signon-date (current-time-string + (seconds-to-time signon-time)) + :signon-ago (circe-duration-string (- (float-time) + signon-time))) + (circe-display 'circe-format-server-whois-idle + :whois-nick nick + :idle-seconds seconds-idle + :idle-duration (circe-duration-string seconds-idle)))))) + +(circe-set-display-handler "329" 'circe-display-329) +(defun circe-display-329 (_server ignored _numeric _target channel timestamp) + "Show a 329 numeric (RPL_CREATIONTIME)." + (with-current-buffer (or (circe-server-get-chat-buffer channel) + (circe-server-last-active-buffer)) + (let ((creation-time (string-to-number timestamp))) + (circe-display 'circe-format-server-channel-creation-time + :channel channel + :date (current-time-string + (seconds-to-time creation-time)) + :ago (circe-duration-string (- (float-time) + creation-time)))))) + +(circe-set-display-handler "333" 'circe-display-333) +(defun circe-display-333 (_server ignored _numeric target + channel setter topic-time) + "Show a 333 numeric (RPL_TOPICWHOTIME). + +Arguments are either of the two: + +:<server> 333 <target> <channel> <nick> 1434996762 +:<server> 333 <target> <channel> <nick>!<user>@<host> 1434996803" + (let ((channel-buffer (circe-server-get-chat-buffer channel)) + (topic-time (string-to-number topic-time))) + (with-current-buffer (or channel-buffer + (circe-server-last-active-buffer)) + (circe-display (if channel-buffer + 'circe-format-server-topic-time + 'circe-format-server-topic-time-for-channel) + :nick target + :channel channel + :setter (irc-userstring-nick setter) + :setter-userhost (or (irc-userstring-userhost setter) + "(unknown)") + :topic-time topic-time + :topic-date (current-time-string + (seconds-to-time topic-time)) + :topic-ago (circe-duration-string (- (float-time) + topic-time)))))) + +(circe-set-display-handler "AUTHENTICATE" 'circe-display-ignore) +(circe-set-display-handler "CAP" 'circe-display-ignore) +(circe-set-display-handler "conn.connected" 'circe-display-ignore) +(circe-set-display-handler "conn.disconnected" 'circe-display-ignore) + +(circe-set-display-handler "irc.ctcp" 'circe-display-ignore) +(circe-set-display-handler "irc.ctcpreply" 'circe-display-ignore) + +(circe-set-display-handler "irc.ctcp.ACTION" 'circe-display-ctcp-action) +(defun circe-display-ctcp-action (nick userhost _command target text) + "Show an ACTION." + (cond + ;; Query + ((circe-server-my-nick-p target) + (let ((query-buffer (circe-query-auto-query-buffer nick))) + (with-current-buffer (or query-buffer + (circe-server-last-active-buffer)) + (circe-display (if query-buffer + 'circe-format-action + 'circe-format-message-action) + :nick nick + :userhost (or userhost "server") + :body text)))) + ;; Channel + (t + (with-current-buffer (circe-server-get-or-create-chat-buffer + target 'circe-channel-mode) + (circe-lurker-display-active nick userhost) + (circe-display 'circe-format-action + :nick nick + :userhost (or userhost "server") + :body text))))) + +(circe-set-display-handler "irc.ctcp.CLIENTINFO" 'circe-display-ctcp) + +(circe-set-display-handler "irc.ctcp.PING" 'circe-display-ctcp-ping) +(defun circe-display-ctcp-ping (nick userhost _command target text) + "Show a CTCP PING request." + (with-current-buffer (circe-server-last-active-buffer) + (circe-display 'circe-format-server-ctcp-ping + :nick nick + :userhost (or userhost "server") + :target target + :body (or text "") + :ago (let ((time (when text + (string-to-number text)))) + (if time + (format "%.2f seconds" (- (float-time) time)) + "unknown seconds"))))) + +(circe-set-display-handler "irc.ctcpreply.PING" 'circe-display-ctcp-ping-reply) +(defun circe-display-ctcp-ping-reply (nick userhost _command target text) + "Show a CTCP PING reply." + (with-current-buffer (circe-server-last-active-buffer) + (circe-display 'circe-format-server-ctcp-ping-reply + :nick nick + :userhost (or userhost "server") + :target target + :body text + :ago (let ((time (string-to-number text))) + (if time + (format "%.2f seconds" (- (float-time) time)) + "unknown seconds"))))) + +(circe-set-display-handler "irc.ctcp.SOURCE" 'circe-display-ctcp) +(circe-set-display-handler "irc.ctcp.TIME" 'circe-display-ctcp) +(circe-set-display-handler "irc.ctcp.VERSION" 'circe-display-ctcp) +(defun circe-display-ctcp (nick userhost command target text) + "Show a CTCP request that does not require special handling." + (with-current-buffer (circe-server-last-active-buffer) + (circe-display 'circe-format-server-ctcp + :nick nick + :userhost (or userhost "server") + :target target + :command (substring command 9) + :body (or text "")))) + +(circe-set-display-handler "irc.registered" 'circe-display-ignore) + +(circe-set-display-handler "JOIN" 'circe-display-JOIN) +(defun circe-display-JOIN (nick userhost _command channel + &optional accountname realname) + "Show a JOIN message. + +The command receives an extra argument, the account name, on some +IRC servers." + (let* ((accountname (if (equal accountname "*") + "(unauthenticated)" + accountname)) + (userinfo (if accountname + (format "%s, %s: %s" userhost accountname realname) + userhost)) + (split (circe--netsplit-join nick))) + ;; First, update the channel + (with-current-buffer (circe-server-get-or-create-chat-buffer + channel 'circe-channel-mode) + (cond + (split + (let ((split-time (cadr split))) + (when (< (+ split-time circe-netsplit-delay) + (float-time)) + (circe-display 'circe-format-server-netmerge + :split (car split) + :time (cadr split) + :date (current-time-string + (seconds-to-time (cadr split))) + :ago (circe-duration-string + (- (float-time) (cadr split))))))) + ((and (circe-reduce-lurker-spam) + (circe-lurker-rejoin-p nick circe-chat-target)) + (let* ((channel (irc-connection-channel (circe-server-process) + circe-chat-target)) + (user (when channel + (irc-channel-recent-user channel nick))) + (departed (when user + (irc-user-part-time user)))) + (circe-display 'circe-format-server-rejoin + :nick nick + :userhost (or userhost "server") + :accountname accountname + :realname realname + :userinfo userinfo + :departuretime departed + :departuredelta (circe-duration-string + (- (float-time) + departed))))) + ((not (circe-reduce-lurker-spam)) + (circe-display 'circe-format-server-join + :nick nick + :userhost (or userhost "server") + :accountname accountname + :realname realname + :userinfo userinfo + :channel circe-chat-target)))) + ;; Next, a possible query buffer. We do this even when the message + ;; should be ignored by a netsplit, since this can't flood. + (let ((buf (circe-server-get-chat-buffer nick))) + (when buf + (with-current-buffer buf + (circe-display 'circe-format-server-join-in-channel + :nick nick + :userhost (or userhost "server") + :accountname accountname + :realname realname + :userinfo userinfo + :channel circe-chat-target)))))) + +(circe-set-display-handler "MODE" 'circe-display-MODE) +(defun circe-display-MODE (setter userhost _command target &rest modes) + "Show a MODE message." + (with-current-buffer (or (circe-server-get-chat-buffer target) + (circe-server-last-active-buffer)) + (circe-display 'circe-format-server-mode-change + :setter setter + :userhost (or userhost "server") + :target target + :change (mapconcat #'identity modes " ")))) + +(circe-set-display-handler "NICK" 'circe-display-NICK) +(defun circe-display-NICK (old-nick userhost _command new-nick) + "Show a nick change." + (if (circe-server-my-nick-p new-nick) + (dolist (buf (cons (or circe-server-buffer + (current-buffer)) + (circe-server-chat-buffers))) + (with-current-buffer buf + (circe-display 'circe-format-server-nick-change-self + :old-nick old-nick + :userhost (or userhost "server") + :new-nick new-nick))) + (let ((query-buffer (circe-server-get-chat-buffer old-nick))) + (when query-buffer + (with-current-buffer query-buffer + (circe-server-rename-chat-buffer old-nick new-nick) + (circe-display 'circe-format-server-nick-change + :old-nick old-nick + :new-nick new-nick + :userhost (or userhost "server"))))) + (dolist (buf (circe-user-channels new-nick)) + (with-current-buffer buf + (cond + ((and (circe-reduce-lurker-spam) + (circe-lurker-p new-nick)) + nil) + ((circe-channel-user-nick-regain-p old-nick new-nick) + (circe-display 'circe-format-server-nick-regain + :old-nick old-nick + :new-nick new-nick + :userhost (or userhost "server"))) + (t + (circe-display 'circe-format-server-nick-change + :old-nick old-nick + :new-nick new-nick + :userhost (or userhost "server")))))))) + +(circe-set-display-handler "nickserv.identified" 'circe-display-ignore) + +;; NOTICE is also used to encode CTCP replies. irc.el will send +;; irc.notice events for NOTICEs without CTCP replies, so we show +;; that, not the raw notice. +(circe-set-display-handler "NOTICE" 'circe-display-ignore) +(circe-set-display-handler "irc.notice" 'circe-display-NOTICE) +(defun circe-display-NOTICE (nick userhost _command target text) + "Show a NOTICE message." + (cond + ((not userhost) + (with-current-buffer (circe-server-last-active-buffer) + (circe-display 'circe-format-server-notice + :server nick + :body text))) + ((circe-server-my-nick-p target) + (with-current-buffer (or (circe-server-get-chat-buffer nick) + (circe-server-last-active-buffer)) + (circe-display 'circe-format-notice + :nick nick + :userhost (or userhost "server") + :body text))) + (t + (with-current-buffer (or (circe-server-get-chat-buffer target) + (circe-server-last-active-buffer)) + (circe-display 'circe-format-notice + :nick nick + :userhost (or userhost "server") + :body text))))) + +(circe-set-display-handler "PART" 'circe-display-PART) +(defun circe-display-PART (nick userhost _command channel &optional reason) + "Show a PART message." + (with-current-buffer (or (circe-server-get-chat-buffer channel) + (circe-server-last-active-buffer)) + (when (or (not circe-chat-target) + (not (circe-lurker-p nick))) + (circe-display 'circe-format-server-part + :nick nick + :userhost (or userhost "server") + :channel channel + :reason (or reason "[No reason given]"))))) + +(circe-set-display-handler "PING" 'circe-display-ignore) +(circe-set-display-handler "PONG" 'circe-display-ignore) + +;; PRIVMSG is also used to encode CTCP requests. irc.el will send +;; irc.message events for PRIVMSGs without CTCP messages, so we show +;; that, not the raw message. +(circe-set-display-handler "PRIVMSG" 'circe-display-ignore) +(circe-set-display-handler "irc.message" 'circe-display-PRIVMSG) +(defun circe-display-PRIVMSG (nick userhost _command target text) + "Show a PRIVMSG message." + (cond + ((circe-server-my-nick-p target) + (let ((buf (circe-query-auto-query-buffer nick))) + (if buf + (with-current-buffer buf + (circe-display 'circe-format-say + :nick nick + :userhost (or userhost "server") + :body text)) + (with-current-buffer (circe-server-last-active-buffer) + (circe-display 'circe-format-message + :nick nick + :userhost (or userhost "server") + :body text))))) + (t + (with-current-buffer (circe-server-get-or-create-chat-buffer + target 'circe-channel-mode) + (circe-lurker-display-active nick userhost) + (circe-display 'circe-format-say + :nick nick + :userhost (or userhost "server") + :body text))))) + +(circe-set-display-handler "TOPIC" 'circe-display-topic) +(defun circe-display-topic (nick userhost _command channel new-topic) + "Show a TOPIC change." + (with-current-buffer (circe-server-get-or-create-chat-buffer + channel 'circe-channel-mode) + (let* ((channel-obj (irc-connection-channel (circe-server-process) + channel)) + (old-topic (or (when channel + (irc-channel-last-topic channel-obj)) + ""))) + (circe-display 'circe-format-server-topic + :nick nick + :userhost (or userhost "server") + :channel channel + :new-topic new-topic + :old-topic old-topic + :topic-diff (circe--topic-diff old-topic new-topic))))) + +(defun circe--topic-diff (old new) + "Return a colored topic diff between OLD and NEW." + (mapconcat (lambda (elt) + (cond + ((eq '+ (car elt)) + (let ((s (cadr elt))) + (add-face-text-property 0 (length s) + 'circe-topic-diff-new-face nil s) + s)) + ((eq '- (car elt)) + (let ((s (cadr elt))) + (add-face-text-property 0 (length s) + 'circe-topic-diff-removed-face nil s) + s)) + (t + (cadr elt)))) + (lcs-unified-diff (circe--topic-diff-split old) + (circe--topic-diff-split new) + 'string=) + "")) + +(defun circe--topic-diff-split (str) + "Split STR into a list of components. +The list consists of words and spaces." + (let ((lis nil)) + (with-temp-buffer + (insert str) + (goto-char (point-min)) + (while (< (point) + (point-max)) + (if (or (looking-at "\\w+\\W*") + (looking-at ".\\s-*")) + (progn + (setq lis (cons (match-string 0) + lis)) + (replace-match "")) + (error "Can't happen")))) + (nreverse lis))) + +(circe-set-display-handler "channel.quit" 'circe-display-channel-quit) +(defun circe-display-channel-quit (nick userhost _command channel + &optional reason) + "Show a QUIT message." + (let ((split (circe--netsplit-quit reason nick))) + (with-current-buffer (circe-server-get-or-create-chat-buffer + channel 'circe-channel-mode) + (cond + (split + (when (< (+ split circe-netsplit-delay) + (float-time)) + (circe-display 'circe-format-server-netsplit + :split reason))) + ((not (circe-lurker-p nick)) + (circe-display 'circe-format-server-quit-channel + :nick nick + :userhost (or userhost "server") + :channel channel + :reason (or reason "[no reason given]"))))))) + +(circe-set-display-handler "QUIT" 'circe-display-QUIT) +(defun circe-display-QUIT (nick userhost _command &optional reason) + "Show a QUIT message. + +Channel quits are shown already, so just show quits in queries." + (let ((buf (circe-server-get-chat-buffer nick))) + (when buf + (with-current-buffer buf + (circe-display 'circe-format-server-quit + :nick nick + :userhost (or userhost "server") + :reason (or reason "[no reason given]")))))) + +(defvar circe-netsplit-list nil + "A list of recorded netsplits. +Every item is a list with four elements: +- The quit message for this split. +- The time when last we heard about a join in this split +- The time when last we heard about a quit in this split +- A hash table noting which nicks did leave") +(make-variable-buffer-local 'circe-netsplit-list) + +(defun circe--netsplit-join (nick) + "Search for NICK in the netsplit lists. +This either returns a pair whose car is the quit message of this +split, and the cadr the time we last heard anything of the split +of that user. If the NICK isn't split, this returns nil." + (with-circe-server-buffer + (catch 'return + (dolist (entry circe-netsplit-list) + (let ((table (nth 3 entry))) + (when (gethash nick table) + (let ((name (nth 0 entry)) + (time (nth 1 entry))) + (remhash nick table) + (when (= 0 (hash-table-count table)) + (setq circe-netsplit-list + (delq entry circe-netsplit-list))) + (setcar (cdr entry) + (float-time)) + (throw 'return (list name time)))))) + nil))) + +(defun circe--netsplit-quit (reason nick) + "If REASON indicates a netsplit, mark NICK as splitted. +This either returns the time when last we heard about this split, +or nil when this isn't a split." + (when (circe--netsplit-reason-p reason) + (with-circe-server-buffer + (let ((entry (assoc reason circe-netsplit-list))) + (if entry + (let ((time (nth 2 entry)) + (table (nth 3 entry))) + (setcar (cddr entry) + (float-time)) + (puthash nick nick table) + time) + ;; New split! + (let ((table (make-hash-table :test 'equal))) + (puthash nick nick table) + (setq circe-netsplit-list + (cons (list reason 0 (float-time) table) + circe-netsplit-list)) + 0)))))) + +(defun circe--netsplit-reason-p (reason) + "Return non-nil if REASON is the quit message of a netsplit. +This is true when it contains exactly two hosts, with a single +space in between them. The hosts must include at least one dot, +and must not include colons or slashes (else they might be +URLs). (Thanks to irssi for this criteria list)" + (if (string-match "^[^ :/]+\\.[^ :/]* [^ :/]+\\.[^ :/]*$" + reason) + t + nil)) + +(let ((simple-format-specifiers + '(("INVITE" active "Invite: {origin} invites you to {1}") + ("KICK" 0 "Kick: {1} kicked by {origin}: {2}") + ("ERROR" active "Error: {0-}") + ("001" server "{1}") + ("002" server "{1}") + ("003" server "{1}") + ("004" server "{1-}") + ("005" server "{1-}") + ;; IRCnet: * Please wait while we process your connection. + ("020" server "{0-}") + ;; IRCnet + ("042" server "Your unique ID is {1}") + ("200" active "{1-}") + ("201" active "{1-}") + ("203" active "{1-}") + ("204" active "{1-}") + ("205" active "{1-}") + ("206" active "{1-}") + ("207" active "{1-}") + ("208" active "{1-}") + ("209" active "{1-}") + ("211" active "{1-}") + ("212" active "{1-}") + ("219" active "{1-}") + ("221" active "User mode: {1-}") + ("234" active "Service: {1-}") + ("235" active "{1-}") + ("242" active "{1}") + ("243" active "{1-}") + ("250" server "{1}") + ("251" server "{1}") + ("252" server "{1-}") + ("253" server "{1-}") + ("254" server "{1-}") + ("255" server "{1}") + ("256" active "{1-}") + ("257" active "{1}") + ("258" active "{1}") + ("259" active "{1}") + ("261" active "{1-}") + ("262" active "{1-}") + ("263" active "{1-}") + ("265" server "{1-}") + ("266" server "{1-}") + ;; This is returned on both WHOIS and PRIVMSG. It + ;; should go to the active window for the former, and + ;; the query window for the latter. Oh well. + ("301" active "User away: {1}") + ("302" active "User hosts: {1}") + ("303" active "Users online: {1}") + ("305" active "{1}") + ("306" active "{1}") + ("307" active "{1-}") + ;; Coldfront: 310 <nick> is available for help. + ("310" active "{1-}") + ("311" active "{1} is {2}@{3} ({5})") + ("312" active "{1} is on {2} ({3})") + ("313" active "{1} {2}") + ("314" active "{1} was {2}@{3} ({5})") + ("315" active "{2}") + ("318" active "{2}") + ("319" active "{1} is on {2}") + ("320" active "{1-}") + ("322" active "{1-}") + ("323" active "{1-}") + ("324" 1 "Channel mode for {1}: {2-}") + ("325" 1 "Unique operator on {1} is {2}") + ("328" 1 "Channel homepage for {1}: {2-}") + ("330" active "{1} is logged in as {2}") + ("331" 1 "No topic for {1} set") + ("332" 1 "Topic for {1}: {2}") + ("341" active "Inviting {1} to {2}") + ("346" 1 "Invite mask: {2}") + ("347" 1 "{2}") + ("348" 1 "Except mask: {2}") + ("349" 1 "{2}") + ("351" active "{1-}") + ("352" active "{5} ({2}@{3}) in {1} on {4}: {6-}") + ("353" 2 "Names: {3}") + ("364" active "{1-}") + ("365" active "{1-}") + ("366" 1 "{2}") + ("367" 1 "Ban mask: {2}") + ("368" 1 "{2}") + ("369" active "{1} {2}") + ("371" active "{1}") + ("372" server "{1}") + ("374" active "{1}") + ("375" server "{1}") + ("376" server "{1}") + ("378" active "{1-}") + ("381" active "{1}") + ("382" active "{1-}") + ("391" active "Time on {1}: {2}") + ("401" active "No such nick: {1}") + ("402" active "No such server: {1}") + ("403" active "No such channel: {1}") + ("404" 1 "Can not send to channel {1}") + ("405" active "Can not join {1}: {2}") + ("406" active "{1-}") + ("407" active "{1-}") + ("408" active "No such service: {1}") + ("422" active "{1}") + ("432" active "Erroneous nick name: {1}") + ("433" active "Nick name in use: {1}") + ("437" active "Nick/channel is temporarily unavailable: {1}") + ("441" 2 "User not on channel: {1}") + ("442" active "You are not on {1}") + ("443" 2 "User {1} is already on channel {2}") + ;; Coldfront: 451 * :You have not registered + ("451" active "{1-}") + ("467" 1 "{2}") + ("470" 1 "{1} made you join {2}: {3-}") + ("471" 1 "{2}") + ("472" active "{1-}") + ("473" active "{1-}") + ("474" active "{1-}") + ("475" active "{1-}") + ("476" active "{1-}") + ("477" active "{1-}") + ("481" 1 "{2-}") + ("484" active "{1-}") + ;; Coldfront: 671 <nick> is using a Secure Connection + ("671" active "{1-}") + ("728" 1 "Quiet mask: {3}") + ("729" 1 "{3-}") + ;; Freenode SASL auth + ("900" active "SASL: {3-}") + ("903" active "{1-}")))) + (dolist (fmt simple-format-specifiers) + (circe-set-display-handler (car fmt) (cdr fmt)))) + +(defun circe-set-message-target (command target) + "Set the target of COMMAND to TARGET. + +This can be used to change format-based display handlers more +easily." + (let ((handler (circe-get-display-handler command))) + (when (not (consp handler)) + (error "Handler of command %s is not a list" command)) + (setcar handler target))) + +;;;;;;;;;;;;;;;;;;;;;;;; +;;; Helper Functions ;;; +;;;;;;;;;;;;;;;;;;;;;;;; + +(defun circe--list-drop-right (list pattern) + "Drop elements from the right of LIST that match PATTERN. + +LIST should be a list of strings, and PATTERN is used as a +regular expression." + (let ((list (reverse list))) + (while (and list + (string-match pattern (car list))) + (setq list (cdr list))) + (nreverse list))) + +(defun circe--nick-next (oldnick) + "Return a new nick to try for OLDNICK." + (cond + ;; If the nick ends with -+, replace those with _ + ((string-match "^\\(.*[^-]\\)\\(-+\\)$" oldnick) + (concat (match-string 1 oldnick) + (make-string (- (match-end 2) + (match-beginning 2)) + ?_))) + ;; If the nick is 9 chars long, take prefix and rotate. + ((>= (length oldnick) + 9) + (when (string-match "^\\(.*[^-_]\\)[-_]*$" oldnick) + (let ((nick (match-string 1 oldnick))) + (concat (substring nick 1) + (string (aref nick 0)))))) + ;; If the nick ends with _+ replace those with - and add one + ((string-match "^\\(.*[^_]\\)\\(_+\\)$" oldnick) + (concat (match-string 1 oldnick) + (make-string (- (match-end 2) + (match-beginning 2)) + ?-) + "-")) + ;; Else, just append - + (t + (concat oldnick "-")))) + +(defun circe-duration-string (duration) + "Return a description of a DURATION in seconds." + (let ((parts `((,(* 12 30 24 60 60) "year") + (,(* 30 24 60 60) "month") + (,(* 24 60 60) "day") + (,(* 60 60) "hour") + (60 "minute") + (1 "second"))) + (duration (round duration)) + (result nil)) + (dolist (part parts) + (let* ((seconds-per-part (car part)) + (description (cadr part)) + (count (/ duration seconds-per-part))) + (when (not (zerop count)) + (setq result (cons (format "%d %s%s" + count description + (if (= count 1) "" "s")) + result))) + (setq duration (- duration (* count seconds-per-part))))) + (if result + (mapconcat #'identity + (nreverse result) + " ") + "a moment"))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Deprecated functions and variables + +(define-obsolete-function-alias 'circe-server-nick 'circe-nick + "Circe 2.0") + +(define-obsolete-function-alias 'circe-server-message + 'circe-display-server-message + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-networks 'circe-network-defaults + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-server-name 'circe-host + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-server-service 'circe-port + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-server-network 'circe-network + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-server-ip-family 'circe-ip-family + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-server-nick 'circe-nick + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-server-user 'circe-user + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-server-pass 'circe-pass + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-server-realname 'circe-realname + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-server-use-tls 'circe-use-tls + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-server-auto-join-channels + 'circe-channels + "Circe 2.0") + +(provide 'circe) +;;; circe.el ends here |