emacs jabber blacklist by komintern (linux.org.ru)

komintern@komintern:~$ cat ~/elbl.el
(defvar *jabber-blacklist* nil)

(defun jabber-add-to-blacklist (&optional jid)
  (interactive)
  (when (not jid)
    (setf jid (read-string "JID: " nil nil jid)))
  (when (not (jabber-check-blacklist jid))
  (setf *jabber-blacklist* (concatenate 'string jid " " *jabber-blacklist*))
  (message "%s added to jabber blacklist" jid)
  (jabber-save-blacklist)))

(defun get-string-from-file (filePath)
  (with-temp-buffer
    (insert-file-contents filePath)
    (buffer-string)))

(defun write-string-to-file (string file)
  (with-temp-buffer
    (insert string)
    (when (file-writable-p file)
      (write-region (point-min)
            (point-max)
            file))))

(defun jabber-load-blacklist ()
  (interactive)
  (setf *jabber-blacklist*
    (get-string-from-file "~/.emacs-jabber-blacklist")))

(defun jabber-save-blacklist ()
  (interactive)
  (write-string-to-file *jabber-blacklist* "~/.emacs-jabber-blacklist"))

(defun jabber-check-blacklist (&optional from)
  (interactive)
  (when (not from)
    (setf from (read-string "JID: " nil nil from)))
  (when *jabber-blacklist*
  (if (member* from (split-string *jabber-blacklist*) :test 'string=)
    t nil)))

(defun jabber-process-chat (jc xml-data)
  "If XML-DATA is a one-to-one chat message, handle it as such."
  (when (not (jabber-muc-message-p xml-data))
    (let ((from (jabber-xml-get-attribute xml-data 'from))
      (error-p (jabber-xml-get-children xml-data 'error))
      (body-text (car (jabber-xml-node-children
               (car (jabber-xml-get-children
                 xml-data 'body))))))
      (if (not (jabber-check-blacklist from))
      (progn
        (when (or error-p
              (run-hook-with-args-until-success 'jabber-chat-printers xml-data :foreign :printp))
          (with-current-buffer (if (jabber-muc-sender-p from)
                       (jabber-muc-private-create-buffer
                    jc
                    (jabber-jid-user from)
                    (jabber-jid-resource from))
                     (jabber-chat-create-buffer jc from))
        (let ((node
               (ewoc-enter-last jabber-chat-ewoc (list (if error-p :error :foreign) xml-data :time (current-time)))))
          (jabber-maybe-print-rare-time node))

        (dolist (hook '(jabber-message-hooks jabber-alert-message-hooks))
          (run-hook-with-args hook
                      from (current-buffer) body-text
                      (funcall jabber-alert-message-function
                           from (current-buffer) body-text))))))
    (message "Message from %s blacklisted" from)))))

(if (file-exists-p "~/.emacs-jabber-blacklist")
    (jabber-load-blacklist))

(defun jabber-add-to-blacklist-jid-at-point ()
  (interactive)
  (jabber-add-to-blacklist (get-text-property (point) 'jabber-jid)))

(defun jabber-remove-from-blacklist (&optional jid)
  (interactive)
  (when (not jid)
    (setf jid (read-string "JID: " nil nil jid)))
  (when (jabber-check-blacklist jid)
    (setf *jabber-blacklist* (mapconcat 'identity (delete jid (split-string *jabber-blacklist*)) " "))
    (message "%s removed from jabber blacklist" jid)
    (jabber-save-blacklist)))

(defun jabber-remove-from-blacklist-jid-at-point ()
  (interactive)
  (jabber-remove-from-blacklist (get-text-property (point) 'jabber-jid)))