Mercurial > emacs
view lisp/international/titdic-cnv.el @ 25619:f25a14690a18
(Fmakehash): Accept just one optional argument TEST.
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Thu, 09 Sep 1999 14:54:28 +0000 |
parents | d08387c742bb |
children | 3ab020a4847b |
line wrap: on
line source
;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. ;; Keywords: Quail, TIT, cxterm ;; 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, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Comments: ;; Convert cxterm dictionary (of TIT format) to quail-package. ;; ;; Usage (within Emacs): ;; M-x titdic-convert<CR>CXTERM-DICTIONARY-NAME<CR> ;; Usage (from shell): ;; % emacs -batch -l titdic-cnv -f batch-titdic-convert\ ;; [-dir DIR] [DIR | FILE] ... ;; ;; When you run titdic-convert within Emacs, you have a chance to ;; modify arguments of `quail-define-package' before saving the ;; converted file. For instance, you are likely to modify TITLE, ;; DOCSTRING, and KEY-BINDINGS. ;; Cxterm dictionary file (*.tit) is a line-oriented text (English, ;; Chinese, Japanese, and Korean) file. The whole file contains of ;; two parts, the definition part (`header' here after) followed by ;; the dictionary part (`body' here after). All lines begin with ;; leading '#' are ignored. ;; ;; Each line in the header part has two fields, KEY and VALUE. These ;; fields are separated by one or more white characters. ;; ;; Each line in the body part has two fields, KEYSEQ and TRANSLATIONS. ;; These fields are separated by one or more white characters. ;; ;; See the manual page of `tit2cit' of cxterm distribution for more ;; detail. ;;; Code: (require 'quail) ;; List of values of key "ENCODE:" and the corresponding Emacs ;; coding-system and language environment name. (defvar tit-encode-list '(("GB" euc-china "Chinese-GB") ("BIG5" cn-big5 "Chinese-BIG5") ("JIS" euc-japan "Japanese") ("KS" euc-kr "Korean"))) ;; List of package names and the corresponding titles. (defvar quail-cxterm-package-title-alist '(("chinese-4corner" . "$(0(?-F(B") ("chinese-array30" . "$(0#R#O(B") ("chinese-ccdospy" . "$AKuF4(B") ("chinese-ctlau" . "$AAuTA(B") ("chinese-ctlaub" . "$(0N,Gn(B") ("chinese-ecdict" . "$(05CKH(B") ("chinese-etzy" . "$(06/0D(B") ("chinese-punct-b5" . "$(0O:(BB") ("chinese-punct" . "$A1j(BG") ("chinese-py-b5" . "$(03<(BB") ("chinese-py" . "$AF4(BG") ("chinese-qj-b5" . "$(0)A(BB") ("chinese-qj" . "$AH+(BG") ("chinese-sw" . "$AJWN2(B") ("chinese-tonepy" . "$A5wF4(B") ("chinese-ziranma" . "$AK+F4(B") ("chinese-zozy" . "$(0I\0D(B"))) ;; Return a value of the key in the current line. (defsubst tit-read-key-value () (if (looking-at "[^ \t\n]+") (car (read-from-string (concat "\"" (match-string 0) "\""))))) ;; Return an appropriate quail-package filename from FILENAME (TIT ;; dictionary filename). For instance, ".../ZOZY.tit" -> "ZOZY.el". (defun tit-make-quail-package-file-name (filename &optional dirname) (expand-file-name (concat (file-name-nondirectory (substring filename 0 -4)) ".el") dirname)) ;; This value is nil if we are processing phrase dictionary. (defconst tit-dictionary t) (defvar tit-encode nil) (defvar tit-default-encode "GB") ;; Generate elements of KEY-BINDINGS arg for `quail-define-package' so ;; that each characters in KEYS invokes FUNCTION-SYMBOL. (defun tit-generate-key-bindings (keys function-symbol) (let ((len (length keys)) (i 0) (first t) key) (while (< i len) (or first (princ "\n ")) (setq key (aref keys i)) (if (if (< key ?\ ) (eq (lookup-key quail-translation-keymap (char-to-string key)) 'quail-execute-non-quail-command) (<= key 127)) (progn (princ (cons (cond ((< key ?\ ) (format "\"\\C-%c\"" (+ key ?@))) ((< key 127) (format "\"%c\"" key)) (t "\"\\C-?\"")) function-symbol)) (setq first nil))) (setq i (1+ i))))) ;; Analyze header part of TIT dictionary and generate an appropriate ;; `quail-define-package' function call. (defun tit-process-header (filename) (message "Processing header part...") (goto-char (point-min)) ;; At first, generate header part of the Quail package while ;; collecting information from the original header. (let ((package (concat "chinese-" (substring (downcase (file-name-nondirectory filename)) 0 -4))) ;; TIT keywords and the corresponding default values. (tit-multichoice t) (tit-prompt "") (tit-comments nil) (tit-backspace "\010\177") (tit-deleteall "\015\025") (tit-moveright ".>") (tit-moveleft ",<") (tit-keyprompt nil)) (princ ";; Quail package `") (princ package) (princ "' generated by the command `titdic-convert'\n;;\tDate: ") (princ (current-time-string)) (princ "\n;;\tOriginal TIT dictionary file: ") (princ (file-name-nondirectory filename)) (princ "\n\n;;; Comment:\n\n") (princ ";; Byte-compile this file again after any modification.\n\n") (princ ";;; Start of the header of original TIT dictionary.\n\n") (while (not (eobp)) (let ((ch (following-char)) (pos (point))) (cond ((= ch ?C) ; COMMENT (cond ((looking-at "COMMENT") (let ((pos (match-end 0))) (end-of-line) (setq tit-comments (cons (buffer-substring pos (point)) tit-comments)))))) ((= ch ?M) ; MULTICHOICE, MOVERIGHT, MOVELEFT (cond ((looking-at "MULTICHOICE:[ \t]*") (goto-char (match-end 0)) (setq tit-multichoice (looking-at "YES"))) ((looking-at "MOVERIGHT:[ \t]*") (goto-char (match-end 0)) (setq tit-moveright (tit-read-key-value))) ((looking-at "MOVELEFT:[ \t]*") (goto-char (match-end 0)) (setq tit-moveleft (tit-read-key-value))))) ((= ch ?P) ; PROMPT (cond ((looking-at "PROMPT:[ \t]*") (goto-char (match-end 0)) (setq tit-prompt (tit-read-key-value))))) ((= ch ?B) ; BACKSPACE, BEGINDICTIONARY, ; BEGINPHRASE (cond ((looking-at "BACKSPACE:[ \t]*") (goto-char (match-end 0)) (setq tit-backspace (tit-read-key-value))) ((looking-at "BEGINDICTIONARY") (setq tit-dictionary t)) ((looking-at "BEGINPHRASE") (setq tit-dictionary nil)))) ((= ch ?K) ; KEYPROMPT (cond ((looking-at "KEYPROMPT(\\(.*\\)):[ \t]*") (let ((key-char (match-string 1))) (goto-char (match-end 0)) (if (string-match "\\\\[0-9]+" key-char) (setq key-char (car (read-from-string (format "\"%s\"" key-char))))) (setq tit-keyprompt (cons (cons key-char (tit-read-key-value)) tit-keyprompt))))))) (end-of-line) (princ ";; ") (princ (buffer-substring pos (point))) (princ "\n") (forward-line 1))) (princ "\n;;; End of the header of original TIT dictionary.\n\n") (princ ";;; Code:\n\n(require 'quail)\n\n") (princ "(quail-define-package ") ;; Args NAME, LANGUAGE, TITLE (let ((title (cdr (assoc package quail-cxterm-package-title-alist)))) (princ "\"") (princ package) (princ "\" \"") (princ (nth 2 (assoc tit-encode tit-encode-list))) (princ "\" \"") (princ (or title (if (string-match "[:$A!K$(0!(!J(B]+\\([^:$A!K$(0!(!K(B]+\\)" tit-prompt) (substring tit-prompt (match-beginning 1) (match-end 1)) tit-prompt))) (princ "\"\n")) ;; Arg GUIDANCE (if tit-keyprompt (progn (princ " '(") (while tit-keyprompt (princ " ") (princ (format "(%d . \"%s\")\n" (string-to-char (car (car tit-keyprompt))) (cdr (car tit-keyprompt)))) (setq tit-keyprompt (cdr tit-keyprompt))) (princ ")")) (princ " t\n")) ;; Arg DOCSTRING (prin1 (mapconcat 'identity (cons tit-prompt (nreverse tit-comments)) "\n")) (terpri) ;; Arg KEY-BINDINGS (princ " '(") (tit-generate-key-bindings tit-backspace 'quail-delete-last-char) (princ "\n ") (tit-generate-key-bindings tit-deleteall 'quail-abort-translation) (princ "\n ") (tit-generate-key-bindings tit-moveright 'quail-next-translation) (princ "\n ") (tit-generate-key-bindings tit-moveleft 'quail-prev-translation) (princ ")\n") ;; Args FORGET-TRANSLATION, DETERMINISTIC, KBD-TRANSLATE, SHOW-LAYOUT. ;; The remaining args are all nil. (princ " nil") (princ (if tit-multichoice " nil" " t")) (princ (if tit-keyprompt " t t)\n\n" " nil nil)\n\n")))) (defsubst tit-flush-translations (key translations) (if (string-match "\\\\[0-9][0-9][0-9]" key) (let ((newkey (concat (substring key 0 (match-beginning 0)) (car (read-from-string (concat "\"" (match-string 0 key) "\""))))) (idx (match-end 0))) (while (string-match "\\\\[0-9][0-9][0-9]" key idx) (setq newkey (concat newkey (substring key idx (match-beginning 0)) (car (read-from-string (concat "\"" (match-string 0 key) "\""))))) (setq idx (match-end 0))) (setq key (concat newkey (substring key idx))))) (prin1 (list key (if tit-dictionary translations (vconcat (nreverse translations))))) (princ "\n")) ;; Convert body part of TIT dictionary into `quail-define-rules' ;; function call. (defun tit-process-body () (message "Formatting translation rules...") (let* ((template (list nil nil)) (second (cdr template)) (prev-key "") ch key translations pos) (princ "(quail-define-rules\n") (while (null (eobp)) (setq ch (following-char)) (if (or (= ch ?#) (= ch ?\n)) (forward-line 1) (setq pos (point)) (skip-chars-forward "^ \t\n") (setq key (buffer-substring pos (point))) (skip-chars-forward " \t") (setq ch (following-char)) (if (or (= ch ?#) (= ch ?\n)) ;; This entry contains no translations. Let's ignore it. (forward-line 1) (or (string= key prev-key) (progn (if translations (tit-flush-translations prev-key translations)) (setq translations nil prev-key key))) (if tit-dictionary (progn (setq pos (point)) (skip-chars-forward "^ \t#\n") (setq translations (if translations (concat translations (buffer-substring pos (point))) (buffer-substring pos (point))))) (while (not (eolp)) (setq pos (point)) (skip-chars-forward "^ \t\n") (setq translations (cons (buffer-substring pos (point)) translations)) (skip-chars-forward " \t") (setq ch (following-char)) (if (= ch ?#) (end-of-line)))) (forward-line 1)))) (if translations (tit-flush-translations prev-key translations)) (princ ")\n"))) ;;;###autoload (defun titdic-convert (filename &optional dirname) "Convert a TIT dictionary of FILENAME into a Quail package. Optional argument DIRNAME if specified is the directory name under which the generated Quail package is saved." (interactive "FTIT dictionary file: ") (with-temp-file (tit-make-quail-package-file-name filename dirname) (set-buffer-file-coding-system 'iso-2022-7bit) (let ((standard-output (current-buffer))) (with-temp-buffer (let ((coding-system-for-read 'no-conversion)) (insert-file-contents (expand-file-name filename))) (set-buffer-multibyte t) ;; Decode the buffer contents from the encoding specified by a ;; value of the key "ENCODE:". (if (not (search-forward "\nBEGIN" nil t)) (error "TIT dictionary doesn't have body part")) (let ((limit (point)) coding-system slot) (goto-char (point-min)) (if (re-search-forward "^ENCODE:[ \t]*" limit t) (progn (goto-char (match-end 0)) (setq tit-encode (tit-read-key-value))) (setq tit-encode tit-default-encode)) (setq slot (assoc tit-encode tit-encode-list)) (if (not slot) (error "Invalid ENCODE: value in TIT dictionary")) (setq coding-system (nth 1 slot)) (message "Decoding with coding system %s..." coding-system) (goto-char (point-min)) (decode-coding-region (point-min) (point-max) coding-system)) ;; Set point the starting position of the body part. (goto-char (point-min)) (if (not (search-forward "\nBEGIN" nil t)) (error "TIT dictionary can't be decoded correctly")) ;; Process the header part. (forward-line 1) (narrow-to-region (point-min) (point)) (tit-process-header filename) (widen) ;; Process the body part. For speed, we turn off multibyte facility. (with-current-buffer standard-output (set-buffer-multibyte nil)) (set-buffer-multibyte nil) (tit-process-body))))) ;;;###autoload (defun batch-titdic-convert (&optional force) "Run `titdic-convert' on the files remaining on the command line. Use this from the command line, with `-batch'; it won't work in an interactive Emacs. For example, invoke \"emacs -batch -f batch-titdic-convert XXX.tit\" to generate Quail package file \"xxx.el\" from TIT dictionary file \"XXX.tit\". To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." (defvar command-line-args-left) ; Avoid compiler warning. (if (not noninteractive) (error "`batch-titdic-convert' should be used only with -batch")) (if (string= (car command-line-args-left) "-h") (progn (message "To convert XXX.tit and YYY.tit into xxx.el and yyy.el:") (message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert XXX.tit YYY.tit") (message "To convert XXX.tit into DIR/xxx.el:") (message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert -dir DIR XXX.tit")) (let (targetdir filename files file) (if (string= (car command-line-args-left) "-dir") (progn (setq command-line-args-left (cdr command-line-args-left)) (setq targetdir (car command-line-args-left)) (setq command-line-args-left (cdr command-line-args-left)))) (while command-line-args-left (setq filename (expand-file-name (car command-line-args-left))) (if (file-directory-p filename) (progn (message "Converting all tit files in the directory %s" filename) (setq files (directory-files filename t "\\.tit$"))) (setq files (list filename))) (while files (setq file (expand-file-name (car files))) (when (or force (file-newer-than-file-p file (tit-make-quail-package-file-name file targetdir))) (message "Converting %s to quail-package..." file) (titdic-convert file targetdir)) (setq files (cdr files))) (setq command-line-args-left (cdr command-line-args-left))) (message "Byte-compile the created files by:") (message " %% emacs -batch -f batch-byte-compile XXX.el"))) (kill-emacs 0)) ;;; titdic-cnv.el ends here