comparison lisp/international/mule-util.el @ 18200:c913160e34a7

(set-coding-system-alist): Deleted. (string-to-sequence): Doc string modified. (coding-system-list): Add optional arg BASE-ONLY. (coding-system-base): New function. (coding-system-plist): New function. (coding-system-equal): New function. (coding-system-unification-table): New function.

18199:15177bdb2fcf

;;; characters.

;;;###autoload
(defun string-to-sequence (string type)
  "Convert STRING to a sequence of TYPE which contains characters in STRING.
TYPE should be `list' or `vector'.
Multibyte characters are conserned."
  (or (eq type 'list) (eq type 'vector)
      (error "Invalid type: %s" type))
  (let* ((len (length string))
	 (i 0)
	 l ch)

      alist)))

;; Coding system related functions.

;;;###autoload
(defun set-coding-system-alist (target-type regexp coding-system
					    &optional operation)
  "Update `coding-system-alist' according to the arguments.
TARGET-TYPE specifies a type of the target: `file', `process', or `network'.
  TARGET-TYPE tells which slots of coding-system-alist should be affected.
  If `file', it affects slots for insert-file-contents and write-region.
  If `process', it affects slots for call-process, call-process-region, and
    start-process.
  If `network', it affects a slot for open-network-process.
REGEXP is a regular expression matching a target of I/O operation.
CODING-SYSTEM is a coding system to perform code conversion
  on the I/O operation, or a cons of coding systems for decoding and
  encoding respectively, or a function symbol which returns the cons.
Optional arg OPERATION if non-nil specifies directly one of slots above.
  The valid value is: insert-file-contents, write-region,
  call-process, call-process-region, start-process, or open-network-stream.
If OPERATION is specified, TARGET-TYPE is ignored.
See the documentation of `coding-system-alist' for more detail."
  (or (stringp regexp)
      (error "Invalid regular expression: %s" regexp))
  (or (memq target-type '(file process network))
      (error "Invalid target type: %s" target-type))
  (if (symbolp coding-system)
      (if (not (fboundp coding-system))
	  (progn
	    (check-coding-system coding-system)
	    (setq coding-system (cons coding-system coding-system))))
    (check-coding-system (car coding-system))
    (check-coding-system (cdr coding-system)))
  (let ((op-list (if operation (list operation)
		   (cond ((eq target-type 'file)
			  '(insert-file-contents write-region))
			 ((eq target-type 'process)
			  '(call-process call-process-region start-process))
			 (t		; i.e. (eq target-type network)
			  '(open-network-stream)))))
	slot)
    (while op-list
      (setq slot (assq (car op-list) coding-system-alist))
      (if slot
	  (let ((chain (cdr slot)))
	    (if (catch 'tag
		  (while chain
		    (if (string= regexp (car (car chain)))
			(progn
			  (setcdr (car chain) coding-system)
			  (throw 'tag nil)))
		    (setq chain (cdr chain)))
		  t)
	      (setcdr slot (cons (cons regexp coding-system) (cdr slot)))))
	(setq coding-system-alist
	      (cons (cons (car op-list) (list (cons regexp coding-system)))
		    coding-system-alist)))
      (setq op-list (cdr op-list)))))

;;;###autoload
(defun coding-system-list ()
  "Return a list of all existing coding systems."
  (let (l)
    (mapatoms (lambda (x) (if (get x 'coding-system) (setq l (cons x l)))))
    l))


;;; Composite charcater manipulations.

;;;###autoload

18200:c913160e34a7

;;; characters.

;;;###autoload
(defun string-to-sequence (string type)
  "Convert STRING to a sequence of TYPE which contains characters in STRING.
TYPE should be `list' or `vector'."
  (or (eq type 'list) (eq type 'vector)
      (error "Invalid type: %s" type))
  (let* ((len (length string))
	 (i 0)
	 l ch)

      alist)))

;; Coding system related functions.

;;;###autoload
(defun coding-system-list (&optional base-only)
  "Return a list of all existing coding systems.
If optional arg BASE-ONLY is non-nil, each element of the list
is a base coding system or a list of coding systems.
In the latter case, the first element is a base coding system,
and the remainings are aliases of it."
  (let (l)
    (mapatoms (lambda (x) (if (get x 'coding-system) (setq l (cons x l)))))
    (if (not base-only)
	l
      (let* ((codings (sort l (function
			       (lambda (x y)
				 (<= (coding-system-mnemonic x)
				     (coding-system-mnemonic y))))))
	     (tail (cons nil codings))
	     (aliases nil)		; ((BASE ALIAS ...) ...)
	     base coding)
	;; At first, remove subsidiary coding systems (eol variants) and
	;; move alias coding systems to ALIASES.
	(while (cdr tail)
	  (setq coding (car (cdr tail)))
	  (if (get coding 'eol-variant)
	      (setcdr tail (cdr (cdr tail)))
	    (setq base (coding-system-base coding))
	    (if (and (not (eq coding base))
		     (coding-system-equal coding base))
		(let ((slot (memq base aliases)))
		  (setcdr tail (cdr (cdr tail)))
		  (if slot
		      (setcdr slot (cons coding (cdr slot)))
		    (setq aliases (cons (list base coding) aliases))))
	      (setq tail (cdr tail)))))
	;; Then, replace a coding system who has aliases with a list.
	(setq tail codings)
	(while tail
	  (let ((alias (assq (car tail) aliases)))
	    (if alias
		(setcar tail alias)))
	  (setq tail (cdr tail)))
	codings))))

;;;###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-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 of 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."
  (equal (coding-system-plist coding-system-1)
	 (coding-system-plist coding-system-2)))

;;;###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 1) 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 (coding-system)
  "Return unification-table property of CODING-SYSTEM."
  (and coding-system
       (symbolp coding-system)
       (or (get coding-system 'unification-table)
	   (coding-system-unification-table
	    (get coding-system 'coding-system)))))


;;; Composite charcater manipulations.

;;;###autoload