269 |
them and you don't supply CODE1, return the character of the smallest |
them and you don't supply CODE1, return the character of the smallest |
270 |
code in CHARSET. |
code in CHARSET. |
271 |
|
|
272 |
If CODE1 or CODE2 are invalid (out of range), this function signals an error." |
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." |
277 |
(make-char-internal (charset-id charset) code1 code2)) |
(make-char-internal (charset-id charset) code1 code2)) |
278 |
|
|
279 |
(put 'make-char 'byte-compile |
(put 'make-char 'byte-compile |
540 |
(setq tail (cdr tail))))) |
(setq tail (cdr tail))))) |
541 |
codings)) |
codings)) |
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 |
|
|
561 |
(defun register-char-codings (coding-system safe-chars) |
(defun register-char-codings (coding-system safe-chars) |
562 |
(let ((general (char-table-extra-slot char-coding-system-table 0))) |
"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))) |
570 |
(if (eq safe-chars t) |
(if (eq safe-chars t) |
571 |
(or (memq coding-system general) |
(or (memq coding-system general) |
572 |
(set-char-table-extra-slot char-coding-system-table 0 |
(set-char-table-extra-slot char-coding-system-table 0 |
573 |
(cons coding-system general))) |
(cons coding-system general))) |
574 |
(map-char-table |
(map-char-table |
575 |
(function |
(lambda (key val) |
576 |
(lambda (key val) |
(if (and (>= key 128) val) |
577 |
(if (and (>= key 128) val) |
(let ((codings (aref char-coding-system-table key)) |
578 |
(let ((codings (aref char-coding-system-table key))) |
(charset (char-charset key))) |
579 |
(or (memq coding-system codings) |
(unless (memq coding-system codings) |
580 |
(aset char-coding-system-table key |
(if (and (generic-char-p key) |
581 |
(cons coding-system codings))))))) |
(memq charset partials)) |
582 |
safe-chars)))) |
;; 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)))) |
614 |
|
|
615 |
|
|
616 |
(defun make-subsidiary-coding-system (coding-system) |
(defun make-subsidiary-coding-system (coding-system) |
830 |
The value is a list to indicate valid byte ranges of the encoded |
The value is a list to indicate valid byte ranges of the encoded |
831 |
file. Each element of the list is an integer or a cons of integer. |
file. Each element of the list is an integer or a cons of integer. |
832 |
In the former case, the integer value is a valid byte code. In the |
In the former case, the integer value is a valid byte code. In the |
833 |
latter case, the integers specifies the range of valid byte codes. |
latter case, the integers specify the range of valid byte codes. |
834 |
|
|
835 |
These properties are set in PLIST, a property list. This function |
These properties are set in PLIST, a property list. This function |
836 |
also sets properties `coding-category' and `alias-coding-systems' |
also sets properties `coding-category' and `alias-coding-systems' |
1390 |
(if (and pos |
(if (and pos |
1391 |
(= (char-after head-start) ?#) |
(= (char-after head-start) ?#) |
1392 |
(= (char-after (1+ head-start)) ?!)) |
(= (char-after (1+ head-start)) ?!)) |
1393 |
;; If the file begins with "#!" (exec interpreter magic), |
;; If the file begins with "#!" (exec interpreter magic), |
1394 |
;; look for coding frobs in the first two lines. You cannot |
;; look for coding frobs in the first two lines. You cannot |
1395 |
;; necessarily put them in the first line of such a file |
;; necessarily put them in the first line of such a file |
1396 |
;; without screwing up the interpreter invocation. |
;; without screwing up the interpreter invocation. |
1397 |
(setq pos (search-forward "\n" head-end t))) |
(setq pos (search-forward "\n" head-end t))) |