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: