update.

[elisp/sinfo.git] / sinfo.el

diff --git a/sinfo.el b/sinfo.el
index e970b67..e78dfbd 100644 (file)
--- a/sinfo.el
+++ b/sinfo.el
@@ -1,9 +1,8 @@
 ;;; sinfo.el --- sinfo to Texinfo converter
 
-;; Copyright (C) 1996 MORIOKA Tomohiko
+;; Copyright (C) 1996,1997,1998 MORIOKA Tomohiko
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Id: sinfo.el,v 3.6 1996/12/25 18:24:28 morioka Exp $
 ;; Keywords: SGML, Texinfo
 
 ;; This file is part of sinfo (SGML based info system).
@@ -30,15 +29,23 @@
 
 ;;; Code:
 
-(require 'tl-list)
-(require 'tl-str)
 (require 'texinfmt)
 (require 'texi-util)
+(require 'emu)
+
+(defun-maybe file-name-non-extension (filename)
+  (if (string-match "\\.[^.]+$" filename)
+      (substring filename 0 (match-beginning 0))
+    filename))
 
 (defvar sinfo-texi-mapping-file
   "/usr/local/share/sgml/rep/sinfo/texi-mapping"
   "*SGML mapping file to convert into Texinfo.")
 
+(defvar sinfo-html-mapping-file
+  "/usr/local/share/sgml/rep/sinfo/html-mapping"
+  "*SGML mapping file to convert into HTML.")
+
 (defun sinfo-texi-swap-node ()
   (interactive)
   (goto-char (point-min))
@@ -48,7 +55,7 @@
     (let* ((md (match-data))
           (nd (last md 2))
           (nb (car nd))
-          (ne (second nd))
+          (ne (cadr nd))
           )
       (replace-match (format "%s\n%s"
                             (buffer-substring nb ne)
@@ -123,9 +130,12 @@
       (replace-match (concat "@" (buffer-substring (match-beginning 0)
                                                   (match-end 0))))
       )
-    (let ((coding-system-for-read 'coding-system-internal)
-         (coding-system-for-write 'coding-system-internal)
-         )
+    (let ((sinfo-path (getenv "SINFO_PATH"))
+         (coding-system-for-read 'emacs-mule)
+         (coding-system-for-write 'emacs-mule))
+      (setenv "SGML_PATH"
+             (format "%s/dtd/%%N.dtd:%s/dtd/%%P.dtd:%s/rep/texi/%%N"
+                     sinfo-path sinfo-path sinfo-path))
       (setq status
            (call-process-region (point-min)(point-max)
                                 "sh" t t t
@@ -161,7 +171,9 @@
        (goto-char (point-min))
        (and (re-search-forward "@setfilename$" nil t)
             (replace-match
-             (format "@setfilename %s" fname)
+             (format
+              "@c Generated automatically from %s by sinfo 3.7.
+@setfilename %s" (file-name-nondirectory src-name) fname)
              ))
        (and (re-search-forward "@settitle{}" nil t)
             (replace-match
@@ -286,6 +298,81 @@
       (goto-char (point-min))
       )))
 
+(defun sinfo-to-html ()
+  (interactive)
+  (let* ((the-buf (current-buffer))
+        (src-name (buffer-file-name))
+        (name (file-name-non-extension src-name))
+        (dst-name (concat name ".html"))
+        (cs buffer-file-coding-system)
+        status)
+    (find-file dst-name)
+    (erase-buffer)
+    (insert-buffer the-buf)
+    (let ((sinfo-path (getenv "SINFO_PATH"))
+         (coding-system-for-read 'emacs-mule)
+         (coding-system-for-write 'emacs-mule))
+      (setenv "SGML_PATH"
+             (format "%s/dtd/%%N.dtd:%s/dtd/%%P.dtd:%s/rep/html/%%N"
+                     sinfo-path sinfo-path sinfo-path))
+      (setq status
+           (call-process-region (point-min)(point-max)
+                                "sh" t t t
+                                "-c"
+                                (format "sgmls|sgmlsasp %s"
+                                        (expand-file-name
+                                         sinfo-html-mapping-file)
+                                        )
+                                )
+           )
+      )
+    (goto-char (point-min))
+    (if (and (search-forward "sgmls:" nil t)
+            (re-search-forward "line \\([0-9]+\\)" nil t)
+            )
+       (let ((line (string-to-number
+                    (buffer-substring (match-beginning 1)
+                                      (match-end 1)))
+                   ))
+         (progn
+           (pop-to-buffer the-buf)
+           (goto-line line)
+           ))
+      (set-buffer-file-coding-system cs)
+      (goto-char (point-min))
+      )
+    (goto-char (point-min))
+    (if (re-search-forward "<title>" nil t)
+       (let ((p0 (match-end 0)))
+         (if (re-search-forward "</title>" nil t)
+             (let ((title (buffer-substring p0 (match-beginning 0))))
+               (when (re-search-forward "<body>" nil t)
+                 (insert "\n<h1>")
+                 (insert title)
+                 (insert "</h1>")
+                 )))))
+    (goto-char (point-min))
+    (while (re-search-forward
+           "<h[1-6]>\\([^<]+\\)\\(<a name=\"[^\"]+\">\\)</a>"
+           nil t)
+      (let* ((p0 (match-beginning 0))
+            (p1 (match-beginning 1))
+            (p2 (match-end 1))
+            (p3 (match-end 2))
+            (p4 (match-end 0))
+            (h (buffer-substring (1+ (match-beginning 0)) p1))
+            (desc (buffer-substring p1 p2)))
+       (goto-char p4)
+       (insert (concat "</" h))
+       (goto-char p3)
+       (insert desc)
+       (delete-region p1 p2)
+       (goto-char p0)
+       (insert "<hr>\n")
+       ))
+    (goto-char (point-min))
+    ))
+
 
 ;;; @ end
 ;;;