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

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

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

revision 1.57 by handa, Fri Mar 9 00:27:36 2001 UTC revision 1.57.12.1 by eliz, Fri Feb 22 10:45:22 2002 UTC
# Line 405  is treated as a character." Line 405  is treated as a character."
405  (define-coding-system-alias 'x-ctext 'compound-text)  (define-coding-system-alias 'x-ctext 'compound-text)
406  (define-coding-system-alias 'ctext 'compound-text)  (define-coding-system-alias 'ctext 'compound-text)
407    
408    ;; Same as compound-text, but doesn't produce composition escape
409    ;; sequences.  Used in post-read and pre-write conversions of
410    ;; ctext-with-extensions, below.
411    (make-coding-system
412     'ctext-no-compositions 2 ?x
413     "Compound text based generic encoding for decoding unknown messages.
414    
415    Like `compound-text', but does not produce escape sequences for compositions."
416     '((ascii t) (latin-iso8859-1 katakana-jisx0201 t) t t
417       nil ascii-eol ascii-cntl nil locking-shift single-shift nil nil nil
418       init-bol nil nil)
419     '((safe-charsets . t)
420       (mime-charset . x-ctext)))
421    
422    (defvar non-standard-icccm-encodings-alist
423      '(("ISO8859-15" . latin-iso8859-15)
424        ("ISO8859-14" . latin-iso8859-14)
425        ("KOI8-R" . koi8-r)
426        ("BIG5-0" . big5))
427      "Alist of font charset names defined by XLFD, and the corresponding Emacs
428    charsets or coding systems.")
429    
430    ;; Functions to support "Non-Standard Character Set Encodings" defined
431    ;; by the ICCCM spec.  We support that by converting the leading
432    ;; sequence of the ``extended segment'' to the corresponding ISO-2022
433    ;; sequences (if the leading sequence names an Emacs charset), or decode
434    ;; the segment (if it names a coding system).  Encoding does the reverse.
435    (defun ctext-post-read-conversion (len)
436      "Decode LEN characters encoded as Compound Text with Extended Segments."
437      (buffer-disable-undo) ; minimize consing due to insertions and deletions
438      (narrow-to-region (point) (+ (point) len))
439      (save-match-data
440        (let ((pt (point-marker))
441              (oldpt (point-marker))
442              (newpt (make-marker))
443              (modified-p (buffer-modified-p))
444              (case-fold-search nil)
445              last-coding-system-used
446              encoding textlen chset)
447          (while (re-search-forward
448                  "\\(\e\\)%/[0-4]\\([\200-\377][\200-\377]\\)\\([^\002]+\\)\002"
449                  nil 'move)
450            (set-marker newpt (point))
451            (set-marker pt (match-beginning 0))
452            (setq encoding (match-string 3))
453            (setq textlen (- (+ (* (- (aref (match-string 2) 0) 128) 128)
454                                (- (aref (match-string 2) 1) 128))
455                             (1+ (length encoding))))
456            (setq
457             chset (cdr (assoc-ignore-case encoding
458                                           non-standard-icccm-encodings-alist)))
459            (cond ((null chset)
460                   ;; This charset is not supported--leave this extended
461                   ;; segment unaltered and skip over it.
462                   (goto-char (+ (point) textlen)))
463                  ((charsetp chset)
464                 ;; If it's a charset, replace the leading escape sequence
465                 ;; with a standard ISO-2022 sequence.  We will decode all
466                  ;; such segments later, in one go, when we exit the loop
467                   ;; or find an extended segment that names a coding
468                   ;; system, not a charset.
469                   (replace-match
470                    (concat "\\1"
471                            (if (= 0 (charset-iso-graphic-plane chset))
472                                ;; GL charsets
473                                (if (= 1 (charset-dimension chset)) "(" "$(")
474                              ;; GR charsets
475                              (if (= 96 (charset-chars chset))
476                                  "-"
477                                (if (= 1 (charset-dimension chset)) ")" "$)")))
478                            (string (charset-iso-final-char chset)))
479                    t)
480                   (goto-char (+ (point) textlen)))
481                  ((coding-system-p chset)
482                 ;; If it's a coding system, we need to decode the segment
483                   ;; right away.  But first, decode what we've skipped
484                   ;; across until now.
485                   (when (> pt oldpt)
486                     (decode-coding-region oldpt pt 'ctext-no-compositions))
487                   (delete-region pt newpt)
488                   (set-marker newpt (+ newpt textlen))
489                   (decode-coding-region pt newpt chset)
490                   (goto-char newpt)
491                   (set-marker oldpt newpt))))
492          ;; Decode what's left.
493          (when (> (point) oldpt)
494            (decode-coding-region oldpt (point) 'ctext-no-compositions))
495         ;; This buffer started as unibyte, because the string we get from
496          ;; the X selection is a unibyte string.  We must now make it
497          ;; multibyte, so that the decoded text is inserted as multibyte
498          ;; into its buffer.
499          (set-buffer-multibyte t)
500          (set-buffer-modified-p modified-p)
501          (- (point-max) (point-min)))))
502    
503    (defvar non-standard-designations-alist
504      '(("$(0" . (big5 "big5-0" 2))
505        ("$(1" . (big5 "big5-0" 2))
506        ("-V"  . (t "iso8859-10" 1))
507        ("-Y"  . (t "iso8859-13" 1))
508        ("-_"  . (t "iso8859-14" 1))
509        ("-b"  . (t "iso8859-15" 1))
510        ("-f"  . (t "iso8859-16" 1)))
511      "Alist of ctext control sequences that introduce character sets which
512    are not in the list of approved ICCCM encodings, and the corresponding
513    coding system, identifier string, and number of octets per encoded
514    character.
515    
516    Each element has the form (CTLSEQ . (ENCODING CHARSET NOCTETS)).  CTLSEQ
517    is the control sequence (sans the leading ESC) that introduces the character
518    set in the text encoded by compound-text.  ENCODING is a coding system
519    symbol; if it is t, it means that the ctext coding system already encodes
520    the text correctly, and only the leading control sequence needs to be altered.
521    If ENCODING is a coding system, we need to re-encode the text with that
522    coding system.  CHARSET is the ICCCM name of the charset we need to put into
523    the leading control sequence.  NOCTETS is the number of octets (bytes) that
524    encode each character in this charset.  NOCTETS can be 0 (meaning the number
525    of octets per character is variable), 1, 2, 3, or 4.")
526    
527    (defun ctext-pre-write-conversion (from to)
528      "Encode characters between FROM and TO as Compound Text w/Extended Segments."
529      (buffer-disable-undo) ; minimize consing due to insertions and deletions
530      (narrow-to-region from to)
531      (encode-coding-region from to 'ctext-no-compositions)
532      ;; Replace ISO-2022 charset designations with extended segments, for
533      ;; those charsets that are not part of the official X registry.
534      (save-match-data
535        (goto-char (point-min))
536        (let ((newpt (make-marker))
537              (case-fold-search nil)
538              pt desig encode-info encoding chset noctets textlen)
539          (set-buffer-multibyte nil)
540          (while (re-search-forward "\e\\(\$([01]\\|-[VY_bf]\\)" nil 'move)
541            (setq desig (match-string 1)
542                  pt (point-marker)
543                  encode-info (cdr (assoc desig non-standard-designations-alist))
544                  encoding (car encode-info)
545                  chset (cadr encode-info)
546                  noctets (car (cddr encode-info)))
547            (skip-chars-forward "^\e")
548            (set-marker newpt (point))
549            (cond
550             ((eq encoding t)  ; only the leading sequence needs to be changed
551              (setq textlen (+ (- newpt pt) (length chset) 1))
552              (replace-match (format "\e%%/%d%c%c%s\
"
553                                     noctets
554                                     (+ (/ textlen 128) 128)
555                                     (+ (% textlen 128) 128)
556                                     chset)
557                             t t))
558             ((coding-system-p encoding) ; need to recode the entire segment...
559              (set-marker pt (match-beginning 0))
560              (decode-coding-region pt newpt 'ctext-no-compositions)
561              (set-buffer-multibyte t)
562              (encode-coding-region pt newpt encoding)
563              (set-buffer-multibyte nil)
564              (setq textlen (+ (- newpt pt) (length chset) 1))
565              (goto-char pt)
566              (insert (format "\e%%/%d%c%c%s\
"
567                              noctets
568                              (+ (/ textlen 128) 128)
569                              (+ (% textlen 128) 128)
570                              chset))))
571            (goto-char newpt))))
572      (set-buffer-multibyte t)
573      nil)
574    
575    (make-coding-system
576     'compound-text-with-extensions 5 ?x
577     "Compound text encoding with ICCCM Extended Segment extensions.
578    
579    This coding system should be used only for X selections.  It is inappropriate
580    for decoding and encoding files, process I/O, etc."
581     nil
582     '((post-read-conversion . ctext-post-read-conversion)
583       (pre-write-conversion . ctext-pre-write-conversion)))
584    
585    (define-coding-system-alias
586      'x-ctext-with-extensions 'compound-text-with-extensions)
587    (define-coding-system-alias
588      'ctext-with-extensions 'compound-text-with-extensions)
589    
590  (make-coding-system  (make-coding-system
591   'iso-safe 2 ?-   'iso-safe 2 ?-
592   "Convert all characters but ASCII to `?'."   "Convert all characters but ASCII to `?'."

Legend:
Removed from v.1.57  
changed lines
  Added in v.1.57.12.1

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