code.delx.au - gnu-emacs/blob - lisp/international/titdic-cnv.el

   1 ;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package
   2
   3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
   4 ;; Licensed to the Free Software Foundation.
   5
   6 ;; Keywords: Quail, TIT, cxterm
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Comments:
  26
  27 ;; Convert cxterm dictionary (of TIT format) to quail-package.
  28 ;;
  29 ;; Usage (within Emacs):
  30 ;;      M-x titdic-convert<CR>CXTERM-DICTIONARY-NAME<CR>
  31 ;; Usage (from shell):
  32 ;;      % emacs -batch -l titdic-cnv -f batch-titdic-convert\
  33 ;;              [-dir DIR] [DIR | FILE] ...
  34 ;;
  35 ;; When you run titdic-convert within Emacs, you have a chance to
  36 ;; modify arguments of `quail-define-package' before saving the
  37 ;; converted file.  For instance, you are likely to modify TITLE,
  38 ;; DOCSTRING, and KEY-BINDINGS.
  39
  40 ;; Cxterm dictionary file (*.tit) is a line-oriented text (English,
  41 ;; Chinese, Japanese, and Korean) file.  The whole file contains of
  42 ;; two parts, the definition part (`header' here after) followed by
  43 ;; the dictionary part (`body' here after).  All lines begin with
  44 ;; leading '#' are ignored.
  45 ;;
  46 ;; Each line in the header part has two fields, KEY and VALUE.  These
  47 ;; fields are separated by one or more white characters.
  48 ;;
  49 ;; Each line in the body part has two fields, KEYSEQ and TRANSLATIONS.
  50 ;; These fields are separated by one or more white characters.
  51 ;;
  52 ;; See the manual page of `tit2cit' of cxterm distribution for more
  53 ;; detail.
  54
  55 ;;; Code:
  56
  57 (require 'quail)
  58
  59 ;; List of values of key "ENCODE:" and the corresponding Emacs
  60 ;; coding-system and language environment name.
  61 (defvar tit-encode-list
  62   '(("GB" euc-china "Chinese-GB")
  63     ("BIG5" cn-big5 "Chinese-BIG5")
  64     ("JIS" euc-japan "Japanese")
  65     ("KS" euc-kr "Korean")))
  66
  67 ;; List of package names and the corresponding titles.
  68 (defvar quail-cxterm-package-title-alist
  69   '(("chinese-4corner" . "\e$(0(?-F\e(B")
  70     ("chinese-array30" . "\e$(0#R#O\e(B")
  71     ("chinese-ccdospy" . "\e$AKuF4\e(B")
  72     ("chinese-ctlau" . "\e$AAuTA\e(B")
  73     ("chinese-ctlaub" . "\e$(0N,Gn\e(B")
  74     ("chinese-ecdict" . "\e$(05CKH\e(B")
  75     ("chinese-etzy" . "\e$(06/0D\e(B")
  76     ("chinese-punct-b5" . "\e$(0O:\e(BB")
  77     ("chinese-punct" . "\e$A1j\e(BG")
  78     ("chinese-py-b5" . "\e$(03<\e(BB")
  79     ("chinese-py" . "\e$AF4\e(BG")
  80     ("chinese-qj-b5" . "\e$(0)A\e(BB")
  81     ("chinese-qj" . "\e$AH+\e(BG")
  82     ("chinese-sw" . "\e$AJWN2\e(B")
  83     ("chinese-tonepy" . "\e$A5wF4\e(B")
  84     ("chinese-ziranma" . "\e$AK+F4\e(B")
  85     ("chinese-zozy" . "\e$(0I\0D\e(B")))
  86
  87 ;; Return a value of the key in the current line.
  88 (defsubst tit-read-key-value ()
  89   (if (looking-at "[^ \t\n]+")
  90       (car (read-from-string (concat "\"" (match-string 0) "\"")))))
  91
  92 ;; Return an appropriate quail-package filename from FILENAME (TIT
  93 ;; dictionary filename).  For instance, ".../ZOZY.tit" -> "ZOZY.el".
  94 (defun tit-make-quail-package-file-name (filename &optional dirname)
  95   (expand-file-name
  96    (concat (file-name-nondirectory (substring filename 0 -4)) ".el")
  97    dirname))
  98
  99 ;; This value is t if we are processing phrase dictionary.
 100 (defvar tit-phrase nil)
 101 (defvar tit-encode nil)
 102 (defvar tit-default-encode "GB")
 103
 104 ;; Generate elements of KEY-BINDINGS arg for `quail-define-package' so
 105 ;; that each characters in KEYS invokes FUNCTION-SYMBOL.
 106 (defun tit-generate-key-bindings (keys function-symbol)
 107   (let ((len (length keys))
 108         (i 0)
 109         key)
 110     (while (< i len)
 111       (setq key (aref keys i))
 112       (indent-to 3)
 113       (if (< key ?\ )
 114           (if (eq (lookup-key quail-translation-keymap (char-to-string key))
 115                   'quail-execute-non-quail-command)
 116               (insert (format "(\"\\C-%c\" . %s)\n"
 117                               (+ key ?@) function-symbol)))
 118         (if (< key 127)
 119             (insert (format "(\"%c\" . %s)\n" key function-symbol))
 120           (insert (format "(\"\\C-?\" . %s)\n" function-symbol))))
 121       (setq i (1+ i)))))
 122
 123 ;; Analyze header part of TIT dictionary and generate an appropriate
 124 ;; `quail-define-package' function call.
 125 (defun tit-process-header (filename)
 126   (message "Processing header part...")
 127   (goto-char (point-min))
 128
 129   (let (;; TIT keywords and the corresponding default values.
 130         (tit-multichoice t)
 131         (tit-prompt "")
 132         (tit-comments nil)
 133         (tit-backspace "\010\177")
 134         (tit-deleteall "\015\025")
 135         (tit-moveright ".>")
 136         (tit-moveleft ",<")
 137         (tit-keyprompt nil))
 138     ;; At first, collect information from the header.
 139     (while (not (eobp))
 140       (insert ";; ")
 141       (let ((ch (following-char)))
 142         (cond ((= ch ?C)                ; COMMENT
 143                (cond ((looking-at "COMMENT")
 144                       (let ((pos (match-end 0)))
 145                         (end-of-line)
 146                         (while (re-search-backward "[\"\\]" pos t)
 147                           (insert "\\")
 148                           (forward-char -1))
 149                         (end-of-line)
 150                         (setq tit-comments (cons (buffer-substring pos (point))
 151                                                  tit-comments))))))
 152               ((= ch ?M)                ; MULTICHOICE, MOVERIGHT, MOVELEFT
 153                (cond ((looking-at "MULTICHOICE:[ \t]*")
 154                       (goto-char (match-end 0))
 155                       (setq tit-multichoice (looking-at "YES")))
 156                      ((looking-at "MOVERIGHT:[ \t]*")
 157                       (goto-char (match-end 0))
 158                       (setq tit-moveright (tit-read-key-value)))
 159                      ((looking-at "MOVELEFT:[ \t]*")
 160                       (goto-char (match-end 0))
 161                       (setq tit-moveleft (tit-read-key-value)))))
 162               ((= ch ?P)                ; PROMPT
 163                (cond ((looking-at "PROMPT:[ \t]*")
 164                       (goto-char (match-end 0))
 165                       (setq tit-prompt (tit-read-key-value)))))
 166               ((= ch ?B)                ; BACKSPACE, BEGINDICTIONARY,
 167                                         ; BEGINPHRASE
 168                (cond ((looking-at "BACKSPACE:[ \t]*")
 169                       (goto-char (match-end 0))
 170                       (setq tit-backspace (tit-read-key-value)))
 171                      ((looking-at "BEGINDICTIONARY")
 172                       (setq tit-phrase nil))
 173                      ((looking-at "BEGINPHRASE")
 174                       (setq tit-phrase t))))
 175               ((= ch ?K)                ; KEYPROMPT
 176                (cond ((looking-at "KEYPROMPT(\\(.*\\)):[ \t]*")
 177                       (let ((key-char (match-string 1)))
 178                         (goto-char (match-end 0))
 179                         (setq tit-keyprompt
 180                               (cons (cons key-char (tit-read-key-value))
 181                                     tit-keyprompt))))))))
 182       (forward-line 1))
 183
 184     ;; Then, generate header part of the Quail package.
 185     (goto-char (point-min))
 186     (let ((package
 187            (concat
 188             "chinese-"
 189             (substring (downcase (file-name-nondirectory buffer-file-name))
 190                        0 -3))))
 191       (insert ";; Quail package `"
 192               package
 193               "' generated by the command `titdic-convert'\n"
 194               ";;\tDate: " (current-time-string) "\n"
 195               ";;\tOriginal TIT dictionary file: "
 196               (file-name-nondirectory filename)
 197               "\n\n"
 198               ";;; Comment:\n\n"
 199               ";; Do byte-compile this file again after any modification.\n\n"
 200               ";;; Start of the header of original TIT dictionary.\n\n")
 201
 202       (goto-char (point-max))
 203       (insert "\n"
 204               ";;; End of the header of original TIT dictionary.\n\n"
 205               ";;; Code:\n\n"
 206               "(require 'quail)\n\n")
 207
 208       (insert "(quail-define-package ")
 209       ;; Args NAME, LANGUAGE, TITLE
 210       (let ((title (cdr (assoc package quail-cxterm-package-title-alist))))
 211         (insert
 212          "\""
 213          package
 214          "\" \"" (nth 2 (assoc tit-encode tit-encode-list))
 215          "\" \""
 216          (or title
 217              (if (string-match "[:\e$A!K\e$(0!(!J\e(B]+\\([^:\e$A!K\e$(0!(!K\e(B]+\\)" tit-prompt)
 218                  (substring tit-prompt (match-beginning 1) (match-end 1))
 219                tit-prompt))
 220          "\"\n"))
 221       )
 222
 223     ;; Arg GUIDANCE
 224     (if tit-keyprompt
 225         (progn
 226           (insert " '(")
 227           (while tit-keyprompt
 228             (indent-to 3)
 229             (insert (format "(%d . \"%s\")\n"
 230                             (string-to-char (car (car tit-keyprompt)))
 231                             (cdr (car tit-keyprompt))))
 232             (setq tit-keyprompt (cdr tit-keyprompt)))
 233           (forward-char -1)
 234           (insert ")")
 235           (forward-char 1))
 236       (insert " t\n"))
 237
 238     ;; Arg DOCSTRING
 239     (insert "\"" tit-prompt "\n")
 240     (let ((l (nreverse tit-comments)))
 241       (while l
 242         (insert (format "%s\n" (car l)))
 243         (setq l (cdr l))))
 244     (insert "\"\n")
 245
 246     ;; Arg KEY-BINDINGS
 247     (insert " '(")
 248     (tit-generate-key-bindings tit-backspace 'quail-delete-last-char)
 249     (tit-generate-key-bindings tit-deleteall 'quail-abort-translation)
 250     (tit-generate-key-bindings tit-moveright 'quail-next-translation)
 251     (tit-generate-key-bindings tit-moveleft 'quail-prev-translation)
 252     (forward-char -1)
 253     (insert ")")
 254     (forward-char 1)
 255
 256     ;; Args FORGET-TRANSLATION, DETERMINISTIC, KBD-TRANSLATE, SHOW-LAYOUT.
 257     ;; The remaining args are all nil.
 258     (insert " nil"
 259             (if tit-multichoice " nil" " t")
 260             (if tit-keyprompt " t t)\n\n" " nil nil)\n\n")))
 261
 262   ;; Return the position of end of the header.
 263   (point-max))
 264
 265 ;; Convert body part of TIT dictionary into `quail-define-rules'
 266 ;; function call.
 267 (defun tit-process-body ()
 268   (message "Formatting translation rules...")
 269   (let ((enable-multibyte-characters nil)
 270         (keyseq "\000")
 271         pos)
 272     (insert "(quail-define-rules\n")
 273     (while (null (eobp))
 274       (if (or (= (following-char) ?#) (= (following-char) ?\n))
 275           (progn
 276             (insert ";; ")
 277             (forward-line 1))
 278         (insert "(\"")
 279         (setq pos (point))
 280         (skip-chars-forward "^ \t")
 281         (setq keyseq
 282               (concat (regexp-quote (buffer-substring pos (point))) "[ \t]+"))
 283         (save-excursion
 284           (while (re-search-backward "[\\\"]" pos t)
 285             (insert "\\")
 286             (forward-char -1)))
 287         (insert "\"")
 288         (skip-chars-forward " \t")
 289
 290         ;; Now point is at the start of translations.  Remember it in
 291         ;; POS and combine lines of the same key sequence while
 292         ;; deleting trailing white spaces and  comments (start with
 293         ;; '#').  POS doesn't has to be a marker because we never
 294         ;; modify region before POS.
 295         (setq pos (point))
 296         (if (looking-at "[^ \t]*\\([ \t]*#.*\\)")
 297             (delete-region (match-beginning 1) (match-end 1)))
 298         (while (and (= (forward-line 1) 0)
 299                     (looking-at keyseq))
 300           (let ((p (match-end 0)))
 301             (skip-chars-backward " \t\n")
 302             (delete-region (point) p)
 303             (if tit-phrase (insert " "))
 304             (if (looking-at "[^ \t]*\\([ \t]*#.*\\)")
 305                 (delete-region (match-beginning 1) (match-end 1)))
 306             ))
 307
 308         (goto-char pos)
 309         (if (eolp)
 310             ;; This entry contains no translations.  Let's ignore it.
 311             (progn
 312               (beginning-of-line)
 313               (setq pos (point))
 314               (forward-line 1)
 315               (delete-region pos (point)))
 316
 317           ;; Modify the current line to meet the syntax of Quail package.
 318           (if tit-phrase
 319               (progn
 320                 ;; PHRASE1 PHRASE2 ... => ["PHRASE1" "PHRASE2" ...]
 321                 (insert "[\"")
 322                 (skip-chars-forward "^ \t\n")
 323                 (while (not (eolp))
 324                   (insert "\"")
 325                   (forward-char 1)
 326                   (insert "\"")
 327                   (skip-chars-forward "^ \t\n"))
 328                 (insert "\"])"))
 329             ;; TRANSLATIONS => "TRANSLATIONS"
 330             (insert "\"")
 331             (end-of-line)
 332             (insert "\")"))
 333           (forward-line 1))))
 334     (insert ")\n")))
 335
 336 ;;;###autoload
 337 (defun titdic-convert (filename &optional dirname)
 338   "Convert a TIT dictionary of FILENAME into a Quail package.
 339 Optional argument DIRNAME if specified is the directory name under which
 340 the generated Quail package is saved."
 341   (interactive "FTIT dictionary file: ")
 342   (let ((buf (get-buffer-create "*tit-work*")))
 343     (save-excursion
 344       ;; Setup the buffer.
 345       (set-buffer buf)
 346       (erase-buffer)
 347       (let ((coding-system-for-read 'no-conversion))
 348         (insert-file-contents (expand-file-name filename)))
 349       (set-visited-file-name
 350        (tit-make-quail-package-file-name filename dirname) t)
 351       (set-buffer-file-coding-system 'iso-2022-7bit)
 352
 353       ;; Decode the buffer contents from the encoding specified by a
 354       ;; value of the key "ENCODE:".
 355       (let (coding-system)
 356         (save-excursion
 357           (if (search-forward "\nBEGIN" nil t)
 358               (let ((limit (point))
 359                     slot)
 360                 (goto-char 1)
 361                 (if (re-search-forward "^ENCODE:[ \t]*" limit t)
 362                     (progn
 363                       (goto-char (match-end 0))
 364                       (setq tit-encode (tit-read-key-value)))
 365                   (setq tit-encode tit-default-encode))
 366                 (setq slot (assoc tit-encode tit-encode-list))
 367                 (if slot
 368                     (setq coding-system (nth 1 slot))
 369                   (error "Invalid ENCODE: value in TIT dictionary")))
 370             (error "TIT dictionary doesn't have body part")))
 371         (message "Decoding %s..." coding-system)
 372         (goto-char 1)
 373         (decode-coding-region 1 (point-max) coding-system))
 374
 375       ;; Set point the starting position of the body part.
 376       (goto-char 1)
 377       (if (search-forward "\nBEGIN" nil t)
 378           (forward-line 1)
 379         (error "TIT dictionary can't be decoded correctly"))
 380
 381       ;; Now process the header and body parts.
 382       (goto-char
 383        (save-excursion
 384          (save-restriction
 385            (narrow-to-region 1 (point))
 386            (tit-process-header filename))))
 387       (tit-process-body))
 388
 389     (if noninteractive
 390         ;; Save the Quail package file.
 391         (save-excursion
 392           (set-buffer buf)
 393           (save-buffer 0))
 394       ;; Show the Quail package just generated.
 395       (switch-to-buffer buf)
 396       (goto-char 1)
 397       (message "Save this buffer after you make any modification"))))
 398
 399 ;;;###autoload
 400 (defun batch-titdic-convert ()
 401   "Run `titdic-convert' on the files remaining on the command line.
 402 Use this from the command line, with `-batch';
 403 it won't work in an interactive Emacs.
 404 For example, invoke \"emacs -batch -f batch-titdic-convert XXX.tit\" to
 405  generate Quail package file \"xxx.el\" from TIT dictionary file \"XXX.tit\".
 406 To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
 407   (defvar command-line-args-left)       ; Avoid compiler warning.
 408   (if (not noninteractive)
 409       (error "`batch-titdic-convert' should be used only with -batch"))
 410   (if (string= (car command-line-args-left) "-h")
 411       (progn
 412         (message "To convert XXX.tit and YYY.tit into xxx.el and yyy.el:")
 413         (message "  %% emacs -batch -l titdic-cnv -f batch-titdic-convert XXX.tit YYY.tit")
 414         (message "To convert XXX.tit into DIR/xxx.el:")
 415         (message "  %% emacs -batch -l titdic-cnv -f batch-titdic-convert -dir DIR XXX.tit"))
 416     (let (targetdir filename files file)
 417       (if (string= (car command-line-args-left) "-dir")
 418           (progn
 419             (setq command-line-args-left (cdr command-line-args-left))
 420             (setq targetdir (car command-line-args-left))
 421             (setq command-line-args-left (cdr command-line-args-left))))
 422       (while command-line-args-left
 423         (setq filename (expand-file-name (car command-line-args-left)))
 424         (if (file-directory-p filename)
 425             (progn
 426               (message "Converting all tit files in the directory %s" filename)
 427               (setq files (directory-files filename t "\\.tit$")))
 428           (setq files (list filename)))
 429         (while files
 430           (setq file (expand-file-name (car files)))
 431           (if (file-newer-than-file-p
 432                file (tit-make-quail-package-file-name file targetdir))
 433               (progn
 434                 (message "Converting %s to quail-package..." file)
 435                 (titdic-convert file targetdir)))
 436           (setq files (cdr files)))
 437         (setq command-line-args-left (cdr command-line-args-left)))
 438       (message "Do byte-compile the created files by:")
 439       (message "  %% emacs -batch -f batch-byte-compile XXX.el")))
 440   (kill-emacs 0))
 441
 442 ;;; titdic-cnv.el ends here