;;; mm-util.el --- Utility functions for Mule and low level things
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(coding-system-equal . equal)
(annotationp . ignore)
(set-buffer-file-coding-system . ignore)
- (make-char
- . (lambda (charset int)
- (int-to-char int)))
(read-charset
. (lambda (prompt)
"Return a charset."
mm-mime-mule-charset-alist)
nil t))))
(subst-char-in-string
- . (lambda (from to string) ;; stolen (and renamed) from nnheader.el
- "Replace characters in STRING from FROM to TO."
- (let ((string (substring string 0)) ;Copy 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.
((fboundp 'char-valid-p) 'char-valid-p)
(t 'identity))))
+;; 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
(cond
(or mm-coding-system-list
(setq mm-coding-system-list (mm-coding-system-list))))
-(defun mm-coding-system-p (sym)
- "Return non-nil if SYM is a coding system."
- (if (fboundp 'coding-system-p)
- (coding-system-p sym)
- (memq sym (mm-get-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 (fboundp 'find-coding-system)
+ (find-coding-system cs)
+ (if (fboundp 'coding-system-p)
+ (coding-system-p cs)
+ ;; Is this branch ever actually useful?
+ (memq cs (mm-get-coding-system-list)))))
(defvar mm-charset-synonym-alist
`(
- ;; Perfectly fine? A valid MIME name, anyhow.
- ,@(unless (mm-coding-system-p 'big5)
- '((big5 . cn-big5)))
;; Not in XEmacs, but it's not a proper MIME charset anyhow.
,@(unless (mm-coding-system-p 'x-ctext)
'((x-ctext . ctext)))
- ;; Apparently not defined in Emacs 20, but is a valid MIME name.
- ,@(unless (mm-coding-system-p 'gb2312)
- '((gb2312 . cn-gb-2312)))
;; ISO-8859-15 is very similar to ISO-8859-1. But it's _different_!
,@(unless (mm-coding-system-p 'iso-8859-15)
'((iso-8859-15 . iso-8859-1)))
+ ;; BIG-5HKSCS is similar to, but different than, BIG-5.
+ ,@(unless (mm-coding-system-p 'big5-hkscs)
+ '((big5-hkscs . big5)))
;; Windows-1252 is actually a superset of Latin-1. See also
;; `gnus-article-dumbquotes-map'.
,@(unless (mm-coding-system-p 'windows-1252)
,@(if (and (not (mm-coding-system-p 'windows-1250))
(mm-coding-system-p 'cp1250))
'((windows-1250 . cp1250)))
+ ;; A Microsoft misunderstanding.
+ ,@(unless (mm-coding-system-p 'ks_c_5601-1987)
+ (if (mm-coding-system-p 'cp949)
+ '((ks_c_5601-1987 . cp949))
+ '((ks_c_5601-1987 . euc-kr))))
)
"A mapping from invalid charset names to the real charset names.")
;; Japanese users may prefer iso-2022-jp to shift-jis.
'(iso-2022-jp iso-2022-jp-2 japanese-shift-jis
iso-latin-1 utf-8)))))
- "Preferred coding systems for encoding outgoing mails.
+ "Preferred coding systems for encoding outgoing messages.
-More than one suitable coding system may be found for some text. By
-default, the coding system with the highest priority is used to encode
-outgoing mails (see `sort-coding-systems'). If this variable is set,
-it overrides the default priority."
+More than one suitable coding system may be found for some text.
+By default, the coding system with the highest priority is used
+to encode outgoing messages (see `sort-coding-systems'). If this
+variable is set, it overrides the default priority."
:type '(repeat (symbol :tag "Coding system"))
:group 'mime)
(setq cs c)))
cs))))
-(defsubst mm-replace-chars-in-string (string from to)
- (mm-subst-char-in-string from to string))
-
(eval-and-compile
(defvar mm-emacs-mule (and (not (featurep 'xemacs))
(boundp 'default-enable-multibyte-characters)
"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 t))
+ (set-buffer-multibyte 'to))
(defalias 'mm-enable-multibyte 'ignore))
(if mm-emacs-mule
(setq result (cons head result)))
(nreverse result)))
+;; 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))
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 'default-enable-multibyte-characters)
+ default-enable-multibyte-characters
+ t)))
+
(defun mm-iso-8859-x-to-15-region (&optional b e)
(if (fboundp 'char-charset)
(let (charset item c inconvertible)
;; `compound-text' is not in the IANA list. We
;; shouldn't normally use anything here with a
;; mime-charset having an `x-' prefix.
- ;; Fixme: allow this to be overridden, since
+ ;; Fixme: Allow this to be overridden, since
;; there is existing use of x-ctext.
;; Also people apparently need the coding system
- ;; `iso-2022-jp-3', which Mule-UCS defines.
+ ;; `iso-2022-jp-3' (which Mule-UCS defines with
+ ;; mime-charset, though it's not valid).
(if (and cs
- (not (string-match "^[Xx]-" (symbol-name cs))))
+ (not (string-match "^[Xx]-" (symbol-name cs)))
+ ;; UTF-16 of any variety is invalid for
+ ;; text parts and, unfortunately, has
+ ;; mime-charset defined both in Mule-UCS
+ ;; and versions of Emacs. (The name
+ ;; might be `mule-utf-16...' or
+ ;; `utf-16...'.)
+ (not (string-match "utf-16" (symbol-name cs))))
(setq systems nil
charsets (list cs))))))
charsets))
- ;; Otherwise we're not multibyte, we're XEmacs or a single
+ ;; Otherwise we're not multibyte, we're XEmacs, or a single
;; coding system won't cover it.
(setq charsets
(mm-delete-duplicates
(put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body))
(defmacro mm-with-unibyte (&rest forms)
- "Eval the FORMS with the default value of `enable-multibyte-characters' nil, ."
+ "Eval the FORMS with the default value of `enable-multibyte-characters' nil."
`(let (default-enable-multibyte-characters)
,@forms))
(put 'mm-with-unibyte 'lisp-indent-function 0)
(put 'mm-with-unibyte 'edebug-form-spec '(body))
+(defmacro mm-with-multibyte (&rest forms)
+ "Eval the FORMS with the default value of `enable-multibyte-characters' t."
+ `(let ((default-enable-multibyte-characters t))
+ ,@forms))
+(put 'mm-with-multibyte 'lisp-indent-function 0)
+(put 'mm-with-multibyte 'edebug-form-spec '(body))
+
(defun mm-find-charset-region (b e)
"Return a list of Emacs charsets in the region B to E."
(cond
mm-mime-mule-charset-alist)))))
(list 'ascii (or charset 'latin-iso8859-1)))))))))
-(if (fboundp 'shell-quote-argument)
- (defalias 'mm-quote-arg 'shell-quote-argument)
- (defun mm-quote-arg (arg)
- "Return a version of ARG that is safe to evaluate in a shell."
- (let ((pos 0) new-pos accum)
- ;; *** bug: we don't handle newline characters properly
- (while (setq new-pos (string-match "[]*[;!'`\"$\\& \t{} |()<>]" arg pos))
- (push (substring arg pos new-pos) accum)
- (push "\\" accum)
- (push (list (aref arg new-pos)) accum)
- (setq pos (1+ new-pos)))
- (if (= pos 0)
- arg
- (apply 'concat (nconc (nreverse accum) (list (substring arg pos))))))))
-
(defun mm-auto-mode-alist ()
"Return an `auto-mode-alist' with only the .gz (etc) thingies."
(let ((alist auto-mode-alist)
(defun mm-insert-file-contents (filename &optional visit beg end replace
inhibit)
- "Like `insert-file-contents', q.v., but only reads in the file.
+ "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-hooks', etc.
If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'.
This function ensures that none of these modifications will take place."
(let ((format-alist nil)
(append mm-inhibit-file-name-handlers
inhibit-file-name-handlers)
inhibit-file-name-handlers)))
- (append-to-file start end filename)))
+ (write-region start end filename t 'no-message)
+ (message "Appended to %s" filename)))
(defun mm-write-region (start end filename &optional append visit lockname
coding-system inhibit)
(defun mm-image-load-path (&optional package)
(let (dir result)
(dolist (path load-path (nreverse result))
- (if (file-directory-p
- (setq dir (concat (file-name-directory
- (directory-file-name path))
- "etc/" (or package "gnus/"))))
- (push dir result))
+ (when (and path
+ (file-directory-p
+ (setq dir (concat (file-name-directory
+ (directory-file-name path))
+ "etc/" (or package "gnus/")))))
+ (push dir result))
(push path result))))
;; Fixme: This doesn't look useful where it's used.