comparison lisp/gnus/message.el @ 90234:b1c1fc853d2f

Revision: [e-mail]--gnu-2005/emacs--unicode--0--patch-86 Merge from emacs--cvs-trunk--0 Patches applied: * emacs--cvs-trunk--0 (patch 562-568) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 125-128) - Merge from emacs--cvs-trunk--0 - Update from CVS

90233:ee12d75eb214

(defcustom message-use-idna (and (condition-case nil (require 'idna)
				   (file-error))
				 (mm-coding-system-p 'utf-8)
				 (executable-find idna-program)
				 'ask)
  "Whether to encode non-ASCII in domain names into ASCII according to IDNA."
  :version "22.1"
  :group 'message-headers
  :link '(custom-manual "(message)IDNA")
  :type '(choice (const :tag "Ask" ask)
		 (const :tag "Never" nil)

	      new subject)
	new))))

;;; Suggested by Jonas Steverud  @  www.dtek.chalmers.se/~d4jonas/

;;;###autoload
(defun message-change-subject (new-subject)
  "Ask for NEW-SUBJECT header, append (was: <Old Subject>)."
  ;; <URL:http://www.landfield.com/usefor/drafts/draft-ietf-usefor-useage--1.02.unpaged>
  (interactive
   (list

		    (insert (concat "Subject: "
				    new-subject
				    " (was: "
				    old-subject ")\n")))))))))

;;;###autoload
(defun message-mark-inserted-region (beg end)
  "Mark some region in the current article with enclosing tags.
See `message-mark-insert-begin' and `message-mark-insert-end'."
  (interactive "r")
  (save-excursion

    (goto-char end)
    (insert message-mark-insert-end)
    (goto-char beg)
    (insert message-mark-insert-begin)))

;;;###autoload
(defun message-mark-insert-file (file)
  "Insert FILE at point, marking it with enclosing tags.
See `message-mark-insert-begin' and `message-mark-insert-end'."
  (interactive "fFile to insert: ")
    ;; reverse insertion to get correct result.

    (goto-char p)
    (insert-file-contents file)
    (goto-char p)
    (insert message-mark-insert-begin)))

;;;###autoload
(defun message-add-archive-header ()
  "Insert \"X-No-Archive: Yes\" in the header and a note in the body.
The note can be customized using `message-archive-note'.  When called with a
prefix argument, ask for a text to insert.  If you don't want the note in the
body, set  `message-archive-note' to nil."

	(insert message-archive-note)
	(newline))
      (message-add-header message-archive-header)
      (message-sort-headers)))

;;;###autoload
(defun message-cross-post-followup-to-header (target-group)
  "Mangles FollowUp-To and Newsgroups header to point to TARGET-GROUP.
With prefix-argument just set Follow-Up, don't cross-post."
  (interactive
   (list ; Completion based on Gnus

				 "[ \t]*$")
			 (message-fetch-field "Newsgroups")))
      (insert (concat "\nFollowup-To: " target-group)))
  (setq message-cross-post-old-target target-group))

;;;###autoload
(defun message-cross-post-insert-note (target-group cross-post in-old
						    old-groups)
  "Insert a in message body note about a set Followup or Crosspost.
If there have been previous notes, delete them.  TARGET-GROUP specifies the
group to Followup-To.  When CROSS-POST is t, insert note about

	    (not cross-post)
	    (string-match "^[ \t]*poster[ \t]*$" target-group))
	(insert (concat message-followup-to-note target-group "\n"))
      (insert (concat message-cross-post-note target-group "\n")))))

;;;###autoload
(defun message-cross-post-followup-to (target-group)
  "Crossposts message and set Followup-To to TARGET-GROUP.
With prefix-argument just set Follow-Up, don't cross-post."
  (interactive
   (list ; Completion based on Gnus

					  current-prefix-arg)) t)
			     in-old old-groups))))))))

;;; Reduce To: to Cc: or Bcc: header

;;;###autoload
(defun message-reduce-to-to-cc ()
 "Replace contents of To: header with contents of Cc: or Bcc: header."
 (interactive)
 (let ((cc-content
	(save-restriction (message-narrow-to-headers)

	      (message-remove-header (if bcc
					 "bcc"
				       "cc"))))))))

;;; End of functions adopted from `message-utils.el'.

(defun message-remove-header (header &optional is-regexp first reverse)
  "Remove HEADER in the narrowed buffer.
If IS-REGEXP, HEADER is a regular expression.
If FIRST, only remove the first instance of the header.

(defun message-idna-to-ascii-rhs-1 (header)
  "Interactively potentially IDNA encode domain names in HEADER."
  (let ((field (message-fetch-field header))
	rhs ace  address)
    (when field
      (dolist (address (mail-header-parse-addresses field))
	(setq address (car address)
	      rhs (downcase (or (cadr (split-string address "@")) ""))
	      ace (downcase (idna-to-ascii rhs)))
	(when (and (not (equal rhs ace))
		   (or (not (eq message-use-idna 'ask))
		       (y-or-n-p (format "Replace %s with %s? " rhs ace))))
	  (goto-char (point-min))
	  (while (re-search-forward (concat "^" header ":") nil t)
	    (message-narrow-to-field)
	    (while (search-forward (concat "@" rhs) nil t)
	      (replace-match (concat "@" ace) t t))

    (save-excursion
      (save-restriction
	(message-narrow-to-head)
	(message-idna-to-ascii-rhs-1 "From")
	(message-idna-to-ascii-rhs-1 "To")
	(message-idna-to-ascii-rhs-1 "Cc")))))

(defun message-generate-headers (headers)
  "Prepare article HEADERS.
Headers already prepared in the buffer are not modified."

90234:b1c1fc853d2f

(defcustom message-use-idna (and (condition-case nil (require 'idna)
				   (file-error))
				 (mm-coding-system-p 'utf-8)
				 (executable-find idna-program)
				 (string= (idna-to-ascii "räksmörgås")
					  "xn--rksmrgs-5wao1o")
				 t)
  "Whether to encode non-ASCII in domain names into ASCII according to IDNA.
GNU Libidn, and in particular the elisp package \"idna.el\" and
the external program \"idn\", must be installed for this
functionality to work."
  :version "22.1"
  :group 'message-headers
  :link '(custom-manual "(message)IDNA")
  :type '(choice (const :tag "Ask" ask)
		 (const :tag "Never" nil)

	      new subject)
	new))))

;;; Suggested by Jonas Steverud  @  www.dtek.chalmers.se/~d4jonas/

(defun message-change-subject (new-subject)
  "Ask for NEW-SUBJECT header, append (was: <Old Subject>)."
  ;; <URL:http://www.landfield.com/usefor/drafts/draft-ietf-usefor-useage--1.02.unpaged>
  (interactive
   (list

		    (insert (concat "Subject: "
				    new-subject
				    " (was: "
				    old-subject ")\n")))))))))

(defun message-mark-inserted-region (beg end)
  "Mark some region in the current article with enclosing tags.
See `message-mark-insert-begin' and `message-mark-insert-end'."
  (interactive "r")
  (save-excursion

    (goto-char end)
    (insert message-mark-insert-end)
    (goto-char beg)
    (insert message-mark-insert-begin)))

