ew-compat.el

   1 (require 'ew-dec)
   2 (require 'eword-decode)
   3
   4 (require 'ew-line)
   5 (eval-when-compile (require 'cl))
   6
   7 (defun ew-gnus-structured-field-decoder (string)
   8   (if (fboundp 'ew-decode-field)
   9       (let ((ew-ignore-76bytes-limit t)
  10             (ew-default-mime-charset default-mime-charset))
  11         (condition-case nil
  12             (ew-cut-cr-lf (ew-decode-field "From" (ew-lf-crlf-to-crlf string)))
  13           (error
  14            (message "gnus-structured-field-decoder error: %s" string)
  15            (decode-mime-charset-string string 'x-ctext))))
  16     (eword-decode-and-unfold-structured-field-body string)))
  17
  18 (defun ew-gnus-unstructured-field-decoder (string)
  19   (if (fboundp 'ew-decode-field)
  20       (let ((ew-ignore-76bytes-limit t)
  21             (ew-default-mime-charset default-mime-charset))
  22         (condition-case nil
  23             (ew-cut-cr-lf (ew-decode-field "Subject" (ew-lf-crlf-to-crlf string)))
  24           (error
  25            (message "gnus-unstructured-field-decoder error: %s" string)
  26            (decode-mime-charset-string string 'x-ctext))))
  27     (eword-decode-unstructured-field-body (std11-unfold-string string) 'must-unfold)))
  28
  29 (defun ew-mime-update-field-decoder-cache (field mode)
  30   (let ((fun (cond
  31               ((eq mode 'plain)
  32                (lexical-let ((field-name (symbol-name field)))
  33                  (lambda (field-body &optional start-column max-column must-unfold)
  34                    (setq field-body (ew-lf-to-crlf field-body))
  35                    (let ((res (ew-crlf-to-lf
  36                                (ew-decode-field field-name field-body))))
  37                      (add-text-properties
  38                       0 (length res)
  39                       (list 'original-field-name field-name
  40                             'original-field-body field-body)
  41                       res)
  42                      res))))
  43               ((eq mode 'wide)
  44                (lexical-let ((field-name (symbol-name field)))
  45                  (lambda (field-body &optional start-column max-column must-unfold)
  46                    (setq field-body (ew-lf-to-crlf field-body))
  47                    (let ((res (ew-crlf-to-lf
  48                                (ew-crlf-refold
  49                                 (ew-decode-field field-name field-body)
  50                                 (length field-name)
  51                                 (or max-column fill-column)))))
  52                      (add-text-properties
  53                       0 (length res)
  54                       (list 'original-field-name field-name
  55                             'original-field-body field-body)
  56                       res)
  57                      res))))
  58               ((eq mode 'summary)
  59                (lexical-let ((field-name (symbol-name field)))
  60                  (lambda (field-body &optional start-column max-column must-unfold)
  61                    (setq field-body (ew-lf-to-crlf field-body))
  62                    (let ((res (ew-crlf-to-lf
  63                                (ew-crlf-unfold
  64                                 (ew-decode-field field-name field-body)))))
  65                      (add-text-properties
  66                       0 (length res)
  67                       (list 'original-field-name field-name
  68                             'original-field-body field-body)
  69                       res)
  70                      res))))
  71               ((eq mode 'nov)
  72                (lexical-let ((field-name (symbol-name field)))
  73                  (lambda (field-body &optional start-column max-column must-unfold)
  74                    (setq field-body (ew-lf-to-crlf field-body))
  75                    (require 'ew-var)
  76                    (let ((ew-ignore-76bytes-limit t))
  77                      (let ((res (ew-crlf-to-lf
  78                                  (ew-crlf-unfold
  79                                   (ew-decode-field field-name field-body)))))
  80                        (add-text-properties
  81                         0 (length res)
  82                         (list 'original-field-name field-name
  83                               'original-field-body field-body)
  84                         res)
  85                        res)))))
  86               (t
  87                nil))))
  88     (mime-update-field-decoder-cache field mode fun)))
  89
  90 (setq mime-update-field-decoder-cache 'ew-mime-update-field-decoder-cache)