sinfo.el

   1 ;;; sinfo.el --- sinfo to Texinfo converter
   2
   3 ;; Copyright (C) 1996,1997 MORIOKA Tomohiko
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Version: $Id: sinfo.el,v 3.7 1997/01/31 13:46:10 morioka Exp $
   7 ;; Keywords: SGML, Texinfo
   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 GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; 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 'texinfmt)
  34 (require 'texi-util)
  35 (require 'emu)
  36
  37 (defun-maybe file-name-non-extension (filename)
  38   (if (string-match "\\.[^.]+$" filename)
  39       (substring filename 0 (match-beginning 0))
  40     filename))
  41
  42 (defvar sinfo-texi-mapping-file
  43   "/usr/local/share/sgml/rep/sinfo/texi-mapping"
  44   "*SGML mapping file to convert into Texinfo.")
  45
  46 (defvar sinfo-html-mapping-file
  47   "/usr/local/share/sgml/rep/sinfo/html-mapping"
  48   "*SGML mapping file to convert into HTML.")
  49
  50 (defun sinfo-texi-swap-node ()
  51   (interactive)
  52   (goto-char (point-min))
  53   (while (re-search-forward
  54           "^\\(@\\(chapter\\|\\(sub\\)*section\\) .*\\)
  55 \\(@node .*\\)\n" nil t)
  56     (let* ((md (match-data))
  57            (nd (last md 2))
  58            (nb (car nd))
  59            (ne (cadr nd))
  60            )
  61       (replace-match (format "%s\n%s"
  62                              (buffer-substring nb ne)
  63                              (buffer-substring (match-beginning 0) nb)
  64                              ))
  65       )))
  66
  67 (defun sinfo-filter-for-standard ()
  68   (goto-char (point-min))
  69   (while (re-search-forward
  70           "@noindent\n\\[\\([^][]*\\)\\]\n@quotation\n\\([^,]*\\)," nil t)
  71     (let ((name (buffer-substring (match-beginning 1)(match-end 1)))
  72           (org (buffer-substring (match-beginning 2)(match-end 2)))
  73           (dest "@quotation\n")
  74           (b (match-beginning 0))
  75           )
  76       (save-restriction
  77         (and (eq (aref name 0) ?:)
  78              (eq (aref name 1) ?\ )
  79              (setq name (substring name 2))
  80              )
  81         (or (string= name "")
  82             (setq dest (concat "@noindent\n[" name "]\n" dest))
  83             )
  84         (or (string= org "")
  85             (setq dest (concat dest org ","))
  86             )
  87         (replace-match dest)
  88         (search-forward "@end quotation")
  89         (narrow-to-region b (match-beginning 0))
  90         (goto-char b)
  91         (if (search-forward " (obsolete RFC )" nil t)
  92             (replace-match "")
  93           )
  94         (goto-char b)
  95         (while (search-forward "\e$B!X!Y\e(B" nil t)
  96           (replace-match "")
  97           )
  98         (goto-char b)
  99         (while (search-forward "``''" nil t)
 100           (replace-match "")
 101           )
 102         (goto-char b)
 103         (while (re-search-forward ",[ \t\n]*," nil t)
 104           (replace-match ",")
 105           (goto-char b)
 106           )
 107         (and (re-search-forward "^,[ \t\n]*" nil t)
 108              (replace-match "")
 109              )
 110         (if (search-forward ", ." nil t)
 111             (replace-match ".")
 112           )
 113         (goto-char (point-max))
 114         (fill-paragraph nil)
 115         ))))
 116
 117 (defun sinfo-to-texi ()
 118   (interactive)
 119   (let* ((the-buf (current-buffer))
 120          (src-name (buffer-file-name))
 121          (name (file-name-non-extension src-name))
 122          (dst-name (concat name ".texi"))
 123          (fname (concat (file-name-nondirectory name) ".info"))
 124          (cs buffer-file-coding-system)
 125          status)
 126     (find-file dst-name)
 127     (erase-buffer)
 128     (insert-buffer the-buf)
 129     (goto-char (point-min))
 130     (while (re-search-forward "[@{}]" nil t)
 131       (replace-match (concat "@" (buffer-substring (match-beginning 0)
 132                                                    (match-end 0))))
 133       )
 134     (let ((sinfo-path (getenv "SINFO_PATH"))
 135           (coding-system-for-read 'emacs-mule)
 136           (coding-system-for-write 'emacs-mule))
 137       (setenv "SGML_PATH"
 138               (format "%s/dtd/%%N.dtd:%s/dtd/%%P.dtd:%s/rep/texi/%%N"
 139                       sinfo-path sinfo-path sinfo-path))
 140       (setq status
 141             (call-process-region (point-min)(point-max)
 142                                  "sh" t t t
 143                                  "-c"
 144                                  (format "sgmls|sgmlsasp %s"
 145                                          (expand-file-name
 146                                           sinfo-texi-mapping-file)
 147                                          )
 148                                  )
 149             )
 150       )
 151     (goto-char (point-min))
 152     (if (and (search-forward "sgmls:" nil t)
 153              (re-search-forward "line \\([0-9]+\\)" nil t)
 154              )
 155         (let ((line (string-to-number
 156                      (buffer-substring (match-beginning 1)
 157                                        (match-end 1)))
 158                     ))
 159           (progn
 160             (pop-to-buffer the-buf)
 161             (goto-line line)
 162             ))
 163       (set-buffer-file-coding-system cs)
 164       (sinfo-texi-swap-node)
 165       (let ((title
 166              (progn
 167                (goto-char (point-min))
 168                (and (re-search-forward "@title \\(.*\\)\n" nil t)
 169                     (buffer-substring (match-beginning 1)(match-end 1))
 170                     )))
 171             )
 172         (goto-char (point-min))
 173         (and (re-search-forward "@setfilename$" nil t)
 174              (replace-match
 175               (format "@setfilename %s" fname)
 176               ))
 177         (and (re-search-forward "@settitle{}" nil t)
 178              (replace-match
 179               (format "@settitle{%s}" title)
 180               ))
 181         (and (re-search-forward "@top$" nil t)
 182              (replace-match
 183               (format "@top %s" title)
 184               ))
 185         )
 186       (goto-char (point-min))
 187       (while (re-search-forward
 188               "@DREF{\\(([^{}()]*)\\)\\([^{}]+\\)}"
 189               nil t)
 190         (let ((file (buffer-substring (match-beginning 1)(match-end 1)))
 191               (word (buffer-substring (match-beginning 2)(match-end 2)))
 192               )
 193           (replace-match "")
 194           (re-search-forward "@end DREF")
 195           (replace-match
 196            (concat word " (@ref{"
 197                    (if (string= file "()")
 198                        word
 199                      (concat file word)
 200                      ) "})") 'fixed-case)
 201           ))
 202       (goto-char (point-min))
 203       (while (re-search-forward
 204               "@AREF{\\([^{}]*\\)}{<URL:\\([^<>()]*\\)>}\n*"
 205               nil t)
 206         (let ((node (buffer-substring (match-beginning 1)(match-end 1)))
 207               (url  (buffer-substring (match-beginning 2)(match-end 2)))
 208               )
 209           (replace-match "")
 210           (re-search-forward "@end AREF")
 211           (replace-match
 212            (if (string= node "()")
 213                (concat "(" url ")")
 214              (concat "(@ref{" node "})")
 215              ) 'fixed-case)
 216           ))
 217       (sinfo-filter-for-standard)
 218       (goto-char (point-min))
 219       (while (re-search-forward "@CONCEPT{\\([^{}]+\\)}" nil t)
 220         (let ((name (buffer-substring (match-beginning 1) (match-end 1))))
 221           (replace-match (format "@cindex{%s}@strong{%s}" name name)
 222                          'fixed-case)
 223           ))
 224       (goto-char (point-min))
 225       (while (search-forward "{<URL:>}" nil t)
 226         (replace-match "")
 227         )
 228       (goto-char (point-min))
 229       (while (search-forward "@ref{()" nil t)
 230         (replace-match "@ref{")
 231         )
 232       (goto-char (point-min))
 233       (while (re-search-forward "@cindex{\\([^}]*\\)}" nil t)
 234         (let ((str (buffer-substring (match-beginning 1)(match-end 1))))
 235           (replace-match "")
 236           (if (string= str "")
 237               ""
 238             (save-excursion
 239               (if (re-search-backward
 240                    "@\\(chapter\\|\\(sub\\)*section\\)[ \t][^\n]*\n" nil t)
 241                   (progn
 242                     (goto-char (match-end 0))
 243                     (insert
 244                      (concat "@cindex "
 245                              (mapconcat (function (lambda (chr)
 246                                                     (if (eq chr ?\n)
 247                                                         " "
 248                                                       (char-to-string chr)
 249                                                       )))
 250                                         str "")
 251                              "\n"))
 252                     ))))))
 253       (goto-char (point-min))
 254       (while (re-search-forward "{@refill}" nil t)
 255         (replace-match "")
 256         (if (= (current-column) 0)
 257             (delete-char 1)
 258           ;;(fill-paragraph nil)
 259           (if (looking-at "\n\n")
 260               (insert "@refill")
 261             )
 262           (fill-paragraph nil)
 263           ))
 264       (goto-char (point-min))
 265       (while (re-search-forward "@ref{\\([^}]*\\)}" nil t)
 266         (let ((str (buffer-substring (match-beginning 1)(match-end 1))))
 267           (replace-match
 268            (if (string= str "")
 269                ""
 270              (concat "@ref{"
 271                      (mapconcat (function (lambda (chr)
 272                                             (if (eq chr ?\n)
 273                                                 " "
 274                                               (char-to-string chr)
 275                                               )))
 276                                 str "")
 277                      "}")) 'fixed-case)
 278           ))
 279       (goto-char (point-min))
 280       (while (re-search-forward "@strong{\\([^}]*\\)}" nil t)
 281         (let ((str (buffer-substring (match-beginning 1)(match-end 1))))
 282           (replace-match
 283            (if (string= str "")
 284                ""
 285              (concat "@strong{"
 286                      (mapconcat (function (lambda (chr)
 287                                             (if (eq chr ?\n)
 288                                                 " "
 289                                               (char-to-string chr)
 290                                               )))
 291                                 str "")
 292                      "}")
 293              ))))
 294       (texinfo-every-node-update)
 295       (texinfo-all-menus-update)
 296       (texinfo-all-menu-titles-update)
 297       (goto-char (point-min))
 298       )))
 299
 300 (defun sinfo-to-html ()
 301   (interactive)
 302   (let* ((the-buf (current-buffer))
 303          (src-name (buffer-file-name))
 304          (name (file-name-non-extension src-name))
 305          (dst-name (concat name ".html"))
 306          (cs buffer-file-coding-system)
 307          status)
 308     (find-file dst-name)
 309     (erase-buffer)
 310     (insert-buffer the-buf)
 311     (let ((sinfo-path (getenv "SINFO_PATH"))
 312           (coding-system-for-read 'emacs-mule)
 313           (coding-system-for-write 'emacs-mule))
 314       (setenv "SGML_PATH"
 315               (format "%s/dtd/%%N.dtd:%s/dtd/%%P.dtd:%s/rep/html/%%N"
 316                       sinfo-path sinfo-path sinfo-path))
 317       (setq status
 318             (call-process-region (point-min)(point-max)
 319                                  "sh" t t t
 320                                  "-c"
 321                                  (format "sgmls|sgmlsasp %s"
 322                                          (expand-file-name
 323                                           sinfo-html-mapping-file)
 324                                          )
 325                                  )
 326             )
 327       )
 328     (goto-char (point-min))
 329     (if (and (search-forward "sgmls:" nil t)
 330              (re-search-forward "line \\([0-9]+\\)" nil t)
 331              )
 332         (let ((line (string-to-number
 333                      (buffer-substring (match-beginning 1)
 334                                        (match-end 1)))
 335                     ))
 336           (progn
 337             (pop-to-buffer the-buf)
 338             (goto-line line)
 339             ))
 340       (set-buffer-file-coding-system cs)
 341       (goto-char (point-min))
 342       )
 343     (goto-char (point-min))
 344     (if (re-search-forward "<title>" nil t)
 345         (let ((p0 (match-end 0)))
 346           (if (re-search-forward "</title>" nil t)
 347               (let ((title (buffer-substring p0 (match-beginning 0))))
 348                 (when (re-search-forward "<body>" nil t)
 349                   (insert "\n<h1>")
 350                   (insert title)
 351                   (insert "</h1>")
 352                   )))))
 353     (goto-char (point-min))
 354     (while (re-search-forward
 355             "<h[1-6]>\\([^<]+\\)\\(<a name=\"[^\"]+\">\\)</a>"
 356             nil t)
 357       (let* ((p0 (match-beginning 0))
 358              (p1 (match-beginning 1))
 359              (p2 (match-end 1))
 360              (p3 (match-end 2))
 361              (p4 (match-end 0))
 362              (h (buffer-substring (1+ (match-beginning 0)) p1))
 363              (desc (buffer-substring p1 p2)))
 364         (goto-char p4)
 365         (insert (concat "</" h))
 366         (goto-char p3)
 367         (insert desc)
 368         (delete-region p1 p2)
 369         (goto-char p0)
 370         (insert "<hr>\n")
 371         ))
 372     (goto-char (point-min))
 373     ))
 374
 375
 376 ;;; @ end
 377 ;;;
 378
 379 (provide 'sinfo)
 380
 381 ;;; sinfo.el ends here