/[emacs]/emacs/lisp/international/mule.el
ViewVC logotype

Diff of /emacs/lisp/international/mule.el

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

revision 1.141.2.26 by fx, Fri May 23 23:32:01 2003 UTC revision 1.141.2.27 by handa, Wed May 28 11:41:17 2003 UTC
# Line 527  to lower case. Line 527  to lower case.
527  `:mime-text-unsuitable'  `:mime-text-unsuitable'
528    
529  VALUE non-nil means the `:mime-charset' property names a charset which  VALUE non-nil means the `:mime-charset' property names a charset which
530  is unsuitable for the top-level media type "text".  is unsuitable for the top-level media type \"text\".
531    
532  `:flags'  `:flags'
533    
# Line 954  Now we have more convenient function `se Line 954  Now we have more convenient function `se
954    
955  ;;; X selections  ;;; X selections
956    
957  (defvar non-standard-icccm-encodings-alist  (defvar ctext-non-standard-encodings-alist
958    '(("ISO8859-15" . latin-iso8859-15)    '(("ISO8859-10" . iso-8859-10)
959      ("ISO8859-14" . latin-iso8859-14)      ("ISO8859-13" . iso-8859-13)
960        ("ISO8859-14" . iso-8859-14)
961        ("ISO8859-15" . iso-8859-15)
962        ("ISO8859-16" . iso-8859-16)
963      ("KOI8-R" . koi8-r)      ("KOI8-R" . koi8-r)
964      ("BIG5-0" . big5))      ("BIG5-0" . big5))
965    "Alist of font charset names defined by XLFD, and the corresponding Emacs    "Alist of non-standard encoding names vs Emacs coding systems.
966  charsets or coding systems.")  This alist is used to decode an extened segment of a compound text.")
   
 ;; Fixme: this needs sorting out  
