archive/elisp/doc-to-texi.el

   1
   2 (load "../gcl-tk/convert.el")
   3 ;(let ((i 2000)) (while (> i 0) (do-one) (setq i (- i 1))))
   4
   5 (defun get-match (i) (buffer-substring (match-beginning i) (match-end i)))
   6 (defun list-matches (l)
   7   (let (ans)
   8   (while l
   9     (setq ans (cons (get-match (car l)) ans)))
  10   (nreverse ans)))
  11 (defun do-one ()
  12   (interactive)
  13
  14   ()
  15   (beginning-of-line)
  16   (re-search-forward "\x1f" nil t)
  17   (let ((beg (point))
  18         def
  19         (end (save-excursion   (re-search-forward "\x1f" nil t) (point))))
  20     (cond ((looking-at "F\\([^\n]+\\)\n\\([^\n]+\\) in \\([A-Z_a-z]+\\) package[:]?[\n ]\\(Args\\|Syntax\\): ")
  21            (let ((fun (get-match 1))
  22                  (type (get-match 2))
  23                  (package (get-match 3))
  24                  args body)
  25              (goto-char (match-end 0))
  26              (cond ((equal (get-match 4) "Syntax")
  27                     (setq args "")
  28                     (beginning-of-line))
  29                    (t
  30                      (setq args
  31                        (progn (let ((beg (point)))
  32                                 (forward-sexp 1)
  33                                 (buffer-substring beg (point)))))))
  34
  35              (setq body (buffer-substring (point) (- end 1)))
  36              (delete-region beg end )
  37              (save-excursion
  38                (get-buffer-create package)
  39                (set-buffer package)
  40                (goto-char (point-max))
  41                (insert
  42                 (if (equal type "Function")
  43                     (setq def "@defun")
  44                   (concat (setq def "@deffn") " {" type "}"))
  45                 " "
  46                  fun " " args "\nPackage:" package "\n"
  47                        body)
  48                (insert "\n@end " (substring def 1) "\n")
  49                )))
  50           ((looking-at "V\\([^\n]+\\)\n\\([^\n]+\\) in \\([A-Z_a-z]+\\) package:\n")
  51            (let ((fun (get-match 1))
  52                  (type (get-match 2))
  53                  (package (get-match 3))
  54                  args body)
  55              (goto-char (match-end 0))
  56              (setq body (buffer-substring (point) (- end 1)))
  57              (delete-region beg end )
  58              (save-excursion
  59                (get-buffer-create package)
  60                (set-buffer package)
  61                (goto-char (point-max))
  62                (insert (if (string-match "^\\*" fun)
  63                            (setq def "@defvar")
  64                          (concat (setq def "@defvr")" {Constant}"))
  65                        " "
  66                        fun " " "\nPackage:" package "\n"
  67                        body )
  68                (insert "\n@end " (substring def 1) "\n")))))))
  69
  70
  71 (defun do-some ()
  72   (interactive)
  73   (while (re-search-forward "{Constant}" nil t)
  74     (let* ((tem (read-char ))
  75            (u
  76             (cdr (assoc  tem
  77                         '((?s . "{Special Variable}")
  78                           (?d .  "{Declaration}"))))))
  79       (if u (replace-match u)))))
  80
  81 (setq b-alist '((?n . "number.texi")
  82                 (?s . "sequence.texi")
  83                 (?c . "character.texi")
  84                 (?l . "list.texi")
  85                 (?i . "io.texi")
  86                 (?a . "internal.texi")
  87                 (?f . "form.texi")
  88                 (?C . "compile.texi")
  89                 (?S . "symbol.texi")
  90                 (?t . "system.texi")
  91                 (?d . "structure.texi")
  92                 (?I . "iteration.texi")
  93                 (?u . "user-interface.texi")
  94                 (?d . "doc.texi")
  95                 (?b . "type.texi")
  96                 ))
  97 (defun try1 ()
  98   (interactive)
  99   (while (re-search-forward "\n@def" nil t)
 100     (let ((beg (match-beginning 0)) me tem
 101           (end (save-excursion (re-search-forward "\n@end def[a-z]+" nil t)
 102                                (point))))
 103       (sit-for 0 300)
 104       (setq tem (read-char ))
 105       (cond ((setq tem (cdr (assoc tem b-alist)))
 106              (setq  me (buffer-substring beg end))
 107              (delete-region beg end)
 108              (forward-char -2)
 109              (save-excursion
 110                (get-buffer-create tem)
 111                (set-buffer tem)
 112                (goto-char (point-max))
 113                (insert me "\n")))))))
 114
 115
 116
 117 (setq xall        (mapcar 'cdr  b-alist))
 118
 119 ;(let ((all xall)) (while all (set-buffer (car all))  (write-file (car all)) (setq all (cdr all))))
 120 ;(let ((all xall)) (while all   (find-file (car all)) (setq all (cdr all))))
 121 (let ((all xall) x) (while all (set-buffer (car all)) (goto-char (point-min)) (insert "@node " (setq x (capitalize (car all))) "\n@chapter "x"\n")  (write-file (car all)) (set-buffer "gcl-si.texi")(goto-char (point-max)) (insert "\\n@include " (car all) "\n") (setq all (cdr all))))
 122
 123
 124 (let ((all xall) x) (while all (switch-to-buffer (car all)) (goto-char (point-min)) (insert "@node " (setq x (capitalize (car all))) "\n@chapter "x"\n")  (save-buffer) (set-buffer "gcl-si.texi")(goto-char (point-max)) (insert "\\n@include " (car all) "\n") (setq all (cdr all))))
 125
 126 (let ((all xall) x) (while all (switch-to-buffer (car all)) (goto-char (point-min)) (insert "@node " (setq x (capitalize (car all))) "\n@chapter "x"\n")  (save-buffer) (set-buffer "gcl-si.texi")(goto-char (point-max)) (insert "\\n@include " (car all) "\n") (setq all (cdr all))))