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