diff options
| author | Dave Love | 2001-11-29 12:38:39 +0000 |
|---|---|---|
| committer | Dave Love | 2001-11-29 12:38:39 +0000 |
| commit | 6fb7766c00330bca787390451d48612323fc0f31 (patch) | |
| tree | 885ae4d52963b8cb73ae6822f6edbb79ba0e2460 | |
| parent | b25236041463fcc6a76ea4e4796e9887a0124c01 (diff) | |
| download | emacs-6fb7766c00330bca787390451d48612323fc0f31.tar.gz emacs-6fb7766c00330bca787390451d48612323fc0f31.zip | |
Doc fixes.
(map-charset-chars): New function.
(register-char-codings): Use it to cope with generic chars in
safe-chars.
| -rw-r--r-- | lisp/international/mule.el | 86 |
1 files changed, 73 insertions, 13 deletions
diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 84701b4841e..9ffc9dc54e7 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el | |||
| @@ -269,7 +269,11 @@ don't have corresponding generic characters. If CHARSET is one of | |||
| 269 | them and you don't supply CODE1, return the character of the smallest | 269 | them and you don't supply CODE1, return the character of the smallest |
| 270 | code in CHARSET. | 270 | code in CHARSET. |
| 271 | 271 | ||
| 272 | If CODE1 or CODE2 are invalid (out of range), this function signals an error." | 272 | If CODE1 or CODE2 are invalid (out of range), this function signals an |
| 273 | error. However, the eighth bit of both CODE1 and CODE2 is zeroed | ||
| 274 | before they are used to index CHARSET. Thus you may use, say, the | ||
| 275 | actual ISO 8859 character code rather than subtracting 128, as you | ||
| 276 | would need to index the corresponding Emacs charset." | ||
| 273 | (make-char-internal (charset-id charset) code1 code2)) | 277 | (make-char-internal (charset-id charset) code1 code2)) |
| 274 | 278 | ||
| 275 | (put 'make-char 'byte-compile | 279 | (put 'make-char 'byte-compile |
| @@ -536,21 +540,77 @@ formats (e.g. iso-latin-1-unix, koi8-r-dos)." | |||
| 536 | (setq tail (cdr tail))))) | 540 | (setq tail (cdr tail))))) |
| 537 | codings)) | 541 | codings)) |
| 538 | 542 | ||
| 543 | (defun map-charset-chars (func charset) | ||
| 544 | "Use FUNC to map over all characters in CHARSET for side effects. | ||
| 545 | FUNC is a function of two args, the start and end (inclusive) of a | ||
| 546 | character code range. Thus FUNC should iterate over [START, END]." | ||
| 547 | (let* ((dim (charset-dimension charset)) | ||
| 548 | (chars (charset-chars charset)) | ||
| 549 | (start (if (= chars 94) | ||
| 550 | 33 | ||
| 551 | 32))) | ||
| 552 | (if (= dim 1) | ||
| 553 | (funcall func | ||
| 554 | (make-char charset start) | ||
| 555 | (make-char charset (+ start chars -1))) | ||
| 556 | (dotimes (i chars) | ||
| 557 | (funcall func | ||
| 558 | (make-char charset (+ i start) start) | ||
| 559 | (make-char charset (+ i start) (+ start chars -1))))))) | ||
| 560 | |||
| 539 | (defun register-char-codings (coding-system safe-chars) | 561 | (defun register-char-codings (coding-system safe-chars) |
| 540 | (let ((general (char-table-extra-slot char-coding-system-table 0))) | 562 | "Add entries for CODING-SYSTEM to `char-coding-system-table'. |
| 563 | If SAFE-CHARS is a char-table, its non-nil entries specify characters | ||
| 564 | which CODING-SYSTEM encodes safely. If SAFE-CHARS is t, register | ||
| 565 | CODING-SYSTEM as a general one which can encode all characters." | ||
| 566 | (let ((general (char-table-extra-slot char-coding-system-table 0)) | ||
| 567 | ;; Charsets which have some members in the table, but not all | ||
| 568 | ;; of them (i.e. not just a generic character): | ||
| 569 | (partials (char-table-extra-slot char-coding-system-table 1))) | ||
| 541 | (if (eq safe-chars t) | 570 | (if (eq safe-chars t) |
| 542 | (or (memq coding-system general) | 571 | (or (memq coding-system general) |
| 543 | (set-char-table-extra-slot char-coding-system-table 0 | 572 | (set-char-table-extra-slot char-coding-system-table 0 |
| 544 | (cons coding-system general))) | 573 | (cons coding-system general))) |
| 545 | (map-char-table | 574 | (map-char-table |
| 546 | (function | 575 | (lambda (key val) |
| 547 | (lambda (key val) | 576 | (if (and (>= key 128) val) |
| 548 | (if (and (>= key 128) val) | 577 | (let ((codings (aref char-coding-system-table key)) |
| 549 | (let ((codings (aref char-coding-system-table key))) | 578 | (charset (char-charset key))) |
| 550 | (or (memq coding-system codings) | 579 | (unless (memq coding-system codings) |
| 551 | (aset char-coding-system-table key | 580 | (if (and (generic-char-p key) |
| 552 | (cons coding-system codings))))))) | 581 | (memq charset partials)) |
| 553 | safe-chars)))) | 582 | ;; The generic char would clobber individual |
| 583 | ;; entries already in the table. First save the | ||
| 584 | ;; separate existing entries for all chars of the | ||
| 585 | ;; charset (with the generic entry added, if | ||
| 586 | ;; necessary). | ||
| 587 | (let (entry existing) | ||
| 588 | (map-charset-chars | ||
| 589 | (lambda (start end) | ||
| 590 | (while (<= start end) | ||
| 591 | (setq entry (aref char-coding-system-table start)) | ||
| 592 | (when entry | ||
| 593 | (push (cons | ||
| 594 | start | ||
| 595 | (if (memq coding-system entry) | ||
| 596 | entry | ||
| 597 | (cons coding-system entry))) | ||
| 598 | existing)) | ||
| 599 | (setq start (1+ start)))) | ||
| 600 | charset) | ||
| 601 | ;; Update the generic entry. | ||
| 602 | (aset char-coding-system-table key | ||
| 603 | (cons coding-system codings)) | ||
| 604 | ;; Override with the saved entries. | ||
| 605 | (dolist (elt existing) | ||
| 606 | (aset char-coding-system-table (car elt) (cdr elt)))) | ||
| 607 | (aset char-coding-system-table key | ||
| 608 | (cons coding-system codings)) | ||
| 609 | (unless (or (memq charset partials) | ||
| 610 | (generic-char-p key)) | ||
| 611 | (push charset partials))))))) | ||
| 612 | safe-chars) | ||
| 613 | (set-char-table-extra-slot char-coding-system-table 1 partials)))) | ||
| 554 | 614 | ||
| 555 | 615 | ||
| 556 | (defun make-subsidiary-coding-system (coding-system) | 616 | (defun make-subsidiary-coding-system (coding-system) |
| @@ -770,7 +830,7 @@ following properties are recognized: | |||
| 770 | The value is a list to indicate valid byte ranges of the encoded | 830 | The value is a list to indicate valid byte ranges of the encoded |
| 771 | file. Each element of the list is an integer or a cons of integer. | 831 | file. Each element of the list is an integer or a cons of integer. |
| 772 | In the former case, the integer value is a valid byte code. In the | 832 | In the former case, the integer value is a valid byte code. In the |
| 773 | latter case, the integers specifies the range of valid byte codes. | 833 | latter case, the integers specify the range of valid byte codes. |
| 774 | 834 | ||
| 775 | These properties are set in PLIST, a property list. This function | 835 | These properties are set in PLIST, a property list. This function |
| 776 | also sets properties `coding-category' and `alias-coding-systems' | 836 | also sets properties `coding-category' and `alias-coding-systems' |
| @@ -1330,8 +1390,8 @@ function by default." | |||
| 1330 | (if (and pos | 1390 | (if (and pos |
| 1331 | (= (char-after head-start) ?#) | 1391 | (= (char-after head-start) ?#) |
| 1332 | (= (char-after (1+ head-start)) ?!)) | 1392 | (= (char-after (1+ head-start)) ?!)) |
| 1333 | ;; If the file begins with "#!" (exec interpreter magic), | 1393 | ;; If the file begins with "#!" (exec interpreter magic), |
| 1334 | ;; look for coding frobs in the first two lines. You cannot | 1394 | ;; look for coding frobs in the first two lines. You cannot |
| 1335 | ;; necessarily put them in the first line of such a file | 1395 | ;; necessarily put them in the first line of such a file |
| 1336 | ;; without screwing up the interpreter invocation. | 1396 | ;; without screwing up the interpreter invocation. |
| 1337 | (setq pos (search-forward "\n" head-end t))) | 1397 | (setq pos (search-forward "\n" head-end t))) |