Mercurial > emacs
annotate lisp/cedet/srecode/document.el @ 112218:376148b31b5e
Add 2011 to FSF/AIST copyright years.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Sun, 02 Jan 2011 15:50:46 -0800 |
parents | 1d1d5d9bd884 |
children | ef719132ddfa |
rev | line source |
---|---|
104498 | 1 ;;; srecode/document.el --- Documentation (comment) generation |
2 | |
112218
376148b31b5e
Add 2011 to FSF/AIST copyright years.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
3 ;; Copyright (C) 2008, 2009, 2010, 2011 Free Software Foundation, Inc. |
104498 | 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 | |
105328 | 87 versions of names. This is an alist with each element of the form: |
104498 | 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\\(iallize\\)?" . "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 ;commen sylable | |
171 ) | |
172 "List of common English abbreviations or full words. | |
173 These are nouns (as opposed to verbs) for use in creating expanded | |
105328 | 174 versions of names. This is an alist with each element of the form: |
104498 | 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. | |
105328 | 214 RESULT is a string, which can contain %s, which is replaced with |
104498 | 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 ) | |
105328 | 256 "Alist of input parameter types and strings describing them. |
104498 | 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. | |
105328 | 363 If FCN-IN is not provided, the current tag is used instead. |
104498 | 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. | |
105328 | 474 If VAR-IN is not provided, the current tag is used instead. |
104498 | 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 | |
105328 | 658 finish off the sentence. That is, any function with 'alloc' in it will be |
104498 | 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 tailers 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 englishify 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 actuall have 2 words | |
815 ;; next to eachother 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 | |
105377 | 840 ;; arch-tag: 5ce9b30b-7862-4ab8-b3f8-a4df37a2e0fe |
104498 | 841 ;;; srecode/document.el ends here |