sinfo.el

   1 ;;; sinfo.el --- sinfo to Texinfo converter
   2
   3 ;; Copyright (C) 1996 MORIOKA Tomohiko
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Version: $Id: sinfo.el,v 3.3 1996/11/28 13:34:51 morioka Exp $
   7 ;; Keywords: outline-mode, Texinfo, plain2
   8
   9 ;; This file is part of sinfo (SGML based info system).
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Comment:
  27
  28 ;; This program is for Emacs/mule (mule-19.33-delta) and requires
  29 ;; sgmls.
  30
  31 ;;; Code:
  32
  33 (require 'tl-list)
  34 (require 'tl-str)
  35 (require 'texinfmt)
  36 (require 'texi-util)
  37
  38 (defvar sinfo-texi-mapping-file
  39   "/usr/local/share/sgml/rep/sinfo/texi-mapping"
  40   "*SGML mapping file to convert into Texinfo.")
  41
  42 (defun sinfo-texi-swap-node ()
  43   (interactive)
  44   (goto-char (point-min))
  45   (while (re-search-forward
  46           "^\\(@\\(chapter\\|\\(sub\\)*section\\) .*\\)
  47 \\(@node .*\\)\n" nil t)
  48     (let* ((md (match-data))
  49            (nd (last md 2))
  50            (nb (car nd))
  51            (ne (second nd))
  52            )
  53       (replace-match (format "%s\n%s"
  54                              (buffer-substring nb ne)
  55                              (buffer-substring (match-beginning 0) nb)
  56                              ))
  57       )))
  58
  59 (defun sinfo-filter-for-standard ()
  60   (goto-char (point-min))
  61   (while (re-search-forward
  62           "@noindent\n\\[\\([^][]*\\)\\]\n@quotation\n\\([^,]*\\)," nil t)
  63     (let ((name (buffer-substring (match-beginning 1)(match-end 1)))
  64           (org (buffer-substring (match-beginning 2)(match-end 2)))
  65           (dest "@quotation\n")
  66           (b (match-beginning 0))
  67           )
  68       (save-restriction
  69         (and (eq (aref name 0) ?:)
  70              (eq (aref name 1) ?\ )
  71              (setq name (substring name 2))
  72              )
  73         (or (string= name "")
  74             (setq dest (concat "@noindent\n[" name "]\n" dest))
  75             )
  76         (or (string= org "")
  77             (setq dest (concat dest org ","))
  78             )
  79         (replace-match dest)
  80         (search-forward "@end quotation")
  81         (narrow-to-region b (match-beginning 0))
  82         (goto-char b)
  83         (if (search-forward " (obsolete RFC )" nil t)
  84             (replace-match "")
  85           )
  86         (goto-char b)
  87         (while (search-forward "\e$B!X!Y\e(B" nil t)
  88           (replace-match "")
  89           )
  90         (goto-char b)
  91         (while (search-forward "``''" nil t)
  92           (replace-match "")
  93           )
  94         (goto-char b)
  95         (while (re-search-forward ",[ \t\n]*," nil t)
  96           (replace-match ",")
  97           (goto-char b)
  98           )
  99         (and (re-search-forward "^,[ \t\n]*" nil t)
 100              (replace-match "")
 101              )
 102         (if (search-forward ", ." nil t)
 103             (replace-match ".")
 104           )
 105         (goto-char (point-max))
 106         (fill-paragraph nil)
 107         ))))
 108
 109 (defun sinfo-to-texi ()
 110   (interactive)
 111   (let* ((the-buf (current-buffer))
 112          (src-name (buffer-file-name))
 113          (name (file-name-non-extension src-name))
 114          (dst-name (concat name ".texi"))
 115          (fname (concat (file-name-nondirectory name) ".info"))
 116          (cs buffer-file-coding-system)
 117          status)
 118     (find-file dst-name)
 119     (erase-buffer)
 120     (insert-buffer the-buf)
 121     (goto-char (point-min))
 122     (while (re-search-forward "[@{}]" nil t)
 123       (replace-match (concat "@" (buffer-substring (match-beginning 0)
 124                                                    (match-end 0))))
 125       )
 126     (let ((coding-system-for-read 'coding-system-internal)
 127           (coding-system-for-write 'coding-system-internal)
 128           )
 129       (setq status
 130             (call-process-region (point-min)(point-max)
 131                                  "sh" t t t
 132                                  "-c"
 133                                  (format "sgmls|sgmlsasp %s"
 134                                          (expand-file-name
 135                                           sinfo-texi-mapping-file)
 136                                          )
 137                                  )
 138             )
 139       )
 140     (goto-char (point-min))
 141     (if (and (search-forward "sgmls:" nil t)
 142              (re-search-forward "line \\([0-9]+\\)" nil t)
 143              )
 144         (let ((line (string-to-number
 145                      (buffer-substring (match-beginning 1)
 146                                        (match-end 1)))
 147                     ))
 148           (progn
 149             (pop-to-buffer the-buf)
 150             (goto-line line)
 151             ))
 152       (set-buffer-file-coding-system cs)
 153       (sinfo-texi-swap-node)
 154       (let ((title
 155              (progn
 156                (goto-char (point-min))
 157                (and (re-search-forward "@title \\(.*\\)\n" nil t)
 158                     (buffer-substring (match-beginning 1)(match-end 1))
 159                     )))
 160             )
 161         (goto-char (point-min))
 162         (and (re-search-forward "@setfilename$" nil t)
 163              (replace-match
 164               (format "@setfilename %s" fname)
 165               ))
 166         (and (re-search-forward "@settitle{}" nil t)
 167              (replace-match
 168               (format "@settitle{%s}" title)
 169               ))
 170         (and (re-search-forward "@top$" nil t)
 171              (replace-match
 172               (format "@top %s" title)
 173               ))
 174         )
 175       (goto-char (point-min))
 176       (while (re-search-forward
 177               "@DREF{\\(([^{}()]*)\\)\\([^{}]+\\)}"
 178               nil t)
 179         (let ((file (buffer-substring (match-beginning 1)(match-end 1)))
 180               (word (buffer-substring (match-beginning 2)(match-end 2)))
 181               )
 182           (replace-match "")
 183           (re-search-forward "@end DREF")
 184           (replace-match
 185            (concat word " (@ref{"
 186                    (if (string= file "()")
 187                        word
 188                      (concat file word)
 189                      ) "})"))
 190           ))
 191       (goto-char (point-min))
 192       (while (re-search-forward
 193               "@AREF{\\([^{}]*\\)}{<URL:\\([^<>()]*\\)>}\n*"
 194               nil t)
 195         (let ((node (buffer-substring (match-beginning 1)(match-end 1)))
 196               (url  (buffer-substring (match-beginning 2)(match-end 2)))
 197               )
 198           (replace-match "")
 199           (re-search-forward "@end AREF")
 200           (replace-match
 201            (if (string= node "()")
 202                (concat "(" url ")")
 203              (concat "(@ref{" node "})")
 204              ))
 205           ))
 206       (sinfo-filter-for-standard)
 207       (goto-char (point-min))
 208       (while (re-search-forward "@CONCEPT{\\([^{}]+\\)}" nil t)
 209         (let ((name (buffer-substring (match-beginning 1) (match-end 1))))
 210           (replace-match (format "@cindex{%s}@strong{%s}" name name)
 211                          'fixed-case)
 212           ))
 213       (goto-char (point-min))
 214       (while (search-forward "{<URL:>}" nil t)
 215         (replace-match "")
 216         )
 217       (goto-char (point-min))
 218       (while (search-forward "@ref{()" nil t)
 219         (replace-match "@ref{")
 220         )
 221       (goto-char (point-min))
 222       (while (search-forward "@ref{}" nil t)
 223         (replace-match "")
 224         )
 225       (goto-char (point-min))
 226       (while (search-forward "@cindex{}" nil t)
 227         (replace-match "")
 228         )
 229       (goto-char (point-min))
 230       (while (re-search-forward "{@refill}" nil t)
 231         (replace-match "")
 232         (if (= (current-column) 0)
 233             (delete-char 1)
 234           ;;(fill-paragraph nil)
 235           (if (looking-at "\n\n")
 236               (insert "@refill")
 237             )
 238           (fill-paragraph nil)
 239           ))
 240       (texinfo-every-node-update)
 241       (texinfo-all-menus-update)
 242       (texinfo-all-menu-titles-update)
 243       (goto-char (point-min))
 244       )))
 245
 246
 247 ;;; @ end
 248 ;;;
 249
 250 (provide 'sinfo)
 251
 252 ;;; sinfo.el ends here