967    
968  ;; Functions to support "Non-Standard Character Set Encodings" defined  ;; Functions to support "Non-Standard Character Set Encodings" defined
969  ;; by the ICCCM spec.  We support that by converting the leading  ;; by the COMPOUND TEXT spec.
970  ;; sequence of the ``extended segment'' to the corresponding ISO-2022  
971  ;; sequences (if the leading sequence names an Emacs charset), or decode  (defvar ctext-non-standard-encodings-regexp
972  ;; the segment (if it names a coding system).  Encoding does the reverse.    (string-to-multibyte
973       (concat
974        ;; For non-standard encodings.
975        "\\(\e%/[0-4][\200-\377][\200-\377]\\([^\002]+\\)\002\\)"
976        "\\|"
977        ;; For UTF-8 encoding.
978        "\\(\e%G[^\e]*\e%@\\)")))
979    
980  (defun ctext-post-read-conversion (len)  (defun ctext-post-read-conversion (len)
981    "Decode LEN characters encoded as Compound Text with Extended Segments."    "Decode LEN characters encoded as Compound Text with Extended Segments."
982    (buffer-disable-undo) ; minimize consing due to insertions and deletions    ;; We don't need the following because it is expected that this
983    (narrow-to-region (point) (+ (point) len))    ;; function is mainly used for decoding X selection which is not
984      ;; that big data.
985      ;;(buffer-disable-undo) ; minimize consing due to insertions and deletions
986    (save-match-data    (save-match-data
987      (let ((pt (point-marker))      (save-restriction
988            (oldpt (point-marker))        (narrow-to-region (point) (+ (point) len))
989            (newpt (make-marker))        (let ((case-fold-search nil)
990            (modified-p (buffer-modified-p))              last-coding-system-used
991            (case-fold-search nil)              pos bytes)
992            last-coding-system-used          (decode-coding-region (point-min) (point-max) 'ctext)
993            encoding textlen chset)          (while (re-search-forward ctext-non-standard-encodings-regexp
994        (while (re-search-forward                                    nil 'move)
995                "\\(\e\\)%/[0-4]\\([\200-\377][\200-\377]\\)\\([^\002]+\\)\002"            (setq pos (match-beginning 0))
996                nil 'move)            (if (match-beginning 1)
997          (set-marker newpt (point))                ;; ESC % / [0-4] M L --ENCODING-NAME-- \002 --BYTES--
998          (set-marker pt (match-beginning 0))                (let* ((M (char-after (+ pos 4)))
999          (setq encoding (match-string 3))                       (L (char-after (+ pos 5)))
1000          (setq textlen (- (+ (* (- (aref (match-string 2) 0) 128) 128)                       (encoding (match-string 2))
1001                              (- (aref (match-string 2) 1) 128))                       (coding (or (cdr (assoc-ignore-case
1002                           (1+ (length encoding))))                                         encoding
1003          (setq                                         ctext-non-standard-encodings-alist))
1004           chset (cdr (assoc-ignore-case encoding                                   (coding-system-p
1005                                         non-standard-icccm-encodings-alist)))                                    (intern (downcase encoding))))))
1006          (cond ((null chset)                  (if enable-multibyte-characters
1007                 ;; This charset is not supported--leave this extended                      (setq M (multibyte-char-to-unibyte M)
1008                 ;; segment unaltered and skip over it.                            L (multibyte-char-to-unibyte L)))
1009                 (goto-char (+ (point) textlen)))                  (setq bytes (- (+ (* (- M 128) 128) (- L 128))
1010                ((charsetp chset)                                 (- (point) (+ pos 6))))
1011               ;; If it's a charset, replace the leading escape sequence                  (when coding
1012               ;; with a standard ISO-2022 sequence.  We will decode all                    (delete-region pos (point))
1013                ;; such segments later, in one go, when we exit the loop                    (forward-char bytes)
1014                 ;; or find an extended segment that names a coding                    (decode-coding-region (- (point) bytes) (point) coding)))
1015                 ;; system, not a charset.              ;; ESC % G --UTF-8-BYTES-- ESC % @
1016                 (replace-match              (setq bytes (- (point) pos))
1017                  (concat "\\1"              (decode-coding-region (- (point) bytes) (point) 'utf-8))))
1018                          (if (= 0 (charset-iso-graphic-plane chset))        (goto-char (point-min))
1019                              ;; GL charsets        (- (point-max) (point)))))
                             (if (= 1 (charset-dimension chset)) "(" "$(")  
                           ;; GR charsets  
                           (if (= 96 (charset-chars chset))  
                               "-"  
                             (if (= 1 (charset-dimension chset)) ")" "$)")))  
                         (string (charset-iso-final-char chset)))  
                 t)  
                (goto-char (+ (point) textlen)))  
               ((coding-system-p chset)  
              ;; If it's a coding system, we need to decode the segment  
                ;; right away.  But first, decode what we've skipped  
                ;; across until now.  
                (when (> pt oldpt)  
                  (decode-coding-region oldpt pt 'ctext-no-compositions))  
                (delete-region pt newpt)  
                (set-marker newpt (+ newpt textlen))  
                (decode-coding-region pt newpt chset)  
                (goto-char newpt)  
                (set-marker oldpt newpt))))  
       ;; Decode what's left.  
       (when (> (point) oldpt)  
         (decode-coding-region oldpt (point) 'ctext-no-compositions))  
      ;; This buffer started as unibyte, because the string we get from  
       ;; the X selection is a unibyte string.  We must now make it  
       ;; multibyte, so that the decoded text is inserted as multibyte  
       ;; into its buffer.  
       (set-buffer-multibyte t)  
       (set-buffer-modified-p modified-p)  
       (- (point-max) (point-min)))))  
1020    
1021  (defvar non-standard-designations-alist  (defvar ctext-non-standard-designations-alist
1022    '(("$(0" . (big5 "big5-0" 2))    '(("$(0" . (big5 "big5-0" 2))
1023      ("$(1" . (big5 "big5-0" 2))      ("$(1" . (big5 "big5-0" 2))
1024      ("-V"  . (t "iso8859-10" 1))      ("-V"  . (t "iso8859-10" 1))
# Line 1045  charsets or coding systems.") Line 1026  charsets or coding systems.")
1026      ("-_"  . (t "iso8859-14" 1))      ("-_"  . (t "iso8859-14" 1))
1027      ("-b"  . (t "iso8859-15" 1))      ("-b"  . (t "iso8859-15" 1))
1028      ("-f"  . (t "iso8859-16" 1)))      ("-f"  . (t "iso8859-16" 1)))
1029    "Alist of ctext control sequences that introduce character sets which    "Alist of ctext control sequences that introduce character sets
1030  are not in the list of approved ICCCM encodings, and the corresponding  which are not in the list of approved COMPOUND TEXT encodings, and the
1031  coding system, identifier string, and number of octets per encoded  corresponding coding system, identifier string, and number of octets
1032  character.  per encoded character.
1033    
1034  Each element has the form (CTLSEQ . (ENCODING CHARSET NOCTETS)).  CTLSEQ  Each element has the form (CTLSEQ . (ENCODING CHARSET NOCTETS)).  CTLSEQ
1035  is the control sequence (sans the leading ESC) that introduces the character  is the control sequence (sans the leading ESC) that introduces the character
# Line 1067  of octets per character is variable), 1, Line 1048  of octets per character is variable), 1,
1048  If FROM is a string, or if the current buffer is not the one set up for us  If FROM is a string, or if the current buffer is not the one set up for us
1049  by run_pre_post_conversion_on_str, generate a new temp buffer, insert the  by run_pre_post_conversion_on_str, generate a new temp buffer, insert the
1050  text, and convert it in the temporary buffer.  Otherwise, convert in-place."  text, and convert it in the temporary buffer.  Otherwise, convert in-place."
   (cond ((and (string= (buffer-name) " *code-converting-work*")  
               (not (stringp from)))  
          ; Minimize consing due to subsequent insertions and deletions.  
          (buffer-disable-undo)  
          (narrow-to-region from to))  
         (t  
          (let ((buf (current-buffer)))  
            (set-buffer (generate-new-buffer " *temp"))  
            (buffer-disable-undo)  
            (if (stringp from)  
                (insert from)  
              (insert-buffer-substring buf from to)))))  
   (encode-coding-region from to 'ctext-no-compositions)  
   ;; Replace ISO-2022 charset designations with extended segments, for  
   ;; those charsets that are not part of the official X registry.  
1051    (save-match-data    (save-match-data
1052      (goto-char (point-min))      (save-restriction
1053      (let ((newpt (make-marker))        (narrow-to-region from to)
1054            (case-fold-search nil)        (goto-char from)
1055            pt desig encode-info encoding chset noctets textlen)        (encode-coding-region from to 'ctext-no-compositions)
1056        (set-buffer-multibyte nil)        (set-buffer-multibyte nil)
1057        ;; The regexp below finds the leading sequences for big5 and        ;; Replace ISO-2022 charset designations with extended segments,
1058        ;; iso8859-1[03-6] charsets.        ;; for those charsets that are not part of the official X
1059        (while (re-search-forward "\e\\(\$([01]\\|-[VY_bf]\\)" nil 'move)        ;; registry.
1060          (setq desig (match-string 1)        (let ((case-fold-search nil)
1061                pt (point-marker)              pos posend desig encode-info encoding chset noctets textlen)
1062                encode-info (cdr (assoc desig non-standard-designations-alist))          ;; The regexp below finds the leading sequences for big5 and
1063                encoding (car encode-info)          ;; iso8859-1[03-6] charsets.
1064                chset (cadr encode-info)          (while (re-search-forward "\e\\(\$([01]\\|-[VY_bf]\\)" nil 'move)
1065                noctets (car (cddr encode-info)))            (setq pos (match-beginning 0)
1066          (skip-chars-forward "^\e")                  posend (point)
1067          (set-marker newpt (point))                  desig (match-string 1)
1068          (cond                  encode-info (cdr (assoc desig
1069           ((eq encoding t)  ; only the leading sequence needs to be changed                                          ctext-non-standard-designations-alist))
1070            (setq textlen (+ (- newpt pt) (length chset) 1))                  encoding (car encode-info)
1071            ;; Generate the ICCCM control sequence for an extended segment.                  chset (cadr encode-info)
1072            (replace-match (format "\e%%/%d%c%c%s\
"
                 noctets (car (cddr encode-info)))
1073                                   noctets            (skip-chars-forward "^\e")
1074                                   (+ (/ textlen 128) 128)            (cond
1075                                   (+ (% textlen 128) 128)             ((eq encoding t) ; only the leading sequence needs to be changed
1076                                   chset)              (setq textlen (+ (- (point) posend) (length chset) 1))
1077                           t t))              ;; Generate the ICCCM control sequence for an extended segment.
1078           ((coding-system-p encoding) ; need to recode the entire segment...              (replace-match (format "\e%%/%d%c%c%s\
"
1079            (set-marker pt (match-beginning 0))                                     noctets
1080            (decode-coding-region pt newpt 'ctext-no-compositions)                                     (+ (/ textlen 128) 128)
1081            (set-buffer-multibyte t)                                     (+ (% textlen 128) 128)
1082            (encode-coding-region pt newpt encoding)                                     chset)
1083            (set-buffer-multibyte nil)                             t t))
1084            (setq textlen (+ (- newpt pt) (length chset) 1))             ((coding-system-p encoding) ; need to recode the entire segment...
1085            (goto-char pt)              (decode-coding-region pos (point) 'ctext-no-compositions)
1086            (insert (format "\e%%/%d%c%c%s\
"
             (encode-coding-region pos (point) encoding)
1087                            noctets              (setq textlen (+ (- (point) pos) (length chset) 1))
1088                            (+ (/ textlen 128) 128)              (save-excursion
1089                            (+ (% textlen 128) 128)                (goto-char pos)
1090                            chset))))                (insert (format "\e%%/%d%c%c%s\
"
1091          (goto-char newpt))))                                noctets
1092    (set-buffer-multibyte t)                                (+ (/ textlen 128) 128)
1093    ;; Must return nil, as build_annotations_2 expects that.                                (+ (% textlen 128) 128)
1094    nil)                                chset)))))))
1095          (goto-char (point-min)))))
1096    
1097  (make-obsolete 'set-coding-priority 'set-coding-system-priority "22.1")  (make-obsolete 'set-coding-priority 'set-coding-system-priority "22.1")
1098    

Legend:
Removed from v.1.141.2.26  
changed lines
  Added in v.1.141.2.27

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