Function: ctext-pre-write-conversion

ctext-pre-write-conversion is a byte-compiled function defined in mule.el.gz.

Signature

(ctext-pre-write-conversion FROM TO)

Documentation

Encode characters between FROM and TO as Compound Text w/Extended Segments.

If FROM is a string, generate a new temp buffer, insert the text, and convert it in the temporary buffer. Otherwise, convert in-place.

Source Code

;; Defined in /usr/src/emacs/lisp/international/mule.el.gz
(defun ctext-pre-write-conversion (from to)
  "Encode characters between FROM and TO as Compound Text w/Extended Segments.

If FROM is a string, generate a new temp buffer, insert the text,
and convert it in the temporary buffer.  Otherwise, convert
in-place."
  (save-match-data
    ;; Setup a working buffer if necessary.
    (when (stringp from)
      (set-buffer (generate-new-buffer " *temp"))
      (set-buffer-multibyte (multibyte-string-p from))
      (insert from)
      (setq from (point-min) to (point-max)))
    (save-restriction
      (narrow-to-region from to)
      (goto-char from)
      (let ((encoding-table (ctext-non-standard-encodings-table))
	    (charset-list (sort-charsets
			   (copy-sequence ctext-standard-encodings)))
	    (end-pos (make-marker))
	    last-coding-system-used
	    last-pos charset encoding-info)
	(dolist (elt encoding-table)
	  (push (car elt) charset-list))
	(setq end-pos (point-marker))
	(while (re-search-forward "[^\0-\177]+" nil t)
	  ;; Found a sequence of non-ASCII characters.
	  (set-marker end-pos (match-end 0))
	  (goto-char (match-beginning 0))
	  (setq last-pos (point)
		charset (char-charset (following-char) charset-list))
	  (forward-char 1)
	  (while (and (< (point) end-pos)
		      (eq charset (char-charset (following-char) charset-list)))
	    (forward-char 1))
	  (if charset
	      (if (setq encoding-info (cdr (assq charset encoding-table)))
		  ;; Encode this range using an extended segment.
		  (let ((encoding-name (car encoding-info))
			(coding-system (nth 1 encoding-info))
			(noctets (nth 2 encoding-info))
			len)
		    (encode-coding-region last-pos (point) coding-system)
		    (setq len (+ (length encoding-name) 1
				 (- (point) last-pos)))
		    ;; According to the spec of CTEXT, it is not
		    ;; necessary to produce this extra designation
		    ;; sequence, but some buggy application
		    ;; (e.g. crxvt-gb) requires it.
		    (insert "\e(B")
		    (save-excursion
		      (goto-char last-pos)
		      (insert (format "\e%%/%d" noctets))
		      (insert-byte (+ (/ len 128) 128) 1)
		      (insert-byte (+ (% len 128) 128) 1)
		      (insert encoding-name)
		      (insert 2)))
		;; Encode this range as characters in CHARSET.
		(put-text-property last-pos (point) 'charset charset))
	    ;; Encode this range using UTF-8 encoding extension.
	    (encode-coding-region last-pos (point) 'mule-utf-8)
	    (save-excursion
	      (goto-char last-pos)
	      (insert "\e%G"))
	    (insert "\e%@")))
	(goto-char (point-min)))))
  ;; Must return nil, as build_annotations_2 expects that.
  nil)