Source

erc / erc-members.el

Full commit
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
;;; erc-members.el --- ERC member management

;; Copyright (C) 2003  Free Software Foundation, Inc.

;; Author: Andreas Fuchs <asf@void.at>, 
;;         Alex Schroeder <alex@gnu.org>

;; This 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 2, or (at your option)
;; any later version.

;; This 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; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; An implementation of management functions which act as a
;; replacement of the erc-channel-member lists.  Note that when lines
;; are parsed from the server, the nick is not downcased using
;; `erc-downcase'.  Thus, when comparing nicks, we always have to call
;; `erc-downcase'.  `erc-members' is a hash of hashes, where the
;; second hash uses the downcased version of nicks as the key.
;; Whenever gethash or puthash is used on it, this has to be
;; considered.

;; Eventually, remove erc-update-channel-info-buffer!

;;; Code:

;; Avoid miscompiling macro `erc-log' and `with-erc-channel-buffer' in
;; absence of loaded definition from 'erc.
;; See 2004-03-15_23-01_macro_err_1.txt in
;; http://labb.contactor.se/~matsl/smoketest/logs/
;; or newer results for miscompiled macros.
(eval-when-compile (require 'erc))

(require 'cl); for defstruct

(defvar erc-members (makehash 'eq)
  "A hash containing all channel members.
The key is the `erc-process', and the value is yet another hash.  This
other hash uses the erc-downcased nick name as a key, and returns an
erc-person structure.")

(defcustom erc-members-changed-hook nil
  "*This hook is called everytime the variable `erc-members' changes.
Note that if a bunch of changes happen at the same time, the hook is only
called once, at the end."
  :group 'erc-hooks
  :type 'hook)

(make-obsolete-variable 'erc-channel-members-changed-hook 'erc-members-changed-hook)

(when (and (boundp 'erc-channel-members-changed-hook)
	   erc-channel-members-changed-hook)
  (nconc erc-members-changed-hook erc-channel-members-changed-hook))

;; These erc-person structures are created in erc-add-nick-to-channel
(defstruct erc-person nick user host full-name email info channels)
;; When creating a new erc-person, make sure to use (makehash 'equal)
;;   for CHANNELS!
;; CHANNELS is a hashtable of channel names as key and a list of modes,
;;   starting with nil, as a value.  Other members of this list are 'op
;;   and 'voice.  That is, if a person is in channel foo, (gethash "foo"
;;   CHANNELS) returns (nil), or (op) or (voice) or even (op voice).

(defun erc-person-debug (person)
  "Return a human readable representation of PERSON.
PERSON is an erc-person structure."
  (list
   (erc-person-nick person)
   (erc-person-user person)
   (erc-person-host person)
   (erc-person-full-name person)
   (let (result)
     (maphash (lambda (key val)
		(if (equal val '(nil))
		    (setq result (cons key result))
		  (setq result (cons (cons key val) result))))
	      (erc-person-channels person))
     result)))

;(eval-when-compile
;  (let ((p (make-erc-person :nick "test" :channels (makehash 'equal))))
;    (erc-add-person-to-channel p "foo" '(ga))
;    (erc-person-debug p)))

(defun erc-members-debug ()
  "Return a human readable representation of `erc-members'."
  (let (result)
    (maphash
     (lambda (key val)
       (setq result (cons (cons key
				(let (l)
				  (maphash (lambda (k v)
					     (setq l (cons (cons k
								 (list (erc-person-debug v)))
							   l)))
					   val)
				  l))
			  result)))
     erc-members)
    result))

;;; Accessor Functions.

;; In many cases there are two accessors: One for persons -- these are
;; internal functions, and one for nicks -- these are the functions to
;; be used from the outside.  The goal is to call `erc-person' only
;; once per nick.

(defun erc-members-reset ()
  "Clear the `erc-members' hash-table."
  (setq erc-members (makehash 'eq)))

(defun erc-members (&optional process)
  "Return the hash of nicks for PROCESS.
If PROCESS is nil, return the nick names for `erc-process'."
  (gethash (or process erc-process) erc-members))

(defun erc-person-in-channel (person channel)
  "Return non-nil if PERSON is in CHANNEL.
PERSON is an erc-person structure."
  (gethash channel (erc-person-channels person)))

(defun erc-person (nick &optional process)
  "Return the erc-person structure for NICK and PROCESS.
If PROCESS is nil, use `erc-process'."
  (gethash (erc-downcase nick) (erc-members process)))

(defun erc-nick-in-channel (nick channel &optional process)
  "Return non-nil if NICK is in CHANNEL for PROCESS.
If PROCESS is nil, use `erc-process'."
  (let ((person (erc-person nick process)))
    (when person
      (erc-person-in-channel person channel))))

(defun erc-nick-channels (nick &optional process)
  "Return the list of channels NICK is in.
If PROCESS is nil, use `erc-process'."
  (let ((person (erc-person nick process)))
    (when person
;; someone was trying to pass in a second arg 'process'?
      (erc-person-channels person))))


(defun erc-add-person-to-channel (person channel modes)
  "Add PERSON to CHANNEL with MODES.
PERSON is an `erc-person' structure.
CHANNEL is a string.
MODES is a list of modes such as 'op or 'voice.
If MODES is nil, the list (nil) will be used."
  (puthash channel
	   (or modes '(nil))
	   (erc-person-channels person))
  ;; when doing batch changes, bind erc-members-changed-hook to nil
  (run-hooks 'erc-members-changed-hook))

(defun erc-add-nick-to-channel (nick channel modes &optional process)
  "Add NICK to CHANNEL for PROCESS with MODES.
NICK is string
CHANNEL is a string.
MODES is a list of modes such as 'op or 'voice, or nil.
If PROCESS is nil, use `erc-process'."
  (let ((nicks (gethash process erc-members))
	person)
    (unless nicks
      (setq nicks (makehash 'equal))
      (puthash process nicks erc-members))
    (setq person (erc-person nick process))
    (unless person
      (setq person (make-erc-person :nick nick :channels (makehash 'equal)))
      (puthash (erc-downcase nick) person nicks))
    (erc-add-person-to-channel person channel modes)))

(defun erc-remove-person-from-channel (person channel)
  "Remove PERSON from CHANNEL.
PERSON is an `erc-person' structure.
CHANNEL is a string."
  (remhash channel (erc-person-channels person))
  ;; when doing batch changes, bind erc-members-changed-hook to nil
  (run-hooks 'erc-members-changed-hook))

(defun erc-remove-nick-from-channel (nick channel &optional process)
  "Remove NICK from CHANNEL for PROCESS.
If PROCESS is nil, use `erc-process'."
  (erc-remove-person-from-channel (erc-person nick process) channel))

(defun erc-person-get-mode-in-channel (person channel mode)
  "Return non-nil if PERSON in CHANNEL has MODE.
PERSON is an erc-person structure.
CHANNEL is a string.
MODE is a symbol such as `op'"
  (memq mode (gethash channel (erc-person-channels person))))

(defun erc-person-set-mode-in-channel (person channel mode status)
  "Give PERSON MODE STATUS in CHANNEL.
PERSON is an erc-person structure.
MODE is the symbol `op' or `voice'.
STATUS is nil or t.
CHANNEL is a string."
  (let ((modes (gethash channel (erc-person-channels person))))
    (unless modes
      (error "%S is not in channel %s" person channel))
    (if status
	(or (memq mode modes)
	    (puthash channel
		     (cons mode modes)
		     (erc-person-channels person)))
      (or (not (memq mode modes))
	  (puthash channel
		   (delq mode modes)
		   (erc-person-channels person))))))

(defun erc-get-channel-members (channel &optional process)
  "Return a list of erc-person structures for CHANNEL.
If PROCESS is nil, use `erc-process'."
  (let (result)
    (maphash (lambda (nick person)
	       (when (erc-person-in-channel person channel)
		 (setq result (cons person result))))
	     (erc-members process))
    result))

(defun erc-refresh-channel-members (channel names-string &optional add)
  "Update channel members for CHANNEL.
All the nicks listed in NAMES-STRING are on that channel.
If optional ADD is non-nil, do not remove existing names from the list.
This refers to the channel named CHANNEL associated with the current
`erc-process' only."
  (unless erc-process
    (error "No erc-process in %S" (current-buffer)))
  ;; We need to delete "" because in XEmacs, (split-string "a ")
  ;; returns ("a" "").  Based on the nick names used in NAMES-STRING,
  ;; we determine their op and voice capabilities, we create a
  ;; hashtable where each key is the nick name, and the value has the
  ;; form (OP VOICE), where OP and VOICE are either nil or t.
  (let ((names (makehash))
	(erc-members-changed-hook nil)); bulk changes
    ;; fill names table
    (dolist (name (delete "" (split-string names-string)))
      (cond ((string-match "^@\\(.*\\)$" name)
	     (puthash (match-string 1 name) '(op) names))
	    ((string-match "^+\\(.*\\)$" name)
	     (puthash (match-string 1 name) '(voice) names))
	    (t
	     (puthash name nil names))))
    ;; clear all channel members, if add is nil
    (unless add
      (mapc (lambda (person)
	      (erc-remove-person-from-channel person channel))
	    (erc-get-channel-members channel)))
    ;; add all names now -- overwriting their previous modes
    (maphash (lambda (nick modes)
	       (erc-add-nick-to-channel nick channel modes erc-process))
	     names))
  (run-hooks 'erc-members-changed-hook))

(defun erc-update-member (channel nick &optional new-nick add op voice host 
				  email full-name info)
  ;; when adding new arguments, be sure to check the test at the end
  ;; before erc-members-changed-hook runs
  "Update the user info in the channel CHANNEL.
All non-nil attributes will be used to update the info we have.

The user's NICK will be changed to NEW-NICK.  If ADD is non-nil, add
the user to CHANNEL.  The other optional arguments OP, VOICE, HOST,
EMAIL and FULL-NAME change the appropriate fields.  INFO is the
additional info such as sign-on time or comments.

Note: If OP or VOICE is nil, the status does not change, so use `on'
or `off' to set the status instead of t and nil.

If the info is actually updated, return non-nil and call
`erc-channel-members-updated-hook'."
  (unless erc-process
    (error "No erc-process in %S" (current-buffer)))
  (when (string= nick new-nick)
    (setq new-nick nil));; backwards compatibility
  (let ((person (erc-person nick))
	(erc-members-changed-hook nil));; call it only once
    (erc-log (format "update-member: old %S" person))
    (when new-nick
      (setf (erc-person-nick person) new-nick)
      (remhash nick (erc-members))
      (puthash (erc-downcase new-nick) person (erc-members)))
    (if add
	(let (modes)
	  (when (eq op 'on)
	    (setq modes (cons 'op modes)))
	  (when (eq voice 'on)
	    (setq modes (cons 'voice modes)))
	  (erc-add-person-to-channel person channel modes))
      (when (erc-person-in-channel person channel)
	(when op
	  (erc-person-set-mode-in-channel person channel 'op (eq op 'on)))
	(when voice
	  (erc-person-set-mode-in-channel person channel 'op (eq voice 'on)))))
    (when host
      (setf (erc-person-host person) host))
    (when email
      (setf (erc-person-email person) email))
    (when full-name
      (setf (erc-person-full-name person) full-name))
    (when info
      (setf (erc-person-info person) info))
    (erc-log (format "update-member: new %S" person)))
  (let ((changes (or new-nick add op voice host email full-name info)))
    (when changes (run-hooks 'erc-members-changed-hook))
    changes))

(make-obsolete 'erc-update-channel-member 'erc-update-member)

(defalias 'erc-update-channel-member 'erc-update-member)

(defun erc-buffer-list-with-nick (nick &optional process)
  "Return buffers where NICK is online.
If PROCESS is nil, use `erc-process'."
  (let ((channels (erc-nick-channels nick process)))
    (erc-buffer-filter
     (lambda ()
       (member (erc-default-target) channels))
     process)))

;; FIXME: erc-format-nick and erc-format-@nick calling convention is
;; not backwards compatible -- make a note of this!  Search for other
;; calls to these functions and fix them.

(defun erc-format-nick (person)
  "Standard nickname formatting function.
Returns the nick of PERSON.
PERSON is an erc-person structure."
  (erc-person-nick person))

(defun erc-format-@nick (person)
  "Format a nickname such that @ or + are prefixed to the nick of PERSON,
if OP or VOICE are t for the current `erc-default-target' respectively.
PERSON is an erc-person structure."
  (let ((channel (erc-default-target)))
    (when channel
      (concat (if (erc-person-get-mode-in-channel person channel 'voice)
		  "+" "")
	      (if (erc-person-get-mode-in-channel person channel 'op)
		  "@" "")
	      nick))))

(defun erc-server-PRIVMSG-or-NOTICE (proc parsed)
  (let ((sspec (aref parsed 1))
	(cmd (aref parsed 0))
	(tgt (aref parsed 2))
	(msg (aref parsed 3)))
    (if (or (erc-ignored-user-p sspec)
	    (erc-ignored-reply-p msg tgt proc))
	(if erc-minibuffer-ignored
	    (message "Ignored %s from %s to %s" cmd sspec tgt))
      (let* ((sndr (erc-parse-user sspec))
	     (nick (nth 0 sndr))
	     (login (nth 1 sndr))
	     (host (nth 2 sndr))
	     (msgp (string= cmd "PRIVMSG"))
	     (noticep (string= cmd "NOTICE"))
	     ;; S.B. downcase *both* tgt and current nick
	     (privp (erc-current-nick-p tgt))
	     s buffer
	     fnick)
	(setq buffer (erc-get-buffer (if privp nick tgt) proc))
	(when buffer
	  (with-current-buffer buffer
	    ;; update the chat partner info.  Add to the list if private
	    ;; message.	 We will accumulate private identities indefinitely
	    ;; at this point.
	    (if (erc-update-channel-member (if privp nick tgt) nick nick
					   privp nil nil host login)
		(erc-update-channel-info-buffer (if privp nick tgt)))
	    (setq fnick (funcall erc-format-nick-function (erc-person nick)))))
	(cond
	 ((erc-is-message-ctcp-p msg)
	  (setq s (if msgp
		      (erc-process-ctcp-query proc parsed nick login host)
		    (erc-process-ctcp-reply proc parsed nick login host
					    (match-string 1 msg)))))
	 (t
	  (setcar last-peers nick)
	  (setq s (erc-format-privmessage (or fnick nick) msg privp msgp))))
	(when s
	  (when (and noticep privp erc-echo-notices-in-minibuffer-flag)
	    (message (concat "NOTICE: " s)))
	  (erc-display-message parsed nil buffer s))))))

(defun erc-remove-channel-member (channel nick)
  "Remove NICK from CHANNEL in PROCESS.
If PROCESS is nil, use `erc-process'."
  (erc-remove-nick-from-channel nick channel))

(make-obsolete 'erc-remove-channel-member 'erc-remove-nick-from-channel)

;; We should delete these stupid info buffers anyway.  Improve our
;; feature karma!  Or at least move them out into a module that works
;; using the erc-members-changed-hook.

(make-obsolete 'erc-update-channel-info-buffer 'ignore)

(make-obsolete 'erc-channel-member-to-user-spec 'erc-format-user)

(defun erc-format-user (person)
  "Return a user string of the form nick!user@host for person.
PERSON is an erc-person structure."
  (format "%s!%s@%s"
	  (or (erc-person-nick person) "")
	  (or (erc-person-user person) "")
	  (or (erc-person-host person) "")))

(defun erc-ignored-reply-p (message target process)
  "Send MESSAGE to TARGET in PROCESS and maybe return return non-nil.
We return non-nil, when MESSAGE is addressed to an ignored user, ie. a user
matching any regexp in `erc-ignore-reply-list'."
  (let ((target-nick (erc-message-target message)))
    (unless target-nick
      (with-erc-channel-buffer target process
	(when (erc-nick-in-channel target-nick target process)
	  (erc-list-match erc-ignore-reply-list
			  (erc-format-user
			   (erc-person target-nick process))))))))

;;; Testing

;; Use (erc-members-debug) when looking at the data structure!
;; I recommend M-x ielm for that.
;(eval-when-compile
;  (let ((p (make-erc-person :channels (makehash 'equal)))
;	(erc-process 'proc))
 ;   (erc-members-reset)
  ;  (erc-add-person-to-channel p "foo" nil)
   ; (assert (erc-person-in-channel p "foo"))
    ;(assert (not (erc-person-in-channel p "bar")))
    ;(erc-person-set-mode-in-channel p "foo" 'op t)
    ;(assert (erc-person-get-mode-in-channel p "foo" 'op))
    ;(assert (not (erc-person-get-mode-in-channel p "foo" 'voice)))
    ;(assert (not (erc-person-get-mode-in-channel p "bar" 'op)))
    ;(erc-remove-person-from-channel p "foo")
    ;(assert (not (erc-person-in-channel p "foo")))
    ;(erc-refresh-channel-members "foo" "alex fritz @andi" t)
    ;(assert (equal '(nil) (erc-nick-in-channel "alex" "foo")))
    ;(assert (equal '(op) (erc-nick-in-channel "andi" "foo")))
    ;(erc-update-member "foo" "alex" "kensanata")
    ;(assert (not (erc-nick-in-channel "alex" "foo")))
    ;(assert (erc-nick-in-channel "kensanata" "foo"))))

;; FIXME: test if erc-buffer-list-with-nick returns query buffers, too
;; FIXME: test what happens when a nick in a query buffer renames itself

(provide 'erc-members)

;;; erc-members.el ends here