(defun message-mark-insert-file (file)
  "Insert FILE at point, marking it with enclosing tags.
See `message-mark-insert-begin' and `message-mark-insert-end'."
  (interactive "fFile to insert: ")
    ;; reverse insertion to get correct result.

    (goto-char p)
    (insert-file-contents file)
    (goto-char p)
    (insert message-mark-insert-begin)))

(defun message-add-archive-header ()
  "Insert \"X-No-Archive: Yes\" in the header and a note in the body.
The note can be customized using `message-archive-note'.  When called with a
prefix argument, ask for a text to insert.  If you don't want the note in the
body, set  `message-archive-note' to nil."

	(insert message-archive-note)
	(newline))
      (message-add-header message-archive-header)
      (message-sort-headers)))

(defun message-cross-post-followup-to-header (target-group)
  "Mangles FollowUp-To and Newsgroups header to point to TARGET-GROUP.
With prefix-argument just set Follow-Up, don't cross-post."
  (interactive
   (list ; Completion based on Gnus

				 "[ \t]*$")
			 (message-fetch-field "Newsgroups")))
      (insert (concat "\nFollowup-To: " target-group)))
  (setq message-cross-post-old-target target-group))

(defun message-cross-post-insert-note (target-group cross-post in-old
						    old-groups)
  "Insert a in message body note about a set Followup or Crosspost.
If there have been previous notes, delete them.  TARGET-GROUP specifies the
group to Followup-To.  When CROSS-POST is t, insert note about

	    (not cross-post)
	    (string-match "^[ \t]*poster[ \t]*$" target-group))
	(insert (concat message-followup-to-note target-group "\n"))
      (insert (concat message-cross-post-note target-group "\n")))))

(defun message-cross-post-followup-to (target-group)
  "Crossposts message and set Followup-To to TARGET-GROUP.
With prefix-argument just set Follow-Up, don't cross-post."
  (interactive
   (list ; Completion based on Gnus

					  current-prefix-arg)) t)
			     in-old old-groups))))))))

;;; Reduce To: to Cc: or Bcc: header

(defun message-reduce-to-to-cc ()
 "Replace contents of To: header with contents of Cc: or Bcc: header."
 (interactive)
 (let ((cc-content
	(save-restriction (message-narrow-to-headers)

	      (message-remove-header (if bcc
					 "bcc"
				       "cc"))))))))

;;; End of functions adopted from `message-utils.el'.

(defun message-remove-duplicates (list)
  (let (new)
    (while list
      (or (member (car list) new)
	  (setq new (cons (car list) new)))
      (setq list (cdr list)))
    (nreverse new)))

(defun message-remove-header (header &optional is-regexp first reverse)
  "Remove HEADER in the narrowed buffer.
If IS-REGEXP, HEADER is a regular expression.
If FIRST, only remove the first instance of the header.

(defun message-idna-to-ascii-rhs-1 (header)
  "Interactively potentially IDNA encode domain names in HEADER."
  (let ((field (message-fetch-field header))
	rhs ace  address)
    (when field
      (dolist (rhs
	       (message-remove-duplicates
		(mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) ""))
			(mapcar 'downcase
				(mapcar
				 'car (mail-header-parse-addresses field))))))
	(setq ace (downcase (idna-to-ascii rhs)))
	(when (and (not (equal rhs ace))
		   (or (not (eq message-use-idna 'ask))
		       (y-or-n-p (format "Replace %s with %s in %s:? "
					 rhs ace header))))
	  (goto-char (point-min))
	  (while (re-search-forward (concat "^" header ":") nil t)
	    (message-narrow-to-field)
	    (while (search-forward (concat "@" rhs) nil t)
	      (replace-match (concat "@" ace) t t))

    (save-excursion
      (save-restriction
	(message-narrow-to-head)
	(message-idna-to-ascii-rhs-1 "From")
	(message-idna-to-ascii-rhs-1 "To")
	(message-idna-to-ascii-rhs-1 "Reply-To")
	(message-idna-to-ascii-rhs-1 "Mail-Reply-To")
	(message-idna-to-ascii-rhs-1 "Mail-Followup-To")
	(message-idna-to-ascii-rhs-1 "Cc")))))

(defun message-generate-headers (headers)
  "Prepare article HEADERS.
Headers already prepared in the buffer are not modified."