diff options
Diffstat (limited to 'lisp/gnus/mm-util.el')
| -rw-r--r-- | lisp/gnus/mm-util.el | 1046 |
1 files changed, 140 insertions, 906 deletions
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 25ecca69c58..89f397e3ed0 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -25,279 +25,24 @@ (eval-when-compile (require 'cl)) (require 'mail-prsvr) +(require 'timer) -(eval-and-compile - (if (featurep 'xemacs) - (unless (ignore-errors - (require 'timer-funcs)) - (require 'timer)) - (require 'timer))) - -(defvar mm-mime-mule-charset-alist ) -;; Note this is not presently used on Emacs >= 23, which is good, -;; since it means standalone message-mode (which requires mml and -;; hence mml-util) does not load gnus-util. -(autoload 'gnus-completing-read "gnus-util") - -;; Emulate functions that are not available in every (X)Emacs version. -;; The name of a function is prefixed with mm-, like `mm-char-int' for -;; `char-int' that is a native XEmacs function, not available in Emacs. -;; Gnus programs all should use mm- functions, not the original ones. -(eval-and-compile - (mapc - (lambda (elem) - (let ((nfunc (intern (format "mm-%s" (car elem))))) - (if (fboundp (car elem)) - (defalias nfunc (car elem)) - (defalias nfunc (cdr elem))))) - `(;; `coding-system-list' is not available in XEmacs 21.4 built - ;; without the `file-coding' feature. - (coding-system-list . ignore) - ;; `char-int' is an XEmacs function, not available in Emacs. - (char-int . identity) - ;; `coding-system-equal' is an Emacs function, not available in XEmacs. - (coding-system-equal . equal) - ;; `annotationp' is an XEmacs function, not available in Emacs. - (annotationp . ignore) - ;; `set-buffer-file-coding-system' is not available in XEmacs 21.4 - ;; built without the `file-coding' feature. - (set-buffer-file-coding-system . ignore) - ;; `read-charset' is an Emacs function, not available in XEmacs. - (read-charset - . ,(lambda (prompt) - "Return a charset." - (intern - (gnus-completing-read - prompt - (mapcar (lambda (e) (symbol-name (car e))) - mm-mime-mule-charset-alist) - t)))) - ;; `subst-char-in-string' is not available in XEmacs 21.4. - (subst-char-in-string - . ,(lambda (from to string &optional inplace) - ;; stolen (and renamed) from nnheader.el - "Replace characters in STRING from FROM to TO. - Unless optional argument INPLACE is non-nil, return a new string." - (let ((string (if inplace string (copy-sequence string))) - (len (length string)) - (idx 0)) - ;; Replace all occurrences of FROM with TO. - (while (< idx len) - (when (= (aref string idx) from) - (aset string idx to)) - (setq idx (1+ idx))) - string))) - ;; `replace-in-string' is an XEmacs function, not available in Emacs. - (replace-in-string - . ,(lambda (string regexp rep &optional literal) - "See `replace-regexp-in-string', only the order of args differs." - (replace-regexp-in-string regexp rep string nil literal))) - ;; `string-as-unibyte' is an Emacs function, not available in XEmacs. - (string-as-unibyte . identity) - ;; `string-make-unibyte' is an Emacs function, not available in XEmacs. - (string-make-unibyte . identity) - ;; string-as-multibyte often doesn't really do what you think it does. - ;; Example: - ;; (aref (string-as-multibyte "\201") 0) -> 129 (aka ?\201) - ;; (aref (string-as-multibyte "\300") 0) -> 192 (aka ?\300) - ;; (aref (string-as-multibyte "\300\201") 0) -> 192 (aka ?\300) - ;; (aref (string-as-multibyte "\300\201") 1) -> 129 (aka ?\201) - ;; but - ;; (aref (string-as-multibyte "\201\300") 0) -> 2240 - ;; (aref (string-as-multibyte "\201\300") 1) -> <error> - ;; Better use string-to-multibyte or encode-coding-string. - ;; If you really need string-as-multibyte somewhere it's usually - ;; because you're using the internal emacs-mule representation (maybe - ;; because you're using string-as-unibyte somewhere), which is - ;; generally a problem in itself. - ;; Here is an approximate equivalence table to help think about it: - ;; (string-as-multibyte s) ~= (decode-coding-string s 'emacs-mule) - ;; (string-to-multibyte s) ~= (decode-coding-string s 'binary) - ;; (string-make-multibyte s) ~= (decode-coding-string s locale-coding-system) - ;; `string-as-multibyte' is an Emacs function, not available in XEmacs. - (string-as-multibyte . identity) - ;; `multibyte-string-p' is an Emacs function, not available in XEmacs. - (multibyte-string-p . ignore) - ;; `insert-byte' is available only in Emacs 23.1 or greater. - (insert-byte . insert-char) - ;; `multibyte-char-to-unibyte' is an Emacs function, not available - ;; in XEmacs. - (multibyte-char-to-unibyte . identity) - ;; `set-buffer-multibyte' is an Emacs function, not available in XEmacs. - (set-buffer-multibyte . ignore) - ;; `substring-no-properties' is available only in Emacs 22.1 or greater. - (substring-no-properties - . ,(lambda (string &optional from to) - "Return a substring of STRING, without text properties. -It starts at index FROM and ending before TO. -TO may be nil or omitted; then the substring runs to the end of STRING. -If FROM is nil or omitted, the substring starts at the beginning of STRING. -If FROM or TO is negative, it counts from the end. - -With one argument, just copy STRING without its properties." - (setq string (substring string (or from 0) to)) - (set-text-properties 0 (length string) nil string) - string)) - ;; `line-number-at-pos' is available only in Emacs 22.1 or greater - ;; and XEmacs 21.5. - (line-number-at-pos - . ,(lambda (&optional pos) - "Return (narrowed) buffer line number at position POS. -If POS is nil, use current buffer location. -Counting starts at (point-min), so the value refers -to the contents of the accessible portion of the buffer." - (let ((opoint (or pos (point))) start) - (save-excursion - (goto-char (point-min)) - (setq start (point)) - (goto-char opoint) - (forward-line 0) - (1+ (count-lines start (point)))))))))) - -;; `special-display-p' is an Emacs function, not available in XEmacs. -(defalias 'mm-special-display-p - (if (featurep 'emacs) - 'special-display-p - (lambda (buffer-name) - "Returns non-nil if a buffer named BUFFER-NAME gets a special frame." - (and special-display-function - (or (and (member buffer-name special-display-buffer-names) t) - (cdr (assoc buffer-name special-display-buffer-names)) - (catch 'return - (dolist (elem special-display-regexps) - (and (stringp elem) - (string-match elem buffer-name) - (throw 'return t)) - (and (consp elem) - (stringp (car elem)) - (string-match (car elem) buffer-name) - (throw 'return (cdr elem)))))))))) - -;; `decode-coding-string', `encode-coding-string', `decode-coding-region' -;; and `encode-coding-region' are available in Emacs and XEmacs built with -;; the `file-coding' feature, but the XEmacs versions treat nil, that is -;; given as the `coding-system' argument, as the `binary' coding system. -(eval-and-compile - (if (featurep 'xemacs) - (if (featurep 'file-coding) - (progn - (defun mm-decode-coding-string (str coding-system) - (if coding-system - (decode-coding-string str coding-system) - str)) - (defun mm-encode-coding-string (str coding-system) - (if coding-system - (encode-coding-string str coding-system) - str)) - (defun mm-decode-coding-region (start end coding-system) - (if coding-system - (decode-coding-region start end coding-system))) - (defun mm-encode-coding-region (start end coding-system) - (if coding-system - (encode-coding-region start end coding-system)))) - (defun mm-decode-coding-string (str coding-system) str) - (defun mm-encode-coding-string (str coding-system) str) - (defalias 'mm-decode-coding-region 'ignore) - (defalias 'mm-encode-coding-region 'ignore)) - (defalias 'mm-decode-coding-string 'decode-coding-string) - (defalias 'mm-encode-coding-string 'encode-coding-string) - (defalias 'mm-decode-coding-region 'decode-coding-region) - (defalias 'mm-encode-coding-region 'encode-coding-region))) - -;; `string-to-multibyte' is available only in Emacs. -(defalias 'mm-string-to-multibyte (if (featurep 'xemacs) - 'identity - 'string-to-multibyte)) - -;; `char-or-char-int-p' is an XEmacs function, not available in Emacs. -(eval-and-compile - (defalias 'mm-char-or-char-int-p - (cond - ((fboundp 'char-or-char-int-p) 'char-or-char-int-p) - ((fboundp 'char-valid-p) 'char-valid-p) - (t 'identity)))) - -;; `ucs-to-char' is a function that Mule-UCS provides. -(eval-and-compile - (if (featurep 'xemacs) - (cond ((and (fboundp 'unicode-to-char) ;; XEmacs 21.5. - (subrp (symbol-function 'unicode-to-char))) - (if (featurep 'mule) - (defalias 'mm-ucs-to-char 'unicode-to-char) - (defun mm-ucs-to-char (codepoint) - "Convert Unicode codepoint to character." - (or (unicode-to-char codepoint) ?#)))) - ((featurep 'mule) - (defun mm-ucs-to-char (codepoint) - "Convert Unicode codepoint to character." - (if (fboundp 'ucs-to-char) ;; Mule-UCS is loaded. - (progn - (defalias 'mm-ucs-to-char - (lambda (codepoint) - "Convert Unicode codepoint to character." - (condition-case nil - (or (ucs-to-char codepoint) ?#) - (error ?#)))) - (mm-ucs-to-char codepoint)) - (condition-case nil - (or (int-to-char codepoint) ?#) - (error ?#))))) - (t - (defun mm-ucs-to-char (codepoint) - "Convert Unicode codepoint to character." - (condition-case nil - (or (int-to-char codepoint) ?#) - (error ?#))))) - (if (let ((char (make-char 'japanese-jisx0208 36 34))) - (eq char (decode-char 'ucs char))) - ;; Emacs 23. - (defalias 'mm-ucs-to-char 'identity) - (defun mm-ucs-to-char (codepoint) - "Convert Unicode codepoint to character." - (or (decode-char 'ucs codepoint) ?#))))) - -;; Fixme: This seems always to be used to read a MIME charset, so it -;; should be re-named and fixed (in Emacs) to offer completion only on -;; proper charset names (base coding systems which have a -;; mime-charset defined). XEmacs doesn't believe in mime-charset; -;; test with -;; `(or (coding-system-get 'iso-8859-1 'mime-charset) -;; (coding-system-get 'iso-8859-1 :mime-charset))' -;; Actually, there should be an `mm-coding-system-mime-charset'. -(eval-and-compile - (defalias 'mm-read-coding-system - (if (featurep 'emacs) 'read-coding-system - (cond - ((fboundp 'read-coding-system) - (if (and (featurep 'xemacs) - (<= (string-to-number emacs-version) 21.1)) - (lambda (prompt &optional default-coding-system) - (read-coding-system prompt)) - 'read-coding-system)) - (t (lambda (prompt &optional default-coding-system) - "Prompt the user for a coding system." - (gnus-completing-read - prompt (mapcar (lambda (s) (symbol-name (car s))) - mm-mime-mule-charset-alist)))))))) +(defvar mm-mime-mule-charset-alist) + +(defun mm-ucs-to-char (codepoint) + "Convert Unicode codepoint to character." + (or (decode-char 'ucs codepoint) ?#)) (defvar mm-coding-system-list nil) (defun mm-get-coding-system-list () "Get the coding system list." (or mm-coding-system-list - (setq mm-coding-system-list (mm-coding-system-list)))) + (setq mm-coding-system-list (coding-system-list)))) (defun mm-coding-system-p (cs) - "Return non-nil if CS is a symbol naming a coding system. -In XEmacs, also return non-nil if CS is a coding system object. -If CS is available, return CS itself in Emacs, and return a coding -system object in XEmacs." - (if (fboundp 'find-coding-system) - (and cs (find-coding-system cs)) - (if (fboundp 'coding-system-p) - (when (coding-system-p cs) - cs) - ;; no-MULE XEmacs: - (car (memq cs (mm-get-coding-system-list)))))) + "Return CS if CS is a coding system." + (and (coding-system-p cs) + cs)) (defvar mm-charset-synonym-alist `( @@ -343,170 +88,17 @@ system object in XEmacs." (mm-coding-system-p 'iso-8859-1)) '((iso_8859-1 . iso-8859-1))) ) - "A mapping from unknown or invalid charset names to the real charset names. - -See `mm-codepage-iso-8859-list' and `mm-codepage-ibm-list'.") - -(defun mm-codepage-setup (number &optional alias) - "Create a coding system cpNUMBER. -The coding system is created using `codepage-setup'. If ALIAS is -non-nil, an alias is created and added to -`mm-charset-synonym-alist'. If ALIAS is a string, it's used as -the alias. Else windows-NUMBER is used." - (interactive - (let ((completion-ignore-case t) - (candidates (if (fboundp 'cp-supported-codepages) - (cp-supported-codepages) - ;; Removed in Emacs 23 (unicode), so signal an error: - (error "`codepage-setup' not present in this Emacs version")))) - (list (gnus-completing-read "Setup DOS Codepage" candidates - t nil nil "437")))) - (when alias - (setq alias (if (stringp alias) - (intern alias) - (intern (format "windows-%s" number))))) - (let* ((cp (intern (format "cp%s" number)))) - (unless (mm-coding-system-p cp) - (if (fboundp 'codepage-setup) ; silence compiler - (codepage-setup number) - (error "`codepage-setup' not present in this Emacs version"))) - (when (and alias - ;; Don't add alias if setup of cp failed. - (mm-coding-system-p cp)) - (add-to-list 'mm-charset-synonym-alist (cons alias cp))))) - -(defcustom mm-codepage-iso-8859-list - (list 1250 ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft - ;; Outlook users in Czech republic. Use this to allow reading of - ;; their e-mails. - '(1252 . 1) ;; Windows-1252 is a superset of iso-8859-1 (West - ;; Europe). See also `gnus-article-dumbquotes-map'. - '(1254 . 9) ;; Windows-1254 is a superset of iso-8859-9 (Turkish). - '(1255 . 8));; Windows-1255 is a superset of iso-8859-8 (Hebrew). - "A list of Windows codepage numbers and iso-8859 charset numbers. - -If an element is a number corresponding to a supported windows -codepage, appropriate entries to `mm-charset-synonym-alist' are -added by `mm-setup-codepage-iso-8859'. An element may also be a -cons cell where the car is a codepage number and the cdr is the -corresponding number of an iso-8859 charset." - :type '(list (set :inline t - (const 1250 :tag "Central and East European") - (const (1252 . 1) :tag "West European") - (const (1254 . 9) :tag "Turkish") - (const (1255 . 8) :tag "Hebrew")) - (repeat :inline t - :tag "Other options" - (choice - (integer :tag "Windows codepage number") - (cons (integer :tag "Windows codepage number") - (integer :tag "iso-8859 charset number"))))) - :version "22.1" ;; Gnus 5.10.9 - :group 'mime) - -(defcustom mm-codepage-ibm-list - (list 437 ;; (US etc.) - 860 ;; (Portugal) - 861 ;; (Iceland) - 862 ;; (Israel) - 863 ;; (Canadian French) - 865 ;; (Nordic) - 852 ;; - 850 ;; (Latin 1) - 855 ;; (Cyrillic) - 866 ;; (Cyrillic - Russian) - 857 ;; (Turkish) - 864 ;; (Arabic) - 869 ;; (Greek) - 874);; (Thai) - ;; In Emacs 23 (unicode), cp... and ibm... are aliases. - ;; Cf. http://thread.gmane.org/v9lkng5nwy.fsf@marauder.physik.uni-ulm.de - "List of IBM codepage numbers. - -The codepage mappings slightly differ between IBM and other vendors. -See \"ftp://ftp.unicode.org/Public/MAPPINGS/VENDORS/IBM/README.TXT\". - -If an element is a number corresponding to a supported windows -codepage, appropriate entries to `mm-charset-synonym-alist' are -added by `mm-setup-codepage-ibm'." - :type '(list (set :inline t - (const 437 :tag "US etc.") - (const 860 :tag "Portugal") - (const 861 :tag "Iceland") - (const 862 :tag "Israel") - (const 863 :tag "Canadian French") - (const 865 :tag "Nordic") - (const 852) - (const 850 :tag "Latin 1") - (const 855 :tag "Cyrillic") - (const 866 :tag "Cyrillic - Russian") - (const 857 :tag "Turkish") - (const 864 :tag "Arabic") - (const 869 :tag "Greek") - (const 874 :tag "Thai")) - (repeat :inline t - :tag "Other options" - (integer :tag "Codepage number"))) - :version "22.1" ;; Gnus 5.10.9 - :group 'mime) - -(defun mm-setup-codepage-iso-8859 (&optional list) - "Add appropriate entries to `mm-charset-synonym-alist'. -Unless LIST is given, `mm-codepage-iso-8859-list' is used." - (unless list - (setq list mm-codepage-iso-8859-list)) - (dolist (i list) - (let (cp windows iso) - (if (consp i) - (setq cp (intern (format "cp%d" (car i))) - windows (intern (format "windows-%d" (car i))) - iso (intern (format "iso-8859-%d" (cdr i)))) - (setq cp (intern (format "cp%d" i)) - windows (intern (format "windows-%d" i)))) - (unless (mm-coding-system-p windows) - (if (mm-coding-system-p cp) - (add-to-list 'mm-charset-synonym-alist (cons windows cp)) - (add-to-list 'mm-charset-synonym-alist (cons windows iso))))))) - -(defun mm-setup-codepage-ibm (&optional list) - "Add appropriate entries to `mm-charset-synonym-alist'. -Unless LIST is given, `mm-codepage-ibm-list' is used." - (unless list - (setq list mm-codepage-ibm-list)) - (dolist (number list) - (let ((ibm (intern (format "ibm%d" number))) - (cp (intern (format "cp%d" number)))) - (when (and (not (mm-coding-system-p ibm)) - (mm-coding-system-p cp)) - (add-to-list 'mm-charset-synonym-alist (cons ibm cp)))))) - -;; Initialize: -(mm-setup-codepage-iso-8859) -(mm-setup-codepage-ibm) + "A mapping from unknown or invalid charset names to the real charset names.") ;; Note: this has to be defined before `mm-charset-to-coding-system'. -(defcustom mm-charset-eval-alist - (if (featurep 'xemacs) - nil ;; I don't know what would be useful for XEmacs. - '(;; Emacs 22 provides autoloads for 1250-1258 - ;; (i.e. `mm-codepage-setup' does nothing). - (windows-1250 . (mm-codepage-setup 1250 t)) - (windows-1251 . (mm-codepage-setup 1251 t)) - (windows-1253 . (mm-codepage-setup 1253 t)) - (windows-1257 . (mm-codepage-setup 1257 t)))) +(defcustom mm-charset-eval-alist nil "An alist of (CHARSET . FORM) pairs. If an article is encoded in an unknown CHARSET, FORM is evaluated. This allows the loading of additional libraries providing charsets on demand. If supported by your Emacs version, you could use `autoload-coding-system' here." :version "22.1" ;; Gnus 5.10.9 - :type '(list (set :inline t - (const (windows-1250 . (mm-codepage-setup 1250 t))) - (const (windows-1251 . (mm-codepage-setup 1251 t))) - (const (windows-1253 . (mm-codepage-setup 1253 t))) - (const (windows-1257 . (mm-codepage-setup 1257 t))) - (const (cp850 . (mm-codepage-setup 850 nil)))) - (repeat :inline t + :type '(list (repeat :inline t :tag "Other options" (cons (symbol :tag "charset") (symbol :tag "form")))) @@ -706,7 +298,7 @@ superset of iso-8859-1." ;; Fixme: some of the cars here aren't valid MIME charsets. That ;; should only matter with XEmacs, though. (defvar mm-mime-mule-charset-alist - `((us-ascii ascii) + '((us-ascii ascii) (iso-8859-1 latin-iso8859-1) (iso-8859-2 latin-iso8859-2) (iso-8859-3 latin-iso8859-3) @@ -756,56 +348,24 @@ superset of iso-8859-1." (iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208 japanese-jisx0213-1 japanese-jisx0213-2) (shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208) - ,(cond ((fboundp 'unicode-precedence-list) - (cons 'utf-8 (delq 'ascii (mapcar 'charset-name - (unicode-precedence-list))))) - ((or (not (fboundp 'charsetp)) ;; non-Mule case - (charsetp 'unicode-a) - (not (mm-coding-system-p 'mule-utf-8))) - '(utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e)) - (t ;; If we have utf-8 we're in Mule 5+. - (append '(utf-8) - (delete 'ascii - (coding-system-get 'mule-utf-8 'safe-charsets)))))) + (utf-8)) "Alist of MIME-charset/MULE-charsets.") -(defun mm-enrich-utf-8-by-mule-ucs () - "Make the `utf-8' MIME charset usable by the Mule-UCS package. -This function will run when the `un-define' module is loaded under -XEmacs, and fill the `utf-8' entry in `mm-mime-mule-charset-alist' -with Mule charsets. It is completely useless for Emacs." - (when (boundp 'unicode-basic-translation-charset-order-list) - (condition-case nil - (let ((val (delq - 'ascii - (copy-sequence - (symbol-value - 'unicode-basic-translation-charset-order-list)))) - (elem (assq 'utf-8 mm-mime-mule-charset-alist))) - (if elem - (setcdr elem val) - (setq mm-mime-mule-charset-alist - (nconc mm-mime-mule-charset-alist - (list (cons 'utf-8 val)))))) - (error)))) - ;; Correct by construction, but should be unnecessary for Emacs: -(if (featurep 'xemacs) - (eval-after-load "un-define" '(mm-enrich-utf-8-by-mule-ucs)) - (when (and (fboundp 'coding-system-list) - (fboundp 'sort-coding-systems)) - (let ((css (sort-coding-systems (coding-system-list 'base-only))) - cs mime mule alist) - (while css - (setq cs (pop css) - mime (or (coding-system-get cs :mime-charset); Emacs 23 (unicode) - (coding-system-get cs 'mime-charset))) - (when (and mime - (not (eq t (setq mule - (coding-system-get cs 'safe-charsets)))) - (not (assq mime alist))) - (push (cons mime (delq 'ascii mule)) alist))) - (setq mm-mime-mule-charset-alist (nreverse alist))))) +(when (and (fboundp 'coding-system-list) + (fboundp 'sort-coding-systems)) + (let ((css (sort-coding-systems (coding-system-list 'base-only))) + cs mime mule alist) + (while css + (setq cs (pop css) + mime (or (coding-system-get cs :mime-charset) ; Emacs 23 (unicode) + (coding-system-get cs 'mime-charset))) + (when (and mime + (not (eq t (setq mule + (coding-system-get cs 'safe-charsets)))) + (not (assq mime alist))) + (push (cons mime (delq 'ascii mule)) alist))) + (setq mm-mime-mule-charset-alist (nreverse alist)))) (defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2) "A list of special charsets. @@ -838,16 +398,11 @@ Valid elements include: "A table of the difference character between ISO-8859-X and ISO-8859-15.") (defcustom mm-coding-system-priorities - (let ((lang (if (boundp 'current-language-environment) - (symbol-value 'current-language-environment)))) - (cond (;; XEmacs without Mule but with `file-coding'. - (not lang) nil) - ;; In XEmacs 21.5 it may be the one like "Japanese (UTF-8)". - ((string-match "\\`Japanese" lang) - ;; Japanese users prefer iso-2022-jp to others usually used - ;; for `buffer-file-coding-system', however iso-8859-1 should - ;; be used when there are only ASCII and Latin-1 characters. - '(iso-8859-1 iso-2022-jp utf-8)))) + (and (string-match "\\`Japanese" current-language-environment) + ;; Japanese users prefer iso-2022-jp to others usually used + ;; for `buffer-file-coding-system', however iso-8859-1 should + ;; be used when there are only ASCII and Latin-1 characters. + '(iso-8859-1 iso-2022-jp utf-8)) "Preferred coding systems for encoding outgoing messages. More than one suitable coding system may be found for some text. @@ -859,14 +414,13 @@ variable is set, it overrides the default priority." :group 'mime) ;; ?? -(defvar mm-use-find-coding-systems-region - (fboundp 'find-coding-systems-region) +(defvar mm-use-find-coding-systems-region t "Use `find-coding-systems-region' to find proper coding systems. Setting it to nil is useful on Emacsen supporting Unicode if sending mail with multiple parts is preferred to sending a Unicode one.") -(defvar mm-extra-numeric-entities +(defcustom mm-extra-numeric-entities (mapcar (lambda (item) (cons (car item) (mm-ucs-to-char (cdr item)))) @@ -879,7 +433,9 @@ mail with multiple parts is preferred to sending a Unicode one.") (#x9C . #x0153) (#x9E . #x017E) (#x9F . #x0178))) "*Alist of extra numeric entities and characters other than ISO 10646. This table is used for decoding extra numeric entities to characters, -like \"€\" to the euro sign, mainly in html messages.") +like \"€\" to the euro sign, mainly in html messages." + :type '(alist :key-type character :value-type character) + :group 'mime) ;;; Internal variables: @@ -887,45 +443,26 @@ like \"€\" to the euro sign, mainly in html messages.") (defun mm-mule-charset-to-mime-charset (charset) "Return the MIME charset corresponding to the given Mule CHARSET." - (if (and (fboundp 'find-coding-systems-for-charsets) - (fboundp 'sort-coding-systems)) - (let ((css (sort (sort-coding-systems - (find-coding-systems-for-charsets (list charset))) - 'mm-sort-coding-systems-predicate)) - cs mime) - (while (and (not mime) - css) - (when (setq cs (pop css)) - (setq mime (or (coding-system-get cs :mime-charset) - (coding-system-get cs 'mime-charset))))) - mime) - (let ((alist (mapcar (lambda (cs) - (assq cs mm-mime-mule-charset-alist)) - (sort (mapcar 'car mm-mime-mule-charset-alist) - 'mm-sort-coding-systems-predicate))) - out) - (while alist - (when (memq charset (cdar alist)) - (setq out (caar alist) - alist nil)) - (pop alist)) - out))) - -(eval-and-compile - (if (featurep 'xemacs) - (defalias 'mm-enable-multibyte 'ignore) - (defun mm-enable-multibyte () - "Set the multibyte flag of the current buffer. + (let ((css (sort (sort-coding-systems + (find-coding-systems-for-charsets (list charset))) + 'mm-sort-coding-systems-predicate)) + cs mime) + (while (and (not mime) + css) + (when (setq cs (pop css)) + (setq mime (or (coding-system-get cs :mime-charset) + (coding-system-get cs 'mime-charset))))) + mime)) + +(defun mm-enable-multibyte () + "Set the multibyte flag of the current buffer. Only do this if the default value of `enable-multibyte-characters' is -non-nil. This is a no-op in XEmacs." - (set-buffer-multibyte 'to))) +non-nil." + (set-buffer-multibyte 'to)) - (if (featurep 'xemacs) - (defalias 'mm-disable-multibyte 'ignore) - (defun mm-disable-multibyte () - "Unset the multibyte flag of in the current buffer. -This is a no-op in XEmacs." - (set-buffer-multibyte nil)))) +(defun mm-disable-multibyte () + "Unset the multibyte flag of in the current buffer." + (set-buffer-multibyte nil)) (defun mm-preferred-coding-system (charset) ;; A typo in some Emacs versions. @@ -939,8 +476,7 @@ This is a no-op in XEmacs." mail-parse-mule-charset ;; cached mule-charset (progn (setq mail-parse-mule-charset - (and (boundp 'current-language-environment) - (car (last + (and (car (last (assq 'charset (assoc current-language-environment language-info-alist)))))) @@ -956,94 +492,53 @@ This is a no-op in XEmacs." (defun mm-charset-after (&optional pos) "Return charset of a character in current buffer at position POS. If POS is nil, it defaults to the current point. -If POS is out of range, the value is nil. -If the charset is `composition', return the actual one." +If POS is out of range, the value is nil." (let ((char (char-after pos)) charset) - (if (< (mm-char-int char) 128) + (if (< char 128) (setq charset 'ascii) - ;; charset-after is fake in some Emacsen. - (setq charset (and (fboundp 'char-charset) (char-charset char))) - (if (eq charset 'composition) ; Mule 4 - (let ((p (or pos (point)))) - (cadr (find-charset-region p (1+ p)))) - (if (and charset (not (memq charset '(ascii eight-bit-control - eight-bit-graphic)))) - charset - (mm-guess-charset)))))) + (setq charset (char-charset char)) + (if (and charset (not (memq charset '(ascii eight-bit-control + eight-bit-graphic)))) + charset + (mm-guess-charset))))) (defun mm-mime-charset (charset) "Return the MIME charset corresponding to the given Mule CHARSET." - (if (eq charset 'unknown) - (error "The message contains non-printable characters, please use attachment")) - (if (and (fboundp 'coding-system-get) (fboundp 'get-charset-property)) - (or - (and (mm-preferred-coding-system charset) - (or (coding-system-get - (mm-preferred-coding-system charset) :mime-charset) - (coding-system-get - (mm-preferred-coding-system charset) 'mime-charset))) - (and (eq charset 'ascii) - 'us-ascii) - (mm-preferred-coding-system charset) - (mm-mule-charset-to-mime-charset charset)) - ;; This is for XEmacs. - (mm-mule-charset-to-mime-charset charset))) - -;; `delete-dups' is not available in XEmacs 21.4. -(if (fboundp 'delete-dups) - (defalias 'mm-delete-duplicates 'delete-dups) - (defun mm-delete-duplicates (list) - "Destructively remove `equal' duplicates from LIST. -Store the result in LIST and return it. LIST must be a proper list. -Of several `equal' occurrences of an element in LIST, the first -one is kept. - -This is a compatibility function for Emacsen without `delete-dups'." - ;; Code from `subr.el' in Emacs 22: - (let ((tail list)) - (while tail - (setcdr tail (delete (car tail) (cdr tail))) - (setq tail (cdr tail)))) - list)) + (when (eq charset 'unknown) + (error "The message contains non-printable characters, please use attachment")) + (or + (and (mm-preferred-coding-system charset) + (coding-system-get (mm-preferred-coding-system charset) 'mime-charset)) + (and (eq charset 'ascii) + 'us-ascii) + (mm-preferred-coding-system charset) + (mm-mule-charset-to-mime-charset charset))) ;; Fixme: This is used in places when it should be testing the -;; default multibyteness. See mm-default-multibyte-p. -(eval-and-compile - (if (and (not (featurep 'xemacs)) - (boundp 'enable-multibyte-characters)) - (defun mm-multibyte-p () - "Non-nil if multibyte is enabled in the current buffer." - enable-multibyte-characters) - (defun mm-multibyte-p () (featurep 'mule)))) - -(defun mm-default-multibyte-p () - "Return non-nil if the session is multibyte. -This affects whether coding conversion should be attempted generally." - (if (featurep 'mule) - (if (boundp 'enable-multibyte-characters) - (default-value 'enable-multibyte-characters) - t))) +;; default multibyteness. +(defun mm-multibyte-p () + "Non-nil if multibyte is enabled in the current buffer." + enable-multibyte-characters) (defun mm-iso-8859-x-to-15-region (&optional b e) - (if (fboundp 'char-charset) - (let (charset item c inconvertible) - (save-restriction - (if e (narrow-to-region b e)) - (goto-char (point-min)) - (skip-chars-forward "\0-\177") - (while (not (eobp)) - (cond - ((not (setq item (assq (char-charset (setq c (char-after))) - mm-iso-8859-x-to-15-table))) - (forward-char)) - ((memq c (cdr (cdr item))) - (setq inconvertible t) - (forward-char)) - (t - (insert-before-markers (prog1 (+ c (car (cdr item))) - (delete-char 1))))) - (skip-chars-forward "\0-\177"))) - (not inconvertible)))) + (let (charset item c inconvertible) + (save-restriction + (if e (narrow-to-region b e)) + (goto-char (point-min)) + (skip-chars-forward "\0-\177") + (while (not (eobp)) + (cond + ((not (setq item (assq (char-charset (setq c (char-after))) + mm-iso-8859-x-to-15-table))) + (forward-char)) + ((memq c (cdr (cdr item))) + (setq inconvertible t) + (forward-char)) + (t + (insert-before-markers (prog1 (+ c (car (cdr item))) + (delete-char 1))))) + (skip-chars-forward "\0-\177"))) + (not inconvertible))) (defun mm-sort-coding-systems-predicate (a b) (let ((priorities @@ -1058,85 +553,6 @@ This affects whether coding conversion should be attempted generally." (length (memq (coding-system-base b) priorities))) t)))) -(declare-function latin-unity-massage-name "ext:latin-unity") -(declare-function latin-unity-maybe-remap "ext:latin-unity") -(declare-function latin-unity-representations-feasible-region "ext:latin-unity") -(declare-function latin-unity-representations-present-region "ext:latin-unity") - -(defvar latin-unity-coding-systems) -(defvar latin-unity-ucs-list) - -(defun mm-xemacs-find-mime-charset-1 (begin end) - "Determine which MIME charset to use to send region as message. -This uses the XEmacs-specific latin-unity package to better handle the -case where identical characters from diverse ISO-8859-? character sets -can be encoded using a single one of the corresponding coding systems. - -It treats `mm-coding-system-priorities' as the list of preferred -coding systems; a useful example setting for this list in Western -Europe would be (iso-8859-1 iso-8859-15 utf-8), which would default -to the very standard Latin 1 coding system, and only move to coding -systems that are less supported as is necessary to encode the -characters that exist in the buffer. - -Latin Unity doesn't know about those non-ASCII Roman characters that -are available in various East Asian character sets. As such, its -behavior if you have a JIS 0212 LATIN SMALL LETTER A WITH ACUTE in a -buffer and it can otherwise be encoded as Latin 1, won't be ideal. -But this is very much a corner case, so don't worry about it." - (let ((systems mm-coding-system-priorities) csets psets curset) - - ;; Load the Latin Unity library, if available. - (when (and (not (featurep 'latin-unity)) (locate-library "latin-unity")) - (require 'latin-unity)) - - ;; Now, can we use it? - (if (featurep 'latin-unity) - (progn - (setq csets (latin-unity-representations-feasible-region begin end) - psets (latin-unity-representations-present-region begin end)) - - (catch 'done - - ;; Pass back the first coding system in the preferred list - ;; that can encode the whole region. - (dolist (curset systems) - (setq curset (latin-unity-massage-name 'buffer-default curset)) - - ;; If the coding system is a universal coding system, then - ;; it can certainly encode all the characters in the region. - (if (memq curset latin-unity-ucs-list) - (throw 'done (list curset))) - - ;; If a coding system isn't universal, and isn't in - ;; the list that latin unity knows about, we can't - ;; decide whether to use it here. Leave that until later - ;; in `mm-find-mime-charset-region' function, whence we - ;; have been called. - (unless (memq curset latin-unity-coding-systems) - (throw 'done nil)) - - ;; Right, we know about this coding system, and it may - ;; conceivably be able to encode all the characters in - ;; the region. - (if (latin-unity-maybe-remap begin end curset csets psets t) - (throw 'done (list curset)))) - - ;; Can't encode using anything from the - ;; `mm-coding-system-priorities' list. - ;; Leave `mm-find-mime-charset' to do most of the work. - nil)) - - ;; Right, latin unity isn't available; let `mm-find-charset-region' - ;; take its default action, which equally applies to GNU Emacs. - nil))) - -(defmacro mm-xemacs-find-mime-charset (begin end) - (when (featurep 'xemacs) - `(and (featurep 'mule) (mm-xemacs-find-mime-charset-1 ,begin ,end)))) - -(declare-function mm-delete-duplicates "mm-util" (list)) - (defun mm-find-mime-charset-region (b e &optional hack-charsets) "Return the MIME charsets needed to encode the region between B and E. nil means ASCII, a single-element list represents an appropriate MIME @@ -1178,16 +594,9 @@ charset, and a longer list means no appropriate charset." (setq systems nil charsets (list cs)))))) charsets)) - ;; If we're XEmacs, and some coding system is appropriate, - ;; mm-xemacs-find-mime-charset will return an appropriate list. - ;; Otherwise, we'll get nil, and the next setq will get invoked. - (setq charsets (mm-xemacs-find-mime-charset b e)) - - ;; Fixme: won't work for unibyte Emacs 23: - ;; We're not multibyte, or a single coding system won't cover it. (setq charsets - (mm-delete-duplicates + (delete-dups (mapcar 'mm-mime-charset (delq 'ascii (mm-find-charset-region b e)))))) @@ -1200,17 +609,6 @@ charset, and a longer list means no appropriate charset." (if (and (memq 'iso-2022-jp-2 charsets) (memq 'iso-2022-jp-2 hack-charsets)) (setq charsets (delq 'iso-2022-jp charsets))) - ;; Attempt to reduce the number of charsets if utf-8 is available. - (if (and (featurep 'xemacs) - (> (length charsets) 1) - (mm-coding-system-p 'utf-8)) - (let ((mm-coding-system-priorities - (cons 'utf-8 mm-coding-system-priorities))) - (setq charsets - (mm-delete-duplicates - (mapcar 'mm-mime-charset - (delq 'ascii - (mm-find-charset-region b e))))))) charsets)) (defmacro mm-with-unibyte-buffer (&rest forms) @@ -1233,7 +631,6 @@ Use multibyte mode for this." (defmacro mm-with-unibyte-current-buffer (&rest forms) "Evaluate FORMS with current buffer temporarily made unibyte. -Equivalent to `progn' in XEmacs. Note: We recommend not using this macro any more; there should be better ways to do a similar thing. The previous version of this macro @@ -1241,31 +638,27 @@ bound the default value of `enable-multibyte-characters' to nil while evaluating FORMS but it is no longer done. So, some programs assuming it if any may malfunction." (declare (obsolete nil "25.1") (indent 0) (debug t)) - (if (featurep 'xemacs) - `(progn ,@forms) - (let ((multibyte (make-symbol "multibyte"))) - `(let ((,multibyte enable-multibyte-characters)) + (let ((multibyte (make-symbol "multibyte"))) + `(let ((,multibyte enable-multibyte-characters)) + (when ,multibyte + (set-buffer-multibyte nil)) + (prog1 + (progn ,@forms) (when ,multibyte - (set-buffer-multibyte nil)) - (prog1 - (progn ,@forms) - (when ,multibyte - (set-buffer-multibyte t))))))) + (set-buffer-multibyte t)))))) (defun mm-find-charset-region (b e) "Return a list of Emacs charsets in the region B to E." (cond - ((and (mm-multibyte-p) - (fboundp 'find-charset-region)) + ((mm-multibyte-p) ;; Remove composition since the base charsets have been included. ;; Remove eight-bit-*, treat them as ascii. (let ((css (find-charset-region b e))) - (dolist (cs - '(composition eight-bit-control eight-bit-graphic control-1) - css) - (setq css (delq cs css))))) + (dolist (cs '(composition eight-bit-control eight-bit-graphic control-1)) + (setq css (delq cs css))) + css)) (t - ;; We are in a unibyte buffer or XEmacs non-mule, so we futz around a bit. + ;; We are in a unibyte buffer, so we futz around a bit. (save-excursion (save-restriction (narrow-to-region b e) @@ -1274,11 +667,9 @@ it if any may malfunction." (if (eobp) '(ascii) (let (charset) - (setq charset - (and (boundp 'current-language-environment) - (car (last (assq 'charset - (assoc current-language-environment - language-info-alist)))))) + (setq charset (car (last (assq 'charset + (assoc current-language-environment + language-info-alist))))) (if (eq charset 'ascii) (setq charset nil)) (or charset (setq charset @@ -1305,9 +696,9 @@ it if any may malfunction." "Like `insert-file-contents', but only reads in the file. A buffer may be modified in several ways after reading into the buffer due to advanced Emacs features, such as file-name-handlers, format decoding, -`find-file-hooks', etc. +`find-file-hook', etc. If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'. - This function ensures that none of these modifications will take place." +This function ensures that none of these modifications will take place." (letf* ((format-alist nil) (auto-mode-alist (if inhibit nil (mm-auto-mode-alist))) ((default-value 'major-mode) 'fundamental-mode) @@ -1322,14 +713,8 @@ If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'. (append mm-inhibit-file-name-handlers inhibit-file-name-handlers) inhibit-file-name-handlers)) - (ffh (if (boundp 'find-file-hook) - 'find-file-hook - 'find-file-hooks)) - (val (symbol-value ffh))) - (set ffh nil) - (unwind-protect - (insert-file-contents filename visit beg end replace) - (set ffh val)))) + (find-file-hook nil)) + (insert-file-contents filename visit beg end replace))) (defun mm-append-to-file (start end filename &optional codesys inhibit) "Append the contents of the region to the end of file FILENAME. @@ -1371,70 +756,8 @@ If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." inhibit-file-name-handlers))) (write-region start end filename append visit lockname))) -(autoload 'gmm-write-region "gmm-utils") - -;; It is not a MIME function, but some MIME functions use it. -(if (and (fboundp 'make-temp-file) - (ignore-errors - (let ((def (if (fboundp 'compiled-function-arglist) ;; XEmacs - (eval (list 'compiled-function-arglist - (symbol-function 'make-temp-file))) - (require 'help-fns) - (help-function-arglist 'make-temp-file t)))) - (and (>= (length def) 4) - (eq (nth 3 def) 'suffix))))) - (defalias 'mm-make-temp-file 'make-temp-file) - ;; Stolen (and modified for XEmacs) from Emacs 22. - (defun mm-make-temp-file (prefix &optional dir-flag suffix) - "Create a temporary file. -The returned file name (created by appending some random characters at the end -of PREFIX, and expanding against `temporary-file-directory' if necessary), -is guaranteed to point to a newly created empty file. -You can then use `write-region' to write new data into the file. - -If DIR-FLAG is non-nil, create a new empty directory instead of a file. - -If SUFFIX is non-nil, add that at the end of the file name." - (let ((umask (default-file-modes)) - file) - (unwind-protect - (progn - ;; Create temp files with strict access rights. It's easy to - ;; loosen them later, whereas it's impossible to close the - ;; time-window of loose permissions otherwise. - (set-default-file-modes 448) - (while (condition-case err - (progn - (setq file - (make-temp-name - (expand-file-name - prefix - (if (fboundp 'temp-directory) - ;; XEmacs - (temp-directory) - temporary-file-directory)))) - (if suffix - (setq file (concat file suffix))) - (if dir-flag - (make-directory file) - ;; NOTE: This is unsafe if Emacs 20 - ;; users and XEmacs users don't use - ;; a secure temp directory. - (gmm-write-region "" nil file nil 'silent - nil 'excl)) - nil) - (file-already-exists t) - ;; The XEmacs version of `make-directory' issues - ;; `file-error'. - (file-error (or (and (featurep 'xemacs) - (file-exists-p file)) - (signal (car err) (cdr err))))) - ;; the file was somehow created by someone else between - ;; `make-temp-name' and `write-region', let's try again. - nil) - file) - ;; Reset the umask. - (set-default-file-modes umask))))) +(defalias 'mm-make-temp-file 'make-temp-file) +(define-obsolete-function-alias 'mm-make-temp-file 'make-temp-file "26.1") (defvar mm-image-load-path-cache nil) @@ -1455,54 +778,23 @@ If SUFFIX is non-nil, add that at the end of the file name." result))) ;; Fixme: This doesn't look useful where it's used. -(if (fboundp 'detect-coding-region) - (defun mm-detect-coding-region (start end) - "Like `detect-coding-region' except returning the best one." - (let ((coding-systems - (detect-coding-region start end))) - (or (car-safe coding-systems) - coding-systems))) - (defun mm-detect-coding-region (start end) - (let ((point (point))) - (goto-char start) - (skip-chars-forward "\0-\177" end) - (prog1 - (if (eq (point) end) 'ascii (mm-guess-charset)) - (goto-char point))))) +(defun mm-detect-coding-region (start end) + "Like `detect-coding-region' except returning the best one." + (let ((coding-systems (detect-coding-region start end))) + (or (car-safe coding-systems) + coding-systems))) (declare-function mm-detect-coding-region "mm-util" (start end)) -(if (fboundp 'coding-system-get) - (defun mm-detect-mime-charset-region (start end) - "Detect MIME charset of the text in the region between START and END." - (let ((cs (mm-detect-coding-region start end))) - (or (coding-system-get cs :mime-charset) - (coding-system-get cs 'mime-charset)))) - (defun mm-detect-mime-charset-region (start end) - "Detect MIME charset of the text in the region between START and END." - (let ((cs (mm-detect-coding-region start end))) - cs))) - -(eval-when-compile - (unless (fboundp 'coding-system-to-mime-charset) - (defalias 'coding-system-to-mime-charset 'ignore))) +(defun mm-detect-mime-charset-region (start end) + "Detect MIME charset of the text in the region between START and END." + (let ((cs (mm-detect-coding-region start end))) + (coding-system-get cs 'mime-charset))) (defun mm-coding-system-to-mime-charset (coding-system) - "Return the MIME charset corresponding to CODING-SYSTEM. -To make this function work with XEmacs, the APEL package is required." - (when coding-system - (or (and (fboundp 'coding-system-get) - (or (coding-system-get coding-system :mime-charset) - (coding-system-get coding-system 'mime-charset))) - (and (featurep 'xemacs) - (or (and (fboundp 'coding-system-to-mime-charset) - (not (eq (symbol-function 'coding-system-to-mime-charset) - 'ignore))) - (and (condition-case nil - (require 'mcharset) - (error nil)) - (fboundp 'coding-system-to-mime-charset))) - (coding-system-to-mime-charset coding-system))))) + "Return the MIME charset corresponding to CODING-SYSTEM." + (and coding-system + (coding-system-get coding-system 'mime-charset))) (defvar jka-compr-acceptable-retval-list) (declare-function jka-compr-make-temp-name "jka-compr" (&optional local)) @@ -1571,14 +863,6 @@ decompressed data. The buffer's multibyteness must be turned off." (message "%s" (or err-msg (concat msg "done"))) retval))))) -(eval-when-compile - (unless (fboundp 'coding-system-name) - (defalias 'coding-system-name 'ignore)) - (unless (fboundp 'find-file-coding-system-for-read-from-filename) - (defalias 'find-file-coding-system-for-read-from-filename 'ignore)) - (unless (fboundp 'find-operation-coding-system) - (defalias 'find-operation-coding-system 'ignore))) - (defun mm-find-buffer-file-coding-system (&optional filename) "Find coding system used to decode the contents of the current buffer. This function looks for the coding system magic cookie or examines the @@ -1601,66 +885,16 @@ gzip, bzip2, etc. are allowed." (setq filename (file-name-sans-extension filename))) (goto-char (point-min)) (unwind-protect - (cond - ((boundp 'set-auto-coding-function) ;; Emacs - (if filename - (or (funcall (symbol-value 'set-auto-coding-function) - filename (- (point-max) (point-min))) - (car (find-operation-coding-system 'insert-file-contents - filename))) - (let (auto-coding-alist) - (condition-case nil - (funcall (symbol-value 'set-auto-coding-function) - nil (- (point-max) (point-min))) - (error nil))))) - ((and (featurep 'xemacs) (featurep 'file-coding)) ;; XEmacs - (let ((case-fold-search t) - (end (point-at-eol)) - codesys start) - (or - (and (re-search-forward "-\\*-+[\t ]*" end t) - (progn - (setq start (match-end 0)) - (re-search-forward "[\t ]*-+\\*-" end t)) - (progn - (setq end (match-beginning 0)) - (goto-char start) - (or (looking-at "coding:[\t ]*\\([^\t ;]+\\)") - (re-search-forward - "[\t ;]+coding:[\t ]*\\([^\t ;]+\\)" - end t))) - (find-coding-system (setq codesys - (intern (match-string 1)))) - codesys) - (and (re-search-forward "^[\t ]*;+[\t ]*Local[\t ]+Variables:" - nil t) - (progn - (setq start (match-end 0)) - (re-search-forward "^[\t ]*;+[\t ]*End:" nil t)) - (progn - (setq end (match-beginning 0)) - (goto-char start) - (re-search-forward - "^[\t ]*;+[\t ]*coding:[\t ]*\\([^\t\n\r ]+\\)" - end t)) - (find-coding-system (setq codesys - (intern (match-string 1)))) - codesys) - (and (progn - (goto-char (point-min)) - (setq case-fold-search nil) - (re-search-forward "^;;;coding system: " - ;;(+ (point-min) 3000) t)) - nil t)) - (looking-at "[^\t\n\r ]+") - (find-coding-system - (setq codesys (intern (match-string 0)))) - codesys) - (and filename - (setq codesys - (find-file-coding-system-for-read-from-filename - filename)) - (coding-system-name (coding-system-base codesys))))))) + (if filename + (or (funcall (symbol-value 'set-auto-coding-function) + filename (- (point-max) (point-min))) + (car (find-operation-coding-system 'insert-file-contents + filename))) + (let (auto-coding-alist) + (condition-case nil + (funcall (symbol-value 'set-auto-coding-function) + nil (- (point-max) (point-min))) + (error nil)))) (when decomp (kill-buffer (current-buffer))))))) |