[bpt/emacs.git] / lisp / erc / erc-notify.el

;;; erc-notify.el --- Online status change notification  -*- lexical-binding:t -*-

;; Copyright (C) 2002-2004, 2006-2013 Free Software Foundation, Inc.

;; Author: Mario Lang <mlang@lexx.delysid.org>
;; Maintainer: FSF
;; 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 <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This module defines a new command, /NOTIFY
;; See the docstring of `erc-cmd-NOTIFY' for details.

;;; Code:

(require 'erc)
(require 'erc-networks)
(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."
  :group 'erc-notify
  :type '(repeat string))

(defcustom erc-notify-interval 60
  "Time interval (in seconds) for checking online status of notified
people."
  :group 'erc-notify
  :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."
  :group 'erc-notify
  :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."
  :group 'erc-notify
  :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 erc-last-ison nil
  "Last ISON information received through `erc-notify-timer'.")
(make-variable-buffer-local 'erc-last-ison)

(defvar erc-last-ison-time 0
  "Last time ISON was sent to the server in `erc-notify-timer'.")
(make-variable-buffer-local 'erc-last-ison-time)

;;;; Setup

(defun erc-notify-install-message-catalogs ()
  (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'.
If this condition is satisfied, 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'.
If this condition is satisfied, 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'.
If this condition is satisfied, produce a notify_off message and remove the
nick from `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)
	       (erc-member-ignore-case nick erc-last-ison))
      (setq erc-last-ison (erc-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."
  (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")
    (erc-display-message nil 'notice 'active
			 'notify_list ?l (mapconcat 'identity erc-notify-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
		(if (erc-server-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-display-message
     nil 'notice 'active
     'notify_list ?l (mapconcat 'identity erc-notify-list " "))))
  t)

(autoload 'pcomplete-erc-all-nicks "erc-pcomplete")

;; "--" is not a typo.
(declare-function pcomplete--here "pcomplete"
		  (&optional form stub paring form-only))

;;;###autoload
(defun pcomplete/erc-mode/NOTIFY ()
  (require 'pcomplete)
  (pcomplete-here (pcomplete-erc-all-nicks)))

(erc-notify-install-message-catalogs)

(provide 'erc-notify)

;;; erc-notify.el ends here
;;
;; Local Variables:
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
Commit	Line	Data
d0fcaff5	1	;;; erc-notify.el --- Online status change notification -- lexical-binding:t --
597993cf	2
ab422c4d	3	;; Copyright (C) 2002-2004, 2006-2013 Free Software Foundation, Inc.
597993cf MB	4
597993cf MB	5	;; Author: Mario Lang <mlang@lexx.delysid.org>
df5d5f59	6	;; Maintainer: FSF
597993cf MB	7	;; Keywords: comm
	8
	9	;; This file is part of GNU Emacs.
	10
4ee57b2a	11	;; GNU Emacs is free software: you can redistribute it and/or modify
597993cf	12	;; it under the terms of the GNU General Public License as published by
4ee57b2a GM	13	;; the Free Software Foundation, either version 3 of the License, or
4ee57b2a GM	14	;; (at your option) any later version.
597993cf MB	15
	16	;; GNU Emacs is distributed in the hope that it will be useful,
	17	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	18	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	19	;; GNU General Public License for more details.
	20
	21	;; You should have received a copy of the GNU General Public License
4ee57b2a	22	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
597993cf MB	23
	24	;;; Commentary:
	25
	26	;; This module defines a new command, /NOTIFY
	27	;; See the docstring of `erc-cmd-NOTIFY' for details.
	28
	29	;;; Code:
	30
	31	(require 'erc)
c6b99621	32	(require 'erc-networks)
19dc7206	33	(eval-when-compile (require 'pcomplete))
597993cf MB	34
	35	;;;; Customizable variables
	36
	37	(defgroup erc-notify nil
	38	"Track online status of certain nicknames."
	39	:group 'erc)
	40
	41	(defcustom erc-notify-list nil
fb7ada5f	42	"List of nicknames you want to be notified about online/offline
597993cf MB	43	status change."
	44	:group 'erc-notify
	45	:type '(repeat string))
	46
	47	(defcustom erc-notify-interval 60
fb7ada5f	48	"Time interval (in seconds) for checking online status of notified
597993cf MB	49	people."
	50	:group 'erc-notify
	51	:type 'integer)
	52
	53	(defcustom erc-notify-signon-hook nil
fb7ada5f	54	"Hook run after someone on `erc-notify-list' has signed on.
597993cf MB	55	Two arguments are passed to the function, SERVER and NICK, both
	56	strings."
	57	:group 'erc-notify
	58	:type 'hook
	59	:options '(erc-notify-signon))
	60
	61	(defcustom erc-notify-signoff-hook nil
fb7ada5f	62	"Hook run after someone on `erc-notify-list' has signed off.
597993cf MB	63	Two arguments are passed to the function, SERVER and NICK, both
	64	strings."
	65	:group 'erc-notify
	66	:type 'hook
	67	:options '(erc-notify-signoff))
	68
	69	(defun erc-notify-signon (server nick)
	70	(message "%s signed on at %s" nick server))
	71
	72	(defun erc-notify-signoff (server nick)
	73	(message "%s signed off from %s" nick server))
	74
	75	;;;; Internal variables
	76
	77	(defvar erc-last-ison nil
	78	"Last ISON information received through `erc-notify-timer'.")
	79	(make-variable-buffer-local 'erc-last-ison)
	80
	81	(defvar erc-last-ison-time 0
	82	"Last time ISON was sent to the server in `erc-notify-timer'.")
	83	(make-variable-buffer-local 'erc-last-ison-time)
	84
	85	;;;; Setup
	86
	87	(defun erc-notify-install-message-catalogs ()
	88	(erc-define-catalog
	89	'english
09e80d9f	90	'((notify_current . "Notified people online: %l")
597993cf MB	91	(notify_list . "Current notify list: %l")
	92	(notify_on . "Detected %n on IRC network %m")
	93	(notify_off . "%n has left IRC network %m"))))
	94
	95	;;;###autoload (autoload 'erc-notify-mode "erc-notify" nil t)
	96	(define-erc-module notify nil
	97	"Periodically check for the online status of certain users and report
	98	changes."
	99	((add-hook 'erc-timer-hook 'erc-notify-timer)
	100	(add-hook 'erc-server-JOIN-functions 'erc-notify-JOIN)
	101	(add-hook 'erc-server-NICK-functions 'erc-notify-NICK)
	102	(add-hook 'erc-server-QUIT-functions 'erc-notify-QUIT))
	103	((remove-hook 'erc-timer-hook 'erc-notify-timer)
	104	(remove-hook 'erc-server-JOIN-functions 'erc-notify-JOIN)
	105	(remove-hook 'erc-server-NICK-functions 'erc-notify-NICK)
	106	(remove-hook 'erc-server-QUIT-functions 'erc-notify-QUIT)))
	107
	108	;;;; Timer handler
	109
	110	(defun erc-notify-timer (now)
2131c501 MO	111	(when (and erc-server-connected
2131c501 MO	112	erc-notify-list
597993cf MB	113	(> (erc-time-diff
	114	erc-last-ison-time now)
	115	erc-notify-interval))
	116	(erc-once-with-server-event
	117	303
d0fcaff5 SM	118	(lambda (proc parsed)
	119	(let* ((server (erc-response.sender parsed))
	120	(ison-list (delete "" (split-string
	121	(erc-response.contents parsed))))
	122	(new-list ison-list)
	123	(old-list (erc-with-server-buffer erc-last-ison)))
	124	(while new-list
	125	(when (not (erc-member-ignore-case (car new-list) old-list))
	126	(run-hook-with-args 'erc-notify-signon-hook server (car new-list))
	127	(erc-display-message
	128	parsed 'notice proc
	129	'notify_on ?n (car new-list) ?m (erc-network-name)))
	130	(setq new-list (cdr new-list)))
	131	(while old-list
	132	(when (not (erc-member-ignore-case (car old-list) ison-list))
	133	(run-hook-with-args 'erc-notify-signoff-hook server (car old-list))
	134	(erc-display-message
	135	parsed 'notice proc
	136	'notify_off ?n (car old-list) ?m (erc-network-name)))
	137	(setq old-list (cdr old-list)))
	138	(setq erc-last-ison ison-list)
	139	t)))
597993cf MB	140	(erc-server-send
	141	(concat "ISON " (mapconcat 'identity erc-notify-list " ")))
	142	(setq erc-last-ison-time now)))
	143
	144	(defun erc-notify-JOIN (proc parsed)
	145	"Check if channel joiner is on `erc-notify-list' and not on `erc-last-ison'.
	146	If this condition is satisfied, produce a notify_on message and add the nick
	147	to `erc-last-ison' to prevent any further notifications."
	148	(let ((nick (erc-extract-nick (erc-response.sender parsed))))
	149	(when (and (erc-member-ignore-case nick erc-notify-list)
	150	(not (erc-member-ignore-case nick erc-last-ison)))
	151	(add-to-list 'erc-last-ison nick)
	152	(run-hook-with-args 'erc-notify-signon-hook
	153	(or erc-server-announced-name erc-session-server)
	154	nick)
	155	(erc-display-message
	156	parsed 'notice proc
	157	'notify_on ?n nick ?m (erc-network-name)))
	158	nil))
	159
	160	(defun erc-notify-NICK (proc parsed)
	161	"Check if new nick is on `erc-notify-list' and not on `erc-last-ison'.
	162	If this condition is satisfied, produce a notify_on message and add the nick
	163	to `erc-last-ison' to prevent any further notifications."
	164	(let ((nick (erc-response.contents parsed)))
	165	(when (and (erc-member-ignore-case nick erc-notify-list)
	166	(not (erc-member-ignore-case nick erc-last-ison)))
	167	(add-to-list 'erc-last-ison nick)
	168	(run-hook-with-args 'erc-notify-signon-hook
	169	(or erc-server-announced-name erc-session-server)
	170	nick)
	171	(erc-display-message
	172	parsed 'notice proc
	173	'notify_on ?n nick ?m (erc-network-name)))
	174	nil))
	175
	176	(defun erc-notify-QUIT (proc parsed)
	177	"Check if quitter is on `erc-notify-list' and on `erc-last-ison'.
	178	If this condition is satisfied, produce a notify_off message and remove the
	179	nick from `erc-last-ison' to prevent any further notifications."
	180	(let ((nick (erc-extract-nick (erc-response.sender parsed))))
	181	(when (and (erc-member-ignore-case nick erc-notify-list)
	182	(erc-member-ignore-case nick erc-last-ison))
d0fcaff5 SM	183	(setq erc-last-ison (erc-delete-if
	184	(let ((nick-down (erc-downcase nick)))
	185	(lambda (el)
	186	(string= nick-down (erc-downcase el))))
	187	erc-last-ison))
597993cf MB	188	(run-hook-with-args 'erc-notify-signoff-hook
	189	(or erc-server-announced-name erc-session-server)
	190	nick)
	191	(erc-display-message
	192	parsed 'notice proc
	193	'notify_off ?n nick ?m (erc-network-name)))
	194	nil))
	195
	196	;;;; User level command
	197
	198	;;;###autoload
	199	(defun erc-cmd-NOTIFY (&rest args)
	200	"Change `erc-notify-list' or list current notify-list members online.
0b381c7e	201	Without args, list the current list of notified people online,
597993cf MB	202	with args, toggle notify status of people."
	203	(cond
	204	((null args)
0b381c7e	205	;; Print current notified people (online)
ff59d266	206	(let ((ison (erc-with-server-buffer erc-last-ison)))
597993cf MB	207	(if (not ison)
	208	(erc-display-message
	209	nil 'notice 'active "No ison-list yet!")
	210	(erc-display-message
	211	nil 'notice 'active
	212	'notify_current ?l ison))))
	213	((string= (car args) "-l")
	214	(erc-display-message nil 'notice 'active
	215	'notify_list ?l (mapconcat 'identity erc-notify-list
	216	" ")))
	217	(t
	218	(while args
	219	(if (erc-member-ignore-case (car args) erc-notify-list)
	220	(progn
	221	(setq erc-notify-list (delete (car args) erc-notify-list))
	222	;; Remove the nick from the value of erc-last-ison in
	223	;; every server buffer. This prevents seeing a signoff
	224	;; notification for a nick that you have just _removed_
	225	;; from your notify list.
	226	(dolist (buf (erc-buffer-list))
	227	(with-current-buffer buf
	228	(if (erc-server-buffer-p)
	229	(setq erc-last-ison (delete (car args) erc-last-ison))))))
	230	(setq erc-notify-list (cons (erc-string-no-properties (car args))
	231	erc-notify-list)))
	232	(setq args (cdr args)))
	233	(erc-display-message
	234	nil 'notice 'active
	235	'notify_list ?l (mapconcat 'identity erc-notify-list " "))))
	236	t)
	237
1dee7c23 GM	238	(autoload 'pcomplete-erc-all-nicks "erc-pcomplete")
1dee7c23 GM	239
f440830d GM	240	;; "--" is not a typo.
	241	(declare-function pcomplete--here "pcomplete"
	242	(&optional form stub paring form-only))
	243
597993cf MB	244	;;;###autoload
597993cf MB	245	(defun pcomplete/erc-mode/NOTIFY ()
f440830d	246	(require 'pcomplete)
597993cf MB	247	(pcomplete-here (pcomplete-erc-all-nicks)))
	248
	249	(erc-notify-install-message-catalogs)
	250
	251	(provide 'erc-notify)
	252
	253	;;; erc-notify.el ends here
	254	;;
	255	;; Local Variables:
	256	;; indent-tabs-mode: t
	257	;; tab-width: 8
	258	;; End: