*** pub/pgnus/lisp/drums.el	Fri Sep 11 08:08:31 1998
--- pgnus/lisp/drums.el	Sat Sep 12 09:15:34 1998
***************
*** 62,68 ****
--- 62,70 ----
      (modify-syntax-entry ?@ "w" table)
      (modify-syntax-entry ?/ "w" table)
      (modify-syntax-entry ?= " " table)
+     (modify-syntax-entry ?* " " table)
      (modify-syntax-entry ?\; " " table)
+     (modify-syntax-entry ?\' " " table)
      table))
  
  (defun drums-token-to-list (token)
***************
*** 215,273 ****
    "Return an Emacs time spec from STRING."
    (apply 'encode-time (parse-time-string string)))
  
- (defun drums-content-type-get (ct attribute)
-   "Return the value of ATTRIBUTE from CT."
-   (cdr (assq attribute (cdr ct))))
- 
- (defun drums-parse-content-type (string)
-   "Parse STRING and return a list."
-   (with-temp-buffer
-     (let ((ttoken (drums-token-to-list drums-text-token))
- 	  (stoken (drums-token-to-list drums-tspecials))
- 	  display-name mailbox c display-string parameters
- 	  attribute value type subtype)
-       (drums-init (drums-remove-whitespace (drums-remove-comments string)))
-       (setq c (following-char))
-       (when (and (memq c ttoken)
- 		 (not (memq c stoken)))
- 	(setq type (downcase (buffer-substring
- 			      (point) (progn (forward-sexp 1) (point)))))
- 	;; Do the params
- 	(while (not (eobp))
- 	  (setq c (following-char))
- 	  (unless (eq c ?\;)
- 	    (error "Invalid header: %s" string))
- 	  (forward-char 1)
- 	  (setq c (following-char))
- 	  (if (and (memq c ttoken)
- 		   (not (memq c stoken)))
- 	      (setq attribute
- 		    (intern
- 		     (downcase
- 		      (buffer-substring
- 		       (point) (progn (forward-sexp 1) (point))))))
- 	    (error "Invalid header: %s" string))
- 	  (setq c (following-char))
- 	  (unless (eq c ?=)
- 	    (error "Invalid header: %s" string))
- 	  (forward-char 1)
- 	  (setq c (following-char))
- 	  (cond
- 	   ((eq c ?\")
- 	    (setq value
- 		  (buffer-substring (1+ (point))
- 				    (progn (forward-sexp 1) (1- (point))))))
- 	   ((and (memq c ttoken)
- 		 (not (memq c stoken)))
- 	    (setq value (buffer-substring
- 			 (point) (progn (forward-sexp 1) (point)))))
- 	   (t
- 	    (error "Invalid header: %s" string)))
- 	  (push (cons attribute value) parameters))
- 	`(,type ,@(nreverse parameters))))))
- 
  (defun drums-narrow-to-header ()
!   "Narrow to the header of the current buffer."
    (narrow-to-region
     (goto-char (point-min))
     (if (search-forward "\n\n" nil 1)
--- 217,224 ----
    "Return an Emacs time spec from STRING."
    (apply 'encode-time (parse-time-string string)))
  
  (defun drums-narrow-to-header ()
!   "Narrow to the header section in the current buffer."
    (narrow-to-region
     (goto-char (point-min))
     (if (search-forward "\n\n" nil 1)
*** pub/pgnus/lisp/gnus-art.el	Fri Sep 11 18:21:51 1998
--- pgnus/lisp/gnus-art.el	Sat Sep 12 09:15:35 1998
***************
*** 34,40 ****
  (require 'gnus-int)
  (require 'browse-url)
  (require 'mm-bodies)
! (require 'drums)
  (require 'mm-decode)
  (require 'mm-view)
  
--- 34,40 ----
  (require 'gnus-int)
  (require 'browse-url)
  (require 'mm-bodies)
! (require 'mail-parse)
  (require 'mm-decode)
  (require 'mm-view)
  
***************
*** 532,538 ****
  			       (face :value default)))))
  
  (defcustom gnus-article-decode-hook
!   '(article-decode-charset article-decode-rfc1522)
    "*Hook run to decode charsets in articles."
    :group 'gnus-article-headers
    :type 'hook)
--- 532,538 ----
  			       (face :value default)))))
  
  (defcustom gnus-article-decode-hook
!   '(article-decode-charset article-decode-encoded-words)
    "*Hook run to decode charsets in articles."
    :group 'gnus-article-headers
    :type 'hook)
***************
*** 951,957 ****
      (set-buffer gnus-article-buffer)
      (let ((inhibit-point-motion-hooks t)
  	  buffer-read-only)
!       (rfc2047-decode-region (point-min) (point-max)))))
  
  (defun article-decode-charset (&optional prompt)
    "Decode charset-encoded text in the article.
--- 951,957 ----
      (set-buffer gnus-article-buffer)
      (let ((inhibit-point-motion-hooks t)
  	  buffer-read-only)
!       (mail-decode-encoded-word-region (point-min) (point-max)))))
  
  (defun article-decode-charset (&optional prompt)
    "Decode charset-encoded text in the article.
***************
*** 963,975 ****
        (let* ((inhibit-point-motion-hooks t)
  	     (ct (message-fetch-field "Content-Type" t))
  	     (cte (message-fetch-field "Content-Transfer-Encoding" t))
! 	     (ctl (and ct (condition-case () (drums-parse-content-type ct)
  			    (error nil))))
  	     (charset (cond
  		       (prompt
  			(mm-read-coding-system "Charset to decode: "))
  		       (ctl
! 			(drums-content-type-get ctl 'charset))
  		       (gnus-newsgroup-name
  			(gnus-group-find-parameter
  			 gnus-newsgroup-name 'charset))))
--- 963,976 ----
        (let* ((inhibit-point-motion-hooks t)
  	     (ct (message-fetch-field "Content-Type" t))
  	     (cte (message-fetch-field "Content-Transfer-Encoding" t))
! 	     (ctl (and ct (condition-case ()
! 			      (mail-header-parse-content-type ct)
  			    (error nil))))
  	     (charset (cond
  		       (prompt
  			(mm-read-coding-system "Charset to decode: "))
  		       (ctl
! 			(mail-content-type-get ctl 'charset))
  		       (gnus-newsgroup-name
  			(gnus-group-find-parameter
  			 gnus-newsgroup-name 'charset))))
***************
*** 983,997 ****
  	   charset (and cte (intern (downcase
  				     (gnus-strip-whitespace cte))))))))))
  
! (defalias 'gnus-decode-rfc1522 'article-decode-rfc1522)
! (defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522)
! (defun article-decode-rfc1522 ()
!   "Remove QP encoding from headers."
    (let ((inhibit-point-motion-hooks t)
  	(buffer-read-only nil))
      (save-restriction
        (message-narrow-to-head)
!       (rfc2047-decode-region (point-min) (point-max)))))
  
  (defun article-de-quoted-unreadable (&optional force)
    "Translate a quoted-printable-encoded article.
--- 984,996 ----
  	   charset (and cte (intern (downcase
  				     (gnus-strip-whitespace cte))))))))))
  
! (defun article-decode-encoded-words ()
!   "Remove encoded-word encoding from headers."
    (let ((inhibit-point-motion-hooks t)
  	(buffer-read-only nil))
      (save-restriction
        (message-narrow-to-head)
!       (mail-decode-encoded-word-region (point-min) (point-max)))))
  
  (defun article-de-quoted-unreadable (&optional force)
    "Translate a quoted-printable-encoded article.
***************
*** 1001,1007 ****
    (save-excursion
      (let ((buffer-read-only nil)
  	  (type (gnus-fetch-field "content-transfer-encoding")))
-       ;;(gnus-article-decode-rfc1522)
        (when (or force
  		(and type (string-match "quoted-printable" (downcase type))))
  	(goto-char (point-min))
--- 1000,1005 ----
***************
*** 1110,1116 ****
        (goto-char (point-min))
        (search-forward "\n\n" nil t)
        (while (re-search-forward "^[ \t]+$" nil t)
! 	(replace-match "" nil t))
        ;; Then replace multiple empty lines with a single empty line.
        (goto-char (point-min))
        (search-forward "\n\n" nil t)
--- 1108,1116 ----
        (goto-char (point-min))
        (search-forward "\n\n" nil t)
        (while (re-search-forward "^[ \t]+$" nil t)
! 	(unless (gnus-annotation-in-region-p
! 		 (match-beginning 0) (match-end 0))
! 	  (replace-match "" nil t)))
        ;; Then replace multiple empty lines with a single empty line.
        (goto-char (point-min))
        (search-forward "\n\n" nil t)
***************
*** 1852,1857 ****
--- 1852,1859 ----
       article-date-original
       article-date-ut
       article-decode-mime-words
+      article-decode-charset
+      article-decode-encoded-words
       article-date-user
       article-date-lapsed
       article-emphasize
***************
*** 2130,2143 ****
  ;;; Gnus MIME viewing functions
  ;;;
  
! (defvar gnus-mime-button-line-format "%{%([%t%n]%)%}\n")
  (defvar gnus-mime-button-line-format-alist
    '((?t gnus-tmp-type ?s)
!     (?n gnus-tmp-name ?s)))
  
  (defvar gnus-mime-button-map nil)
  (unless gnus-mime-button-map
!   (setq gnus-mime-button-map (make-sparse-keymap))
    (define-key gnus-mime-button-map gnus-mouse-2 'gnus-article-push-button)
    (define-key gnus-mime-button-map "\r" 'gnus-article-press-button)
    (define-key gnus-mime-button-map "\M-\r" 'gnus-mime-view-part)
--- 2132,2146 ----
  ;;; Gnus MIME viewing functions
  ;;;
  
! (defvar gnus-mime-button-line-format "%{%([%t%d%n]%)%}\n")
  (defvar gnus-mime-button-line-format-alist
    '((?t gnus-tmp-type ?s)
!     (?n gnus-tmp-name ?s)
!     (?d gnus-tmp-description ?s)))
  
  (defvar gnus-mime-button-map nil)
  (unless gnus-mime-button-map
!   (setq gnus-mime-button-map (copy-keymap gnus-article-mode-map))
    (define-key gnus-mime-button-map gnus-mouse-2 'gnus-article-push-button)
    (define-key gnus-mime-button-map "\r" 'gnus-article-press-button)
    (define-key gnus-mime-button-map "\M-\r" 'gnus-mime-view-part)
***************
*** 2174,2185 ****
      (goto-char (point-min))))
  
  (defun gnus-insert-mime-button (handle)
!   (let ((gnus-tmp-name (drums-content-type-get (cadr handle) 'name))
! 	(gnus-tmp-type (caadr handle)))
      (setq gnus-tmp-name
        (if gnus-tmp-name
  	  (concat " (" gnus-tmp-name ")")
  	""))
      (gnus-eval-format
       gnus-mime-button-line-format gnus-mime-button-line-format-alist
       `(local-map ,gnus-mime-button-map
--- 2177,2193 ----
      (goto-char (point-min))))
  
  (defun gnus-insert-mime-button (handle)
!   (let ((gnus-tmp-name (mail-content-type-get (mm-handle-type handle) 'name))
! 	(gnus-tmp-type (car (mm-handle-type handle)))
! 	(gnus-tmp-description (mm-handle-description handle)))
      (setq gnus-tmp-name
        (if gnus-tmp-name
  	  (concat " (" gnus-tmp-name ")")
  	""))
+     (setq gnus-tmp-description
+       (if gnus-tmp-description
+ 	  (concat " (" gnus-tmp-description ")")
+ 	""))
      (gnus-eval-format
       gnus-mime-button-line-format gnus-mime-button-line-format-alist
       `(local-map ,gnus-mime-button-map
***************
*** 2191,2199 ****
    "Insert MIME buttons in the buffer."
    (let (ct ctl)
      (save-restriction
!       (drums-narrow-to-header)
        (when (setq ct (mail-fetch-field "content-type"))
! 	(setq ctl (drums-parse-content-type ct))))
      (let* ((handles (mm-dissect-buffer))
  	   handle name type b e)
        (mapcar 'mm-destroy-part gnus-article-mime-handles)
--- 2199,2207 ----
    "Insert MIME buttons in the buffer."
    (let (ct ctl)
      (save-restriction
!       (mail-narrow-to-head)
        (when (setq ct (mail-fetch-field "content-type"))
! 	(setq ctl (mail-header-parse-content-type ct))))
      (let* ((handles (mm-dissect-buffer))
  	   handle name type b e)
        (mapcar 'mm-destroy-part gnus-article-mime-handles)
***************
*** 2206,2212 ****
  	    (while (setq handle (pop handles))
  	      (gnus-insert-mime-button handle)
  	      (insert "\n\n")
! 	      (when (mm-automatic-display-p (caadr handle))
  		(forward-line -2)
  		(mm-display-part handle)
  		(goto-char (point-max))))
--- 2214,2223 ----
  	    (while (setq handle (pop handles))
  	      (gnus-insert-mime-button handle)
  	      (insert "\n\n")
! 	      (when (and (mm-automatic-display-p (car (mm-handle-type handle)))
! 			 (or (not (mm-handle-disposition handle))
! 			     (equal (car (mm-handle-disposition handle))
! 				    "inline")))
  		(forward-line -2)
  		(mm-display-part handle)
  		(goto-char (point-max))))
***************
*** 2228,2241 ****
         (progn
  	 (insert (format "[%c] %-18s"
  			 (if (equal handle preferred) ?* ? )
! 			 (caadr handle)))
  	 (point))
         `(local-map ,gnus-mime-button-map
  		   keymap ,gnus-mime-button-map
  		   gnus-callback
  		   (lambda (handles)
  		     (gnus-mime-display-alternative
! 		      ',ihandles ,(caadr handle)))
  		   gnus-data ,handle))
        (insert "  "))
      (insert "\n\n")
--- 2239,2252 ----
         (progn
  	 (insert (format "[%c] %-18s"
  			 (if (equal handle preferred) ?* ? )
! 			 (car (mm-handle-type handle))))
  	 (point))
         `(local-map ,gnus-mime-button-map
  		   keymap ,gnus-mime-button-map
  		   gnus-callback
  		   (lambda (handles)
  		     (gnus-mime-display-alternative
! 		      ',ihandles ,(car (mm-handle-type handle))))
  		   gnus-data ,handle))
        (insert "  "))
      (insert "\n\n")
*** pub/pgnus/lisp/gnus-int.el	Fri Sep 11 12:31:15 1998
--- pgnus/lisp/gnus-int.el	Sat Sep 12 09:15:35 1998
***************
*** 437,444 ****
      (insert "\n"))
    (unless no-encode
      (save-restriction
!       (message-narrow-to-headers)
!       (rfc2047-encode-message-header))
      (message-encode-message-body))
    (let ((func (car (or gnus-command-method
  		       (gnus-find-method-for-group group)))))
--- 437,444 ----
      (insert "\n"))
    (unless no-encode
      (save-restriction
!       (message-narrow-to-head)
!       (mail-encode-encoded-word-buffer))
      (message-encode-message-body))
    (let ((func (car (or gnus-command-method
  		       (gnus-find-method-for-group group)))))
***************
*** 450,456 ****
  (defun gnus-request-replace-article (article group buffer)
    (save-restriction
      (message-narrow-to-headers)
!     (rfc2047-encode-message-header))
    (message-encode-message-body)
    (let ((func (car (gnus-group-name-to-method group))))
      (funcall (intern (format "%s-request-replace-article" func))
--- 450,456 ----
  (defun gnus-request-replace-article (article group buffer)
    (save-restriction
      (message-narrow-to-headers)
!     (mail-encode-encoded-word-buffer))
    (message-encode-message-body)
    (let ((func (car (gnus-group-name-to-method group))))
      (funcall (intern (format "%s-request-replace-article" func))
*** pub/pgnus/lisp/gnus-msg.el	Thu Sep 10 04:01:51 1998
--- pgnus/lisp/gnus-msg.el	Sat Sep 12 09:15:35 1998
***************
*** 399,405 ****
  			 (or (search-forward "\n\n" nil t) (point)))
  	  ;; Insert the original article headers.
  	  (insert-buffer-substring gnus-original-article-buffer beg end)
! 	  (gnus-article-decode-rfc1522)))
        gnus-article-copy)))
  
  (defun gnus-post-news (post &optional group header article-buffer yank subject
--- 399,405 ----
  			 (or (search-forward "\n\n" nil t) (point)))
  	  ;; Insert the original article headers.
  	  (insert-buffer-substring gnus-original-article-buffer beg end)
! 	  (gnus-article-decode-encoded-words)))
        gnus-article-copy)))
  
  (defun gnus-post-news (post &optional group header article-buffer yank subject
*** pub/pgnus/lisp/gnus-sum.el	Fri Sep 11 12:31:16 1998
--- pgnus/lisp/gnus-sum.el	Sat Sep 12 09:15:36 1998
***************
*** 3052,3059 ****
  	  (setq header
  		(make-full-mail-header
  		 number			; number
! 		 (rfc2047-decode-string (gnus-nov-field)) ; subject
! 		 (rfc2047-decode-string (gnus-nov-field)) ; from
  		 (gnus-nov-field)	; date
  		 (or (gnus-nov-field)
  		     (nnheader-generate-fake-message-id)) ; id
--- 3052,3059 ----
  	  (setq header
  		(make-full-mail-header
  		 number			; number
! 		 (mail-decode-encoded-word-string (gnus-nov-field)) ; subject
! 		 (mail-decode-encoded-word-string (gnus-nov-field)) ; from
  		 (gnus-nov-field)	; date
  		 (or (gnus-nov-field)
  		     (nnheader-generate-fake-message-id)) ; id
***************
*** 4396,4408 ****
  	    (progn
  	      (goto-char p)
  	      (if (search-forward "\nsubject: " nil t)
! 		  (rfc2047-decode-string (nnheader-header-value))
  		"(none)"))
  	    ;; From.
  	    (progn
  	      (goto-char p)
  	      (if (search-forward "\nfrom: " nil t)
! 		  (rfc2047-decode-string (nnheader-header-value))
  		"(nobody)"))
  	    ;; Date.
  	    (progn
--- 4396,4408 ----
  	    (progn
  	      (goto-char p)
  	      (if (search-forward "\nsubject: " nil t)
! 		  (mail-decode-encoded-word-string (nnheader-header-value))
  		"(none)"))
  	    ;; From.
  	    (progn
  	      (goto-char p)
  	      (if (search-forward "\nfrom: " nil t)
! 		  (mail-decode-encoded-word-string (nnheader-header-value))
  		"(nobody)"))
  	    ;; Date.
  	    (progn
*** pub/pgnus/lisp/gnus.el	Fri Sep 11 18:21:51 1998
--- pgnus/lisp/gnus.el	Sat Sep 12 09:15:36 1998
***************
*** 250,256 ****
    :link '(custom-manual "(gnus)Exiting Gnus")
    :group 'gnus)
  
! (defconst gnus-version-number "0.27"
    "Version number for this version of Gnus.")
  
  (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
--- 250,256 ----
    :link '(custom-manual "(gnus)Exiting Gnus")
    :group 'gnus)
  
! (defconst gnus-version-number "0.28"
    "Version number for this version of Gnus.")
  
  (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
***************
*** 1570,1576 ****
       ("info" Info-goto-node)
       ("pp" pp pp-to-string pp-eval-expression)
       ("qp" quoted-printable-decode-region quoted-printable-decode-string)
-      ("rfc2047" rfc2047-decode-region rfc2047-decode-string)
       ("ps-print" ps-print-preprint)
       ("mail-extr" mail-extract-address-components)
       ("browse-url" browse-url)
--- 1570,1575 ----
***************
*** 1689,1695 ****
        gnus-article-next-page gnus-article-prev-page
        gnus-request-article-this-buffer gnus-article-mode
        gnus-article-setup-buffer gnus-narrow-to-page
!       gnus-article-delete-invisible-text gnus-hack-decode-rfc1522)
       ("gnus-art" :interactive t
        gnus-article-hide-headers gnus-article-hide-boring-headers
        gnus-article-treat-overstrike gnus-article-word-wrap
--- 1688,1694 ----
        gnus-article-next-page gnus-article-prev-page
        gnus-request-article-this-buffer gnus-article-mode
        gnus-article-setup-buffer gnus-narrow-to-page
!       gnus-article-delete-invisible-text)
       ("gnus-art" :interactive t
        gnus-article-hide-headers gnus-article-hide-boring-headers
        gnus-article-treat-overstrike gnus-article-word-wrap
***************
*** 1701,1707 ****
        gnus-article-date-original gnus-article-date-lapsed
        gnus-article-show-all-headers
        gnus-article-edit-mode gnus-article-edit-article
!       gnus-article-edit-done gnus-decode-rfc1522 article-decode-rfc1522
        gnus-start-date-timer gnus-stop-date-timer)
       ("gnus-int" gnus-request-type)
       ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1
--- 1700,1706 ----
        gnus-article-date-original gnus-article-date-lapsed
        gnus-article-show-all-headers
        gnus-article-edit-mode gnus-article-edit-article
!       gnus-article-edit-done gnus-article-decode-encoded-words
        gnus-start-date-timer gnus-stop-date-timer)
       ("gnus-int" gnus-request-type)
       ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1
*** pub/pgnus/lisp/lpath.el	Fri Sep 11 18:21:51 1998
--- pgnus/lisp/lpath.el	Sat Sep 12 09:15:36 1998
***************
*** 36,42 ****
  		     mule-write-region-no-coding-system
  		     find-charset-region base64-decode-string
  		     find-coding-systems-region get-charset-property
! 		     coding-system-get))
        (maybe-bind '(global-face-data
  		    mark-active transient-mark-mode mouse-selection-click-count
  		    mouse-selection-click-count-buffer buffer-display-table
--- 36,42 ----
  		     mule-write-region-no-coding-system
  		     find-charset-region base64-decode-string
  		     find-coding-systems-region get-charset-property
! 		     coding-system-get w3-region))
        (maybe-bind '(global-face-data
  		    mark-active transient-mark-mode mouse-selection-click-count
  		    mouse-selection-click-count-buffer buffer-display-table
***************
*** 67,73 ****
  		 mule-write-region-no-coding-system char-int
  		 annotationp delete-annotation make-image-specifier
  		 make-annotation base64-decode-string
! 		 w3-do-setup w3-region)))
  
  (setq load-path (cons "." load-path))
  (require 'custom)
--- 67,73 ----
  		 mule-write-region-no-coding-system char-int
  		 annotationp delete-annotation make-image-specifier
  		 make-annotation base64-decode-string
! 		 w3-do-setup w3-region base64-decode)))
  
  (setq load-path (cons "." load-path))
  (require 'custom)
*** pub/pgnus/lisp/mail-parse.el	Sat Sep 12 09:15:46 1998
--- pgnus/lisp/mail-parse.el	Sat Sep 12 09:15:37 1998
***************
*** 0 ****
--- 1,64 ----
+ ;;; mail-parse.el --- Interface functions for parsing mail
+ ;; Copyright (C) 1998 Free Software Foundation, Inc.
+ 
+ ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+ ;; This file is part of GNU Emacs.
+ 
+ ;; 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:
+ 
+ ;; This file contains wrapper functions for a wide range of mail
+ ;; parsing functions.  The idea is that there are low-level libraries
+ ;; that impement according to various specs (RFC2231, DRUMS, USEFOR),
+ ;; but that programmers that want to parse some header (say,
+ ;; Content-Type) will want to use the latest spec.
+ ;;
+ ;; So while each low-level library (rfc2231.el, for instance) decodes
+ ;; faithfully according to that (proposed) standard, this library is
+ ;; the interface library.  If some later RFC supersedes RFC2231, one
+ ;; would just have to write a new low-level library, adjust the
+ ;; aliases in this library, and the users and programmers won't notice
+ ;; any changes.
+ 
+ ;;; Code:
+ 
+ (require 'drums)
+ (require 'rfc2231)
+ (require 'rfc2047)
+ 
+ (defalias 'mail-header-parse-content-type 'rfc2231-parse-string)
+ (defalias 'mail-header-parse-content-disposition 'rfc2231-parse-string)
+ (defalias 'mail-content-type-get 'rfc2231-get-value)
+ 
+ (defalias 'mail-header-remove-comments 'drums-remove-comments)
+ (defalias 'mail-header-remove-whitespace 'drums-remove-whitespace)
+ (defalias 'mail-header-get-comment 'drums-get-comment)
+ (defalias 'mail-header-parse-address 'drums-parse-address)
+ (defalias 'mail-header-parse-addresses 'drums-parse-addresses)
+ (defalias 'mail-header-parse-date 'drums-parse-date)
+ (defalias 'mail-narrow-to-head 'drums-narrow-to-header)
+ 
+ (defalias 'mail-header-narrow-to-field 'rfc2047-narrow-to-field)
+ (defalias 'mail-encode-encoded-word-region 'rfc2047-encode-region)
+ (defalias 'mail-encode-encoded-word-buffer 'rfc2047-encode-message-header)
+ (defalias 'mail-encode-encoded-word-string 'rfc2047-encode-string)
+ (defalias 'mail-decode-encoded-word-region 'rfc2047-decode-region)
+ (defalias 'mail-decode-encoded-word-string 'rfc2047-decode-string)
+ 
+ (provide 'mail-parse)
+ 
+ ;;; mail-parse.el ends here
*** pub/pgnus/lisp/mailcap.el	Fri Sep 11 18:21:51 1998
--- pgnus/lisp/mailcap.el	Sat Sep 12 09:15:37 1998
***************
*** 28,34 ****
  
  (eval-and-compile
    (require 'cl))
! (require 'drums)
  
  (defvar mailcap-parse-args-syntax-table
    (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
--- 28,34 ----
  
  (eval-and-compile
    (require 'cl))
! (require 'mail-parse)
  
  (defvar mailcap-parse-args-syntax-table
    (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
***************
*** 42,210 ****
  (defvar mailcap-mime-data
    '(("application"
       ("x-x509-ca-cert"
!       ("viewer" . ssl-view-site-cert)
!       ("test" . (fboundp 'ssl-view-site-cert))
!       ("type" . "application/x-x509-ca-cert"))
       ("x-x509-user-cert"
!       ("viewer" . ssl-view-user-cert)
!       ("test" . (fboundp 'ssl-view-user-cert))
!       ("type" . "application/x-x509-user-cert"))
       ("octet-stream"
!       ("viewer" . mailcap-save-binary-file)
!       ("type" ."application/octet-stream"))
       ("dvi"
!       ("viewer" . "open %s")
!       ("type"   . "application/dvi")
!       ("test"   . (eq (mm-device-type) 'ns)))
       ("dvi"
!       ("viewer" . "xdvi %s")
!       ("test"   . (eq (mm-device-type) 'x))
        ("needsx11")
!       ("type"   . "application/dvi"))
       ("dvi"
!       ("viewer" . "dvitty %s")
!       ("test"   . (not (getenv "DISPLAY")))
!       ("type"   . "application/dvi"))
       ("emacs-lisp"
!       ("viewer" . mailcap-maybe-eval)
!       ("type"   . "application/emacs-lisp"))
       ("x-tar"
!       ("viewer" . mailcap-save-binary-file)
!       ("type"   . "application/x-tar"))
       ("x-latex"
!       ("viewer" . tex-mode)
!       ("test"   . (fboundp 'tex-mode))
!       ("type"   . "application/x-latex"))
       ("x-tex"
!       ("viewer" . tex-mode)
!       ("test"   . (fboundp 'tex-mode))
!       ("type"   . "application/x-tex"))
       ("latex"
!       ("viewer" . tex-mode)
!       ("test"   . (fboundp 'tex-mode))
!       ("type"   . "application/latex"))
       ("tex"
!       ("viewer" . tex-mode)
!       ("test"   . (fboundp 'tex-mode))
!       ("type"   . "application/tex"))
       ("texinfo"
!       ("viewer" . texinfo-mode)
!       ("test"   . (fboundp 'texinfo-mode))
!       ("type"   . "application/tex"))
       ("zip"
!       ("viewer" . mailcap-save-binary-file)
!       ("type"   . "application/zip")
        ("copiousoutput"))
       ("pdf"
!       ("viewer" . "acroread %s")
!       ("type"   . "application/pdf"))
       ("postscript"
!       ("viewer" . "open %s")
!       ("type"   . "application/postscript")
!       ("test"   . (eq (mm-device-type) 'ns)))
       ("postscript" 
!       ("viewer" . "ghostview %s")
!       ("type" . "application/postscript")
!       ("test"   . (eq (mm-device-type) 'x))
        ("needsx11"))
       ("postscript"
!       ("viewer" . "ps2ascii %s")
!       ("type" . "application/postscript")
!       ("test" . (not (getenv "DISPLAY")))
        ("copiousoutput")))
      ("audio"
       ("x-mpeg"
!       ("viewer" . "maplay %s")
!       ("type"   . "audio/x-mpeg"))
       (".*"
!       ("viewer" . mm-play-sound-file)
!       ("test"   . (or (featurep 'nas-sound)
  		      (featurep 'native-sound)))
!       ("type"   . "audio/*"))
       (".*"
!       ("viewer" . "showaudio")
!       ("type"   . "audio/*")))
      ("message"
       ("rfc-*822"
!       ("viewer" . vm-mode)
!       ("test"   . (fboundp 'vm-mode))
!       ("type"   . "message/rfc-822"))
       ("rfc-*822"
!       ("viewer" . w3-mode)
!       ("test"   . (fboundp 'w3-mode))
!       ("type"   . "message/rfc-822"))
       ("rfc-*822"
!       ("viewer" . view-mode)
!       ("test"   . (fboundp 'view-mode))
!       ("type"   . "message/rfc-822"))
       ("rfc-*822" 
!       ("viewer" . fundamental-mode)
!       ("type"   . "message/rfc-822")))
      ("image"
       ("x-xwd"
!       ("viewer"  . "xwud -in %s")
!       ("type"    . "image/x-xwd")
        ("compose" . "xwd -frame > %s")
!       ("test"    . (eq (mm-device-type) 'x))
        ("needsx11"))
       ("x11-dump"
!       ("viewer" . "xwud -in %s")
!       ("type" . "image/x-xwd")
        ("compose" . "xwd -frame > %s")
!       ("test"   . (eq (mm-device-type) 'x))
        ("needsx11"))
       ("windowdump"
!       ("viewer" . "xwud -in %s")
!       ("type" . "image/x-xwd")
        ("compose" . "xwd -frame > %s")
!       ("test"   . (eq (mm-device-type) 'x))
        ("needsx11"))
       (".*"
!       ("viewer" . "aopen %s")
!       ("type"   . "image/*")
!       ("test"   . (eq (mm-device-type) 'ns)))
       (".*"
!       ("viewer" . "xv -perfect %s")
!       ("type" . "image/*")
!       ("test"   . (eq (mm-device-type) 'x))
        ("needsx11")))
      ("text"
       ("plain"
!       ("viewer"  . w3-mode)
!       ("test"    . (fboundp 'w3-mode))
!       ("type"    . "text/plain"))
       ("plain"
!       ("viewer"  . view-mode)
!       ("test"    . (fboundp 'view-mode))
!       ("type"    . "text/plain"))
       ("plain"
!       ("viewer"  . fundamental-mode)
!       ("type"    . "text/plain"))
       ("enriched"
!       ("viewer" . enriched-decode-region)
!       ("test"   . (fboundp 'enriched-decode-region))
!       ("type"   . "text/enriched"))
       ("html"
!       ("viewer" . mm-w3-prepare-buffer)
!       ("test"   . (fboundp 'w3-prepare-buffer))
!       ("type"   . "text/html")))
      ("video"
       ("mpeg"
!       ("viewer" . "mpeg_play %s")
!       ("type"   . "video/mpeg")
!       ("test"   . (eq (mm-device-type) 'x))
        ("needsx11")))
      ("x-world"
       ("x-vrml"
!       ("viewer"  . "webspace -remote %s -URL %u")
!       ("type"    . "x-world/x-vrml")
        ("description"
         "VRML document")))
      ("archive"
       ("tar"
!       ("viewer" . tar-mode)
!       ("type" . "archive/tar")
!       ("test" . (fboundp 'tar-mode)))))
       "*The mailcap structure is an assoc list of assoc lists.
  1st assoc list is keyed on the major content-type
  2nd assoc list is keyed on the minor content-type (which can be a regexp)
--- 42,210 ----
  (defvar mailcap-mime-data
    '(("application"
       ("x-x509-ca-cert"
!       (viewer . ssl-view-site-cert)
!       (test . (fboundp 'ssl-view-site-cert))
!       (type . "application/x-x509-ca-cert"))
       ("x-x509-user-cert"
!       (viewer . ssl-view-user-cert)
!       (test . (fboundp 'ssl-view-user-cert))
!       (type . "application/x-x509-user-cert"))
       ("octet-stream"
!       (viewer . mailcap-save-binary-file)
!       (type ."application/octet-stream"))
       ("dvi"
!       (viewer . "open %s")
!       (type   . "application/dvi")
!       (test   . (eq (mm-device-type) 'ns)))
       ("dvi"
!       (viewer . "xdvi %s")
!       (test   . (eq (mm-device-type) 'x))
        ("needsx11")
!       (type   . "application/dvi"))
       ("dvi"
!       (viewer . "dvitty %s")
!       (test   . (not (getenv "DISPLAY")))
!       (type   . "application/dvi"))
       ("emacs-lisp"
!       (viewer . mailcap-maybe-eval)
!       (type   . "application/emacs-lisp"))
       ("x-tar"
!       (viewer . mailcap-save-binary-file)
!       (type   . "application/x-tar"))
       ("x-latex"
!       (viewer . tex-mode)
!       (test   . (fboundp 'tex-mode))
!       (type   . "application/x-latex"))
       ("x-tex"
!       (viewer . tex-mode)
!       (test   . (fboundp 'tex-mode))
!       (type   . "application/x-tex"))
       ("latex"
!       (viewer . tex-mode)
!       (test   . (fboundp 'tex-mode))
!       (type   . "application/latex"))
       ("tex"
!       (viewer . tex-mode)
!       (test   . (fboundp 'tex-mode))
!       (type   . "application/tex"))
       ("texinfo"
!       (viewer . texinfo-mode)
!       (test   . (fboundp 'texinfo-mode))
!       (type   . "application/tex"))
       ("zip"
!       (viewer . mailcap-save-binary-file)
!       (type   . "application/zip")
        ("copiousoutput"))
       ("pdf"
!       (viewer . "acroread %s")
!       (type   . "application/pdf"))
       ("postscript"
!       (viewer . "open %s")
!       (type   . "application/postscript")
!       (test   . (eq (mm-device-type) 'ns)))
       ("postscript" 
!       (viewer . "ghostview %s")
!       (type . "application/postscript")
!       (test   . (eq (mm-device-type) 'x))
        ("needsx11"))
       ("postscript"
!       (viewer . "ps2ascii %s")
!       (type . "application/postscript")
!       (test . (not (getenv "DISPLAY")))
        ("copiousoutput")))
      ("audio"
       ("x-mpeg"
!       (viewer . "maplay %s")
!       (type   . "audio/x-mpeg"))
       (".*"
!       (viewer . mm-view-sound-file)
!       (test   . (or (featurep 'nas-sound)
  		      (featurep 'native-sound)))
!       (type   . "audio/*"))
       (".*"
!       (viewer . "showaudio")
!       (type   . "audio/*")))
      ("message"
       ("rfc-*822"
!       (viewer . vm-mode)
!       (test   . (fboundp 'vm-mode))
!       (type   . "message/rfc-822"))
       ("rfc-*822"
!       (viewer . w3-mode)
!       (test   . (fboundp 'w3-mode))
!       (type   . "message/rfc-822"))
       ("rfc-*822"
!       (viewer . view-mode)
!       (test   . (fboundp 'view-mode))
!       (type   . "message/rfc-822"))
       ("rfc-*822" 
!       (viewer . fundamental-mode)
!       (type   . "message/rfc-822")))
      ("image"
       ("x-xwd"
!       (viewer  . "xwud -in %s")
!       (type    . "image/x-xwd")
        ("compose" . "xwd -frame > %s")
!       (test    . (eq (mm-device-type) 'x))
        ("needsx11"))
       ("x11-dump"
!       (viewer . "xwud -in %s")
!       (type . "image/x-xwd")
        ("compose" . "xwd -frame > %s")
!       (test   . (eq (mm-device-type) 'x))
        ("needsx11"))
       ("windowdump"
!       (viewer . "xwud -in %s")
!       (type . "image/x-xwd")
        ("compose" . "xwd -frame > %s")
!       (test   . (eq (mm-device-type) 'x))
        ("needsx11"))
       (".*"
!       (viewer . "aopen %s")
!       (type   . "image/*")
!       (test   . (eq (mm-device-type) 'ns)))
       (".*"
!       (viewer . "xv -perfect %s")
!       (type . "image/*")
!       (test   . (eq (mm-device-type) 'x))
        ("needsx11")))
      ("text"
       ("plain"
!       (viewer  . w3-mode)
!       (test    . (fboundp 'w3-mode))
!       (type    . "text/plain"))
       ("plain"
!       (viewer  . view-mode)
!       (test    . (fboundp 'view-mode))
!       (type    . "text/plain"))
       ("plain"
!       (viewer  . fundamental-mode)
!       (type    . "text/plain"))
       ("enriched"
!       (viewer . enriched-decode-region)
!       (test   . (fboundp 'enriched-decode-region))
!       (type   . "text/enriched"))
       ("html"
!       (viewer . mm-w3-prepare-buffer)
!       (test   . (fboundp 'w3-prepare-buffer))
!       (type   . "text/html")))
      ("video"
       ("mpeg"
!       (viewer . "mpeg_play %s")
!       (type   . "video/mpeg")
!       (test   . (eq (mm-device-type) 'x))
        ("needsx11")))
      ("x-world"
       ("x-vrml"
!       (viewer  . "webspace -remote %s -URL %u")
!       (type    . "x-world/x-vrml")
        ("description"
         "VRML document")))
      ("archive"
       ("tar"
!       (viewer . tar-mode)
!       (type . "archive/tar")
!       (test . (fboundp 'tar-mode)))))
       "*The mailcap structure is an assoc list of assoc lists.
  1st assoc list is keyed on the major content-type
  2nd assoc list is keyed on the minor content-type (which can be a regexp)
***************
*** 219,227 ****
  Where <info> is another assoc list of the various information
  related to the mailcap RFC.  This is keyed on the lowercase
  attribute name (viewer, test, etc).  This looks like:
!  ((\"viewer\" . viewerinfo)
!   (\"test\"   . testinfo)
!   (\"xxxx\"   . \"string\"))
  
  Where viewerinfo specifies how the content-type is viewed.  Can be
  a string, in which case it is run through a shell, with
--- 219,227 ----
  Where <info> is another assoc list of the various information
  related to the mailcap RFC.  This is keyed on the lowercase
  attribute name (viewer, test, etc).  This looks like:
!  ((viewer . viewerinfo)
!   (test   . testinfo)
!   (xxxx   . \"string\"))
  
  Where viewerinfo specifies how the content-type is viewed.  Can be
  a string, in which case it is run through a shell, with
***************
*** 373,382 ****
  	  (setq viewer (buffer-substring save-pos (point))))
  	(setq save-pos (point))
  	(end-of-line)
! 	(setq info (nconc (list (cons "viewer" viewer)
! 				(cons "type" (concat major "/"
! 						     (if (string= minor ".*")
! 							 "*" minor))))
  			  (mailcap-parse-mailcap-extras save-pos (point))))
  	(mailcap-mailcap-entry-passes-test info)
  	(mailcap-add-mailcap-entry major minor info)))))
--- 373,382 ----
  	  (setq viewer (buffer-substring save-pos (point))))
  	(setq save-pos (point))
  	(end-of-line)
! 	(setq info (nconc (list (cons 'viewer viewer)
! 				(cons 'type (concat major "/"
! 						    (if (string= minor ".*")
! 							"*" minor))))
  			  (mailcap-parse-mailcap-extras save-pos (point))))
  	(mailcap-mailcap-entry-passes-test info)
  	(mailcap-add-mailcap-entry major minor info)))))
***************
*** 430,436 ****
    ;; Return t iff a mailcap entry passes its test clause or no test
    ;; clause is present.
    (let (status				; Call-process-regions return value
! 	(test (assoc "test" info))	; The test clause
  	)
      (setq status (and test (split-string (cdr test) " ")))
      (if (and (assoc "needsx11" info) (not (getenv "DISPLAY")))
--- 430,436 ----
    ;; Return t iff a mailcap entry passes its test clause or no test
    ;; clause is present.
    (let (status				; Call-process-regions return value
! 	(test (assq 'test info))	; The test clause
  	)
      (setq status (and test (split-string (cdr test) " ")))
      (if (and (assoc "needsx11" info) (not (getenv "DISPLAY")))
***************
*** 494,500 ****
  	     ((null save-chr) nil)
  	     ((= save-chr ?t)
  	      (delete-region save-pos (progn (forward-char 1) (point)))
! 	      (insert (or (cdr (assoc "type" type-info)) "\"\"")))
  	     ((= save-chr ?M)
  	      (delete-region save-pos (progn (forward-char 1) (point)))
  	      (insert "\"\""))
--- 494,500 ----
  	     ((null save-chr) nil)
  	     ((= save-chr ?t)
  	      (delete-region save-pos (progn (forward-char 1) (point)))
! 	      (insert (or (cdr (assq 'type type-info)) "\"\"")))
  	     ((= save-chr ?M)
  	      (delete-region save-pos (progn (forward-char 1) (point)))
  	      (insert "\"\""))
***************
*** 520,529 ****
  (defun mailcap-viewer-passes-test (viewer-info type-info)
    ;; Return non-nil iff the viewer specified by VIEWER-INFO passes its
    ;; test clause (if any).
!   (let* ((test-info   (assoc "test"   viewer-info))
  	 (test (cdr test-info))
  	 (otest test)
! 	 (viewer (cdr (assoc "viewer" viewer-info)))
  	 (default-directory (expand-file-name "~/"))
  	 status parsed-test cache result)
      (if (setq cache (assoc test mailcap-viewer-test-cache))
--- 520,529 ----
  (defun mailcap-viewer-passes-test (viewer-info type-info)
    ;; Return non-nil iff the viewer specified by VIEWER-INFO passes its
    ;; test clause (if any).
!   (let* ((test-info (assq 'test viewer-info))
  	 (test (cdr test-info))
  	 (otest test)
! 	 (viewer (cdr (assoc 'viewer viewer-info)))
  	 (default-directory (expand-file-name "~/"))
  	 status parsed-test cache result)
      (if (setq cache (assoc test mailcap-viewer-test-cache))
***************
*** 561,570 ****
        (let ((cur-minor (assoc minor old-major)))
  	(cond
  	 ((or (null cur-minor)		; New minor area, or
! 	      (assoc "test" info))	; Has a test, insert at beginning
  	  (setcdr old-major (cons (cons minor info) (cdr old-major))))
! 	 ((and (not (assoc "test" info)) ; No test info, replace completely
! 	       (not (assoc "test" cur-minor)))
  	  (setcdr cur-minor info))
  	 (t
  	  (setcdr old-major (cons (cons minor info) (cdr old-major)))))))))
--- 561,570 ----
        (let ((cur-minor (assoc minor old-major)))
  	(cond
  	 ((or (null cur-minor)		; New minor area, or
! 	      (assq 'test info))	; Has a test, insert at beginning
  	  (setcdr old-major (cons (cons minor info) (cdr old-major))))
! 	 ((and (not (assq 'test info)) ; No test info, replace completely
! 	       (not (assq 'test cur-minor)))
  	  (setcdr cur-minor info))
  	 (t
  	  (setcdr old-major (cons (cons minor info) (cdr old-major)))))))))
***************
*** 575,584 ****
  
  (defun mailcap-viewer-lessp (x y)
    ;; Return t iff viewer X is more desirable than viewer Y
!   (let ((x-wild (string-match "[*?]" (or (cdr-safe (assoc "type" x)) "")))
! 	(y-wild (string-match "[*?]" (or (cdr-safe (assoc "type" y)) "")))
! 	(x-lisp (not (stringp (or (cdr-safe (assoc "viewer" x)) ""))))
! 	(y-lisp (not (stringp (or (cdr-safe (assoc "viewer" y)) "")))))
      (cond
       ((and x-lisp (not y-lisp))
        t)
--- 575,584 ----
  
  (defun mailcap-viewer-lessp (x y)
    ;; Return t iff viewer X is more desirable than viewer Y
!   (let ((x-wild (string-match "[*?]" (or (cdr-safe (assq 'type x)) "")))
! 	(y-wild (string-match "[*?]" (or (cdr-safe (assq 'type y)) "")))
! 	(x-lisp (not (stringp (or (cdr-safe (assq 'viewer x)) ""))))
! 	(y-lisp (not (stringp (or (cdr-safe (assq 'viewer y)) "")))))
      (cond
       ((and x-lisp (not y-lisp))
        t)
***************
*** 612,618 ****
  	viewer				; The one and only viewer
  	ctl)
      (save-excursion
!       (setq ctl (drums-parse-content-type (or string "text/plain")))
        (setq major (split-string (car ctl) "/"))
        (setq minor (cadr major)
  	    major (car major))
--- 612,618 ----
  	viewer				; The one and only viewer
  	ctl)
      (save-excursion
!       (setq ctl (mail-header-parse-content-type (or string "text/plain")))
        (setq major (split-string (car ctl) "/"))
        (setq minor (cadr major)
  	    major (car major))
***************
*** 627,642 ****
  	    (setq viewers (cdr viewers)))
  	  (setq passed (sort (nreverse passed) 'mailcap-viewer-lessp))
  	  (setq viewer (car passed))))
!       (when (and (stringp (cdr (assoc "viewer" viewer)))
  		 passed)
  	(setq viewer (car passed)))
        (cond
         ((and (null viewer) (not (equal major "default")) request)
  	(mailcap-mime-info "default" request))
         ((or (null request) (equal request ""))
! 	(mailcap-unescape-mime-test (cdr (assoc "viewer" viewer)) info))
         ((stringp request)
! 	(if (or (string= request "test") (string= request "viewer"))
  	    (mailcap-unescape-mime-test
  	     (cdr-safe (assoc request viewer)) info)))
         ((eq request 'all)
--- 627,642 ----
  	    (setq viewers (cdr viewers)))
  	  (setq passed (sort (nreverse passed) 'mailcap-viewer-lessp))
  	  (setq viewer (car passed))))
!       (when (and (stringp (cdr (assq 'viewer viewer)))
  		 passed)
  	(setq viewer (car passed)))
        (cond
         ((and (null viewer) (not (equal major "default")) request)
  	(mailcap-mime-info "default" request))
         ((or (null request) (equal request ""))
! 	(mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info))
         ((stringp request)
! 	(if (or (eq request 'test) (eq request 'viewer))
  	    (mailcap-unescape-mime-test
  	     (cdr-safe (assoc request viewer)) info)))
         ((eq request 'all)
***************
*** 644,651 ****
         (t
  	;; MUST make a copy *sigh*, else we modify mailcap-mime-data
  	(setq viewer (copy-tree viewer))
! 	(let ((view (assoc "viewer" viewer))
! 	      (test (assoc "test" viewer)))
  	  (if view (setcdr view (mailcap-unescape-mime-test (cdr view) info)))
  	  (if test (setcdr test (mailcap-unescape-mime-test (cdr test) info))))
  	viewer)))))
--- 644,651 ----
         (t
  	;; MUST make a copy *sigh*, else we modify mailcap-mime-data
  	(setq viewer (copy-tree viewer))
! 	(let ((view (assq 'viewer viewer))
! 	      (test (assq 'test viewer)))
  	  (if view (setcdr view (mailcap-unescape-mime-test (cdr view) info)))
  	  (if test (setcdr test (mailcap-unescape-mime-test (cdr test) info))))
  	viewer)))))
*** pub/pgnus/lisp/message.el	Fri Sep 11 12:31:18 1998
--- pgnus/lisp/message.el	Sat Sep 12 09:15:37 1998
***************
*** 38,44 ****
  (if (string-match "XEmacs\\|Lucid" emacs-version)
      (require 'mail-abbrevs)
    (require 'mailabbrev))
! (require 'rfc2047)
  (require 'mm-bodies)
  
  (defgroup message '((user-mail-address custom-variable)
--- 38,44 ----
  (if (string-match "XEmacs\\|Lucid" emacs-version)
      (require 'mail-abbrevs)
    (require 'mailabbrev))
! (require 'mail-parse)
  (require 'mm-bodies)
  
  (defgroup message '((user-mail-address custom-variable)
***************
*** 1135,1140 ****
--- 1135,1155 ----
       (point-max)))
    (goto-char (point-min)))
  
+ (defun message-narrow-to-headers-or-head ()
+   "Narrow the buffer to the head of the message."
+   (widen)
+   (narrow-to-region
+    (goto-char (point-min))
+    (cond
+     ((re-search-forward
+       (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
+      (match-beginning 0))
+     ((search-forward "\n\n" nil t)
+      (1- (point)))
+     (t
+      (point-max))))
+   (goto-char (point-min)))
+ 
  (defun message-news-p ()
    "Say whether the current buffer contains a news message."
    (and (not message-this-is-mail)
***************
*** 2022,2028 ****
        (let ((message-deletable-headers
  	     (if news nil message-deletable-headers)))
  	(message-generate-headers message-required-mail-headers))
!       (rfc2047-encode-message-header)
        ;; Let the user do all of the above.
        (run-hooks 'message-header-hook))
      (message-encode-message-body)
--- 2037,2043 ----
        (let ((message-deletable-headers
  	     (if news nil message-deletable-headers)))
  	(message-generate-headers message-required-mail-headers))
!       (mail-encode-encoded-word-buffer)
        ;; Let the user do all of the above.
        (run-hooks 'message-header-hook))
      (message-encode-message-body)
***************
*** 2194,2206 ****
        (message-narrow-to-headers)
        ;; Insert some headers.
        (message-generate-headers message-required-news-headers)
!       (rfc2047-encode-message-header)
        ;; Let the user do all of the above.
        (run-hooks 'message-header-hook))
-     (message-encode-message-body)
      (message-cleanup-headers)
      (if (not (message-check-news-syntax))
  	nil
        (unwind-protect
  	  (save-excursion
  	    (set-buffer tembuf)
--- 2209,2221 ----
        (message-narrow-to-headers)
        ;; Insert some headers.
        (message-generate-headers message-required-news-headers)
!       (mail-encode-encoded-word-buffer)
        ;; Let the user do all of the above.
        (run-hooks 'message-header-hook))
      (message-cleanup-headers)
      (if (not (message-check-news-syntax))
  	nil
+       (message-encode-message-body)
        (unwind-protect
  	  (save-excursion
  	    (set-buffer tembuf)
***************
*** 2619,2624 ****
--- 2634,2641 ----
    (let* ((now (or now (current-time)))
  	 (zone (nth 8 (decode-time now)))
  	 (sign "+"))
+     (when (< zone 0)
+       (setq sign ""))
      ;; We do all of this because XEmacs doesn't have the %z spec.
      (concat (format-time-string "%d %b %Y %H:%M:%S " (or now (current-time)))
  	    (format "%s%02d%02d"
***************
*** 4034,4040 ****
    (when (featurep 'mule)
      (save-excursion
        (save-restriction
! 	(message-narrow-to-headers)
  	(message-remove-header
  	 "^Content-Transfer-Encoding:\\|^Content-Type:\\|^Mime-Version:" t)
  	(goto-char (point-max))
--- 4051,4057 ----
    (when (featurep 'mule)
      (save-excursion
        (save-restriction
! 	(message-narrow-to-headers-or-head)
  	(message-remove-header
  	 "^Content-Transfer-Encoding:\\|^Content-Type:\\|^Mime-Version:" t)
  	(goto-char (point-max))
***************
*** 4045,4051 ****
  	  (when (consp charset)
  	    (error "Can't encode messages with multiple charsets (yet)"))
  	  (widen)
! 	  (message-narrow-to-headers)
  	  (goto-char (point-max))
  	  (setq charset (or charset (mm-mule-charset-to-mime-charset 'ascii)))
  	  ;; We don't insert MIME headers if they only say the default.
--- 4062,4068 ----
  	  (when (consp charset)
  	    (error "Can't encode messages with multiple charsets (yet)"))
  	  (widen)
! 	  (message-narrow-to-headers-or-head)
  	  (goto-char (point-max))
  	  (setq charset (or charset (mm-mule-charset-to-mime-charset 'ascii)))
  	  ;; We don't insert MIME headers if they only say the default.
*** pub/pgnus/lisp/mm-bodies.el	Fri Sep 11 08:08:34 1998
--- pgnus/lisp/mm-bodies.el	Sat Sep 12 09:15:37 1998
***************
*** 28,33 ****
--- 28,34 ----
    (if (not (fboundp 'base64-encode-string))
        (require 'base64)))
  (require 'mm-util)
+ (require 'rfc2047)
  (require 'qp)
  
  (defun mm-encode-body ()
*** pub/pgnus/lisp/mm-decode.el	Fri Sep 11 18:21:52 1998
--- pgnus/lisp/mm-decode.el	Sat Sep 12 09:15:37 1998
***************
*** 24,30 ****
  
  ;;; Code:
  
! (require 'drums)
  (require 'mailcap)
  (require 'mm-bodies)
  
--- 24,30 ----
  
  ;;; Code:
  
! (require 'mail-parse)
  (require 'mailcap)
  (require 'mm-bodies)
  
***************
*** 64,81 ****
  (defvar mm-dissection-list nil)
  (defvar mm-last-shell-command "")
  
  (defun mm-dissect-buffer (&optional no-strict-mime)
    "Dissect the current buffer and return a list of MIME handles."
    (save-excursion
!     (let (ct ctl type subtype cte)
        (save-restriction
! 	(drums-narrow-to-header)
  	(when (and (or no-strict-mime
  		       (mail-fetch-field "mime-version"))
  		   (setq ct (mail-fetch-field "content-type")))
! 	  (setq ctl (drums-parse-content-type ct))
! 	  (setq cte
! 		(mail-fetch-field "content-transfer-encoding"))))
        (when ctl
  	(setq type (split-string (car ctl) "/"))
  	(setq subtype (cadr type)
--- 64,101 ----
  (defvar mm-dissection-list nil)
  (defvar mm-last-shell-command "")
  
+ ;;; Convenience macros.
+ 
+ (defmacro mm-handle-buffer (handle)
+   `(nth 0 ,handle))
+ (defmacro mm-handle-type (handle)
+   `(nth 1 ,handle))
+ (defmacro mm-handle-encoding (handle)
+   `(nth 2 ,handle))
+ (defmacro mm-handle-undisplayer (handle)
+   `(nth 3 ,handle))
+ (defmacro mm-handle-set-undisplayer (handle function)
+   `(setcar (nthcdr 3 ,handle) ,function))
+ (defmacro mm-handle-disposition (handle)
+   `(nth 4 ,handle))
+ (defmacro mm-handle-description (handle)
+   `(nth 5 ,handle))
+ 
+ ;;; The functions.
+ 
  (defun mm-dissect-buffer (&optional no-strict-mime)
    "Dissect the current buffer and return a list of MIME handles."
    (save-excursion
!     (let (ct ctl type subtype cte cd description)
        (save-restriction
! 	(mail-narrow-to-head)
  	(when (and (or no-strict-mime
  		       (mail-fetch-field "mime-version"))
  		   (setq ct (mail-fetch-field "content-type")))
! 	  (setq ctl (mail-header-parse-content-type ct)
! 		cte (mail-fetch-field "content-transfer-encoding")
! 		cd (mail-fetch-field "content-disposition")
! 		description (mail-fetch-field "content-description"))))
        (when ctl
  	(setq type (split-string (car ctl) "/"))
  	(setq subtype (cadr type)
***************
*** 86,100 ****
  	 (t
  	  (mm-dissect-singlepart
  	   ctl
! 	   (and cte (intern (downcase (drums-remove-whitespace
! 				       (drums-remove-comments
  					cte)))))
! 	   no-strict-mime)))))))
  
! (defun mm-dissect-singlepart (ctl cte &optional force)
    (when (or force
  	    (not (equal "text/plain" (car ctl))))
!     (let ((res (list (list (mm-copy-to-buffer) ctl cte nil))))
        (push (car res) mm-dissection-list)
        res)))
  
--- 106,121 ----
  	 (t
  	  (mm-dissect-singlepart
  	   ctl
! 	   (and cte (intern (downcase (mail-header-remove-whitespace
! 				       (mail-header-remove-comments
  					cte)))))
! 	   no-strict-mime
! 	   (and cd (mail-header-parse-content-disposition cd)))))))))
  
! (defun mm-dissect-singlepart (ctl cte &optional force cdl description)
    (when (or force
  	    (not (equal "text/plain" (car ctl))))
!     (let ((res (list (list (mm-copy-to-buffer) ctl cte nil cdl description))))
        (push (car res) mm-dissection-list)
        res)))
  
***************
*** 106,112 ****
  
  (defun mm-dissect-multipart (ctl)
    (goto-char (point-min))
!   (let ((boundary (concat "\n--" (drums-content-type-get ctl 'boundary)))
  	start parts end)
      (while (search-forward boundary nil t)
        (forward-line -1)
--- 127,133 ----
  
  (defun mm-dissect-multipart (ctl)
    (goto-char (point-min))
!   (let ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary)))
  	start parts end)
      (while (search-forward boundary nil t)
        (forward-line -1)
***************
*** 135,143 ****
    "Display the MIME part represented by HANDLE."
    (save-excursion
      (mailcap-parse-mailcaps)
!     (if (nth 3 handle)
  	(mm-remove-part handle)
!       (let* ((type (caadr handle))
  	     (method (mailcap-mime-info type))
  	     (user-method (mm-user-method type)))
  	(if (eq user-method 'inline)
--- 156,164 ----
    "Display the MIME part represented by HANDLE."
    (save-excursion
      (mailcap-parse-mailcaps)
!     (if (mm-handle-undisplayer handle)
  	(mm-remove-part handle)
!       (let* ((type (car (mm-handle-type handle)))
  	     (method (mailcap-mime-info type))
  	     (user-method (mm-user-method type)))
  	(if (eq user-method 'inline)
***************
*** 150,163 ****
  (defun mm-display-external (handle method)
    "Display HANDLE using METHOD."
    (mm-with-unibyte-buffer
!     (insert-buffer-substring (car handle))
!     (mm-decode-content-transfer-encoding (nth 2 handle))
      (if (functionp method)
  	(let ((cur (current-buffer)))
  	  (switch-to-buffer (generate-new-buffer "*mm*"))
  	  (insert-buffer-substring cur)
  	  (funcall method)
! 	  (setcar (nthcdr 3 handle) (current-buffer)))
        (let* ((file (make-temp-name (expand-file-name "emm." mm-tmp-directory)))
  	     process)
  	(write-region (point-min) (point-max)
--- 171,184 ----
  (defun mm-display-external (handle method)
    "Display HANDLE using METHOD."
    (mm-with-unibyte-buffer
!     (insert-buffer-substring (mm-handle-buffer handle))
!     (mm-decode-content-transfer-encoding (mm-handle-encoding handle))
      (if (functionp method)
  	(let ((cur (current-buffer)))
  	  (switch-to-buffer (generate-new-buffer "*mm*"))
  	  (insert-buffer-substring cur)
  	  (funcall method)
! 	  (mm-handle-set-undisplayer handle (current-buffer)))
        (let* ((file (make-temp-name (expand-file-name "emm." mm-tmp-directory)))
  	     process)
  	(write-region (point-min) (point-max)
***************
*** 165,176 ****
  	(setq process
  	      (start-process "*display*" nil shell-file-name
  			     "-c" (format method file)))
! 	(setcar (nthcdr 3 handle) (cons file process))
  	(message "Displaying %s..." (format method file))))))
  
  (defun mm-remove-part (handle)
    "Remove the displayed MIME part represented by HANDLE."
!   (let ((object (nth 3 handle)))
      (condition-case ()
  	(cond
  	 ;; Internally displayed part.
--- 186,197 ----
  	(setq process
  	      (start-process "*display*" nil shell-file-name
  			     "-c" (format method file)))
! 	(mm-handle-set-undisplayer handle (cons file process))
  	(message "Displaying %s..." (format method file))))))
  
  (defun mm-remove-part (handle)
    "Remove the displayed MIME part represented by HANDLE."
!   (let ((object (mm-handle-undisplayer handle)))
      (condition-case ()
  	(cond
  	 ;; Internally displayed part.
***************
*** 192,201 ****
  	  (when (buffer-live-p object)
  	    (kill-buffer object))))
        (error nil))
!     (setcar (nthcdr 3 handle) nil)))
  
  (defun mm-display-inline (handle)
!   (let* ((type (caadr handle))
  	 (function (cadr (assoc type mm-inline-media-tests))))
      (funcall function handle)))
  	 
--- 213,222 ----
  	  (when (buffer-live-p object)
  	    (kill-buffer object))))
        (error nil))
!     (mm-handle-set-undisplayer handle nil)))
  
  (defun mm-display-inline (handle)
!   (let* ((type (car (mm-handle-type handle)))
  	 (function (cadr (assoc type mm-inline-media-tests))))
      (funcall function handle)))
  	 
***************
*** 241,248 ****
  (defun mm-destroy-part (handle)
    "Destroy the data structures connected to HANDLE."
    (mm-remove-part handle)
!   (when (buffer-live-p (car handle))
!     (kill-buffer (car handle))))
  
  (defun mm-quote-arg (arg)
    "Return a version of ARG that is safe to evaluate in a shell."
--- 262,269 ----
  (defun mm-destroy-part (handle)
    "Destroy the data structures connected to HANDLE."
    (mm-remove-part handle)
!   (when (buffer-live-p (mm-handle-buffer handle))
!     (kill-buffer (mm-handle-buffer handle))))
  
  (defun mm-quote-arg (arg)
    "Return a version of ARG that is safe to evaluate in a shell."
***************
*** 264,299 ****
  (defun mm-get-part (handle)
    "Return the contents of HANDLE as a string."
    (mm-with-unibyte-buffer
!     (insert-buffer-substring (car handle))
!     (mm-decode-content-transfer-encoding (nth 2 handle))
      (buffer-string)))
  
  (defun mm-save-part (handle)
    "Write HANDLE to a file."
!   (let* ((name (drums-content-type-get (cadr handle) 'name))
! 	 (file (read-file-name "Save MIME part to: "
! 			       (expand-file-name
! 				(or name "") default-directory))))
      (mm-with-unibyte-buffer
!       (insert-buffer-substring (car handle))
!       (mm-decode-content-transfer-encoding (nth 2 handle))
        (when (or (not (file-exists-p file))
  		(yes-or-no-p (format "File %s already exists; overwrite? ")))
  	(write-region (point-min) (point-max) file)))))
  
  (defun mm-pipe-part (handle)
    "Pipe HANDLE to a process."
!   (let* ((name (drums-content-type-get (cadr handle) 'name))
  	 (command
  	  (read-string "Shell command on MIME part: " mm-last-shell-command)))
      (mm-with-unibyte-buffer
!       (insert-buffer-substring (car handle))
!       (mm-decode-content-transfer-encoding (nth 2 handle))
        (shell-command-on-region (point-min) (point-max) command nil))))
  
  (defun mm-interactively-view-part (handle)
    "Display HANDLE using METHOD."
!   (let* ((type (caadr handle))
  	 (methods
  	  (mapcar (lambda (i) (list (cdr (assoc "viewer" i))))
  		  (mailcap-mime-info type 'all)))
--- 285,326 ----
  (defun mm-get-part (handle)
    "Return the contents of HANDLE as a string."
    (mm-with-unibyte-buffer
!     (insert-buffer-substring (mm-handle-buffer handle))
!     (mm-decode-content-transfer-encoding (mm-handle-encoding handle))
      (buffer-string)))
  
  (defun mm-save-part (handle)
    "Write HANDLE to a file."
!   (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
! 	 (filename (mail-content-type-get
! 		    (mm-handle-disposition handle) 'filename))
! 	 file)
!     (when filename
!       (setq filename (file-name-nondirectory filename)))
!     (setq file
! 	  (read-file-name "Save MIME part to: "
! 			  (expand-file-name
! 			   (or filename name "") default-directory)))
      (mm-with-unibyte-buffer
!       (insert-buffer-substring (mm-handle-buffer handle))
!       (mm-decode-content-transfer-encoding (mm-handle-encoding handle))
        (when (or (not (file-exists-p file))
  		(yes-or-no-p (format "File %s already exists; overwrite? ")))
  	(write-region (point-min) (point-max) file)))))
  
  (defun mm-pipe-part (handle)
    "Pipe HANDLE to a process."
!   (let* ((name (mail-content-type-get (car (mm-handle-type handle)) 'name))
  	 (command
  	  (read-string "Shell command on MIME part: " mm-last-shell-command)))
      (mm-with-unibyte-buffer
!       (insert-buffer-substring (mm-handle-buffer handle))
!       (mm-decode-content-transfer-encoding (mm-handle-encoding handle))
        (shell-command-on-region (point-min) (point-max) command nil))))
  
  (defun mm-interactively-view-part (handle)
    "Display HANDLE using METHOD."
!   (let* ((type (car (mm-handle-type handle)))
  	 (methods
  	  (mapcar (lambda (i) (list (cdr (assoc "viewer" i))))
  		  (mailcap-mime-info type 'all)))
***************
*** 307,315 ****
      (while (setq p (pop prec))
        (setq h handles)
        (while h
! 	(setq type (car (nth 1 (car h))))
  	(when (and (equal p type)
! 		   (mm-automatic-display-p type))
  	  (setq result (car h)
  		h nil
  		prec nil))
--- 334,345 ----
      (while (setq p (pop prec))
        (setq h handles)
        (while h
! 	(setq type (car (mm-handle-type (car h))))
  	(when (and (equal p type)
! 		   (mm-automatic-display-p type)
! 		   (or (not (mm-handle-disposition (car h)))
! 		       (equal (car (mm-handle-disposition (car h)))
! 			      "inline")))
  	  (setq result (car h)
  		h nil
  		prec nil))
*** pub/pgnus/lisp/mm-view.el	Fri Sep 11 18:21:52 1998
--- pgnus/lisp/mm-view.el	Sat Sep 12 09:15:38 1998
***************
*** 23,29 ****
  
  ;;; Code:
  
! (require 'drums)
  (require 'mailcap)
  (require 'mm-bodies)
  
--- 23,29 ----
  
  ;;; Code:
  
! (require 'mail-parse)
  (require 'mailcap)
  (require 'mm-bodies)
  
***************
*** 32,67 ****
  ;;;
  
  (defun mm-inline-image (handle)
!   (let ((type (cadr (split-string (caadr handle) "/")))
! 	image)
      (mm-with-unibyte-buffer
!       (insert-buffer-substring (car handle))
!       (mm-decode-content-transfer-encoding (nth 2 handle))
        (setq image (make-image-specifier
  		   (vector (intern type) :data (buffer-string)))))
      (let ((annot (make-annotation image nil 'text)))
        (set-extent-property annot 'mm t)
        (set-extent-property annot 'duplicable t)
!       (setcar (nthcdr 3 handle) annot))))
  
  (defun mm-inline-text (handle)
!   (let ((type (cadr (split-string (caadr handle) "/")))
  	text buffer-read-only)
      (cond
       ((equal type "plain")
        (with-temp-buffer
! 	(insert-buffer-substring (car handle))
! 	(mm-decode-content-transfer-encoding (nth 2 handle))
  	(setq text (buffer-string)))
        (let ((b (point)))
  	(insert text)
  	(save-restriction
  	  (narrow-to-region b (point))
! 	  (let ((charset (drums-content-type-get (nth 1 handle) 'charset)))
  	    (when charset
  	      (mm-decode-body charset nil)))
! 	  (setcar
! 	   (nthcdr 3 handle)
  	   `(lambda ()
  	      (let (buffer-read-only)
  		(delete-region
--- 32,69 ----
  ;;;
  
  (defun mm-inline-image (handle)
!   (let ((type (cadr (split-string (car (mm-handle-type handle)) "/")))
! 	buffer-read-only image)
      (mm-with-unibyte-buffer
!       (insert-buffer-substring (mm-handle-buffer handle))
!       (mm-decode-content-transfer-encoding (mm-handle-encoding handle))
        (setq image (make-image-specifier
  		   (vector (intern type) :data (buffer-string)))))
      (let ((annot (make-annotation image nil 'text)))
        (set-extent-property annot 'mm t)
        (set-extent-property annot 'duplicable t)
!       (mm-handle-set-undisplayer handle annot))
!     (insert " ")))
  
  (defun mm-inline-text (handle)
!   (let ((type (cadr (split-string (car (mm-handle-type handle)) "/")))
  	text buffer-read-only)
      (cond
       ((equal type "plain")
        (with-temp-buffer
! 	(insert-buffer-substring (mm-handle-buffer handle))
! 	(mm-decode-content-transfer-encoding (mm-handle-encoding handle))
  	(setq text (buffer-string)))
        (let ((b (point)))
  	(insert text)
  	(save-restriction
  	  (narrow-to-region b (point))
! 	  (let ((charset (mail-content-type-get
! 			  (mm-handle-type handle) 'charset)))
  	    (when charset
  	      (mm-decode-body charset nil)))
! 	  (mm-handle-set-undisplayer
! 	   handle
  	   `(lambda ()
  	      (let (buffer-read-only)
  		(delete-region
***************
*** 72,87 ****
  	(save-excursion
  	  (w3-do-setup)
  	  (mm-with-unibyte-buffer
! 	    (insert-buffer-substring (car handle))
! 	    (mm-decode-content-transfer-encoding (nth 2 handle))
  	    (require 'url)
  	    (save-window-excursion
  	      (w3-region (point-min) (point-max))
  	      (setq text (buffer-string))))
  	  (let ((b (point)))
  	    (insert text)
! 	    (setcar
! 	     (nthcdr 3 handle)
  	     `(lambda ()
  		(let (buffer-read-only)
  		  (delete-region ,(set-marker (make-marker) b)
--- 74,89 ----
  	(save-excursion
  	  (w3-do-setup)
  	  (mm-with-unibyte-buffer
! 	    (insert-buffer-substring (mm-handle-buffer handle))
! 	    (mm-decode-content-transfer-encoding (mm-handle-encoding handle))
  	    (require 'url)
  	    (save-window-excursion
  	      (w3-region (point-min) (point-max))
  	      (setq text (buffer-string))))
  	  (let ((b (point)))
  	    (insert text)
! 	    (mm-handle-set-undisplayer
! 	     handle
  	     `(lambda ()
  		(let (buffer-read-only)
  		  (delete-region ,(set-marker (make-marker) b)
***************
*** 91,97 ****
  (defun mm-inline-audio (handle)
    (message "Not implemented"))
  
! (defun mm-play-sound-file ()
    (message "Not implemented"))
  
  (defun mm-w3-prepare-buffer ()
--- 93,99 ----
  (defun mm-inline-audio (handle)
    (message "Not implemented"))
  
! (defun mm-view-sound-file ()
    (message "Not implemented"))
  
  (defun mm-w3-prepare-buffer ()
*** pub/pgnus/lisp/rfc2047.el	Wed Sep  9 09:32:38 1998
--- pgnus/lisp/rfc2047.el	Sat Sep 12 09:15:38 1998
***************
*** 101,107 ****
         (point-max))))
    (goto-char (point-min)))
  
- ;;;###autoload
  (defun rfc2047-encode-message-header ()
    "Encode the message header according to `rfc2047-header-encoding-alist'.
  Should be called narrowed to the head of the message."
--- 101,106 ----
***************
*** 230,236 ****
  (defvar rfc2047-encoded-word-regexp
    "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ ]+\\)\\?=")
  
- ;;;###autoload
  (defun rfc2047-decode-region (start end)
    "Decode MIME-encoded words in region between START and END."
    (interactive "r")
--- 229,234 ----
***************
*** 261,267 ****
  	(when (mm-multibyte-p)
  	  (mm-decode-coding-region b (point-max) rfc2047-default-charset))))))
  
- ;;;###autoload
  (defun rfc2047-decode-string (string)
    "Decode the quoted-printable-encoded STRING and return the results."
    (let ((m (mm-multibyte-p)))
--- 259,264 ----
*** pub/pgnus/lisp/rfc2231.el	Sat Sep 12 09:15:50 1998
--- pgnus/lisp/rfc2231.el	Sat Sep 12 09:15:38 1998
***************
*** 0 ****
--- 1,142 ----
+ ;;; rfc2231.el --- Functions for decoding rfc2231 headers
+ ;; Copyright (C) 1998 Free Software Foundation, Inc.
+ 
+ ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+ ;; This file is part of GNU Emacs.
+ 
+ ;; 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:
+ 
+ ;;; Code:
+ 
+ (require 'drums)
+ 
+ (defun rfc2231-get-value (ct attribute)
+   "Return the value of ATTRIBUTE from CT."
+   (cdr (assq attribute (cdr ct))))
+ 
+ (defun rfc2231-parse-string (string)
+   "Parse STRING and return a list.
+ The list will be on the form
+  `(name (attribute . value) (attribute . value)...)"
+   (with-temp-buffer
+     (let ((ttoken (drums-token-to-list drums-text-token))
+ 	  (stoken (drums-token-to-list drums-tspecials))
+ 	  (ntoken (drums-token-to-list "0-9"))
+ 	  (prev-value "")
+ 	  display-name mailbox c display-string parameters
+ 	  attribute value type subtype number encoded
+ 	  prev-attribute)
+       (drums-init (mail-header-remove-whitespace
+ 		   (mail-header-remove-comments string)))
+       (let ((table (copy-syntax-table drums-syntax-table)))
+ 	(modify-syntax-entry ?\' "w" table)
+ 	(set-syntax-table table))
+       (setq c (following-char))
+       (when (and (memq c ttoken)
+ 		 (not (memq c stoken)))
+ 	(setq type (downcase (buffer-substring
+ 			      (point) (progn (forward-sexp 1) (point)))))
+ 	;; Do the params
+ 	(while (not (eobp))
+ 	  (setq c (following-char))
+ 	  (unless (eq c ?\;)
+ 	    (error "Invalid header: %s" string))
+ 	  (forward-char 1)
+ 	  (setq c (following-char))
+ 	  (if (and (memq c ttoken)
+ 		   (not (memq c stoken)))
+ 	      (setq attribute
+ 		    (intern
+ 		     (downcase
+ 		      (buffer-substring
+ 		       (point) (progn (forward-sexp 1) (point))))))
+ 	    (error "Invalid header: %s" string))
+ 	  (setq c (following-char))
+ 	  (setq encoded nil)
+ 	  (when (eq c ?*)
+ 	    (forward-char 1)
+ 	    (setq c (following-char))
+ 	    (when (memq c ntoken)
+ 	      (setq number
+ 		    (string-to-number
+ 		     (buffer-substring
+ 		      (point) (progn (forward-sexp 1) (point)))))
+ 	      (setq c (following-char))
+ 	      (when (eq c ?*)
+ 		(setq encoded t)
+ 		(forward-char 1)
+ 		(setq c (following-char)))))
+ 	  ;; See if we have any previous continuations.
+ 	  (when (and prev-attribute
+ 		     (not (eq prev-attribute attribute)))
+ 	    (push (cons prev-attribute prev-value) parameters)
+ 	    (setq prev-attribute nil
+ 		  prev-value ""))
+ 	  (unless (eq c ?=)
+ 	    (error "Invalid header: %s" string))
+ 	  (forward-char 1)
+ 	  (setq c (following-char))
+ 	  (cond
+ 	   ((eq c ?\")
+ 	    (setq value
+ 		  (buffer-substring (1+ (point))
+ 				    (progn (forward-sexp 1) (1- (point))))))
+ 	   ((and (memq c ttoken)
+ 		 (not (memq c stoken)))
+ 	    (setq value (buffer-substring
+ 			 (point) (progn (forward-sexp 1) (point)))))
+ 	   (t
+ 	    (error "Invalid header: %s" string)))
+ 	  (when encoded
+ 	    (setq value (rfc2231-decode-encoded-string value)))
+ 	  (if number
+ 	      (setq prev-attribute attribute
+ 		    prev-value (concat prev-value value))
+ 	    (push (cons attribute value) parameters)))
+ 
+ 	;; Take care of any final continuations.
+ 	(when prev-attribute
+ 	  (push (cons prev-attribute prev-value) parameters))
+ 
+ 	`(,type ,@(nreverse parameters))))))
+ 
+ (defun rfc2231-decode-encoded-string (string)
+   "Decode an RFC2231-encoded string.
+ These look like \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\"."
+   (with-temp-buffer
+     (let ((elems (split-string string "'")))
+       ;; The encoded string may contain zero to two single-quote
+       ;; marks.  This should give us the encoded word stripped
+       ;; of any preceding values.
+       (insert (or (car (last elems))
+ 		  string))
+       (goto-char (point-min))
+       (while (search-forward "%" nil t)
+ 	(insert
+ 	 (prog1
+ 	     (string-to-number (buffer-substring (point) (+ (point) 2)) 16)
+ 	   (delete-region (1- (point)) (+ (point) 2)))))
+       ;; Encode using the charset, if any.
+       (when (and elems
+ 		 (not (equal (car elems) 'us-ascii)))
+ 	(mm-decode-coding-region (point-min) (point-max) (car elems)))
+       (buffer-string))))
+ 
+ (provide 'rfc2231)
+ 
+ ;;; rfc2231.el ends here
*** pub/pgnus/lisp/ChangeLog	Fri Sep 11 18:21:50 1998
--- pgnus/lisp/ChangeLog	Sat Sep 12 09:15:34 1998
***************
*** 1,3 ****
--- 1,47 ----
+ Sat Sep 12 09:17:30 1998  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
+ 
+ 	* gnus.el: Pterodactyl Gnus v0.28 is released.
+ 
+ 1998-09-12 04:57:25  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+ 
+ 	* gnus-art.el (gnus-mime-button-map): Use the article keymap as a
+ 	starting point.
+ 	(article-decode-encoded-words): Rename.
+ 
+ 	* message.el (message-narrow-to-headers-or-head): New function.
+ 
+ 	* gnus-int.el (gnus-request-accept-article): Narrow to the right
+ 	region. 
+ 
+ 	* message.el (message-send-news): Encode body after checking
+ 	syntax. 
+ 
+ 	* gnus-art.el (gnus-mime-button-line-format): Allow descriptions.
+ 
+ 	* mm-decode.el (mm-save-part): Use Content-Disposition filename.
+ 
+ 	* gnus-art.el (gnus-display-mime): Respect disposition.
+ 
+ 	* mm-decode.el (mm-preferred-alternative): Respect disposition.
+ 
+ 	* gnus-art.el (article-strip-multiple-blank-lines): Don't delete
+ 	text with annotations.
+ 
+ 	* message.el (message-make-date): Fix sign for negative time
+ 	zones. 
+ 
+ 	* mm-view.el (mm-inline-image): Insert a space at the end of the
+ 	image. 
+ 
+ 	* mail-parse.el: New file.
+ 
+ 	* rfc2231.el: New file.
+ 
+ 	* drums.el (drums-content-type-get): Removed.
+ 	(drums-parse-content-type): Ditto.
+ 
+ 	* mailcap.el (mailcap-mime-data): Use symbols instead of strings. 
+ 
  Fri Sep 11 18:23:34 1998  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
  
  	* gnus.el: Pterodactyl Gnus v0.27 is released.
*** pub/pgnus/texi/gnus.texi	Fri Sep 11 18:21:53 1998
--- pgnus/texi/gnus.texi	Sat Sep 12 09:15:39 1998
***************
*** 1,7 ****
  \input texinfo                  @c -*-texinfo-*-
  
  @setfilename gnus
! @settitle Pterodactyl Gnus 0.27 Manual
  @synindex fn cp
  @synindex vr cp
  @synindex pg cp
--- 1,7 ----
  \input texinfo                  @c -*-texinfo-*-
  
  @setfilename gnus
! @settitle Pterodactyl Gnus 0.28 Manual
  @synindex fn cp
  @synindex vr cp
  @synindex pg cp
***************
*** 318,324 ****
  @tex
  
  @titlepage
! @title Pterodactyl Gnus 0.27 Manual
  
  @author by Lars Magne Ingebrigtsen
  @page
--- 318,324 ----
  @tex
  
  @titlepage
! @title Pterodactyl Gnus 0.28 Manual
  
  @author by Lars Magne Ingebrigtsen
  @page
***************
*** 354,360 ****
  spool or your mbox file.  All at the same time, if you want to push your
  luck.
  
! This manual corresponds to Pterodactyl Gnus 0.27.
  
  @end ifinfo
  
--- 354,360 ----
  spool or your mbox file.  All at the same time, if you want to push your
  luck.
  
! This manual corresponds to Pterodactyl Gnus 0.28.
  
  @end ifinfo
  
***************
*** 8086,8091 ****
--- 8086,8097 ----
  (This is the default.)  If @code{nil}, each group will have its own
  article buffer.
  
+ @vindex gnus-article-decode-hook
+ @item gnus-article-decode-hook
+ @cindex MIME
+ Hook used to decode @sc{mime} articles.  The default value is
+ @code{(article-decode-charset article-decode-encoded-words)}
+ 
  @vindex gnus-article-prepare-hook
  @item gnus-article-prepare-hook
  This hook is called right after the article has been inserted into the
***************
*** 9641,9654 ****
  
  @vindex nnmail-split-hook
  @item nnmail-split-hook
! @findex article-decode-rfc1522
  @findex RFC1522 decoding
  Hook run in the buffer where the mail headers of each message is kept
  just before the splitting based on these headers is done.  The hook is
  free to modify the buffer contents in any way it sees fit---the buffer
  is discarded after the splitting has been done, and no changes performed
! in the buffer will show up in any files.  @code{gnus-article-decode-rfc1522}
! is one likely function to add to this hook.
  
  @vindex nnmail-pre-get-new-mail-hook
  @vindex nnmail-post-get-new-mail-hook
--- 9647,9662 ----
  
  @vindex nnmail-split-hook
  @item nnmail-split-hook
! @findex article-decode-encoded-words
  @findex RFC1522 decoding
+ @findex RFC2047 decoding
  Hook run in the buffer where the mail headers of each message is kept
  just before the splitting based on these headers is done.  The hook is
  free to modify the buffer contents in any way it sees fit---the buffer
  is discarded after the splitting has been done, and no changes performed
! in the buffer will show up in any files.
! @code{gnus-article-decode-encoded-words} is one likely function to add
! to this hook.
  
  @vindex nnmail-pre-get-new-mail-hook
  @vindex nnmail-post-get-new-mail-hook
*** pub/pgnus/texi/message.texi	Fri Sep 11 18:21:53 1998
--- pgnus/texi/message.texi	Sat Sep 12 09:15:39 1998
***************
*** 1,7 ****
  \input texinfo                  @c -*-texinfo-*-
  
  @setfilename message
! @settitle Pterodactyl Message 0.27 Manual
  @synindex fn cp
  @synindex vr cp
  @synindex pg cp
--- 1,7 ----
  \input texinfo                  @c -*-texinfo-*-
  
  @setfilename message
! @settitle Pterodactyl Message 0.28 Manual
  @synindex fn cp
  @synindex vr cp
  @synindex pg cp
***************
*** 42,48 ****
  @tex
  
  @titlepage
! @title Pterodactyl Message 0.27 Manual
  
  @author by Lars Magne Ingebrigtsen
  @page
--- 42,48 ----
  @tex
  
  @titlepage
! @title Pterodactyl Message 0.28 Manual
  
  @author by Lars Magne Ingebrigtsen
  @page
***************
*** 83,89 ****
  * Key Index::         List of Message mode keys.
  @end menu
  
! This manual corresponds to Pterodactyl Message 0.27.  Message is
  distributed with the Gnus distribution bearing the same version number
  as this manual.
  
--- 83,89 ----
  * Key Index::         List of Message mode keys.
  @end menu
  
! This manual corresponds to Pterodactyl Message 0.28.  Message is
  distributed with the Gnus distribution bearing the same version number
  as this manual.
  
*** pub/pgnus/texi/ChangeLog	Fri Sep 11 18:21:54 1998
--- pgnus/texi/ChangeLog	Sat Sep 12 09:15:40 1998
***************
*** 1,3 ****
--- 1,7 ----
+ 1998-09-12 08:53:05  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+ 
+ 	* gnus.texi (Misc Article): Addition.
+ 
  1998-09-11 08:52:50  Lars Magne Ingebrigtsen  <larsi@gnus.org>
  
  	* gnus.texi (Group Score Commands): Fix.
