Many codes re-written to adjust for

character-base positioning and for speed up by using
with-temp-file, with-temp-buffer, and princ.

1 files changed, 177 insertions, 204 deletions

diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el
index ce5890f34ae..450400af021 100644
--- a/lisp/international/titdic-cnv.el
+++ b/lisp/international/titdic-cnv.el
@@ -96,8 +96,8 @@
    (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")
 
@@ -106,18 +106,22 @@
 (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
@@ -126,7 +130,13 @@
   (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)
@@ -135,18 +145,24 @@
         (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
@@ -169,9 +185,9 @@
                       (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)))
@@ -182,162 +198,132 @@
                                                                  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 "[:$A!K$(0!(!J(B]+\\([^:$A!K$(0!(!K(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 "[:$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
-          (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 ((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
-          ;; Escape `"' and `\' which is not used for quoting the
-          ;; following octal digits.
-          (while (re-search-backward "\"\\|\\\\[^0-9]" 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
-                ;; PHRASE1 PHRASE2 ... => ["PHRASE1" "PHRASE2" ...]
-                (insert "[")
-                (skip-chars-forward " \t")
-                (while (not (eolp))
-                  (insert "\"")
-                  (skip-chars-forward "^ \t\n")
-                  (insert "\"")
-                  (skip-chars-forward " \t"))
-                (insert "])"))
-            ;; TRANSLATIONS => "TRANSLATIONS"
-            (insert "\"")
-            (end-of-line)
-            (skip-chars-backward " \t")
-            (insert "\")"))
+                (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))))
-    (insert ")\n")))
+
+    (if translations
+        (tit-flush-translations prev-key translations))
+    (princ ")\n")))
 
 ;;;###autoload
 (defun titdic-convert (filename &optional dirname)
@@ -345,63 +331,50 @@
 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)
-      (setq enable-multibyte-characters 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)))
+        (setq enable-multibyte-characters 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 (&optional force)