utils/mokuji.el

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