;;; ccl-dispatch.el --- dispatcher for CCL compiler programs

;;; Code:

(if (boundp 'MULE)
    ;; Mule 2.x (0 <= x <= 3)
    (load-file "../aux/cclc-mule2.elc")
  ;; Mule 2.4 or newer
  (require 'ccl)
  (cond ((and (= emacs-major-version 20)
	      (or (= emacs-minor-version 3) (= emacs-minor-version 4)))
	 ;; Emacs 20.[34] workaround
(defun ccl-compile-write-string (str)
  (setq str (string-as-unibyte str))
  (let ((len (length str)))
    (ccl-embed-code 'write-const-string 1 len)
    (ccl-embed-string len str))
  nil)

(defun ccl-compile-write-repeat (cmd)
  (if (/= (length cmd) 2)
      (error "CCL: Invalid number of arguments: %s" cmd))
  (if (null ccl-loop-head)
      (error "CCL: No outer loop: %s" cmd))
  (let ((arg (nth 1 cmd)))
    (cond ((integerp arg)
	   (ccl-embed-code 'write-const-jump 0 ccl-loop-head)
	   (ccl-embed-data arg))
	  ((stringp arg)
	   (setq arg (string-as-unibyte arg))
	   (let ((len (length arg))
		 (i 0))
	     (ccl-embed-code 'write-string-jump 0 ccl-loop-head)
	     (ccl-embed-data len)
	     (ccl-embed-string len arg)))
	  (t
	   (ccl-check-register arg cmd)
	   (ccl-embed-code 'write-register-jump arg ccl-loop-head))))
  t)
	 )
        ((eq (aref (compose-string "AB") 0) ?A)
         ;; Emulate old-style `string-as-unibyte'.  String
         ;; compositions are embedded using a special encoding.
(defun odccl-string-as-unibyte (str)
  (let ((pos 0)
	(strlen (length str))
	compinfo comp-start comp-end)
    (if (and (not (multibyte-string-p str))
	     (null (find-composition 0 strlen str)))
	str
      (with-temp-buffer
	(set-buffer-multibyte nil)
	(while (setq compinfo (find-composition pos strlen str))
	  (setq comp-start (car compinfo)
		comp-end (car (cdr compinfo)))
	  (insert (string-as-unibyte (substring str pos comp-start)))
	  (insert ?\200)
	  (let* ((compstr (string-as-unibyte
			   (substring str comp-start comp-end)))
		 (i 0)
		 (len (length compstr))
		 leading-byte bytes)
	    (while (< i len)
	      (setq leading-byte (aref compstr i))
	      (setq i (1+ i))
	      (if (< leading-byte ?\x80) ; ascii
		  (insert ?\240 (+ ?\200 leading-byte))
		(insert (+ ?\x20 leading-byte))
		(setq bytes
		      (cond ((< leading-byte ?\x90) 1)
			    ;;((< leading-byte ?\x9A) 2)
			    ((< leading-byte ?\x9C) 2)
			    (t 3)))
		(insert (substring compstr i (setq i (+ i bytes)))))))
	  (setq pos comp-end))
	(insert (string-as-unibyte (substring str pos)))
	(buffer-string)))))

(defun ccl-compile-write-string (str)
  (setq str (odccl-string-as-unibyte str))
  (let ((len (length str)))
    (ccl-embed-code 'write-const-string 1 len)
    (ccl-embed-string len str))
  nil)

(defun ccl-compile-write-repeat (cmd)
  (if (/= (length cmd) 2)
      (error "CCL: Invalid number of arguments: %s" cmd))
  (if (null ccl-loop-head)
      (error "CCL: No outer loop: %s" cmd))
  (let ((arg (nth 1 cmd)))
    (cond ((integerp arg)
	   (ccl-embed-code 'write-const-jump 0 ccl-loop-head)
	   (ccl-embed-data arg))
	  ((stringp arg)
	   (setq arg (odccl-string-as-unibyte arg))
	   (let ((len (length arg))
		 (i 0))
	     (ccl-embed-code 'write-string-jump 0 ccl-loop-head)
	     (ccl-embed-data len)
	     (ccl-embed-string len arg)))
	  (t
	   (ccl-check-register arg cmd)
	   (ccl-embed-code 'write-register-jump arg ccl-loop-head))))
  t)
         )
))

(if (fboundp 'set-language-environment)
    (set-language-environment 'Japanese))

;;; ccl-dispatch.el ends here
