summary decode hook

[Shenghuo ZHU <zsh@cs.rochester.edu>]

The hook, gnus-article-decode-hook, has been added to PGNUS. I think
gnus-summary-decode-hook, nnheader-decode-hook, or something like this
should also be added, so that customized decoding functions can be
added to decode headers in summary buffer. Any thought?

I'd like the hook is called with arguments of header and group-name.

I get this thought when I was working on gnus native RFC1843 decoding.

RFC 1843 is "HZ - A Data Format for Exchanging Files of Arbitrarily
Mixed Chinese and ASCII characters" , which is wildly used in
newsgroups of alt.chinese.text . The encoded text looks like this:
~{<:Ky2;S{#,NpJ)l6HK!#~}

There is a charset chinese-hz in MULE, but think about using GNUS
without MULE.

What I have done is adding a function to gnus-article-decode-hook and
assigning another function to gnus-alter-header-function.

The file, rfc1843.el, is attatched. Any suggestion?

-- 
Shenghuo

---------------------------------------------------------------------
;;; rfc1843.el --- HZ (rfc1843) decoding
;;; Copyright (c) 1998 by Shenghuo Zhu <zsh@cs.rochester.edu>

;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: news HZ 

;;;
;;; This file is not part of GNU Emacs, but the same permissions apply.
;;;
;;; GNU Emacs 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.
;;;
;;; GNU Emacs 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:

;; Usage: 
;; Add 
;;      (require 'rfc1843)
;; to .gnus
;; 
;; Test:
;; 1. 
;; (rfc1843-decode-string  "GB.~{<:Ky2;S{#,NpJ)l6HK!#~}Bye.")
;; 
;; 2. 
;; (require 'rfc1843)
;; (setq rfc1843-newsgroups-regexp "$")  ;; decode any newsgroup

;;; Code:
(require 'mm-util)

(defvar rfc1843-word-regexp 
  "~{\\(\\([\041-\167][\041-\176]\\| \\)+\\)\\(~}\\|$\\)")
(defvar rfc1843-word-regexp-strict 
  "~{\\([\041-\167][\041-\176]\\)+~}")

(defcustom rfc1843-decode-loosely nil
  "Loosely check HZ encoding
When it is set non-nil, only buffers or strings with strictly 
HZ-encoded are decoded"
  :type 'boolean
  :group 'gnus-article-mime)

(defcustom rfc1843-newsgroups-regexp "chinese"
  "Regexp of newsgroups in which might be HZ encoded"
  :type 'string
  :group 'gnus-article-mime)

(defun rfc1843-decode-region (from to)
  "Decode HZ in the region between FROM and TO."
  (interactive "r")
  (save-excursion
    (goto-char from)
    (if (or rfc1843-decode-loosely 
	    (re-search-forward rfc1843-word-regexp-strict to t))
	(save-restriction 
	  (narrow-to-region from to)
	  (goto-char (point-min))
	  (while (re-search-forward rfc1843-word-regexp (point-max) t)  
	    (insert (mm-decode-coding-string 
		     (rfc1843-decode
		      (prog1 
			  (buffer-substring (match-beginning 1) (match-end 1))
			(delete-region (match-beginning 0) (match-end 0))))
		     'cn-gb-2312)))
	  (goto-char (point-min))
	  (while (search-forward "~" (point-max) t)  
	    (cond ((eq (following-char) ?\n)
		 (delete-char -1)
		 (delete-char 1))
		  ((eq (following-char) ?~)
		   (delete-char 1))))))))

(defun rfc1843-decode-string (string)
  "Decode HZ STRING and return the results."
  (let ((m (mm-multibyte-p)))
    (with-temp-buffer
      (when m
	(mm-enable-multibyte))
      (insert string)
      (inline
	(rfc1843-decode-region (point-min) (point-max)))
      (buffer-string))))

(defun rfc1843-decode (word)
  "Decode HZ WORD and return it"
  (let ((i -1) (s (substring word 0)) v)
    (while (< (incf i) (length s))
      (setq v (aref s i))
      (aset s i  (if (eq v ? ) v (+ 128 v))))
    s))

(defun rfc1843-gnus-article-decode ()
  "Decode HZ encoded text in the article."
  (if (string-match rfc1843-newsgroups-regexp gnus-newsgroup-name)
      (save-excursion
	(set-buffer gnus-article-buffer)
	(rfc1843-decode-region (point-min) (point-max)))))

;(defun rfc1843-newsgroup-prepare ()
;  "Add HZ decoding if the newsgroup matchs `rfc1843-newsgroups-regexp'"
;  (when (string-match rfc1843-newsgroups-regexp gnus-newsgroup-name)
;    (make-local-variable 'rfc1843-old-gnus-alter-header-function)
;    (make-local-variable 'gnus-alter-header-function)
;)

(defun rfc1843-gnus-header-decode (header)
  "Decode HZ encoded text in the header."
  (if rfc1843-old-gnus-alter-header-function 
      (funcall rfc1843-old-gnus-alter-header-function header))
  (aset header 1  (rfc1843-decode-string (aref header 1))) ; subject
  (aset header 2  (rfc1843-decode-string (aref header 2))) ; from
)

(require 'gnus-art)
(add-hook 'gnus-article-decode-hook 'rfc1843-gnus-article-decode t)

(require 'gnus-sum)
(defvar rfc1843-old-gnus-alter-header-function gnus-alter-header-function)
(setq gnus-alter-header-function 'rfc1843-gnus-header-decode)

(provide 'rfc1843)