/[emacs]/emacs/lisp/international/utf-8.el
ViewVC logotype

Diff of /emacs/lisp/international/utf-8.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1.2.7 by fx, Sun Oct 28 16:26:01 2001 UTC revision 1.1.2.8 by fx, Tue Nov 20 16:57:58 2001 UTC
# Line 26  Line 26 
26    
27  ;;; Commentary:  ;;; Commentary:
28    
29  ;; The coding-system `mule-utf-8' supports encoding/decoding of the  ;; The coding-system `mule-utf-8' basically supports encoding/decoding
30  ;; following character sets to and from UTF-8:  ;; of the following character sets to and from UTF-8:
31  ;;  ;;
32  ;;   ascii  ;;   ascii
33  ;;   eight-bit-control  ;;   eight-bit-control
# Line 36  Line 36 
36  ;;   mule-unicode-2500-33ff  ;;   mule-unicode-2500-33ff
37  ;;   mule-unicode-e000-ffff  ;;   mule-unicode-e000-ffff
38  ;;  ;;
 ;; Characters of other character sets cannot be encoded with  
 ;; mule-utf-8.  Note that the mule-unicode charsets currently lack  
 ;; case and syntax information, so things like `downcase' will only  
 ;; work for characters from ASCII and Latin-1.  
 ;;  
39  ;; On decoding, Unicode characters that do not fit into the above  ;; On decoding, Unicode characters that do not fit into the above
40  ;; character sets are handled as `eight-bit-control' or  ;; character sets are handled as `eight-bit-control' or
41  ;; `eight-bit-graphic' characters to retain the information about the  ;; `eight-bit-graphic' characters to retain the information about the
42  ;; original byte sequence.  ;; original byte sequence.
43    ;;
44    ;; Characters from other character sets can be encoded with
45    ;; mule-utf-8 by populating the table `ucs-mule-to-mule-unicode' and
46    ;; registering the translation with `register-char-codings'.
47    
48  ;; UTF-8 is defined in RFC 2279.  A sketch of the encoding is:  ;; UTF-8 is defined in RFC 2279.  A sketch of the encoding is:
49    
# Line 57  Line 56 
56    
57  ;;; Code:  ;;; Code:
58    
59    (defvar ucs-mule-to-mule-unicode (make-translation-table)
60      "Translation table for encoding to `mule-utf-8'.")
61    ;; Could have been done by ucs-tables loaded before.
62    (unless (get 'ucs-mule-to-mule-unicode 'translation-table)
63      (define-translation-table 'ucs-mule-to-mule-unicode ucs-mule-to-mule-unicode))
64  (define-ccl-program ccl-decode-mule-utf-8  (define-ccl-program ccl-decode-mule-utf-8
65    ;;    ;;
66    ;;        charset         | bytes in utf-8 | bytes in emacs    ;;        charset         | bytes in utf-8 | bytes in emacs
# Line 230  characters.") Line 234  characters.")
234        (if (r5 < 0)        (if (r5 < 0)
235            ((r1 = -1)            ((r1 = -1)
236             (read-multibyte-character r0 r1)             (read-multibyte-character r0 r1)
237             (translate-character ucs-mule-8859-to-mule-unicode r0 r1))             (translate-character ucs-mule-to-mule-unicode r0 r1))
238          (;; We have already done read-multibyte-character.          (;; We have already done read-multibyte-character.
239           (r0 = r5)           (r0 = r5)
240           (r1 = r6)           (r1 = r6)
# Line 344  Others are encoded as U+FFFD.") Line 348  Others are encoded as U+FFFD.")
348    
349  ;; Dummy definition so that the CCL can be checked correctly; the  ;; Dummy definition so that the CCL can be checked correctly; the
350  ;; actual data are loaded on demand.  ;; actual data are loaded on demand.
351  (define-translation-table 'ucs-mule-8859-to-mule-unicode)  (unless (boundp 'ucs-mule-8859-to-mule-unicode) ; don't zap it
352      (define-translation-table 'ucs-mule-8859-to-mule-unicode))
353    
354  (defsubst utf-8-untranslated-to-ucs ()  (defsubst utf-8-untranslated-to-ucs ()
355    (let ((b1 (char-after))    (let ((b1 (char-after))
# Line 395  Return the sequence's length." Line 400  Return the sequence's length."
400        (compose-region (point) (+ l (point)) subst)        (compose-region (point) (+ l (point)) subst)
401        l)))        l)))
402    
403    (defcustom utf-8-compose-scripts nil
404      "*Non-nil means compose various scipts on decoding utf-8 text."
405      :group 'mule
406      :type 'boolean)
407    
408    (autoload 'lao-post-read-conversion "lao-util") ; omitted in Emacs 21.1
409    
410  (defun utf-8-post-read-conversion (length)  (defun utf-8-post-read-conversion (length)
411    "Compose untranslated utf-8 sequences into single characters."    "Compose untranslated utf-8 sequences into single characters.
412    Also compose particular scripts if `utf-8-compose-scripts' is non-nil."
413    (save-excursion    (save-excursion
414      (while (and (skip-chars-forward      (while (and (skip-chars-forward
415                   (eval-and-compile      ; missing optimization                   (eval-and-compile      ; missing optimization
416                     (string-as-multibyte "^\341-\377")))                     (string-as-multibyte "^\341-\377")))
417                  (not (eobp)))                  (not (eobp)))
418        (forward-char (utf-8-compose))))        (forward-char (utf-8-compose))))
419      (when (and utf-8-compose-scripts (> length 1))
420        ;; These currently have definitions which cover the relevant
421        ;; Unicodes.  We could avoid loading thai-util &c by checking
422        ;; whether the region contains any characters with the appropriate
423        ;; categories.
424        (save-excursion (diacritic-post-read-conversion length))
425        (save-excursion (thai-post-read-conversion length))
426        (save-excursion (lao-post-read-conversion length)))
427    length)    length)
428    
429    ;;; (defun utf-8-pre-write-conversion (beg end)
430    ;;;   (require 'ucs-tables)               ; ensure translation table is loaded
431    ;;;   (let ((oldbuff (current-buffer)))
432    ;;;     (set-buffer (generate-new-buffer " *temp*"))
433    ;;;     (if (stringp beg)
434    ;;;     (insert beg)
435    ;;;       (insert-buffer-substring beg end oldbuff))
436    ;;;     ;; Look for 8-bit-graphic characters that haven't been marked as
437    ;;;     ;; untranslated, and UTF-8-encode them.
438    ;;;     (goto-char (point-min))
439    ;;;     (while (and (skip-chars-forward (eval-and-compile
440    ;;;                                   (string-as-multibyte "^\240-\377")))
441    ;;;             (not (eobp)))
442    ;;;       (if (get-text-property (point) 'untranslated-utf-8)
443    ;;;       (forward-char)
444    ;;;     (let ((c (char-after)))
445    ;;;       (delete-char 1)
446    ;;;       (insert (make-char 'latin-iso8859-1 (- c 128)))))))
447    ;;;   nil)
448    
449  (defun utf-8-pre-write-conversion (beg end)  (defun utf-8-pre-write-conversion (beg end)
450    (require 'ucs-tables)           ; ensure translation table is loaded    "Semi-dummy pre-write function effectively to autoload ucs-tables."
451    (when (stringp beg)    ;; Ensure translation table is loaded.
452      (set-buffer (generate-new-buffer " *temp*"))    (require 'ucs-tables)
453      (insert beg)    ;; Don't do this again.
454      (setq end (1+ (length beg)))    (coding-system-put 'mule-utf-8 'pre-write-conversion nil)
     (setq beg 1))  
   ;; Look for 8-bit-graphic characters that haven't been marked as  
   ;; untranslated, and UTF-8-encode them.  
   (save-excursion  
     (save-restriction  
       (narrow-to-region beg end)  
       (goto-char beg)  
       (while (and (skip-chars-forward (eval-and-compile  
                                         (string-as-multibyte "^\240-\377")))  
                   (not (eobp)))  
         (if (get-text-property (point) 'untranslated-utf-8)  
             (forward-char)  
           (let ((c (char-after)))  
             (delete-char 1)  
             (insert (make-char 'latin-iso8859-1 (- c 128))))))))  
455    nil)    nil)
456    
457  (make-coding-system  (make-coding-system
458   'mule-utf-8 4 ?u   'mule-utf-8 4 ?u
459   "UTF-8 encoding for Emacs-supported Unicode characters.   "UTF-8 encoding for Emacs-supported Unicode characters.
460  The supported Emacs character sets are the following, determined by the  The supported Emacs character sets are the following, plus others
461  translation table `ucs-mule-8859-to-mule-unicode':  which may be included in the translation table
462     ascii  `ucs-mule-8859-to-mule-unicode':
463     eight-bit-control   ascii
464     eight-bit-graphic   eight-bit-control
465     latin-iso8859-1   eight-bit-graphic
466     latin-iso8859-2   latin-iso8859-1
467     latin-iso8859-3   latin-iso8859-2
468     latin-iso8859-4   latin-iso8859-3
469     cyrillic-iso8859-5   latin-iso8859-4
470     greek-iso8859-7   cyrillic-iso8859-5
471     hebrew-iso8859-8   greek-iso8859-7
472     latin-iso8859-9   hebrew-iso8859-8
473     latin-iso8859-14   latin-iso8859-9
474     latin-iso8859-15   latin-iso8859-14
475     mule-unicode-0100-24ff   latin-iso8859-15
476     mule-unicode-2500-33ff   mule-unicode-0100-24ff
477     mule-unicode-e000-ffff   mule-unicode-2500-33ff
478     mule-unicode-e000-ffff
479    
480  Unicode characters out of the ranges U+0000-U+33FF and U+E200-U+FFFF  Unicode characters out of the ranges U+0000-U+33FF and U+E200-U+FFFF
481  are decoded into sequences of eight-bit-control and eight-bit-graphic  are decoded into sequences of eight-bit-control and eight-bit-graphic
482  characters to preserve their byte sequences and composed to behave as  characters to preserve their byte sequences and composed to display as
483  a single character when editing.  Emacs characters out of these ranges  a single character.  Emacs characters that can't be encoded to these
484  are encoded into U+FFFD."  ranges are encoded as U+FFFD."
485    
486   '(ccl-decode-mule-utf-8 . ccl-encode-mule-utf-8)   '(ccl-decode-mule-utf-8 . ccl-encode-mule-utf-8)
487   '((safe-charsets   '((safe-charsets
# Line 477  are encoded into U+FFFD." Line 504  are encoded into U+FFFD."
504     (mime-charset . utf-8)     (mime-charset . utf-8)
505     (coding-category . coding-category-utf-8)     (coding-category . coding-category-utf-8)
506     (valid-codes (0 . 255))     (valid-codes (0 . 255))
507     (post-read-conversion . utf-8-post-read-conversion)     (pre-write-conversion . utf-8-pre-write-conversion)
508     (pre-write-conversion . utf-8-pre-write-conversion)))     (post-read-conversion . utf-8-post-read-conversion)))
509    
510  (define-coding-system-alias 'utf-8 'mule-utf-8)  (define-coding-system-alias 'utf-8 'mule-utf-8)
511    
512  ;; I think this needs special private charsets defined for the  ;; I think this needs special private charsets defined for the
513  ;; untranslated sequences, if it's going to work well.  ;; untranslated sequences, if it's going to work well.
514    
515  ;; (defun utf-8-compose-function (pos to pattern &optional string)  ;;; (defun utf-8-compose-function (pos to pattern &optional string)
516  ;;   (let* ((prop (get-char-property pos 'composition string))  ;;;   (let* ((prop (get-char-property pos 'composition string))
517  ;;       (l (and prop (- (cadr prop) (car prop)))))  ;;;      (l (and prop (- (cadr prop) (car prop)))))
518  ;;     (cond ((and l (> l (- to pos)))  ;;;     (cond ((and l (> l (- to pos)))
519  ;;         (delete-region pos to))  ;;;        (delete-region pos to))
520  ;;        ((and (> (char-after pos) 224)  ;;;       ((and (> (char-after pos) 224)
521  ;;              (< (char-after pos) 256)  ;;;             (< (char-after pos) 256)
522  ;;              (save-restriction  ;;;             (save-restriction
523  ;;                (narrow-to-region pos to)  ;;;               (narrow-to-region pos to)
524  ;;                (utf-8-compose)))  ;;;               (utf-8-compose)))
525  ;;         t))))  ;;;        t))))
526    
527  ;; (dotimes (i 96)  ;;; (dotimes (i 96)
528  ;;   (aset composition-function-table  ;;;   (aset composition-function-table
529  ;;      (+ 128 i)  ;;;     (+ 128 i)
530  ;;      `((,(string-as-multibyte "[\200-\237\240-\377]")  ;;;     `((,(string-as-multibyte "[\200-\237\240-\377]")
531  ;;         . utf-8-compose-function))))  ;;;        . utf-8-compose-function))))
532    
533  ;;; utf-8.el ends here  ;;; utf-8.el ends here

Legend:
Removed from v.1.1.2.7  
changed lines
  Added in v.1.1.2.8

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26