comparison lisp/international/mule-util.el @ 20113:00ca5f419c16

(coding-system-base): Moved to mule.el. (coding-system-post-read-conversion): Use the new function coding-system-get. (coding-system-pre-write-conversion): Likewise. (coding-system-unification-table-for-decode): Likewise. (coding-system-unification-table-for-encode): Likewise. (coding-system-list): Adjusted for the change in mule.el. (coding-system-plist): Deleted. (coding-system-equal): Do not use coding-system-plist.

20112:6e6838a12511


;; Coding system related functions.

;;;###autoload
(defun coding-system-base (coding-system)
  "Return a base of CODING-SYSTEM.
The base is a coding system of which coding-system property is a
coding-spec (see the function `make-coding-system')."
  (let ((coding-spec (get coding-system 'coding-system)))
    (if (vectorp coding-spec)
	coding-system
      (coding-system-base coding-spec))))

;;;###autoload
(defun coding-system-eol-type-mnemonic (coding-system)
  "Return mnemonic letter of eol-type of CODING-SYSTEM."
  (let ((eol-type (coding-system-eol-type coding-system)))
    (cond ((vectorp eol-type) eol-mnemonic-undecided)
	  ((eq eol-type 0) eol-mnemonic-unix)

	  ((eq eol-type 2) eol-mnemonic-unix)
	  (t ?-))))

;;;###autoload
(defun coding-system-post-read-conversion (coding-system)
  "Return post-read-conversion property of CODING-SYSTEM."
  (and coding-system
       (symbolp coding-system)
       (or (get coding-system 'post-read-conversion)
	   (coding-system-post-read-conversion
	    (get coding-system 'coding-system)))))

;;;###autoload
(defun coding-system-pre-write-conversion (coding-system)
  "Return pre-write-conversion property of CODING-SYSTEM."
  (and coding-system
       (symbolp coding-system)
       (or (get coding-system 'pre-write-conversion)
	   (coding-system-pre-write-conversion
	    (get coding-system 'coding-system)))))

;;;###autoload
(defun coding-system-unification-table-for-decode (coding-system)
  "Return unification-table-for-decode property of CODING-SYSTEM."
  (and coding-system
       (symbolp coding-system)
       (or (get coding-system 'unification-table-for-decode)
	   (coding-system-unification-table-for-decode
	    (get coding-system 'coding-system)))))

;;;###autoload
(defun coding-system-unification-table-for-encode (coding-system)
  "Return unification-table-for-encode property of CODING-SYSTEM."
  (and coding-system
       (symbolp coding-system)
       (or (get coding-system 'unification-table-for-encode)
	   (coding-system-unification-table-for-encode
	    (get coding-system 'coding-system)))))

(defun coding-system-lessp (x y)
  (cond ((eq x 'no-conversion) t)
	((eq y 'no-conversion) nil)
	((eq x 'emacs-mule) t)

;;;###autoload
(defun coding-system-list (&optional base-only)
  "Return a list of all existing coding systems.
If optional arg BASE-ONLY is non-nil, only base coding systems are listed."
  (let (l)
    (mapatoms (lambda (x) (if (get x 'coding-system) (setq l (cons x l)))))
    (let* ((codings (sort l 'coding-system-lessp))
	   (tail (cons nil codings))
	   coding)
      ;; At first, remove subsidiary coding systems (eol variants) and
      ;; alias coding systems (if necessary).
      (while (cdr tail)
	(setq coding (car (cdr tail)))
	(if (or (get coding 'eol-variant)
		(and base-only (coding-system-parent coding)))
	    (setcdr tail (cdr (cdr tail)))
	  (setq tail (cdr tail))))
      codings)))

;;;###autoload
(defun coding-system-plist (coding-system)
  "Return property list of CODING-SYSTEM."
  (let ((found nil)
	coding-spec eol-type
	post-read-conversion pre-write-conversion
	unification-table)
    (while (not found)
      (or eol-type
	  (setq eol-type (get coding-system 'eol-type)))
      (or post-read-conversion
	  (setq post-read-conversion
		(get coding-system 'post-read-conversion)))
      (or pre-write-conversion
	  (setq pre-write-conversion
		(get coding-system 'pre-write-conversion)))
      (or unification-table
	  (setq unification-table
		(get coding-system 'unification-table)))
      (setq coding-spec (get coding-system 'coding-system))
      (if (and coding-spec (symbolp coding-spec))
	  (setq coding-system coding-spec)
	(setq found t)))
    (if (not coding-spec)
	(error "Invalid coding system: %s" coding-system))
    (list 'coding-spec coding-spec
	  'eol-type eol-type
	  'post-read-conversion post-read-conversion
	  'pre-write-conversion pre-write-conversion
	  'unification-table unification-table)))

;;;###autoload
(defun coding-system-equal (coding-system-1 coding-system-2)
  "Return t if and only if CODING-SYSTEM-1 and CODING-SYSTEM-2 are identical.
Two coding systems are identical if two symbols are equal
or one is an alias of the other."
  (or (eq coding-system-1 coding-system-2)
      (equal (coding-system-plist coding-system-1)
	     (coding-system-plist coding-system-2))))


;;; Composite charcater manipulations.

;;;###autoload

20113:00ca5f419c16


;; Coding system related functions.

;;;###autoload
(defun coding-system-eol-type-mnemonic (coding-system)
  "Return mnemonic letter of eol-type of CODING-SYSTEM."
  (let ((eol-type (coding-system-eol-type coding-system)))
    (cond ((vectorp eol-type) eol-mnemonic-undecided)
	  ((eq eol-type 0) eol-mnemonic-unix)

	  ((eq eol-type 2) eol-mnemonic-unix)
	  (t ?-))))

;;;###autoload
(defun coding-system-post-read-conversion (coding-system)
  "Return the value of CODING-SYSTEM's post-read-conversion property."
  (coding-system-get coding-system 'post-read-conversion))

;;;###autoload
(defun coding-system-pre-write-conversion (coding-system)
  "Return the value of CODING-SYSTEM's pre-write-conversion property."
  (coding-system-get coding-system 'pre-write-conversion))

;;;###autoload
(defun coding-system-unification-table-for-decode (coding-system)
  "Return the value of CODING-SYSTEM's unification-table-for-decode property."
  (coding-system-get coding-system 'character-unification-table-for-decode))

;;;###autoload
(defun coding-system-unification-table-for-encode (coding-system)
  "Return the value of CODING-SYSTEM's unification-table-for-encode property."
  (coding-system-get coding-system 'character-unification-table-for-encode))

(defun coding-system-lessp (x y)
  (cond ((eq x 'no-conversion) t)
	((eq y 'no-conversion) nil)
	((eq x 'emacs-mule) t)

;;;###autoload
(defun coding-system-list (&optional base-only)
  "Return a list of all existing coding systems.
If optional arg BASE-ONLY is non-nil, only base coding systems are listed."
  (let* ((codings (sort (copy-sequence coding-system-list)
			'coding-system-lessp))
	 (tail (cons nil codings)))
    ;; Remove subsidiary coding systems (eol variants) and alias
    ;; coding systems (if necessary).
    (while (cdr tail)
      (let* ((coding (car (cdr tail)))
	     (aliases (coding-system-get coding 'alias-coding-systems)))
	(if (or
	     ;; CODING is an eol varinant if not in ALIASES.
	     (not (memq coding aliases))
	     ;; CODING is an alias if it is not car of ALISES.
	     (and base-only (not (eq coding (car aliases)))))
	    (setcdr tail (cdr (cdr tail)))
	  (setq tail (cdr tail)))))
    codings))

;;;###autoload
(defun coding-system-equal (coding-system-1 coding-system-2)
  "Return t if and only if CODING-SYSTEM-1 and CODING-SYSTEM-2 are identical.
Two coding systems are identical if two symbols are equal
or one is an alias of the other."
  (or (eq coding-system-1 coding-system-2)
      (and (equal (coding-system-spec coding-system-1)
		  (coding-system-spec coding-system-2))
	   (let ((eol-type-1 (coding-system-eol-type coding-system-1))
		 (eol-type-2 (coding-system-eol-type coding-system-2)))
	     (or (eq eol-type-1 eol-type-2)
		 (and (vectorp eol-type-1) (vectorp eol-type-2)))))))


;;; Composite charcater manipulations.

;;;###autoload