;;; doc-mode.el --- convenient editing of in-code documentation
;;
;; Copyright (C) 2007, 2009 Nikolaj Schumacher
;; Author: Nikolaj Schumacher <bugs * nschum de>
;; Version: 0.2
;; Keywords: convenience tools
;; URL: http://nschum.de/src/emacs/doc-mode/
;; Compatibility: GNU Emacs 22.x, GNU Emacs 23.x
;;
;; This file is NOT part of GNU Emacs.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;
;;; Commentary:
;;
;; This mode requires the Semantic package to be installed and running:
;; http://cedet.sourceforge.net/
;;
;; doc-mode allows easy creation and editing of JavaDoc or Doxygen comment
;; blocks in your code.  It also greatly improves readability of code by folding
;; the blocks, so they don't take up precious screen lines.
;;
;; Add the following to your .emacs file:
;; (require 'doc-mode)
;; (add-hook 'c-mode-common-hook 'doc-mode)
;;
;; The command `doc-mode-fix-tag-doc' or "C-cdd" adds or replaces the
;; documentation for the function, variable, or class at point.
;; `doc-mode-remove-tag-doc' or "C-cdr" removes it.
;;
;; You can fold the comments by using `doc-mode-toggle-tag-doc-folding' or
;; `doc-mode-fold-all'.
;;
;;; Change Log:
;;
;; 2009-03-22 (0.2)
;;    Added `doc-mode-keywords-from-tag-func' as customizable option.
;;    Improved parameter list change recognition.
;;    `doc-mode-jump-to-template' now enables jumping to the latest comment.
;;    `doc-mode-first-template' now jumps to the first template in this buffer.
;;
;; 2007-09-09 (0.1.1)
;;    Fixed return value detection.
;;    Actual keyword highlighting.
;;
;; 2007-09-07 (0.1)
;;    Initial release.
;;
;;; Code:

(eval-when-compile (require 'cl))
(require 'semantic)
(require 'cc-mode)
(require 'newcomment) ;comment-fill-column

(dolist (err `("^No tag found$" "^Semantic can't parse buffer$"
               "^No template found$" "^doc-mode not enabled$"))
  (add-to-list 'debug-ignored-errors err))

;; semantic-after-auto-parse-hooks

(defgroup doc-mode nil
  "Minor mode for editing in-code documentation."
  :group 'convenience
  :group 'tools)

(defcustom doc-mode-auto-check-p t
  "*Should the buffer documentation be checked after a Semantic reparse."
  :group 'doc-mode
  :type '(choice (const :tag "Off" nil)
                 (const :tag "On" t)))

(defcustom doc-mode-jump-to-template t
  "*Should the point be moved inside the template after inserting a doc."
  :group 'doc-mode
  :type '(choice (const :tag "Off" nil)
                 (const :tag "On" t)))

(defcustom doc-mode-template-start "/**"
  "*The string to insert at the beginning of a comment."
  :group 'doc-mode
  :type 'string)

(defcustom doc-mode-template-end " */"
  "*The string to insert at the end of a comment."
  :group 'doc-mode
  :type 'string)

(defcustom doc-mode-template-continue " * "
  "*The string to insert at the beginning of each line in a comment."
  :group 'doc-mode
  :type 'string)

(defcustom doc-mode-template-single-line-start "/** "
  "*The string to insert at the beginning of a single-line comment.
For using single-line comments, see `doc-mode-allow-single-line-comments'"
  :group 'doc-mode
  :type 'string)

(defcustom doc-mode-template-single-line-end " */"
  "*The string to insert at the end of a single-line comment.
For using single-line comments, see `doc-mode-allow-single-line-comments'"
  :group 'doc-mode
  :type 'string)

(defcustom doc-mode-template-keyword-char "@"
  "*The character used to begin keywords."
  :group 'doc-mode
  :type '(choice (const :tag "@" "@")
                 (const :tag "\\" "\\")
                 (string :tag "Other")))

(defcustom doc-mode-template-empty-line-after-summary nil
  "*Whether to put an empty line after the first one in the comment."
  :group 'doc-mode
  :type '(choice (const :tag "Off" nil)
                 (const :tag "On" t)))

(defcustom doc-mode-template-empty-line-before-keywords nil
  "*Whether to put an empty line before the keyword list in a comment."
  :group 'doc-mode
  :type '(choice (const :tag "Off" nil)
                 (const :tag "On" t)))

(defcustom doc-mode-template-keywords
  '("deprecated" "param" "return" "author" "exception" "throws" "version"
    "since" "see" "sa" "todo")
  "*Keywords that should be listed in this order.
All other keywords will be considered regular text."
  :group 'doc-mode
  :type '(repeat string))

(defcustom doc-mode-allow-single-line-comments t
  "*Whether to allow a more space-saving format for very short comments.
When this is enabled, `doc-mode-template-single-line-start' and
`doc-mode-template-single-line-end' will be used to format single-line
comments instead of `doc-mode-template-start', `doc-mode-template-end' and
`doc-mode-template-continue'."
  :group 'doc-mode
  :type '(choice (const :tag "Off" nil)
                 (const :tag "On" t)))

(defcustom doc-mode-fold-single-line-comments nil
  "*Whether to bother folding comments that are already a single line."
  :group 'doc-mode
  :type '(choice (const :tag "Off" nil)
                 (const :tag "On" t)))

(defcustom doc-mode-align-keyword-arguments t
  "*Whether to align the arguments to a keyword continued in the next line.
This may also be a number, describing how far to indent the argument list."
  :group 'doc-mode
  :type '(choice (const :tag "Off" nil)
                 (integer :tag "Indent" nil)
                 (const :tag "On" t)))

(defcustom doc-mode-fill-column nil
  "*The column at which to break text when formatting it.
If this is nil, `comment-fill-column' is used."
  :group 'doc-mode
  :type '(choice (const :tag "Default" nil)
                 (integer :tag "Fill Column")))

