/[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.135 by eliz, Thu Nov 8 11:33:31 2001 UTC revision 1.136 by fx, Thu Nov 29 12:38:39 2001 UTC
# Line 269  don't have corresponding generic charact Line 269  don't have corresponding generic charact
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
# Line 536  formats (e.g. iso-latin-1-unix, koi8-r-d Line 540  formats (e.g. iso-latin-1-unix, koi8-r-d
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)
# Line 770  following properties are recognized: Line 830  following properties are recognized:
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'
# Line 1330  function by default." Line 1390  function by default."
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)))

Legend:
Removed from v.1.135  
changed lines
  Added in v.1.136

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