;; erc.el --- An Emacs Internet Relay Chat client
-;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
;; Author: Alexander L. Belikoff (alexander@belikoff.net)
;; Contributors: Sergey Berezin (sergey.berezin@cs.cmu.edu),
;; Andreas Fuchs (afs@void.at)
;; Gergely Nagy (algernon@midgard.debian.net)
;; David Edmondson (dme@dme.org)
-;; Maintainer: Michael Olson (mwolson@gnu.org)
+;; Maintainer: FSF
;; Keywords: IRC, chat, client, Internet
;; Version: 5.3
(defconst erc-version-string "Version 5.3"
"ERC version. This is used by function `erc-version'.")
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'font-lock)
(require 'pp)
(require 'thingatpt)
"Ignoring certain messages"
:group 'erc)
+(defgroup erc-lurker nil
+ "Hide specified message types sent by lurkers"
+ :version "24.3"
+ :group 'erc-ignore)
+
(defgroup erc-query nil
"Using separate buffers for private discussions"
:group 'erc)
(message (concat "ERC: The function `defvaralias' is not bound. See the "
"NEWS file for variable name changes since ERC 5.0.4.")))
-(defalias 'erc-send-command 'erc-server-send)
-(erc-make-obsolete 'erc-send-command 'erc-server-send "ERC 5.1")
+(define-obsolete-function-alias 'erc-send-command
+ 'erc-server-send "ERC 5.1")
;; tunable connection and authentication parameters
(defmacro erc-with-server-buffer (&rest body)
"Execute BODY in the current ERC server buffer.
If no server buffer exists, return nil."
+ (declare (indent 0) (debug (body)))
(let ((buffer (make-symbol "buffer")))
`(let ((,buffer (erc-server-buffer)))
(when (buffer-live-p ,buffer)
(with-current-buffer ,buffer
,@body)))))
-(put 'erc-with-server-buffer 'lisp-indent-function 0)
-(put 'erc-with-server-buffer 'edebug-form-spec '(body))
-(defstruct (erc-server-user (:type vector) :named)
+(cl-defstruct (erc-server-user (:type vector) :named)
;; User data
nickname host login full-name info
;; Buffers
(buffers nil)
)
-(defstruct (erc-channel-user (:type vector) :named)
+(cl-defstruct (erc-channel-user (:type vector) :named)
op voice
;; Last message time (in the form of the return value of
;; (current-time)
'erc-replace-insert))
((remove-hook 'erc-insert-modify-hook
'erc-replace-insert)))"
+ (declare (doc-string 3))
(let* ((sn (symbol-name name))
(mode (intern (format "erc-%s-mode" (downcase sn))))
(group (intern (format "erc-%s" (downcase sn))))
(put ',enable 'definition-name ',name)
(put ',disable 'definition-name ',name))))
-(put 'define-erc-module 'doc-string-elt 3)
-
(defun erc-once-with-server-event (event &rest forms)
"Execute FORMS the next time EVENT occurs in the `current-buffer'.
(add-hook hook fun nil nil)
fun))
-(defmacro erc-log (string)
+(defsubst erc-log (string)
"Logs STRING if logging is on (see `erc-log-p')."
- `(when erc-log-p
- (erc-log-aux ,string)))
+ (when erc-log-p
+ (erc-log-aux string)))
(defun erc-server-buffer ()
"Return the server buffer for the current buffer's process.
t))
(erc-server-send (format "ISON %s" nick))
(while (eq erc-online-p 'unknown) (accept-process-output))
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "%s is %sonline"
(or erc-online-p nick)
(if erc-online-p "" "not "))
See also `with-current-buffer'.
\(fn (TARGET [PROCESS]) BODY...)"
+ (declare (indent 1) (debug ((form &optional form) body)))
(let ((buf (make-symbol "buf"))
(proc (make-symbol "proc"))
(target (make-symbol "target"))
(when (buffer-live-p ,buf)
(with-current-buffer ,buf
,@body)))))
-(put 'erc-with-buffer 'lisp-indent-function 1)
-(put 'erc-with-buffer 'edebug-form-spec '((form &optional form) body))
(defun erc-get-buffer (target &optional proc)
"Return the buffer matching TARGET in the process PROC.
FORMS will be evaluated in all buffers having the process PROCESS and
where PRED matches or in all buffers of the server process if PRED is
nil."
+ (declare (indent 1) (debug (form form body)))
;; Make the evaluation have the correct order
(let ((pre (make-symbol "pre"))
(pro (make-symbol "pro")))
;; Silence the byte-compiler by binding the result of mapcar to
;; a variable.
res)))
-(put 'erc-with-all-buffers-of-server 'lisp-indent-function 1)
-(put 'erc-with-all-buffers-of-server 'edebug-form-spec '(form form body))
;; (iswitchb-mode) will autoload iswitchb.el
(defvar iswitchb-temp-buflist)
capab-identify)
(const :tag "completion: Complete nicknames and commands (programmable)"
completion)
- (const :tag "hecomplete: Complete nicknames and commands (old)" hecomplete)
+ (const :tag "hecomplete: Complete nicknames and commands (obsolete, use \"completion\")" hecomplete)
(const :tag "dcc: Provide Direct Client-to-Client support" dcc)
(const :tag "fill: Wrap long lines" fill)
(const :tag "identd: Launch an identd server on port 8113" identd)
(const :tag
"notify: Notify when the online status of certain users changes"
notify)
+ (const :tag "notifications: Send notifications on PRIVMSG or nickname mentions"
+ notifications)
(const :tag "page: Process CTCP PAGE requests from IRC" page)
(const :tag "readonly: Make displayed lines read-only" readonly)
(const :tag "replace: Replace text in messages" replace)
(list :server server :port port :nick nick :password passwd)))
;;;###autoload
-(defun* erc (&key (server (erc-compute-server))
- (port (erc-compute-port))
- (nick (erc-compute-nick))
- password
- (full-name (erc-compute-full-name)))
+(cl-defun erc (&key (server (erc-compute-server))
+ (port (erc-compute-port))
+ (nick (erc-compute-nick))
+ password
+ (full-name (erc-compute-full-name)))
"ERC is a powerful, modular, and extensible IRC client.
This function is the main entry point for ERC.
(while list
(setq elt (car list))
(cond ((integerp elt) ; POSITION
- (incf (car list) shift))
+ (cl-incf (car list) shift))
((or (atom elt) ; nil, EXTENT
;; (eq t (car elt)) ; (t . TIME)
(markerp (car elt))) ; (MARKER . DISTANCE)
nil)
((integerp (car elt)) ; (BEGIN . END)
- (incf (car elt) shift)
- (incf (cdr elt) shift))
+ (cl-incf (car elt) shift)
+ (cl-incf (cdr elt) shift))
((stringp (car elt)) ; (TEXT . POSITION)
- (incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift)))
+ (cl-incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift)))
((null (car elt)) ; (nil PROPERTY VALUE BEG . END)
(let ((cons (nthcdr 3 elt)))
- (incf (car cons) shift)
- (incf (cdr cons) shift)))
+ (cl-incf (car cons) shift)
+ (cl-incf (cdr cons) shift)))
((and (featurep 'xemacs)
(extentp (car elt))) ; (EXTENT START END)
- (incf (nth 1 elt) shift)
- (incf (nth 2 elt) shift)))
+ (cl-incf (nth 1 elt) shift)
+ (cl-incf (nth 2 elt) shift)))
(setq list (cdr list))))))
(defvar erc-valid-nick-regexp "[]a-zA-Z^[;\\`_{}|][]^[;\\`_{}|a-zA-Z0-9-]*"
string)
string)))
+(defvar erc-lurker-state nil
+ "Track the time of the last PRIVMSG for each (server,nick) pair.
+
+This is implemented as a hash of hashes, where the outer key is
+the canonicalized server name (as returned by
+`erc-canonicalize-server-name') and the outer value is a hash
+table mapping nicks (as returned by `erc-lurker-maybe-trim') to
+the times of their most recently received PRIVMSG on any channel
+on the given server.")
+
+(defcustom erc-lurker-trim-nicks t
+ "If t, trim trailing `erc-lurker-ignore-chars' from nicks.
+
+This causes e.g. nick and nick` to be considered as the same
+individual for activity tracking and lurkiness detection
+purposes."
+ :group 'erc-lurker
+ :type 'boolean)
+
+(defcustom erc-lurker-ignore-chars "`_"
+ "Characters at the end of a nick to strip for activity tracking purposes.
+
+See also `erc-lurker-trim-nicks'."
+ :group 'erc-lurker
+ :type 'string)
+
+(defun erc-lurker-maybe-trim (nick)
+ "Maybe trim trailing `erc-lurker-ignore-chars' from NICK.
+
+Returns NICK unmodified unless `erc-lurker-trim-nicks' is
+non-nil."
+ (if erc-lurker-trim-nicks
+ (replace-regexp-in-string
+ (format "[%s]"
+ (mapconcat (lambda (char)
+ (regexp-quote (char-to-string char)))
+ erc-lurker-ignore-chars ""))
+ "" nick)
+ nick))
+
+(defcustom erc-lurker-hide-list nil
+ "List of IRC type messages to hide when sent by lurkers.
+
+A typical value would be '(\"JOIN\" \"PART\" \"QUIT\").
+See also `erc-lurker-p' and `erc-hide-list'."
+ :group 'erc-lurker
+ :type 'erc-message-type)
+
+(defcustom erc-lurker-threshold-time (* 60 60 24) ; 24h by default
+ "Nicks from which no PRIVMSGs have been received within this
+interval (in units of seconds) are considered lurkers by
+`erc-lurker-p' and as a result their messages of types in
+`erc-lurker-hide-list' will be hidden."
+ :group 'erc-lurker
+ :type 'integer)
+
+(defun erc-lurker-initialize ()
+ "Initialize ERC lurker tracking functionality.
+
+This function adds `erc-lurker-update-status' to
+`erc-insert-pre-hook' in order to record the time of each nick's
+most recent PRIVMSG as well as initializing the state variable
+storing this information."
+ (setq erc-lurker-state (make-hash-table :test 'equal))
+ (add-hook 'erc-insert-pre-hook 'erc-lurker-update-status))
+
+(defun erc-lurker-cleanup ()
+ "Remove all last PRIVMSG state older than `erc-lurker-threshold-time'.
+
+This should be called regularly to avoid excessive resource
+consumption for long-lived IRC or Emacs sessions."
+ (maphash
+ (lambda (server hash)
+ (maphash
+ (lambda (nick last-PRIVMSG-time)
+ (when
+ (> (float-time (time-subtract
+ (current-time)
+ last-PRIVMSG-time))
+ erc-lurker-threshold-time)
+ (remhash nick hash)))
+ hash)
+ (if (zerop (hash-table-count hash))
+ (remhash server erc-lurker-state)))
+ erc-lurker-state))
+
+(defvar erc-lurker-cleanup-count 0
+ "Internal counter variable for use with `erc-lurker-cleanup-interval'.")
+
+(defvar erc-lurker-cleanup-interval 100
+ "Specifies frequency of cleaning up stale erc-lurker state.
+
+`erc-lurker-update-status' calls `erc-lurker-cleanup' once for
+every `erc-lurker-cleanup-interval' updates to
+`erc-lurker-state'. This is designed to limit the memory
+consumption of lurker state during long Emacs sessions and/or ERC
+sessions with large numbers of incoming PRIVMSGs.")
+
+(defun erc-lurker-update-status (message)
+ "Update `erc-lurker-state' if necessary.
+
+This function is called from `erc-insert-pre-hook'. If the
+current message is a PRIVMSG, update `erc-lurker-state' to
+reflect the fact that its sender has issued a PRIVMSG at the
+current time. Otherwise, take no action.
+
+This function depends on the fact that `erc-display-message'
+dynamically binds `parsed', which is used to check if the current
+message is a PRIVMSG and to determine its sender. See also
+`erc-lurker-trim-nicks' and `erc-lurker-ignore-chars'.
+
+In order to limit memory consumption, this function also calls
+`erc-lurker-cleanup' once every `erc-lurker-cleanup-interval'
+updates of `erc-lurker-state'."
+ (when (and (boundp 'parsed) (erc-response-p parsed))
+ (let* ((command (erc-response.command parsed))
+ (sender
+ (erc-lurker-maybe-trim
+ (car (erc-parse-user (erc-response.sender parsed)))))
+ (server
+ (erc-canonicalize-server-name erc-server-announced-name)))
+ (when (equal command "PRIVMSG")
+ (when (>= (cl-incf erc-lurker-cleanup-count)
+ erc-lurker-cleanup-interval)
+ (setq erc-lurker-cleanup-count 0)
+ (erc-lurker-cleanup))
+ (unless (gethash server erc-lurker-state)
+ (puthash server (make-hash-table :test 'equal) erc-lurker-state))
+ (puthash sender (current-time)
+ (gethash server erc-lurker-state))))))
+
+(defun erc-lurker-p (nick)
+ "Predicate indicating NICK's lurking status on the current server.
+
+Lurking is the condition where NICK has issued no PRIVMSG on this
+server within `erc-lurker-threshold-time'. See also
+`erc-lurker-trim-nicks' and `erc-lurker-ignore-chars'."
+ (unless erc-lurker-state (erc-lurker-initialize))
+ (let* ((server
+ (erc-canonicalize-server-name erc-server-announced-name))
+ (last-PRIVMSG-time
+ (gethash (erc-lurker-maybe-trim nick)
+ (gethash server erc-lurker-state (make-hash-table)))))
+ (or (null last-PRIVMSG-time)
+ (> (float-time
+ (time-subtract (current-time) last-PRIVMSG-time))
+ erc-lurker-threshold-time))))
+
+(defcustom erc-common-server-suffixes
+ '(("openprojects.net$" . "OPN")
+ ("freenode.net$" . "freenode")
+ ("oftc.net$" . "OFTC"))
+ "Alist of common server name suffixes.
+This variable is used in mode-line display to save screen
+real estate. Set it to nil if you want to avoid changing
+displayed hostnames."
+ :group 'erc-mode-line-and-header
+ :type 'alist)
+
+(defun erc-canonicalize-server-name (server)
+ "Returns the canonical network name for SERVER if any,
+otherwise `erc-server-announced-name'. SERVER is matched against
+`erc-common-server-suffixes'."
+ (when server
+ (or (cdar (erc-remove-if-not
+ (lambda (net) (string-match (car net) server))
+ erc-common-server-suffixes))
+ erc-server-announced-name)))
+
+(defun erc-hide-current-message-p (parsed)
+ "Predicate indicating whether the parsed ERC response PARSED should be hidden.
+
+Messages are always hidden if the message type of PARSED appears in
+`erc-hide-list'. In addition, messages whose type is a member of
+`erc-lurker-hide-list' are hidden if `erc-lurker-p' returns true."
+ (let* ((command (erc-response.command parsed))
+ (sender (car (erc-parse-user (erc-response.sender parsed)))))
+ (or (member command erc-hide-list)
+ (and (member command erc-lurker-hide-list) (erc-lurker-p sender)))))
+
(defun erc-display-message (parsed type buffer msg &rest args)
"Display MSG in BUFFER.
(if (not (erc-response-p parsed))
(erc-display-line string buffer)
- (unless (member (erc-response.command parsed) erc-hide-list)
+ (unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
(erc-put-text-property 0 (length string) 'rear-sticky t string)
(erc-display-line string buffer)))))
(add-to-list 'symlist
(cons (erc-once-with-server-event
311 `(string= ,nick
- (second
+ (nth 1
(erc-response.command-args parsed))))
'erc-server-311-functions))
(add-to-list 'symlist
(cons (erc-once-with-server-event
312 `(string= ,nick
- (second
+ (nth 1
(erc-response.command-args parsed))))
'erc-server-312-functions))
(add-to-list 'symlist
(cons (erc-once-with-server-event
318 `(string= ,nick
- (second
+ (nth 1
(erc-response.command-args parsed))))
'erc-server-318-functions))
(add-to-list 'symlist
(cons (erc-once-with-server-event
319 `(string= ,nick
- (second
+ (nth 1
(erc-response.command-args parsed))))
'erc-server-319-functions))
(add-to-list 'symlist
(cons (erc-once-with-server-event
320 `(string= ,nick
- (second
+ (nth 1
(erc-response.command-args parsed))))
'erc-server-320-functions))
(add-to-list 'symlist
(cons (erc-once-with-server-event
330 `(string= ,nick
- (second
+ (nth 1
(erc-response.command-args parsed))))
'erc-server-330-functions))
(add-to-list 'symlist
(defun erc-banlist-store (proc parsed)
"Record ban entries for a channel."
- (multiple-value-bind (channel mask whoset)
- (values-list (cdr (erc-response.command-args parsed)))
+ (pcase-let ((`(,channel ,mask ,whoset)
+ (cdr (erc-response.command-args parsed))))
;; Determine to which buffer the message corresponds
(let ((buffer (erc-get-buffer channel proc)))
(with-current-buffer buffer
(defun erc-banlist-finished (proc parsed)
"Record that we have received the banlist."
- (let* ((channel (second (erc-response.command-args parsed)))
+ (let* ((channel (nth 1 (erc-response.command-args parsed)))
(buffer (erc-get-buffer channel proc)))
(with-current-buffer buffer
(put 'erc-channel-banlist 'received-from-server t)))
(defun erc-banlist-update (proc parsed)
"Check MODE commands for bans and update the banlist appropriately."
;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11
- (let* ((tgt (first (erc-response.command-args parsed)))
+ (let* ((tgt (car (erc-response.command-args parsed)))
(mode (erc-response.contents parsed))
(whoset (erc-response.sender parsed))
(buffer (erc-get-buffer tgt proc)))
"Return the value of `point' at the end of the input line."
(point-max))
+(defvar erc-last-input-time 0
+ "Time of last call to `erc-send-current-line'.
+If that function has never been called, the value is 0.")
+
+(defcustom erc-accidental-paste-threshold-seconds nil
+ "Minimum time, in seconds, before sending new lines via IRC.
+If the value is a number, `erc-send-current-line' signals an
+error if its previous invocation was less than this much time
+ago. This is useful so that if you accidentally enter large
+amounts of text into the ERC buffer, that text is not sent to the
+IRC server.
+
+If the value is nil, `erc-send-current-line' always considers any
+submitted line to be intentional."
+ :group 'erc
+ :version "24.4"
+ :type '(choice number (other :tag "disabled" nil)))
+
(defun erc-send-current-line ()
"Parse current line and send it to IRC."
(interactive)
- (save-restriction
- (widen)
- (if (< (point) (erc-beg-of-input-line))
- (erc-error "Point is not in the input area")
- (let ((inhibit-read-only t)
- (str (erc-user-input))
- (old-buf (current-buffer)))
- (if (and (not (erc-server-buffer-live-p))
- (not (erc-command-no-process-p str)))
- (erc-error "ERC: No process running")
- (erc-set-active-buffer (current-buffer))
-
- ;; Kill the input and the prompt
- (delete-region (erc-beg-of-input-line)
- (erc-end-of-input-line))
-
- (unwind-protect
- (erc-send-input str)
- ;; Fix the buffer if the command didn't kill it
- (when (buffer-live-p old-buf)
- (with-current-buffer old-buf
- (save-restriction
- (widen)
- (goto-char (point-max))
- (when (processp erc-server-process)
- (set-marker (process-mark erc-server-process) (point)))
- (set-marker erc-insert-marker (point))
- (let ((buffer-modified (buffer-modified-p)))
- (erc-display-prompt)
- (set-buffer-modified-p buffer-modified))))))
-
- ;; Only when last hook has been run...
- (run-hook-with-args 'erc-send-completed-hook str))))))
+ (let ((now (float-time)))
+ (if (or (not erc-accidental-paste-threshold-seconds)
+ (< erc-accidental-paste-threshold-seconds
+ (- now erc-last-input-time)))
+ (save-restriction
+ (widen)
+ (if (< (point) (erc-beg-of-input-line))
+ (erc-error "Point is not in the input area")
+ (let ((inhibit-read-only t)
+ (str (erc-user-input))
+ (old-buf (current-buffer)))
+ (if (and (not (erc-server-buffer-live-p))
+ (not (erc-command-no-process-p str)))
+ (erc-error "ERC: No process running")
+ (erc-set-active-buffer (current-buffer))
+ ;; Kill the input and the prompt
+ (delete-region (erc-beg-of-input-line)
+ (erc-end-of-input-line))
+ (unwind-protect
+ (erc-send-input str)
+ ;; Fix the buffer if the command didn't kill it
+ (when (buffer-live-p old-buf)
+ (with-current-buffer old-buf
+ (save-restriction
+ (widen)
+ (goto-char (point-max))
+ (when (processp erc-server-process)
+ (set-marker (process-mark erc-server-process) (point)))
+ (set-marker erc-insert-marker (point))
+ (let ((buffer-modified (buffer-modified-p)))
+ (erc-display-prompt)
+ (set-buffer-modified-p buffer-modified))))))
+
+ ;; Only when last hook has been run...
+ (run-hook-with-args 'erc-send-completed-hook str))))
+ (setq erc-last-input-time now))
+ (switch-to-buffer "*ERC Accidental Paste Overflow*")
+ (lwarn 'erc :warning
+ "You seem to have accidentally pasted some text!"))))
(defun erc-user-input ()
"Return the input of the user in the current buffer."
(if cuser
(setq op (erc-channel-user-op cuser)
voice (erc-channel-user-voice cuser)))
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "%s is %s@%s%s%s"
nick login host
(if full-name (format " (%s)" full-name) "")
:group 'erc-paranoia
:type 'boolean)
-(defcustom erc-common-server-suffixes
- '(("openprojects.net$" . "OPN")
- ("freenode.net$" . "freenode")
- ("oftc.net$" . "OFTC"))
- "Alist of common server name suffixes.
-This variable is used in mode-line display to save screen
-real estate. Set it to nil if you want to avoid changing
-displayed hostnames."
- :group 'erc-mode-line-and-header
- :type 'alist)
-
(defcustom erc-mode-line-away-status-format
"(AWAY since %a %b %d %H:%M) "
"When you're away on a server, this is shown in the mode line.
(format "ERC %s (GNU Emacs %s)" erc-version-string emacs-version)))
(if here
(insert version-string)
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "%s" version-string)
version-string))))
", ")))
(if here
(insert string)
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "%s" string)
string))))