104498
|
1 ;;; srecode/document.el --- Documentation (comment) generation
|
|
2
|
|
3 ;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
|
|
4
|
|
5 ;; Author: Eric M. Ludlam <eric@siege-engine.com>
|
|
6
|
|
7 ;; This file is part of GNU Emacs.
|
|
8
|
|
9 ;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
10 ;; it under the terms of the GNU General Public License as published by
|
|
11 ;; the Free Software Foundation, either version 3 of the License, or
|
|
12 ;; (at your option) any later version.
|
|
13
|
|
14 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
17 ;; GNU General Public License for more details.
|
|
18
|
|
19 ;; You should have received a copy of the GNU General Public License
|
|
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
21
|
|
22 ;;; Commentary:
|
|
23 ;;
|
|
24 ;; Routines for fabricating human readable text from function and
|
|
25 ;; variable names as base-text for function comments. Document is not
|
|
26 ;; meant to generate end-text for any function. It is merely meant to
|
|
27 ;; provide some useful base words and text, and as a framework for
|
|
28 ;; managing comments.
|
|
29 ;;
|
|
30 ;;; Origins:
|
|
31 ;;
|
|
32 ;; Document was first written w/ cparse, a custom regexp based c parser.
|
|
33 ;;
|
|
34 ;; Document was then ported to cedet/semantic using sformat (super
|
|
35 ;; format) as the templating engine.
|
|
36 ;;
|
|
37 ;; Document has now been ported to srecode, using the semantic recoder
|
|
38 ;; as the templating engine.
|
|
39
|
|
40 ;; This file combines srecode-document.el and srecode-document-vars.el
|
|
41 ;; from the CEDET repository.
|
|
42
|
|
43 (require 'srecode/args)
|
|
44 (require 'srecode/dictionary)
|
|
45 (require 'srecode/extract)
|
|
46 (require 'srecode/insert)
|
|
47 (require 'srecode/semantic)
|
|
48
|
|
49 (require 'semantic)
|
|
50 (require 'semantic/tag)
|
|
51 (require 'semantic/doc)
|
|
52 (require 'pulse)
|
|
53
|
|
54 ;;; Code:
|
|
55
|
|
56 (defgroup document nil
|
|
57 "File and tag browser frame."
|
|
58 :group 'texinfo
|
|
59 :group 'srecode)
|
|
60
|
|
61 (defcustom srecode-document-autocomment-common-nouns-abbrevs
|
|
62 '(
|
|
63 ("sock\\(et\\)?" . "socket")
|
|
64 ("addr\\(ess\\)?" . "address")
|
|
65 ("buf\\(f\\(er\\)?\\)?" . "buffer")
|
|
66 ("cur\\(r\\(ent\\)?\\)?" . "current")
|
|
67 ("dev\\(ice\\)?" . "device")
|
|
68 ("doc" . "document")
|
|
69 ("i18n" . "internationalization")
|
|
70 ("file" . "file")
|
|
71 ("line" . "line")
|
|
72 ("l10n" . "localization")
|
|
73 ("msg\\|message" . "message")
|
|
74 ("name" . "name")
|
|
75 ("next\\|nxt" . "next")
|
|
76 ("num\\(ber\\)?" . "number")
|
|
77 ("port" . "port")
|
|
78 ("host" . "host")
|
|
79 ("obj\\|object" . "object")
|
|
80 ("previous\\|prev" . "previous")
|
|
81 ("str\\(ing\\)?" . "string")
|
|
82 ("use?r" . "user")
|
|
83 ("\\(^\\|\\s-\\)id\\($\\|\\s-\\)" . "Identifier") ;complex cause ;common syllable
|
|
84 )
|
|
85 "List of common English abbreviations or full words.
|
|
86 These are nouns (as opposed to verbs) for use in creating expanded
|
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-feature: srecode/loaddefs
|
|
838 ;; generated-autoload-load-name: "srecode/document"
|
|
839 ;; End:
|
|
840
|
|
841 ;;; srecode/document.el ends here
|