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, 0 insertions, 3602 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 deleted file mode 100644 index 721044dd2a..0000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe.el +++ /dev/null @@ -1,3602 +0,0 @@ -;;; 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 |