Commit | Line | Data |
---|---|---|
4d902e6f CY |
1 | ;;; srecode/document.el --- Documentation (comment) generation |
2 | ||
114f9c96 | 3 | ;; Copyright (C) 2008, 2009, 2010 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 | ||
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 | |
2f10955c | 87 | versions of names. This is an alist with each element of the form: |
4d902e6f CY |
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 | |
2f10955c | 174 | versions of names. This is an alist with each element of the form: |
4d902e6f CY |
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. | |
2f10955c | 214 | RESULT 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. | |
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 | ) | |
2f10955c | 256 | "Alist of input parameter types and strings describing them. |
4d902e6f CY |
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. | |
2f10955c | 363 | If FCN-IN is not provided, the current tag is used instead. |
4d902e6f CY |
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. | |
2f10955c | 474 | If VAR-IN is not provided, the current tag is used instead. |
4d902e6f CY |
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 | |
2f10955c | 658 | finish off the sentence. That is, any function with 'alloc' in it will be |
4d902e6f CY |
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" | |
4d902e6f CY |
837 | ;; generated-autoload-load-name: "srecode/document" |
838 | ;; End: | |
839 | ||
3999968a | 840 | ;; arch-tag: 5ce9b30b-7862-4ab8-b3f8-a4df37a2e0fe |
4d902e6f | 841 | ;;; srecode/document.el ends here |