NetNews Usenet Archive 1992 #31/NN_1992_31.iso/spool/sfnet/tietolii/ryhmatl/493

Text File | 1992-12-27 | 11.9 KB | 351 lines

Xref: sparky sfnet.tietoliikenne.ryhmat+listat:493 sfnet.atk.sodat:668 sfnet.tietoliikenne.viestinviejat:37 sfnet.atk.gnu:12
Path: sparky!uunet!mcsun!news.funet.fi!funic!sauna.cs.hut.fi!cs.hut.fi!jpm
From: [e-mail] (Jussi-Pekka Mantere)
Newsgroups: sfnet.tietoliikenne.ryhmat+listat,sfnet.atk.sodat,sfnet.tietoliikenne.viestinviejat,sfnet.atk.gnu
Subject: MIME & GNUS
Followup-To: sfnet.atk.gnu
Date: 27 Dec 92 13:46:23 GMT
Organization: Helsinki University of Technology, Finland
Lines: 332
Distribution: sfnet
Message-ID: <[e-mail]>
References: <[e-mail]> <[e-mail]>
    <[e-mail]>
    <[e-mail]>
    <[e-mail]>
NNTP-Posting-Host: cardhu.cs.hut.fi
In-reply-to: [e-mail]'s message of Sat, 26 Dec 92 16:51:05 GMT

Matti Aarnio <[e-mail]> kirjoittaa:

     Tervemenoa tekem{{n GNUS-versio, joka sis{lt{{ uudet speedup
   paketit ja MIME-featuret, sille on varmasti kysynt{{!

Avot, t{ss{!

Chape

Newsgroups: comp.mail.mime,gnu.emacs.gnus
From: [e-mail] (Joe Ilacqua)
Subject: MIME support for GNUS.
Message-ID: <[e-mail]>
Organization: Software Tool & Die
Date: Wed, 23 Dec 1992 23:28:19 GMT


    This is more of a proof of concept than a finished product,
but it seems to work.  This package allows you to read MIME format
news articles, use richtext in you postings, and insert (presumably
binary) files into you messages.

    You need to have "Metamail" installed and have
"transparent.el" in your load path.
Have fun.

->Spike

#!/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 12/23/1992 23:24 UTC by spike@world
# Source directory /staff/spike
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#   9416 -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 <[e-mail]>
;;  with code from Michael Littman's <[e-mail]>
;;  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    (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 [e-mail].
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      )))
SHAR_EOF
chmod 0664 gnus-mime.el ||
echo 'restore of gnus-mime.el failed'
Wc_c="`wc -c < 'gnus-mime.el'`"
test 9416 -eq "$Wc_c" ||
    echo 'gnus-mime.el: original size 9416, current size' "$Wc_c"
fi
exit 0