🚀 go-pugleaf

In the referenced article guenther@stolaf.edu (Philip A Guenther) writes:
<Does antone happen to have patches to gnus to make it MIME compatible?

	Why yes, I do.  It still needs work, but it does quite a few
things right.

->Spike

---Cut Here---

#!/bin/sh
# This is a shell archive (produced by shar 3.50)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 01/12/1993 22:25 UTC by spike@world
# Source directory /staff/spike
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#   9436 -rw-rw-r-- gnus-mime.el
#
# ============= gnus-mime.el ==============
if test -f 'gnus-mime.el' -a X"$1" != X"-c"; then
	echo 'x - skipping gnus-mime.el (File already exists)'
else
echo 'x - extracting gnus-mime.el (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'gnus-mime.el' &&
;;;  Support to read/post MIME format USENET articles in GNUS.
X
;;  Author Spike <Spike@world.std.com>
;;  with code from Michael Littman's <mlittman@breeze.bellcore.com>
;;  richtext.el and metamail's MH-E patches.
X
X
;;  This requires that you have the metamail package installed
;;  (thumper.bellcore.com:/pub/nsb/mm.tar.Z) and transparent.el
;;  
;;  This package provides four basic functions
;;
;;  gnus-Subject-run-metamail - invokes metamail on the selected news article.
;;  gnus-inews-article - replaces the standard gnus-inews-article with one
;;                       which inserts MIME headers and does Richtext style
;;                       signatures.
;;  gnus-richtext-posting - converts the posting buffer to Richtext format,
;;                          knows how to make text bold, italics, and
;;                          underlined.
;;  gnus-insert-file-as-mime - Allows you to insert arbitrary data into
;;                             a posting in MIME format.  Automatically
;;                             recognizes some formats (GIF, JPEG, PS),
;;                             more can be add through "auto-mime-id-list".
X
;;  As ships this binds gnus-Subject-run-metamail to "@" in the "*Subject*"
;;  buffer.  gnus-richtext-posting to "C-c r" and "gnus-insert-file-as-mime" to
;;  "C-c i" in the posting buffer.
;;
X
;;  To use put "(load-library "gnus-mime.el")" in your ".emacs" or "default.el"
X
;;  If you want GNUS to announce MIME postings but something like:
;;  (setq gnus-Article-prepare-hook
;;       '(lambda ()
;;	  (gnus-Subject-check-content-type)))
;;  in your ".emacs" file.
X
;; CAVEATS: You can only insert one file per posting.  You can not call
;;          gnus-richtext-posting after calling gnus-insert-file-as-mime.
X
(require 'transparent)
;;(load-library "rnewspost") ;; sigh...  This could be better.
(require 'gnuspost)
(provide 'gnus-mime)
X
(defvar gnus-invoke-mime-key "@" 
X  "The key that calls gnus-Subject-run-metamail")
X
(define-key gnus-Subject-mode-map gnus-invoke-mime-key
X  'gnus-Subject-run-metamail)
X
(define-key news-reply-mode-map "\C-cr" 'gnus-richtext-posting)
(define-key news-reply-mode-map "\C-ci" 'gnus-insert-file-as-mime)
X
(defvar auto-mime-id-list nil "\
A list of filename patterns vs corresponding MIME type strings
Each element looks like (REGEXP . TYPE).")
(setq auto-mime-id-list (mapcar 'purecopy
X                              '(("\\.gif$" . "image/gif")
X				("\\.jpg$" . "image/jpeg")
X				("\\.xwd$" . "image/x-xwd")
X				("\\.ps$"  . "application/PostScript"))))
X
;;;;;;
X
(defun gnus-Subject-check-content-type ()
X  (if (gnus-fetch-field "Mime-Version")
X      (let ((content-type (gnus-fetch-field "Content-Type")))
X	   (message (concat "You can use '" gnus-invoke-mime-key 
X			    "' to view this '" content-type 
X			    "' MIME format article.")))))
X
(defun gnus-Subject-run-metamail ()
X  (interactive)
X  "Process Selected Article Through \"metamail\"."
X  (gnus-Subject-select-article)
X  (gnus-eval-in-buffer-window gnus-Article-buffer
X  (let ((metamail-tmpfile (make-temp-name "/tmp/rmailct")))
X    (save-restriction
X      (widen)
X      (write-region (point-min) (point-max) metamail-tmpfile))
X    (if 
X	(and window-system (getenv "DISPLAY"))
X	(let ((buffer-read-only nil))
X	  (push-mark (point) t)
X	  (erase-buffer)
X	  (call-process "metamail" nil t t
X		 "-m" "mh-e" "-x" "-d" "-q" "-z" metamail-tmpfile)
X	  (exchange-point-and-mark)
X	  (set-buffer-modified-p nil)
X	  (other-window -1))
X      (progn
X	(other-window -1)
X	(switch-to-buffer "METAMAIL")
X	(erase-buffer)
X	(sit-for 0)
X	(transparent-window
X	 "METAMAIL"
X	 "metamail"
X	 (list "-p" "-d" "-q" metamail-tmpfile)
X	 nil
X	 (concat
X	  "\n\r\n\r*****************************************"
X	  "*******************************\n\rPress any key "
X	  "to go back to EMACS\n\r\n\r***********************" 
X	  "*************************************************\n\r")))
X      )
X    )
X  )
X )
X
X
(defvar rich-substitutions
X      '(
X        ("<"        "<lt>") ; in case some one sends less-thans.
X        ("\\B%\\b" "</italic>") ; needs to be first to not get closing tags.
X        ("\\b%\\B" "<italic>")
X        ("\\B\\*\\b" "<bold>")
X        ("\\b\\*\\B" "</bold>")
X        ("
" "
<nl>")
X        ("\\B_\\b" "<underline>")
X        ("\\b_\\B" "</underline>")
X        )
X      "A table of REGEXP to translate text to MIME's text/richtext format.")
X
(defun gnus-richtext-posting ()
X  "Convert the current buffer to MIME's \"text/richtext\" format.
\"*foo*\" is converted to bold, \"%foo%\" to italics, and \"_foo_\" to
underlined. Note: this does not recognize font markers *after*
punctuation, thus \"*foo!*\" will not work."
X  (interactive)
X  (mail-position-on-field "Subject")
X  (or (gnus-fetch-field "Mime-Version")
X      (insert "\nMime-Version: 1.0"))
X  (or (gnus-fetch-field "Content-Type")
X      (insert "\nContent-Type: text/richtext"))
X  (goto-char (point-min))
X  (search-forward (concat "\n" mail-header-separator "\n") nil t)
X  (perform-rich-sub)
X  )
X
(defun perform-rich-sub ()
X  "Perform the rich substiution."
X  (let ((subs rich-substitutions)
X        pat rep
X        (top (point)))
X    (save-excursion
X      (while subs
X        (setq pat (car (car subs)))
X        (setq rep (car (cdr (car subs))))
X        (setq subs (cdr subs))
X        (goto-char top)
X        (while (re-search-forward pat (point-max) t)
X          (replace-match rep))
X        ))))
X
(defun gnus-insert-file-as-mime (filename)
X  "Encode and insert a file into the posting buffer and setup the correct
MIME headers for that file type."
X  (interactive "FFind file: ")
X  (let ((ctype nil)
X	(boundary
X	 (concat "GNUS.BOUNDARY." (system-name) "." (current-time-string))))
X    (let ((mlist auto-mime-id-list)
X	  (name filename))
X      (while (and (not ctype) mlist)
X	(if (string-match (car (car mlist)) name)
X	    (setq ctype (cdr (car mlist))))
X              (setq mlist (cdr mlist))))
X    (if (not ctype)
X	(setq ctype 
X	      (read-string "MIME content type: " "application/octet-stream")))
X    (goto-char (point-min))
X    (re-search-forward
X     (concat "^" (regexp-quote mail-header-separator) "\n"))
X    (insert (concat "--" boundary "\n"))
X    (insert "Content-type: text/richtext\n")
X    (insert "Content-Transfer-Encoding: quoted-printable\n\n")
X    (goto-char (point-max))
X    (insert (concat "\n--" boundary "\n"))
X    (insert (concat "Content-type: " ctype "\n"))
X    (insert "Content-Transfer-Encoding: base64\n\n")
X    (shell-command (concat "mmencode " filename) t)
X    (goto-char (point-max))
X    (insert (concat "\n--" boundary "\n"))
X    (mail-position-on-field "Subject")
X    (or (gnus-fetch-field "Mime-Version")
X	(insert "\nMime-Version: 1.0"))
X    (if (gnus-fetch-field "Content-Type")
X	(progn
X	  (mail-position-on-field "Content-Type")
X	  (beginning-of-line)
X	  (delete-region (point) (progn (forward-line 1) (point)))))
X      (insert (concat "Content-Type: multipart/mixed;\n"
X		      "\tboundary=\"" boundary "\"\n"))
X    ))
X
(defun gnus-inews-article ()
X  "NNTP inews interface."
X  (let ((signature
X	 (if gnus-signature-file
X	     (expand-file-name gnus-signature-file nil)))
X	(distribution nil)
X	(artbuf (current-buffer))
X	(tmpbuf (get-buffer-create " *GNUS-posting*"))
X	(ctype nil)
X	(boundary nil))
X    (save-excursion
X      (set-buffer tmpbuf)
X      (buffer-flush-undo (current-buffer))
X      (erase-buffer)
X      (insert-buffer-substring artbuf)
X      ;; Get distribution.
X      (setq distribution (gnus-fetch-field "Distribution"))
X      (if signature
X	  (progn
X	    ;; Change signature file by distribution.
X	    ;; Suggested by hyoko@flab.fujitsu.junet.
X	    (if (file-exists-p (concat signature "-" distribution))
X		(setq signature (concat signature "-" distribution)))
X	    ;; Insert signature.
X	    (if (file-exists-p signature)
X		(progn
X		  ;; Mime signature format
X		  (setq ctype (gnus-fetch-field "Content-Type"))
X		  (if (and ctype (string-match "multipart/mixed" ctype))
X		      (progn
X			(string-match "boundary=\"" ctype)
X			(setq boundary (substring ctype  (- (match-end 0) 1)))
X			(string-match "\"" boundary)
X			(setq boundary 
X			      (substring boundary 0 (- (match-end 0) 1)))
X			(goto-char (point-max))
X			(insert (concat "--" boundary "\n"))
X			(insert "Content-type: text/richtext\n")
X			(insert "Content-Transfer-Encoding: quoted-printable\n\n")
X			))
X		  (goto-char (point-max))
X		  (insert "<signature>")
X		  (insert-file-contents signature)
X		  (goto-char (point-max))
X		  (insert "</signature>\n")))
X	    ))
X      ;; Prepare article headers.
X      (save-restriction
X	(goto-char (point-min))
X	(search-forward "\n\n")
X	(narrow-to-region (point-min) (point))
X	(gnus-inews-insert-headers)
X	;; insert mime headers if needed.
X	(goto-char (point-max))
X	(forward-line -2)
X	(or (gnus-fetch-field "Mime-Version")
X	    (insert "Mime-Version: 1.0\n"))
X	(or (gnus-fetch-field "Content-Type")
X	    (insert "Content-Type: text/richtext\n"))
X	;; Save author copy of posted article. The article must be
X	;;  copied before being posted because `gnus-request-post'
X	;;  modifies the buffer.
X	(let ((case-fold-search t))
X	  ;; Find and handle any FCC fields.
X	  (goto-char (point-min))
X	  (if (re-search-forward "^FCC:" nil t)
X	      (gnus-inews-do-fcc))))
X      (widen)
X      ;; Run final inews hooks.
X      (run-hooks 'gnus-Inews-article-hook)
X      ;; Post an article to NNTP server.
X      ;; Return NIL if post failed.
X      (prog1
X	  (gnus-request-post)
X	(kill-buffer (current-buffer)))
X      )))
X
SHAR_EOF
chmod 0664 gnus-mime.el ||
echo 'restore of gnus-mime.el failed'
Wc_c="`wc -c < 'gnus-mime.el'`"
test 9436 -eq "$Wc_c" ||
	echo 'gnus-mime.el: original size 9436, current size' "$Wc_c"
fi
exit 0