Commit 4ed46869 authored by Karl Heuer's avatar Karl Heuer

Initial revision

parent adb572fb
;; gnus-mule.el -- Provide multilingual environment to GNUS
;; Copyright (C) 1995 Free Software Foundation, Inc.
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
;; Keywords: gnus, mule
;; This file is part of GNU Emacs.
;; GNU Emacs 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.
;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
;; This package enables GNUS to code convert automatically
;; accoding to a coding system specified for each news group.
;; Please put the following line in your .emacs:
;; (add-hook 'gnus-startup-hook 'gnus-mule-initialize)
;; If you want to specify some coding system for a specific news
;; group, add the fllowing line in your .emacs:
;; (gnus-mule-add-group "xxx.yyy.zzz" 'some-coding-system)
;;
;; Decoding of summary buffer is not yet implemented.
(require 'gnus)
(defvar gnus-newsgroup-coding-systems nil
"Assoc list of news groups vs corresponding coding systems.
Each element is a list of news group name and cons of coding systems
for reading and posting.")
;;;###autoload
(defun gnus-mule-add-group (name coding-system)
"Specify that articles of news group NAME are encoded in CODING-SYSTEM.
All news groups deeper than NAME are also the target.
If CODING-SYSTEM is a cons, the car and cdr part are regarded as
coding-system for reading and writing respectively."
(if (not (consp coding-system))
(setq coding-system (cons coding-system coding-system)))
(setq name (concat "^" (regexp-quote name)))
(let ((group (assoc name gnus-newsgroup-coding-systems)))
(if group
(setcdr group coding-system)
(setq gnus-newsgroup-coding-systems
(cons (cons name coding-system) gnus-newsgroup-coding-systems)))))
(defun gnus-mule-get-coding-system (group)
"Return the coding system for news group GROUP."
(let ((groups gnus-newsgroup-coding-systems)
(len -1)
coding-system)
;; Find an entry which matches GROUP the best (i.e. longest).
(while groups
(if (and (string-match (car (car groups)) group)
(> (match-end 0) len))
(setq len (match-end 0)
coding-system (cdr (car groups))))
(setq groups (cdr groups)))
coding-system))
;; Flag to indicate if article buffer is already decoded or not.")
(defvar gnus-mule-article-decoded nil)
;; Codingsystem for reading articles of the current news group.
(defvar gnus-mule-coding-system nil)
(defvar gnus-mule-subject nil)
(defvar gnus-mule-decoded-subject nil)
(defvar gnus-mule-original-subject nil)
;; Encode (if ENCODING is t) or decode (if ENCODING is nil) the
;; region from START to END by CODING-SYSTEM.
(defun gnus-mule-code-convert1 (start end coding-system encoding)
(if (< start end)
(save-excursion
(if encoding
(encode-coding-region start end coding-system)
(decode-coding-region start end coding-system)))))
;; Encode (if ENCODING is t) or decode (if ENCODING is nil) the
;; current buffer by CODING-SYSTEM. Try not to move positions of
;; (window-start) and (point).
(defun gnus-mule-code-convert (coding-system encoding)
(if coding-system
(let ((win (get-buffer-window (current-buffer))))
(if win
;; We should keep (point) and (window-start).
(save-window-excursion
(select-window win)
(if encoding
;; Simple way to assure point is on valid character boundary.
(beginning-of-line))
(gnus-mule-code-convert1 (point-min) (window-start)
coding-system encoding)
(gnus-mule-code-convert1 (window-start) (point)
coding-system encoding)
(gnus-mule-code-convert1 (point) (point-max)
coding-system encoding)
(if (not (pos-visible-in-window-p))
;; point went out of window, move to the bottom of window.
(move-to-window-line -1)))
;; No window for the buffer, no need to worry about (point)
;; and (windos-start).
(gnus-mule-code-convert1 (point-min) (point-max)
coding-system encoding))
)))
;; Set `gnus-mule-coding-system' to the coding system articles of the
;; current news group is encoded. This function is set in
;; `gnus-select-group-hook'.
(defun gnus-mule-select-coding-system ()
(let ((coding-system (gnus-mule-get-coding-system gnus-newsgroup-name)))
(setq gnus-mule-coding-system
(if (and coding-system (coding-system-p (car coding-system)))
(car coding-system)))))
;; Decode the current article. This function is set in
;; `gnus-article-prepare-hook'.
(defun gnus-mule-decode-article ()
(gnus-mule-code-convert gnus-mule-coding-system nil)
(setq gnus-mule-article-decoded t))
;; Decode the current summary buffer. This function is set in
;; `gnus-summary-prepare-hook'.
(defun gnus-mule-decode-summary ()
;; I have not yet implemented this function because I'm not yet
;; familiar with the new Gnus codes, especialy how to extract only
;; subjects from a summary buffer.
nil)
(defun gnus-mule-toggle-article-format ()
"Toggle decoding/encoding of the current article buffer."
(interactive)
(let ((buf (get-buffer gnus-article-buffer)))
(if (and gnus-mule-coding-system buf)
(save-excursion
(set-buffer buf)
(let ((modif (buffer-modified-p))
buffer-read-only)
(gnus-mule-code-convert gnus-mule-coding-system
gnus-mule-article-decoded)
(setq gnus-mule-article-decoded (not gnus-mule-article-decoded))
(set-buffer-modified-p modif))))))
;;;###autoload
(defun gnus-mule-initialize ()
"Do several settings for GNUS to enable automatic code conversion."
;; Convenient key definitions
(define-key gnus-article-mode-map "z" 'gnus-mule-toggle-article-format)
(define-key gnus-summary-mode-map "z" 'gnus-mule-toggle-article-format)
;; Hook definition
(add-hook 'gnus-select-group-hook 'gnus-mule-select-coding-system)
(add-hook 'gnus-summary-prepare-hook 'gnus-mule-decode-summary)
(add-hook 'gnus-article-prepare-hook 'gnus-mule-decode-article))
(gnus-mule-add-group "" 'coding-system-iso-2022-7) ;; default coding system
(gnus-mule-add-group "alt" 'no-conversion)
(gnus-mule-add-group "comp" 'no-conversion)
(gnus-mule-add-group "gnu" 'no-conversion)
(gnus-mule-add-group "rec" 'no-conversion)
(gnus-mule-add-group "sci" 'no-conversion)
(gnus-mule-add-group "soc" 'no-conversion)
(gnus-mule-add-group "alt.chinese.text" 'coding-system-hz)
(gnus-mule-add-group "alt.hk" 'coding-system-hz)
(gnus-mule-add-group "alt.chinese.text.big5" 'coding-system-big5)
(gnus-mule-add-group "soc.culture.vietnamese" '(nil . coding-system-viqr))
(add-hook 'gnus-startup-hook 'gnus-mule-initialize)
;; gnus-mule.el ends here
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
;;; isearch-x.el --- extended isearch handling commands
;; Copyright (C) 1995 Free Software Foundation, Inc.
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
;; Keywords: multilingual, isearch
;; Author: Kenichi HANDA <handa@etl.go.jp>
;; Maintainer: Kenichi HANDA <handa@etl.go.jp>
;; This file is part of GNU Emacs.
;; GNU Emacs 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.
;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Code:
;;;###autoload
(defun isearch-toggle-specified-input-method ()
"Select and toggle specified input method in interactive search."
(interactive)
;; Let the command `toggle-input-method' ask users to select input
;; method interactively.
(setq default-input-method nil)
(isearch-toggle-input-method))
;;;###autoload
(defun isearch-toggle-input-method ()
"Toggle input method in interactive search."
(interactive)
(if isearch-multibyte-characters-flag
(setq isearch-multibyte-characters-flag nil)
(condition-case nil
(progn
(if (null default-input-method)
(let ((overriding-terminal-local-map nil))
;; No input method has ever been selected. Select one
;; interactively now. This also sets
;; `default-input-method-title' to the title of the
;; selected input method.
(toggle-input-method)
;; And, inactivate it for the moment.
(toggle-input-method)))
(setq isearch-multibyte-characters-flag t))
(error (ding))))
(isearch-update))
(defun isearch-input-method-after-insert-chunk-function ()
(funcall inactivate-current-input-method-function))
(defun isearch-process-search-multibyte-characters (last-char)
(let* ((overriding-terminal-local-map nil)
;; Let input method exit when a chunk is inserted.
(input-method-after-insert-chunk-hook
'(isearch-input-method-after-insert-chunk-function))
(input-method-inactivate-hook '(exit-minibuffer))
;; Let input method work rather tersely.
(input-method-tersely-flag t)
str)
(setq unread-command-events (cons last-char unread-command-events))
(setq str (read-multilingual-string (concat (isearch-message-prefix)
isearch-message)))
(isearch-process-search-string str str)))
;;; isearch-x.el ends here
;;; kinsoku.el --- `Kinsoku' processing functions.
;; Copyright (C) 1995 Free Software Foundation, Inc.
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
;; Keywords: kinsoku
;; This file is part of GNU Emacs.
;; GNU Emacs 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.
;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
;; `Kinsoku' processing is to prohibit specific characters to be
;; placed at beginning of line or at end of line. Characters not to
;; be placed at beginning and end of line have character category `>'
;; and `<' respectively. This restriction is dissolved by making a
;; line longer or shorter.
;;
;; `Kinsoku' is a Japanese word which originally means ordering to
;; stay in one place, and is used for the text processing described
;; above in the context of text formatting.
;;; Code:
(defvar kinsoku-limit 4
"How many more columns we can make lines longer by `kinsoku' processing.
The value 0 means there's no limitation.")
;; Setting character category `>' for characters which should not be
;; placed at beginning of line.
(let* ((kinsoku-bol
(concat
;; ASCII
"!)-_~}]:;',.?"
;; Japanese JISX0208
"$B!"!#!$!%!&!'!(!)!*!+!,!-!.!/!0!1!2!3!4!5!6!7!8!9!:!;!<!=!>(B\
$B!?!@!A!B!C!D!E!G!I!K!M!O!Q!S!U!W!Y![!k!l!m!n(B\
$B$!$#$%$'$)$C$c$e$g$n%!%#%%%'%)%C%c%e%g%n%u%v(B"
;; Chinese GB2312
"$A!"!##.#,!$!%!&!'!(!)!*!+!,!-!/!1#)!3!5!7!9!;!=(B\
$A!?#;#:#?#!!@!A!B!C!c!d!e!f#/#\#"#_#~#|(e(B"
;; Chinese BIG5
"$(0!"!#!$!%!&!'!(!)!*!+!,!-!.!/!0!1!2(B\
$(0!3!4!5!6!7!8!9!:!;!<!=!?!A!C!E!G!I!K(B\
$(0!M!O!Q(B $(0!S!U!W!Y![!]!_!a!c!e!g!i!k!q(B\
$(0"#"$"%"&"'"(")"*"+","2"3"4"j"k"l"x%7(B"))
(len (length kinsoku-bol))
(idx 0)
ch)
(while (< idx len)
(setq ch (sref kinsoku-bol idx)
idx (+ idx (char-bytes ch)))
(modify-category-entry ch ?>)))
;; Setting character category `<' for characters which should not be
;; placed at end of line.
(let* ((kinsoku-eol
(concat
;; ASCII
"({[`"
;; Japanese JISX0208
"$B!F!H!J!L!N!P!R!T!V!X!Z!k!l!m!n!w!x(B\
$A!.!0#"#(!2!4!6!8!:!<!>!c!d!e#@!f!l(B"
;; Chinese GB2312
"$A(E(F(G(H(I(J(K(L(M(N(O(P(Q(R(S(T(U(V(W(X(Y(h(B\
$(0!>!@!B!D!F!H!J!L!N!P!R!T!V!X!Z!\!^!`!b(B"
;; Chinese BIG5
"$(0!d!f!h!j!k!q!p"i"j"k"n"x$u$v$w$x$y$z${(B\
$(0$|$}$~%!%"%#%$%%%&%'%(%)%*%+%:(B"))
(len (length kinsoku-eol))
(idx 0)
ch)
(while (< idx len)
(setq ch (sref kinsoku-eol idx)
idx (+ idx (char-bytes ch)))
(modify-category-entry ch ?<)))
;; Try to resolve `kinsoku' restriction by making the current line longer.
(defun kinsoku-longer ()
(let ((pos-and-column (save-excursion
(forward-char 1)
(while (aref (char-category-set (following-char)) ?>)
(forward-char 1))
(cons (point) (current-column)))))
(if (or (<= kinsoku-limit 0)
(< (cdr pos-and-column) (+ (current-fill-column) kinsoku-limit)))
(goto-char (car pos-and-column)))))
;; Try to resolve `kinsoku' restriction by making the current line shorter.
;; The line can't be broken before the buffer position LINEBEG."
(defun kinsoku-shorter (linebeg)
(let ((pos (save-excursion
(forward-char -1)
(while (and (< linebeg (point))
(or (aref (char-category-set (preceding-char)) ?<)
(aref (char-category-set (following-char)) ?>)))
(forward-char -1))
(point))))
(if (< linebeg pos)
(goto-char pos))))
;;;###autoload
(defun kinsoku (linebeg)
"Go to a line breaking position near point by doing `kinsoku' processing.
LINEBEG is a buffer position we can't break a line before.
`Kinsoku' processing is to prohibit specific characters to be placed
at beginning of line or at end of line. Characters not to be placed
at beginning and end of line have character category `>' and `<'
respectively. This restriction is dissolved by making a line longer or
shorter.
`Kinsoku' is a Japanese word which originally means ordering to stay
in one place, and is used for the text processing described above in
the context of text formatting."
(if (or (and
;; The character after point can't be placed at beginning
;; of line.
(aref (char-category-set (following-char)) ?>)
;; We at first try to dissolve this situation by making a
;; line longer. If it fails, then try making a line
;; shorter.
(not (kinsoku-longer)))
;; The character before point can't be placed at end of line.
(aref (char-category-set (preceding-char)) ?<))
(kinsoku-shorter linebeg)))
;; kinsoku.el ends here
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
;; skkdic-utl.el -- utility functions for handling skkdic.el
;; Copyright (C) 1995 Free Software Foundation, Inc.
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
;; Keywords: mule, multilingual, Japanese, SKK
;; This file is part of GNU Emacs.
;; GNU Emacs 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.
;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
;; SKK is a free Japanese input method running on Mule created by
;; Masahiko Sato <masahiko@sato.riec.tohoku.ac.jp>. A dictionary of
;; SKK can be converted by `skkdic-convert' (skkdic-conv.el) to a file
;; "skkdic.el" in which the dictionary entries are defined in the
;; format which can be handled by the following functions.
;;; Code:
(defvar skkdic-okuri-ari nil
"OKURI-ARI entries of SKK dictionary.")
(defvar skkdic-postfix nil
"POSTFIX entries of SKK dictionary.")
(defvar skkdic-prefix nil
"PREFIX entries of SKK dictionary.")
(defvar skkdic-okuri-nasi nil
"OKURI-NASI entries of SKK dictionary.")
;; Alist of Okuriganas vs trailing ASCII letters in OKURI-ARI entry.
(defconst skkdic-okurigana-table
'((?$B$!(B . ?a) (?$B$"(B . ?a) (?$B$#(B . ?i) (?$B$$(B . ?i) (?$B$%(B . ?u)
(?$B$&(B . ?u) (?$B$'(B . ?e) (?$B$((B . ?e) (?$B$)(B . ?o) (?$B$*(B . ?o)
(?$B$+(B . ?k) (?$B$,(B . ?g) (?$B$-(B . ?k) (?$B$.(B . ?g) (?$B$/(B . ?k)
(?$B$0(B . ?g) (?$B$1(B . ?k) (?$B$2(B . ?g) (?$B$3(B . ?k) (?$B$4(B . ?g)
(?$B$5(B . ?s) (?$B$6(B . ?z) (?$B$7(B . ?s) (?$B$8(B . ?j) (?$B$9(B . ?s)
(?$B$:(B . ?z) (?$B$;(B . ?s) (?$B$<(B . ?z) (?$B$=(B . ?s) (?$B$>(B . ?z)
(?$B$?(B . ?t) (?$B$@(B . ?d) (?$B$A(B . ?t) (?$B$B(B . ?d) (?$B$C(B . ?t)
(?$B$D(B . ?t) (?$B$E(B . ?d) (?$B$F(B . ?t) (?$B$G(B . ?d) (?$B$H(B . ?t) (?$B$I(B . ?d)
(?$B$J(B . ?n) (?$B$K(B . ?n) (?$B$L(B . ?n) (?$B$M(B . ?n) (?$B$N(B . ?n)
(?$B$O(B . ?h) (?$B$P(B . ?b) (?$B$Q(B . ?p) (?$B$R(B . ?h) (?$B$S(B . ?b)
(?$B$T(B . ?p) (?$B$U(B . ?h) (?$B$V(B . ?b) (?$B$W(B . ?p) (?$B$X(B . ?h)
(?$B$Y(B . ?b) (?$B$Z(B . ?p) (?$B$[(B . ?h) (?$B$\(B . ?b) (?$B$](B . ?p)
(?$B$^(B . ?m) (?$B$_(B . ?m) (?$B$`(B . ?m) (?$B$a(B . ?m) (?$B$b(B . ?m)
(?$B$c(B . ?y) (?$B$d(B . ?y) (?$B$e(B . ?y) (?$B$f(B . ?y) (?$B$g(B . ?y) (?$B$h(B . ?y)
(?$B$i(B . ?r) (?$B$j(B . ?r) (?$B$k(B . ?r) (?$B$l(B . ?r) (?$B$m(B . ?r)
(?$B$o(B . ?w) (?$B$p(B . ?w) (?$B$q(B . ?w) (?$B$r(B . ?w)
(?$B$s(B . ?n)
))
(defconst skkdic-jbytes
(charset-bytes 'japanese-jisx0208))
(defun skkdic-merge-head-and-tail (heads tails postfix)
(let ((min-len (* skkdic-jbytes 2))
l)
(while heads
(if (or (not postfix)
(>= (length (car heads)) min-len))
(let ((tail tails))
(while tail
(if (or postfix
(>= (length (car tail)) min-len))
(setq l (cons (concat (car heads) (car tail)) l)))
(setq tail (cdr tail)))))
(setq heads (cdr heads)))
l))
(defconst skkdic-jisx0208-hiragana-block (nth 1 (split-char ?$B$"(B)))
(defun skkdic-lookup-key (seq len &optional postfix)
"Return a list of conversion string for sequence SEQ of length LEN.
SEQ is a vector of Kana characters to be converted by SKK dictionary.
If LEN is shorter than the length of KEYSEQ, the first LEN keys in SEQ
are took into account.
Postfixes are handled only if the optional argument POSTFIX is non-nil."
(or skkdic-okuri-nasi
(condition-case err
(load-library "skk/skkdic")
(error (ding)
(with-output-to-temp-buffer "*Help*"
(princ "The library `skkdic' can't be loaded.
The most common case is that you have not yet installed the library
included in LEIM (Libraries of Emacs Input Method) which is
distributed separately from Emacs.
LEIM is available from the same ftp directory as Emacs."))
(signal (car err) (cdr err)))))
(let ((vec (make-vector len 0))
(i 0)
entry)
;; At first, generate vector VEC from SEQ for looking up SKK
;; alists. Nth element in VEC corresponds to Nth element in SEQ.
;; The values are decided as follows.
;; If SEQ[N] is `$B!<(B', VEC[N] is 0,
;; Else if SEQ[N] is a Hiragana character, VEC[N] is:
;; ((The 2nd position code o SEQ[N]) - 32),
;; ELse VEC[N] is 128.
(while (< i len)
(let ((ch (aref seq i))
elts)
(if (= ch ?$B!<(B)
(aset vec i 0)
(setq elts (split-char ch))
(if (and (eq (car elts) 'japanese-jisx0208)
(= (nth 1 elts) skkdic-jisx0208-hiragana-block))
(aset vec i (- (nth 2 elts) 32))
(aset vec i 128))))
(setq i (1+ i)))
;; Search OKURI-NASI entries.
(setq entry (lookup-nested-alist vec skkdic-okuri-nasi len 0 t))
(if (consp (car entry))
(setq entry (copy-sequence (car entry)))
(setq entry nil))
(if postfix
;; Search OKURI-NASI entries with postfixes.
(let ((break (max (- len (car skkdic-postfix)) 1))
entry-head entry-postfix entry2)
(while (< break len)
(if (and (setq entry-head
(lookup-nested-alist vec skkdic-okuri-nasi
break 0 t))
(consp (car entry-head))
(setq entry-postfix
(lookup-nested-alist vec skkdic-postfix
len break t))
(consp (car entry-postfix))
(setq entry2 (skkdic-merge-head-and-tail
(car entry-head) (car entry-postfix) t)))
(if entry
(nconc entry entry2)
(setq entry entry2)))
(setq break (1+ break)))))
;; Search OKURI-NASI entries with prefixes.
(let ((break (min (car skkdic-prefix) (- len 2)))
entry-prefix entry-tail entry2)
(while (> break 0)
(if (and (setq entry-prefix
(lookup-nested-alist vec skkdic-prefix break 0 t))
(consp (car entry-prefix))
(setq entry-tail
(lookup-nested-alist vec skkdic-okuri-nasi len break t))
(consp (car entry-tail))
(setq entry2 (skkdic-merge-head-and-tail
(car entry-prefix) (car entry-tail) nil)))
(if entry
(nconc entry entry2)
(setq entry entry2)))
(setq break (1- break))))
;; Search OKURI-ARI entries.
(let ((okurigana (assq (aref seq (1- len)) skkdic-okurigana-table))
orig-element entry2)
(if okurigana
(progn
(setq orig-element (aref vec (1- len)))
(aset vec (1- len) (- (cdr okurigana)))
(if (and (setq entry2 (lookup-nested-alist vec skkdic-okuri-ari
len 0 t))
(consp (car entry2)))
(progn
(setq entry2 (copy-sequence (car entry2)))
(let ((l entry2)
(okuri (char-to-string (aref seq (1- len)))))
(while l
(setcar l (concat (car l) okuri))
(setq l (cdr l)))
(if entry
(nconc entry entry2)
(setq entry entry2)))))
(aset vec (1- len) orig-element))))
entry))
;;
(provide 'skkdic-utl)
;; skkdic-utl.el ends here
This diff is collapsed.
;; china-util.el -- utilities for Chinese
;; Copyright (C) 1995 Free Software Foundation, Inc.
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
;; Keywords: mule, multilingual, Chinese
;; This file is part of GNU Emacs.
;; GNU Emacs 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.
;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Code:
;; Hz/ZW encoding stuffs
;; HZ is an encoding method for Chinese character set GB2312 used
;; widely in Internet. It is very similar to 7-bit environment of
;; ISO-2022. The difference is that HZ uses the sequence "~{" and
;; "~}" for designating GB2312 and ASCII respectively, hence, it
;; doesn't uses ESC (0x1B) code.
;; ZW is another encoding method for Chinese character set GB2312. It
;; encodes Chinese characters line by line by starting each line with
;; the sequence "zW". It also uses only 7-bit as HZ.
;; ISO-2022 escape sequence to designate GB2312.
(defvar iso2022-gb-designation "\e$A")
;; HZ escape sequence to designate GB2312.
(defvar hz-gb-designnation "~{")
;; ISO-2022 escape sequence to designate ASCII.
(defvar iso2022-ascii-designation "\e(B")
;; HZ escape sequence to designate ASCII.
(defvar hz-ascii-designnation "~}")
;; Regexp of ZW sequence to start GB2312.
(defvar zw-start-gb "^zW")
;; Regexp for start of GB2312 in an encoding mixture of HZ and ZW.
(defvar hz/zw-start-gb (concat hz-gb-designnation "\\|" zw-start-gb))
(defvar decode-hz-line-continuation nil
"Flag to tell if we should care line continuation convention of Hz.")
;;;###autoload
(defun decode-hz-region (beg end)
"Decode HZ/ZW encoded text in the current region.
Return the length of resulting text."
(interactive "r")
(save-excursion
(save-restriction
(narrow-to-region beg end)
;; We, at first, convert HZ/ZW to `coding-system-iso-2022-7',
;; then decode it.
;; "~\n" -> "\n"
(goto-char (point-min))
(while (search-forward "~" nil t)
(if (= (following-char) ?\n) (delete-char -1))
(if (not (eobp)) (forward-char 1)))
;; "^zW...\n" -> Chinese GB2312
;; "~{...~}" -> Chinese GB2312
(goto-char (point-min))
(let ((chinese-found nil))
(while (re-search-forward hz/zw-start-gb nil t)
(if (= (char-after (match-beginning 0)) ?z)
;; ZW -> coding-system-iso-20227-7
(progn
(delete-char -2)
(insert iso2022-gb-designation)
(end-of-line)
(insert iso2022-ascii-designation))
;; HZ -> coding-system-iso-20227-7
(delete-char -2)
(insert iso2022-gb-designation)
(let ((pos (save-excursion (end-of-line) (point))))
(if (search-forward hz-ascii-designnation pos t)
(replace-match iso2022-ascii-designation)
(if (not decode-hz-line-continuation)
(insert iso2022-ascii-designation)))))
(setq chinese-found t))
(if (or chinese-found
(let ((enable-multibyte-characters nil))
;; Here we check if the text contains EUC (China) codes.
;; If any, we had better decode them also.
(goto-char (point-min))
(re-search-forward "[\240-\377]" nil t)))
(decode-coding-region (point-min) (point-max)
'coding-system-euc-china)))
;; "~~" -> "~"