sinfo.el

   1 ;;; sinfo.el --- sinfo to Texinfo converter
   2
   3 ;; Copyright (C) 1996,1997,1998 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
 176                "@c Generated automatically from %s by sinfo .
 177 @setfilename %s" (file-name-nondirectory src-name) fname)
 178               ))
 179         (and (re-search-forward "@settitle{}" nil t)
 180              (replace-match
 181               (format "@settitle{%s}" title)
 182               ))
 183         (and (re-search-forward "@top$" nil t)
 184              (replace-match
 185               (format "@top %s" title)
 186               ))
 187         )
 188       (goto-char (point-min))
 189       (while (re-search-forward
 190               "@DREF{\\(([^{}()]*)\\)\\([^{}]+\\)}"
 191               nil t)
 192         (let ((file (buffer-substring (match-beginning 1)(match-end 1)))
 193               (word (buffer-substring (match-beginning 2)(match-end 2)))
 194               )
 195           (replace-match "")
 196           (re-search-forward "@end DREF")
 197           (replace-match
 198            (concat word " (@ref{"
 199                    (if (string= file "()")
 200                        word
 201                      (concat file word)
 202                      ) "})") 'fixed-case)
 203           ))
 204       (goto-char (point-min))
 205       (while (re-search-forward
 206               "@AREF{\\([^{}]*\\)}{<URL:\\([^<>()]*\\)>}\n*"
 207               nil t)
 208         (let ((node (buffer-substring (match-beginning 1)(match-end 1)))
 209               (url  (buffer-substring (match-beginning 2)(match-end 2)))
 210               )
 211           (replace-match "")
 212           (re-search-forward "@end AREF")
 213           (replace-match
 214            (if (string= node "()")
 215                (concat "(" url ")")
 216              (concat "(@ref{" node "})")
 217              ) 'fixed-case)
 218           ))
 219       (sinfo-filter-for-standard)
 220       (goto-char (point-min))
 221       (while (re-search-forward "@CONCEPT{\\([^{}]+\\)}" nil t)
 222         (let ((name (buffer-substring (match-beginning 1) (match-end 1))))
 223           (replace-match (format "@cindex{%s}@strong{%s}" name name)
 224                          'fixed-case)
 225           ))
 226       (goto-char (point-min))
 227       (while (search-forward "{<URL:>}" nil t)
 228         (replace-match "")
 229         )
 230       (goto-char (point-min))
 231       (while (search-forward "@ref{()" nil t)
 232         (replace-match "@ref{")
 233         )
 234       (goto-char (point-min))
 235       (while (re-search-forward "@cindex{\\([^}]*\\)}" nil t)
 236         (let ((str (buffer-substring (match-beginning 1)(match-end 1))))
 237           (replace-match "")
 238           (if (string= str "")
 239               ""
 240             (save-excursion
 241               (if (re-search-backward
 242                    "@\\(chapter\\|\\(sub\\)*section\\)[ \t][^\n]*\n" nil t)
 243                   (progn
 244                     (goto-char (match-end 0))
 245                     (insert
 246                      (concat "@cindex "
 247                              (mapconcat (function (lambda (chr)
 248                                                     (if (eq chr ?\n)
 249                                                         " "
 250                                                       (char-to-string chr)
 251                                                       )))
 252                                         str "")
 253                              "\n"))
 254                     ))))))
 255       (goto-char (point-min))
 256       (while (re-search-forward "{@refill}" nil t)
 257         (replace-match "")
 258         (if (= (current-column) 0)
 259             (delete-char 1)
 260           ;;(fill-paragraph nil)
 261           (if (looking-at "\n\n")
 262               (insert "@refill")
 263             )
 264           (fill-paragraph nil)
 265           ))
 266       (goto-char (point-min))
 267       (while (re-search-forward "@ref{\\([^}]*\\)}" nil t)
 268         (let ((str (buffer-substring (match-beginning 1)(match-end 1))))
 269           (replace-match
 270            (if (string= str "")
 271                ""
 272              (concat "@ref{"
 273                      (mapconcat (function (lambda (chr)
 274                                             (if (eq chr ?\n)
 275                                                 " "
 276                                               (char-to-string chr)
 277                                               )))
 278                                 str "")
 279                      "}")) 'fixed-case)
 280           ))
 281       (goto-char (point-min))
 282       (while (re-search-forward "@strong{\\([^}]*\\)}" nil t)
 283         (let ((str (buffer-substring (match-beginning 1)(match-end 1))))
 284           (replace-match
 285            (if (string= str "")
 286                ""
 287              (concat "@strong{"
 288                      (mapconcat (function (lambda (chr)
 289                                             (if (eq chr ?\n)
 290                                                 " "
 291                                               (char-to-string chr)
 292                                               )))
 293                                 str "")
 294                      "}")
 295              ))))
 296       (texinfo-every-node-update)
 297       (texinfo-all-menus-update)
 298       (texinfo-all-menu-titles-update)
 299       (goto-char (point-min))
 300       )))
 301
 302 (defun sinfo-to-html ()
 303   (interactive)
 304   (let* ((the-buf (current-buffer))
 305          (src-name (buffer-file-name))
 306          (name (file-name-non-extension src-name))
 307          (dst-name (concat name ".html"))
 308          (cs buffer-file-coding-system)
 309          status)
 310     (find-file dst-name)
 311     (erase-buffer)
 312     (insert-buffer the-buf)
 313     (let ((sinfo-path (getenv "SINFO_PATH"))
 314           (coding-system-for-read 'emacs-mule)
 315           (coding-system-for-write 'emacs-mule))
 316       (setenv "SGML_PATH"
 317               (format "%s/dtd/%%N.dtd:%s/dtd/%%P.dtd:%s/rep/html/%%N"
 318                       sinfo-path sinfo-path sinfo-path))
 319       (setq status
 320             (call-process-region (point-min)(point-max)
 321                                  "sh" t t t
 322                                  "-c"
 323                                  (format "sgmls|sgmlsasp %s"
 324                                          (expand-file-name
 325                                           sinfo-html-mapping-file)
 326                                          )
 327                                  )
 328             )
 329       )
 330     (goto-char (point-min))
 331     (if (and (search-forward "sgmls:" nil t)
 332              (re-search-forward "line \\([0-9]+\\)" nil t)
 333              )
 334         (let ((line (string-to-number
 335                      (buffer-substring (match-beginning 1)
 336                                        (match-end 1)))
 337                     ))
 338           (progn
 339             (pop-to-buffer the-buf)
 340             (goto-line line)
 341             ))
 342       (set-buffer-file-coding-system cs)
 343       (goto-char (point-min))
 344       )
 345     (goto-char (point-min))
 346     (if (re-search-forward "<title>" nil t)
 347         (let ((p0 (match-end 0)))
 348           (if (re-search-forward "</title>" nil t)
 349               (let ((title (buffer-substring p0 (match-beginning 0))))
 350                 (when (re-search-forward "<body>" nil t)
 351                   (insert "\n<h1>")
 352                   (insert title)
 353                   (insert "</h1>")
 354                   )))))
 355     (goto-char (point-min))
 356     (while (re-search-forward
 357             "<h[1-6]>\\([^<]+\\)\\(<a name=\"[^\"]+\">\\)</a>"
 358             nil t)
 359       (let* ((p0 (match-beginning 0))
 360              (p1 (match-beginning 1))
 361              (p2 (match-end 1))
 362              (p3 (match-end 2))
 363              (p4 (match-end 0))
 364              (h (buffer-substring (1+ (match-beginning 0)) p1))
 365              (desc (buffer-substring p1 p2)))
 366         (goto-char p4)
 367         (insert (concat "</" h))
 368         (goto-char p3)
 369         (insert desc)
 370         (delete-region p1 p2)
 371         (goto-char p0)
 372         (insert "<hr>\n")
 373         ))
 374     (goto-char (point-min))
 375     ))
 376
 377
 378 ;;; @ end
 379 ;;;
 380
 381 (provide 'sinfo)
 382
 383 ;;; sinfo.el ends here