aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDave Love2000-10-27 18:52:28 +0000
committerDave Love2000-10-27 18:52:28 +0000
commit052802c1f4cb243e359f87e41c86915a51835769 (patch)
treec86b03bb860f7b02eb47417ab3e2abb47dd553d6
parentd4dfaa1967011bd95d132bb5a153f899bfbbdcff (diff)
downloademacs-052802c1f4cb243e359f87e41c86915a51835769.tar.gz
emacs-052802c1f4cb243e359f87e41c86915a51835769.zip
2000-10-27 ShengHuo ZHU <zsh@cs.rochester.edu>
* mm-util.el (mm-multibyte-p): Test (featurep 'xemacs). (mm-with-unibyte-current-buffer-mule4): New function. (mm-enable-multibyte-mule4): New. (mm-disable-multibyte-mule4): New. * mm-util.el (mm-enable-multibyte-mule4): New. (mm-disable-multibyte-mule4): New.
-rw-r--r--lisp/gnus/mm-util.el138
1 files changed, 87 insertions, 51 deletions
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index bb4ae3716c4..0b98a85da02 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -3,6 +3,7 @@
3 3
4;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 4;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5;; MORIOKA Tomohiko <morioka@jaist.ac.jp> 5;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
6;; Maintainer: bugs@gnus.org
6;; This file is part of GNU Emacs. 7;; This file is part of GNU Emacs.
7 8
8;; GNU Emacs is free software; you can redistribute it and/or modify 9;; GNU Emacs is free software; you can redistribute it and/or modify
@@ -24,6 +25,7 @@
24 25
25;;; Code: 26;;; Code:
26 27
28(eval-when-compile (require 'cl))
27(require 'mail-prsvr) 29(require 'mail-prsvr)
28 30
29(defvar mm-mime-mule-charset-alist 31(defvar mm-mime-mule-charset-alist
@@ -41,8 +43,6 @@
41 (iso-8859-7 greek-iso8859-7) 43 (iso-8859-7 greek-iso8859-7)
42 (iso-8859-8 hebrew-iso8859-8) 44 (iso-8859-8 hebrew-iso8859-8)
43 (iso-8859-9 latin-iso8859-9) 45 (iso-8859-9 latin-iso8859-9)
44 (iso-8859-14 latin-iso8859-14)
45 (iso-8859-15 latin-iso8859-15)
46 (viscii vietnamese-viscii-lower) 46 (viscii vietnamese-viscii-lower)
47 (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978) 47 (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978)
48 (euc-kr korean-ksc5601) 48 (euc-kr korean-ksc5601)
@@ -233,6 +233,22 @@ used as the line break code type of the coding system."
233 (when (fboundp 'set-buffer-multibyte) 233 (when (fboundp 'set-buffer-multibyte)
234 (set-buffer-multibyte nil))) 234 (set-buffer-multibyte nil)))
235 235
236(defsubst mm-enable-multibyte-mule4 ()
237 "Enable multibyte in the current buffer.
238Only used in Emacs Mule 4."
239 (when (and (fboundp 'set-buffer-multibyte)
240 (boundp 'enable-multibyte-characters)
241 (default-value 'enable-multibyte-characters)
242 (not (charsetp 'eight-bit-control)))
243 (set-buffer-multibyte t)))
244
245(defsubst mm-disable-multibyte-mule4 ()
246 "Disable multibyte in the current buffer.
247Only used in Emacs Mule 4."
248 (when (and (fboundp 'set-buffer-multibyte)
249 (not (charsetp 'eight-bit-control)))
250 (set-buffer-multibyte nil)))
251
236(defun mm-preferred-coding-system (charset) 252(defun mm-preferred-coding-system (charset)
237 ;; A typo in some Emacs versions. 253 ;; A typo in some Emacs versions.
238 (or (get-charset-property charset 'prefered-coding-system) 254 (or (get-charset-property charset 'prefered-coding-system)
@@ -243,35 +259,37 @@ used as the line break code type of the coding system."
243If POS is nil, it defauls to the current point. 259If POS is nil, it defauls to the current point.
244If POS is out of range, the value is nil. 260If POS is out of range, the value is nil.
245If the charset is `composition', return the actual one." 261If the charset is `composition', return the actual one."
246 (let ((charset (cond 262 (let ((char (char-after pos)) charset)
247 ((fboundp 'charset-after) 263 (if (< (mm-char-int char) 128)
248 (charset-after pos)) 264 (setq charset 'ascii)
249 ((fboundp 'char-charset) 265 ;; charset-after is fake in some Emacsen.
250 (char-charset (char-after pos))) 266 (setq charset (and (fboundp 'char-charset) (char-charset char)))
251 ((< (mm-char-int (char-after pos)) 128) 267 (if (eq charset 'composition)
252 'ascii) 268 (let ((p (or pos (point))))
253 (mail-parse-mule-charset ;; cached mule-charset 269 (cadr (find-charset-region p (1+ p))))
254 mail-parse-mule-charset) 270 (if (and charset (not (memq charset '(ascii eight-bit-control
255 ((boundp 'current-language-environment) 271 eight-bit-graphic))))
256 (let ((entry (assoc current-language-environment 272 charset
257 language-info-alist))) 273 (or
258 (setq mail-parse-mule-charset 274 mail-parse-mule-charset ;; cached mule-charset
259 (or (car (last (assq 'charset entry))) 275 (progn
260 'latin-iso8859-1)))) 276 (setq mail-parse-mule-charset
261 (t ;; figure out the charset 277 (and (boundp 'current-language-environment)
262 (setq mail-parse-mule-charset 278 (car (last
263 (or (car (last (assq mail-parse-charset 279 (assq 'charset
264 mm-mime-mule-charset-alist))) 280 (assoc current-language-environment
265 'latin-iso8859-1)))))) 281 language-info-alist))))))
266 (if (eq charset 'composition) 282 (if (or (not mail-parse-mule-charset)
267 (let ((p (or pos (point)))) 283 (eq mail-parse-mule-charset 'ascii))
268 (cadr (find-charset-region p (1+ p)))) 284 (setq mail-parse-mule-charset
269 charset))) 285 (or (car (last (assq mail-parse-charset
286 mm-mime-mule-charset-alist)))
287 'latin-iso8859-1)))
288 mail-parse-mule-charset)))))))
270 289
271(defun mm-mime-charset (charset) 290(defun mm-mime-charset (charset)
272 "Return the MIME charset corresponding to the MULE CHARSET." 291 "Return the MIME charset corresponding to the MULE CHARSET."
273 (if (and (fboundp 'coding-system-get) 292 (if (and (fboundp 'coding-system-get) (fboundp 'get-charset-property))
274 (fboundp 'get-charset-property))
275 ;; This exists in Emacs 20. 293 ;; This exists in Emacs 20.
276 (or 294 (or
277 (and (mm-preferred-coding-system charset) 295 (and (mm-preferred-coding-system charset)
@@ -309,16 +327,17 @@ If the charset is `composition', return the actual one."
309 327
310(defsubst mm-multibyte-p () 328(defsubst mm-multibyte-p ()
311 "Say whether multibyte is enabled." 329 "Say whether multibyte is enabled."
312 (or (featurep 'xemacs) 330 (if (and (not (featurep 'xemacs))
313 (and (boundp 'enable-multibyte-characters) 331 (boundp 'enable-multibyte-characters))
314 enable-multibyte-characters))) 332 enable-multibyte-characters
333 (featurep 'mule)))
315 334
316(defmacro mm-with-unibyte-buffer (&rest forms) 335(defmacro mm-with-unibyte-buffer (&rest forms)
317 "Create a temporary buffer, and evaluate FORMS there like `progn'. 336 "Create a temporary buffer, and evaluate FORMS there like `progn'.
318See also `with-temp-file' and `with-output-to-string'." 337See also `with-temp-file' and `with-output-to-string'."
319 (let ((temp-buffer (make-symbol "temp-buffer")) 338 (let ((temp-buffer (make-symbol "temp-buffer"))
320 (multibyte (make-symbol "multibyte"))) 339 (multibyte (make-symbol "multibyte")))
321 `(if (or (string-match "XEmacs\\|Lucid" emacs-version) 340 `(if (or (featurep 'xemacs)
322 (not (boundp 'enable-multibyte-characters))) 341 (not (boundp 'enable-multibyte-characters)))
323 (with-temp-buffer ,@forms) 342 (with-temp-buffer ,@forms)
324 (let ((,multibyte (default-value 'enable-multibyte-characters)) 343 (let ((,multibyte (default-value 'enable-multibyte-characters))
@@ -360,6 +379,28 @@ See also `with-temp-file' and `with-output-to-string'."
360(put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0) 379(put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0)
361(put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body)) 380(put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body))
362 381
382(defmacro mm-with-unibyte-current-buffer-mule4 (&rest forms)
383 "Evaluate FORMS there like `progn' in current buffer.
384Mule4 only."
385 (let ((multibyte (make-symbol "multibyte")))
386 `(if (or (featurep 'xemacs)
387 (not (fboundp 'set-buffer-multibyte))
388 (charsetp 'eight-bit-control)) ;; For Emacs Mule 4 only.
389 (progn
390 ,@forms)
391 (let ((,multibyte (default-value 'enable-multibyte-characters)))
392 (unwind-protect
393 (let ((buffer-file-coding-system mm-binary-coding-system)
394 (coding-system-for-read mm-binary-coding-system)
395 (coding-system-for-write mm-binary-coding-system))
396 (set-buffer-multibyte nil)
397 (setq-default enable-multibyte-characters nil)
398 ,@forms)
399 (setq-default enable-multibyte-characters ,multibyte)
400 (set-buffer-multibyte ,multibyte))))))
401(put 'mm-with-unibyte-current-buffer-mule4 'lisp-indent-function 0)
402(put 'mm-with-unibyte-current-buffer-mule4 'edebug-form-spec '(body))
403
363(defmacro mm-with-unibyte (&rest forms) 404(defmacro mm-with-unibyte (&rest forms)
364 "Set default `enable-multibyte-characters' to `nil', eval the FORMS." 405 "Set default `enable-multibyte-characters' to `nil', eval the FORMS."
365 (let ((multibyte (make-symbol "multibyte"))) 406 (let ((multibyte (make-symbol "multibyte")))
@@ -382,7 +423,8 @@ See also `with-temp-file' and `with-output-to-string'."
382 (fboundp 'find-charset-region)) 423 (fboundp 'find-charset-region))
383 ;; Remove composition since the base charsets have been included. 424 ;; Remove composition since the base charsets have been included.
384 (delq 'composition (find-charset-region b e))) 425 (delq 'composition (find-charset-region b e)))
385 ((not (boundp 'current-language-environment)) 426 (t
427 ;; We are in a unibyte buffer or XEmacs non-mule, so we futz around a bit.
386 (save-excursion 428 (save-excursion
387 (save-restriction 429 (save-restriction
388 (narrow-to-region b e) 430 (narrow-to-region b e)
@@ -390,24 +432,18 @@ See also `with-temp-file' and `with-output-to-string'."
390 (skip-chars-forward "\0-\177") 432 (skip-chars-forward "\0-\177")
391 (if (eobp) 433 (if (eobp)
392 '(ascii) 434 '(ascii)
393 (delq nil (list 'ascii 435 (let (charset)
394 (or (car (last (assq mail-parse-charset 436 (setq charset
395 mm-mime-mule-charset-alist))) 437 (and (boundp 'current-language-environment)
396 'latin-iso8859-1))))))) 438 (car (last (assq 'charset
397 (t 439 (assoc current-language-environment
398 ;; We are in a unibyte buffer, so we futz around a bit. 440 language-info-alist))))))
399 (save-excursion 441 (if (eq charset 'ascii) (setq charset nil))
400 (save-restriction 442 (or charset
401 (narrow-to-region b e) 443 (setq charset
402 (goto-char (point-min)) 444 (car (last (assq mail-parse-charset
403 (let ((entry (assoc current-language-environment 445 mm-mime-mule-charset-alist)))))
404 language-info-alist))) 446 (list 'ascii (or charset 'latin-iso8859-1)))))))))
405 (skip-chars-forward "\0-\177")
406 (if (eobp)
407 '(ascii)
408 (delq nil (list 'ascii
409 (or (car (last (assq 'charset entry)))
410 'latin-iso8859-1))))))))))
411 447
412(if (fboundp 'shell-quote-argument) 448(if (fboundp 'shell-quote-argument)
413 (defalias 'mm-quote-arg 'shell-quote-argument) 449 (defalias 'mm-quote-arg 'shell-quote-argument)