(concat (file-name-nondirectory (substring filename 0 -4)) ".el")
dirname))
-;; This value is t if we are processing phrase dictionary.
-(defvar tit-phrase nil)
+;; This value is nil if we are processing phrase dictionary.
+(defconst tit-dictionary t)
(defvar tit-encode nil)
(defvar tit-default-encode "GB")
(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))
- (indent-to 3)
- (if (< key ?\ )
- (if (eq (lookup-key quail-translation-keymap (char-to-string key))
+ (if (if (< key ?\ )
+ (eq (lookup-key quail-translation-keymap
+ (char-to-string key))
'quail-execute-non-quail-command)
- (insert (format "(\"\\C-%c\" . %s)\n"
- (+ key ?@) function-symbol)))
- (if (< key 127)
- (insert (format "(\"%c\" . %s)\n" key function-symbol))
- (insert (format "(\"\\C-?\" . %s)\n" function-symbol))))
+ (<= 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
(message "Processing header part...")
(goto-char (point-min))
- (let (;; TIT keywords and the corresponding default values.
+ ;; 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-moveright ".>")
(tit-moveleft ",<")
(tit-keyprompt nil))
- ;; At first, collect information from the header.
+
+ (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 ";; Do byte-compile this file again after any modification.\n\n")
+ (princ ";;; Start of the header of original TIT dictionary.\n\n")
+
(while (not (eobp))
- (insert ";; ")
- (let ((ch (following-char)))
+ (let ((ch (following-char))
+ (pos (point)))
(cond ((= ch ?C) ; COMMENT
(cond ((looking-at "COMMENT")
(let ((pos (match-end 0)))
(end-of-line)
- (while (re-search-backward "[\"\\]" pos t)
- (insert "\\")
- (forward-char -1))
- (end-of-line)
(setq tit-comments (cons (buffer-substring pos (point))
tit-comments))))))
((= ch ?M) ; MULTICHOICE, MOVERIGHT, MOVELEFT
(goto-char (match-end 0))
(setq tit-backspace (tit-read-key-value)))
((looking-at "BEGINDICTIONARY")
- (setq tit-phrase nil))
+ (setq tit-dictionary t))
((looking-at "BEGINPHRASE")
- (setq tit-phrase t))))
+ (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))))))))
- (forward-line 1))
+ tit-keyprompt)))))))
+ (end-of-line)
+ (princ ";; ")
+ (princ (buffer-substring pos (point)))
+ (princ "\n")
+ (forward-line 1)))
- ;; Then, generate header part of the Quail package.
- (goto-char (point-min))
- (let ((package
- (concat
- "chinese-"
- (substring (downcase (file-name-nondirectory buffer-file-name))
- 0 -3))))
- (insert ";; Quail package `"
- package
- "' generated by the command `titdic-convert'\n"
- ";;\tDate: " (current-time-string) "\n"
- ";;\tOriginal TIT dictionary file: "
- (file-name-nondirectory filename)
- "\n\n"
- ";;; Comment:\n\n"
- ";; Do byte-compile this file again after any modification.\n\n"
- ";;; Start of the header of original TIT dictionary.\n\n")
-
- (goto-char (point-max))
- (insert "\n"
- ";;; End of the header of original TIT dictionary.\n\n"
- ";;; Code:\n\n"
- "(require 'quail)\n\n")
-
- (insert "(quail-define-package ")
- ;; Args NAME, LANGUAGE, TITLE
- (let ((title (cdr (assoc package quail-cxterm-package-title-alist))))
- (insert
- "\""
- package
- "\" \"" (nth 2 (assoc tit-encode tit-encode-list))
- "\" \""
- (or title
- (if (string-match "[:\e$A!K\e$(0!(!J\e(B]+\\([^:\e$A!K\e$(0!(!K\e(B]+\\)" tit-prompt)
- (substring tit-prompt (match-beginning 1) (match-end 1))
- tit-prompt))
- "\"\n"))
- )
+ (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 "[:\e$A!K\e$(0!(!J\e(B]+\\([^:\e$A!K\e$(0!(!K\e(B]+\\)" tit-prompt)
+ (substring tit-prompt (match-beginning 1) (match-end 1))
+ tit-prompt)))
+ (princ "\"\n"))
;; Arg GUIDANCE
(if tit-keyprompt
(progn
- (insert " '(")
+ (princ " '(")
(while tit-keyprompt
- (indent-to 3)
- (insert (format "(%d . \"%s\")\n"
- (string-to-char (car (car tit-keyprompt)))
- (cdr (car 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)))
- (forward-char -1)
- (insert ")")
- (forward-char 1))
- (insert " t\n"))
+ (princ ")"))
+ (princ " t\n"))
;; Arg DOCSTRING
- (insert "\"" tit-prompt "\n")
- (let ((l (nreverse tit-comments)))
- (while l
- (insert (format "%s\n" (car l)))
- (setq l (cdr l))))
- (insert "\"\n")
+ (prin1
+ (mapconcat 'identity (cons tit-prompt (nreverse tit-comments)) "\n"))
+ (terpri)
;; Arg KEY-BINDINGS
- (insert " '(")
+ (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)
- (forward-char -1)
- (insert ")")
- (forward-char 1)
+ (princ ")\n")
;; Args FORGET-TRANSLATION, DETERMINISTIC, KBD-TRANSLATE, SHOW-LAYOUT.
;; The remaining args are all nil.
- (insert " nil"
- (if tit-multichoice " nil" " t")
- (if tit-keyprompt " t t)\n\n" " nil nil)\n\n")))
-
- ;; Return the position of end of the header.
- (point-max))
+ (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 ((enable-multibyte-characters nil)
- (keyseq "\000")
- pos)
- (insert "(quail-define-rules\n")
+ (let* ((template (list nil nil))
+ (second (cdr template))
+ (prev-key "")
+ ch key translations pos)
+ (princ "(quail-define-rules\n")
(while (null (eobp))
- (if (or (= (following-char) ?#) (= (following-char) ?\n))
- (progn
- (insert ";; ")
- (forward-line 1))
- (insert "(\"")
+ (setq ch (following-char))
+ (if (or (= ch ?#) (= ch ?\n))
+ (forward-line 1)
(setq pos (point))
- (skip-chars-forward "^ \t")
- (setq keyseq
- (concat (regexp-quote (buffer-substring pos (point))) "[ \t]+"))
- (save-excursion
- (while (re-search-backward "[\\\"]" pos t)
- (insert "\\")
- (forward-char -1)))
- (insert "\"")
+ (skip-chars-forward "^ \t\n")
+ (setq key (buffer-substring pos (point)))
(skip-chars-forward " \t")
-
- ;; Now point is at the start of translations. Remember it in
- ;; POS and combine lines of the same key sequence while
- ;; deleting trailing white spaces and comments (start with
- ;; '#'). POS doesn't has to be a marker because we never
- ;; modify region before POS.
- (setq pos (point))
- (if (looking-at "[^ \t]*\\([ \t]*#.*\\)")
- (delete-region (match-beginning 1) (match-end 1)))
- (while (and (= (forward-line 1) 0)
- (looking-at keyseq))
- (let ((p (match-end 0)))
- (skip-chars-backward " \t\n")
- (delete-region (point) p)
- (if tit-phrase (insert " "))
- (if (looking-at "[^ \t]*\\([ \t]*#.*\\)")
- (delete-region (match-beginning 1) (match-end 1)))
- ))
-
- (goto-char pos)
- (if (eolp)
+ (setq ch (following-char))
+ (if (or (= ch ?#) (= ch ?\n))
;; This entry contains no translations. Let's ignore it.
- (progn
- (beginning-of-line)
- (setq pos (point))
- (forward-line 1)
- (delete-region pos (point)))
-
- ;; Modify the current line to meet the syntax of Quail package.
- (if tit-phrase
+ (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
- ;; PHRASE1 PHRASE2 ... => ["PHRASE1" "PHRASE2" ...]
- (insert "[\"")
- (skip-chars-forward "^ \t\n")
- (while (not (eolp))
- (insert "\"")
- (forward-char 1)
- (insert "\"")
- (skip-chars-forward "^ \t\n"))
- (insert "\"])"))
- ;; TRANSLATIONS => "TRANSLATIONS"
- (insert "\"")
- (end-of-line)
- (insert "\")"))
+ (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))))
- (insert ")\n")))
+
+ (if translations
+ (tit-flush-translations prev-key translations))
+ (princ ")\n")))
;;;###autoload
(defun titdic-convert (filename &optional dirname)
Optional argument DIRNAME if specified is the directory name under which
the generated Quail package is saved."
(interactive "FTIT dictionary file: ")
- (let ((buf (get-buffer-create "*tit-work*")))
- (save-excursion
- ;; Setup the buffer.
- (set-buffer buf)
- (erase-buffer)
- (let ((coding-system-for-read 'no-conversion))
- (insert-file-contents (expand-file-name filename)))
- (set-visited-file-name
- (tit-make-quail-package-file-name filename dirname) t)
- (set-buffer-file-coding-system 'iso-2022-7bit)
-
- ;; Decode the buffer contents from the encoding specified by a
- ;; value of the key "ENCODE:".
- (let (coding-system)
- (save-excursion
- (if (search-forward "\nBEGIN" nil t)
- (let ((limit (point))
- slot)
- (goto-char 1)
- (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 slot
- (setq coding-system (nth 1 slot))
- (error "Invalid ENCODE: value in TIT dictionary")))
- (error "TIT dictionary doesn't have body part")))
- (message "Decoding %s..." coding-system)
- (goto-char 1)
- (decode-coding-region 1 (point-max) coding-system))
-
- ;; Set point the starting position of the body part.
- (goto-char 1)
- (if (search-forward "\nBEGIN" nil t)
- (forward-line 1)
- (error "TIT dictionary can't be decoded correctly"))
-
- ;; Now process the header and body parts.
- (goto-char
- (save-excursion
- (save-restriction
- (narrow-to-region 1 (point))
- (tit-process-header filename))))
- (tit-process-body))
-
- (if noninteractive
- ;; Save the Quail package file.
- (save-excursion
- (set-buffer buf)
- (save-buffer 0))
- ;; Show the Quail package just generated.
- (switch-to-buffer buf)
- (goto-char 1)
- (message "Save this buffer after you make any modification"))))
+ (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 by %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 ()
+(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.
(setq files (list filename)))
(while files
(setq file (expand-file-name (car files)))
- (if (file-newer-than-file-p
- file (tit-make-quail-package-file-name file targetdir))
- (progn
- (message "Converting %s to quail-package..." file)
- (titdic-convert file targetdir)))
+ (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 "Do byte-compile the created files by:")