;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;  How To Make a Builtin Function Help Object
;;;  by Generating It Directly from the Programmers' Manual Source:
;;;                                                      Roger Crew 7/21/92
;;;
;;; 1. Start up EMACS and load this file (or do ^Xh M-x eval-region).
;;;    Have the texinfo version of the Programmers' Manual in a file somewhere
;;;    (or have ange-ftp loaded and be ready to type the name of the file on 
;;;     parcftp...)
;;;
;;; 2. Do M-x do-builtins
;;;    You'll be prompted for the aforementioned filename and then for an 
;;;    object-id for the builtin-function help object. 
;;;
;;; 3. Go to the resulting *Function* buffer which will be a script that
;;;    installs all of the necessary properties and sets their values.
;;;    You'll probably want to do a teentsy bit of editing.
;;;
;;;    For the 11/91 version of the Programmers' Manual, I found I had to
;;;
;;;     .  consolidate the two descriptions of length(), 
;;;     .  fix a typo in tonum(),
;;;     .  remove ``@quotation'' from set_task_perms(),
;;;     .  edit ctime(), add_property(), add_verb(), and read() 
;;;         so that the word `above' does not occur.
;;;
;;; 4. Upload the resulting script to your moo.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun do-short-@ (name before after)
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward (concat "@" name "{") nil t)
      (replace-match before)
      (let ((level 0))
        (while (and (>= level 0) (re-search-forward "{\\|}" nil t))
          (forward-char -1)
          (cond ((= (preceding-char) ?@))
                ((= (following-char) ?\{)
                 (setq level (1+ level)))
                ((= (following-char) ?\})
                 (setq level (1- level))))
          (forward-char 1))
        (if (/= (preceding-char) ?\})
            (error "missing }")
          (delete-char -1)
          (insert after))))))


(defun do-builtins (file obj)
  (interactive "fFile name of .texinfo programmers manual: \nsHelp object id: ")
  (let (indent-tabs-mode)
    (set-buffer (find-file-noselect file))
    (goto-char (point-min))
    (with-output-to-temp-buffer "*Functions*"
      (while (re-search-forward "^@deftypefun[  ]*" nil t)
        (let ((b (match-beginning 0)))
          (re-search-forward "^@end[    ]+deftypefun.*\n" nil 1)
          (princ (buffer-substring b (point)))
          ))
      (set-buffer standard-output)
      (goto-char (point-min))
      (do-short-@ "code" "`" "'")
      (do-short-@ "samp" "`" "'")
      (do-short-@ "var" "<" ">")
      (do-short-@ "emph" "*" "*")
      (do-short-@ "dfn" "\"" "\"")
      (do-short-@ "r" "" "")
      (save-excursion
        (while (re-search-forward "@result{}" nil t)
          (replace-match "=>")))
      (save-excursion
        (while (re-search-forward "@error{}" nil t)
          (replace-match "-error->")))
      (save-excursion
        (while (re-search-forward "@dots{}" nil t)
          (replace-match "...")))
      (save-excursion
        (while (re-search-forward "^@noindent.*\n" nil t)
          (delete-region (match-beginning 0) (match-end 0))))
      (save-excursion
        (while (re-search-forward "^@example.*\n" nil t)
          (delete-region (match-beginning 0) (match-end 0))
          (let ((s (point)))
            (re-search-forward "^@end[ \t]+example.*\n" nil 1)
            (delete-region (match-beginning 0) (point))
            (indent-rigidly s (point) 4))))
      (save-excursion
        (while (re-search-forward "@{" nil t)
          (replace-match "{")))
      (save-excursion
        (while (re-search-forward "@}" nil t)
          (replace-match "}")))
      (save-excursion
        (while (re-search-forward "@@" nil t)
          (replace-match "@")))
      (save-excursion
        (while (re-search-forward "^\\." nil t)
          (replace-match "..")))
      (save-excursion
        (while (re-search-forward "^@end[ \t]deftype.*$" nil t)
          (replace-match ".")))
      (save-excursion
        (while (re-search-forward "^@deftypefun[ \t]+\\([a-z_]+\\)[ \t]*\\([a-z_]+\\)\\(.*\\)\n" nil t)
          (let ((p (buffer-substring (match-beginning 2) (match-end 2)))
                q)
            (replace-match (concat "@prop " obj ".\\2() {}\n;;" obj ".(\"\\2()\")=$command_utils:read_lines()\nSyntax:  \\2\\3   => \\1\n"))
            (while (looking-at "^@deftypefunx[ \t]+\\([a-z_]+\\)[ \t]*\\([a-z_]+\\)\\(.*\\)\n")
              (setq q (cons (buffer-substring (match-beginning 2) (match-end 2)) q))
              (replace-match (concat (make-string (- (length p) -9 (length (car q))) 32) "\\2\\3   => \\1\n")))
            (insert "\n")
            (re-search-forward "^.\n")
            (while q
              (insert "@prop " obj "." (car q) "() {}\n;;" obj ".(\"" (car q) "()\") = {\"*forward*\", \"" p "()\"}\n")
              (setq q (cdr q)))))))))