Mercurial > emacs
comparison lisp/international/mule.el @ 30491:7b4fadfac0c8
(register-char-codings): New function.
(make-coding-system): Handle `safe-chars' specification in the arg
PROPERTY.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Thu, 27 Jul 2000 06:08:14 +0000 |
parents | 4a60ce7cede2 |
children | e55b142a5369 |
comparison
equal
deleted
inserted
replaced
30490:6c62244b12b8 | 30491:7b4fadfac0c8 |
---|---|
349 ;; | 349 ;; |
350 ;; o translation-table-for-encode | 350 ;; o translation-table-for-encode |
351 ;; | 351 ;; |
352 ;; The value is a translation table to be applied on encoding. | 352 ;; The value is a translation table to be applied on encoding. |
353 ;; | 353 ;; |
354 ;; o safe-chars | |
355 ;; | |
356 ;; The value is a char table. If a character has non-nil value in it, | |
357 ;; the character is safely supported by the coding system. This | |
358 ;; overrides the specification of safe-charsets. | |
359 | |
354 ;; o safe-charsets | 360 ;; o safe-charsets |
355 ;; | 361 ;; |
356 ;; The value is a list of charsets safely supported by the coding | 362 ;; The value is a list of charsets safely supported by the coding |
357 ;; system. The value t means that all charsets Emacs handles are | 363 ;; system. The value t means that all charsets Emacs handles are |
358 ;; supported. Even if some charset is not in this list, it doesn't | 364 ;; supported. Even if some charset is not in this list, it doesn't |
490 len (- len (/ len 2))) | 496 len (- len (/ len 2))) |
491 (setq len (/ len 2)))) | 497 (setq len (/ len 2)))) |
492 (setcdr tem (cons coding-system (cdr tem)))))) | 498 (setcdr tem (cons coding-system (cdr tem)))))) |
493 | 499 |
494 (defun coding-system-list (&optional base-only) | 500 (defun coding-system-list (&optional base-only) |
495 "Return a list of all existing coding systems. | 501 "Return a list of all existing non-subsidiary coding systems. |
496 If optional arg BASE-ONLY is non-nil, only base coding systems are listed." | 502 If optional arg BASE-ONLY is non-nil, only base coding systems are listed. |
503 The value doesn't include subsidiary coding systems which are what | |
504 made from bases and aliases automatically for various end-of-line | |
505 formats (e.g. iso-latin-1-unix, koi8-r-dos)." | |
497 (let* ((codings (copy-sequence coding-system-list)) | 506 (let* ((codings (copy-sequence coding-system-list)) |
498 (tail (cons nil codings))) | 507 (tail (cons nil codings))) |
499 ;; Remove subsidiary coding systems (eol variants) and alias | 508 ;; Remove subsidiary coding systems (eol variants) and alias |
500 ;; coding systems (if necessary). | 509 ;; coding systems (if necessary). |
501 (while (cdr tail) | 510 (while (cdr tail) |
507 ;; CODING is an alias if it is not car of ALIASES. | 516 ;; CODING is an alias if it is not car of ALIASES. |
508 (and base-only (not (eq coding (car aliases))))) | 517 (and base-only (not (eq coding (car aliases))))) |
509 (setcdr tail (cdr (cdr tail))) | 518 (setcdr tail (cdr (cdr tail))) |
510 (setq tail (cdr tail))))) | 519 (setq tail (cdr tail))))) |
511 codings)) | 520 codings)) |
521 | |
522 (defun register-char-codings (coding-system safe-chars) | |
523 (let ((general (char-table-extra-slot char-coding-system-table 0))) | |
524 (if (eq safe-chars t) | |
525 (or (memq coding-system general) | |
526 (set-char-table-extra-slot char-coding-system-table 0 | |
527 (cons coding-system general))) | |
528 (map-char-table | |
529 (function | |
530 (lambda (key val) | |
531 (if (and (>= key 128) val) | |
532 (let ((codings (aref char-coding-system-table key))) | |
533 (or (memq coding-system codings) | |
534 (aset char-coding-system-table key | |
535 (cons coding-system codings))))))) | |
536 safe-chars)))) | |
537 | |
512 | 538 |
513 ;; Make subsidiary coding systems (eol-type variants) of CODING-SYSTEM. | 539 ;; Make subsidiary coding systems (eol-type variants) of CODING-SYSTEM. |
514 (defun make-subsidiary-coding-system (coding-system) | 540 (defun make-subsidiary-coding-system (coding-system) |
515 (let ((coding-spec (coding-system-spec coding-system)) | 541 (let ((coding-spec (coding-system-spec coding-system)) |
516 (subsidiaries (vector (intern (format "%s-unix" coding-system)) | 542 (subsidiaries (vector (intern (format "%s-unix" coding-system)) |
577 INIT-BOL non-nil means any designation state is assumed to be reset | 603 INIT-BOL non-nil means any designation state is assumed to be reset |
578 to initial at each beginning of line on output. | 604 to initial at each beginning of line on output. |
579 DESIGNATION-BOL non-nil means designation sequences should be placed | 605 DESIGNATION-BOL non-nil means designation sequences should be placed |
580 at beginning of line on output. | 606 at beginning of line on output. |
581 SAFE non-nil means convert unsafe characters to `?' on output. | 607 SAFE non-nil means convert unsafe characters to `?' on output. |
582 Unsafe characters are what not specified in SAFE-CHARSET. | 608 Characters not specified in the property `safe-charsets' nor |
609 `safe-chars' are unsafe. | |
583 ACCEPT-LATIN-EXTRA-CODE non-nil means code-detection routine accepts | 610 ACCEPT-LATIN-EXTRA-CODE non-nil means code-detection routine accepts |
584 a code specified in `latin-extra-code-table' (which see) as a valid | 611 a code specified in `latin-extra-code-table' (which see) as a valid |
585 code of the coding system. | 612 code of the coding system. |
586 | 613 |
587 If TYPE is 4 (private), FLAGS should be a cons of CCL programs, for | 614 If TYPE is 4 (private), FLAGS should be a cons of CCL programs, for |
716 (if (and properties | 743 (if (and properties |
717 (or (eq properties t) | 744 (or (eq properties t) |
718 (not (consp (car properties))))) | 745 (not (consp (car properties))))) |
719 ;; In the old version, the arg PROPERTIES is a list to be | 746 ;; In the old version, the arg PROPERTIES is a list to be |
720 ;; set in PLIST as a value of property `safe-charsets'. | 747 ;; set in PLIST as a value of property `safe-charsets'. |
721 (plist-put plist 'safe-charsets properties) | 748 (setq properties (list (cons 'safe-charsets properties)))) |
722 ;; In the current version PROPERTIES is a property list. | 749 ;; In the current version PROPERTIES is a property list. |
723 ;; Reflect it into PLIST one by one. | 750 ;; Reflect it into PLIST one by one while handling safe-chars |
724 (let ((l properties)) | 751 ;; specially. |
725 (while l | 752 (let ((safe-charsets (cdr (assq 'safe-charsets properties))) |
726 (plist-put plist (car (car l)) (cdr (car l))) | 753 (safe-chars (cdr (assq 'safe-chars properties))) |
727 (setq l (cdr l))))) | 754 (l properties) |
755 prop val) | |
756 ;; If only safe-charsets is specified, make a char-table from | |
757 ;; it, and store that char-table as the value of `safe-chars'. | |
758 (if (and (not safe-chars) safe-charsets) | |
759 (let (charset) | |
760 (if (eq safe-charsets t) | |
761 (setq safe-chars t) | |
762 (setq safe-chars (make-char-table 'safe-chars)) | |
763 (while safe-charsets | |
764 (setq charset (car safe-charsets) | |
765 safe-charsets (cdr safe-charsets)) | |
766 (cond ((eq charset 'ascii)) ; just ignore | |
767 ((eq charset 'eight-bit-control) | |
768 (let ((i 128)) | |
769 (while (< i 160) | |
770 (aset safe-chars i t) | |
771 (setq i (1+ i))))) | |
772 ((eq charset 'eight-bit-graphic) | |
773 (let ((i 160)) | |
774 (while (< i 256) | |
775 (aset safe-chars i t) | |
776 (setq i (1+ i))))) | |
777 (t | |
778 (aset safe-chars (make-char charset) t))))) | |
779 (setq l (cons (cons 'safe-chars safe-chars) l)))) | |
780 (while l | |
781 (setq prop (car (car l)) val (cdr (car l)) l (cdr l)) | |
782 (if (eq prop 'safe-chars) | |
783 (progn | |
784 (setq val safe-chars) | |
785 (register-char-codings coding-system safe-chars))) | |
786 (plist-put plist prop val))) | |
728 ;; The property `coding-category' may have been set differently | 787 ;; The property `coding-category' may have been set differently |
729 ;; through PROPERTIES. | 788 ;; through PROPERTIES. |
730 (setq coding-category (plist-get plist 'coding-category)) | 789 (setq coding-category (plist-get plist 'coding-category)) |
731 (aset coding-spec coding-spec-plist-idx plist)) | 790 (aset coding-spec coding-spec-plist-idx plist)) |
732 (put coding-system 'coding-system coding-spec) | 791 (put coding-system 'coding-system coding-spec) |
766 ;; XXX-with-esc variants. | 825 ;; XXX-with-esc variants. |
767 (let ((coding-category (coding-system-category coding-system))) | 826 (let ((coding-category (coding-system-category coding-system))) |
768 (if (or (eq coding-category 'coding-category-iso-8-1) | 827 (if (or (eq coding-category 'coding-category-iso-8-1) |
769 (eq coding-category 'coding-category-iso-8-2)) | 828 (eq coding-category 'coding-category-iso-8-2)) |
770 (let ((esc (intern (concat (symbol-name coding-system) "-with-esc"))) | 829 (let ((esc (intern (concat (symbol-name coding-system) "-with-esc"))) |
771 (doc (format "Same as %s but can handle any charsets by ISO's escape sequences." coding-system))) | 830 (doc (format "Same as %s but can handle any charsets by ISO's escape sequences." coding-system)) |
831 (safe-charsets (assq 'safe-charsets properties)) | |
832 (mime-charset (assq 'mime-charset properties))) | |
833 (if safe-charsets | |
834 (setcdr safe-charsets t) | |
835 (setq properties (cons (cons 'safe-charsets t) properties))) | |
836 (if mime-charset | |
837 (setcdr mime-charset nil)) | |
772 (make-coding-system esc type mnemonic doc | 838 (make-coding-system esc type mnemonic doc |
773 (if (listp (car flags)) | 839 (if (listp (car flags)) |
774 (cons (append (car flags) '(t)) (cdr flags)) | 840 (cons (append (car flags) '(t)) (cdr flags)) |
775 (cons (list (car flags) t) (cdr flags))) | 841 (cons (list (car flags) t) (cdr flags))) |
776 properties) | 842 properties)))) |
777 (coding-system-put esc 'mime-charset nil) | |
778 (coding-system-put esc 'safe-charsets t)))) | |
779 | 843 |
780 coding-system) | 844 coding-system) |
781 | 845 |
782 (defun define-coding-system-alias (alias coding-system) | 846 (defun define-coding-system-alias (alias coding-system) |
783 "Define ALIAS as an alias for coding system CODING-SYSTEM." | 847 "Define ALIAS as an alias for coding system CODING-SYSTEM." |