(defcustom doc-mode-keywords-from-tag-func 'doc-mode-keywords-from-tag
  "*Function used to generate keywords for a tag.
This must be a function that takes two arguments.  The first argument is the
Semantic tag for which to generate keywords, the second is a list of existing
keywords taken from the current doc comment.  It should return the new list of
keywords.  Each element in a keyword list can be either a string or a list with
a keyword, optional argument and optional description.  Additional entries with
undetermined content should be created with `doc-mode-new-keyword'."
  :group 'doc-mode
  :type 'function)

;;; keywords ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defconst doc-mode-font-lock-keywords
  (eval-when-compile
    `((,(concat "[\\@]"
         (regexp-opt
          '("addindex" "addtogroup" "anchor" "arg" "author" "brief" "callgraph"
            "callergraph" "category" "code" "cond" "copydoc" "date" "defgroup"
            "deprecated" "details" "dir" "dontinclude" "dot" "dotfile" "e"
            "else" "elseif" "em" "endcode" "endcond" "enddot" "endhtmlonly"
            "endif" "endlatexonly" "endlink" "endmanonly" "endmsc" "endverbatim"
            "endxmlonly" "example" "f$" "f[" "f]" "file" "fn" "hideinitializer"
            "htmlinclude" "htmlonly" "if" "ifnot" "image" "include"
            "includelineno" "ingroup" "internal" "invariant" "latexonly" "li"
            "line" "link" "mainpage" "manonly" "msc" "name" "nosubgrouping"
            "note" "overload" "package" "page" "par" "paragraph"  "post" "pre"
            "private" "privatesection" "property" "protected" "protectedsection"
            "public" "publicsection" "ref" "remarks" "return" "retval" "sa"
            "section" "see" "serial" "serialData" "serialField"
            "showinitializer" "since" "skip" "skipline" "subpage" "subsection"
            "subsubsection" "test" "typedef" "until" "defvar" "verbatim"
            "verbinclude" "version" "weakgroup" "xmlonly" "xrefitem" "$" "@"
            "\\" "&" "~" "<" ">" "#" "%") t)
         "\\>")
       (0 font-lock-keyword-face prepend))
      ;; don't highlight \n, it's too common in code
      ("@n" (0 font-lock-keyword-face prepend))
      (,(concat "\\([@\\]"
         (regexp-opt '("class" "struct" "union" "exception" "enum" "throw"
                       "throws") t)
         "\\)\\>\\(?:[ \t]+\\(\\sw+\\)\\)?")
       (1 font-lock-keyword-face prepend)
       (3 font-lock-type-face prepend))
      (,(concat "\\([@\\]"
         (regexp-opt '("param" "param[in]" "param[out]" "param[in+out]" "a"
                       "namespace" "relates" "relatesalso" "def") t)
         "\\)\\>\\(?:[ \t]+\\(\\sw+\\)\\)?")
       (1 font-lock-keyword-face prepend)
       (3 font-lock-variable-name-face prepend))
      (,(concat "\\([@\\]retval\\)\\>\\(?:[ \t]+\\(\\sw+\\)\\)?")
       (1 font-lock-keyword-face prepend)
       (2 font-lock-function-name-face prepend))
      (,(concat "[@\\]" (regexp-opt '("attention" "warning" "todo" "bug") t)
                "\\>")
       (0 font-lock-warning-face prepend))
      (,(concat "{@"
         (regexp-opt '("docRoot" "inheritDoc" "link" "linkplain" "value") t)
         "}")
       (0 font-lock-keyword-face prepend))
      ("\\([@\\]b\\)[ \t\n]+\\([^ \t\n]+\\)"
       (1 font-lock-keyword-face prepend)
       (2 'bold prepend))
      ("\\([@\\]em?\\)[ \t\n]+\\([^ \t\n]+\\)"
       (1 font-lock-keyword-face prepend)
       (2 'italic prepend))
      ("\\([@\\][cp]\\)[ \t\n]+\\([^ \t\n]+\\)"
       (1 font-lock-keyword-face prepend)
       (2 'underline prepend)))))

;;; templates ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar doc-mode-templates nil)
(make-variable-buffer-local 'doc-mode-templates)

(defun doc-mode-add-template (beg end)
  (let ((overlay (make-overlay beg (point))))
    (overlay-put overlay 'intangible t)
    (overlay-put overlay 'face 'highlight)
    (overlay-put overlay 'insert-in-front-hooks '(doc-mode-replace-overlay))
    (overlay-put overlay 'modification-hooks '(doc-mode-delete-overlay))
    (push overlay doc-mode-templates)))

(defvar doc-mode-temp nil)

(defun doc-mode-delete-overlay (ov after-p beg end &optional r)
  (unless after-p
    (mapc 'doc-mode-unfold-by-overlay
          (overlays-in (1- (overlay-start ov)) (1+ (overlay-end ov))))
    (delete-overlay ov)
    (setq doc-mode-templates (delq ov doc-mode-templates))))

(defun doc-mode-replace-overlay (ov after-p beg end &optional r)
  (unless after-p
    (let ((inhibit-modification-hooks nil))
      (delete-region (overlay-start ov) (overlay-end ov)))))

;;;###autoload
(defun doc-mode-next-template (&optional pos limit)
  "Jump to the next unfinished documentation template in this buffer."
  (interactive)
  (unless pos (setq pos (point)))
  (unless limit (setq limit (point-max)))
  (let ((min-start limit)
        start)
    (dolist (ov doc-mode-templates)
      (setq start (overlay-start ov))
      (and (> start pos)
           (< start min-start)
           (setq min-start start)))
    (when (= min-start limit)
      (error "End of buffer"))
    (push-mark)
    (goto-char min-start)))

;;;###autoload
(defun doc-mode-previous-template (&optional pos limit)
  "Jump to the previous unfinished documentation template in this buffer."
  (interactive)
  (unless pos (setq pos (point)))
  (unless limit (setq limit (point-min)))
  (let ((max-start limit)
        start)
    (dolist (ov doc-mode-templates)
      (setq start (overlay-start ov))
      (and (< start pos)
           (> start max-start)
           (setq max-start start)))
    (when (= max-start limit)
      (error "Beginning of buffer"))
    (push-mark)
    (goto-char max-start)))

;;;###autoload
(defun doc-mode-first-template ()
  "Jump to the first unfinished documentation template in this buffer."
  (interactive)
  (condition-case err
      (doc-mode-next-template (point-min))
    (error (error "No template found"))))

;;; mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar doc-mode-lighter " doc")

(defvar doc-mode-prefix-map
  (let ((map (make-sparse-keymap)))
    (define-key map "d" 'doc-mode-fix-tag-doc)
    (define-key map "c" 'doc-mode-check-tag-doc)
    (define-key map "t" 'doc-mode-toggle-tag-doc-folding)
    (define-key map "f" 'doc-mode-fold-tag-doc)
    (define-key map "u" 'doc-mode-unfold-tag-doc)
    (define-key map "r" 'doc-mode-remove-tag-doc)
    (define-key map "i" 'doc-mode-add-tag-doc)
    (define-key map "e" 'doc-mode-next-faulty-doc)
    (define-key map "n" 'doc-mode-next-template)
    (define-key map "\C-c" 'doc-mode-check-buffer)
    (define-key map "\C-f" 'doc-mode-fold-all)
    (define-key map "\C-u" 'doc-mode-unfold-all)
    map))

(defvar doc-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\C-c\C-d" doc-mode-prefix-map)
    map)
  "Keymap used for `doc-mode'.")

;;;###autoload
(define-minor-mode doc-mode
  "Minor mode for editing in-code documentation."
  nil doc-mode-lighter doc-mode-map
  (if doc-mode
      (progn
        (font-lock-add-keywords nil doc-mode-font-lock-keywords)
        (when doc-mode-auto-check-p
          (add-hook 'semantic-after-auto-parse-hooks 'doc-mode-check-buffer
                    nil t)
          (add-hook 'semantic-after-idle-scheduler-reparse-hooks
                    'doc-mode-check-buffer nil t)))
    (dolist (ov doc-mode-templates)
      (delete-overlay ov))
    (kill-local-variable 'doc-mode-templates)
    (doc-mode-unfold-all)
    (font-lock-remove-keywords nil doc-mode-font-lock-keywords)
    (remove-hook 'semantic-after-auto-parse-hooks 'doc-mode-check-buffer t)
    (remove-hook 'semantic-after-idle-scheduler-reparse-hooks
                 'doc-mode-check-buffer t))

  (when font-lock-mode
    (font-lock-fontify-buffer)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun doc-mode-current-tag ()
  (when (semantic-parse-tree-unparseable-p)
    (error "Semantic can't parse buffer"))
  (when (or (semantic-parse-tree-needs-rebuild-p)
            (semantic-parse-tree-needs-update-p))
    (condition-case nil
        (semantic-fetch-tags)
      (error (error "Semantic can't parse buffer"))))
  (save-excursion
    (or (semantic-current-tag-of-class 'function)
        (semantic-current-tag-of-class 'variable)
        (progn (beginning-of-line) (skip-chars-forward " \t\n") nil)
        (semantic-current-tag-of-class 'function)
        (semantic-current-tag-of-class 'variable)
        (if (not (looking-at "/\\*\\*"))
            (semantic-current-tag-of-class 'type)
          (progn (search-forward "*/" nil t)
                 (skip-chars-forward " \t\n")
                 nil))
        (semantic-current-tag-of-class 'function)
        (semantic-current-tag-of-class 'variable)
        (semantic-current-tag-of-class 'type))))

(defun doc-mode-current-tag-or-bust ()
  (or (doc-mode-current-tag) (error "No tag found")))

;;; insertion ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun doc-mode-line-indent (keyword)
  "Determine left side offset when indenting LINE."
  (if (numberp doc-mode-align-keyword-arguments)
      doc-mode-align-keyword-arguments
    (+ 1 (length (car keyword))
       (if (equal (car keyword) "param")
           (1+ (length (cdr keyword)))
         0))))

(defun doc-mode-insert (text)
  "Insert TEXT if a string, or a template if 'prompt."
  (if (stringp text)
      (insert text)
    (let ((beg (point)))
      (insert (cadr text))
      (when doc-mode
        (doc-mode-add-template beg (point))))))

(defun doc-mode-insert-markup (markup &optional argument description)
  (insert doc-mode-template-keyword-char markup)
  (when argument
    (insert " ")
    (doc-mode-insert argument))
  (when description
    (insert " ")
    (doc-mode-insert description)))

(defun doc-mode-insert-line (line indent)
  (indent-to-column indent)
  (let ((beg (point)))
    (insert doc-mode-template-continue)
    (if (and (consp line) (not (eq (car line) 'prompt)))
        (apply 'doc-mode-insert-markup line)
      (doc-mode-insert line))
    (delete-char (- (skip-chars-backward " \t")))
    (when (> (point) (+ beg 2))
      (save-excursion (fill-region beg (point) 'left t)))
    (insert "\n")))

(defun doc-mode-insert-keyword (keyword indent)
  (indent-to-column indent)
  (let ((fill-column (or doc-mode-fill-column comment-fill-column fill-column))
        (fill-prefix (when doc-mode-align-keyword-arguments
                       (concat (buffer-substring (point-at-bol) (point))
                               doc-mode-template-continue
                               (make-string (doc-mode-line-indent keyword)
                                            ? )))))
    (doc-mode-insert-line keyword indent)))

(defun doc-mode-insert-doc (keywords &optional pos)
  "Insert a documentation at POS.
LINES is a list of keywords."
  (save-excursion
    (if pos
        (goto-char pos)
      (setq pos (point)))
    (let ((indent (current-column)))

      (if (and (not (cdr keywords)) doc-mode-allow-single-line-comments)
          (progn (insert doc-mode-template-single-line-start)
                 (doc-mode-insert (car keywords))
                 (insert doc-mode-template-single-line-end "\n"))
        (insert doc-mode-template-start "\n")

        ;; first line
        (when (or (stringp (car keywords))
                  (eq 'prompt (caar keywords)))
          (doc-mode-insert-line (pop keywords) indent))

        (when (and doc-mode-template-empty-line-after-summary
                   (or (null doc-mode-template-empty-line-before-keywords)
                       (stringp (cadr keywords))))
          (doc-mode-insert-line "" indent))

        ;; paragraphs
        (if (cdr keywords)
            (while (stringp (car keywords))
              (doc-mode-insert-line (pop keywords) indent)
              (when (stringp (car keywords))
                (doc-mode-insert-line "" indent)))
          (while (stringp (car keywords))
            (doc-mode-insert-line (pop keywords) indent)))

        (when doc-mode-template-empty-line-before-keywords
          (doc-mode-insert-line "" indent))

        ;; keywords
        (while keywords
          (doc-mode-insert-keyword (pop keywords) indent))
        (indent-to-column indent)
        (insert doc-mode-template-end "\n"))

      ;; re-indent original line
      (if (< (current-column) indent)
          (indent-to-column indent)
        (move-to-column indent t))))

    (and doc-mode-jump-to-template doc-mode-templates
         (ignore-errors (doc-mode-next-template pos (point)))))

(defun doc-mode-remove-doc (point)
  "Remove the documentation before POINT."
  (let* ((bounds (doc-mode-find-doc-bounds point))
         (beg (plist-get bounds :beg))
         (end (plist-get bounds :end)))
    (when bounds
      (save-excursion
        (goto-char beg)
        (incf beg (skip-chars-backward " \t"))
        (goto-char end)
        (incf end (skip-chars-forward " \t"))
        (when (eolp) (incf end))
        (delete-region beg end)))))

;;;###autoload
(defun doc-mode-remove-tag-doc (tag)
  "Remove the documentation for TAG.
If called interactively, use the tag given by `doc-mode-current-tag'."
  (interactive (list (doc-mode-current-tag-or-bust)))
  (doc-mode-remove-doc (semantic-tag-start tag)))

;;; registering ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun doc-mode-find-doc-bounds (pos)
  "Find the documentation right before POS.
If there is anything but whitespace between the documentation and POS, nil is
returned.  Otherwise a cons of the doc's beginning and end is given."
  (let (end)
    (save-excursion
      (goto-char pos)
      (when (re-search-backward "[ \t]*\n[ \t]*\\=" nil t)
        (setq end (point))
        (cond
         ;; /// Doxygen comment */
         ((looking-back "[ \t]*//[/!]\\(.*\\)$")
          (forward-line -1)
          (while (looking-at "[ \t]*//[/!]\\(.*\\)$")
            (forward-line -1))
          (forward-line 1)
          (skip-chars-forward " \t")
          `(:beg ,(point) :end ,end :column ,(current-indentation)))
         ;; /** JavaDoc comment */
         ((looking-back "\\*/")
          (goto-char (match-beginning 0))
          ;; search for /*, not allowing any */ in between
          (when (and (re-search-backward "\\(/\\*\\)\\|\\*/" nil t)
                     (match-beginning 1)
                     (memq (char-after (1+ (match-beginning 1))) '(?! ?*)))
            `(:beg ,(point) :end ,end :column ,(current-column)))))))))

;;; formating ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun doc-mode-new-keyword (keyword &optional argument)
  (if (equal keyword "param")
      (list keyword argument '(prompt "<doc>"))
    (list keyword '(prompt "<doc>"))))

(defun doc-mode-has-return-value-p (tag)
  "Test if TAG has a return value to format."
  (and (eq (semantic-tag-class tag) 'function)
       (not (equal (semantic-tag-type tag) "void"))
       (not (semantic-tag-get-attribute tag :constructor-flag))
       (or (not (equal (semantic-tag-type tag) "int"))
           ;; semantic bug, constructors sometimes appear to have int type
           (save-excursion (goto-char (semantic-tag-start tag))
                           (and (re-search-forward "\\(\\<int\\>\\)\\|{\\|;"
                                                   (semantic-tag-end tag) t)
                                (match-beginning 1))))))

;;; extracting ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun doc-mode-extract-summary (beg end)
  (let ((bounds (doc-mode-find-summary beg end)))
    (buffer-substring-no-properties (car bounds) (cdr bounds))))

(defun doc-mode-find-summary (beg end)
  (save-excursion
    (goto-char beg)
    (if (or (re-search-forward "^[@\\]brief \\([^\t ][^\n]*\n\\)" end t)
            (re-search-forward "\\<\\(.*\\)\\(\\*+/\\|\n\\)" end t))
        (cons (match-beginning 1) (match-end 1))
      (cons beg beg))))

(defconst doc-mode-begin-regexp
  (eval-when-compile (concat "[ \t\n]*"
                             "\\("
                             "/\\*\\(\\*+\\|!\\)"
                             "\\|"
                             "//[!/]"
                             "\\)[ \t]*")))

(defun doc-mode-clean-doc (beg end)
  "Remove the comment delimiters between BEG and END."
  (save-excursion
    (goto-char beg)
    (when (looking-at doc-mode-begin-regexp)
      (setq beg (match-end 0)))
    (goto-char end)
    (when (looking-back "[ \t\n\r]*\\*+/" nil t)
      (setq end (match-beginning 0)))
    (let ((lines (split-string (buffer-substring-no-properties beg end)
                               "[ \t]*\n[ \t]*\\(\\*/?\\|//[!/]\\)?[ \t]*")))
      (while (equal (car lines) "")
        (pop lines))
      (mapconcat 'identity lines "\n"))))

(defun doc-mode-extract-keywords (beg end)
  "Extract documentation keywords between BEG and END.
Returns a alist of keywords, where each element is the list (keyword
argument value) or (keyword argument)."
  (let* ((paragraphs (doc-mode-clean-doc beg end))
         (doc "")
         (pos 0)
         match results)

    (when (string-match
           "[ \t\n]*\\(\\(.\\|\n\\)*?\\)\\([@\\]\\<\\(.\\|\n\\)*\\'\\)"
           paragraphs)
      (setq doc (match-string-no-properties 3 paragraphs)
            paragraphs (match-string-no-properties 1 paragraphs)))

    ;; first line summary
    (when (string-match "\\`[ \t\n]*\\(.+\\.\\)\\([ \n]+\\|\\'\\)" paragraphs)
      (push (match-string 1 paragraphs) results)
      (setq pos (match-end 0)))

    ;; other paragraphs
    (dolist (paragraph (split-string (substring paragraphs pos)
                                     "[ \t]*\n\\(\n+[ \t]*\\|$\\)" t))
      (push (replace-regexp-in-string "[\n\r]" " " paragraph) results))

    ;; keywords
    (dolist (keyword (cdr (split-string doc "[@\\]\\<")))
      (setq match (split-string keyword))
      (push (if (equal (car match) "param")
                (list (car match) (cadr match)
                      (mapconcat 'identity (cddr match) " "))
              (list (car match) (mapconcat 'identity (cdr match) " ")))
            results))
    (nreverse results)))

(defun doc-mode-extract-keywords-for-tag (tag)
  (let ((bounds (doc-mode-find-doc-bounds (semantic-tag-start tag))))
    (when bounds (doc-mode-extract-keywords (plist-get bounds :beg)
                                            (plist-get bounds :end)))))

(defun doc-mode-find-keyword (keyword keywords)
  (when keywords
    (if (and (consp (car keywords)) (string= (car (car keywords)) keyword))
        (cons (car keywords) (doc-mode-find-keyword keyword (cdr keywords)))
      (doc-mode-find-keyword keyword (cdr keywords)))))

(defun doc-mode-filter-keyword (keyword keywords)
  (when keywords
    (if (and (consp (car keywords)) (string= (car (car keywords)) keyword))
        (doc-mode-filter-keyword keyword (cdr keywords))
      (cons (car keywords) (doc-mode-filter-keyword keyword (cdr keywords))))))

(defun doc-mode-find-eligible-tags ()
  (when buffer-file-name
    (unless (or (semantic-parse-tree-unparseable-p)
                (semantic-parse-tree-needs-rebuild-p)
                (semantic-parse-tree-needs-update-p))
      (ignore-errors
        (let (tags)
          (semantic-brute-find-tag-by-function
           (lambda (tag)
             (when (semantic-tag-start tag)
               (case (semantic-tag-class tag)
                 ((function variable) (push tag tags))
                 (type (setq tags
                             (nconc (semantic-tag-type-members tag)
                                    tags))))))
           (semanticdb-file-stream buffer-file-name))
          tags)))))

;;; checking ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defsubst doc-mode-position (element list)
  "Return the first position of ELEMENT in LIST.
Returns (length LIST) if no occurrence was found."
  (let ((pos 0))
    (while (and list (not (equal element (pop list))))
      (incf pos))
    pos))

(defun doc-mode-keyword< (a b tag)
  (if (equal (car a) "param")
      (let* ((args (mapcar 'semantic-tag-name
                          (semantic-tag-get-attribute tag :arguments)))
             (a-param (cadr a))
             (b-param (cadr b))
             (a-pos (doc-mode-position a-param args))
             (b-pos (doc-mode-position b-param args)))
        (if (= a-pos b-pos) 
             (string< a-param b-param)
          (< a-pos b-pos)))
    (string< (cadr a) (cadr b))))

(defun doc-mode-sort-keywords (keywords tag)
  (let ((lists (make-vector (1+ (length doc-mode-template-keywords)) nil))
        description)
    (dolist (k keywords)
      (if (or (stringp k) (and (eq (car k) 'prompt)))
          (push k description)
        (push k (elt lists (doc-mode-position (car k)
                                              doc-mode-template-keywords)))))
    (let ((i (length lists)) result)
      (while (> i 0)
        (setq result (nconc (sort (elt lists (decf i))
                                  (lambda (a b) (doc-mode-keyword< a b tag)))
                            result)))
      (nconc (nreverse description) result))))

(defun doc-mode-update-parameters (old new)
  "Cleanse and sort NEW parameters according to OLD parameter list."
  (let (params car-new)
    (while (setq car-new (pop new))
      (push (or (dolist (p old) ;; search for match in old
                  (when (equal (cadr p) car-new)
                    (setq old (delete p old))
                    (return p)))
                ;; this parameter wasn't there before
                (if (or (null old) (member (cadr (car old)) new))
                    ;; insertion, new
                    (doc-mode-new-keyword "param" car-new)
                  ;; the old parameter at this pos isn't there anymore, rename
                  (list* "param" car-new (cddr (pop old)))))
            params))
    (nreverse params)))

(defun doc-mode-keywords-from-tag (tag keywords)
  "Create keywords for a Semantic TAG, taking descriptions from old KEYWORDS"
  (let ((old-params (doc-mode-find-keyword "param" keywords))
        (new-params (mapcar 'semantic-tag-name
                            (semantic-tag-get-attribute tag :arguments))))
    ;; fix return value
    (if (doc-mode-has-return-value-p tag)
        ;; add
        (unless (doc-mode-find-keyword "return" keywords)
          (push (doc-mode-new-keyword "return") keywords))
      ;; remove
      (setq keywords (doc-mode-filter-keyword "return" keywords)))
    (unless (stringp (car keywords))
      (push `(prompt ,(format "Description for %s." (semantic-tag-name tag)))
            keywords))
    (doc-mode-sort-keywords (nconc (doc-mode-update-parameters old-params
                                                               new-params)
                                   (doc-mode-filter-keyword "param" keywords))
                            tag)))

;;;###autoload
(defun doc-mode-fix-tag-doc (tag)
  (interactive (list (doc-mode-current-tag-or-bust)))
  (let ((keywords (funcall doc-mode-keywords-from-tag-func
                           tag (doc-mode-extract-keywords-for-tag tag))))
    (doc-mode-remove-tag-doc tag)
    (doc-mode-insert-doc keywords (semantic-tag-start tag))
    ;; update lighter
    (doc-mode-check-buffer)))

;;;###autoload
(defalias 'doc-mode-add-tag-doc 'doc-mode-fix-tag-doc)

(defun doc-mode-format-message (type parameters)
  (when parameters
    (concat (case type
              ('missing "Missing")
              ('invalid "Invalid"))
            " parameter" (when (cdr parameters) "s") ": "
            (mapconcat 'identity parameters ", "))))

;;;###autoload
(defun doc-mode-check-tag-doc (tag &optional print-message-p)
  (interactive (list (doc-mode-current-tag-or-bust) t))
  (let* ((actual (doc-mode-extract-keywords-for-tag tag))
         (expected (mapcar 'semantic-tag-name
                           (semantic-tag-get-attribute tag :arguments))))
    (if actual
        (let ((no-doc-p (not (stringp (car actual))))
              ;; we only report parameters
              (actual (mapcar 'cadr (doc-mode-find-keyword "param"
                                                           actual)))
              invalid)
          (dolist (keyword actual)
            (if (member keyword expected)
                (setq expected (delete keyword expected))
              (push keyword invalid)))
          (when print-message-p
            (message "%s" (concat (and no-doc-p "Missing documentation")
                                  (and no-doc-p expected "\n")
                                  (doc-mode-format-message 'missing expected)
                                  (and (or no-doc-p expected) invalid "\n")
                                  (doc-mode-format-message 'invalid invalid))))
          (or no-doc-p expected invalid))
      (when print-message-p
        (message "Missing comment"))
      t)))

;;;###autoload
(defun doc-mode-check-buffer ()
  (interactive)
  (kill-local-variable 'doc-mode-lighter)
  (dolist (tag (doc-mode-find-eligible-tags))
    (when (doc-mode-check-tag-doc tag)
      (set (make-local-variable 'doc-mode-lighter) " doc!")
      (return t))))

(defun doc-mode-first-faulty-tag-doc ()
  (dolist (tag (sort (doc-mode-find-eligible-tags)
                     (lambda (a b) (< (semantic-tag-start a)
                                      (semantic-tag-start b)))))
    (when (doc-mode-check-tag-doc tag)
      (return tag))))

;;;###autoload
(defun doc-mode-next-faulty-doc ()
  "Jump to the next faulty documentation and print error."
  (interactive)
  (let ((tag (or (doc-mode-first-faulty-tag-doc)
                 (error "End of buffer"))))
    (push-mark)
    (goto-char (semantic-tag-start tag))
    ;; check again with message
    (doc-mode-check-tag-doc tag t)))

;;; folding ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar doc-mode-folds nil)
(make-variable-buffer-local 'doc-mode-folds)

(defun doc-mode-fold-doc (point)
  (let ((bounds (doc-mode-find-doc-bounds point)))
    (when bounds
      (let* ((beg (plist-get bounds :beg))
             (end (plist-get bounds :end))
             (summary-bounds (doc-mode-find-summary beg end))
             (before-overlay (make-overlay beg (car summary-bounds)))
             (after-overlay (make-overlay (cdr summary-bounds) end))
             (siblings (list before-overlay after-overlay)))
        (when (or doc-mode-fold-single-line-comments
                  (> (count-lines beg end) 1))
          (dolist (ov siblings)
            (overlay-put ov 'invisible t)
            (overlay-put ov 'isearch-open-invisible-temporary
                         'doc-mode-unfold-by-overlay-temporary)
            (overlay-put ov 'isearch-open-invisible 'doc-mode-unfold-by-overlay)
            (overlay-put ov 'doc-mode-fold siblings))
          (setq doc-mode-folds (nconc doc-mode-folds siblings)))))))

;;;###autoload
(defun doc-mode-fold-tag-doc (tag)
  "Fold the documentation for TAG.
If called interactively, use the tag given by `doc-mode-current-tag'."
  (interactive (list (doc-mode-current-tag-or-bust)))
  (unless doc-mode
    (error "doc-mode not enabled"))
  (doc-mode-fold-doc (semantic-tag-start tag)))

(defun doc-mode-unfold-by-overlay (overlay &rest foo)
  "Unfold OVERLAY and its siblings permanently"
  (dolist (ov (overlay-get overlay 'doc-mode-fold))
    ;; remove overlay
    (setq doc-mode-folds (delq ov doc-mode-folds))
    (delete-overlay ov)
    ;; don't let isearch do anything with it
    (setq isearch-opened-overlays (delq ov isearch-opened-overlays))))

(defun doc-mode-unfold-by-overlay-temporary (overlay invisible)
  "Unfold OVERLAY and its siblings temporarily."
  (dolist (ov (overlay-get overlay 'doc-mode-fold))
    (overlay-put ov 'invisible invisible)))

;;;###autoload
(defun doc-mode-unfold-doc (point)
  "Unfold the comment before POINT."
  (interactive "d")
  (unless doc-mode
    (error "doc-mode not enabled"))
  (let ((bounds (doc-mode-find-doc-bounds point)))
    (when bounds
      (let* ((beg (plist-get bounds :beg))
             (end (plist-get bounds :end))
             (overlays (overlays-in beg end))
             anything-done)
        (dolist (ov overlays)
          (when (overlay-get ov 'doc-mode-fold)
            (setq anything-done t)
            (delete-overlay ov)
            (setq doc-mode-folds (delq ov doc-mode-folds))))
        ;; return non-nil, if anything unfolded
        ;; this is used to toggle
        anything-done))))

;;;###autoload
(defun doc-mode-unfold-tag-doc (tag)
  "Unfold the documentation for TAG.
If called interactively, use the tag given by `doc-mode-current-tag'."
  (interactive (list (doc-mode-current-tag-or-bust)))
  (unless doc-mode
    (error "doc-mode not enabled"))
  (doc-mode-unfold-doc (semantic-tag-start tag)))

;;;###autoload
(defun doc-mode-fold-all (&optional arg)
  (interactive "P")
  (unless doc-mode
    (error "doc-mode not enabled"))
  (if arg
      (doc-mode-unfold-all)
    (dolist (tag (doc-mode-find-eligible-tags))
      (doc-mode-fold-tag-doc tag))))

;;;###autoload
(defun doc-mode-unfold-all ()
  (interactive)
  (dolist (ov doc-mode-folds)
    (delete-overlay ov))
  (kill-local-variable 'doc-mode-folds))

;;; toggle

;;;###autoload
(defun doc-mode-toggle-tag-doc-folding (tag)
  "Toggle folding of TAG's documentation.
If called interactively, use the tag given by `doc-mode-current-tag'."
  (interactive (list (doc-mode-current-tag-or-bust)))
  (or (doc-mode-unfold-tag-doc tag)
      (doc-mode-fold-tag-doc tag)))

(provide 'doc-mode)

;;; doc-mode.el ends here
