/[emacs]/emacs/lisp/international/mule.el
ViewVC logotype

Diff of /emacs/lisp/international/mule.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.133.4.2 by eliz, Thu Nov 8 11:57:48 2001 UTC revision 1.133.4.3 by fx, Thu Nov 29 12:16:43 2001 UTC
# Line 536  formats (e.g. iso-latin-1-unix, koi8-r-d Line 536  formats (e.g. iso-latin-1-unix, koi8-r-d
536            (setq tail (cdr tail)))))            (setq tail (cdr tail)))))
537      codings))      codings))
538    
539    (defun map-charset-chars (func charset)
540      "Use FUNC to map over all characters in CHARSET for side effects.
541    FUNC is a function of two args, the start and end (inclusive) of a
542    character code range.  Thus FUNC should iterate over [START, END]."
543      (let* ((dim (charset-dimension charset))
544             (chars (charset-chars charset))
545             (start (if (= chars 94)
546                        33
547                      32)))
548        (if (= dim 1)
549            (funcall func
550                     (make-char charset start)
551                     (make-char charset (+ start chars -1)))
552          (dotimes (i chars)
553            (funcall func
554                     (make-char charset (+ i start) start)
555                     (make-char charset (+ i start) (+ start chars -1)))))))
556    
557  (defun register-char-codings (coding-system safe-chars)  (defun register-char-codings (coding-system safe-chars)
558    (let ((general (char-table-extra-slot char-coding-system-table 0)))    "Add entries for CODING-SYSTEM to `char-coding-system-table'.
559    If SAFE-CHARS is a char-table, its non-nil entries specify characters
560    which CODING-SYSTEM encodes safely.  If SAFE-CHARS is t, register
561    CODING-SYSTEM as a general one which can encode all characters."
562      (let ((general (char-table-extra-slot char-coding-system-table 0))
563            ;; Charsets which have some members in the table, but not all
564            ;; of them (i.e. not just a generic character):
565            (partials (char-table-extra-slot char-coding-system-table 1)))
566      (if (eq safe-chars t)      (if (eq safe-chars t)
567          (or (memq coding-system general)          (or (memq coding-system general)
568              (set-char-table-extra-slot char-coding-system-table 0              (set-char-table-extra-slot char-coding-system-table 0
569                                         (cons coding-system general)))                                         (cons coding-system general)))
570        (map-char-table        (map-char-table
571         (function         (lambda (key val)
572          (lambda (key val)           (if (and (>= key 128) val)
573            (if (and (>= key 128) val)               (let ((codings (aref char-coding-system-table key))
574                (let ((codings (aref char-coding-system-table key)))                     (charset (char-charset key)))
575                  (or (memq coding-system codings)                 (unless (memq coding-system codings)
576                      (aset char-coding-system-table key                   (if (and (generic-char-p key)
577                            (cons coding-system codings)))))))                            (memq charset partials))
578         safe-chars))))                       ;; The generic char would clobber individual
579                         ;; entries already in the table.  First save the
580                         ;; separate existing entries for all chars of the
581                         ;; charset (with the generic entry added, if
582                         ;; necessary).
583                         (let (entry existing)
584                           (map-charset-chars
585                            (lambda (start end)
586                              (while (<= start end)
587                                (setq entry (aref char-coding-system-table start))
588                                (when entry
589                                  (push (cons
590                                         start
591                                         (if (memq coding-system entry)
592                                             entry
593                                           (cons coding-system entry)))
594                                        existing))
595                                (setq start (1+ start))))
596                            charset)
597                           ;; Update the generic entry.
598                           (aset char-coding-system-table key
599                                 (cons coding-system codings))
600                           ;; Override with the saved entries.
601                           (dolist (elt existing)
602                             (aset char-coding-system-table (car elt) (cdr elt))))
603                       (aset char-coding-system-table key
604                             (cons coding-system codings))
605                       (unless (or (memq charset partials)
606                                   (generic-char-p key))
607                         (push charset partials)))))))
608           safe-chars)
609          (set-char-table-extra-slot char-coding-system-table 1 partials))))
610    
611    
612  (defun make-subsidiary-coding-system (coding-system)  (defun make-subsidiary-coding-system (coding-system)

Legend:
Removed from v.1.133.4.2  
changed lines
  Added in v.1.133.4.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26