Add 2012 to FSF copyright years for Emacs files
[bpt/emacs.git] / lisp / cedet / srecode / document.el
CommitLineData
4d902e6f
CY
1;;; srecode/document.el --- Documentation (comment) generation
2
acaf905b 3;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
4d902e6f
CY
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
07a79ce4 40;; This file combines srecode/document.el and srecode/document-vars.el
4d902e6f
CY
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.
86These are nouns (as opposed to verbs) for use in creating expanded
2f10955c 87versions of names. This is an alist with each element of the form:
4d902e6f
CY
88 (MATCH . RESULT)
89MATCH is a regexp to match in the type field.
90RESULT 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 ")
53964682 125 ("setup\\|init\\(ialize\\)?" . "Initializes the ")
4d902e6f
CY
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.
135This is an alist with each element of the form:
136 (MATCH . RESULT)
137MATCH is a regexp to match in the type field.
138RESULT is a string.
139
140Certain prefixes may always mean the same thing, and the same comment
141can be used as a beginning for the description. Regexp should be
142lower case since the string they are compared to is downcased.
143A string may end in a space, in which case, last-alist is searched to
144see how best to describe what can be returned.
145Doesn't always work correctly, but that is just because English
146doesn'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")
22bcf204 170 ("\\(^\\|\\s-\\)id\\($\\|\\s-\\)" . "Identifier") ;complex cause ;common syllable
4d902e6f
CY
171 )
172 "List of common English abbreviations or full words.
173These are nouns (as opposed to verbs) for use in creating expanded
2f10955c 174versions of names. This is an alist with each element of the form:
4d902e6f
CY
175 (MATCH . RESULT)
176MATCH is a regexp to match in the type field.
177RESULT 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.
189They provide a little bit of text when typing information is
190described.
191This is an alist with each element of the form:
192 (MATCH . RESULT)
193MATCH is a regexp to match in the type field.
194RESULT 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.
211This is an alist with each element of the form:
212 (MATCH . RESULT)
213MATCH is a regexp to match in the type field.
2f10955c 214RESULT is a string, which can contain %s, which is replaced with
4d902e6f
CY
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.
230This is an alist with each element of the form:
231 (MATCH . RESULT)
232MATCH is a regexp to match in the type field.
233RESULT is a string of text to use to describe MATCH.
234When one is encountered, document-insert-parameters will automatically
235place 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 )
2f10955c 256 "Alist of input parameter types and strings describing them.
4d902e6f
CY
257This is an alist with each element of the form:
258 (MATCH . RESULT)
259MATCH is a regexp to match in the type field.
260RESULT 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.
268Whack any comments that may be in the way and replace them.
269If the region is active, then insert group function comments.
270If the cursor is in a comment, figure out what kind of comment it is
271 and replace it.
272If the cursor is in a function, insert a function comment.
273If 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.
362FCN-IN is the Semantic tag of the function to add a comment too.
2f10955c 363If FCN-IN is not provided, the current tag is used instead.
4d902e6f
CY
364It 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.
473VAR-IN is the Semantic tag of the function to add a comment too.
2f10955c 474If VAR-IN is not provided, the current tag is used instead.
4d902e6f
CY
475It 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.
548If the region includes only parts of some tags, expand out
549to the beginning and end of the tags on the region.
550If 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.
656If we can identify a verb in the list followed by some
657name part then check the return value to see if we can use that to
2f10955c 658finish off the sentence. That is, any function with 'alloc' in it will be
4d902e6f
CY
659allocating 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)))
40ba43b4 701 ;; add trailers to names which are obviously returning something.
4d902e6f
CY
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.
721Optional COMMENTLIST is list of previously existing comments to
722use instead in alist form. If the name doesn't appear in the list of
4c36be58 723standard names, then english it instead."
4d902e6f
CY
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.
757Works 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
763not 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))))
91af3942
PE
814 ;; don't terminate because we may actually have 2 words
815 ;; next to each other we didn't identify before
4d902e6f
CY
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"
4d902e6f
CY
837;; generated-autoload-load-name: "srecode/document"
838;; End:
839
840;;; srecode/document.el ends here