;;; pack-doc.el --- Make org documetation from package source file -*- lexical-binding: t -*-

(defun pack-doc (file)
  "Create documentation in org-mode format from FILE.
FILE is an elisp source file formatted according to the emacs
style. Result is an org mode buffer containing the file's
doumentary comments and docstrings."
  (interactive "f")
  ;; TODO: handle prompt for file if NIL
  (switch-to-buffer (get-buffer-create (concat (file-name-nondirectory file) ".org")))
  (insert-file-contents-literally file nil nil nil 'replace)
  (goto-char (point-min))
  ;; Comment-out docstrings
  (let (p0 p1 p2)
    (while (setq p0 (re-search-forward "^(def" nil t))
      (when (not (re-search-forward "^ +\"" nil t))
        (error "badly formatted file, near %d" p0))
      (setq p1 (match-beginning 0))
      (replace-match "")
      (when (not (re-search-forward "\")?$" nil t))
        (error "badly formatted file, near %d" p0))
      (setq p2 (match-beginning 0))
      (replace-match "")
      (goto-char p1)
      (narrow-to-region p1 p2) ; because p2 moves with every replacement
      (while (re-search-forward "^" nil t)
        (replace-match ";;"))
      (widen)))
  ;; Comment-out def* and adjust pre-existing comments
  (dolist (repl '(("^;;; " ";;;; ")
                  ("^$"    ";;")
                  ("^(def" ";;; (def")))
    (goto-char (point-min))
    (while (re-search-forward (car repl) nil t)
      (replace-match (cadr repl))))
  ;; Remove everything else
  (goto-char (point-min))
  (delete-non-matching-lines  "^;" (point-min) (point-max))
  ;; Create org headings and remove extra blank lines
  (dolist (repl '(("^;;;;" "**")
                  ("^;;; (def[^ ]+" "***")
                  ("^;;;" "***")
                  ("^;;" " ")
                  ("^ +$" "")
                  ("\n\n+" "\n\n")))
    (goto-char (point-min))
    (while (re-search-forward (car repl) nil t)
      (replace-match (cadr repl))))
  ;; Create top heading
  (goto-char 1)
  (delete-char 1)
  ;; Ta-da!
  (org-mode))