emacs/.emacs.d/site-lisp/doc-mode.el

   1 ;;; doc-mode.el --- convenient editing of in-code documentation
   2 ;;
   3 ;; Copyright (C) 2007, 2009 Nikolaj Schumacher
   4 ;; Author: Nikolaj Schumacher <bugs * nschum de>
   5 ;; Version: 0.2
   6 ;; Keywords: convenience tools
   7 ;; URL: http://nschum.de/src/emacs/doc-mode/
   8 ;; Compatibility: GNU Emacs 22.x, GNU Emacs 23.x
   9 ;;
  10 ;; This file is NOT part of GNU Emacs.
  11 ;;
  12 ;; This program is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License
  14 ;; as published by the Free Software Foundation; either version 2
  15 ;; of the License, or (at your option) any later version.
  16 ;;
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21 ;;
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  24 ;;
  25 ;;; Commentary:
  26 ;;
  27 ;; This mode requires the Semantic package to be installed and running:
  28 ;; http://cedet.sourceforge.net/
  29 ;;
  30 ;; doc-mode allows easy creation and editing of JavaDoc or Doxygen comment
  31 ;; blocks in your code.  It also greatly improves readability of code by folding
  32 ;; the blocks, so they don't take up precious screen lines.
  33 ;;
  34 ;; Add the following to your .emacs file:
  35 ;; (require 'doc-mode)
  36 ;; (add-hook 'c-mode-common-hook 'doc-mode)
  37 ;;
  38 ;; The command `doc-mode-fix-tag-doc' or "C-cdd" adds or replaces the
  39 ;; documentation for the function, variable, or class at point.
  40 ;; `doc-mode-remove-tag-doc' or "C-cdr" removes it.
  41 ;;
  42 ;; You can fold the comments by using `doc-mode-toggle-tag-doc-folding' or
  43 ;; `doc-mode-fold-all'.
  44 ;;
  45 ;;; Change Log:
  46 ;;
  47 ;; 2009-03-22 (0.2)
  48 ;;    Added `doc-mode-keywords-from-tag-func' as customizable option.
  49 ;;    Improved parameter list change recognition.
  50 ;;    `doc-mode-jump-to-template' now enables jumping to the latest comment.
  51 ;;    `doc-mode-first-template' now jumps to the first template in this buffer.
  52 ;;
  53 ;; 2007-09-09 (0.1.1)
  54 ;;    Fixed return value detection.
  55 ;;    Actual keyword highlighting.
  56 ;;
  57 ;; 2007-09-07 (0.1)
  58 ;;    Initial release.
  59 ;;
  60 ;;; Code:
  61
  62 (eval-when-compile (require 'cl))
  63 (require 'semantic)
  64 (require 'cc-mode)
  65 (require 'newcomment) ;comment-fill-column
  66
  67 (dolist (err `("^No tag found$" "^Semantic can't parse buffer$"
  68                "^No template found$" "^doc-mode not enabled$"))
  69   (add-to-list 'debug-ignored-errors err))
  70
  71 ;; semantic-after-auto-parse-hooks
  72
  73 (defgroup doc-mode nil
  74   "Minor mode for editing in-code documentation."
  75   :group 'convenience
  76   :group 'tools)
  77
  78 (defcustom doc-mode-auto-check-p t
  79   "*Should the buffer documentation be checked after a Semantic reparse."
  80   :group 'doc-mode
  81   :type '(choice (const :tag "Off" nil)
  82                  (const :tag "On" t)))
  83
  84 (defcustom doc-mode-jump-to-template t
  85   "*Should the point be moved inside the template after inserting a doc."
  86   :group 'doc-mode
  87   :type '(choice (const :tag "Off" nil)
  88                  (const :tag "On" t)))
  89
  90 (defcustom doc-mode-template-start "/**"
  91   "*The string to insert at the beginning of a comment."
  92   :group 'doc-mode
  93   :type 'string)
  94
  95 (defcustom doc-mode-template-end " */"
  96   "*The string to insert at the end of a comment."
  97   :group 'doc-mode
  98   :type 'string)
  99
 100 (defcustom doc-mode-template-continue " * "
 101   "*The string to insert at the beginning of each line in a comment."
 102   :group 'doc-mode
 103   :type 'string)
 104
 105 (defcustom doc-mode-template-single-line-start "/** "
 106   "*The string to insert at the beginning of a single-line comment.
 107 For using single-line comments, see `doc-mode-allow-single-line-comments'"
 108   :group 'doc-mode
 109   :type 'string)
 110
 111 (defcustom doc-mode-template-single-line-end " */"
 112   "*The string to insert at the end of a single-line comment.
 113 For using single-line comments, see `doc-mode-allow-single-line-comments'"
 114   :group 'doc-mode
 115   :type 'string)
 116
 117 (defcustom doc-mode-template-keyword-char "@"
 118   "*The character used to begin keywords."
 119   :group 'doc-mode
 120   :type '(choice (const :tag "@" "@")
 121                  (const :tag "\\" "\\")
 122                  (string :tag "Other")))
 123
 124 (defcustom doc-mode-template-empty-line-after-summary nil
 125   "*Whether to put an empty line after the first one in the comment."
 126   :group 'doc-mode
 127   :type '(choice (const :tag "Off" nil)
 128                  (const :tag "On" t)))
 129
 130 (defcustom doc-mode-template-empty-line-before-keywords nil
 131   "*Whether to put an empty line before the keyword list in a comment."
 132   :group 'doc-mode
 133   :type '(choice (const :tag "Off" nil)
 134                  (const :tag "On" t)))
 135
 136 (defcustom doc-mode-template-keywords
 137   '("deprecated" "param" "return" "author" "exception" "throws" "version"
 138     "since" "see" "sa" "todo")
 139   "*Keywords that should be listed in this order.
 140 All other keywords will be considered regular text."
 141   :group 'doc-mode
 142   :type '(repeat string))
 143
 144 (defcustom doc-mode-allow-single-line-comments t
 145   "*Whether to allow a more space-saving format for very short comments.
 146 When this is enabled, `doc-mode-template-single-line-start' and
 147 `doc-mode-template-single-line-end' will be used to format single-line
 148 comments instead of `doc-mode-template-start', `doc-mode-template-end' and
 149 `doc-mode-template-continue'."
 150   :group 'doc-mode
 151   :type '(choice (const :tag "Off" nil)
 152                  (const :tag "On" t)))
 153
 154 (defcustom doc-mode-fold-single-line-comments nil
 155   "*Whether to bother folding comments that are already a single line."
 156   :group 'doc-mode
 157   :type '(choice (const :tag "Off" nil)
 158                  (const :tag "On" t)))
 159
 160 (defcustom doc-mode-align-keyword-arguments t
 161   "*Whether to align the arguments to a keyword continued in the next line.
 162 This may also be a number, describing how far to indent the argument list."
 163   :group 'doc-mode
 164   :type '(choice (const :tag "Off" nil)
 165                  (integer :tag "Indent" nil)
 166                  (const :tag "On" t)))
 167
 168 (defcustom doc-mode-fill-column nil
 169   "*The column at which to break text when formatting it.
 170 If this is nil, `comment-fill-column' is used."
 171   :group 'doc-mode
 172   :type '(choice (const :tag "Default" nil)
 173                  (integer :tag "Fill Column")))
 174
 175 (defcustom doc-mode-keywords-from-tag-func 'doc-mode-keywords-from-tag
 176   "*Function used to generate keywords for a tag.
 177 This must be a function that takes two arguments.  The first argument is the
 178 Semantic tag for which to generate keywords, the second is a list of existing
 179 keywords taken from the current doc comment.  It should return the new list of
 180 keywords.  Each element in a keyword list can be either a string or a list with
 181 a keyword, optional argument and optional description.  Additional entries with
 182 undetermined content should be created with `doc-mode-new-keyword'."
 183   :group 'doc-mode
 184   :type 'function)
 185
 186 ;;; keywords ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 187
 188 (defconst doc-mode-font-lock-keywords
 189   (eval-when-compile
 190     `((,(concat "[\\@]"
 191          (regexp-opt
 192           '("addindex" "addtogroup" "anchor" "arg" "author" "brief" "callgraph"
 193             "callergraph" "category" "code" "cond" "copydoc" "date" "defgroup"
 194             "deprecated" "details" "dir" "dontinclude" "dot" "dotfile" "e"
 195             "else" "elseif" "em" "endcode" "endcond" "enddot" "endhtmlonly"
 196             "endif" "endlatexonly" "endlink" "endmanonly" "endmsc" "endverbatim"
 197             "endxmlonly" "example" "f$" "f[" "f]" "file" "fn" "hideinitializer"
 198             "htmlinclude" "htmlonly" "if" "ifnot" "image" "include"
 199             "includelineno" "ingroup" "internal" "invariant" "latexonly" "li"
 200             "line" "link" "mainpage" "manonly" "msc" "name" "nosubgrouping"
 201             "note" "overload" "package" "page" "par" "paragraph"  "post" "pre"
 202             "private" "privatesection" "property" "protected" "protectedsection"
 203             "public" "publicsection" "ref" "remarks" "return" "retval" "sa"
 204             "section" "see" "serial" "serialData" "serialField"
 205             "showinitializer" "since" "skip" "skipline" "subpage" "subsection"
 206             "subsubsection" "test" "typedef" "until" "defvar" "verbatim"
 207             "verbinclude" "version" "weakgroup" "xmlonly" "xrefitem" "$" "@"
 208             "\\" "&" "~" "<" ">" "#" "%") t)
 209          "\\>")
 210        (0 font-lock-keyword-face prepend))
 211       ;; don't highlight \n, it's too common in code
 212       ("@n" (0 font-lock-keyword-face prepend))
 213       (,(concat "\\([@\\]"
 214          (regexp-opt '("class" "struct" "union" "exception" "enum" "throw"
 215                        "throws") t)
 216          "\\)\\>\\(?:[ \t]+\\(\\sw+\\)\\)?")
 217        (1 font-lock-keyword-face prepend)
 218        (3 font-lock-type-face prepend))
 219       (,(concat "\\([@\\]"
 220          (regexp-opt '("param" "param[in]" "param[out]" "param[in+out]" "a"
 221                        "namespace" "relates" "relatesalso" "def") t)
 222          "\\)\\>\\(?:[ \t]+\\(\\sw+\\)\\)?")
 223        (1 font-lock-keyword-face prepend)
 224        (3 font-lock-variable-name-face prepend))
 225       (,(concat "\\([@\\]retval\\)\\>\\(?:[ \t]+\\(\\sw+\\)\\)?")
 226        (1 font-lock-keyword-face prepend)
 227        (2 font-lock-function-name-face prepend))
 228       (,(concat "[@\\]" (regexp-opt '("attention" "warning" "todo" "bug") t)
 229                 "\\>")
 230        (0 font-lock-warning-face prepend))
 231       (,(concat "{@"
 232          (regexp-opt '("docRoot" "inheritDoc" "link" "linkplain" "value") t)
 233          "}")
 234        (0 font-lock-keyword-face prepend))
 235       ("\\([@\\]b\\)[ \t\n]+\\([^ \t\n]+\\)"
 236        (1 font-lock-keyword-face prepend)
 237        (2 'bold prepend))
 238       ("\\([@\\]em?\\)[ \t\n]+\\([^ \t\n]+\\)"
 239        (1 font-lock-keyword-face prepend)
 240        (2 'italic prepend))
 241       ("\\([@\\][cp]\\)[ \t\n]+\\([^ \t\n]+\\)"
 242        (1 font-lock-keyword-face prepend)
 243        (2 'underline prepend)))))
 244
 245 ;;; templates ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 246
 247 (defvar doc-mode-templates nil)
 248 (make-variable-buffer-local 'doc-mode-templates)
 249
 250 (defun doc-mode-add-template (beg end)
 251   (let ((overlay (make-overlay beg (point))))
 252     (overlay-put overlay 'intangible t)
 253     (overlay-put overlay 'face 'highlight)
 254     (overlay-put overlay 'insert-in-front-hooks '(doc-mode-replace-overlay))
 255     (overlay-put overlay 'modification-hooks '(doc-mode-delete-overlay))
 256     (push overlay doc-mode-templates)))
 257
 258 (defvar doc-mode-temp nil)
 259
 260 (defun doc-mode-delete-overlay (ov after-p beg end &optional r)
 261   (unless after-p
 262     (mapc 'doc-mode-unfold-by-overlay
 263           (overlays-in (1- (overlay-start ov)) (1+ (overlay-end ov))))
 264     (delete-overlay ov)
 265     (setq doc-mode-templates (delq ov doc-mode-templates))))
 266
 267 (defun doc-mode-replace-overlay (ov after-p beg end &optional r)
 268   (unless after-p
 269     (let ((inhibit-modification-hooks nil))
 270       (delete-region (overlay-start ov) (overlay-end ov)))))
 271
 272 ;;;###autoload
 273 (defun doc-mode-next-template (&optional pos limit)
 274   "Jump to the next unfinished documentation template in this buffer."
 275   (interactive)
 276   (unless pos (setq pos (point)))
 277   (unless limit (setq limit (point-max)))
 278   (let ((min-start limit)
 279         start)
 280     (dolist (ov doc-mode-templates)
 281       (setq start (overlay-start ov))
 282       (and (> start pos)
 283            (< start min-start)
 284            (setq min-start start)))
 285     (when (= min-start limit)
 286       (error "End of buffer"))
 287     (push-mark)
 288     (goto-char min-start)))
 289
 290 ;;;###autoload
 291 (defun doc-mode-previous-template (&optional pos limit)
 292   "Jump to the previous unfinished documentation template in this buffer."
 293   (interactive)
 294   (unless pos (setq pos (point)))
 295   (unless limit (setq limit (point-min)))
 296   (let ((max-start limit)
 297         start)
 298     (dolist (ov doc-mode-templates)
 299       (setq start (overlay-start ov))
 300       (and (< start pos)
 301            (> start max-start)
 302            (setq max-start start)))
 303     (when (= max-start limit)
 304       (error "Beginning of buffer"))
 305     (push-mark)
 306     (goto-char max-start)))
 307
 308 ;;;###autoload
 309 (defun doc-mode-first-template ()
 310   "Jump to the first unfinished documentation template in this buffer."
 311   (interactive)
 312   (condition-case err
 313       (doc-mode-next-template (point-min))
 314     (error (error "No template found"))))
 315
 316 ;;; mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317
 318 (defvar doc-mode-lighter " doc")
 319
 320 (defvar doc-mode-prefix-map
 321   (let ((map (make-sparse-keymap)))
 322     (define-key map "d" 'doc-mode-fix-tag-doc)
 323     (define-key map "c" 'doc-mode-check-tag-doc)
 324     (define-key map "t" 'doc-mode-toggle-tag-doc-folding)
 325     (define-key map "f" 'doc-mode-fold-tag-doc)
 326     (define-key map "u" 'doc-mode-unfold-tag-doc)
 327     (define-key map "r" 'doc-mode-remove-tag-doc)
 328     (define-key map "i" 'doc-mode-add-tag-doc)
 329     (define-key map "e" 'doc-mode-next-faulty-doc)
 330     (define-key map "n" 'doc-mode-next-template)
 331     (define-key map "\C-c" 'doc-mode-check-buffer)
 332     (define-key map "\C-f" 'doc-mode-fold-all)
 333     (define-key map "\C-u" 'doc-mode-unfold-all)
 334     map))
 335
 336 (defvar doc-mode-map
 337   (let ((map (make-sparse-keymap)))
 338     (define-key map "\C-c\C-d" doc-mode-prefix-map)
 339     map)
 340   "Keymap used for `doc-mode'.")
 341
 342 ;;;###autoload
 343 (define-minor-mode doc-mode
 344   "Minor mode for editing in-code documentation."
 345   nil doc-mode-lighter doc-mode-map
 346   (if doc-mode
 347       (progn
 348         (font-lock-add-keywords nil doc-mode-font-lock-keywords)
 349         (when doc-mode-auto-check-p
 350           (add-hook 'semantic-after-auto-parse-hooks 'doc-mode-check-buffer
 351                     nil t)
 352           (add-hook 'semantic-after-idle-scheduler-reparse-hooks
 353                     'doc-mode-check-buffer nil t)))
 354     (dolist (ov doc-mode-templates)
 355       (delete-overlay ov))
 356     (kill-local-variable 'doc-mode-templates)
 357     (doc-mode-unfold-all)
 358     (font-lock-remove-keywords nil doc-mode-font-lock-keywords)
 359     (remove-hook 'semantic-after-auto-parse-hooks 'doc-mode-check-buffer t)
 360     (remove-hook 'semantic-after-idle-scheduler-reparse-hooks
 361                  'doc-mode-check-buffer t))
 362
 363   (when font-lock-mode
 364     (font-lock-fontify-buffer)))
 365
 366 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 367
 368 (defun doc-mode-current-tag ()
 369   (when (semantic-parse-tree-unparseable-p)
 370     (error "Semantic can't parse buffer"))
 371   (when (or (semantic-parse-tree-needs-rebuild-p)
 372             (semantic-parse-tree-needs-update-p))
 373     (condition-case nil
 374         (semantic-fetch-tags)
 375       (error (error "Semantic can't parse buffer"))))
 376   (save-excursion
 377     (or (semantic-current-tag-of-class 'function)
 378         (semantic-current-tag-of-class 'variable)
 379         (progn (beginning-of-line) (skip-chars-forward " \t\n") nil)
 380         (semantic-current-tag-of-class 'function)
 381         (semantic-current-tag-of-class 'variable)
 382         (if (not (looking-at "/\\*\\*"))
 383             (semantic-current-tag-of-class 'type)
 384           (progn (search-forward "*/" nil t)
 385                  (skip-chars-forward " \t\n")
 386                  nil))
 387         (semantic-current-tag-of-class 'function)
 388         (semantic-current-tag-of-class 'variable)
 389         (semantic-current-tag-of-class 'type))))
 390
 391 (defun doc-mode-current-tag-or-bust ()
 392   (or (doc-mode-current-tag) (error "No tag found")))
 393
 394 ;;; insertion ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 395
 396 (defun doc-mode-line-indent (keyword)
 397   "Determine left side offset when indenting LINE."
 398   (if (numberp doc-mode-align-keyword-arguments)
 399       doc-mode-align-keyword-arguments
 400     (+ 1 (length (car keyword))
 401        (if (equal (car keyword) "param")
 402            (1+ (length (cdr keyword)))
 403          0))))
 404
 405 (defun doc-mode-insert (text)
 406   "Insert TEXT if a string, or a template if 'prompt."
 407   (if (stringp text)
 408       (insert text)
 409     (let ((beg (point)))
 410       (insert (cadr text))
 411       (when doc-mode
 412         (doc-mode-add-template beg (point))))))
 413
 414 (defun doc-mode-insert-markup (markup &optional argument description)
 415   (insert doc-mode-template-keyword-char markup)
 416   (when argument
 417     (insert " ")
 418     (doc-mode-insert argument))
 419   (when description
 420     (insert " ")
 421     (doc-mode-insert description)))
 422
 423 (defun doc-mode-insert-line (line indent)
 424   (indent-to-column indent)
 425   (let ((beg (point)))
 426     (insert doc-mode-template-continue)
 427     (if (and (consp line) (not (eq (car line) 'prompt)))
 428         (apply 'doc-mode-insert-markup line)
 429       (doc-mode-insert line))
 430     (delete-char (- (skip-chars-backward " \t")))
 431     (when (> (point) (+ beg 2))
 432       (save-excursion (fill-region beg (point) 'left t)))
 433     (insert "\n")))
 434
 435 (defun doc-mode-insert-keyword (keyword indent)
 436   (indent-to-column indent)
 437   (let ((fill-column (or doc-mode-fill-column comment-fill-column fill-column))
 438         (fill-prefix (when doc-mode-align-keyword-arguments
 439                        (concat (buffer-substring (point-at-bol) (point))
 440                                doc-mode-template-continue
 441                                (make-string (doc-mode-line-indent keyword)
 442                                             ? )))))
 443     (doc-mode-insert-line keyword indent)))
 444
 445 (defun doc-mode-insert-doc (keywords &optional pos)
 446   "Insert a documentation at POS.
 447 LINES is a list of keywords."
 448   (save-excursion
 449     (if pos
 450         (goto-char pos)
 451       (setq pos (point)))
 452     (let ((indent (current-column)))
 453
 454       (if (and (not (cdr keywords)) doc-mode-allow-single-line-comments)
 455           (progn (insert doc-mode-template-single-line-start)
 456                  (doc-mode-insert (car keywords))
 457                  (insert doc-mode-template-single-line-end "\n"))
 458         (insert doc-mode-template-start "\n")
 459
 460         ;; first line
 461         (when (or (stringp (car keywords))
 462                   (eq 'prompt (caar keywords)))
 463           (doc-mode-insert-line (pop keywords) indent))
 464
 465         (when (and doc-mode-template-empty-line-after-summary
 466                    (or (null doc-mode-template-empty-line-before-keywords)
 467                        (stringp (cadr keywords))))
 468           (doc-mode-insert-line "" indent))
 469
 470         ;; paragraphs
 471         (if (cdr keywords)
 472             (while (stringp (car keywords))
 473               (doc-mode-insert-line (pop keywords) indent)
 474               (when (stringp (car keywords))
 475                 (doc-mode-insert-line "" indent)))
 476           (while (stringp (car keywords))
 477             (doc-mode-insert-line (pop keywords) indent)))
 478
 479         (when doc-mode-template-empty-line-before-keywords
 480           (doc-mode-insert-line "" indent))
 481
 482         ;; keywords
 483         (while keywords
 484           (doc-mode-insert-keyword (pop keywords) indent))
 485         (indent-to-column indent)
 486         (insert doc-mode-template-end "\n"))
 487
 488       ;; re-indent original line
 489       (if (< (current-column) indent)
 490           (indent-to-column indent)
 491         (move-to-column indent t))))
 492
 493     (and doc-mode-jump-to-template doc-mode-templates
 494          (ignore-errors (doc-mode-next-template pos (point)))))
 495
 496 (defun doc-mode-remove-doc (point)
 497   "Remove the documentation before POINT."
 498   (let* ((bounds (doc-mode-find-doc-bounds point))
 499          (beg (plist-get bounds :beg))
 500          (end (plist-get bounds :end)))
 501     (when bounds
 502       (save-excursion
 503         (goto-char beg)
 504         (incf beg (skip-chars-backward " \t"))
 505         (goto-char end)
 506         (incf end (skip-chars-forward " \t"))
 507         (when (eolp) (incf end))
 508         (delete-region beg end)))))
 509
 510 ;;;###autoload
 511 (defun doc-mode-remove-tag-doc (tag)
 512   "Remove the documentation for TAG.
 513 If called interactively, use the tag given by `doc-mode-current-tag'."
 514   (interactive (list (doc-mode-current-tag-or-bust)))
 515   (doc-mode-remove-doc (semantic-tag-start tag)))
 516
 517 ;;; registering ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 518
 519 (defun doc-mode-find-doc-bounds (pos)
 520   "Find the documentation right before POS.
 521 If there is anything but whitespace between the documentation and POS, nil is
 522 returned.  Otherwise a cons of the doc's beginning and end is given."
 523   (let (end)
 524     (save-excursion
 525       (goto-char pos)
 526       (when (re-search-backward "[ \t]*\n[ \t]*\\=" nil t)
 527         (setq end (point))
 528         (cond
 529          ;; /// Doxygen comment */
 530          ((looking-back "[ \t]*//[/!]\\(.*\\)$")
 531           (forward-line -1)
 532           (while (looking-at "[ \t]*//[/!]\\(.*\\)$")
 533             (forward-line -1))
 534           (forward-line 1)
 535           (skip-chars-forward " \t")
 536           `(:beg ,(point) :end ,end :column ,(current-indentation)))
 537          ;; /** JavaDoc comment */
 538          ((looking-back "\\*/")
 539           (goto-char (match-beginning 0))
 540           ;; search for /*, not allowing any */ in between
 541           (when (and (re-search-backward "\\(/\\*\\)\\|\\*/" nil t)
 542                      (match-beginning 1)
 543                      (memq (char-after (1+ (match-beginning 1))) '(?! ?*)))
 544             `(:beg ,(point) :end ,end :column ,(current-column)))))))))
 545
 546 ;;; formating ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 547
 548 (defun doc-mode-new-keyword (keyword &optional argument)
 549   (if (equal keyword "param")
 550       (list keyword argument '(prompt "<doc>"))
 551     (list keyword '(prompt "<doc>"))))
 552
 553 (defun doc-mode-has-return-value-p (tag)
 554   "Test if TAG has a return value to format."
 555   (and (eq (semantic-tag-class tag) 'function)
 556        (not (equal (semantic-tag-type tag) "void"))
 557        (not (semantic-tag-get-attribute tag :constructor-flag))
 558        (or (not (equal (semantic-tag-type tag) "int"))
 559            ;; semantic bug, constructors sometimes appear to have int type
 560            (save-excursion (goto-char (semantic-tag-start tag))
 561                            (and (re-search-forward "\\(\\<int\\>\\)\\|{\\|;"
 562                                                    (semantic-tag-end tag) t)
 563                                 (match-beginning 1))))))
 564
 565 ;;; extracting ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 566
 567 (defun doc-mode-extract-summary (beg end)
 568   (let ((bounds (doc-mode-find-summary beg end)))
 569     (buffer-substring-no-properties (car bounds) (cdr bounds))))
 570
 571 (defun doc-mode-find-summary (beg end)
 572   (save-excursion
 573     (goto-char beg)
 574     (if (or (re-search-forward "^[@\\]brief \\([^\t ][^\n]*\n\\)" end t)
 575             (re-search-forward "\\<\\(.*\\)\\(\\*+/\\|\n\\)" end t))
 576         (cons (match-beginning 1) (match-end 1))
 577       (cons beg beg))))
 578
 579 (defconst doc-mode-begin-regexp
 580   (eval-when-compile (concat "[ \t\n]*"
 581                              "\\("
 582                              "/\\*\\(\\*+\\|!\\)"
 583                              "\\|"
 584                              "//[!/]"
 585                              "\\)[ \t]*")))
 586
 587 (defun doc-mode-clean-doc (beg end)
 588   "Remove the comment delimiters between BEG and END."
 589   (save-excursion
 590     (goto-char beg)
 591     (when (looking-at doc-mode-begin-regexp)
 592       (setq beg (match-end 0)))
 593     (goto-char end)
 594     (when (looking-back "[ \t\n\r]*\\*+/" nil t)
 595       (setq end (match-beginning 0)))
 596     (let ((lines (split-string (buffer-substring-no-properties beg end)
 597                                "[ \t]*\n[ \t]*\\(\\*/?\\|//[!/]\\)?[ \t]*")))
 598       (while (equal (car lines) "")
 599         (pop lines))
 600       (mapconcat 'identity lines "\n"))))
 601
 602 (defun doc-mode-extract-keywords (beg end)
 603   "Extract documentation keywords between BEG and END.
 604 Returns a alist of keywords, where each element is the list (keyword
 605 argument value) or (keyword argument)."
 606   (let* ((paragraphs (doc-mode-clean-doc beg end))
 607          (doc "")
 608          (pos 0)
 609          match results)
 610
 611     (when (string-match
 612            "[ \t\n]*\\(\\(.\\|\n\\)*?\\)\\([@\\]\\<\\(.\\|\n\\)*\\'\\)"
 613            paragraphs)
 614       (setq doc (match-string-no-properties 3 paragraphs)
 615             paragraphs (match-string-no-properties 1 paragraphs)))
 616
 617     ;; first line summary
 618     (when (string-match "\\`[ \t\n]*\\(.+\\.\\)\\([ \n]+\\|\\'\\)" paragraphs)
 619       (push (match-string 1 paragraphs) results)
 620       (setq pos (match-end 0)))
 621
 622     ;; other paragraphs
 623     (dolist (paragraph (split-string (substring paragraphs pos)
 624                                      "[ \t]*\n\\(\n+[ \t]*\\|$\\)" t))
 625       (push (replace-regexp-in-string "[\n\r]" " " paragraph) results))
 626
 627     ;; keywords
 628     (dolist (keyword (cdr (split-string doc "[@\\]\\<")))
 629       (setq match (split-string keyword))
 630       (push (if (equal (car match) "param")
 631                 (list (car match) (cadr match)
 632                       (mapconcat 'identity (cddr match) " "))
 633               (list (car match) (mapconcat 'identity (cdr match) " ")))
 634             results))
 635     (nreverse results)))
 636
 637 (defun doc-mode-extract-keywords-for-tag (tag)
 638   (let ((bounds (doc-mode-find-doc-bounds (semantic-tag-start tag))))
 639     (when bounds (doc-mode-extract-keywords (plist-get bounds :beg)
 640                                             (plist-get bounds :end)))))
 641
 642 (defun doc-mode-find-keyword (keyword keywords)
 643   (when keywords
 644     (if (and (consp (car keywords)) (string= (car (car keywords)) keyword))
 645         (cons (car keywords) (doc-mode-find-keyword keyword (cdr keywords)))
 646       (doc-mode-find-keyword keyword (cdr keywords)))))
 647
 648 (defun doc-mode-filter-keyword (keyword keywords)
 649   (when keywords
 650     (if (and (consp (car keywords)) (string= (car (car keywords)) keyword))
 651         (doc-mode-filter-keyword keyword (cdr keywords))
 652       (cons (car keywords) (doc-mode-filter-keyword keyword (cdr keywords))))))
 653
 654 (defun doc-mode-find-eligible-tags ()
 655   (when buffer-file-name
 656     (unless (or (semantic-parse-tree-unparseable-p)
 657                 (semantic-parse-tree-needs-rebuild-p)
 658                 (semantic-parse-tree-needs-update-p))
 659       (ignore-errors
 660         (let (tags)
 661           (semantic-brute-find-tag-by-function
 662            (lambda (tag)
 663              (when (semantic-tag-start tag)
 664                (case (semantic-tag-class tag)
 665                  ((function variable) (push tag tags))
 666                  (type (setq tags
 667                              (nconc (semantic-tag-type-members tag)
 668                                     tags))))))
 669            (semanticdb-file-stream buffer-file-name))
 670           tags)))))
 671
 672 ;;; checking ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 673
 674 (defsubst doc-mode-position (element list)
 675   "Return the first position of ELEMENT in LIST.
 676 Returns (length LIST) if no occurrence was found."
 677   (let ((pos 0))
 678     (while (and list (not (equal element (pop list))))
 679       (incf pos))
 680     pos))
 681
 682 (defun doc-mode-keyword< (a b tag)
 683   (if (equal (car a) "param")
 684       (let* ((args (mapcar 'semantic-tag-name
 685                           (semantic-tag-get-attribute tag :arguments)))
 686              (a-param (cadr a))
 687              (b-param (cadr b))
 688              (a-pos (doc-mode-position a-param args))
 689              (b-pos (doc-mode-position b-param args)))
 690         (if (= a-pos b-pos)
 691              (string< a-param b-param)
 692           (< a-pos b-pos)))
 693     (string< (cadr a) (cadr b))))
 694
 695 (defun doc-mode-sort-keywords (keywords tag)
 696   (let ((lists (make-vector (1+ (length doc-mode-template-keywords)) nil))
 697         description)
 698     (dolist (k keywords)
 699       (if (or (stringp k) (and (eq (car k) 'prompt)))
 700           (push k description)
 701         (push k (elt lists (doc-mode-position (car k)
 702                                               doc-mode-template-keywords)))))
 703     (let ((i (length lists)) result)
 704       (while (> i 0)
 705         (setq result (nconc (sort (elt lists (decf i))
 706                                   (lambda (a b) (doc-mode-keyword< a b tag)))
 707                             result)))
 708       (nconc (nreverse description) result))))
 709
 710 (defun doc-mode-update-parameters (old new)
 711   "Cleanse and sort NEW parameters according to OLD parameter list."
 712   (let (params car-new)
 713     (while (setq car-new (pop new))
 714       (push (or (dolist (p old) ;; search for match in old
 715                   (when (equal (cadr p) car-new)
 716                     (setq old (delete p old))
 717                     (return p)))
 718                 ;; this parameter wasn't there before
 719                 (if (or (null old) (member (cadr (car old)) new))
 720                     ;; insertion, new
 721                     (doc-mode-new-keyword "param" car-new)
 722                   ;; the old parameter at this pos isn't there anymore, rename
 723                   (list* "param" car-new (cddr (pop old)))))
 724             params))
 725     (nreverse params)))
 726
 727 (defun doc-mode-keywords-from-tag (tag keywords)
 728   "Create keywords for a Semantic TAG, taking descriptions from old KEYWORDS"
 729   (let ((old-params (doc-mode-find-keyword "param" keywords))
 730         (new-params (mapcar 'semantic-tag-name
 731                             (semantic-tag-get-attribute tag :arguments))))
 732     ;; fix return value
 733     (if (doc-mode-has-return-value-p tag)
 734         ;; add
 735         (unless (doc-mode-find-keyword "return" keywords)
 736           (push (doc-mode-new-keyword "return") keywords))
 737       ;; remove
 738       (setq keywords (doc-mode-filter-keyword "return" keywords)))
 739     (unless (stringp (car keywords))
 740       (push `(prompt ,(format "Description for %s." (semantic-tag-name tag)))
 741             keywords))
 742     (doc-mode-sort-keywords (nconc (doc-mode-update-parameters old-params
 743                                                                new-params)
 744                                    (doc-mode-filter-keyword "param" keywords))
 745                             tag)))
 746
 747 ;;;###autoload
 748 (defun doc-mode-fix-tag-doc (tag)
 749   (interactive (list (doc-mode-current-tag-or-bust)))
 750   (let ((keywords (funcall doc-mode-keywords-from-tag-func
 751                            tag (doc-mode-extract-keywords-for-tag tag))))
 752     (doc-mode-remove-tag-doc tag)
 753     (doc-mode-insert-doc keywords (semantic-tag-start tag))
 754     ;; update lighter
 755     (doc-mode-check-buffer)))
 756
 757 ;;;###autoload
 758 (defalias 'doc-mode-add-tag-doc 'doc-mode-fix-tag-doc)
 759
 760 (defun doc-mode-format-message (type parameters)
 761   (when parameters
 762     (concat (case type
 763               ('missing "Missing")
 764               ('invalid "Invalid"))
 765             " parameter" (when (cdr parameters) "s") ": "
 766             (mapconcat 'identity parameters ", "))))
 767
 768 ;;;###autoload
 769 (defun doc-mode-check-tag-doc (tag &optional print-message-p)
 770   (interactive (list (doc-mode-current-tag-or-bust) t))
 771   (let* ((actual (doc-mode-extract-keywords-for-tag tag))
 772          (expected (mapcar 'semantic-tag-name
 773                            (semantic-tag-get-attribute tag :arguments))))
 774     (if actual
 775         (let ((no-doc-p (not (stringp (car actual))))
 776               ;; we only report parameters
 777               (actual (mapcar 'cadr (doc-mode-find-keyword "param"
 778                                                            actual)))
 779               invalid)
 780           (dolist (keyword actual)
 781             (if (member keyword expected)
 782                 (setq expected (delete keyword expected))
 783               (push keyword invalid)))
 784           (when print-message-p
 785             (message "%s" (concat (and no-doc-p "Missing documentation")
 786                                   (and no-doc-p expected "\n")
 787                                   (doc-mode-format-message 'missing expected)
 788                                   (and (or no-doc-p expected) invalid "\n")
 789                                   (doc-mode-format-message 'invalid invalid))))
 790           (or no-doc-p expected invalid))
 791       (when print-message-p
 792         (message "Missing comment"))
 793       t)))
 794
 795 ;;;###autoload
 796 (defun doc-mode-check-buffer ()
 797   (interactive)
 798   (kill-local-variable 'doc-mode-lighter)
 799   (dolist (tag (doc-mode-find-eligible-tags))
 800     (when (doc-mode-check-tag-doc tag)
 801       (set (make-local-variable 'doc-mode-lighter) " doc!")
 802       (return t))))
 803
 804 (defun doc-mode-first-faulty-tag-doc ()
 805   (dolist (tag (sort (doc-mode-find-eligible-tags)
 806                      (lambda (a b) (< (semantic-tag-start a)
 807                                       (semantic-tag-start b)))))
 808     (when (doc-mode-check-tag-doc tag)
 809       (return tag))))
 810
 811 ;;;###autoload
 812 (defun doc-mode-next-faulty-doc ()
 813   "Jump to the next faulty documentation and print error."
 814   (interactive)
 815   (let ((tag (or (doc-mode-first-faulty-tag-doc)
 816                  (error "End of buffer"))))
 817     (push-mark)
 818     (goto-char (semantic-tag-start tag))
 819     ;; check again with message
 820     (doc-mode-check-tag-doc tag t)))
 821
 822 ;;; folding ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 823
 824 (defvar doc-mode-folds nil)
 825 (make-variable-buffer-local 'doc-mode-folds)
 826
 827 (defun doc-mode-fold-doc (point)
 828   (let ((bounds (doc-mode-find-doc-bounds point)))
 829     (when bounds
 830       (let* ((beg (plist-get bounds :beg))
 831              (end (plist-get bounds :end))
 832              (summary-bounds (doc-mode-find-summary beg end))
 833              (before-overlay (make-overlay beg (car summary-bounds)))
 834              (after-overlay (make-overlay (cdr summary-bounds) end))
 835              (siblings (list before-overlay after-overlay)))
 836         (when (or doc-mode-fold-single-line-comments
 837                   (> (count-lines beg end) 1))
 838           (dolist (ov siblings)
 839             (overlay-put ov 'invisible t)
 840             (overlay-put ov 'isearch-open-invisible-temporary
 841                          'doc-mode-unfold-by-overlay-temporary)
 842             (overlay-put ov 'isearch-open-invisible 'doc-mode-unfold-by-overlay)
 843             (overlay-put ov 'doc-mode-fold siblings))
 844           (setq doc-mode-folds (nconc doc-mode-folds siblings)))))))
 845
 846 ;;;###autoload
 847 (defun doc-mode-fold-tag-doc (tag)
 848   "Fold the documentation for TAG.
 849 If called interactively, use the tag given by `doc-mode-current-tag'."
 850   (interactive (list (doc-mode-current-tag-or-bust)))
 851   (unless doc-mode
 852     (error "doc-mode not enabled"))
 853   (doc-mode-fold-doc (semantic-tag-start tag)))
 854
 855 (defun doc-mode-unfold-by-overlay (overlay &rest foo)
 856   "Unfold OVERLAY and its siblings permanently"
 857   (dolist (ov (overlay-get overlay 'doc-mode-fold))
 858     ;; remove overlay
 859     (setq doc-mode-folds (delq ov doc-mode-folds))
 860     (delete-overlay ov)
 861     ;; don't let isearch do anything with it
 862     (setq isearch-opened-overlays (delq ov isearch-opened-overlays))))
 863
 864 (defun doc-mode-unfold-by-overlay-temporary (overlay invisible)
 865   "Unfold OVERLAY and its siblings temporarily."
 866   (dolist (ov (overlay-get overlay 'doc-mode-fold))
 867     (overlay-put ov 'invisible invisible)))
 868
 869 ;;;###autoload
 870 (defun doc-mode-unfold-doc (point)
 871   "Unfold the comment before POINT."
 872   (interactive "d")
 873   (unless doc-mode
 874     (error "doc-mode not enabled"))
 875   (let ((bounds (doc-mode-find-doc-bounds point)))
 876     (when bounds
 877       (let* ((beg (plist-get bounds :beg))
 878              (end (plist-get bounds :end))
 879              (overlays (overlays-in beg end))
 880              anything-done)
 881         (dolist (ov overlays)
 882           (when (overlay-get ov 'doc-mode-fold)
 883             (setq anything-done t)
 884             (delete-overlay ov)
 885             (setq doc-mode-folds (delq ov doc-mode-folds))))
 886         ;; return non-nil, if anything unfolded
 887         ;; this is used to toggle
 888         anything-done))))
 889
 890 ;;;###autoload
 891 (defun doc-mode-unfold-tag-doc (tag)
 892   "Unfold the documentation for TAG.
 893 If called interactively, use the tag given by `doc-mode-current-tag'."
 894   (interactive (list (doc-mode-current-tag-or-bust)))
 895   (unless doc-mode
 896     (error "doc-mode not enabled"))
 897   (doc-mode-unfold-doc (semantic-tag-start tag)))
 898
 899 ;;;###autoload
 900 (defun doc-mode-fold-all (&optional arg)
 901   (interactive "P")
 902   (unless doc-mode
 903     (error "doc-mode not enabled"))
 904   (if arg
 905       (doc-mode-unfold-all)
 906     (dolist (tag (doc-mode-find-eligible-tags))
 907       (doc-mode-fold-tag-doc tag))))
 908
 909 ;;;###autoload
 910 (defun doc-mode-unfold-all ()
 911   (interactive)
 912   (dolist (ov doc-mode-folds)
 913     (delete-overlay ov))
 914   (kill-local-variable 'doc-mode-folds))
 915
 916 ;;; toggle
 917
 918 ;;;###autoload
 919 (defun doc-mode-toggle-tag-doc-folding (tag)
 920   "Toggle folding of TAG's documentation.
 921 If called interactively, use the tag given by `doc-mode-current-tag'."
 922   (interactive (list (doc-mode-current-tag-or-bust)))
 923   (or (doc-mode-unfold-tag-doc tag)
 924       (doc-mode-fold-tag-doc tag)))
 925
 926 (provide 'doc-mode)
 927
 928 ;;; doc-mode.el ends here