comparison lisp/international/mule.el @ 50181:b88623fccdf1

* international/mule.el (optimize-char-coding-system-table): Remove this function. (register-char-codings): Make it obsolete. (char-coding-system-table): Defconst it here. (make-coding-system): Don't call register-char-codings, call define-coding-system-internal.

50180:46738c95f450

      (dotimes (i chars)
	(funcall func
		 (make-char charset (+ i start) start)
		 (make-char charset (+ i start) (+ start chars -1)))))))

(defun optimize-char-coding-system-table ()
  "Optimize `char-coding-system-table'.
Elements which compare `equal' are modified to share the same list."
  (let (cache)
    (map-char-table
     (lambda (k v)
       ;; This doesn't worry about elements which are permutations of
       ;; each other.  As it is, with utf-translate-cjk on and
       ;; code-pages loaded, the table has ~50k elements, which are
       ;; reduced to ~1k.  (`optimize-char-table' might win if
       ;; permutations were eliminated, but that's probably a small
       ;; effect and not easy to test.)
       (if v
	   (let ((existing (car (member v cache))))
	     (if existing
		 (aset char-coding-system-table k existing)
	       (push v cache)))))
     char-coding-system-table))
  (optimize-char-table char-coding-system-table))

(defun register-char-codings (coding-system safe-chars)
  "Add entries for CODING-SYSTEM to `char-coding-system-table'.
If SAFE-CHARS is a char-table, its non-nil entries specify characters
which CODING-SYSTEM encodes safely.  If SAFE-CHARS is t, register
CODING-SYSTEM as a general one which can encode all characters."
  (let ((general (char-table-extra-slot char-coding-system-table 0))
	;; Charsets which have some members in the table, but not all
	;; of them (i.e. not just a generic character):
	(partials (char-table-extra-slot char-coding-system-table 1)))
    (if (eq safe-chars t)
	(or (memq coding-system general)
	    (set-char-table-extra-slot char-coding-system-table 0
				       (cons coding-system general)))
      (map-char-table
       (lambda (key val)
	 (if (and (>= key 128) val)
	     (let ((codings (aref char-coding-system-table key))
		   (charset (char-charset key)))
	       (unless (memq coding-system codings)
		 (if (and (generic-char-p key)
			  (memq charset partials))
		     ;; The generic char would clobber individual
		     ;; entries already in the table.  First save the
		     ;; separate existing entries for all chars of the
		     ;; charset (with the generic entry added, if
		     ;; necessary).
		     (let (entry existing)
		       (map-charset-chars
			(lambda (start end)
			  (while (<= start end)
			    (setq entry (aref char-coding-system-table start))
			    (when entry
			      (push (cons
				     start
				     (if (memq coding-system entry)
					 entry
				       (cons coding-system entry)))
				    existing))
			    (setq start (1+ start))))
			charset)
		       ;; Update the generic entry.
		       (aset char-coding-system-table key
			     (cons coding-system codings))
		       ;; Override with the saved entries.
		       (dolist (elt existing)
			 (aset char-coding-system-table (car elt) (cdr elt))))
		   (aset char-coding-system-table key
			 (cons coding-system codings))
		   (unless (or (memq charset partials)
			       (generic-char-p key))
		     (push charset partials)))))))
       safe-chars)
      ;; This is probably too expensive (e.g. multiple calls in
      ;; ucs-tables), and only really relevant in certain cases, so do
      ;; it explicitly where appropriate.
      ;; (optimize-char-coding-system-table)
      (set-char-table-extra-slot char-coding-system-table 1 partials))))

(defun make-subsidiary-coding-system (coding-system)
  "Make subsidiary coding systems (eol-type variants) of CODING-SYSTEM."
  (let ((coding-spec (coding-system-spec coding-system))
	(subsidiaries (vector (intern (format "%s-unix" coding-system))

	  (if (eq prop 'safe-chars)
	      (progn
		(if (and (symbolp val)
			 (get val 'translation-table))
		    (setq safe-chars (get val 'translation-table)))
		(register-char-codings coding-system safe-chars)
		(setq val safe-chars)))
	  (plist-put plist prop val)))
      ;; The property `coding-category' may have been set differently
      ;; through PROPERTIES.
      (setq coding-category (plist-get plist 'coding-category))

			     (<= eol-type 2))))
	       eol-type)
	      (t
	       (error "Invalid EOL-TYPE spec:%S" eol-type))))
  (put coding-system 'eol-type eol-type)

  ;; At last, register CODING-SYSTEM in `coding-system-list' and
  ;; `coding-system-alist'.
  (add-to-coding-system-list coding-system)
  (setq coding-system-alist (cons (list (symbol-name coding-system))

50181:b88623fccdf1

      (dotimes (i chars)
	(funcall func
		 (make-char charset (+ i start) start)
		 (make-char charset (+ i start) (+ start chars -1)))))))

(defun register-char-codings (coding-system safe-chars)
  "This is an obsolete function.  
It exists just for backward compatibility, and it does nothing.")
(make-obsolete 'register-char-codings
	       "Unnecessary function.  Calling it has no effect."
	       "21.3")

(defconst char-coding-system-table nil
  "This is an obsolete variable.
It exists just for backward compatibility, and the value is always nil.")

(defun make-subsidiary-coding-system (coding-system)
  "Make subsidiary coding systems (eol-type variants) of CODING-SYSTEM."
  (let ((coding-spec (coding-system-spec coding-system))
	(subsidiaries (vector (intern (format "%s-unix" coding-system))

	  (if (eq prop 'safe-chars)
	      (progn
		(if (and (symbolp val)
			 (get val 'translation-table))
		    (setq safe-chars (get val 'translation-table)))
		(setq val safe-chars)))
	  (plist-put plist prop val)))
      ;; The property `coding-category' may have been set differently
      ;; through PROPERTIES.
      (setq coding-category (plist-get plist 'coding-category))

			     (<= eol-type 2))))
	       eol-type)
	      (t
	       (error "Invalid EOL-TYPE spec:%S" eol-type))))
  (put coding-system 'eol-type eol-type)

  (define-coding-system-internal coding-system)

  ;; At last, register CODING-SYSTEM in `coding-system-list' and
  ;; `coding-system-alist'.
  (add-to-coding-system-list coding-system)
  (setq coding-system-alist (cons (list (symbol-name coding-system))