/[emacs]/emacs/lisp/gnus/message.el
ViewVC logotype

Diff of /emacs/lisp/gnus/message.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.58.2.3 by rsteib, Tue Aug 31 14:47:59 2004 UTC revision 1.58.2.4 by rsteib, Tue Aug 31 15:39:43 2004 UTC
# Line 1532  no, only reply back to the author." Line 1532  no, only reply back to the author."
1532    :type 'regexp)    :type 'regexp)
1533    
1534  (eval-and-compile  (eval-and-compile
1535      (autoload 'idna-to-ascii "idna")
1536    (autoload 'message-setup-toolbar "messagexmas")    (autoload 'message-setup-toolbar "messagexmas")
1537    (autoload 'mh-new-draft-name "mh-comp")    (autoload 'mh-new-draft-name "mh-comp")
1538    (autoload 'mh-send-letter "mh-comp")    (autoload 'mh-send-letter "mh-comp")
# Line 4878  subscribed address (and not the addition Line 4879  subscribed address (and not the addition
4879                list                list
4880              msg-recipients))))))              msg-recipients))))))
4881    
 (defun message-idna-inside-rhs-p ()  
   "Return t iff point is inside a RHS (heuristically).  
 Only works properly if header contains mailbox-list or address-list.  
 I.e., calling it on a Subject: header is useless."  
   (save-restriction  
     (narrow-to-region (save-excursion (or (re-search-backward "^[^ \t]" nil t)  
                                           (point-min)))  
                       (save-excursion (or (re-search-forward "^[^ \t]" nil t)  
                                           (point-max))))  
     (if (re-search-backward "[\\\n\r\t ]"  
                             (save-excursion (search-backward "@" nil t)) t)  
         ;; whitespace between @ and point  
         nil  
       (let ((dquote 1) (paren 1))  
         (while (save-excursion (re-search-backward "[^\\]\"" nil t dquote))  
           (incf dquote))  
         (while (save-excursion (re-search-backward "[^\\]\(" nil t paren))  
           (incf paren))  
         (and (= (% dquote 2) 1) (= (% paren 2) 1))))))  
   
 (autoload 'idna-to-ascii "idna")  
   
4882  (defun message-idna-to-ascii-rhs-1 (header)  (defun message-idna-to-ascii-rhs-1 (header)
4883    "Interactively potentially IDNA encode domain names in HEADER."    "Interactively potentially IDNA encode domain names in HEADER."
4884    (let (rhs ace start startpos endpos ovl)    (let ((field (message-fetch-field header))
4885      (goto-char (point-min))          rhs ace  address)
4886      (while (re-search-forward (concat "^" header) nil t)      (when field
4887        (while (re-search-forward "@\\([^ \t\r\n>,]+\\)"        (dolist (address (mail-header-parse-addresses field))
4888                                  (or (save-excursion          (setq address (car address)
4889                                        (re-search-forward "^[^ \t]" nil t))                rhs (downcase (or (cadr (split-string address "@")) ""))
4890                                      (point-max))                ace (downcase (idna-to-ascii rhs)))
4891                                  t)          (when (and (not (equal rhs ace))
4892          (setq rhs (match-string-no-properties 1)                     (or (not (eq message-use-idna 'ask))
4893                startpos (match-beginning 1)                         (y-or-n-p (format "Replace %s with %s? " rhs ace))))
4894                endpos (match-end 1))            (goto-char (point-min))
4895          (when (save-match-data            (while (re-search-forward (concat "^" header ":") nil t)
4896                  (and (message-idna-inside-rhs-p)              (message-narrow-to-field)
4897                       (setq ace (idna-to-ascii rhs))              (while (search-forward (concat "@" rhs) nil t)
4898                       (not (string= rhs ace))                (replace-match (concat "@" ace) t t))
4899                       (if (eq message-use-idna 'ask)              (goto-char (point-max))
4900                           (unwind-protect              (widen)))))))
                              (progn  
                                (setq ovl (message-make-overlay startpos  
                                                                endpos))  
                                (message-overlay-put ovl 'face 'highlight)  
                                (y-or-n-p  
                                 (format "Replace with `%s'? " ace)))  
                            (message "")  
                            (message-delete-overlay ovl))  
                        message-use-idna)))  
           (replace-match (concat "@" ace)))))))  
4901    
4902  (defun message-idna-to-ascii-rhs ()  (defun message-idna-to-ascii-rhs ()
4903    "Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers.    "Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers.

Legend:
Removed from v.1.58.2.3  
changed lines
  Added in v.1.58.2.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26