Process HTMLish XMPP messages

gistfile1.el

(require 'cl)
(require 'xml)
(defun jabber-body-printer-with-xml (xml-data who mode)
  "Prints XMPP message bodies, linkifying <a> elements.

See `jabber-chat-normal-body'. Requires Emacs 24.1 with LibXML2 support."
  (if (eq mode :insert)
      (let ((beginning (point)))
        (jabber-chat-normal-body xml-data who mode)
        (save-restriction
          (narrow-to-region beginning (point))
          (let ((xml (let ((string (buffer-string)))
                       (with-temp-buffer
                         (insert "<a>" string "</a>")
                         (let ((xml (libxml-parse-xml-region (point-min) (point-max))))
                           (and xml (xml-node-children xml)))))))
            (when xml
              (delete-region (point-min) (point-max))
              ;; This might need to be letrec if you have lexical scoping
              (labels ((insert-node (child)
                         (etypecase child
                           (string (insert child))
                           (list
                            (case (xml-node-name child)
                              (a (make-text-button (prog1 (point)
                                                     (mapc #'insert-node (xml-node-children child)))
                                                   (point)
                                                   'follow-link 'mouse-face
                                                   'action (lambda (button)
                                                             (browse-url (button-get button 'url)))
                                                   'url (xml-get-attribute child 'href)))
                              (p (mapc #'insert-node (xml-node-children child)))
                              (br (terpri (current-buffer)))
                              (otherwise (xml-debug-print (list child))))))))
                (mapc #'insert-node xml))))
          (goto-char (point-max))))
    (jabber-chat-normal-body xml-data who mode)))
(remove-hook 'jabber-body-printers #'jabber-chat-normal-body)
(add-hook 'jabber-body-printers #'jabber-body-printer-with-xml t)