536 |
(setq tail (cdr tail))))) |
(setq tail (cdr tail))))) |
537 |
codings)) |
codings)) |
538 |
|
|
539 |
|
(defun map-charset-chars (func charset) |
540 |
|
"Use FUNC to map over all characters in CHARSET for side effects. |
541 |
|
FUNC is a function of two args, the start and end (inclusive) of a |
542 |
|
character code range. Thus FUNC should iterate over [START, END]." |
543 |
|
(let* ((dim (charset-dimension charset)) |
544 |
|
(chars (charset-chars charset)) |
545 |
|
(start (if (= chars 94) |
546 |
|
33 |
547 |
|
32))) |
548 |
|
(if (= dim 1) |
549 |
|
(funcall func |
550 |
|
(make-char charset start) |
551 |
|
(make-char charset (+ start chars -1))) |
552 |
|
(dotimes (i chars) |
553 |
|
(funcall func |
554 |
|
(make-char charset (+ i start) start) |
555 |
|
(make-char charset (+ i start) (+ start chars -1))))))) |
556 |
|
|
557 |
(defun register-char-codings (coding-system safe-chars) |
(defun register-char-codings (coding-system safe-chars) |
558 |
(let ((general (char-table-extra-slot char-coding-system-table 0))) |
"Add entries for CODING-SYSTEM to `char-coding-system-table'. |
559 |
|
If SAFE-CHARS is a char-table, its non-nil entries specify characters |
560 |
|
which CODING-SYSTEM encodes safely. If SAFE-CHARS is t, register |
561 |
|
CODING-SYSTEM as a general one which can encode all characters." |
562 |
|
(let ((general (char-table-extra-slot char-coding-system-table 0)) |
563 |
|
;; Charsets which have some members in the table, but not all |
564 |
|
;; of them (i.e. not just a generic character): |
565 |
|
(partials (char-table-extra-slot char-coding-system-table 1))) |
566 |
(if (eq safe-chars t) |
(if (eq safe-chars t) |
567 |
(or (memq coding-system general) |
(or (memq coding-system general) |
568 |
(set-char-table-extra-slot char-coding-system-table 0 |
(set-char-table-extra-slot char-coding-system-table 0 |
569 |
(cons coding-system general))) |
(cons coding-system general))) |
570 |
(map-char-table |
(map-char-table |
571 |
(function |
(lambda (key val) |
572 |
(lambda (key val) |
(if (and (>= key 128) val) |
573 |
(if (and (>= key 128) val) |
(let ((codings (aref char-coding-system-table key)) |
574 |
(let ((codings (aref char-coding-system-table key))) |
(charset (char-charset key))) |
575 |
(or (memq coding-system codings) |
(unless (memq coding-system codings) |
576 |
(aset char-coding-system-table key |
(if (and (generic-char-p key) |
577 |
(cons coding-system codings))))))) |
(memq charset partials)) |
578 |
safe-chars)))) |
;; The generic char would clobber individual |
579 |
|
;; entries already in the table. First save the |
580 |
|
;; separate existing entries for all chars of the |
581 |
|
;; charset (with the generic entry added, if |
582 |
|
;; necessary). |
583 |
|
(let (entry existing) |
584 |
|
(map-charset-chars |
585 |
|
(lambda (start end) |
586 |
|
(while (<= start end) |
587 |
|
(setq entry (aref char-coding-system-table start)) |
588 |
|
(when entry |
589 |
|
(push (cons |
590 |
|
start |
591 |
|
(if (memq coding-system entry) |
592 |
|
entry |
593 |
|
(cons coding-system entry))) |
594 |
|
existing)) |
595 |
|
(setq start (1+ start)))) |
596 |
|
charset) |
597 |
|
;; Update the generic entry. |
598 |
|
(aset char-coding-system-table key |
599 |
|
(cons coding-system codings)) |
600 |
|
;; Override with the saved entries. |
601 |
|
(dolist (elt existing) |
602 |
|
(aset char-coding-system-table (car elt) (cdr elt)))) |
603 |
|
(aset char-coding-system-table key |
604 |
|
(cons coding-system codings)) |
605 |
|
(unless (or (memq charset partials) |
606 |
|
(generic-char-p key)) |
607 |
|
(push charset partials))))))) |
608 |
|
safe-chars) |
609 |
|
(set-char-table-extra-slot char-coding-system-table 1 partials)))) |
610 |
|
|
611 |
|
|
612 |
(defun make-subsidiary-coding-system (coding-system) |
(defun make-subsidiary-coding-system (coding-system) |