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 `?'." |