Mercurial > emacs
comparison lisp/gnus/message.el @ 90667:dbe3f29e61d6
Merge from emacs--devo--0
Patches applied:
* emacs--devo--0 (patch 505-522)
- Update from CVS
- Merge from gnus--rel--5.10
- Update from CVS: etc/TUTORIAL.cn: Updated.
- Merge from erc--emacs--22
* gnus--rel--5.10 (patch 164-167)
- Update from CVS
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-137
author | Miles Bader <miles@gnu.org> |
---|---|
date | Tue, 21 Nov 2006 08:56:38 +0000 |
parents | 7eeafaaa9eab 234305495123 |
children | bc10a33dd40b |
comparison
equal
deleted
inserted
replaced
90666:00d54c8fa693 | 90667:dbe3f29e61d6 |
---|---|
1783 (defun message-strip-subject-re (subject) | 1783 (defun message-strip-subject-re (subject) |
1784 "Remove \"Re:\" from subject lines in string SUBJECT." | 1784 "Remove \"Re:\" from subject lines in string SUBJECT." |
1785 (if (string-match message-subject-re-regexp subject) | 1785 (if (string-match message-subject-re-regexp subject) |
1786 (substring subject (match-end 0)) | 1786 (substring subject (match-end 0)) |
1787 subject)) | 1787 subject)) |
1788 | |
1789 (defcustom message-replacement-char "." | |
1790 "Replacement character used instead of unprintable or not decodable chars." | |
1791 :group 'message-various | |
1792 :version "22.1" ;; Gnus 5.10.9 | |
1793 :type '(choice string | |
1794 (const ".") | |
1795 (const "?"))) | |
1796 | |
1797 ;; FIXME: We also should call `message-strip-subject-encoded-words' | |
1798 ;; when forwarding. Probably in `message-make-forward-subject' and | |
1799 ;; `message-forward-make-body'. | |
1800 | |
1801 (defun message-strip-subject-encoded-words (subject) | |
1802 "Fix non-decodable words in SUBJECT." | |
1803 ;; Cf. `gnus-simplify-subject-fully'. | |
1804 (let* ((case-fold-search t) | |
1805 (replacement-chars (format "[%s%s%s]" | |
1806 message-replacement-char | |
1807 message-replacement-char | |
1808 message-replacement-char)) | |
1809 (enc-word-re "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?\\([^?]+\\)\\(\\?=\\)") | |
1810 cs-string | |
1811 (have-marker | |
1812 (with-temp-buffer | |
1813 (insert subject) | |
1814 (goto-char (point-min)) | |
1815 (when (re-search-forward enc-word-re nil t) | |
1816 (setq cs-string (match-string 1))))) | |
1817 cs-coding q-or-b word-beg word-end) | |
1818 (if (or (not have-marker) ;; No encoded word found... | |
1819 ;; ... or double encoding was correct: | |
1820 (and (stringp cs-string) | |
1821 (setq cs-string (downcase cs-string)) | |
1822 (mm-coding-system-p (intern cs-string)) | |
1823 (not (prog1 | |
1824 (y-or-n-p | |
1825 (format "\ | |
1826 Decoded Subject \"%s\" | |
1827 contains a valid encoded word. Decode again? " | |
1828 subject)) | |
1829 (setq cs-coding (intern cs-string)))))) | |
1830 subject | |
1831 (with-temp-buffer | |
1832 (insert subject) | |
1833 (goto-char (point-min)) | |
1834 (while (re-search-forward enc-word-re nil t) | |
1835 (setq cs-string (downcase (match-string 1)) | |
1836 q-or-b (match-string 2) | |
1837 word-beg (match-beginning 0) | |
1838 word-end (match-end 0)) | |
1839 (setq cs-coding | |
1840 (if (mm-coding-system-p (intern cs-string)) | |
1841 (setq cs-coding (intern cs-string)) | |
1842 nil)) | |
1843 ;; No double encoded subject? => bogus charset. | |
1844 (unless cs-coding | |
1845 (setq cs-coding | |
1846 (mm-read-coding-system | |
1847 (format "\ | |
1848 Decoded Subject \"%s\" | |
1849 contains an encoded word. The charset `%s' is unknown or invalid. | |
1850 Hit RET to replace non-decodable characters with \"%s\" or enter replacement | |
1851 charset: " | |
1852 subject cs-string message-replacement-char))) | |
1853 (if cs-coding | |
1854 (replace-match (concat "=?" (symbol-name cs-coding) | |
1855 "?\\2?\\3\\4\\5")) | |
1856 (save-excursion | |
1857 (goto-char word-beg) | |
1858 (re-search-forward "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?" word-end t) | |
1859 (replace-match "") | |
1860 ;; QP or base64 | |
1861 (if (string-match "\\`Q\\'" q-or-b) | |
1862 ;; QP | |
1863 (progn | |
1864 (message "Replacing non-decodable characters with \"%s\"." | |
1865 message-replacement-char) | |
1866 (while (re-search-forward "\\(=[A-F0-9][A-F0-9]\\)+" | |
1867 word-end t) | |
1868 (replace-match message-replacement-char))) | |
1869 ;; base64 | |
1870 (message "Replacing non-decodable characters with \"%s\"." | |
1871 replacement-chars) | |
1872 (re-search-forward "[^?]+" word-end t) | |
1873 (replace-match replacement-chars)) | |
1874 (re-search-forward "\\?=") | |
1875 (replace-match ""))))) | |
1876 (rfc2047-decode-region (point-min) (point-max)) | |
1877 (buffer-string))))) | |
1788 | 1878 |
1789 ;;; Start of functions adopted from `message-utils.el'. | 1879 ;;; Start of functions adopted from `message-utils.el'. |
1790 | 1880 |
1791 (defun message-strip-subject-trailing-was (subject) | 1881 (defun message-strip-subject-trailing-was (subject) |
1792 "Remove trailing \"(was: <old subject>)\" from SUBJECT lines. | 1882 "Remove trailing \"(was: <old subject>)\" from SUBJECT lines. |
3612 (skip-chars-forward mm-7bit-chars)) | 3702 (skip-chars-forward mm-7bit-chars)) |
3613 (when found | 3703 (when found |
3614 (setq choice | 3704 (setq choice |
3615 (gnus-multiple-choice | 3705 (gnus-multiple-choice |
3616 "Non-printable characters found. Continue sending?" | 3706 "Non-printable characters found. Continue sending?" |
3617 '((?d "Remove non-printable characters and send") | 3707 `((?d "Remove non-printable characters and send") |
3618 (?r "Replace non-printable characters with dots and send") | 3708 (?r ,(format |
3709 "Replace non-printable characters with \"%s\" and send" | |
3710 message-replacement-char)) | |
3619 (?i "Ignore non-printable characters and send") | 3711 (?i "Ignore non-printable characters and send") |
3620 (?e "Continue editing")))) | 3712 (?e "Continue editing")))) |
3621 (if (eq choice ?e) | 3713 (if (eq choice ?e) |
3622 (error "Non-printable characters")) | 3714 (error "Non-printable characters")) |
3623 (message-goto-body) | 3715 (message-goto-body) |
3636 (point) 'untranslated-utf-8))))) | 3728 (point) 'untranslated-utf-8))))) |
3637 (if (eq choice ?i) | 3729 (if (eq choice ?i) |
3638 (message-kill-all-overlays) | 3730 (message-kill-all-overlays) |
3639 (delete-char 1) | 3731 (delete-char 1) |
3640 (when (eq choice ?r) | 3732 (when (eq choice ?r) |
3641 (insert ".")))) | 3733 (insert message-replacement-char)))) |
3642 (forward-char) | 3734 (forward-char) |
3643 (skip-chars-forward mm-7bit-chars)))))) | 3735 (skip-chars-forward mm-7bit-chars)))))) |
3644 | 3736 |
3645 (defun message-add-action (action &rest types) | 3737 (defun message-add-action (action &rest types) |
3646 "Add ACTION to be performed when doing an exit of type TYPES." | 3738 "Add ACTION to be performed when doing an exit of type TYPES." |
5814 (if (string-match "^ +" recipients) | 5906 (if (string-match "^ +" recipients) |
5815 (setq recipients (substring recipients (match-end 0)))) | 5907 (setq recipients (substring recipients (match-end 0)))) |
5816 (push (cons 'Cc recipients) follow-to))) | 5908 (push (cons 'Cc recipients) follow-to))) |
5817 follow-to)) | 5909 follow-to)) |
5818 | 5910 |
5911 (defcustom message-simplify-subject-functions | |
5912 '(message-strip-list-identifiers | |
5913 message-strip-subject-re | |
5914 message-strip-subject-trailing-was | |
5915 message-strip-subject-encoded-words) | |
5916 "List of functions taking a string argument that simplify subjects. | |
5917 The functions are applied when replying to a message. | |
5918 | |
5919 Useful functions to put in this list include: | |
5920 `message-strip-list-identifiers', `message-strip-subject-re', | |
5921 `message-strip-subject-trailing-was', and | |
5922 `message-strip-subject-encoded-words'." | |
5923 :version "22.1" ;; Gnus 5.10.9 | |
5924 :group 'message-various | |
5925 :type '(repeat function)) | |
5926 | |
5927 (defun message-simplify-subject (subject &optional functions) | |
5928 "Return simplified SUBJECT." | |
5929 (unless functions | |
5930 ;; Simplify fully: | |
5931 (setq functions message-simplify-subject-functions)) | |
5932 (when (and (memq 'message-strip-list-identifiers functions) | |
5933 gnus-list-identifiers) | |
5934 (setq subject (message-strip-list-identifiers subject))) | |
5935 (when (memq 'message-strip-subject-re functions) | |
5936 (setq subject (concat "Re: " (message-strip-subject-re subject)))) | |
5937 (when (and (memq 'message-strip-subject-trailing-was functions) | |
5938 message-subject-trailing-was-query) | |
5939 (setq subject (message-strip-subject-trailing-was subject))) | |
5940 (when (memq 'message-strip-subject-encoded-words functions) | |
5941 (setq subject (message-strip-subject-encoded-words subject))) | |
5942 subject) | |
5943 | |
5819 ;;;###autoload | 5944 ;;;###autoload |
5820 (defun message-reply (&optional to-address wide) | 5945 (defun message-reply (&optional to-address wide) |
5821 "Start editing a reply to the article in the current buffer." | 5946 "Start editing a reply to the article in the current buffer." |
5822 (interactive) | 5947 (interactive) |
5823 (require 'gnus-sum) ; for gnus-list-identifiers | 5948 (require 'gnus-sum) ; for gnus-list-identifiers |
5843 (setq message-id (message-fetch-field "message-id" t) | 5968 (setq message-id (message-fetch-field "message-id" t) |
5844 references (message-fetch-field "references") | 5969 references (message-fetch-field "references") |
5845 date (message-fetch-field "date") | 5970 date (message-fetch-field "date") |
5846 from (or (message-fetch-field "from") "nobody") | 5971 from (or (message-fetch-field "from") "nobody") |
5847 subject (or (message-fetch-field "subject") "none")) | 5972 subject (or (message-fetch-field "subject") "none")) |
5848 (when gnus-list-identifiers | 5973 |
5849 (setq subject (message-strip-list-identifiers subject))) | 5974 ;; Strip list identifiers, "Re: ", and "was:" |
5850 (setq subject (concat "Re: " (message-strip-subject-re subject))) | 5975 (setq subject (message-simplify-subject subject)) |
5851 (when message-subject-trailing-was-query | |
5852 (setq subject (message-strip-subject-trailing-was subject))) | |
5853 | 5976 |
5854 (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) | 5977 (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) |
5855 (string-match "<[^>]+>" gnus-warning)) | 5978 (string-match "<[^>]+>" gnus-warning)) |
5856 (setq message-id (match-string 0 gnus-warning))) | 5979 (setq message-id (match-string 0 gnus-warning))) |
5857 | 5980 |
5917 ;; Remove bogus distribution. | 6040 ;; Remove bogus distribution. |
5918 (when (and (stringp distribution) | 6041 (when (and (stringp distribution) |
5919 (let ((case-fold-search t)) | 6042 (let ((case-fold-search t)) |
5920 (string-match "world" distribution))) | 6043 (string-match "world" distribution))) |
5921 (setq distribution nil)) | 6044 (setq distribution nil)) |
5922 (if gnus-list-identifiers | 6045 ;; Strip list identifiers, "Re: ", and "was:" |
5923 (setq subject (message-strip-list-identifiers subject))) | 6046 (setq subject (message-simplify-subject subject)) |
5924 (setq subject (concat "Re: " (message-strip-subject-re subject))) | |
5925 (when message-subject-trailing-was-query | |
5926 (setq subject (message-strip-subject-trailing-was subject))) | |
5927 (widen)) | 6047 (widen)) |
5928 | 6048 |
5929 (message-pop-to-buffer (message-buffer-name "followup" from newsgroups)) | 6049 (message-pop-to-buffer (message-buffer-name "followup" from newsgroups)) |
5930 | 6050 |
5931 (setq message-reply-headers | 6051 (setq message-reply-headers |