/[emacs]/emacs/lisp/gnus/mm-util.el
ViewVC logotype

Diff of /emacs/lisp/gnus/mm-util.el

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

revision 1.25 by zsh, Thu Mar 21 19:11:23 2002 UTC revision 1.25.2.1 by miles, Fri Apr 4 06:20:21 2003 UTC
# Line 24  Line 24 
24    
25  ;;; Code:  ;;; Code:
26    
27  (eval-when-compile (require 'cl))  (eval-when-compile
28      (require 'cl)
29      (defvar mm-mime-mule-charset-alist))
30  (require 'mail-prsvr)  (require 'mail-prsvr)
31    
32  (eval-and-compile  (eval-and-compile
# Line 70  Line 72 
72              string)))              string)))
73       (string-as-unibyte . identity)       (string-as-unibyte . identity)
74       (string-as-multibyte . identity)       (string-as-multibyte . identity)
75       (multibyte-string-p . ignore))))       (multibyte-string-p . ignore)
76         (point-at-bol . line-beginning-position)
77         (point-at-eol . line-end-position)
78         (insert-byte . insert-char)
79         (multibyte-char-to-unibyte . identity))))
80    
81  (eval-and-compile  (eval-and-compile
82    (defalias 'mm-char-or-char-int-p    (defalias 'mm-char-or-char-int-p
# Line 117  Line 123 
123      ,@(unless (mm-coding-system-p 'gb2312)      ,@(unless (mm-coding-system-p 'gb2312)
124         '((gb2312 . cn-gb-2312)))         '((gb2312 . cn-gb-2312)))
125      ;; ISO-8859-15 is very similar to ISO-8859-1.      ;; ISO-8859-15 is very similar to ISO-8859-1.
126        ;; But this is just wrong.  --fx
127      ,@(unless (mm-coding-system-p 'iso-8859-15) ; Emacs 21 defines it.      ,@(unless (mm-coding-system-p 'iso-8859-15) ; Emacs 21 defines it.
128         '((iso-8859-15 . iso-8859-1)))         '((iso-8859-15 . iso-8859-1)))
129      ;; Windows-1252 is actually a superset of Latin-1.  See also      ;; Windows-1252 is actually a superset of Latin-1.  See also
130      ;; `gnus-article-dumbquotes-map'.      ;; `gnus-article-dumbquotes-map'.
131      ,@(unless (mm-coding-system-p 'windows-1252)              ,@(unless (mm-coding-system-p 'windows-1252)
132         (if (mm-coding-system-p 'cp1252)         (if (mm-coding-system-p 'cp1252)
133             '((windows-1252 . cp1252))             '((windows-1252 . cp1252))
134           '((windows-1252 . iso-8859-1))))           '((windows-1252 . iso-8859-1))))
135      ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft      ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft
136      ;; Outlook users in Czech republic. Use this to allow reading of their      ;; Outlook users in Czech republic. Use this to allow reading of their
137      ;; e-mails. cp1250 should be defined by M-x codepage-setup.      ;; e-mails. cp1250 should be defined by M-x codepage-setup.
138    
139        ;; This is not TRT, the MIME name, windows-1250, should be an
140        ;; alias, and cp1250 should have a mime-charset property, per
141        ;; code-page.el. -- fx
142      ,@(if (and (not (mm-coding-system-p 'windows-1250))      ,@(if (and (not (mm-coding-system-p 'windows-1250))
143                 (mm-coding-system-p 'cp1250))                 (mm-coding-system-p 'cp1250))
144            '((windows-1250 . cp1250)))            '((windows-1250 . cp1250)))
# Line 153  Line 164 
164    
165  (defvar mm-auto-save-coding-system  (defvar mm-auto-save-coding-system
166    (cond    (cond
167       ((mm-coding-system-p 'utf-8-emacs)
168        (if (memq system-type '(windows-nt ms-dos ms-windows))
169            (if (mm-coding-system-p 'utf-8-emacs-dos)
170                'utf-8-emacs-dos mm-binary-coding-system)
171          'utf-8-emacs))
172     ((mm-coding-system-p 'emacs-mule)     ((mm-coding-system-p 'emacs-mule)
173      (if (memq system-type '(windows-nt ms-dos ms-windows))      (if (memq system-type '(windows-nt ms-dos ms-windows))
174          (if (mm-coding-system-p 'emacs-mule-dos)          (if (mm-coding-system-p 'emacs-mule-dos)
# Line 231  Line 247 
247           'nconc           'nconc
248           (mapcar           (mapcar
249            (lambda (cs)            (lambda (cs)
250              (when (and (coding-system-get cs 'mime-charset)              (when (and (or (coding-system-get cs :mime-charset) ; Emacs 22
251                               (coding-system-get cs 'mime-charset))
252                         (not (eq t (coding-system-get cs 'safe-charsets))))                         (not (eq t (coding-system-get cs 'safe-charsets))))
253                (list (cons (coding-system-get cs 'mime-charset)                (list (cons (or (coding-system-get cs :mime-charset)
254                                  (coding-system-get cs 'mime-charset))
255                            (delq 'ascii                            (delq 'ascii
256                                  (coding-system-get cs 'safe-charsets))))))                                  (coding-system-get cs 'safe-charsets))))))
257            (sort-coding-systems (coding-system-list 'base-only))))))            (sort-coding-systems (coding-system-list 'base-only))))))
# Line 245  Valid elements include: Line 263  Valid elements include:
263  `iso-2022-jp-2'  convert ISO-2022-jp to ISO-2022-jp-2 if ISO-2022-jp-2 exists."  `iso-2022-jp-2'  convert ISO-2022-jp to ISO-2022-jp-2 if ISO-2022-jp-2 exists."
264  )  )
265    
266  (defvar mm-iso-8859-15-compatible  (defvar mm-iso-8859-15-compatible
267    '((iso-8859-1 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE")    '((iso-8859-1 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE")
268      (iso-8859-9 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE\xD0\xDD\xDE\xF0\xFD\xFE"))      (iso-8859-9 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE\xD0\xDD\xDE\xF0\xFD\xFE"))
269    "ISO-8859-15 exchangeable coding systems and inconvertible characters.")    "ISO-8859-15 exchangeable coding systems and inconvertible characters.")
# Line 253  Valid elements include: Line 271  Valid elements include:
271  (defvar mm-iso-8859-x-to-15-table  (defvar mm-iso-8859-x-to-15-table
272    (and (fboundp 'coding-system-p)    (and (fboundp 'coding-system-p)
273         (mm-coding-system-p 'iso-8859-15)         (mm-coding-system-p 'iso-8859-15)
274         (mapcar         (mapcar
275          (lambda (cs)          (lambda (cs)
276            (if (mm-coding-system-p (car cs))            (if (mm-coding-system-p (car cs))
277                (let ((c (string-to-char                (let ((c (string-to-char
278                          (decode-coding-string "\341" (car cs)))))                          (decode-coding-string "\341" (car cs)))))
279                  (cons (char-charset c)                  (cons (char-charset c)
280                        (cons                        (cons
281                         (- (string-to-char                         (- (string-to-char
282                             (decode-coding-string "\341" 'iso-8859-15)) c)                             (decode-coding-string "\341" 'iso-8859-15)) c)
283                         (string-to-list (decode-coding-string (car (cdr cs))                         (string-to-list (decode-coding-string (car (cdr cs))
284                                                               (car cs))))))                                                               (car cs))))))
285              '(gnus-charset 0)))              '(gnus-charset 0)))
286          mm-iso-8859-15-compatible))          mm-iso-8859-15-compatible))
# Line 281  prefer iso-2022-jp to japanese-shift-jis Line 299  prefer iso-2022-jp to japanese-shift-jis
299    '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis utf-8))    '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis utf-8))
300  ")  ")
301    
302    ;; Why on earth was this broken out?  -- fx
303  (defvar mm-use-find-coding-systems-region  (defvar mm-use-find-coding-systems-region
304    (fboundp 'find-coding-systems-region)    (fboundp 'find-coding-systems-region)
305    "Use `find-coding-systems-region' to find proper coding systems.")    "Use `find-coding-systems-region' to find proper coding systems.")
# Line 296  prefer iso-2022-jp to japanese-shift-jis Line 315  prefer iso-2022-jp to japanese-shift-jis
315          (dolist (cs (find-coding-systems-for-charsets (list charset)))          (dolist (cs (find-coding-systems-for-charsets (list charset)))
316            (unless mime            (unless mime
317              (when cs              (when cs
318                (setq mime (coding-system-get cs 'mime-charset)))))                (setq mime (or (coding-system-get cs :mime-charset)
319                                 (coding-system-get cs 'mime-charset))))))
320          mime)          mime)
321      (let ((alist mm-mime-mule-charset-alist)      (let ((alist mm-mime-mule-charset-alist)
322            out)            out)
# Line 345  used as the line break code type of the Line 365  used as the line break code type of the
365        ;; Do we need -lbt?        ;; Do we need -lbt?
366        (dolist (c (mm-get-coding-system-list))        (dolist (c (mm-get-coding-system-list))
367          (if (and (null cs)          (if (and (null cs)
368                   (eq charset (coding-system-get c 'mime-charset)))                   (eq charset (or (coding-system-get c :mime-charset)
369                                     (coding-system-get c 'mime-charset))))
370              (setq cs c)))              (setq cs c)))
371        cs))))        cs))))
372    
# Line 357  used as the line break code type of the Line 378  used as the line break code type of the
378                               (boundp 'default-enable-multibyte-characters)                               (boundp 'default-enable-multibyte-characters)
379                               default-enable-multibyte-characters                               default-enable-multibyte-characters
380                               (fboundp 'set-buffer-multibyte))                               (fboundp 'set-buffer-multibyte))
381      "Emacs mule.")      "True in Emacs with Mule.")
     
   (defvar mm-mule4-p (and mm-emacs-mule  
                           (fboundp 'charsetp)  
                           (not (charsetp 'eight-bit-control)))  
     "Mule version 4.")  
382    
383    (if mm-emacs-mule    (if mm-emacs-mule
384        (defun mm-enable-multibyte ()        (defun mm-enable-multibyte ()
# Line 377  non-nil.  This is a no-op in XEmacs." Line 393  non-nil.  This is a no-op in XEmacs."
393          "Unset the multibyte flag of in the current buffer.          "Unset the multibyte flag of in the current buffer.
394  This is a no-op in XEmacs."  This is a no-op in XEmacs."
395          (set-buffer-multibyte nil))          (set-buffer-multibyte nil))
396      (defalias 'mm-disable-multibyte 'ignore))      (defalias 'mm-disable-multibyte 'ignore)))
   
   (if mm-mule4-p  
       (defun mm-enable-multibyte-mule4  ()  
         "Enable multibyte in the current buffer.  
 Only used in Emacs Mule 4."  
         (set-buffer-multibyte t))  
     (defalias 'mm-enable-multibyte-mule4 'ignore))  
     
   (if mm-mule4-p  
       (defun mm-disable-multibyte-mule4 ()  
         "Disable multibyte in the current buffer.  
 Only used in Emacs Mule 4."  
         (set-buffer-multibyte nil))  
     (defalias 'mm-disable-multibyte-mule4 'ignore)))  
397    
398  (defun mm-preferred-coding-system (charset)  (defun mm-preferred-coding-system (charset)
399    ;; A typo in some Emacs versions.    ;; A typo in some Emacs versions.
# Line 408  If the charset is `composition', return Line 410  If the charset is `composition', return
410          (setq charset 'ascii)          (setq charset 'ascii)
411        ;; charset-after is fake in some Emacsen.        ;; charset-after is fake in some Emacsen.
412        (setq charset (and (fboundp 'char-charset) (char-charset char)))        (setq charset (and (fboundp 'char-charset) (char-charset char)))
413        (if (eq charset 'composition)        (if (eq charset 'composition)     ; Mule 4
414            (let ((p (or pos (point))))            (let ((p (or pos (point))))
415              (cadr (find-charset-region p (1+ p))))              (cadr (find-charset-region p (1+ p))))
416          (if (and charset (not (memq charset '(ascii eight-bit-control          (if (and charset (not (memq charset '(ascii eight-bit-control
# Line 440  If the charset is `composition', return Line 442  If the charset is `composition', return
442        ;; This exists in Emacs 20.        ;; This exists in Emacs 20.
443        (or        (or
444         (and (mm-preferred-coding-system charset)         (and (mm-preferred-coding-system charset)
445              (coding-system-get              (or (coding-system-get
446               (mm-preferred-coding-system charset) 'mime-charset))                   (mm-preferred-coding-system charset) :mime-charset)
447                    (coding-system-get
448                     (mm-preferred-coding-system charset) 'mime-charset)))
449         (and (eq charset 'ascii)         (and (eq charset 'ascii)
450              'us-ascii)              'us-ascii)
451         (mm-preferred-coding-system charset)         (mm-preferred-coding-system charset)
# Line 475  If the charset is `composition', return Line 479  If the charset is `composition', return
479            (goto-char (point-min))            (goto-char (point-min))
480            (skip-chars-forward "\0-\177")            (skip-chars-forward "\0-\177")
481            (while (not (eobp))            (while (not (eobp))
482              (cond              (cond
483               ((not (setq item (assq (char-charset (setq c (char-after)))               ((not (setq item (assq (char-charset (setq c (char-after)))
484                                      mm-iso-8859-x-to-15-table)))                                      mm-iso-8859-x-to-15-table)))
485                (forward-char))                (forward-char))
486               ((memq c (cdr (cdr item)))               ((memq c (cdr (cdr item)))
# Line 503  charset, and a longer list means no appr Line 507  charset, and a longer list means no appr
507               ;; system that has one.               ;; system that has one.
508               (let ((systems (find-coding-systems-region b e)))               (let ((systems (find-coding-systems-region b e)))
509                 (when mm-coding-system-priorities                 (when mm-coding-system-priorities
510                   (setq systems                   (setq systems
511                         (sort systems 'mm-sort-coding-systems-predicate)))                         (sort systems 'mm-sort-coding-systems-predicate)))
512                 ;; Fixme: The `mime-charset' (`x-ctext') of `compound-text'                 ;; Fixme: The `mime-charset' (`x-ctext') of `compound-text'
513                 ;; is not in the IANA list.                 ;; is not in the IANA list.
514                 (setq systems (delq 'compound-text systems))                 (setq systems (delq 'compound-text systems))
515                 (unless (equal systems '(undecided))                 (unless (equal systems '(undecided))
516                   (while systems                   (while systems
517                     (let ((cs (coding-system-get (pop systems) 'mime-charset)))                     (let* ((head (pop systems))
518                              (cs (or (coding-system-get head :mime-charset)
519                                      (coding-system-get head 'mime-charset))))
520                       (if cs                       (if cs
521                           (setq systems nil                           (setq systems nil
522                                 charsets (list cs))))))                                 charsets (list cs))))))
523                 charsets))                 charsets))
524          ;; Otherwise we're not multibyte, XEmacs or a single coding          ;; Otherwise we're not multibyte, XEmacs or a single coding
525          ;; system won't cover it.          ;; system won't cover it.
526          (setq charsets          (setq charsets
527                (mm-delete-duplicates                (mm-delete-duplicates
528                 (mapcar 'mm-mime-charset                 (mapcar 'mm-mime-charset
529                         (delq 'ascii                         (delq 'ascii
# Line 541  Use unibyte mode for this." Line 547  Use unibyte mode for this."
547  (put 'mm-with-unibyte-buffer 'edebug-form-spec '(body))  (put 'mm-with-unibyte-buffer 'edebug-form-spec '(body))
548    
549  (defmacro mm-with-unibyte-current-buffer (&rest forms)  (defmacro mm-with-unibyte-current-buffer (&rest forms)
550    "Evaluate FORMS with current current buffer temporarily made unibyte.    "Evaluate FORMS with current buffer temporarily made unibyte.
551  Also bind `default-enable-multibyte-characters' to nil.  Also bind `default-enable-multibyte-characters' to nil.
552  Equivalent to `progn' in XEmacs"  Equivalent to `progn' in XEmacs"
553    (let ((multibyte (make-symbol "multibyte"))    (let ((multibyte (make-symbol "multibyte"))
554          (buffer (make-symbol "buffer")))          (buffer (make-symbol "buffer")))
555      `(if mm-emacs-mule      `(if mm-emacs-mule
556           (let ((,multibyte enable-multibyte-characters)           (let ((,multibyte enable-multibyte-characters)
557                 (,buffer (current-buffer)))                 (,buffer (current-buffer)))
558             (unwind-protect             (unwind-protect
# Line 560  Equivalent to `progn' in XEmacs" Line 566  Equivalent to `progn' in XEmacs"
566  (put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0)  (put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0)
567  (put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body))  (put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body))
568    
 (defmacro mm-with-unibyte-current-buffer-mule4 (&rest forms)  
   "Evaluate FORMS there like `progn' in current buffer.  
 Mule4 only."  
   (let ((multibyte (make-symbol "multibyte"))  
         (buffer (make-symbol "buffer")))  
     `(if mm-mule4-p  
          (let ((,multibyte enable-multibyte-characters)  
                (,buffer (current-buffer)))  
            (unwind-protect  
                (let (default-enable-multibyte-characters)  
                  (set-buffer-multibyte nil)  
                  ,@forms)  
              (set-buffer ,buffer)  
              (set-buffer-multibyte ,multibyte)))  
        (let (default-enable-multibyte-characters)  
          ,@forms))))  
 (put 'mm-with-unibyte-current-buffer-mule4 'lisp-indent-function 0)  
 (put 'mm-with-unibyte-current-buffer-mule4 'edebug-form-spec '(body))  
   
569  (defmacro mm-with-unibyte (&rest forms)  (defmacro mm-with-unibyte (&rest forms)
570    "Eval the FORMS with the default value of `enable-multibyte-characters' nil, ."    "Eval the FORMS with the default value of `enable-multibyte-characters' nil, ."
571    `(let (default-enable-multibyte-characters)    `(let (default-enable-multibyte-characters)
# Line 655  Mule4 only." Line 642  Mule4 only."
642  A buffer may be modified in several ways after reading into the buffer due  A buffer may be modified in several ways after reading into the buffer due
643  to advanced Emacs features, such as file-name-handlers, format decoding,  to advanced Emacs features, such as file-name-handlers, format decoding,
644  find-file-hooks, etc.  find-file-hooks, etc.
645  If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers.  If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'.
646    This function ensures that none of these modifications will take place."    This function ensures that none of these modifications will take place."
647    (let ((format-alist nil)    (let ((format-alist nil)
648          (auto-mode-alist (if inhibit nil (mm-auto-mode-alist)))          (auto-mode-alist (if inhibit nil (mm-auto-mode-alist)))

Legend:
Removed from v.1.25  
changed lines
  Added in v.1.25.2.1

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