;;; org-el-file.el --- Make org documetation from elisp source file -*- lexical-binding: t -*-

(defun org-el-file (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")
  (switch-to-buffer (get-buffer-create (concat (file-name-nondirectory file) ".org")))
  (insert-file-contents 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))
  ;; Move autoload declarations within their target's definition
  (goto-char (point-min))
  (while (re-search-forward "^;;;###autoload\n" nil t)
    (replace-match "")
    (re-search-forward "\n")
    (replace-match " [autoloaded]\n"))
  ;; substitute command keys
  (goto-char (point-min))
  (while (re-search-forward "\\\\\\[[^]]+]" nil t)
    (replace-match (substitute-command-keys (match-string 0))))
  ;; Create org headings and remove extra blank lines
  (dolist
      (repl '(("^;;;;" "**")
              ("^;;; (def\\([^ ]+\\) \\([^ \n]+\\)\\( ([^)]*)\\)?[^\n]*" "*** def\\1\t\\2\\3")
              ("^;;;" "***")
              ("^;;" " ")
              ("^ +$" "")
              ("\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 (point-min))
  (delete-char 1)
  ;; Create colophon heading
  (forward-line 1)
  (insert "** Colophon:\n")
  ;; Ta-da!
  (goto-char (point-min))
  (org-mode)
  (org-cycle) ; open up first-level headings
  (when (re-search-forward "^\*\* Commentary:" nil t)
    (goto-char (match-beginning 0))
    ;; open up content of anny commentary text
    (org-cycle)))

;; TODO:
;;
;; + The single \t inserted into "(def[^ ]+" headings in insufficient
;;   to vertically align symbol names when the "(def[^ ]+" is
;;   `define-derived-mode' or `define-obsolete-function-alias'