Mercurial > emacs
comparison lisp/international/mule-util.el @ 89483:2f877ed80fa6
*** empty log message ***
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Mon, 08 Sep 2003 12:53:41 +0000 |
parents | 375f2633d815 438e610d8d06 |
children | e8de75a86fbc |
comparison
equal
deleted
inserted
replaced
88123:375f2633d815 | 89483:2f877ed80fa6 |
---|---|
1 ;;; mule-util.el --- utility functions for mulitilingual environment (mule) | 1 ;;; mule-util.el --- utility functions for mulitilingual environment (mule) |
2 | 2 |
3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. | 3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. |
4 ;; Licensed to the Free Software Foundation. | 4 ;; Licensed to the Free Software Foundation. |
5 ;; Copyright (C) 2002 Free Software Foundation, Inc. | |
6 ;; Copyright (C) 2003 | |
7 ;; National Institute of Advanced Industrial Science and Technology (AIST) | |
8 ;; Registration Number H13PRO009 | |
9 | |
5 | 10 |
6 ;; Keywords: mule, multilingual | 11 ;; Keywords: mule, multilingual |
7 | 12 |
8 ;; This file is part of GNU Emacs. | 13 ;; This file is part of GNU Emacs. |
9 | 14 |
294 ;; Coding system related functions. | 299 ;; Coding system related functions. |
295 | 300 |
296 ;;;###autoload | 301 ;;;###autoload |
297 (defun coding-system-post-read-conversion (coding-system) | 302 (defun coding-system-post-read-conversion (coding-system) |
298 "Return the value of CODING-SYSTEM's `post-read-conversion' property." | 303 "Return the value of CODING-SYSTEM's `post-read-conversion' property." |
299 (coding-system-get coding-system 'post-read-conversion)) | 304 (coding-system-get coding-system :post-read-conversion)) |
300 | 305 |
301 ;;;###autoload | 306 ;;;###autoload |
302 (defun coding-system-pre-write-conversion (coding-system) | 307 (defun coding-system-pre-write-conversion (coding-system) |
303 "Return the value of CODING-SYSTEM's `pre-write-conversion' property." | 308 "Return the value of CODING-SYSTEM's `pre-write-conversion' property." |
304 (coding-system-get coding-system 'pre-write-conversion)) | 309 (coding-system-get coding-system :pre-write-conversion)) |
305 | 310 |
306 ;;;###autoload | 311 ;;;###autoload |
307 (defun coding-system-translation-table-for-decode (coding-system) | 312 (defun coding-system-translation-table-for-decode (coding-system) |
308 "Return the value of CODING-SYSTEM's `translation-table-for-decode' property." | 313 "Return the value of CODING-SYSTEM's `decode-translation-table' property." |
309 (coding-system-get coding-system 'translation-table-for-decode)) | 314 (coding-system-get coding-system :decode-translation-table)) |
310 | 315 |
311 ;;;###autoload | 316 ;;;###autoload |
312 (defun coding-system-translation-table-for-encode (coding-system) | 317 (defun coding-system-translation-table-for-encode (coding-system) |
313 "Return the value of CODING-SYSTEM's `translation-table-for-encode' property." | 318 "Return the value of CODING-SYSTEM's `encode-translation-table' property." |
314 (coding-system-get coding-system 'translation-table-for-encode)) | 319 (coding-system-get coding-system :encode-translation-table)) |
315 | 320 |
316 ;;;###autoload | 321 ;;;###autoload |
317 (defun coding-system-equal (coding-system-1 coding-system-2) | 322 (defun coding-system-equal (coding-system-1 coding-system-2) |
318 "Return t if and only if CODING-SYSTEM-1 and CODING-SYSTEM-2 are identical. | 323 "Return t if and only if CODING-SYSTEM-1 and CODING-SYSTEM-2 are identical. |
319 Two coding systems are identical if two symbols are equal | 324 Two coding systems are identical if two symbols are equal |
320 or one is an alias of the other." | 325 or one is an alias of the other." |
321 (or (eq coding-system-1 coding-system-2) | 326 (or (eq coding-system-1 coding-system-2) |
322 (and (equal (coding-system-spec coding-system-1) | 327 (and (equal (coding-system-plist coding-system-1) |
323 (coding-system-spec coding-system-2)) | 328 (coding-system-plist coding-system-2)) |
324 (let ((eol-type-1 (coding-system-eol-type coding-system-1)) | 329 (let ((eol-type-1 (coding-system-eol-type coding-system-1)) |
325 (eol-type-2 (coding-system-eol-type coding-system-2))) | 330 (eol-type-2 (coding-system-eol-type coding-system-2))) |
326 (or (eq eol-type-1 eol-type-2) | 331 (or (eq eol-type-1 eol-type-2) |
327 (and (vectorp eol-type-1) (vectorp eol-type-2))))))) | 332 (and (vectorp eol-type-1) (vectorp eol-type-2))))))) |
328 | 333 |
329 ;;;###autoload | 334 ;;;###autoload |
335 (defmacro with-coding-priority (coding-systems &rest body) | |
336 "Execute BODY like `progn' with CODING-SYSTEMS at the front of priority list. | |
337 CODING-SYSTEMS is a list of coding systems. See | |
338 `set-coding-priority'. This affects the implicit sorting of lists of | |
339 coding sysems returned by operations such as `find-coding-systems-region'." | |
340 (let ((current (make-symbol "current"))) | |
341 `(let ((,current (coding-system-priority-list))) | |
342 (apply #'set-coding-system-priority ,coding-systems) | |
343 (unwind-protect | |
344 (progn ,@body) | |
345 (apply #'set-coding-system-priority ,current))))) | |
346 (put 'with-coding-priority 'lisp-indent-function 1) | |
347 (put 'with-coding-priority 'edebug-form-spec t) | |
348 | |
349 ;;;###autoload | |
330 (defmacro detect-coding-with-priority (from to priority-list) | 350 (defmacro detect-coding-with-priority (from to priority-list) |
331 "Detect a coding system of the text between FROM and TO with PRIORITY-LIST. | 351 "Detect a coding system of the text between FROM and TO with PRIORITY-LIST. |
332 PRIORITY-LIST is an alist of coding categories vs the corresponding | 352 PRIORITY-LIST is an alist of coding categories vs the corresponding |
333 coding systems ordered by priority." | 353 coding systems ordered by priority." |
334 `(unwind-protect | 354 `(with-coding-priority (mapcar #'cdr ,priority-list) |
335 (let* ((prio-list ,priority-list) | 355 (detect-coding-region ,from ,to))) |
336 (coding-category-list coding-category-list) | 356 (make-obsolete 'detect-coding-with-priority |
337 ,@(mapcar (function (lambda (x) (list x x))) | 357 "Use with-coding-priority and detect-coding-region" "22.1") |
338 coding-category-list)) | |
339 (mapc (function (lambda (x) (set (car x) (cdr x)))) | |
340 prio-list) | |
341 (set-coding-priority (mapcar #'car prio-list)) | |
342 (detect-coding-region ,from ,to)) | |
343 ;; We must restore the internal database. | |
344 (set-coding-priority coding-category-list) | |
345 (update-coding-systems-internal))) | |
346 | 358 |
347 ;;;###autoload | 359 ;;;###autoload |
348 (defun detect-coding-with-language-environment (from to lang-env) | 360 (defun detect-coding-with-language-environment (from to lang-env) |
349 "Detect a coding system of the text between FROM and TO with LANG-ENV. | 361 "Detect a coding system of the text between FROM and TO with LANG-ENV. |
350 The detection takes into account the coding system priorities for the | 362 The detection takes into account the coding system priorities for the |
351 language environment LANG-ENV." | 363 language environment LANG-ENV." |
352 (let ((coding-priority (get-language-info lang-env 'coding-priority))) | 364 (let ((coding-priority (get-language-info lang-env 'coding-priority))) |
353 (if coding-priority | 365 (if coding-priority |
354 (detect-coding-with-priority | 366 (with-coding-priority coding-priority |
355 from to | 367 (detect-coding-region from to))))) |
356 (mapcar (function (lambda (x) | |
357 (cons (coding-system-get x 'coding-category) x))) | |
358 coding-priority)) | |
359 (detect-coding-region from to)))) | |
360 | 368 |
361 | 369 |
362 (provide 'mule-util) | 370 (provide 'mule-util) |
363 | 371 |
364 ;; Local Variables: | 372 ;; Local Variables: |