Mercurial > emacs

comparison lisp/gnus/rfc2047.el @ 47951:9cd6016af581

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Revert decoding changes temporarily.
author Dave Love <fx@gnu.org>
date Fri, 18 Oct 2002 14:15:44 +0000
parents 3915f2c7691e
children b042c57894f8 d7ddb3e565de
comparison
equal deleted inserted replaced
47950:6b2496e2e77b 47951:9cd6016af581
471 (goto-char (1+ (point-min))) 471 (goto-char (1+ (point-min)))
472 (while (and (not (bobp)) (not (eobp))) 472 (while (and (not (bobp)) (not (eobp)))
473 (goto-char (min (point-max) (+ 56 bol))) 473 (goto-char (min (point-max) (+ 56 bol)))
474 (search-backward "=" (- (point) 2) t) 474 (search-backward "=" (- (point) 2) t)
475 (unless (or (bobp) (eobp)) 475 (unless (or (bobp) (eobp))
476 (insert ?\n) 476 (insert "\n")
477 (setq bol (point))))))))) 477 (setq bol (point)))))))))
478 478
479 ;;; 479 ;;;
480 ;;; Functions for decoding RFC2047 messages 480 ;;; Functions for decoding RFC2047 messages
481 ;;; 481 ;;;
482 482
483 (eval-and-compile 483 (defvar rfc2047-encoded-word-regexp
484 (defvar rfc2047-encoded-word-regexp 484 "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ +]+\\)\\?=")
485 "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\
486 \\([!->@-~ +]+\\)\\?="))
487 485
488 (defun rfc2047-decode-region (start end) 486 (defun rfc2047-decode-region (start end)
489 "Decode MIME-encoded words in region between START and END." 487 "Decode MIME-encoded words in region between START and END."
490 (interactive "r") 488 (interactive "r")
491 (let ((case-fold-search t) 489 (let ((case-fold-search t)
492 (undoing (not (eq t buffer-undo-list)))
493 b e) 490 b e)
494 (unwind-protect 491 (save-excursion
495 (save-excursion 492 (save-restriction
496 (save-restriction 493 (narrow-to-region start end)
497 (buffer-enable-undo) 494 (goto-char (point-min))
498 (narrow-to-region start end) 495 ;; Remove whitespace between encoded words.
499 (goto-char (point-min)) 496 (while (re-search-forward
500 ;; Remove whitespace between encoded words. 497 (concat "\\(" rfc2047-encoded-word-regexp "\\)"
501 (while (re-search-forward 498 "\\(\n?[ \t]\\)+"
502 (eval-when-compile 499 "\\(" rfc2047-encoded-word-regexp "\\)")
503 (concat "\\(" rfc2047-encoded-word-regexp "\\)" 500 nil t)
504 "\\(\n?[ \t]\\)+" 501 (delete-region (goto-char (match-end 1)) (match-beginning 6)))
505 "\\(" rfc2047-encoded-word-regexp "\\)")) 502 ;; Decode the encoded words.
506 nil t) 503 (setq b (goto-char (point-min)))
507 (delete-region (goto-char (match-end 1)) (match-beginning 6))) 504 (while (re-search-forward rfc2047-encoded-word-regexp nil t)
508 ;; Decode the encoded words. 505 (setq e (match-beginning 0))
509 (setq b (goto-char (point-min))) 506 (insert (rfc2047-parse-and-decode
510 (while (re-search-forward rfc2047-encoded-word-regexp nil t) 507 (prog1
511 (setq e (match-beginning 0)) 508 (match-string 0)
512 (rfc2047-parse-and-decode (match-beginning 0) (match-end 0))) 509 (delete-region (match-beginning 0) (match-end 0)))))
513 (when (and (mm-multibyte-p) 510 (when (and (mm-multibyte-p)
514 mail-parse-charset 511 mail-parse-charset
515 (not (eq mail-parse-charset 'us-ascii)) 512 (not (eq mail-parse-charset 'gnus-decoded)))
516 (not (eq mail-parse-charset 'gnus-decoded))) 513 (mm-decode-coding-region b e mail-parse-charset))
517 (mm-decode-coding-region b (point-max) mail-parse-charset)) 514 (setq b (point)))
518 (rfc2047-unfold-region (point-min) (point-max)))) 515 (when (and (mm-multibyte-p)
519 (unless undoing 516 mail-parse-charset
520 (buffer-disable-undo))))) 517 (not (eq mail-parse-charset 'us-ascii))
518 (not (eq mail-parse-charset 'gnus-decoded)))
519 (mm-decode-coding-region b (point-max) mail-parse-charset))
520 (rfc2047-unfold-region (point-min) (point-max))))))
521 521
522 (defun rfc2047-decode-string (string) 522 (defun rfc2047-decode-string (string)
523 "Decode the quoted-printable-encoded STRING and return the results." 523 "Decode the quoted-printable-encoded STRING and return the results."
524 (let ((m (mm-multibyte-p))) 524 (let ((m (mm-multibyte-p)))
525 (with-temp-buffer 525 (with-temp-buffer
528 (insert string) 528 (insert string)
529 (inline 529 (inline
530 (rfc2047-decode-region (point-min) (point-max))) 530 (rfc2047-decode-region (point-min) (point-max)))
531 (buffer-string)))) 531 (buffer-string))))
532 532
533 (defun rfc2047-parse-and-decode (b e) 533 (defun rfc2047-parse-and-decode (word)
534 "Decode WORD and return it if it is an encoded word. 534 "Decode WORD and return it if it is an encoded word.
535 Return WORD if not." 535 Return WORD if not."
536 (save-restriction 536 (if (not (string-match rfc2047-encoded-word-regexp word))
537 (narrow-to-region b e) 537 word
538 (goto-char b) 538 (or
539 (when (looking-at (eval-when-compile 539 (condition-case nil
540 (concat "\\`" rfc2047-encoded-word-regexp "\\'"))) 540 (rfc2047-decode
541 (condition-case nil 541 (match-string 1 word)
542 (let ((charset (match-string 1)) 542 (upcase (match-string 2 word))
543 (encoding (upcase (match-string 2)))) 543 (match-string 3 word))
544 (undo-boundary) 544 (error word))
545 (delete-region (match-beginning 0) (1+ (match-end 2))) 545 word)))
546 (delete-region (- (point-max) 2) (point-max)) 546
547 (rfc2047-decode charset encoding (point-min) (point-max))) 547 (defun rfc2047-decode (charset encoding string)
548 ;; If we get an error, undo the change 548 "Decode STRING from the given MIME CHARSET in the given ENCODING.
549 (error (undo))))))
550
551 (defun rfc2047-decode (charset encoding b e)
552 "Decode from the given MIME CHARSET in the given ENCODING in region B to E.
553 Valid ENCODINGs are \"B\" and \"Q\". 549 Valid ENCODINGs are \"B\" and \"Q\".
554 If your Emacs implementation can't decode CHARSET, return nil." 550 If your Emacs implementation can't decode CHARSET, return nil."
555 (if (stringp charset) 551 (if (stringp charset)
556 (setq charset (intern (downcase charset)))) 552 (setq charset (intern (downcase charset))))
557 (if (or (not charset) 553 (if (or (not charset)
566 (setq cs (mm-charset-to-coding-system mail-parse-charset))) 562 (setq cs (mm-charset-to-coding-system mail-parse-charset)))
567 (when cs 563 (when cs
568 (when (and (eq cs 'ascii) 564 (when (and (eq cs 'ascii)
569 mail-parse-charset) 565 mail-parse-charset)
570 (setq cs mail-parse-charset)) 566 (setq cs mail-parse-charset))
571 (save-restriction 567 ;; Ensure unibyte result in Emacs 20.
572 (narrow-to-region b e) 568 (let (default-enable-multibyte-characters)
573 (cond 569 (with-temp-buffer
574 ((equal "B" encoding) 570 (mm-decode-coding-string
575 (base64-decode-region b e)) 571 (cond
576 ((equal "Q" encoding) 572 ((equal "B" encoding)
577 (subst-char-in-region b e ?_ ? t) 573 (base64-decode-string string))
578 (quoted-printable-decode-region b e)) 574 ((equal "Q" encoding)
579 (t (error "Invalid encoding: %s" encoding))) 575 (quoted-printable-decode-string
580 (mm-decode-coding-region (point-min) (point-max) cs))))) 576 (mm-replace-chars-in-string string ?_ ? )))
577 (t (error "Invalid encoding: %s" encoding)))
578 cs))))))
581 579
582 (provide 'rfc2047) 580 (provide 'rfc2047)
583 581
584 ;;; rfc2047.el ends here 582 ;;; rfc2047.el ends here