*** empty log message ***
[m17n/m17n-docs.git] / utils / mokuji.el
1 (require 'un-define)
2
3 (defconst latex-dir
4   (format "%s/latex" (nth 2 command-line-args-left)))
5
6 (defun parse-toc ()
7   (let ((sections nil)
8         section-type
9         title pos current-section current-subsection)
10     (save-excursion
11       (find-file (expand-file-name "refman.toc" latex-dir))
12       (while (re-search-forward "{\\(sub\\)*section}" nil t)
13         (goto-char (1+ (match-beginning 0)))
14         (setq section-type (intern (buffer-substring
15                                     (1+ (match-beginning 0))
16                                     (1- (match-end 0)))))
17         (re-search-forward "{[0-9.]+}")
18         (setq title (buffer-substring (1+ (match-beginning 0))
19                                       (1- (match-end 0))))
20         (narrow-to-region (point) (line-end-position))
21         (goto-char (point-max))
22         (forward-sexp -1)
23         (forward-char -1)
24         (setq title
25               (concat title " " (buffer-substring (point-min) (point))))
26         (widen)
27         (let (idx)
28           (while (setq idx (string-match "\\\\discretionary {-}{}{}" title))
29             (setq title (concat (substring title 0 idx)
30                                 (substring title (match-end 0))))))
31         (re-search-forward "[0-9]+")
32         (setq page (string-to-int (match-string 0)))
33         (cond ((eq section-type 'section)
34                (setq current-section (list title page)) 
35                (setq sections
36                      (nconc sections (list current-section)))
37                (setq current-subsection nil current-subsubsection nil))
38               ((eq section-type 'subsection)
39                (setq current-subsection (list title page))
40                (setq current-section
41                      (nconc current-section (list current-subsection)))
42                (setq current-subsubsection nil))
43               (t
44                (setq current-subsubsection (list title page))
45                (setq current-subsection
46                      (nconc current-subsection (list current-subsubsection)))
47                )))
48       sections)))
49
50 (defun insert-one-line (elt)
51   (insert
52    (format "[ /Count %d /Page %d/View [/XYZ null null 1.0]/Title ("
53            (length (nthcdr 2 elt)) (+ (nth 1 elt) 4)))
54   (let* ((str (encode-coding-string (car elt) 'utf-16-be-dos))
55          (len (length str))
56          (i 0))
57     (while (< i len)
58       (insert (format "\\%03o" (aref str i)))
59       (setq i (1+ i))))
60   (insert ") /OUT pdfmark\n"))
61
62 (defun write-mokuji ()
63   (let ((l (parse-toc)) elt)
64     (with-temp-file (expand-file-name "mokuji.ps" latex-dir)
65       (set-buffer-multibyte nil)
66       (insert "%!PS-Adobe 3.0
67 %%BeginProlog
68 /bd {bind def} bind def /fsd {findfont exch scalefont def} bd /sms {setfont moveto show} bd /ms {moveto show} bd systemdict /pdfmark known not {userdict /pdfmark systemdict /cleartomark get put } if
69 %%EndProlog
70 %%BeginSetup
71 ")
72       (while l
73         (setq elt (car l) l (cdr l))
74         (insert-one-line elt)
75         (let ((ll (nthcdr 2 elt)) ee)
76           (while ll
77             (setq ee (car ll) ll (cdr ll))
78             (insert-one-line ee)
79             (let ((lll (nthcdr 2 ee)) eee)
80               (while lll
81                 (setq eee (car lll) lll (cdr lll))
82                 (insert-one-line eee))))))
83       (insert "%%EOF\n"))))