;;; thai-xtis-util.el --- utilities for Thai (for XTIS).;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.;; Licensed to the Free Software Foundation.;; Copyright (C) 1999 NECTEC, Thai.;; Author: TAKAHASHI Naoto <ntakahas@etl.go.jp>;; Ken'ichi HANDA <handa@etl.go.jp>;; Virach Sornlertlamvanich <virach@links.nectec.or.th>;; MORIOKA Tomohiko <tomo@etl.go.jp>;; Keywords: mule, multilingual, Thai, XTIS;; This file is part of XEmacs.;; XEmacs is free software; you can redistribute it and/or modify it;; under the terms of the GNU General Public License as published by;; the Free Software Foundation; either version 2, or (at your option);; any later version.;; XEmacs is distributed in the hope that it will be useful, but;; WITHOUT ANY WARRANTY; without even the implied warranty of;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU;; General Public License for more details.;; You should have received a copy of the GNU General Public License;; along with XEmacs; see the file COPYING. If not, write to the Free;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA;; 02111-1307, USA.;;; Commentary:;; For Thai, the pre-composed character set proposed by;; Virach Sornlertlamvanich <virach@links.nectec.or.th> is supported.;;; Code:(require'overlay);;;###autoload;; (defun setup-thai-xtis-environment ();; "Setup multilingual environment for Thai-XTIS.";; (interactive);; (set-language-environment "Thai-XTIS"));;;###autoload;; (defun exit-thai-xtis-environment ();; "Exit Thai-XTIS environment.";; ;; (thai-xtis-text-mode nil);; );;; Utilities for ThaiText minor mode;; Generic character for Thai character set.(defvarthai-xtis-generic-char(if(featurep'xemacs)'thai-xtis(make-char'thai-xtis)));; Regular expression matching any single Thai character.(defvarthai-xtis-char-regexp"\\cx")(defvarthai-xtis-text-modenil"Non-nil if using Thai text minor mode.")(make-variable-buffer-local'thai-xtis-text-mode)(defvarthai-xtis-text-mode-map(let((map(make-sparse-keymap)))(define-keymap"\M-f"'thai-xtis-forward-word)(define-keymap"\M-b"'thai-xtis-backward-word)(define-keymap"\M-d"'thai-xtis-kill-word)(define-keymap"\M-\177"'thai-xtis-backward-kill-word)(define-keymap"\M-t"'thai-xtis-transpose-words)(cond((featurep'xemacs)(define-keymap[(metabackspace)]'thai-xtis-backward-kill-word)(define-keymap[(metadelete)]'thai-xtis-backward-kill-word)(define-keymap[(metaright)]'thai-xtis-forward-word)(define-keymap[(metaleft)]'thai-xtis-backward-word)(define-keymap[(controlright)]'thai-xtis-forward-word)(define-keymap[(controlleft)]'thai-xtis-backward-word)(define-keymap[(controldelete)]'thai-xtis-backward-kill-word))(t(define-keymap[M-right]'thai-xtis-forward-word)(define-keymap[M-left]'thai-xtis-backward-word)(define-keymap[C-right]'thai-xtis-forward-word)(define-keymap[C-left]'thai-xtis-backward-word)(define-keymap[C-delete]'thai-xtis-backward-kill-word)));; Character base operations.(define-keymap"\177"'thai-xtis-backward-delete-char)(define-keymap[backspace]'thai-xtis-backward-delete-char)map)"Keymap for Thai Text minor mode.")(defvarthai-xtis-prev-auto-fill-functionnil)(make-variable-buffer-local'thai-xtis-prev-auto-fill-function)(defvarthai-xtis-prev-normal-auto-fill-functionnil)(make-variable-buffer-local'thai-xtis-prev-normal-auto-fill-function);;;###autoload(defunthai-xtis-text-mode(&optionalarg)"Minor mode for Thai text that pays attention to word segmentation.In this mode, word-oriented commands (e.g forward-word) and textfilling commands (e.g. fill-paragraph) recognize Thai word boundarieswithin a sequence of Thai characters."(interactive(list(notthai-xtis-text-mode)))(setqthai-xtis-text-modearg)(ifthai-xtis-text-mode(progn;; Setup ThaiText mode.(make-local-variable'auto-fill-chars);; (setq auto-fill-chars (copy-sequence auto-fill-chars));; (aset auto-fill-chars thai-xtis-generic-char t)(setqthai-xtis-prev-auto-fill-function'auto-fill-function)(make-local-variable'auto-fill-function)(setqauto-fill-function'thai-xtis-do-auto-fill)(setqthai-xtis-prev-normal-auto-fill-function'normal-auto-fill-function)(setqnormal-auto-fill-function'thai-xtis-do-auto-fill)(make-local-variable'sentence-end-without-period)(setqsentence-end-without-periodt)(set-category-table(copy-category-table));; (modify-category-entry thai-xtis-generic-char ?|)(put-charset-property'thai-xtis'fill-find-break-point-function'thai-xtis-find-break-point)(put-charset-property'thai-xtis'nospace-between-wordst)(make-local-variable'before-change-functions)(setqbefore-change-functions(cons'thai-xtis-wordseg-overlay-modification-functionbefore-change-functions)))(kill-local-variable'auto-fill-chars)(kill-local-variable'sentence-end-without-period)(kill-local-variable'before-change-functions)(setqauto-fill-functionthai-xtis-prev-auto-fill-function)(set-category-table(standard-category-table))(put-charset-property'thai-xtis'fill-find-break-point-functionnil)(put-charset-property'thai-xtis'nospace-between-wordsnil))(force-mode-line-update))(cond((featurep'xemacs)(add-minor-mode'thai-xtis-text-mode" ThaiText"thai-xtis-text-mode-mapnil'thai-xtis-text-mode))(t(require'alist)(set-alist'minor-mode-alist'thai-xtis-text-mode'(" ThaiText"))(set-alist'minor-mode-map-alist'thai-xtis-text-modethai-xtis-text-mode-map)));;; Thai wordseg program interface.(defvarthai-xtis-wordseg-program"/usr/local/bin/wordseg""*Program name of Thai word segmentor.This program reads a Thai word from stdin,and writes segmented words (separated by a space) to stdout.")(defvarthai-xtis-wordseg-data"/usr/local/lib/wordseg""*Directory of data used by `thai-xtis-wordseg-program'.")(defvarthai-xtis-wordseg-args(list"mule""-d"thai-xtis-wordseg-data)"List of arguments for the program `thai-xtis-wordseg-program'.")(defconstthai-xtis-wordseg-service6750"Service name of port number for Thai word segmentor network service.If a program specified in `thai-xtis-wordseg-program' is not availableon your machine, this service will be used.")(defvarthai-xtis-wordseg-server"localhost""*Host name for Thai word segmentor network service.")(defvarthai-xtis-wordseg-coding-system'tis-620"Coding system used to communicate with `thai-xtis-wordseg-program'.");; Wordseg process.(defvarthai-xtis-wordseg-procnil);; String to accumulate data sent from wordseg.(defvarthai-xtis-wordseg-bufnil);; Flag to tell that data sent from wordseg is ready in;; thai-xtis-wordseg-buf.(defvarthai-xtis-wordseg-readynil);; Function to call when data from wordseg arrives at Emacs.(defunthai-xtis-wordseg-filter(procstr)(setqthai-xtis-wordseg-buf(concatthai-xtis-wordseg-bufstr))(if(string-match"\n"thai-xtis-wordseg-buf)(setqthai-xtis-wordseg-readyt)))(defunthai-xtis-word-segment(str&optionalstringp)"Segment STR by Thai words.Return a list of word starting positions.The last element of the list is the ending position of the last word.If optional arg STRINGP is non-nil, return a string of words in Thaiseparated by `|' (vertical bar)."(save-match-data(let((status(andthai-xtis-wordseg-proc(process-statusthai-xtis-wordseg-proc))))(if(not(memqstatus'(runopen)))(let((coding-system-for-read'binary)(coding-system-for-write'binary))(setqthai-xtis-wordseg-proc(if(file-executable-pthai-xtis-wordseg-program)(apply'start-process"wordseg"nilthai-xtis-wordseg-programthai-xtis-wordseg-args)(open-network-stream"wordseg"nilthai-xtis-wordseg-serverthai-xtis-wordseg-service)))(if(not(memq(process-statusthai-xtis-wordseg-proc)'(runopen)))(error"Failed to run %s"thai-xtis-wordseg-program))(process-kill-without-querythai-xtis-wordseg-proc)(set-process-filterthai-xtis-wordseg-proc'thai-xtis-wordseg-filter);; For unknown reason, we must wait for a while before;; sending Thai text to "wordseg" program.(sit-for0300)))(setqthai-xtis-wordseg-buf""thai-xtis-wordseg-readynil)(process-send-stringthai-xtis-wordseg-proc(concat(encode-coding-stringstr'tis-620)"\n"))(while(notthai-xtis-wordseg-ready)(accept-process-outputthai-xtis-wordseg-proc))(setqthai-xtis-wordseg-buf(decode-coding-stringthai-xtis-wordseg-bufthai-xtis-wordseg-coding-system))(ifstringp(substringthai-xtis-wordseg-buf0-2)(let((idx0)(count0)(segments(list0)))(while(setqidx(string-match"|"thai-xtis-wordseg-bufidx))(setqsegments(cons(-idxcount)segments)count(1+count)idx(1+idx)))(nreversesegments))))));; Delete all overlays in between FROM and TO which have;; `thai-xtis-wordseg' property.(defunthai-xtis-delete-wordseg-overlay(fromto)(let((overlays(overlays-infromto)))(whileoverlays(if(overlay-get(caroverlays)'thai-xtis-wordseg)(delete-overlay(caroverlays)))(setqoverlays(cdroverlays)))));; A function to call when a text within or adjacent to a Thai wordseg;; overlay is changed.(defunthai-xtis-wordseg-overlay-modification-function(fromto)(let((overlays(append(overlays-atfrom)(overlays-atto))))(whileoverlays(if(overlay-get(caroverlays)'thai-xtis-wordseg)(delete-overlay(caroverlays)))(setqoverlays(cdroverlays)))));; Return Thai wordseg overlay at POS.(defunthai-xtis-get-wordseg-overlay(pos)(let((overlays(overlays-atpos))overlay)(whileoverlays(if(overlay-get(caroverlays)'thai-xtis-wordseg)(setqoverlay(caroverlays)overlaysnil)))overlay));; Make a wordseg overlay on the region FROM and TO and return it.;; SEGMENTS contains word segmentation information. It is set in;; `thai-xtis-wordseg' property of the overlay.(defunthai-xtis-put-wordseg-overlay(fromtosegments)(let((overlay(make-overlayfromto)))(overlay-putoverlay'thai-xtis-wordsegsegments)(overlay-putoverlay'evaporatet);;(overlay-put overlay 'modification-hooks;;(list 'thai-xtis-wordseg-overlay-modification-function));;(overlay-put overlay 'insert-in-front-hooks;;(list 'thai-xtis-wordseg-overlay-modification-function));;(overlay-put overlay 'insert-behind-hooks;;(list 'thai-xtis-wordseg-overlay-modification-function))overlay));; Make wordseg overlays on all Thai character sequences in the region;; FROM and TO.(defunthai-xtis-set-wordseg-info-region(fromto)(thai-xtis-delete-wordseg-overlayfromto)(save-excursion(save-match-data(goto-charfrom)(let((regexp(concatthai-xtis-char-regexp"+"))(continuet)endsegments)(while(andcontinue(re-search-forwardregexpnilt))(setqfrom(match-beginning0)end(point)continue(<endto)segments(thai-xtis-word-segment(match-string0)))(thai-xtis-put-wordseg-overlayfrom(if(<end(point-max))(1+end)end)segments))))));; Return a list of word segmented positions at or near POS.(defunthai-xtis-wordsegs-at(pos)(let((overlay(thai-xtis-get-wordseg-overlaypos)))(oroverlay(save-excursion(while(and(not(bobp))(eq(char-charset(preceding-char))'thai-xtis))(forward-char-1))(thai-xtis-set-wordseg-info-region(point)pos)(setqoverlay(thai-xtis-get-wordseg-overlaypos))))(ifoverlay(let((head(overlay-startoverlay))(segments(overlay-getoverlay'thai-xtis-wordseg)))(mapcar(function(lambda(x)(+headx)))segments)))))(defunthai-xtis-wordseg-info(pos)(let((segments(thai-xtis-wordsegs-atpos)))(if(andsegments(<pos(car(lastsegments))))(let((from(carsegments)))(while(<=(carsegments)pos)(setqfrom(carsegments)segments(cdrsegments)))(consfrom(carsegments))))));; Move point forward to the next word boundary or to LIMIT. If LIMIT;; is before point, move point backward to the previous word boundary.(defunthai-xtis-search-next-wordseg(limit&optionalinhibit-limit)(save-match-data(let((orig(point))result)(if(>limitorig)(if(and(re-search-forward"\\sw"limit'move)(progn(forward-char-1)(looking-atthai-xtis-char-regexp)))(setqresultt))(if(and(re-search-backward"\\sw"limit'move)(looking-atthai-xtis-char-regexp))(setqresultt)))(ifresult(let((segments(thai-xtis-wordsegs-at(point))))(orsegments(let(fromto)(save-excursion(forward-char1)(if(looking-at(format"\\c%c+"?t))(setqto(match-end0))(setqto(point)))(forward-char-1)(if(re-search-backward(format"\\C%c"?t)(if(<limitorig)limit)'move)(setqfrom(1+(point)))(setqfrom(point)))(thai-xtis-set-wordseg-info-regionfromto))(setqsegments(thai-xtis-wordsegs-at(point)))))(let(;; (point)(lsegments)pos)(if(<limitorig)(progn(setqpos(carsegments))(forward-char1)(while(<(carl)(point))(setqpos(carl)l(cdrl))))(while(<=(carl)(point))(setql(cdrl)))(setqpos(carl)))(goto-charpos)))(goto-charorig)nil))));;; Thai text filling programs.;; Property `fill-find-break-point-function' of Thai charset.(defunthai-xtis-find-break-point(limit)(if(andthai-xtis-text-mode(looking-atthai-xtis-char-regexp))(thai-xtis-search-next-wordseglimit)))(defvarthai-xtis-auto-fill-delay-column8"How many columns right of `fill-column' auto filling should be delayed.In Auto Fill mode, when you type a Thai character beyond fill-columnplus this value, automatic line-wrapping happens.This delay of automatic line-wrapping is to get more accurate wordsegmentation info from `thai-xtis-wordseg-program'.")(defunthai-xtis-do-auto-fill()"Substitution for the function `do-auto-fill' in Thai Text mode."(if(and(not(memq(preceding-char)'(??\n?\t)))(<(current-column)(+fill-columnthai-xtis-auto-fill-delay-column)))nil(do-auto-fill)));;; Word base operations.(defunthai-xtis-forward-word(arg)"Substitution for the command `forward-word' in Thai Text minor mode."(interactive"p")(cond((>arg0)(while(and(not(eobp))(not(or(looking-at"\\w")(looking-atthai-xtis-char-regexp))))(forward-char1))(if(eobp)nil(if(looking-atthai-xtis-char-regexp)(thai-xtis-search-next-wordseg(point-max))(forward-word1))(thai-xtis-forward-word(1-arg))))((<arg0)(while(and(not(bobp))(progn(forward-char-1)(not(or(looking-at"\\w")(looking-atthai-xtis-char-regexp))))))(if(bolp)nil(if(looking-atthai-xtis-char-regexp)(progn(forward-char1)(thai-xtis-search-next-wordseg(point-min)))(forward-char1)(forward-word-1))(thai-xtis-forward-word(1+arg))))))(defunthai-xtis-backward-word(arg)"Substitution for the command `backward-word' in Thai Text minor mode."(interactive"p")(thai-xtis-forward-word(-arg)))(defunthai-xtis-kill-word(arg)"Substitution for the command `kill-word' in Thai Text minor mode."(interactive"*p")(let((pos(point)))(thai-xtis-forward-wordarg)(kill-regionpos(point))))(defunthai-xtis-backward-kill-word(arg)"Substitution for the command `backward-kill-word' in Thai Text minor mode."(interactive"*p")(thai-xtis-kill-word(-arg)))(defunthai-xtis-transpose-words(arg)"Substitution for the command `transpose-words' in Thai Text minor mode."(interactive"*p")(transpose-subr'thai-xtis-forward-wordarg));; Character base operations.(defsubstthai-xtis-char-tone(char)(logand(char-intchar)7))(defsubstthai-xtis-clear-char-tone(char)(int-char(logxor(logior(char-intchar)7)7)))(defsubstthai-xtis-char-verbal(char)(logand(char-intchar)120); #x78)(defsubstthai-xtis-clear-char-verbal(char)(int-char(logior(logxor(logior(char-intchar)120)120)48)); #x30)(defunthai-xtis-backward-delete-char(arg)"Delete backward one character each, used in Thai text only.A vowel sign or a tone mark is considered as a character."(interactive"p")(while(>arg0)(let((chr(char-before)))(cond((eq(char-charsetchr)'thai-xtis)(setqchr(let((tone(thai-xtis-char-tonechr)))(if(>tone0)(thai-xtis-clear-char-tonechr)(let((verbal(thai-xtis-char-verbalchr)))(if(>verbal48); #x30(thai-xtis-clear-char-verbalchr))))))(backward-delete-char1)(ifchr(insertchr)))(t(backward-delete-char1))))(setqarg(1-arg))));;;(provide'thai-xtis-util);; thai-xtis-util.el ends here.