468 lines
19 KiB
EmacsLisp
468 lines
19 KiB
EmacsLisp
;;; erc-notify.el --- Online status change notification -*- lexical-binding:t -*-
|
|
|
|
;; Copyright (C) 2002-2004, 2006-2024 Free Software Foundation, Inc.
|
|
|
|
;; Author: Mario Lang <mlang@lexx.delysid.org>
|
|
;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
|
|
;; URL: https://www.emacswiki.org/emacs/ErcNotify
|
|
;; Keywords: comm
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs 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.
|
|
|
|
;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This module defines a new command, /NOTIFY
|
|
;; See the docstring of `erc-cmd-NOTIFY' for details.
|
|
|
|
;;; Code:
|
|
|
|
(require 'erc)
|
|
(eval-when-compile (require 'pcomplete))
|
|
|
|
;;;; Customizable variables
|
|
|
|
(defgroup erc-notify nil
|
|
"Track online status of certain nicknames."
|
|
:group 'erc)
|
|
|
|
(defcustom erc-notify-list nil
|
|
"List of nicknames you want to be notified about online/offline status change."
|
|
:type '(repeat string))
|
|
|
|
(defcustom erc-notify-interval 60
|
|
"Time interval (in seconds) for checking online status of notified people."
|
|
:type 'integer)
|
|
|
|
(defcustom erc-notify-signon-hook nil
|
|
"Hook run after someone on `erc-notify-list' has signed on.
|
|
Two arguments are passed to the function, SERVER and NICK, both
|
|
strings."
|
|
:type 'hook
|
|
:options '(erc-notify-signon))
|
|
|
|
(defcustom erc-notify-signoff-hook nil
|
|
"Hook run after someone on `erc-notify-list' has signed off.
|
|
Two arguments are passed to the function, SERVER and NICK, both
|
|
strings."
|
|
:type 'hook
|
|
:options '(erc-notify-signoff))
|
|
|
|
(defun erc-notify-signon (server nick)
|
|
(message "%s signed on at %s" nick server))
|
|
|
|
(defun erc-notify-signoff (server nick)
|
|
(message "%s signed off from %s" nick server))
|
|
|
|
;;;; Internal variables
|
|
|
|
(defvar-local erc-last-ison nil
|
|
"Last ISON information received through `erc-notify-timer'.")
|
|
|
|
(defvar-local erc-last-ison-time 0
|
|
"Last time ISON was sent to the server in `erc-notify-timer'.")
|
|
|
|
;;;; Setup
|
|
|
|
(defun erc-notify-install-message-catalogs ()
|
|
(declare (obsolete "defined at top level in erc-notify.el" "30.1"))
|
|
(with-suppressed-warnings ((obsolete erc-define-catalog))
|
|
(erc-define-catalog
|
|
'english
|
|
'((notify-current . "Notified people online: %l")
|
|
(notify-list . "Current notify list: %l")
|
|
(notify-on . "Detected %n on IRC network %m")
|
|
(notify-off . "%n has left IRC network %m")))))
|
|
|
|
;;;###autoload(autoload 'erc-notify-mode "erc-notify" nil t)
|
|
(define-erc-module notify nil
|
|
"Periodically check for the online status of certain users and report
|
|
changes."
|
|
((add-hook 'erc-timer-hook #'erc-notify-timer)
|
|
(add-hook 'erc-server-JOIN-functions #'erc-notify-JOIN)
|
|
(add-hook 'erc-server-NICK-functions #'erc-notify-NICK)
|
|
(add-hook 'erc-server-QUIT-functions #'erc-notify-QUIT))
|
|
((remove-hook 'erc-timer-hook #'erc-notify-timer)
|
|
(remove-hook 'erc-server-JOIN-functions #'erc-notify-JOIN)
|
|
(remove-hook 'erc-server-NICK-functions #'erc-notify-NICK)
|
|
(remove-hook 'erc-server-QUIT-functions #'erc-notify-QUIT)))
|
|
|
|
;;;; Timer handler
|
|
|
|
(defun erc-notify-timer (now)
|
|
(when (and erc-server-connected
|
|
erc-notify-list
|
|
(> (erc-time-diff
|
|
erc-last-ison-time now)
|
|
erc-notify-interval))
|
|
(erc-once-with-server-event
|
|
303
|
|
(lambda (proc parsed)
|
|
(let* ((server (erc-response.sender parsed))
|
|
(ison-list (delete "" (split-string
|
|
(erc-response.contents parsed))))
|
|
(new-list ison-list)
|
|
(old-list (erc-with-server-buffer erc-last-ison)))
|
|
(while new-list
|
|
(when (not (erc-member-ignore-case (car new-list) old-list))
|
|
(run-hook-with-args 'erc-notify-signon-hook server (car new-list))
|
|
(erc-display-message
|
|
parsed 'notice proc
|
|
'notify-on ?n (car new-list) ?m (erc-network-name)))
|
|
(setq new-list (cdr new-list)))
|
|
(while old-list
|
|
(when (not (erc-member-ignore-case (car old-list) ison-list))
|
|
(run-hook-with-args 'erc-notify-signoff-hook server (car old-list))
|
|
(erc-display-message
|
|
parsed 'notice proc
|
|
'notify-off ?n (car old-list) ?m (erc-network-name)))
|
|
(setq old-list (cdr old-list)))
|
|
(setq erc-last-ison ison-list)
|
|
t)))
|
|
(erc-server-send
|
|
(concat "ISON " (mapconcat #'identity erc-notify-list " ")))
|
|
(setq erc-last-ison-time now)))
|
|
|
|
(defun erc-notify-JOIN (proc parsed)
|
|
"Check if channel joiner is on `erc-notify-list' and not on `erc-last-ison'.
|
|
When that's the case, produce a `notify-on' message and add the
|
|
nick to `erc-last-ison' to prevent any further notifications."
|
|
(let ((nick (erc-extract-nick (erc-response.sender parsed))))
|
|
(when (and (erc-member-ignore-case nick erc-notify-list)
|
|
(not (erc-member-ignore-case nick erc-last-ison)))
|
|
(add-to-list 'erc-last-ison nick)
|
|
(run-hook-with-args 'erc-notify-signon-hook
|
|
(or erc-server-announced-name erc-session-server)
|
|
nick)
|
|
(erc-display-message
|
|
parsed 'notice proc
|
|
'notify-on ?n nick ?m (erc-network-name)))
|
|
nil))
|
|
|
|
(defun erc-notify-NICK (proc parsed)
|
|
"Check if new nick is on `erc-notify-list' and not on `erc-last-ison'.
|
|
When that's the case, produce a `notify-on' message and add the
|
|
nick to `erc-last-ison' to prevent any further notifications."
|
|
(let ((nick (erc-response.contents parsed)))
|
|
(when (and (erc-member-ignore-case nick erc-notify-list)
|
|
(not (erc-member-ignore-case nick erc-last-ison)))
|
|
(add-to-list 'erc-last-ison nick)
|
|
(run-hook-with-args 'erc-notify-signon-hook
|
|
(or erc-server-announced-name erc-session-server)
|
|
nick)
|
|
(erc-display-message
|
|
parsed 'notice proc
|
|
'notify-on ?n nick ?m (erc-network-name)))
|
|
nil))
|
|
|
|
(defun erc-notify-QUIT (proc parsed)
|
|
"Check if quitter is on `erc-notify-list' and on `erc-last-ison'.
|
|
When that's the case, insert a `notify-off' message and remove
|
|
the nick from `erc-last-ison' to prevent further notifications."
|
|
(let ((nick (erc-extract-nick (erc-response.sender parsed))))
|
|
(when (and (erc-member-ignore-case nick erc-notify-list)
|
|
(erc-member-ignore-case nick erc-last-ison))
|
|
(setq erc-last-ison (cl-delete-if
|
|
(let ((nick-down (erc-downcase nick)))
|
|
(lambda (el)
|
|
(string= nick-down (erc-downcase el))))
|
|
erc-last-ison))
|
|
(run-hook-with-args 'erc-notify-signoff-hook
|
|
(or erc-server-announced-name erc-session-server)
|
|
nick)
|
|
(erc-display-message
|
|
parsed 'notice proc
|
|
'notify-off ?n nick ?m (erc-network-name)))
|
|
nil))
|
|
|
|
;;;; User level command
|
|
|
|
;;;###autoload
|
|
(defun erc-cmd-NOTIFY (&rest args)
|
|
"Change `erc-notify-list' or list current notify-list members online.
|
|
Without args, list the current list of notified people online,
|
|
with args, toggle notify status of people."
|
|
(unless erc-notify-mode
|
|
(erc-notify-mode +1)
|
|
(erc-button--display-error-notice-with-keys
|
|
(current-buffer)
|
|
"Command /NOTIFY requires the `notify' module. Enabling now. Add `notify'"
|
|
" to `erc-modules' before next starting ERC to silence this message."))
|
|
(cond
|
|
((null args)
|
|
;; Print current notified people (online)
|
|
(let ((ison (erc-with-server-buffer erc-last-ison)))
|
|
(if (not ison)
|
|
(erc-display-message
|
|
nil 'notice 'active "No ison-list yet!")
|
|
(erc-display-message
|
|
nil 'notice 'active
|
|
'notify-current ?l ison))))
|
|
((string= (car args) "-l")
|
|
(let ((list (if erc-notify-list
|
|
(mapconcat #'identity erc-notify-list " ")
|
|
"(empty)")))
|
|
(erc-display-message nil 'notice 'active 'notify-list ?l list)))
|
|
(t
|
|
(while args
|
|
(if (erc-member-ignore-case (car args) erc-notify-list)
|
|
(progn
|
|
(setq erc-notify-list (delete (car args) erc-notify-list))
|
|
;; Remove the nick from the value of erc-last-ison in
|
|
;; every server buffer. This prevents seeing a signoff
|
|
;; notification for a nick that you have just _removed_
|
|
;; from your notify list.
|
|
(dolist (buf (erc-buffer-list))
|
|
(with-current-buffer buf
|
|
;; FIXME replace with `erc--server-buffer-p' or
|
|
;; explain why that's unwise.
|
|
(if (erc-server-or-unjoined-channel-buffer-p)
|
|
(setq erc-last-ison (delete (car args) erc-last-ison))))))
|
|
(setq erc-notify-list (cons (erc-string-no-properties (car args))
|
|
erc-notify-list)))
|
|
(setq args (cdr args)))
|
|
(erc-cmd-NOTIFY "-l")))
|
|
t)
|
|
|
|
;; "--" is not a typo.
|
|
(declare-function pcomplete--here "pcomplete"
|
|
(&optional form stub paring form-only))
|
|
(declare-function pcomplete-erc-all-nicks "erc-pcomplete"
|
|
(&optional postfix))
|
|
|
|
;;;###autoload
|
|
(defun pcomplete/erc-mode/NOTIFY ()
|
|
(require 'erc-pcomplete)
|
|
(pcomplete-here (append erc-notify-list (pcomplete-erc-all-nicks))))
|
|
|
|
(define-obsolete-variable-alias 'erc-message-english-notify_on
|
|
'erc-message-english-notify-on "30.1")
|
|
(define-obsolete-variable-alias 'erc-message-english-notify_off
|
|
'erc-message-english-notify-off "30.1")
|
|
(define-obsolete-variable-alias 'erc-message-english-notify_list
|
|
'erc-message-english-notify-list "30.1")
|
|
(define-obsolete-variable-alias 'erc-message-english-notify_current
|
|
'erc-message-english-notify-current "30.1")
|
|
|
|
(erc-define-message-format-catalog english
|
|
(notify-current . "Notified people online: %l")
|
|
(notify-list . "Current notify list: %l")
|
|
(notify-on . "Detected %n on IRC network %m")
|
|
(notify-off . "%n has left IRC network %m"))
|
|
|
|
|
|
;;;; Module `querypoll'
|
|
|
|
;; This module is similar to `notify' in that it periodically tries to
|
|
;; discover whether certain users are online. Unlike that module, it's
|
|
;; not really configurable. Rather, it only selects users you've
|
|
;; corresponded with in a query buffer, and it keeps `erc-server-users'
|
|
;; entries for them updated.
|
|
|
|
(declare-function ring-empty-p "ring" (ring))
|
|
(declare-function ring-insert "ring" (ring item))
|
|
(declare-function ring-insert+extend "ring" (ring item))
|
|
(declare-function ring-length "ring" (ring))
|
|
(declare-function ring-member "ring" (ring item))
|
|
(declare-function ring-ref "ring" (ring index))
|
|
(declare-function ring-remove "ring" (ring &optional index))
|
|
|
|
(defvar-local erc--querypoll-ring nil)
|
|
(defvar-local erc--querypoll-timer nil)
|
|
|
|
(defcustom erc-querypoll-exclude-regexp
|
|
(rx bot (or (: "*" (+ nonl)) (: (+ (in "A-Za-z")) "Serv")) eot)
|
|
"Pattern to skip polling for bots and services you regularly query."
|
|
:group 'erc
|
|
:package-version '(ERC . "5.6")
|
|
:type 'regexp)
|
|
|
|
;;;###autoload(autoload 'erc-querypoll-mode "erc-notify" nil t)
|
|
(define-erc-module querypoll nil
|
|
"Send periodic \"WHO\" requests for each query buffer.
|
|
Omit query participants who are currently present in some channel.
|
|
Instead of announcing arrivals and departures, rely on other modules,
|
|
like `nickbar', to provide UI feedback when changes occur.
|
|
|
|
Once ERC implements the `monitor' extension, this module will serve as
|
|
an optional fallback for keeping query-participant rolls up to date on
|
|
servers that lack support or are stingy with their allotments. Until
|
|
such time, this module should be considered experimental.
|
|
|
|
This is a local ERC module, so selectively polling only a subset of
|
|
query targets is possible but cumbersome. To do so, ensure
|
|
`erc-querypoll-mode' is enabled in the server buffer, and then toggle it
|
|
as appropriate in desired query buffers. To stop polling for the
|
|
current connection, toggle off the command \\[erc-querypoll-mode] from a
|
|
server buffer, or run \\`M-x C-u erc-querypoll-disable RET' from a
|
|
target buffer."
|
|
((if erc--target
|
|
(if (erc-query-buffer-p)
|
|
(progn ; accommodate those who eschew `erc-modules'
|
|
(erc-with-server-buffer
|
|
(unless erc-querypoll-mode
|
|
(erc-querypoll-mode +1)))
|
|
(erc--querypoll-subscribe (current-buffer)))
|
|
(erc-querypoll-mode -1))
|
|
(cl-assert (not erc--decouple-query-and-channel-membership-p))
|
|
(setq-local erc--querypoll-ring (make-ring 5))
|
|
(erc-with-all-buffers-of-server erc-server-process nil
|
|
(unless erc-querypoll-mode
|
|
(erc-querypoll-mode +1)))))
|
|
((when erc--querypoll-timer
|
|
(cancel-timer erc--querypoll-timer))
|
|
(if erc--target
|
|
(when-let* (((erc-query-buffer-p))
|
|
(ring (erc-with-server-buffer erc--querypoll-ring))
|
|
(index (ring-member ring (current-buffer)))
|
|
((not (erc--querypoll-target-in-chan-p (current-buffer)))))
|
|
(ring-remove ring index)
|
|
(unless (erc-current-nick-p (erc-target))
|
|
(erc-remove-current-channel-member (erc-target))))
|
|
(erc-with-all-buffers-of-server erc-server-process #'erc-query-buffer-p
|
|
(erc-querypoll-mode -1)))
|
|
(kill-local-variable 'erc--querypoll-ring)
|
|
(kill-local-variable 'erc--querypoll-timer))
|
|
'local)
|
|
|
|
(cl-defmethod erc--queries-current-p (&context (erc-querypoll-mode (eql t))) t)
|
|
|
|
(defvar erc-querypoll-period-params '(10 10 1)
|
|
"Parameters affecting the delay with respect to the number of buffers.
|
|
The elements represent some parameters of an exponential decay function,
|
|
a(e)^{-x/b}+c. The first number (a) affects the overall scaling. A
|
|
higher value means longer delays for all query buffers relative to queue
|
|
length. The second number (b) determines how quickly the delay
|
|
decreases as the queue length increases. Larger values make the delay
|
|
taper off more gradually. The last number (c) sets the minimum delay
|
|
between updates regardless of queue length.")
|
|
|
|
(defun erc--querypoll-compute-period (queue-size)
|
|
"Calculate delay based on QUEUE-SIZE."
|
|
(let ((scale (nth 0 erc-querypoll-period-params))
|
|
(rate (* 1.0 (nth 1 erc-querypoll-period-params)))
|
|
(min (nth 2 erc-querypoll-period-params)))
|
|
(+ (* scale (exp (/ (- queue-size) rate))) min)))
|
|
|
|
(defun erc--querypoll-target-in-chan-p (buffer)
|
|
"Determine whether buffer's target, as a user, is joined to any channels."
|
|
(and-let*
|
|
((target (erc--target-string (buffer-local-value 'erc--target buffer)))
|
|
(user (erc-get-server-user target))
|
|
(buffers (erc-server-user-buffers user))
|
|
((seq-some #'erc-channel-p buffers)))))
|
|
|
|
(defun erc--querypoll-get-length (ring)
|
|
"Return the effective length of RING, discounting chan members."
|
|
(let ((count 0))
|
|
(dotimes (i (ring-length ring))
|
|
(unless (erc--querypoll-target-in-chan-p (ring-ref ring i))
|
|
(cl-incf count 1)))
|
|
count))
|
|
|
|
(defun erc--querypoll-get-next (ring)
|
|
(let ((n (ring-length ring)))
|
|
(catch 'found
|
|
(while (natnump (cl-decf n))
|
|
(when-let* ((buffer (ring-remove ring))
|
|
((buffer-live-p buffer)))
|
|
;; Push back buffers for users joined to some chan.
|
|
(if (erc--querypoll-target-in-chan-p buffer)
|
|
(ring-insert ring buffer)
|
|
(throw 'found buffer)))))))
|
|
|
|
(defun erc--querypoll-subscribe (query-buffer &optional penalty)
|
|
"Add QUERY-BUFFER to FIFO and ensure timer is running."
|
|
(when query-buffer
|
|
(cl-assert (erc-query-buffer-p query-buffer)))
|
|
(erc-with-server-buffer
|
|
(when (and query-buffer
|
|
(not (with-current-buffer query-buffer
|
|
(or (erc-current-nick-p (erc-target))
|
|
(string-match erc-querypoll-exclude-regexp
|
|
(erc-target)))))
|
|
(not (ring-member erc--querypoll-ring query-buffer)))
|
|
(ring-insert+extend erc--querypoll-ring query-buffer))
|
|
(unless erc--querypoll-timer
|
|
(setq erc--querypoll-timer
|
|
(let* ((length (erc--querypoll-get-length erc--querypoll-ring))
|
|
(period (erc--querypoll-compute-period length)))
|
|
(run-at-time (+ (or penalty 0) period)
|
|
nil #'erc--querypoll-send (current-buffer)))))))
|
|
|
|
(defun erc--querypoll-on-352 (target-nick args)
|
|
"Add or update `erc-server-users' data for TARGET-NICK from ARGS.
|
|
Then add user to participant rolls in any existing query buffers."
|
|
(pcase-let
|
|
((`(,_ ,channel ,login ,host ,_server ,nick ,_flags, hop-real) args))
|
|
(when (and (string= channel "*") (erc-nick-equal-p nick target-nick))
|
|
(if-let* ((user (erc-get-server-user nick)))
|
|
(erc-update-user user nick host login
|
|
(erc--extract-352-full-name hop-real))
|
|
;; Don't add unless target is already known.
|
|
(when (erc-get-buffer nick erc-server-process)
|
|
(erc-add-server-user
|
|
nick (make-erc-server-user
|
|
:nickname nick :login login :host host
|
|
:full-name (erc--extract-352-full-name hop-real)))))
|
|
(erc--ensure-query-member nick)
|
|
t)))
|
|
|
|
;; This uses heuristics to associate replies to the initial request
|
|
;; because ERC does not yet support `labeled-response'.
|
|
(defun erc--querypoll-send (server-buffer)
|
|
"Send a captive \"WHO\" in SERVER-BUFFER."
|
|
(when (and (buffer-live-p server-buffer)
|
|
(buffer-local-value 'erc-server-connected server-buffer))
|
|
(with-current-buffer server-buffer
|
|
(setq erc--querypoll-timer nil)
|
|
(if-let* ((buffer (erc--querypoll-get-next erc--querypoll-ring)))
|
|
(letrec
|
|
((target (erc--target-string
|
|
(buffer-local-value 'erc--target buffer)))
|
|
(penalty 0)
|
|
(here-fn (erc-once-with-server-event
|
|
"352" (lambda (_ parsed)
|
|
(erc--querypoll-on-352
|
|
target (erc-response.command-args parsed)))))
|
|
(done-fn (erc-once-with-server-event
|
|
"315"
|
|
(lambda (_ parsed)
|
|
(if (memq here-fn erc-server-352-functions)
|
|
(erc-remove-user
|
|
(nth 1 (erc-response.command-args parsed)))
|
|
(remove-hook 'erc-server-352-functions here-fn t))
|
|
(remove-hook 'erc-server-263-functions fail-fn t)
|
|
(remove-hook 'erc-server-315-functions done-fn t)
|
|
(erc--querypoll-subscribe buffer penalty)
|
|
t)))
|
|
(fail-fn (erc-once-with-server-event
|
|
"263"
|
|
(lambda (proc parsed)
|
|
(setq penalty 60)
|
|
(funcall done-fn proc parsed)
|
|
t))))
|
|
(erc-server-send (concat "WHO " target)))
|
|
(unless (ring-empty-p erc--querypoll-ring)
|
|
(erc--querypoll-subscribe nil 30))))))
|
|
|
|
(provide 'erc-notify)
|
|
|
|
;;; erc-notify.el ends here
|
|
;;
|
|
;; Local Variables:
|
|
;; generated-autoload-file: "erc-loaddefs.el"
|
|
;; End:
|