Mercurial > emacs
comparison lisp/international/mule.el @ 23456:934152e1b9a4
(make-coding-system): Create -with-esc variant coding system.
| author | Kenichi Handa <handa@m17n.org> |
|---|---|
| date | Wed, 14 Oct 1998 12:41:02 +0000 |
| parents | e07d05f47832 |
| children | ad0e76fa89be |
comparison
equal
deleted
inserted
replaced
| 23455:84276318b663 | 23456:934152e1b9a4 |
|---|---|
| 546 ((= type 1) | 546 ((= type 1) |
| 547 (setq coding-category 'coding-category-sjis)) | 547 (setq coding-category 'coding-category-sjis)) |
| 548 ((= type 2) ; ISO2022 | 548 ((= type 2) ; ISO2022 |
| 549 (let ((i 0) | 549 (let ((i 0) |
| 550 (vec (make-vector 32 nil)) | 550 (vec (make-vector 32 nil)) |
| 551 (g1-designation nil)) | 551 (g1-designation nil) |
| 552 (fl flags)) | |
| 552 (while (< i 4) | 553 (while (< i 4) |
| 553 (let ((charset (car flags))) | 554 (let ((charset (car fl))) |
| 554 (if (and no-initial-designation | 555 (if (and no-initial-designation |
| 555 (> i 0) | 556 (> i 0) |
| 556 (or (charsetp charset) | 557 (or (charsetp charset) |
| 557 (and (consp charset) | 558 (and (consp charset) |
| 558 (charsetp (car charset))))) | 559 (charsetp (car charset))))) |
| 573 (if charset | 574 (if charset |
| 574 (if (eq charset t) | 575 (if (eq charset t) |
| 575 (setq no-alternative-designation nil) | 576 (setq no-alternative-designation nil) |
| 576 (error "Invalid charset: %s" charset))))) | 577 (error "Invalid charset: %s" charset))))) |
| 577 (aset vec i charset)) | 578 (aset vec i charset)) |
| 578 (setq flags (cdr flags) i (1+ i))) | 579 (setq fl (cdr fl) i (1+ i))) |
| 579 (while (and (< i 32) flags) | 580 (while (and (< i 32) fl) |
| 580 (aset vec i (car flags)) | 581 (aset vec i (car fl)) |
| 581 (setq flags (cdr flags) i (1+ i))) | 582 (setq fl (cdr fl) i (1+ i))) |
| 582 (aset coding-spec 4 vec) | 583 (aset coding-spec 4 vec) |
| 583 (setq coding-category | 584 (setq coding-category |
| 584 (if (aref vec 8) ; Use locking-shift. | 585 (if (aref vec 8) ; Use locking-shift. |
| 585 (or (and (aref vec 7) 'coding-category-iso-7-else) | 586 (or (and (aref vec 7) 'coding-category-iso-7-else) |
| 586 'coding-category-iso-8-else) | 587 'coding-category-iso-8-else) |
| 623 (or (eq properties t) | 624 (or (eq properties t) |
| 624 (not (consp (car properties))))) | 625 (not (consp (car properties))))) |
| 625 ;; In the old version, the arg PROPERTIES is a list to be | 626 ;; In the old version, the arg PROPERTIES is a list to be |
| 626 ;; set in PLIST as a value of property `safe-charsets'. | 627 ;; set in PLIST as a value of property `safe-charsets'. |
| 627 (plist-put plist 'safe-charsets properties) | 628 (plist-put plist 'safe-charsets properties) |
| 628 (while properties | 629 (let ((l properties)) |
| 629 (plist-put plist (car (car properties)) (cdr (car properties))) | 630 (while l |
| 630 (setq properties (cdr properties)))) | 631 (plist-put plist (car (car l)) (cdr (car l))) |
| 632 (setq l (cdr l))))) | |
| 631 (aset coding-spec coding-spec-plist-idx plist)) | 633 (aset coding-spec coding-spec-plist-idx plist)) |
| 632 (put coding-system 'coding-system coding-spec) | 634 (put coding-system 'coding-system coding-spec) |
| 633 (put coding-category 'coding-systems | 635 (put coding-category 'coding-systems |
| 634 (cons coding-system (get coding-category 'coding-systems)))) | 636 (cons coding-system (get coding-category 'coding-systems)))) |
| 635 | 637 |
| 644 ;; At last, register CODING-SYSTEM in `coding-system-list' and | 646 ;; At last, register CODING-SYSTEM in `coding-system-list' and |
| 645 ;; `coding-system-alist'. | 647 ;; `coding-system-alist'. |
| 646 (setq coding-system-list (cons coding-system coding-system-list)) | 648 (setq coding-system-list (cons coding-system coding-system-list)) |
| 647 (setq coding-system-alist (cons (list (symbol-name coding-system)) | 649 (setq coding-system-alist (cons (list (symbol-name coding-system)) |
| 648 coding-system-alist)) | 650 coding-system-alist)) |
| 651 | |
| 652 ;; For a coding system of cateogory iso-8-1 and iso-8-2, create | |
| 653 ;; XXX-with-esc variants. | |
| 654 (let ((coding-category (coding-system-category coding-system))) | |
| 655 (if (or (eq coding-category 'coding-category-iso-8-1) | |
| 656 (eq coding-category 'coding-category-iso-8-2)) | |
| 657 (let ((esc (intern (concat (symbol-name coding-system) "-with-esc"))) | |
| 658 (doc (format "Same as %s but can handle any charsets by ISO's escape sequences." coding-system))) | |
| 659 (make-coding-system esc type mnemonic doc | |
| 660 (if (listp (car flags)) | |
| 661 (cons (append (car flags) '(t)) (cdr flags)) | |
| 662 (cons (list (car flags) t) (cdr flags))) | |
| 663 properties) | |
| 664 (coding-system-put esc 'safe-charsets t)))) | |
| 665 | |
| 649 coding-system) | 666 coding-system) |
| 650 | 667 |
| 651 (defun define-coding-system-alias (alias coding-system) | 668 (defun define-coding-system-alias (alias coding-system) |
| 652 "Define ALIAS as an alias for coding system CODING-SYSTEM." | 669 "Define ALIAS as an alias for coding system CODING-SYSTEM." |
| 653 (put alias 'coding-system (coding-system-spec coding-system)) | 670 (put alias 'coding-system (coding-system-spec coding-system)) |