Mercurial > emacs
comparison lisp/mail/rmail.el @ 87734:036570ec4c05
(rmail-convert-to-babyl-format): Remove
save-excursion to avoid infinite looping.
author | Martin Rudalics <rudalics@gmx.at> |
---|---|
date | Sun, 13 Jan 2008 18:16:04 +0000 |
parents | 107ccd98fa12 |
children | d4d0381a59d8 c70e45a7acfd |
comparison
equal
deleted
inserted
replaced
87733:b991f36c80d0 | 87734:036570ec4c05 |
---|---|
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 ?\^_) |