Source

erc / erc-macs.el

;;; erc-macs.el --- Macros

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

;; Author: Mario Lang <mlang@delysid.org>
;; Keywords: erc, macro, hash-table

;;; ERC victims

; Rationale: `channel-members' is a quick hack, but inefficient
; if it comes to large channels, or simultaneous connections
; with alot of people in the channels.  JOIN and PART are very
; inefficient then using the current method, and QUIT is even worse!
;
; In such cases, one is supposed to use hashtables.  That is what
; we try to define here, a solid framework for erc-victim handling, channel-local
; and server-global.  Please test this stuff, and extend it, if it works
; we will just rip out channel-members completely, and replace it with
; this new, very fast scheme!


(require 'erc)

;; Define a hash-table equality operation for irc-nick:
(define-hash-table-test 'nickeq
  #'(lambda (x y) (string-equal (erc-downcase x) (erc-downcase y)))
  #'(lambda  (x)  (sxhash (erc-downcase x))))

(defvar erc-victims (make-hash-table :test 'nickeq)
  "Hash-table of all known nick names on this server.")
(make-variable-buffer-local 'erc-victims)

(defvar erc-channel-victims (make-hash-table :test 'nickeq)
  "Hash-table of all known nick names on this channel.
Values are (OP VOICE) where OP and VOICE are boolean flags.")
(make-variable-buffer-local 'erc-channel-victims)

(defmacro erc-victim (nick)
  "Access NICK.
If NICK is not in the hash-table, create it."
  (let ((sym (gensym)))
    `(let ((,sym (gethash ,nick erc-victims)))
       (if (consp ,sym) ,sym
	 (puthash ,nick (list nil nil nil nil nil) erc-victims)))))

(defmacro erc-channel-victim (nick)
  "Access NICK in the current channel buffer."
  `(gethash ,nick erc-channel-victims))

(defmacro define-victim-slot (name position type)
  `(defmacro ,(intern (concat "erc-victim-" (symbol-name name))) (nick)
     (list 'nth ,position
	   (list ',type nick))))
(defmacro define-victim-slots (type &rest args)
  `(progn
     ,@(let ((num -1))
	 (mapcar (lambda (name)
		   (incf num)
		   `(define-victim-slot ,name ,num ,type))
		 args))))

(define-victim-slots erc-victim
  host login full-name info buffers)
(define-victim-slots erc-channel-victim
  op voice)

;; Some illustration how it could work.

(defun erc-victim-join (nick channel)
  (let ((buf (erc-get-buffer channel)))
    (with-current-buffer buf
      (setf (erc-channel-victim nick) (list nil nil)))
    (setf (erc-victim-buffers nick)
	  (remove-duplicates (cons buf (erc-victim-buffers nick))))))

(defun erc-victim-part (nick buffer)
  (with-current-buffer buffer (remhash nick erc-channel-victims))
  (setf (erc-victim-buffers nick)
	(remove buffer (erc-victim-buffers nick))))

(defun erc-victim-quit (nick)
  (mapc (lambda (buf)
	  (with-current-buffer buf
	    (remhash nick erc-channel-victims)))
	(erc-victim-buffers nick))
  (remhash nick erc-victims))

(defun map-channel-victims (func)
  (maphash (lambda (nick flags)
	     (with-current-buffer (erc-server-buffer)
	       (apply func nick (append flags (erc-victim nick)))))
	   erc-channel-victims))

(erc-channel-victim "delYsid")

(setf (erc-victim-op "delYsid") t)
;; Some introspection

(macroexpand '(erc-victim-host "delysid"))
(macroexpand '(erc-victim "delysid"))
(get-setf-method '(erc-victim-host "delysid"))
(cl-setf-do-modify '(erc-victim-host "delysid") t)