aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDave Love2001-11-29 12:38:39 +0000
committerDave Love2001-11-29 12:38:39 +0000
commit6fb7766c00330bca787390451d48612323fc0f31 (patch)
tree885ae4d52963b8cb73ae6822f6edbb79ba0e2460
parentb25236041463fcc6a76ea4e4796e9887a0124c01 (diff)
downloademacs-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.el86
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
269them and you don't supply CODE1, return the character of the smallest 269them and you don't supply CODE1, return the character of the smallest
270code in CHARSET. 270code in CHARSET.
271 271
272If CODE1 or CODE2 are invalid (out of range), this function signals an error." 272If CODE1 or CODE2 are invalid (out of range), this function signals an
273error. However, the eighth bit of both CODE1 and CODE2 is zeroed
274before they are used to index CHARSET. Thus you may use, say, the
275actual ISO 8859 character code rather than subtracting 128, as you
276would 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.
545FUNC is a function of two args, the start and end (inclusive) of a
546character 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'.
563If SAFE-CHARS is a char-table, its non-nil entries specify characters
564which CODING-SYSTEM encodes safely. If SAFE-CHARS is t, register
565CODING-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
775These properties are set in PLIST, a property list. This function 835These properties are set in PLIST, a property list. This function
776also sets properties `coding-category' and `alias-coding-systems' 836also 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)))