User agent highlighting in gnus

[Xavier Maillard]

Hello,

Here is a (quite old now) source code for gnus that just does one thing:

highlights user-agent header according to three distinct lists of good, 
bad and unknown user-agents.

It used to work in ... 2004, I think things should still work today. 
Anyway, feel free to modify it.

(Dunno if it has ever hitted gnus folks, maybe yes :)).

Enjoy,

Xavier

;;; xm-user-agent.el --- Gnus User-Agent headers highlighting

;; Copyright (C) 2004  Xavier Maillard <address@hidden>

;; Author: Xavier Maillard <address@hidden>
;; Keywords:

;; This file 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 file 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:

;; This solely implements User-Agent headers highlighting based on an
;; original idea from ... Mutt :)
;;
;; See http://www.xs4all.nl/~matto/mutt-themes/muttrcs/guckes.muttrc
;;
;; To setup, just customize your face (M-x customize...), set the
;; `gnus-article-highlight-user-agent-alist' variable to suit your needs.
;;
;; Then you could hook the function `gnus-article-highlight-user-agent-headers'
;; to `gnus-article-prepare-hook':
;;
;; (add-hook 'gnus-article-prepare-hook 'gnus-article-user-agent-headers)
;;
;; Setting `gnus-article-autoinstall-user-agent-p' to t automatically hooks
;; things for you. You can also invoke it through normal M-x calls.

;;; Code:

;; Face definitions
(defface gnus-header-user-agent-good-face
  '((t (:background "black" :foreground "green")))
"Face to highlight a `good` user agent header.")

(defface gnus-header-user-agent-unknown-face
  '((t (:background "black" :foreground "orange" :bold t)))
"Face to highlight an `unknwnon` user agent header.")

(defface gnus-header-user-agent-bad-face
  '((t (:background "black" :foreground "red" :bold t)))
"Face to highlight a `bad` user agent header.")

;; User options
(defvar gnus-article-autoinstall-user-agent-p t
  "*When non-nil (the default), auto invoke add-hook for the user such
a way that only requiring this file, installs things rightly -i.e. it
just works.")

(defvar gnus-article-highlight-user-agent-p t
  "*When non-nil, use special highligthing to differenciate User-Agent
in the article buffer.")

(defvar gnus-article-highlight-user-agent-alist
  '(("Mutt\\|Gnus" gnus-header-name-face gnus-header-user-agent-unknown-face))
  "List of User-agent and the corresponding faces to apply.
Face is initialized with unknown face properties.")

;; Misc functions
(defun gnus-article-toggle-user-agent-highlight ()
  "Toggle User-Agent headers highlighting."
  (interactive)
  (gnus-message 10 "")
  (setq gnus-article-highlight-user-agent-p
        (not gnus-article-highlight-user-agent-p)))

;; Here is the function
;; This one is by lawrence on #emacs
;; I developped my own based on gnus-article-highlight headers but this one is 
shorter
;; so I prefer to use this one :)

;; Note there was a bug. re-search-forward was done from point to end of buffer.
;; Fixed that problem
(defun gnus-article-highlight-user-agent-headers ()
  "Highlight article User-Agent headers as specified by
`gnus-article-highlight-user-agent-alist' variable."
  (interactive)
  (when gnus-article-highlight-user-agent-p
    (with-current-buffer gnus-article-buffer
      (let ((buffer-read-only nil))
        (save-restriction
          (article-narrow-to-head)
          (goto-char (point-min))
          (dolist (entry gnus-article-highlight-user-agent-alist)
            (dolist (header '("X-Mailer" "Newsreader" "User-Agent" 
"X-Newsreader"))
              (save-excursion
                (while (re-search-forward (concat "^" header) nil t)
                  (gnus-put-text-property (match-beginning 0)
                                          (match-end 0)
                                          'face (nth 1 entry))
                  (when (re-search-forward (concat ": \\(" (nth 0 entry) 
"\\).*$") nil t)
                    (goto-char (match-beginning 0))
                    (forward-char 1)
                    (gnus-put-text-property (point) ;;(match-beginning 0)
                                            (point-at-eol)
                                            'face (nth 2 entry))))))))))))

(when gnus-article-highlight-user-agent-p
  (add-hook 'gnus-article-prepare-hook 
'gnus-article-highlight-user-agent-headers))


(provide 'xm-user-agent)
;;; xm-user-agent.el ends here