/[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.29 by uid68472, Sun Jan 18 03:15:25 2004 UTC revision 1.30 by miles, Sat Sep 4 13:13:43 2004 UTC
# Line 1  Line 1 
1  ;;; mm-util.el --- Utility functions for Mule and low level things  ;;; mm-util.el --- Utility functions for Mule and low level things
2  ;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.  ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
3    ;;   Free Software Foundation, Inc.
4    
5  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6  ;;      MORIOKA Tomohiko <morioka@jaist.ac.jp>  ;;      MORIOKA Tomohiko <morioka@jaist.ac.jp>
# Line 24  Line 25 
25    
26  ;;; Code:  ;;; Code:
27    
28  (eval-when-compile  (eval-when-compile (require 'cl))
   (require 'cl)  
   (defvar mm-mime-mule-charset-alist))  
29  (require 'mail-prsvr)  (require 'mail-prsvr)
30    
31  (eval-and-compile  (eval-and-compile
# Line 42  Line 41 
41       (coding-system-list . ignore)       (coding-system-list . ignore)
42       (decode-coding-region . ignore)       (decode-coding-region . ignore)
43       (char-int . identity)       (char-int . identity)
      (device-type . ignore)  
44       (coding-system-equal . equal)       (coding-system-equal . equal)
45       (annotationp . ignore)       (annotationp . ignore)
46       (set-buffer-file-coding-system . ignore)       (set-buffer-file-coding-system . ignore)
# Line 71  Line 69 
69                (setq idx (1+ idx)))                (setq idx (1+ idx)))
70              string)))              string)))
71       (string-as-unibyte . identity)       (string-as-unibyte . identity)
72         (string-make-unibyte . identity)
73       (string-as-multibyte . identity)       (string-as-multibyte . identity)
74       (multibyte-string-p . ignore)       (multibyte-string-p . ignore)
75       (point-at-bol . line-beginning-position)       ;; It is not a MIME function, but some MIME functions use it.
76       (point-at-eol . line-end-position)       (make-temp-file . (lambda (prefix &optional dir-flag)
77                             (let ((file (expand-file-name
78                                          (make-temp-name prefix)
79                                          (if (fboundp 'temp-directory)
80                                              (temp-directory)
81                                            temporary-file-directory))))
82                               (if dir-flag
83                                   (make-directory file))
84                               file)))
85       (insert-byte . insert-char)       (insert-byte . insert-char)
86       (multibyte-char-to-unibyte . identity))))       (multibyte-char-to-unibyte . identity))))
87    
# Line 85  Line 92 
92       ((fboundp 'char-valid-p) 'char-valid-p)       ((fboundp 'char-valid-p) 'char-valid-p)
93       (t 'identity))))       (t 'identity))))
94    
95    ;; Fixme:  This seems always to be used to read a MIME charset, so it
96    ;; should be re-named and fixed (in Emacs) to offer completion only on
97    ;; proper charset names (base coding systems which have a
98    ;; mime-charset defined).  XEmacs doesn't believe in mime-charset;
99    ;; test with
100    ;;   `(or (coding-system-get 'iso-8859-1 'mime-charset)
101    ;;        (coding-system-get 'iso-8859-1 :mime-charset))'
102    ;; Actually, there should be an `mm-coding-system-mime-charset'.
103  (eval-and-compile  (eval-and-compile
104    (defalias 'mm-read-coding-system    (defalias 'mm-read-coding-system
105      (cond      (cond
# Line 106  Line 121 
121    (or mm-coding-system-list    (or mm-coding-system-list
122        (setq mm-coding-system-list (mm-coding-system-list))))        (setq mm-coding-system-list (mm-coding-system-list))))
123    
124  (defun mm-coding-system-p (sym)  (defun mm-coding-system-p (cs)
125    "Return non-nil if SYM is a coding system."    "Return non-nil if CS is a symbol naming a coding system.
126    (or (and (fboundp 'coding-system-p) (coding-system-p sym))  In XEmacs, also return non-nil if CS is a coding system object."
127        (memq sym (mm-get-coding-system-list))))    (if (fboundp 'find-coding-system)
128          (find-coding-system cs)
129        (if (fboundp 'coding-system-p)
130            (coding-system-p cs)
131          ;; Is this branch ever actually useful?
132          (memq cs (mm-get-coding-system-list)))))
133    
134  (defvar mm-charset-synonym-alist  (defvar mm-charset-synonym-alist
135    `(    `(
# Line 122  Line 142 
142      ;; Apparently not defined in Emacs 20, but is a valid MIME name.      ;; Apparently not defined in Emacs 20, but is a valid MIME name.
143      ,@(unless (mm-coding-system-p 'gb2312)      ,@(unless (mm-coding-system-p 'gb2312)
144         '((gb2312 . cn-gb-2312)))         '((gb2312 . cn-gb-2312)))
145      ;; ISO-8859-15 is very similar to ISO-8859-1.      ;; ISO-8859-15 is very similar to ISO-8859-1.  But it's _different_!
146      ;; But this is just wrong.  --fx      ,@(unless (mm-coding-system-p 'iso-8859-15)
     ,@(unless (mm-coding-system-p 'iso-8859-15) ; Emacs 21 defines it.  
147         '((iso-8859-15 . iso-8859-1)))         '((iso-8859-15 . iso-8859-1)))
148        ;; BIG-5HKSCS is similar to, but different than, BIG-5.
149        ,@(unless (mm-coding-system-p 'big5-hkscs)
150            '((big5-hkscs . big5)))
151      ;; Windows-1252 is actually a superset of Latin-1.  See also      ;; Windows-1252 is actually a superset of Latin-1.  See also
152      ;; `gnus-article-dumbquotes-map'.      ;; `gnus-article-dumbquotes-map'.
153      ,@(unless (mm-coding-system-p 'windows-1252)      ,@(unless (mm-coding-system-p 'windows-1252)
# Line 135  Line 157 
157      ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft      ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft
158      ;; Outlook users in Czech republic. Use this to allow reading of their      ;; Outlook users in Czech republic. Use this to allow reading of their
159      ;; e-mails. cp1250 should be defined by M-x codepage-setup.      ;; e-mails. cp1250 should be defined by M-x codepage-setup.
   
     ;; This is not TRT, the MIME name, windows-1250, should be an  
     ;; alias, and cp1250 should have a mime-charset property, per  
     ;; code-page.el. -- fx  
160      ,@(if (and (not (mm-coding-system-p 'windows-1250))      ,@(if (and (not (mm-coding-system-p 'windows-1250))
161                 (mm-coding-system-p 'cp1250))                 (mm-coding-system-p 'cp1250))
162            '((windows-1250 . cp1250)))            '((windows-1250 . cp1250)))
# Line 164  Line 182 
182    
183  (defvar mm-auto-save-coding-system  (defvar mm-auto-save-coding-system
184    (cond    (cond
185     ((mm-coding-system-p 'utf-8-emacs)     ((mm-coding-system-p 'utf-8-emacs)   ; Mule 7
186      (if (memq system-type '(windows-nt ms-dos ms-windows))      (if (memq system-type '(windows-nt ms-dos ms-windows))
187          (if (mm-coding-system-p 'utf-8-emacs-dos)          (if (mm-coding-system-p 'utf-8-emacs-dos)
188              'utf-8-emacs-dos mm-binary-coding-system)              'utf-8-emacs-dos mm-binary-coding-system)
# Line 286  Valid elements include: Line 304  Valid elements include:
304          mm-iso-8859-15-compatible))          mm-iso-8859-15-compatible))
305    "A table of the difference character between ISO-8859-X and ISO-8859-15.")    "A table of the difference character between ISO-8859-X and ISO-8859-15.")
306    
307  (defvar mm-coding-system-priorities nil  (defcustom mm-coding-system-priorities
308    "Preferred coding systems for encoding outgoing mails.    (if (boundp 'current-language-environment)
309          (let ((lang (symbol-value 'current-language-environment)))
310  More than one suitable coding systems may be found for some texts.  By          (cond ((string= lang "Japanese")
311  default, a coding system with the highest priority is used to encode                 ;; Japanese users may prefer iso-2022-jp to shift-jis.
312  outgoing mails (see `sort-coding-systems').  If this variable is set,                 '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis
313  it overrides the default priority.  For example, Japanese users may                               iso-latin-1 utf-8)))))
314  prefer iso-2022-jp to japanese-shift-jis:    "Preferred coding systems for encoding outgoing messages.
315    
316  \(setq mm-coding-system-priorities  More than one suitable coding system may be found for some text.
317    '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis utf-8))  By default, the coding system with the highest priority is used
318  ")  to encode outgoing messages (see `sort-coding-systems').  If this
319    variable is set, it overrides the default priority."
320      :type '(repeat (symbol :tag "Coding system"))
321      :group 'mime)
322    
323  ;; Why on earth was this broken out?  -- fx  ;; ??
324  (defvar mm-use-find-coding-systems-region  (defvar mm-use-find-coding-systems-region
325    (fboundp 'find-coding-systems-region)    (fboundp 'find-coding-systems-region)
326    "Use `find-coding-systems-region' to find proper coding systems.")    "Use `find-coding-systems-region' to find proper coding systems.
327    
328    Setting it to nil is useful on Emacsen supporting Unicode if sending
329    mail with multiple parts is preferred to sending a Unicode one.")
330    
331  ;;; Internal variables:  ;;; Internal variables:
332    
# Line 310  prefer iso-2022-jp to japanese-shift-jis Line 334  prefer iso-2022-jp to japanese-shift-jis
334    
335  (defun mm-mule-charset-to-mime-charset (charset)  (defun mm-mule-charset-to-mime-charset (charset)
336    "Return the MIME charset corresponding to the given Mule CHARSET."    "Return the MIME charset corresponding to the given Mule CHARSET."
337    (if (fboundp 'find-coding-systems-for-charsets)    (if (and (fboundp 'find-coding-systems-for-charsets)
338               (fboundp 'sort-coding-systems))
339        (let (mime)        (let (mime)
340          (dolist (cs (find-coding-systems-for-charsets (list charset)))          (dolist (cs (sort-coding-systems
341                         (copy-sequence
342                          (find-coding-systems-for-charsets (list charset)))))
343            (unless mime            (unless mime
344              (when cs              (when cs
345                (setq mime (or (coding-system-get cs :mime-charset)                (setq mime (or (coding-system-get cs :mime-charset)
# Line 340  used as the line break code type of the Line 367  used as the line break code type of the
367     ((null charset)     ((null charset)
368      charset)      charset)
369     ;; Running in a non-MULE environment.     ;; Running in a non-MULE environment.
370     ((null (mm-get-coding-system-list))     ((or (null (mm-get-coding-system-list))
371            (not (fboundp 'coding-system-get)))
372      charset)      charset)
373     ;; ascii     ;; ascii
374     ((eq charset 'us-ascii)     ((eq charset 'us-ascii)
# Line 356  used as the line break code type of the Line 384  used as the line break code type of the
384      charset)      charset)
385     ;; Translate invalid charsets.     ;; Translate invalid charsets.
386     ((let ((cs (cdr (assq charset mm-charset-synonym-alist))))     ((let ((cs (cdr (assq charset mm-charset-synonym-alist))))
387        (and cs (mm-coding-system-p charset) cs)))        (and cs (mm-coding-system-p cs) cs)))
388     ;; Last resort: search the coding system list for entries which     ;; Last resort: search the coding system list for entries which
389     ;; have the right mime-charset in case the canonical name isn't     ;; have the right mime-charset in case the canonical name isn't
390     ;; defined (though it should be).     ;; defined (though it should be).
# Line 385  used as the line break code type of the Line 413  used as the line break code type of the
413          "Set the multibyte flag of the current buffer.          "Set the multibyte flag of the current buffer.
414  Only do this if the default value of `enable-multibyte-characters' is  Only do this if the default value of `enable-multibyte-characters' is
415  non-nil.  This is a no-op in XEmacs."  non-nil.  This is a no-op in XEmacs."
416          (set-buffer-multibyte t))          (set-buffer-multibyte 'to))
417      (defalias 'mm-enable-multibyte 'ignore))      (defalias 'mm-enable-multibyte 'ignore))
418    
419    (if mm-emacs-mule    (if mm-emacs-mule
# Line 400  This is a no-op in XEmacs." Line 428  This is a no-op in XEmacs."
428    (or (get-charset-property charset 'preferred-coding-system)    (or (get-charset-property charset 'preferred-coding-system)
429        (get-charset-property charset 'prefered-coding-system)))        (get-charset-property charset 'prefered-coding-system)))
430    
431    ;; Mule charsets shouldn't be used.
432    (defsubst mm-guess-charset ()
433      "Guess Mule charset from the language environment."
434      (or
435       mail-parse-mule-charset ;; cached mule-charset
436       (progn
437         (setq mail-parse-mule-charset
438               (and (boundp 'current-language-environment)
439                    (car (last
440                          (assq 'charset
441                                (assoc current-language-environment
442                                       language-info-alist))))))
443         (if (or (not mail-parse-mule-charset)
444                 (eq mail-parse-mule-charset 'ascii))
445             (setq mail-parse-mule-charset
446                   (or (car (last (assq mail-parse-charset
447                                        mm-mime-mule-charset-alist)))
448                       ;; default
449                       'latin-iso8859-1)))
450         mail-parse-mule-charset)))
451    
452  (defun mm-charset-after (&optional pos)  (defun mm-charset-after (&optional pos)
453    "Return charset of a character in current buffer at position POS.    "Return charset of a character in current buffer at position POS.
454  If POS is nil, it defauls to the current point.  If POS is nil, it defauls to the current point.
# Line 416  If the charset is `composition', return Line 465  If the charset is `composition', return
465          (if (and charset (not (memq charset '(ascii eight-bit-control          (if (and charset (not (memq charset '(ascii eight-bit-control
466                                                      eight-bit-graphic))))                                                      eight-bit-graphic))))
467              charset              charset
468            (or            (mm-guess-charset))))))
            mail-parse-mule-charset ;; cached mule-charset  
            (progn  
              (setq mail-parse-mule-charset  
                    (and (boundp 'current-language-environment)  
                         (car (last  
                               (assq 'charset  
                                     (assoc current-language-environment  
                                            language-info-alist))))))  
              (if (or (not mail-parse-mule-charset)  
                      (eq mail-parse-mule-charset 'ascii))  
                  (setq mail-parse-mule-charset  
                        (or (car (last (assq mail-parse-charset  
                                             mm-mime-mule-charset-alist)))  
                            ;; Fixme: don't fix that!  
                            'latin-iso8859-1)))  
              mail-parse-mule-charset)))))))  
469    
470  (defun mm-mime-charset (charset)  (defun mm-mime-charset (charset)
471    "Return the MIME charset corresponding to the given Mule CHARSET."    "Return the MIME charset corresponding to the given Mule CHARSET."
# Line 462  If the charset is `composition', return Line 495  If the charset is `composition', return
495        (setq result (cons head result)))        (setq result (cons head result)))
496      (nreverse result)))      (nreverse result)))
497    
498  ;; It's not clear whether this is supposed to mean the global or local  ;; Fixme:  This is used in places when it should be testing the
499  ;; setting.  I think it's used inconsistently.  -- fx  ;; default multibyteness.  See mm-default-multibyte-p.
500  (defsubst mm-multibyte-p ()  (eval-and-compile
   "Say whether multibyte is enabled."  
501    (if (and (not (featurep 'xemacs))    (if (and (not (featurep 'xemacs))
502             (boundp 'enable-multibyte-characters))             (boundp 'enable-multibyte-characters))
503        enable-multibyte-characters        (defun mm-multibyte-p ()
504      (featurep 'mule)))          "Non-nil if multibyte is enabled in the current buffer."
505            enable-multibyte-characters)
506        (defun mm-multibyte-p () (featurep 'mule))))
507    
508    (defun mm-default-multibyte-p ()
509      "Return non-nil if the session is multibyte.
510    This affects whether coding conversion should be attempted generally."
511      (if (featurep 'mule)
512          (if (boundp 'default-enable-multibyte-characters)
513              default-enable-multibyte-characters
514            t)))
515    
516  (defun mm-iso-8859-x-to-15-region (&optional b e)  (defun mm-iso-8859-x-to-15-region (&optional b e)
517    (if (fboundp 'char-charset)    (if (fboundp 'char-charset)
# Line 487  If the charset is `composition', return Line 529  If the charset is `composition', return
529                (setq inconvertible t)                (setq inconvertible t)
530                (forward-char))                (forward-char))
531               (t               (t
532                (insert (prog1 (+ c (car (cdr item))) (delete-char 1))))                (insert-before-markers (prog1 (+ c (car (cdr item)))
533              (skip-chars-forward "\0-\177"))))                                         (delete-char 1)))))
534                (skip-chars-forward "\0-\177")))
535          (not inconvertible))))          (not inconvertible))))
536    
537  (defun mm-sort-coding-systems-predicate (a b)  (defun mm-sort-coding-systems-predicate (a b)
538    (> (length (memq a mm-coding-system-priorities))    (let ((priorities
539       (length (memq b mm-coding-system-priorities))))           (mapcar (lambda (cs)
540                       ;; Note: invalid entries are dropped silently
541                       (and (coding-system-p cs)
542                            (coding-system-base cs)))
543                     mm-coding-system-priorities)))
544        (> (length (memq a priorities))
545           (length (memq b priorities)))))
546    
547  (defun mm-find-mime-charset-region (b e &optional hack-charsets)  (defun mm-find-mime-charset-region (b e &optional hack-charsets)
548    "Return the MIME charsets needed to encode the region between B and E.    "Return the MIME charsets needed to encode the region between B and E.
# Line 509  charset, and a longer list means no appr Line 558  charset, and a longer list means no appr
558                 (when mm-coding-system-priorities                 (when mm-coding-system-priorities
559                   (setq systems                   (setq systems
560                         (sort systems 'mm-sort-coding-systems-predicate)))                         (sort systems 'mm-sort-coding-systems-predicate)))
                ;; Fixme: The `mime-charset' (`x-ctext') of `compound-text'  
                ;; is not in the IANA list.  
561                 (setq systems (delq 'compound-text systems))                 (setq systems (delq 'compound-text systems))
562                 (unless (equal systems '(undecided))                 (unless (equal systems '(undecided))
563                   (while systems                   (while systems
564                     (let* ((head (pop systems))                     (let* ((head (pop systems))
565                            (cs (or (coding-system-get head :mime-charset)                            (cs (or (coding-system-get head :mime-charset)
566                                    (coding-system-get head 'mime-charset))))                                    (coding-system-get head 'mime-charset))))
567                       (if cs                       ;; The mime-charset (`x-ctext') of
568                         ;; `compound-text' is not in the IANA list.  We
569                         ;; shouldn't normally use anything here with a
570                         ;; mime-charset having an `x-' prefix.
571                         ;; Fixme:  Allow this to be overridden, since
572                         ;; there is existing use of x-ctext.
573                         ;; Also people apparently need the coding system
574                         ;; `iso-2022-jp-3' (which Mule-UCS defines with
575                         ;; mime-charset, though it's not valid).
576                         (if (and cs
577                                  (not (string-match "^[Xx]-" (symbol-name cs)))
578                                  ;; UTF-16 of any variety is invalid for
579                                  ;; text parts and, unfortunately, has
580                                  ;; mime-charset defined both in Mule-UCS
581                                  ;; and versions of Emacs.  (The name
582                                  ;; might be `mule-utf-16...'  or
583                                  ;; `utf-16...'.)
584                                  (not (string-match "utf-16" (symbol-name cs))))
585                           (setq systems nil                           (setq systems nil
586                                 charsets (list cs))))))                                 charsets (list cs))))))
587                 charsets))                 charsets))
588          ;; Otherwise we're not multibyte, XEmacs or a single coding          ;; Otherwise we're not multibyte, we're XEmacs, or a single
589          ;; system won't cover it.          ;; coding system won't cover it.
590          (setq charsets          (setq charsets
591                (mm-delete-duplicates                (mm-delete-duplicates
592                 (mapcar 'mm-mime-charset                 (mapcar 'mm-mime-charset
593                         (delq 'ascii                         (delq 'ascii
594                               (mm-find-charset-region b e))))))                               (mm-find-charset-region b e))))))
595      (if (and (memq 'iso-8859-15 charsets)      (if (and (> (length charsets) 1)
596                 (memq 'iso-8859-15 charsets)
597               (memq 'iso-8859-15 hack-charsets)               (memq 'iso-8859-15 hack-charsets)
598               (save-excursion (mm-iso-8859-x-to-15-region b e)))               (save-excursion (mm-iso-8859-x-to-15-region b e)))
599          (mapcar (lambda (x) (setq charsets (delq (car x) charsets)))          (mapcar (lambda (x) (setq charsets (delq (car x) charsets)))
# Line 546  Use unibyte mode for this." Line 611  Use unibyte mode for this."
611  (put 'mm-with-unibyte-buffer 'lisp-indent-function 0)  (put 'mm-with-unibyte-buffer 'lisp-indent-function 0)
612  (put 'mm-with-unibyte-buffer 'edebug-form-spec '(body))  (put 'mm-with-unibyte-buffer 'edebug-form-spec '(body))
613    
614    (defmacro mm-with-multibyte-buffer (&rest forms)
615      "Create a temporary buffer, and evaluate FORMS there like `progn'.
616    Use multibyte mode for this."
617      `(let ((default-enable-multibyte-characters t))
618         (with-temp-buffer ,@forms)))
619    (put 'mm-with-multibyte-buffer 'lisp-indent-function 0)
620    (put 'mm-with-multibyte-buffer 'edebug-form-spec '(body))
621    
622  (defmacro mm-with-unibyte-current-buffer (&rest forms)  (defmacro mm-with-unibyte-current-buffer (&rest forms)
623    "Evaluate FORMS with current buffer temporarily made unibyte.    "Evaluate FORMS with current buffer temporarily made unibyte.
624  Also bind `default-enable-multibyte-characters' to nil.  Also bind `default-enable-multibyte-characters' to nil.
# Line 567  Equivalent to `progn' in XEmacs" Line 640  Equivalent to `progn' in XEmacs"
640  (put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body))  (put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body))
641    
642  (defmacro mm-with-unibyte (&rest forms)  (defmacro mm-with-unibyte (&rest forms)
643    "Eval the FORMS with the default value of `enable-multibyte-characters' nil, ."    "Eval the FORMS with the default value of `enable-multibyte-characters' nil."
644    `(let (default-enable-multibyte-characters)    `(let (default-enable-multibyte-characters)
645       ,@forms))       ,@forms))
646  (put 'mm-with-unibyte 'lisp-indent-function 0)  (put 'mm-with-unibyte 'lisp-indent-function 0)
647  (put 'mm-with-unibyte 'edebug-form-spec '(body))  (put 'mm-with-unibyte 'edebug-form-spec '(body))
648    
649    (defmacro mm-with-multibyte (&rest forms)
650      "Eval the FORMS with the default value of `enable-multibyte-characters' t."
651      `(let ((default-enable-multibyte-characters t))
652         ,@forms))
653    (put 'mm-with-multibyte 'lisp-indent-function 0)
654    (put 'mm-with-multibyte 'edebug-form-spec '(body))
655    
656  (defun mm-find-charset-region (b e)  (defun mm-find-charset-region (b e)
657    "Return a list of Emacs charsets in the region B to E."    "Return a list of Emacs charsets in the region B to E."
658    (cond    (cond
# Line 638  Equivalent to `progn' in XEmacs" Line 718  Equivalent to `progn' in XEmacs"
718    
719  (defun mm-insert-file-contents (filename &optional visit beg end replace  (defun mm-insert-file-contents (filename &optional visit beg end replace
720                                           inhibit)                                           inhibit)
721    "Like `insert-file-contents', q.v., but only reads in the file.    "Like `insert-file-contents', but only reads in the file.
722  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
723  to advanced Emacs features, such as file-name-handlers, format decoding,  to advanced Emacs features, such as file-name-handlers, format decoding,
724  find-file-hooks, etc.  `find-file-hooks', etc.
725  If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'.  If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'.
726    This function ensures that none of these modifications will take place."    This function ensures that none of these modifications will take place."
727    (let ((format-alist nil)    (let ((format-alist nil)
# Line 668  START, END and FILENAME.  START and END Line 748  START, END and FILENAME.  START and END
748  saying what text to write.  saying what text to write.
749  Optional fourth argument specifies the coding system to use when  Optional fourth argument specifies the coding system to use when
750  encoding the file.  encoding the file.
751  If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers."  If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'."
752    (let ((coding-system-for-write    (let ((coding-system-for-write
753           (or codesys mm-text-coding-system-for-write           (or codesys mm-text-coding-system-for-write
754               mm-text-coding-system))               mm-text-coding-system))
# Line 680  If INHIBIT is non-nil, inhibit mm-inhibi Line 760  If INHIBIT is non-nil, inhibit mm-inhibi
760               (append mm-inhibit-file-name-handlers               (append mm-inhibit-file-name-handlers
761                       inhibit-file-name-handlers)                       inhibit-file-name-handlers)
762             inhibit-file-name-handlers)))             inhibit-file-name-handlers)))
763      (append-to-file start end filename)))      (write-region start end filename t 'no-message)
764        (message "Appended to %s" filename)))
765    
766  (defun mm-write-region (start end filename &optional append visit lockname  (defun mm-write-region (start end filename &optional append visit lockname
767                                coding-system inhibit)                                coding-system inhibit)
768    
769    "Like `write-region'.    "Like `write-region'.
770  If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers."  If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'."
771    (let ((coding-system-for-write    (let ((coding-system-for-write
772           (or coding-system mm-text-coding-system-for-write           (or coding-system mm-text-coding-system-for-write
773               mm-text-coding-system))               mm-text-coding-system))
# Line 710  If INHIBIT is non-nil, inhibit mm-inhibi Line 791  If INHIBIT is non-nil, inhibit mm-inhibi
791            (push dir result))            (push dir result))
792        (push path result))))        (push path result))))
793    
794  ;; It is not a MIME function, but some MIME functions use it.  ;; Fixme: This doesn't look useful where it's used.
795  (defalias 'mm-make-temp-file  (if (fboundp 'detect-coding-region)
796    (if (fboundp 'make-temp-file)      (defun mm-detect-coding-region (start end)
797        'make-temp-file        "Like `detect-coding-region' except returning the best one."
798      (lambda (prefix &optional dir-flag)        (let ((coding-systems
799        (let ((file (expand-file-name               (detect-coding-region (point) (point-max))))
800                     (make-temp-name prefix)          (or (car-safe coding-systems)
801                     (if (fboundp 'temp-directory)              coding-systems)))
802                         (temp-directory)    (defun mm-detect-coding-region (start end)
803                       temporary-file-directory))))      (let ((point (point)))
804          (if dir-flag        (goto-char start)
805              (make-directory file))        (skip-chars-forward "\0-\177" end)
806          file))))        (prog1
807              (if (eq (point) end) 'ascii (mm-guess-charset))
808            (goto-char point)))))
809    
810    (if (fboundp 'coding-system-get)
811        (defun mm-detect-mime-charset-region (start end)
812          "Detect MIME charset of the text in the region between START and END."
813          (let ((cs (mm-detect-coding-region start end)))
814            (coding-system-get cs 'mime-charset)))
815      (defun mm-detect-mime-charset-region (start end)
816        "Detect MIME charset of the text in the region between START and END."
817        (let ((cs (mm-detect-coding-region start end)))
818          cs)))
819    
820    
821  (provide 'mm-util)  (provide 'mm-util)
822    

Legend:
Removed from v.1.29  
changed lines
  Added in v.1.30

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