Don't require `tl-list' and `tl-str'.
authormorioka <morioka>
Tue, 15 Sep 1998 01:17:01 +0000 (01:17 +0000)
committermorioka <morioka>
Tue, 15 Sep 1998 01:17:01 +0000 (01:17 +0000)
(sinfo-texi-swap-node): Use `cadr' instead of `second'.
(sinfo-to-texi): Refer environment variable `SINFO_PATH'; set
`SGML_PATH'.
(sinfo-to-html): New function.

sinfo.el

index 32fe92a..4695897 100644 (file)
--- a/sinfo.el
+++ b/sinfo.el
 
 ;;; 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 +56,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)
       (replace-match (concat "@" (buffer-substring (match-beginning 0)
                                                   (match-end 0))))
       )
-    (let ((coding-system-for-read 'internal)
-         (coding-system-for-write '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
       (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
 ;;;