diff options
| author | Dave Love | 2000-10-27 18:52:28 +0000 |
|---|---|---|
| committer | Dave Love | 2000-10-27 18:52:28 +0000 |
| commit | 052802c1f4cb243e359f87e41c86915a51835769 (patch) | |
| tree | c86b03bb860f7b02eb47417ab3e2abb47dd553d6 | |
| parent | d4dfaa1967011bd95d132bb5a153f899bfbbdcff (diff) | |
| download | emacs-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.el | 138 |
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. | ||
| 238 | Only 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. | ||
| 247 | Only 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." | |||
| 243 | If POS is nil, it defauls to the current point. | 259 | If POS is nil, it defauls to the current point. |
| 244 | If POS is out of range, the value is nil. | 260 | If POS is out of range, the value is nil. |
| 245 | If the charset is `composition', return the actual one." | 261 | If 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'. |
| 318 | See also `with-temp-file' and `with-output-to-string'." | 337 | See 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. | ||
| 384 | Mule4 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) |