lisp/cedet/srecode/document.el

   1 ;;; srecode/document.el --- Documentation (comment) generation
   2
   3 ;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
   4
   5 ;; Author: Eric M. Ludlam <eric@siege-engine.com>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23 ;;
  24 ;; Routines for fabricating human readable text from function and
  25 ;; variable names as base-text for function comments.  Document is not
  26 ;; meant to generate end-text for any function.  It is merely meant to
  27 ;; provide some useful base words and text, and as a framework for
  28 ;; managing comments.
  29 ;;
  30 ;;; Origins:
  31 ;;
  32 ;; Document was first written w/ cparse, a custom regexp based c parser.
  33 ;;
  34 ;; Document was then ported to cedet/semantic using sformat (super
  35 ;; format) as the templating engine.
  36 ;;
  37 ;; Document has now been ported to srecode, using the semantic recoder
  38 ;; as the templating engine.
  39
  40 ;; This file combines srecode/document.el and srecode/document-vars.el
  41 ;; from the CEDET repository.
  42
  43 (require 'srecode/args)
  44 (require 'srecode/dictionary)
  45 (require 'srecode/extract)
  46 (require 'srecode/insert)
  47 (require 'srecode/semantic)
  48
  49 (require 'semantic)
  50 (require 'semantic/tag)
  51 (require 'semantic/doc)
  52 (require 'pulse)
  53
  54 ;;; Code:
  55
  56 (defgroup document nil
  57   "File and tag browser frame."
  58   :group 'texinfo
  59   :group 'srecode)
  60
  61 (defcustom srecode-document-autocomment-common-nouns-abbrevs
  62   '(
  63     ("sock\\(et\\)?" . "socket")
  64     ("addr\\(ess\\)?" . "address")
  65     ("buf\\(f\\(er\\)?\\)?" . "buffer")
  66     ("cur\\(r\\(ent\\)?\\)?" . "current")
  67     ("dev\\(ice\\)?" . "device")
  68     ("doc" . "document")
  69     ("i18n" . "internationalization")
  70     ("file" . "file")
  71     ("line" . "line")
  72     ("l10n" . "localization")
  73     ("msg\\|message" . "message")
  74     ("name" . "name")
  75     ("next\\|nxt" . "next")
  76     ("num\\(ber\\)?" . "number")
  77     ("port" . "port")
  78     ("host" . "host")
  79     ("obj\\|object" . "object")
  80     ("previous\\|prev" . "previous")
  81     ("str\\(ing\\)?" . "string")
  82     ("use?r" . "user")
  83     ("\\(^\\|\\s-\\)id\\($\\|\\s-\\)" . "Identifier") ;complex cause ;common syllable
  84     )
  85   "List of common English abbreviations or full words.
  86 These are nouns (as opposed to verbs) for use in creating expanded
  87 versions of names.  This is an alist with each element of the form:
  88  (MATCH . RESULT)
  89 MATCH is a regexp to match in the type field.
  90 RESULT is a string."
  91   :group 'document
  92   :type '(repeat (cons (string :tag "Regexp")
  93                        (string :tag "Doc Text"))))
  94
  95 (defcustom srecode-document-autocomment-function-alist
  96   '(
  97     ("abort" . "Aborts the")
  98     ;; trick to get re-alloc and alloc to pair into one sentence.
  99     ("realloc" . "moves or ")
 100     ("alloc\\(ate\\)?" . "Allocates and initializes a new ")
 101     ("clean" . "Cleans up the")
 102     ("clobber" . "Removes")
 103     ("close" . "Cleanly closes")
 104     ("check" . "Checks the")
 105     ("comp\\(are\\)?" . "Compares the")
 106     ("create" . "Creates a new ")
 107     ("find" . "Finds ")
 108     ("free" . "Frees up space")
 109     ("gen\\(erate\\)?" . "Generates a new ")
 110     ("get\\|find" . "Looks for the given ")
 111     ("gobble" . "Removes")
 112     ("he?lp" . "Provides help for")
 113     ("li?ste?n" . "Listens for ")
 114     ("connect" . "Connects to ")
 115     ("acc?e?pt" . "Accepts a ")
 116     ("load" . "Loads in ")
 117     ("match" . "Check that parameters match")
 118     ("name" . "Provides a name which ")
 119     ("new" . "Allocates a ")
 120     ("parse" . "Parses the parameters and returns ")
 121     ("print\\|display" . "Prints out")
 122     ("read" . "Reads from")
 123     ("reset" . "Resets the parameters and returns")
 124     ("scan" . "Scans the ")
 125     ("setup\\|init\\(ialize\\)?" . "Initializes the ")
 126     ("select" . "Chooses the ")
 127     ("send" . "Sends a")
 128     ("re?c\\(v\\|ieves?\\)" . "Receives a ")
 129     ("to" . "Converts ")
 130     ("update" . "Updates the ")
 131     ("wait" . "Waits for ")
 132     ("write" . "Writes to")
 133     )
 134   "List of names to string match against the function name.
 135 This is an alist with each element of the form:
 136  (MATCH . RESULT)
 137 MATCH is a regexp to match in the type field.
 138 RESULT is a string.
 139
 140 Certain prefixes may always mean the same thing, and the same comment
 141 can be used as a beginning for the description.  Regexp should be
 142 lower case since the string they are compared to is downcased.
 143 A string may end in a space, in which case, last-alist is searched to
 144 see how best to describe what can be returned.
 145 Doesn't always work correctly, but that is just because English
 146 doesn't always work correctly."
 147   :group 'document
 148   :type '(repeat (cons (string :tag "Regexp")
 149                        (string :tag "Doc Text"))))
 150
 151 (defcustom srecode-document-autocomment-common-nouns-abbrevs
 152   '(
 153     ("sock\\(et\\)?" . "socket")
 154     ("addr\\(ess\\)?" . "address")
 155     ("buf\\(f\\(er\\)?\\)?" . "buffer")
 156     ("cur\\(r\\(ent\\)?\\)?" . "current")
 157     ("dev\\(ice\\)?" . "device")
 158     ("file" . "file")
 159     ("line" . "line")
 160     ("msg\\|message" . "message")
 161     ("name" . "name")
 162     ("next\\|nxt" . "next")
 163     ("port" . "port")
 164     ("host" . "host")
 165     ("obj\\|object" . "object")
 166     ("previous\\|prev" . "previous")
 167     ("str\\(ing\\)?" . "string")
 168     ("use?r" . "user")
 169     ("num\\(ber\\)?" . "number")
 170     ("\\(^\\|\\s-\\)id\\($\\|\\s-\\)" . "Identifier") ;complex cause ;common syllable
 171     )
 172   "List of common English abbreviations or full words.
 173 These are nouns (as opposed to verbs) for use in creating expanded
 174 versions of names.  This is an alist with each element of the form:
 175  (MATCH . RESULT)
 176 MATCH is a regexp to match in the type field.
 177 RESULT is a string."
 178   :group 'document
 179   :type '(repeat (cons (string :tag "Regexp")
 180                        (string :tag "Doc Text"))))
 181
 182 (defcustom srecode-document-autocomment-return-first-alist
 183   '(
 184     ;; Static must be first in the list to provide the intro to the sentence
 185     ("static" . "Locally defined function which ")
 186     ("Bool\\|BOOL" . "Status of ")
 187     )
 188   "List of regexp matches for types.
 189 They provide a little bit of text when typing information is
 190 described.
 191 This is an alist with each element of the form:
 192  (MATCH . RESULT)
 193 MATCH is a regexp to match in the type field.
 194 RESULT is a string."
 195   :group 'document
 196   :type '(repeat (cons (string :tag "Regexp")
 197                        (string :tag "Doc Text"))))
 198
 199 (defcustom srecode-document-autocomment-return-last-alist
 200   '(
 201     ("static[ \t\n]+struct \\([a-zA-Z0-9_]+\\)" . "%s")
 202     ("struct \\([a-zA-Z0-9_]+\\)" . "%s")
 203     ("static[ \t\n]+union \\([a-zA-Z0-9_]+\\)" . "%s")
 204     ("union \\([a-zA-Z0-9_]+\\)" . "%s")
 205     ("static[ \t\n]+enum \\([a-zA-Z0-9_]+\\)" . "%s")
 206     ("enum \\([a-zA-Z0-9_]+\\)" . "%s")
 207     ("static[ \t\n]+\\([a-zA-Z0-9_]+\\)" . "%s")
 208     ("\\([a-zA-Z0-9_]+\\)" . "of type %s")
 209     )
 210   "List of regexps which provide the type of the return value.
 211 This is an alist with each element of the form:
 212  (MATCH . RESULT)
 213 MATCH is a regexp to match in the type field.
 214 RESULT is a string, which can contain %s, which is replaced with
 215 `match-string' 1."
 216   :group 'document
 217   :type '(repeat (cons (string :tag "Regexp")
 218                        (string :tag "Doc Text"))))
 219
 220 (defcustom srecode-document-autocomment-param-alist
 221   '( ("[Cc]txt" . "Context")
 222      ("[Ii]d" . "Identifier of")
 223      ("[Tt]ype" . "Type of")
 224      ("[Nn]ame" . "Name of")
 225      ("argc" . "Number of arguments")
 226      ("argv" . "Argument vector")
 227      ("envp" . "Environment variable vector")
 228      )
 229   "Alist of common variable names appearing as function parameters.
 230 This is an alist with each element of the form:
 231  (MATCH . RESULT)
 232 MATCH is a regexp to match in the type field.
 233 RESULT is a string of text to use to describe MATCH.
 234 When one is encountered, document-insert-parameters will automatically
 235 place this comment after the parameter name."
 236   :group 'document
 237   :type '(repeat (cons (string :tag "Regexp")
 238                        (string :tag "Doc Text"))))
 239
 240 (defcustom srecode-document-autocomment-param-type-alist
 241   '(("const" . "Constant")
 242     ("void" . "Empty")
 243     ("char[ ]*\\*" . "String ")
 244     ("\\*\\*" . "Pointer to ")
 245     ("\\*" . "Pointer ")
 246     ("char[ ]*\\([^ \t*]\\|$\\)" . "Character")
 247     ("int\\|long" . "Number of")
 248     ("FILE" . "File of")
 249     ("float\\|double" . "Value of")
 250     ;; How about some X things?
 251     ("Bool\\|BOOL" . "Flag")
 252     ("Window" . "Window")
 253     ("GC" . "Graphic Context")
 254     ("Widget" . "Widget")
 255     )
 256   "Alist of input parameter types and strings describing them.
 257 This is an alist with each element of the form:
 258  (MATCH . RESULT)
 259 MATCH is a regexp to match in the type field.
 260 RESULT is a string."
 261   :group 'document
 262   :type '(repeat (cons (string :tag "Regexp")
 263                        (string :tag "Doc Text"))))
 264
 265 ;;;###autoload
 266 (defun srecode-document-insert-comment ()
 267   "Insert some comments.
 268 Whack any comments that may be in the way and replace them.
 269 If the region is active, then insert group function comments.
 270 If the cursor is in a comment, figure out what kind of comment it is
 271   and replace it.
 272 If the cursor is in a function, insert a function comment.
 273 If the cursor is on a one line prototype, then insert post-fcn comments."
 274   (interactive)
 275   (semantic-fetch-tags)
 276   (let ((ctxt (srecode-calculate-context)))
 277     (if ;; Active region stuff.
 278         (or srecode-handle-region-when-non-active-flag
 279             (eq last-command 'mouse-drag-region)
 280             (and transient-mark-mode mark-active))
 281         (if (> (point) (mark))
 282             (srecode-document-insert-group-comments (mark) (point))
 283           (srecode-document-insert-group-comments (point) (mark)))
 284       ;; ELSE
 285
 286       ;; A declaration comment.  Find what it documents.
 287       (when (equal ctxt '("declaration" "comment"))
 288
 289         ;; If we are on a one line tag/comment, go to that fcn.
 290         (if (save-excursion (back-to-indentation)
 291                             (semantic-current-tag))
 292             (back-to-indentation)
 293
 294           ;; Else, do we have a fcn following us?
 295           (let ((tag (semantic-find-tag-by-overlay-next)))
 296             (when tag (semantic-go-to-tag tag))))
 297         )
 298
 299       ;; Now analyze the tag we may be on.
 300
 301       (if (semantic-current-tag)
 302           (cond
 303            ;; A one-line variable
 304            ((and (semantic-tag-of-class-p (semantic-current-tag) 'variable)
 305                  (srecode-document-one-line-tag-p (semantic-current-tag)))
 306             (srecode-document-insert-variable-one-line-comment))
 307            ;; A plain function
 308            ((semantic-tag-of-class-p (semantic-current-tag) 'function)
 309             (srecode-document-insert-function-comment))
 310            ;; Don't know.
 311            (t
 312             (error "Not sure what to comment"))
 313            )
 314
 315         ;; ELSE, no tag.  Perhaps we should just insert a nice section
 316         ;; header??
 317
 318         (let ((title (read-string "Section Title (RET to skip): ")))
 319
 320           (when (and (stringp title) (not (= (length title) 0)))
 321             (srecode-document-insert-section-comment title)))
 322
 323         ))))
 324
 325 (defun srecode-document-insert-section-comment (&optional title)
 326   "Insert a section comment with TITLE."
 327   (interactive "sSection Title: ")
 328
 329   (srecode-load-tables-for-mode major-mode)
 330   (srecode-load-tables-for-mode major-mode 'document)
 331
 332   (if (not (srecode-table))
 333       (error "No template table found for mode %s" major-mode))
 334
 335   (let* ((dict (srecode-create-dictionary))
 336          (temp (srecode-template-get-table (srecode-table)
 337                                            "section-comment"
 338                                            "declaration"
 339                                            'document)))
 340     (if (not temp)
 341         (error "No templates for inserting section comments"))
 342
 343     (when title
 344       (srecode-dictionary-set-value
 345        dict "TITLE" title))
 346
 347     (srecode-insert-fcn temp dict)
 348     ))
 349
 350
 351 (defun srecode-document-trim-whitespace (str)
 352   "Strip stray whitespace from around STR."
 353   (when (string-match "^\\(\\s-\\|\n\\)+" str)
 354     (setq str (replace-match "" t t str)))
 355   (when (string-match "\\(\\s-\\|\n\\)+$" str)
 356     (setq str (replace-match "" t t str)))
 357   str)
 358
 359 ;;;###autoload
 360 (defun srecode-document-insert-function-comment (&optional fcn-in)
 361   "Insert or replace a function comment.
 362 FCN-IN is the Semantic tag of the function to add a comment too.
 363 If FCN-IN is not provided, the current tag is used instead.
 364 It is assumed that the comment occurs just in front of FCN-IN."
 365   (interactive)
 366
 367   (srecode-load-tables-for-mode major-mode)
 368   (srecode-load-tables-for-mode major-mode 'document)
 369
 370   (if (not (srecode-table))
 371       (error "No template table found for mode %s" major-mode))
 372
 373   (let* ((dict (srecode-create-dictionary))
 374          (temp (srecode-template-get-table (srecode-table)
 375                                            "function-comment"
 376                                            "declaration"
 377                                            'document)))
 378     (if (not temp)
 379         (error "No templates for inserting function comments"))
 380
 381     ;; Try to figure out the tag we want to use.
 382     (when (not fcn-in)
 383       (semantic-fetch-tags)
 384       (setq fcn-in (semantic-current-tag)))
 385
 386     (when (or (not fcn-in)
 387               (not (semantic-tag-of-class-p fcn-in 'function)))
 388       (error "No tag of class 'function to insert comment for"))
 389
 390     (if (not (eq (current-buffer) (semantic-tag-buffer fcn-in)))
 391         (error "Only insert comments for tags in the current buffer"))
 392
 393     ;; Find any existing doc strings.
 394     (semantic-go-to-tag fcn-in)
 395     (beginning-of-line)
 396     (forward-char -1)
 397
 398     (let ((lextok (semantic-documentation-comment-preceeding-tag fcn-in 'lex))
 399           (doctext
 400            (srecode-document-function-name-comment fcn-in))
 401           )
 402
 403       (when lextok
 404         (let* ((s (semantic-lex-token-start lextok))
 405                (e (semantic-lex-token-end lextok))
 406                (plaintext
 407                 (srecode-document-trim-whitespace
 408                  (save-excursion
 409                    (goto-char s)
 410                    (semantic-doc-snarf-comment-for-tag nil))))
 411                (extract (condition-case nil
 412                             (srecode-extract temp s e)
 413                           (error nil))
 414                         )
 415                (distance (count-lines e (semantic-tag-start fcn-in)))
 416                (belongelsewhere (save-excursion
 417                                   (goto-char s)
 418                                   (back-to-indentation)
 419                                   (semantic-current-tag)))
 420                )
 421
 422           (when (not belongelsewhere)
 423
 424             (pulse-momentary-highlight-region s e)
 425
 426             ;; There are many possible states that comment could be in.
 427             ;; Take a guess about what the user would like to do, and ask
 428             ;; the right kind of question.
 429             (when (or (not (> distance 2))
 430                       (y-or-n-p "Replace this comment? "))
 431
 432               (when (> distance 2)
 433                 (goto-char e)
 434                 (delete-horizontal-space)
 435                 (delete-blank-lines))
 436
 437               (cond
 438                ((and plaintext (not extract))
 439                 (if (y-or-n-p "Convert old-style comment to Template with old text? ")
 440                     (setq doctext plaintext))
 441                 (delete-region s e)
 442                 (goto-char s))
 443                (extract
 444                 (when (y-or-n-p "Refresh pre-existing comment (recycle old doc)? ")
 445                   (delete-region s e)
 446                   (goto-char s)
 447                   (setq doctext
 448                         (srecode-document-trim-whitespace
 449                          (srecode-dictionary-lookup-name extract "DOC")))))
 450                ))
 451             )))
 452
 453       (beginning-of-line)
 454
 455       ;; Perform the insertion
 456       (let ((srecode-semantic-selected-tag fcn-in)
 457             (srecode-semantic-apply-tag-augment-hook
 458              (lambda (tag dict)
 459                (srecode-dictionary-set-value
 460                 dict "DOC"
 461                 (if (eq tag fcn-in)
 462                     doctext
 463                   (srecode-document-parameter-comment tag))
 464                 )))
 465             )
 466         (srecode-insert-fcn temp dict)
 467         ))
 468     ))
 469
 470 ;;;###autoload
 471 (defun srecode-document-insert-variable-one-line-comment (&optional var-in)
 472   "Insert or replace a variable comment.
 473 VAR-IN is the Semantic tag of the function to add a comment too.
 474 If VAR-IN is not provided, the current tag is used instead.
 475 It is assumed that the comment occurs just after VAR-IN."
 476   (interactive)
 477
 478   (srecode-load-tables-for-mode major-mode)
 479   (srecode-load-tables-for-mode major-mode 'document)
 480
 481   (if (not (srecode-table))
 482       (error "No template table found for mode %s" major-mode))
 483
 484   (let* ((dict (srecode-create-dictionary))
 485          (temp (srecode-template-get-table (srecode-table)
 486                                            "variable-same-line-comment"
 487                                            "declaration"
 488                                            'document)))
 489     (if (not temp)
 490         (error "No templates for inserting variable comments"))
 491
 492     ;; Try to figure out the tag we want to use.
 493     (when (not var-in)
 494       (semantic-fetch-tags)
 495       (setq var-in (semantic-current-tag)))
 496
 497     (when (or (not var-in)
 498               (not (semantic-tag-of-class-p var-in 'variable)))
 499       (error "No tag of class 'variable to insert comment for"))
 500
 501     (if (not (eq (current-buffer) (semantic-tag-buffer var-in)))
 502         (error "Only insert comments for tags in the current buffer"))
 503
 504     ;; Find any existing doc strings.
 505     (goto-char (semantic-tag-end var-in))
 506     (skip-syntax-forward "-" (point-at-eol))
 507     (let ((lextok (semantic-doc-snarf-comment-for-tag 'lex))
 508           )
 509
 510       (when lextok
 511         (let ((s (semantic-lex-token-start lextok))
 512               (e (semantic-lex-token-end lextok)))
 513
 514           (pulse-momentary-highlight-region s e)
 515
 516           (when (not (y-or-n-p "A comment already exists.  Replace? "))
 517             (error "Quit"))
 518
 519           ;; Extract text from the existing comment.
 520           (srecode-extract temp s e)
 521
 522           (delete-region s e)
 523           (goto-char s) ;; To avoid adding a CR.
 524           ))
 525       )
 526
 527     ;; Clean up the end of the line and use handy comment-column.
 528     (end-of-line)
 529     (delete-horizontal-space)
 530     (move-to-column comment-column t)
 531     (when (< (point) (point-at-eol)) (end-of-line))
 532
 533     ;; Perform the insertion
 534     (let ((srecode-semantic-selected-tag var-in)
 535           (srecode-semantic-apply-tag-augment-hook
 536            (lambda (tag dict)
 537              (srecode-dictionary-set-value
 538               dict "DOC" (srecode-document-parameter-comment
 539                           tag))))
 540           )
 541       (srecode-insert-fcn temp dict)
 542       ))
 543   )
 544
 545 ;;;###autoload
 546 (defun srecode-document-insert-group-comments (beg end)
 547   "Insert group comments around the active between BEG and END.
 548 If the region includes only parts of some tags, expand out
 549 to the beginning and end of the tags on the region.
 550 If there is only one tag in the region, complain."
 551   (interactive "r")
 552   (srecode-load-tables-for-mode major-mode)
 553   (srecode-load-tables-for-mode major-mode 'document)
 554
 555   (if (not (srecode-table))
 556       (error "No template table found for mode %s" major-mode))
 557
 558   (let* ((dict (srecode-create-dictionary))
 559          (context "declaration")
 560          (temp-start nil)
 561          (temp-end nil)
 562          (tag-start (save-excursion
 563                       (goto-char beg)
 564                       (or (semantic-current-tag)
 565                           (semantic-find-tag-by-overlay-next))))
 566          (tag-end (save-excursion
 567                     (goto-char end)
 568                     (or (semantic-current-tag)
 569                         (semantic-find-tag-by-overlay-prev))))
 570          (parent-tag nil)
 571          (first-pos beg)
 572          (second-pos end)
 573          )
 574
 575     ;; If beg/end wrapped nothing, then tag-start,end would actually
 576     ;; point at some odd stuff that is out of order.
 577     (when (or (not tag-start) (not tag-end)
 578               (> (semantic-tag-end tag-start)
 579                  (semantic-tag-start tag-end)))
 580       (setq tag-start nil
 581             tag-end nil))
 582
 583     (when tag-start
 584       ;; If tag-start and -end are the same, and it is a class or
 585       ;; struct, try to find child tags inside the classdecl.
 586       (cond
 587        ((and (eq tag-start tag-end)
 588              tag-start
 589              (semantic-tag-of-class-p tag-start 'type))
 590         (setq parent-tag tag-start)
 591         (setq tag-start (semantic-find-tag-by-overlay-next beg)
 592               tag-end (semantic-find-tag-by-overlay-prev end))
 593         )
 594        ((eq (semantic-find-tag-parent-by-overlay tag-start) tag-end)
 595         (setq parent-tag tag-end)
 596         (setq tag-end (semantic-find-tag-by-overlay-prev end))
 597         )
 598        ((eq tag-start (semantic-find-tag-parent-by-overlay tag-end))
 599         (setq parent-tag tag-start)
 600         (setq tag-start (semantic-find-tag-by-overlay-next beg))
 601         )
 602        )
 603
 604       (when parent-tag
 605         ;; We are probably in a classdecl
 606         ;; @todo -could I really use (srecode-calculate-context) ?
 607
 608         (setq context "classdecl")
 609         )
 610
 611       ;; Derive start and end locations based on the tags.
 612       (setq first-pos (semantic-tag-start tag-start)
 613             second-pos (semantic-tag-end tag-end))
 614       )
 615     ;; Now load the templates
 616     (setq temp-start (srecode-template-get-table (srecode-table)
 617                                                  "group-comment-start"
 618                                                  context
 619                                                  'document)
 620           temp-end (srecode-template-get-table (srecode-table)
 621                                                "group-comment-end"
 622                                                context
 623                                                'document))
 624
 625     (when (or (not temp-start) (not temp-end))
 626       (error "No templates for inserting group comments"))
 627
 628     ;; Setup the name of this group ahead of time.
 629
 630     ;; @todo - guess at a name based on common strings
 631     ;;         of the tags in the group.
 632     (srecode-dictionary-set-value
 633      dict "GROUPNAME"
 634      (read-string "Name of group: "))
 635
 636     ;; Perform the insertion
 637     ;; Do the end first so we don't need to recalculate anything.
 638     ;;
 639     (goto-char second-pos)
 640     (end-of-line)
 641     (srecode-insert-fcn temp-end dict)
 642
 643     (goto-char first-pos)
 644     (beginning-of-line)
 645     (srecode-insert-fcn temp-start dict)
 646
 647     ))
 648
 649
 650 ;;; Document Generation Functions
 651 ;;
 652 ;; Routines for making up English style comments.
 653
 654 (defun srecode-document-function-name-comment (tag)
 655   "Create documentation for the function defined in TAG.
 656 If we can identify a verb in the list followed by some
 657 name part then check the return value to see if we can use that to
 658 finish off the sentence.  That is, any function with 'alloc' in it will be
 659 allocating something based on its type."
 660   (let ((al srecode-document-autocomment-return-first-alist)
 661         (dropit nil)
 662         (tailit nil)
 663         (news "")
 664         (fname (semantic-tag-name tag))
 665         (retval (or (semantic-tag-type tag) "")))
 666     (if (listp retval)
 667         ;; convert a type list into a long string to analyze.
 668         (setq retval (car retval)))
 669     ;; check for modifiers like static
 670     (while al
 671       (if (string-match (car (car al)) (downcase retval))
 672           (progn
 673             (setq news (concat news (cdr (car al))))
 674             (setq dropit t)
 675             (setq al nil)))
 676       (setq al (cdr al)))
 677     ;; check for verb parts!
 678     (setq al srecode-document-autocomment-function-alist)
 679     (while al
 680       (if (string-match (car (car al)) (downcase fname))
 681           (progn
 682             (setq news
 683                   (concat news (if dropit (downcase (cdr (car al)))
 684                                  (cdr (car al)))))
 685             ;; if we end in a space, then we are expecting a potential
 686             ;; return value.
 687             (if (= ?  (aref news (1- (length news))))
 688                 (setq tailit t))
 689             (setq al nil)))
 690       (setq al (cdr al)))
 691     ;; check for noun parts!
 692     (setq al srecode-document-autocomment-common-nouns-abbrevs)
 693     (while al
 694       (if (string-match (car (car al)) (downcase fname))
 695           (progn
 696             (setq news
 697                   (concat news (if dropit (downcase (cdr (car al)))
 698                                  (cdr (car al)))))
 699             (setq al nil)))
 700       (setq al (cdr al)))
 701     ;; add trailers to names which are obviously returning something.
 702     (if tailit
 703         (progn
 704           (setq al srecode-document-autocomment-return-last-alist)
 705           (while al
 706             (if (string-match (car (car al)) (downcase retval))
 707                 (progn
 708                   (setq news
 709                         (concat news " "
 710                                 ;; this one may use parts of the return value.
 711                                 (format (cdr (car al))
 712                                         (srecode-document-programmer->english
 713                                          (substring retval (match-beginning 1)
 714                                                     (match-end 1))))))
 715                   (setq al nil)))
 716             (setq al (cdr al)))))
 717     news))
 718
 719 (defun srecode-document-parameter-comment (param &optional commentlist)
 720   "Convert tag or string PARAM into a name,comment pair.
 721 Optional COMMENTLIST is list of previously existing comments to
 722 use instead in alist form.  If the name doesn't appear in the list of
 723 standard names, then english it instead."
 724   (let ((cmt "")
 725         (aso srecode-document-autocomment-param-alist)
 726         (fnd nil)
 727         (name (if (stringp param) param (semantic-tag-name param)))
 728         (tt (if (stringp param) nil (semantic-tag-type param))))
 729     ;; Make sure the type is a string.
 730     (if (listp tt)
 731         (setq tt (semantic-tag-name tt)))
 732     ;; Find name description parts.
 733     (while aso
 734       (if (string-match (car (car aso)) name)
 735           (progn
 736             (setq fnd t)
 737             (setq cmt (concat cmt (cdr (car aso))))))
 738       (setq aso (cdr aso)))
 739     (if (/= (length cmt) 0)
 740         nil
 741       ;; finally check for array parts
 742       (if (and (not (stringp param)) (semantic-tag-modifiers param))
 743           (setq cmt (concat cmt "array of ")))
 744       (setq aso srecode-document-autocomment-param-type-alist)
 745       (while (and aso tt)
 746         (if (string-match (car (car aso)) tt)
 747             (setq cmt (concat cmt (cdr (car aso)))))
 748         (setq aso (cdr aso))))
 749     ;; Convert from programmer to english.
 750     (if (not fnd)
 751         (setq cmt (concat cmt " "
 752                           (srecode-document-programmer->english name))))
 753     cmt))
 754
 755 (defun srecode-document-programmer->english (programmer)
 756   "Take PROGRAMMER and convert it into English.
 757 Works with the following rules:
 758   1) convert all _ into spaces.
 759   2) inserts spaces between CamelCasing word breaks.
 760   3) expands noun names based on common programmer nouns.
 761
 762   This function is designed for variables, not functions.  This does
 763 not account for verb parts."
 764   (if (string= "" programmer)
 765       ""
 766     (let ((ind 0)                       ;index in string
 767           (llow nil)                    ;lower/upper case flag
 768           (newstr nil)                  ;new string being generated
 769           (al nil))                     ;autocomment list
 770       ;;
 771       ;; 1) Convert underscores
 772       ;;
 773       (while (< ind (length programmer))
 774         (setq newstr (concat newstr
 775                              (if (= (aref programmer ind) ?_)
 776                                  " " (char-to-string (aref programmer ind)))))
 777         (setq ind (1+ ind)))
 778       (setq programmer newstr
 779             newstr nil
 780             ind 0)
 781       ;;
 782       ;; 2) Find word breaks between case changes
 783       ;;
 784       (while (< ind (length programmer))
 785         (setq newstr
 786               (concat newstr
 787                       (let ((tc (aref programmer ind)))
 788                         (if (and (>= tc ?a) (<= tc ?z))
 789                             (progn
 790                               (setq llow t)
 791                               (char-to-string tc))
 792                           (if llow
 793                               (progn
 794                                 (setq llow nil)
 795                                 (concat " " (char-to-string tc)))
 796                             (char-to-string tc))))))
 797         (setq ind (1+ ind)))
 798       ;;
 799       ;; 3) Expand the words if possible
 800       ;;
 801       (setq llow nil
 802             ind 0
 803             programmer newstr
 804             newstr nil)
 805       (while (string-match (concat "^\\s-*\\([^ \t\n]+\\)") programmer)
 806         (let ((ts (substring programmer (match-beginning 1) (match-end 1)))
 807               (end (match-end 1)))
 808           (setq al srecode-document-autocomment-common-nouns-abbrevs)
 809           (setq llow nil)
 810           (while al
 811             (if (string-match (car (car al)) (downcase ts))
 812                 (progn
 813                   (setq newstr (concat newstr (cdr (car al))))
 814                   ;; don't terminate because we may actually have 2 words
 815                   ;; next to each other we didn't identify before
 816                   (setq llow t)))
 817             (setq al (cdr al)))
 818           (if (not llow) (setq newstr (concat newstr ts)))
 819           (setq newstr (concat newstr " "))
 820           (setq programmer (substring programmer end))))
 821       newstr)))
 822
 823 ;;; UTILS
 824 ;;
 825 (defun srecode-document-one-line-tag-p (tag)
 826   "Does TAG fit on one line with space on the end?"
 827   (save-excursion
 828     (semantic-go-to-tag tag)
 829     (and (<= (semantic-tag-end tag) (point-at-eol))
 830          (goto-char (semantic-tag-end tag))
 831          (< (current-column) 70))))
 832
 833 (provide 'srecode/document)
 834
 835 ;; Local variables:
 836 ;; generated-autoload-file: "loaddefs.el"
 837 ;; generated-autoload-load-name: "srecode/document"
 838 ;; End:
 839
 840 ;;; srecode/document.el ends here