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

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

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

revision 1.10 by pj, Sun Jul 15 17:42:53 2001 UTC revision 1.10.6.1 by fx, Wed Jun 26 18:57:31 2002 UTC
# Line 169  Should be called narrowed to the head of Line 169  Should be called narrowed to the head of
169  The buffer may be narrowed."  The buffer may be narrowed."
170    (require 'message)                    ; for message-posting-charset    (require 'message)                    ; for message-posting-charset
171    (let ((charsets    (let ((charsets
172           (mapcar           (mm-find-mime-charset-region (point-min) (point-max))))
173            'mm-mime-charset      (and charsets (not (equal charsets (list message-posting-charset))))))
           (mm-find-charset-region (point-min) (point-max))))  
         (cs (list 'us-ascii (car message-posting-charset)))  
         found)  
     (while charsets  
       (unless (memq (pop charsets) cs)  
         (setq found t)))  
     found))  
174    
175  (defun rfc2047-dissect-region (b e)  (defun rfc2047-dissect-region (b e)
176    "Dissect the region between B and E into words."    "Dissect the region between B and E into words."
177    (let ((word-chars "-A-Za-z0-9!*+/")    (let ((word-chars "-A-Za-z0-9!*+/")
178          ;; Not using ietf-drums-specials-token makes life simple.          ;; Not using ietf-drums-specials-token makes life simple.
179          mail-parse-mule-charset          mail-parse-mule-charset
180          words point current          words point nonascii
181          result word)          result word)
182      (save-restriction      (save-restriction
183        (narrow-to-region b e)        (narrow-to-region b e)
184        (goto-char (point-min))        (goto-char (point-min))
185        (skip-chars-forward "\000-\177")        (skip-chars-forward "\000-\177")
186          ;; Fixme: This loop used to check charsets when it found
187          ;; non-ASCII characters.  That's removed, since it doesn't make
188          ;; much sense in Emacs 22 and doesn't seem necessary in Emacs
189          ;; 21, even.  I'm not sure exactly what it should be doing, and
190          ;; it needs another look, especially for efficiency's sake.  -- fx
191        (while (not (eobp))        (while (not (eobp))
192          (setq point (point))          (setq point (point)
193                  nonascii nil)
194          (skip-chars-backward word-chars b)          (skip-chars-backward word-chars b)
195          (unless (eq b (point))          (unless (eq b (point))
196            (push (cons (buffer-substring b (point)) nil) words))            (push (cons (buffer-substring b (point)) nil) words))
197          (setq b (point))          (setq b (point)
198                  nonascii t)
199          (goto-char point)          (goto-char point)
         (setq current (mm-charset-after))  
200          (forward-char 1)          (forward-char 1)
201          (skip-chars-forward word-chars)          (skip-chars-forward word-chars)
202          (while (and (not (eobp))          (while (not (eobp))
                     (eq (mm-charset-after) current))  
203            (forward-char 1)            (forward-char 1)
204            (skip-chars-forward word-chars))            (skip-chars-forward word-chars))
205          (unless (eq b (point))          (unless (eq b (point))
206            (push (cons (buffer-substring b (point)) current) words))            (push (cons (buffer-substring b (point)) nonascii) words))
207          (setq b (point))          (setq b (point))
208          (skip-chars-forward "\000-\177"))          (skip-chars-forward "\000-\177"))
209        (unless (eq b (point))        (unless (eq b (point))
# Line 251  The buffer may be narrowed." Line 249  The buffer may be narrowed."
249            ;; Insert blank between encoded words            ;; Insert blank between encoded words
250            (if (eq (char-before) ?=) (insert " "))            (if (eq (char-before) ?=) (insert " "))
251            (rfc2047-encode (point)            (rfc2047-encode (point)
252                            (progn (insert (car word)) (point))                            (progn (insert (car word)) (point)))))
                           (cdr word))))  
253        (rfc2047-fold-region (point-min) (point-max)))))        (rfc2047-fold-region (point-min) (point-max)))))
254    
255  (defun rfc2047-encode-string (string)  (defun rfc2047-encode-string (string)
# Line 262  The buffer may be narrowed." Line 259  The buffer may be narrowed."
259      (rfc2047-encode-region (point-min) (point-max))      (rfc2047-encode-region (point-min) (point-max))
260      (buffer-string)))      (buffer-string)))
261    
262  (defun rfc2047-encode (b e charset)  (defun rfc2047-encode (b e)
263    "Encode the word in the region B to E with CHARSET."    "Encode the word in the region B to E."
264    (let* ((mime-charset (mm-mime-charset charset))    (let* ((buff (current-buffer))
265           (cs (mm-charset-to-coding-system mime-charset))           (mime-charset (with-temp-buffer
266                             (insert-buffer-substring buff b e)
267                             (mm-find-mime-charset-region b e)))
268             (cs (if (> (length mime-charset) 1)
269                     (mm-charset-to-coding-system mime-charset)
270                   (error "Can't encode word: %s" (buffer-substring b e))))
271           (encoding (or (cdr (assq mime-charset           (encoding (or (cdr (assq mime-charset
272                                    rfc2047-charset-encoding-alist))                                    rfc2047-charset-encoding-alist))
273                         'B))                         'B))

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.10.6.1

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