CEDET (srecode-pop, srecode-peek): Don't use `subclass'
[emacs.git] / lisp / cedet / srecode / document.el
blob47577844c745cd2175920a111205c1fc27fa0864
1 ;;; srecode/document.el --- Documentation (comment) generation
3 ;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
5 ;; Author: Eric M. Ludlam <eric@siege-engine.com>
7 ;; This file is part of GNU Emacs.
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.
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.
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/>.
22 ;;; Commentary:
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.
30 ;;; Origins:
32 ;; Document was first written w/ cparse, a custom regexp based c parser.
34 ;; Document was then ported to cedet/semantic using sformat (super
35 ;; format) as the templating engine.
37 ;; Document has now been ported to srecode, using the semantic recoder
38 ;; as the templating engine.
40 ;; This file combines srecode/document.el and srecode/document-vars.el
41 ;; from the CEDET repository.
43 (require 'srecode/args)
44 (require 'srecode/dictionary)
45 (require 'srecode/extract)
46 (require 'srecode/insert)
47 (require 'srecode/semantic)
49 (require 'semantic)
50 (require 'semantic/tag)
51 (require 'semantic/doc)
52 (require 'pulse)
54 ;;; Code:
56 (defgroup document nil
57 "File and tag browser frame."
58 :group 'texinfo
59 :group 'srecode)
61 (defcustom srecode-document-autocomment-common-nouns-abbrevs
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
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"))))
95 (defcustom srecode-document-autocomment-function-alist
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")
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.
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"))))
151 (defcustom srecode-document-autocomment-common-nouns-abbrevs
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
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"))))
182 (defcustom srecode-document-autocomment-return-first-alist
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 ")
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"))))
199 (defcustom srecode-document-autocomment-return-last-alist
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")
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"))))
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")
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"))))
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")
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"))))
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
286 ;; A declaration comment. Find what it documents.
287 (when (equal ctxt '("declaration" "comment"))
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)
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))))
299 ;; Now analyze the tag we may be on.
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.
312 (error "Not sure what to comment"))
315 ;; ELSE, no tag. Perhaps we should just insert a nice section
316 ;; header??
318 (let ((title (read-string "Section Title (RET to skip): ")))
320 (when (and (stringp title) (not (= (length title) 0)))
321 (srecode-document-insert-section-comment title)))
323 ))))
325 (defun srecode-document-insert-section-comment (&optional title)
326 "Insert a section comment with TITLE."
327 (interactive "sSection Title: ")
329 (srecode-load-tables-for-mode major-mode)
330 (srecode-load-tables-for-mode major-mode 'document)
332 (if (not (srecode-table))
333 (error "No template table found for mode %s" major-mode))
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"))
343 (when title
344 (srecode-dictionary-set-value
345 dict "TITLE" title))
347 (srecode-insert-fcn temp dict)
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)
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)
367 (srecode-load-tables-for-mode major-mode)
368 (srecode-load-tables-for-mode major-mode 'document)
370 (if (not (srecode-table))
371 (error "No template table found for mode %s" major-mode))
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"))
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)))
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"))
390 (if (not (eq (current-buffer) (semantic-tag-buffer fcn-in)))
391 (error "Only insert comments for tags in the current buffer"))
393 ;; Find any existing doc strings.
394 (semantic-go-to-tag fcn-in)
395 (beginning-of-line)
396 (forward-char -1)
398 (let ((lextok (semantic-documentation-comment-preceding-tag fcn-in 'lex))
399 (doctext
400 (srecode-document-function-name-comment fcn-in))
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))
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)))
422 (when (not belongelsewhere)
424 (pulse-momentary-highlight-region s e)
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? "))
432 (when (> distance 2)
433 (goto-char e)
434 (delete-horizontal-space)
435 (delete-blank-lines))
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")))))
453 (beginning-of-line)
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))
466 (srecode-insert-fcn temp dict)
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)
478 (srecode-load-tables-for-mode major-mode)
479 (srecode-load-tables-for-mode major-mode 'document)
481 (if (not (srecode-table))
482 (error "No template table found for mode %s" major-mode))
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"))
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)))
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"))
501 (if (not (eq (current-buffer) (semantic-tag-buffer var-in)))
502 (error "Only insert comments for tags in the current buffer"))
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))
510 (when lextok
511 (let ((s (semantic-lex-token-start lextok))
512 (e (semantic-lex-token-end lextok)))
514 (pulse-momentary-highlight-region s e)
516 (when (not (y-or-n-p "A comment already exists. Replace? "))
517 (error "Quit"))
519 ;; Extract text from the existing comment.
520 (srecode-extract temp s e)
522 (delete-region s e)
523 (goto-char s) ;; To avoid adding a CR.
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))
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))))
541 (srecode-insert-fcn temp dict)
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)
555 (if (not (srecode-table))
556 (error "No template table found for mode %s" major-mode))
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)
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))
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))
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))
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))
604 (when parent-tag
605 ;; We are probably in a classdecl
606 ;; @todo -could I really use (srecode-calculate-context) ?
608 (setq context "classdecl")
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))
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))
625 (when (or (not temp-start) (not temp-end))
626 (error "No templates for inserting group comments"))
628 ;; Setup the name of this group ahead of time.
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: "))
636 ;; Perform the insertion
637 ;; Do the end first so we don't need to recalculate anything.
639 (goto-char second-pos)
640 (end-of-line)
641 (srecode-insert-fcn temp-end dict)
643 (goto-char first-pos)
644 (beginning-of-line)
645 (srecode-insert-fcn temp-start dict)
650 ;;; Document Generation Functions
652 ;; Routines for making up English style comments.
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))
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)
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))
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.
762 This function is designed for variables, not functions. This does
763 not account for verb parts."
764 (if (string= "" programmer)
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
771 ;; 1) Convert underscores
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)
782 ;; 2) Find word breaks between case changes
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)))
799 ;; 3) Expand the words if possible
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)))
823 ;;; UTILS
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))))
833 (provide 'srecode/document)
835 ;; Local variables:
836 ;; generated-autoload-file: "loaddefs.el"
837 ;; generated-autoload-load-name: "srecode/document"
838 ;; End:
840 ;;; srecode/document.el ends here