🚀 go-pugleaf

---- Cut Here and unpack ----
#!/bin/sh
# this is part 2 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file mime.el continued
#
CurArch=2
if test ! -r s2_seq_.tmp
then echo "Please unpack part 1 first!"
     exit 1; fi
( read Scheck
  if test "$Scheck" != $CurArch
  then echo "Please unpack part $Scheck next!"
       exit 1;
  else exit 0; fi
) < s2_seq_.tmp || exit 1
sed 's/^X//' << 'SHAR_EOF' >> mime.el
X		(stringp encoding))
X	   (setq string
X		 (if qp (concat string "\n") string))
X	   (let ((encoded (funcall mime-string-encoder method string)))
X	     (setq encoded
X		   (substring encoded 0 (1- (length encoded))))
X	     (if (string-equal string encoded)
X		 string
X	       (concat "=?" charset "?" encoding "?" encoded "?="))))
X	  ;; Return string without any encoding.
X	  (t string)
X	  )))
X
X(defun mime-search-for-code-boundary ()
X  "Search for code boundary starting from current point and return points."
X  (let ((repeat t)
X	(lastwhite nil)
X	(poslist nil)			;possible boundary points
X	(encoding (and (not (eobp))
X		       (funcall mime-header-charset-chooser
X				(point)
X				(save-excursion
X				  (forward-char 1) (point))))))
X    (while repeat
X      (while (and (not (eobp))
X		  (equal encoding
X			 (funcall mime-header-charset-chooser
X				  (point)
X				  (save-excursion
X				    (forward-char 1) (point)))))
X	(setq lastwhite nil)
X	(forward-char 1))
X      ;; Remember the candidate.
X      (if (not lastwhite)
X	  (setq poslist (cons (point) poslist)))
X      ;; Iterate if the next of the next whitespace is the same.
X      (if (looking-at "[ \t]")
X	  (skip-chars-forward " \t")
X	(setq repeat nil))
X      (setq lastwhite t)
X      )
X    ;; Goto the last point.
X    (goto-char (car poslist))
X    poslist
X    ))
X
X(defun mime-translate-body ()
X  "Encode the tagged MIME body in current buffer in MIME compliant message."
X  (interactive)
X  (save-excursion
X    (let ((boundary
X	   (concat mime-multipart-boundary " " (current-time-string)))
X	  (tag nil)			;MIME tag
X	  (contype nil)			;Content-Type
X	  (encoding nil)		;Content-Transfer-Encoding
X	  (nparts 0))			;Number of body parts
X      (save-restriction
X	;; We are interested in message body.
X	(let* ((beg
X		(progn
X		  (goto-char (point-min))
X		  (re-search-forward
X		   (concat "\n" mail-header-separator
X			   (if mime-ignore-preceding-spaces
X			       "[ \t\n]*\n" "\n")) nil 'move)
X		  (point)))
X	       (end
X		(progn
X		  (goto-char (point-max))
X		  (and mime-ignore-trailing-spaces
X		       (re-search-backward "[^ \t\n]\n" beg t)
X		       (forward-char 1))
X		  (point))))
X	  (narrow-to-region beg end))
X	;; Normalize the body part by inserting appropriate message
X	;; tags for every message contents.
X	(mime-normalize-body)
X	;; Counting the number of Content-Type.
X	(goto-char (point-min))
X	(while (re-search-forward mime-tag-regexp nil t)
X	  (setq nparts (1+ nparts)))
X	;; Begin translation.
X	(cond ((<= nparts 1)
X	       ;; It's a singular message.
X	       (goto-char (point-min))
X	       (while (re-search-forward mime-tag-regexp nil t)
X		 (setq tag
X		       (buffer-substring (match-beginning 0) (match-end 0)))
X		 (delete-region (match-beginning 0) (1+ (match-end 0)))
X		 (setq contype (mime-get-contype tag))
X		 (setq encoding (mime-get-encoding tag))
X		 ))
X	      (t
X	       ;; It's a multipart message.
X	       (goto-char (point-min))
X	       (while (re-search-forward mime-tag-regexp nil t)
X		 (setq tag
X		       (buffer-substring (match-beginning 0) (match-end 0)))
X		 (delete-region (match-beginning 0) (match-end 0))
X		 (setq contype (mime-get-contype tag))
X		 (setq encoding (mime-get-encoding tag))
X		 (insert "--" boundary "\n")
X		 (insert "Content-Type: " contype "\n")
X		 (if encoding
X		     (insert "Content-Transfer-Encoding: " encoding "\n"))
X		 )
X	       ;; Define Content-Type as "multipart/mixed".
X	       (setq contype
X		     (concat "multipart/mixed; boundary=\"" boundary "\""))
X	       ;; Content-Transfer-Encoding must be "7bit".
X	       ;; The following encoding can be `nil', but is
X	       ;; specified as is since there is no way that a user
X	       ;; specifies it.
X	       (setq encoding "7bit")
X	       ;; Insert the trailer.
X	       (goto-char (point-max))
X	       (if (not (= (preceding-char) ?\n))
X		   ;; Boundary must start with a newline.
X		   (insert "\n"))
X	       (insert "--" boundary "--\n")))
X	)
X      ;; Make primary MIME headers.
X      (or (mail-position-on-field "Mime-Version")
X	  (insert mime-version-number))
X      ;; Remove old Content-Type and other fields.
X      (save-restriction
X	(goto-char (point-min))
X	(search-forward (concat "\n" mail-header-separator "\n") nil t)
X	(narrow-to-region (point-min) (point))
X	(goto-char (point-min))
X	(mime-delete-field "Content-Type")
X	(mime-delete-field "Content-Transfer-Encoding"))
X      ;; Then, insert Content-Type and Content-Transfer-Encoding fields.
X      (mail-position-on-field "Content-Type")
X      (insert contype)
X      (if encoding
X	  (progn
X	    (mail-position-on-field "Content-Transfer-Encoding")
X	    (insert encoding)))
X      )))
X
X(defun mime-normalize-body ()
X  "Normalize the body part by inserting appropriate message tags."
X  ;; Insert the first MIME tags if necessary.
X  (goto-char (point-min))
X  (if (not (looking-at mime-tag-regexp))
X      (insert (mime-make-text-tag) "\n"))
X  ;; Check each tag, and add new tag or correct it if necessary.
X  (goto-char (point-min))
X  (while (re-search-forward mime-tag-regexp nil t)
X    (let* ((tag (buffer-substring (match-beginning 0) (match-end 0)))
X	   (contype (mime-get-contype tag))
X	   (charset (mime-get-parameter contype "charset"))
X	   (encoding (mime-get-encoding tag)))
X      ;; Remove extra whitespaces after the tag.
X      (if (looking-at "[ \t]+$")
X	  (delete-region (match-beginning 0) (match-end 0)))
X      (cond ((= (following-char) ?\^M)
X	     ;; It must be image, audio or video.
X	     (let ((beg (point))
X		   (end (mime-content-end)))
X	       ;; Insert explicit MIME tags after hidden messages.
X	       (forward-line 1)
X	       (if (and (not (eobp))
X			(not (looking-at mime-tag-regexp)))
X		   (progn
X		     (insert (mime-make-text-tag) "\n")
X		     (forward-line -1)	;Process it again as text.
X		     ))
X	       ;; Show a hidden message.  The point is not altered
X	       ;; after the conversion.
X	       (mime-flag-region beg end ?\n)))
X	    ((mime-test-content-type contype "message")
X	     ;; Content-type "message" should be sent as is.
X	     (forward-line 1))
X	    ((mime-test-content-type contype "text")
X	     ;; Define charset for text if necessary.
X	     (setq charset (or charset (mime-choose-charset)))
X	     (mime-define-charset charset)
X	     ;; Point is now on current tag.
X	     ;; Define encoding and encode text if necessary.
X	     (if (null encoding)	;Encoding is not specified.
X		 (let* ((encoding (mime-choose-encoding))
X			(beg (mime-content-beginning))
X			(end (mime-content-end))
X			(body (buffer-substring beg end))
X			(encoded (funcall mime-string-encoder
X					  (cons charset encoding) body)))
X		   (if (not (string-equal body encoded))
X		       (progn
X			 (goto-char beg)
X			 (delete-region beg end)
X			 (insert encoded)
X			 (goto-char beg)))
X		   (mime-define-encoding encoding)))
X	     (forward-line 1))
X	    ((null encoding)		;Encoding is not specified.
X	     ;; Application, image, audio, video, and any other
X	     ;; unknown content-type without encoding should be
X	     ;; encoded.
X	     (let* ((encoding "base64")	;Encode in BASE64 by default.
X		    (beg (mime-content-beginning))
X		    (end (mime-content-end))
X		    (body (buffer-substring beg end))
X		    (encoded (funcall mime-string-encoder
X				      (cons nil encoding) body)))
X	       (if (not (string-equal body encoded))
X		   (progn
X		     (goto-char beg)
X		     (delete-region beg end)
X		     (insert encoded)
X		     (goto-char beg)))
X	       (mime-define-encoding encoding))
X	     (forward-line 1))
X	    )
X      )))
X
X(defun mime-delete-field (field)
X  "Delete header FIELD."
X  (let ((regexp (format "^%s:[ \t]*" field)))
X    (goto-char (point-min))
X    (while (re-search-forward regexp nil t)
X      (delete-region (match-beginning 0)
X		     (progn (forward-line 1) (point)))
X      )))
X
X
X;;;
X;;; Platform dependent functions
X;;;
X
X;; Emacs 18 implementations
X
X(defun mime-header-charset-chooser-for-emacs18 (begin end)
X  "Return a cons of charset and header encoding for a given header region.
XEncoding name must be a short name, such as `B' or `Q'."
X  nil					;No encoding is necessary.
X  )
X
X(defun mime-body-charset-chooser-for-emacs18 (begin end)
X  "Return a cons of charset and encoding of a message in a given region.
XEncoding name must be a canonical name, such as `base64'."
X  '("US-ASCII" . nil)			;Default charset of MIME.
X  )
X
X(defun mime-string-encoder-for-emacs18 (method string)
X  "For given METHOD that is a cons of charset and encoding, encode a STRING."
X  (let ((charset (car method))
X	(encoding (cdr method)))
X    (cond ((stringp encoding)
X	   (mime-encode-string encoding string))
X	  ;; Return string without any encoding.
X	  (t string)
X	  )))
X
X
X;; Emacs 19 implementations
X
X(defun mime-header-charset-chooser-for-emacs19 (begin end)
X  "Return a cons of charset and header encoding for a given header region.
XEncoding name must be a short name, such as `B' or `Q'.
XUS-ASCII and ISO-8859-1 are supported on Emacs 19."
X  (cond ((save-excursion
X	   (goto-char begin)
X	   (re-search-forward "[\200-\377]" end t))
X	 '("ISO-8859-1" . "Q"))
X	(t nil)				;No encoding is necessary.
X	))
X
X(defun mime-body-charset-chooser-for-emacs19 (begin end)
X  "Return a cons of charset and encoding of a message in a given region.
XEncoding name must be a canonical name, such as `base64'.
XUS-ASCII and ISO-8859-1 are supported on Emacs 19."
X  (cond ((save-excursion
X	   (goto-char begin)
X	   (re-search-forward "[\200-\377]" end t))
X	 '("ISO-8859-1" . "quoted-printable"))
X	(t
X	 '("US-ASCII" . nil))		;Default charset of MIME.
X	))
X
X(defun mime-string-encoder-for-emacs19 (method string)
X  "For given METHOD that is a cons of charset and encoding, encode a STRING."
X  (let ((charset (car method))
X	(encoding (cdr method)))
X    (cond ((stringp encoding)
X	   (mime-encode-string encoding string))
X	  ;; Return string without any encoding.
X	  (t string)
X	  )))
X
X
X;; NEmacs implementations
X
X(defun mime-header-charset-chooser-for-nemacs (begin end)
X  "Return a cons of charset and header encoding for a given header region.
XEncoding name must be a short name, such as `B' or `Q'.
XUS-ASCII and ISO-2022-JP are supported on NEmacs."
X  (cond ((check-region-kanji-code begin end)
X	 '("ISO-2022-JP" . "B"))
X	(t nil)				;No encoding is necessary.
X	))
X
X(defun mime-body-charset-chooser-for-nemacs (begin end)
X  "Return a cons of charset and encoding of a message in a given region.
XEncoding name must be a canonical name, such as `base64'.
XUS-ASCII and ISO-2022-JP are supported on NEmacs."
X  (cond ((check-region-kanji-code begin end)
X	 ;; The following are safe encoding methods for use in
X	 ;; USENET News systems that strip off all ESCs.
X	 ;; '("ISO-2022-JP" . "quoted-printable")
X	 ;; '("ISO-2022-JP" . "base64")
X	 ;; The following expects transport systems are all MIME
X	 ;; compliants.  For instance, ESCs are never stripped off.
X	 '("ISO-2022-JP" . nil))
X	(t
X	 '("US-ASCII" . nil))		;Default charset of MIME.
X	))
X
X(defun mime-string-encoder-for-nemacs (method string)
X  "For given METHOD that is a cons of charset and encoding, encode a STRING.
XUS-ASCII and ISO-2022-JP are supported on NEmacs."
X  (let ((charset (car method))
X	(encoding (cdr method)))
X    (cond ((stringp encoding)
X	   (mime-encode-string encoding
X			       ;; Convert internal (EUC) to JIS code.
X			       (convert-string-kanji-code string 3 2)
X			       ))
X	  ;; NEmacs can convert into ISO-2022-JP automatically,
X	  ;; but can do it myself as follows:
X	  ;;(t (convert-string-kanji-code string 3 2))
X
X	  ;; Return string without any encoding.
X	  (t string)
X	  )))
X
X
X;; Mule implementations
X;; Thanks to contributions by wkenji@flab.fujitsu.co.jp (Kenji
X;; WAKAMIYA) and handa@etl.go.jp (Kenichi Handa).
X
X(defun mime-header-charset-chooser-for-mule (begin end)
X  "Return cons of charset and header encoding for a given header region.
XEncoding name must be a short name, such as `B' or `Q'.  US-ASCII,
XISO-8859-* (except for ISO-8859-6), ISO-2022-JP and X-ISO-2022-JP-2
Xare supported on Mule."
X  (let ((lclist (find-charset-region begin end)))
X    (cond ((null lclist) nil)		;US-ASCII requres no encoding.
X	  ((memq lc-ltn1 lclist)
X	   '("ISO-8859-1" . "Q"))
X	  ((memq lc-ltn2 lclist)
X	   '("ISO-8859-2" . "Q"))
X	  ((memq lc-ltn3 lclist)
X	   '("ISO-8859-3" . "Q"))
X	  ((memq lc-ltn4 lclist)
X	   '("ISO-8859-4" . "Q"))
X	  ((memq lc-crl lclist)
X	   '("ISO-8859-5" . "Q"))
X	  ;;((memq lc-arb lclist)
X	  ;; '("ISO-8859-6" . "Q"))
X	  ((memq lc-grk lclist)
X	   '("ISO-8859-7" . "Q"))
X	  ((memq lc-hbw lclist)
X	   '("ISO-8859-8" . "Q"))
X	  ((memq lc-ltn5 lclist)
X	   '("ISO-8859-9" . "Q"))
X	  ((memq lc-jp lclist)
X	   '("ISO-2022-JP" . "B"))
X	  (t				;Unknown charset.  It must be Mule!
X	   '("X-ISO-2022-JP-2" . "B"))
X	  )))
X
X(defun mime-body-charset-chooser-for-mule (begin end)
X  "Return a cons of charset and encoding of a message in a given region.
XEncoding name must be a canonical name, such as `base64'.  US-ASCII,
XISO-8859-* (except for ISO-8859-6), ISO-2022-JP and X-ISO-2022-JP-2
Xare supported on Mule.  Charset X-ISO-2022-JP-2 is used for
Xmultilingual text, and it is expected to be encoded in Mule style."
X  (let ((lclist (find-charset-region begin end)))
X    (cond ((null lclist)
X	   '("US-ASCII" . nil))		;Default charset of MIME.
X	  ((> (length lclist) 1)	;Requre multilingual capability
X	   '("X-ISO-2022-JP-2" . nil))
X	  ((memq lc-ltn1 lclist)
X	   '("ISO-8859-1" . "quoted-printable"))
X	  ((memq lc-ltn2 lclist)
X	   '("ISO-8859-2" . "quoted-printable"))
X	  ((memq lc-ltn3 lclist)
X	   '("ISO-8859-3" . "quoted-printable"))
X	  ((memq lc-ltn4 lclist)
X	   '("ISO-8859-4" . "quoted-printable"))
X	  ((memq lc-crl lclist)
X	   '("ISO-8859-5" . "quoted-printable"))
X	  ;;((memq lc-arb lclist)
X	  ;; '("ISO-8859-6" . "quoted-printable"))
X	  ((memq lc-grk lclist)
X	   '("ISO-8859-7" . "quoted-printable"))
X	  ((memq lc-hbw lclist)
X	   '("ISO-8859-8" . "quoted-printable"))
X	  ((memq lc-ltn5 lclist)
X	   '("ISO-8859-9" . "quoted-printable"))
X	  ((memq lc-jp lclist)
X	   '("ISO-2022-JP" . nil))
X	  (t				;Unknown charset.  It must be Mule!
X	   '("X-ISO-2022-JP-2" . nil))
X	  )))
X
X(defun mime-string-encoder-for-mule (method string)
X  "For given METHOD that is a cons of charset and encoding, encode a STRING.
XUS-ASCII, ISO-8859-* (except for ISO-8859-6), ISO-2022-JP and
XX-ISO-2022-JP-2 are supported on Mule.  Charset X-ISO-2022-JP-2 used
Xfor multilingual text is encoded in Mule style."
X  (let* ((charset (car method))
X	 (encoding (cdr method))
X	 (coding-system
X	  (cdr (assoc (and (stringp charset) (upcase charset))
X		      '(("ISO-8859-1" . *ctext*)
X			("ISO-8859-2" . *iso-8859-2*)
X			("ISO-8859-3" . *iso-8859-3*)
X			("ISO-8859-4" . *iso-8859-4*)
X			("ISO-8859-5" . *iso-8859-5*)
X			;;("ISO-8859-6" . *iso-8859-6*)
X			("ISO-8859-7" . *iso-8859-7*)
X			("ISO-8859-8" . *iso-8859-8*)
X			("ISO-8859-9" . *iso-8859-9*)
X			("ISO-2022-JP" . *junet*)
X			("X-ISO-2022-JP-2" . *iso-2022-ss2-7*))))))
X    ;; In bilingual environment it may be unnecessary to convert the
X    ;; coding system of the string unless transfer encoding is
X    ;; required since such conversion may be performed by mule
X    ;; automatically.
X    (if (not (null coding-system))
X	(setq string (code-convert-string string *internal* coding-system)))
X    (if (stringp encoding)
X	(setq string (mime-encode-string encoding string)))
X    string
X    ))
X
X
X;; Sun implementations
X
X(defun mime-voice-recorder-for-sun ()
X  "Record voice in a buffer using Sun audio device, and return the buffer."
X  (let ((buffer (get-buffer-create " *MIME audio*")))
X    (message "Type C-g to finish recording...")
X    (save-excursion
X      (set-buffer buffer)
X      (erase-buffer)
X      (condition-case errorcode
X	  (let ((selective-display nil) ;Disable ^M to nl translation.
X		(mc-flag nil)		;Mule
X		(kanji-flag nil))	;NEmacs
X	    ;; Disable automatic conversion of coding system if Mule.
X	    (if (featurep 'mule)
X		(define-program-coding-system nil "cat" *noconv*))
X	    (call-process "cat"
X			  "/dev/audio"
X			  buffer
X			  nil
X			  ))
X	(quit (message "Type C-g to finish recording... done.")
X	      buffer			;Return the buffer
X	      )))))
X
X
X;;;
X;;; Other useful commands.
X;;;
X
X;; Message forwarding commands as content-type "message/rfc822".
X
X;;;###autoload
X(defun mime-forward-from-rmail-using-mail ()
X  "Forward current message in message/rfc822 content-type message from rmail."
X  (interactive)
X  ;;>> this gets set even if we abort. Can't do anything about it, though.
X  (rmail-set-attribute "forwarded" t)
X  (let ((forward-buffer (current-buffer))
X	(subject (concat "["
X			 (mail-strip-quoted-names (mail-fetch-field "From"))
X			 ": " (or (mail-fetch-field "Subject") "") "]")))
X    ;; If only one window, use it for the mail buffer.
X    ;; Otherwise, use another window for the mail buffer
X    ;; so that the Rmail buffer remains visible
X    ;; and sending the mail will get back to it.
X    (if (if (one-window-p t)
X	    (mail nil nil subject)
X	  (mail-other-window nil nil subject))
X	(save-excursion
X	  (goto-char (point-max))
X	  (forward-line 1)
X	  (mime-insert-tag "message" "rfc822")
X	  (insert-buffer forward-buffer)))))
X
X;;;###autoload
X(defun mime-forward-from-gnus-using-mail ()
X  "Forward current article in message/rfc822 content-type message from GNUS."
X  (let ((forward-buffer (current-buffer))
X	(subject
X	 (concat "[" gnus-newsgroup-name "] "
X		 ;;(mail-strip-quoted-names (gnus-fetch-field "From")) ": "
X		 (or (gnus-fetch-field "Subject") ""))))
X    ;; If only one window, use it for the mail buffer.
X    ;; Otherwise, use another window for the mail buffer
X    ;; so that the Rmail buffer remains visible
X    ;; and sending the mail will get back to it.
X    (if (if (one-window-p t)
X	    (mail nil nil subject)
X	  (mail-other-window nil nil subject))
X	(save-excursion
X	  (goto-char (point-max))
X	  (mime-insert-tag "message" "rfc822")
X	  (insert-buffer forward-buffer)
X	  ;; You have a chance to arrange the message.
X	  (run-hooks 'gnus-mail-forward-hook)
X	  ))))
X
X(provide 'mime)
X
X;;; mime.el ends here
SHAR_EOF
chmod 0644 mime.el || echo "restore of mime.el fails"
set `wc -c mime.el`;Sum=$1
if test "$Sum" != "64778"
then echo original size 64778, current size $Sum;fi
rm -f s2_seq_.tmp
echo "You have unpacked the last part"
exit 0
--
Masanobu UMEDA
umerin@mse.kyutech.ac.jp
Faculty of Computer Science and System Engineering
Kyushu Institute of Technology