Mercurial > emacs
comparison lisp/mail/rmail.el @ 91367:c70e45a7acfd
Merge from emacs--devo--0
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-324
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Wed, 30 Jan 2008 07:57:28 +0000 |
| parents | 606f2d163a64 036570ec4c05 |
| children | 924fe8b4e375 |
comparison
equal
deleted
inserted
replaced
| 91366:86f3a8f0a3a6 | 91367:c70e45a7acfd |
|---|---|
| 1932 (goto-char (point-max))))))) | 1932 (goto-char (point-max))))))) |
| 1933 (goto-char (point-min)) | 1933 (goto-char (point-min)) |
| 1934 (save-restriction | 1934 (save-restriction |
| 1935 (while (not (eobp)) | 1935 (while (not (eobp)) |
| 1936 (setq start (point)) | 1936 (setq start (point)) |
| 1937 (cond ((looking-at "BABYL OPTIONS:");Babyl header | 1937 (cond ((looking-at "BABYL OPTIONS:") ;Babyl header |
| 1938 (if (search-forward "\n\^_" nil t) | 1938 (if (search-forward "\n\^_" nil t) |
| 1939 ;; If we find the proper terminator, delete through there. | 1939 ;; If we find the proper terminator, delete through there. |
| 1940 (delete-region (point-min) (point)) | 1940 (delete-region (point-min) (point)) |
| 1941 (funcall invalid-input-resync) | 1941 (funcall invalid-input-resync) |
| 1942 (delete-region (point-min) (point)))) | 1942 (delete-region (point-min) (point)))) |
| 1951 ;; will be treated properly. | 1951 ;; will be treated properly. |
| 1952 (delete-region (point) | 1952 (delete-region (point) |
| 1953 (save-excursion | 1953 (save-excursion |
| 1954 (skip-chars-forward " \t\n") | 1954 (skip-chars-forward " \t\n") |
| 1955 (point))) | 1955 (point))) |
| 1956 (save-excursion | 1956 ;; The following let* form was wrapped in a `save-excursion' |
| 1957 (let* ((header-end | 1957 ;; which in one case caused infinite looping, see: |
| 1958 (progn | 1958 ;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00968.html |
| 1959 (save-excursion | 1959 ;; Removing that form leaves `point' at the end of the |
| 1960 (goto-char start) | 1960 ;; region decoded by `rmail-decode-region' which should |
| 1961 (forward-line 1) | 1961 ;; be correct. |
| 1962 (if (looking-at "0") | 1962 (let* ((header-end |
| 1963 (forward-line 1) | 1963 (progn |
| 1964 (forward-line 2)) | |
| 1965 (save-restriction | |
| 1966 (narrow-to-region (point) (point-max)) | |
| 1967 (rfc822-goto-eoh) | |
| 1968 (point))))) | |
| 1969 (case-fold-search t) | |
| 1970 (quoted-printable-header-field-end | |
| 1971 (save-excursion | 1964 (save-excursion |
| 1972 (goto-char start) | 1965 (goto-char start) |
| 1973 (re-search-forward | 1966 (forward-line 1) |
| 1974 "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*" | 1967 (if (looking-at "0") |
| 1975 header-end t))) | 1968 (forward-line 1) |
| 1976 (base64-header-field-end | 1969 (forward-line 2)) |
| 1977 (save-excursion | 1970 (save-restriction |
| 1978 (goto-char start) | 1971 (narrow-to-region (point) (point-max)) |
| 1979 ;; Don't try to decode non-text data. | 1972 (rfc822-goto-eoh) |
| 1980 (and (re-search-forward | 1973 (point))))) |
| 1981 "^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/" | 1974 (case-fold-search t) |
| 1982 header-end t) | 1975 (quoted-printable-header-field-end |
| 1983 (goto-char start) | |
| 1984 (re-search-forward | |
| 1985 "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*" | |
| 1986 header-end t))))) | |
| 1987 (if quoted-printable-header-field-end | |
| 1988 (save-excursion | 1976 (save-excursion |
| 1989 (unless | 1977 (goto-char start) |
| 1990 (mail-unquote-printable-region header-end (point) nil t t) | 1978 (re-search-forward |
| 1991 (message "Malformed MIME quoted-printable message")) | 1979 "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*" |
| 1992 ;; Change "quoted-printable" to "8bit", | 1980 header-end t))) |
| 1993 ;; to reflect the decoding we just did. | 1981 (base64-header-field-end |
| 1994 (goto-char quoted-printable-header-field-end) | 1982 (save-excursion |
| 1983 (goto-char start) | |
| 1984 ;; Don't try to decode non-text data. | |
| 1985 (and (re-search-forward | |
| 1986 "^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/" | |
| 1987 header-end t) | |
| 1988 (goto-char start) | |
| 1989 (re-search-forward | |
| 1990 "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*" | |
| 1991 header-end t))))) | |
| 1992 (if quoted-printable-header-field-end | |
| 1993 (save-excursion | |
| 1994 (unless | |
| 1995 (mail-unquote-printable-region header-end (point) nil t t) | |
| 1996 (message "Malformed MIME quoted-printable message")) | |
| 1997 ;; Change "quoted-printable" to "8bit", | |
| 1998 ;; to reflect the decoding we just did. | |
| 1999 (goto-char quoted-printable-header-field-end) | |
| 2000 (delete-region (point) (search-backward ":")) | |
| 2001 (insert ": 8bit"))) | |
| 2002 (if base64-header-field-end | |
| 2003 (save-excursion | |
| 2004 (when | |
| 2005 (condition-case nil | |
| 2006 (progn | |
| 2007 (base64-decode-region (1+ header-end) | |
| 2008 (- (point) 2)) | |
| 2009 t) | |
| 2010 (error nil)) | |
| 2011 ;; Change "base64" to "8bit", to reflect the | |
| 2012 ;; decoding we just did. | |
| 2013 (goto-char base64-header-field-end) | |
| 1995 (delete-region (point) (search-backward ":")) | 2014 (delete-region (point) (search-backward ":")) |
| 1996 (insert ": 8bit"))) | 2015 (insert ": 8bit")))) |
| 1997 (if base64-header-field-end | 2016 (setq last-coding-system-used nil) |
| 1998 (save-excursion | 2017 (or rmail-enable-mime |
| 1999 (when | 2018 (not rmail-enable-multibyte) |
| 2000 (condition-case nil | 2019 (let ((mime-charset |
| 2001 (progn | 2020 (if (and rmail-decode-mime-charset |
| 2002 (base64-decode-region (1+ header-end) | 2021 (save-excursion |
| 2003 (- (point) 2)) | 2022 (goto-char start) |
| 2004 t) | 2023 (search-forward "\n\n" nil t) |
| 2005 (error nil)) | 2024 (let ((case-fold-search t)) |
| 2006 ;; Change "base64" to "8bit", to reflect the | 2025 (re-search-backward |
| 2007 ;; decoding we just did. | 2026 rmail-mime-charset-pattern |
| 2008 (goto-char base64-header-field-end) | 2027 start t)))) |
| 2009 (delete-region (point) (search-backward ":")) | 2028 (intern (downcase (match-string 1)))))) |
| 2010 (insert ": 8bit")))) | 2029 (rmail-decode-region start (point) mime-charset)))) |
| 2011 (setq last-coding-system-used nil) | |
| 2012 (or rmail-enable-mime | |
| 2013 (not rmail-enable-multibyte) | |
| 2014 (let ((mime-charset | |
| 2015 (if (and rmail-decode-mime-charset | |
| 2016 (save-excursion | |
| 2017 (goto-char start) | |
| 2018 (search-forward "\n\n" nil t) | |
| 2019 (let ((case-fold-search t)) | |
| 2020 (re-search-backward | |
| 2021 rmail-mime-charset-pattern | |
| 2022 start t)))) | |
| 2023 (intern (downcase (match-string 1)))))) | |
| 2024 (rmail-decode-region start (point) mime-charset))))) | |
| 2025 ;; Add an X-Coding-System: header if we don't have one. | 2030 ;; Add an X-Coding-System: header if we don't have one. |
| 2026 (save-excursion | 2031 (save-excursion |
| 2027 (goto-char start) | 2032 (goto-char start) |
| 2028 (forward-line 1) | 2033 (forward-line 1) |
| 2029 (if (looking-at "0") | 2034 (if (looking-at "0") |
| 2049 (replace-match "\^_")) | 2054 (replace-match "\^_")) |
| 2050 (save-excursion | 2055 (save-excursion |
| 2051 (save-restriction | 2056 (save-restriction |
| 2052 (narrow-to-region start (1- (point))) | 2057 (narrow-to-region start (1- (point))) |
| 2053 (goto-char (point-min)) | 2058 (goto-char (point-min)) |
| 2054 (while (search-forward "\n\^_" nil t); single char "\^_" | 2059 (while (search-forward "\n\^_" nil t) ; single char "\^_" |
| 2055 (replace-match "\n^_")))); 2 chars: "^" and "_" | 2060 (replace-match "\n^_")))) ; 2 chars: "^" and "_" |
| 2056 (setq last-coding-system-used nil) | 2061 (setq last-coding-system-used nil) |
| 2057 (or rmail-enable-mime | 2062 (or rmail-enable-mime |
| 2058 (not rmail-enable-multibyte) | 2063 (not rmail-enable-multibyte) |
| 2059 (decode-coding-region start (point) 'undecided)) | 2064 (decode-coding-region start (point) 'undecided)) |
| 2060 (save-excursion | 2065 (save-excursion |
| 2166 | 2171 |
| 2167 (save-excursion | 2172 (save-excursion |
| 2168 (save-restriction | 2173 (save-restriction |
| 2169 (narrow-to-region start (point)) | 2174 (narrow-to-region start (point)) |
| 2170 (goto-char (point-min)) | 2175 (goto-char (point-min)) |
| 2171 (while (search-forward "\n\^_" nil t); single char | 2176 (while (search-forward "\n\^_" nil t) ; single char |
| 2172 (replace-match "\n^_")))); 2 chars: "^" and "_" | 2177 (replace-match "\n^_")))) ; 2 chars: "^" and "_" |
| 2173 ;; This is for malformed messages that don't end in newline. | 2178 ;; This is for malformed messages that don't end in newline. |
| 2174 ;; There shouldn't be any, but some users say occasionally | 2179 ;; There shouldn't be any, but some users say occasionally |
| 2175 ;; there are some. | 2180 ;; there are some. |
| 2176 (or (bolp) (newline)) | 2181 (or (bolp) (newline)) |
| 2177 (insert ?\^_) | 2182 (insert ?\^_) |