;; 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
"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)
;; User data
'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.
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)
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)
+
+(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-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)
+
+(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
+ (> (time-to-seconds (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 (>= (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)
+ (> (time-to-seconds
+ (time-subtract (current-time) last-PRIVMSG-time))
+ erc-lurker-threshold-time))))
+
+(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)))))