emacs: lisp/gnus/message.el comparison

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

-:00d54c8fa693
+:dbe3f29e61d6
 (defun message-strip-subject-re (subject)
 "Remove \"Re:\" from subject lines in string SUBJECT."
 (if (string-match message-subject-re-regexp subject)
 (substring subject (match-end 0))
 subject))
+(defcustom message-replacement-char "."
+"Replacement character used instead of unprintable or not decodable chars."
+:group 'message-various
+:version "22.1" ;; Gnus 5.10.9
+:type '(choice string
+		 (const ".")
+		 (const "?")))
+;; FIXME: We also should call `message-strip-subject-encoded-words'
+;; when forwarding.  Probably in `message-make-forward-subject' and
+;; `message-forward-make-body'.
+(defun message-strip-subject-encoded-words (subject)
+"Fix non-decodable words in SUBJECT."
+;; Cf. `gnus-simplify-subject-fully'.
+(let* ((case-fold-search t)
+	 (replacement-chars (format "[%s%s%s]"
+				    message-replacement-char
+				    message-replacement-char
+				    message-replacement-char))
+	 (enc-word-re "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?\\([^?]+\\)\\(\\?=\\)")
+	 cs-string
+	 (have-marker
+	  (with-temp-buffer
+	    (insert subject)
+	    (goto-char (point-min))
+	    (when (re-search-forward enc-word-re nil t)
+	      (setq cs-string (match-string 1)))))
+	 cs-coding q-or-b word-beg word-end)
+(if (or (not have-marker) ;; No encoded word found...
+	    ;; ... or double encoding was correct:
+	    (and (stringp cs-string)
+		 (setq cs-string (downcase cs-string))
+		 (mm-coding-system-p (intern cs-string))
+		 (not (prog1
+			  (y-or-n-p
+			   (format "\
+Decoded Subject \"%s\"
+contains a valid encoded word.  Decode again? "
+				   subject))
+			(setq cs-coding (intern cs-string))))))
+	subject
+(with-temp-buffer
+	(insert subject)
+	(goto-char (point-min))
+	(while (re-search-forward enc-word-re nil t)
+	  (setq cs-string (downcase (match-string 1))
+		q-or-b    (match-string 2)
+		word-beg (match-beginning 0)
+		word-end (match-end 0))
+	  (setq cs-coding
+		(if (mm-coding-system-p (intern cs-string))
+		    (setq cs-coding (intern cs-string))
+		  nil))
+	  ;; No double encoded subject? => bogus charset.
+	  (unless cs-coding
+	    (setq cs-coding
+		  (mm-read-coding-system
+		   (format "\
+Decoded Subject \"%s\"
+contains an encoded word.  The charset `%s' is unknown or invalid.
+Hit RET to replace non-decodable characters with \"%s\" or enter replacement
+charset: "
+			   subject cs-string message-replacement-char)))
+	    (if cs-coding
+		(replace-match (concat "=?" (symbol-name cs-coding)
+				       "?\\2?\\3\\4\\5"))
+	      (save-excursion
+		(goto-char word-beg)
+		(re-search-forward "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?" word-end t)
+		(replace-match "")
+		;; QP or base64
+		(if (string-match "\\`Q\\'" q-or-b)
+		    ;; QP
+		    (progn
+		      (message "Replacing non-decodable characters with \"%s\"."
+			       message-replacement-char)
+		      (while (re-search-forward "\\(=[A-F0-9][A-F0-9]\\)+"
+						word-end t)
+			(replace-match message-replacement-char)))
+		  ;; base64
+		  (message "Replacing non-decodable characters with \"%s\"."
+			   replacement-chars)
+		  (re-search-forward "[^?]+" word-end t)
+		  (replace-match replacement-chars))
+		(re-search-forward "\\?=")
+		(replace-match "")))))
+	(rfc2047-decode-region (point-min) (point-max))
+	(buffer-string)))))
 ;;; Start of functions adopted from `message-utils.el'.
 (defun message-strip-subject-trailing-was (subject)
 "Remove trailing \"(was: <old subject>)\" from SUBJECT lines.
 	(skip-chars-forward mm-7bit-chars))
 (when found
 	(setq choice
 	      (gnus-multiple-choice
 	       "Non-printable characters found.  Continue sending?"
-	       '((?d "Remove non-printable characters and send")
+	       `((?d "Remove non-printable characters and send")
-		 (?r "Replace non-printable characters with dots and send")
+		 (?r ,(format
+		       "Replace non-printable characters with \"%s\" and send"
+		       message-replacement-char))
 		 (?i "Ignore non-printable characters and send")
 		 (?e "Continue editing"))))
 	(if (eq choice ?e)
 	  (error "Non-printable characters"))
 	(message-goto-body)
 				 (point) 'untranslated-utf-8)))))
 	    (if (eq choice ?i)
 		(message-kill-all-overlays)
 	      (delete-char 1)
 	      (when (eq choice ?r)
-		(insert "."))))
+		(insert message-replacement-char))))
 	  (forward-char)
 	  (skip-chars-forward mm-7bit-chars))))))
 (defun message-add-action (action &rest types)
 "Add ACTION to be performed when doing an exit of type TYPES."
 	(if (string-match "^ +" recipients)
 	    (setq recipients (substring recipients (match-end 0))))
 	(push (cons 'Cc recipients) follow-to)))
 follow-to))
+(defcustom message-simplify-subject-functions
+'(message-strip-list-identifiers
+message-strip-subject-re
+message-strip-subject-trailing-was
+message-strip-subject-encoded-words)
+"List of functions taking a string argument that simplify subjects.
+The functions are applied when replying to a message.
+Useful functions to put in this list include:
+`message-strip-list-identifiers', `message-strip-subject-re',
+`message-strip-subject-trailing-was', and
+`message-strip-subject-encoded-words'."
+:version "22.1" ;; Gnus 5.10.9
+:group 'message-various
+:type '(repeat function))
+(defun message-simplify-subject (subject &optional functions)
+"Return simplified SUBJECT."
+(unless functions
+;; Simplify fully:
+(setq functions message-simplify-subject-functions))
+(when (and (memq 'message-strip-list-identifiers functions)
+	     gnus-list-identifiers)
+(setq subject (message-strip-list-identifiers subject)))
+(when (memq 'message-strip-subject-re functions)
+(setq subject (concat "Re: " (message-strip-subject-re subject))))
+(when (and (memq 'message-strip-subject-trailing-was functions)
+	     message-subject-trailing-was-query)
+(setq subject (message-strip-subject-trailing-was subject)))
+(when (memq 'message-strip-subject-encoded-words functions)
+(setq subject (message-strip-subject-encoded-words subject)))
+subject)
 ;;;###autoload
 (defun message-reply (&optional to-address wide)
 "Start editing a reply to the article in the current buffer."
 (interactive)
 (require 'gnus-sum)			; for gnus-list-identifiers
 (setq message-id (message-fetch-field "message-id" t)
 	    references (message-fetch-field "references")
 	    date (message-fetch-field "date")
 	    from (or (message-fetch-field "from") "nobody")
 	    subject (or (message-fetch-field "subject") "none"))
-(when gnus-list-identifiers
-	(setq subject (message-strip-list-identifiers subject)))
+;; Strip list identifiers, "Re: ", and "was:"
-(setq subject (concat "Re: " (message-strip-subject-re subject)))
+(setq subject (message-simplify-subject subject))
-(when message-subject-trailing-was-query
-	(setq subject (message-strip-subject-trailing-was subject)))
 (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
 		 (string-match "<[^>]+>" gnus-warning))
 	(setq message-id (match-string 0 gnus-warning)))
 ;; Remove bogus distribution.
 (when (and (stringp distribution)
 		 (let ((case-fold-search t))
 		   (string-match "world" distribution)))
 	(setq distribution nil))
-(if gnus-list-identifiers
+;; Strip list identifiers, "Re: ", and "was:"
-	  (setq subject (message-strip-list-identifiers subject)))
+(setq subject (message-simplify-subject subject))
-(setq subject (concat "Re: " (message-strip-subject-re subject)))
-(when message-subject-trailing-was-query
-	(setq subject (message-strip-subject-trailing-was subject)))
 (widen))
 (message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
 (setq message-reply-headers

Mercurial > emacs

comparison lisp/gnus/message.el @ 90667:dbe3f29e61d6