Commit | Line | Data |
---|---|---|
55b522b2 | 1 | ;;; semantic/texi.el --- Semantic details for Texinfo files |
9573e58b CY |
2 | |
3 | ;;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2007, 2008, 2009 | |
4 | ;;; Free Software Foundation, Inc. | |
5 | ||
6 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation, either version 3 of the License, or | |
13 | ;; (at your option) any later version. | |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
22 | ||
23 | ;;; Commentary: | |
24 | ;; | |
25 | ;; Parse Texinfo buffers using regular expressions. The core parser | |
26 | ;; engine is the function `semantic-texi-parse-headings'. The | |
27 | ;; parser plug-in is the function `semantic-texi-parse-region' that | |
28 | ;; overrides `semantic-parse-region'. | |
29 | ||
30 | (require 'semantic) | |
31 | (require 'semantic/format) | |
32 | (require 'texinfo) | |
33 | ||
34 | (eval-when-compile | |
35 | (require 'semantic/db) | |
36 | (require 'semantic/db-find) | |
37 | (require 'semantic/ctxt) | |
55b522b2 | 38 | (require 'semantic/find) |
aa8724ae | 39 | ;; (require 'semantic/imenu) |
9573e58b | 40 | (require 'semantic/doc) |
aa8724ae CY |
41 | ;; (require 'senator) |
42 | ) | |
9573e58b | 43 | |
55b522b2 CY |
44 | (declare-function lookup-words "ispell") |
45 | ||
9573e58b CY |
46 | (defvar semantic-texi-super-regex |
47 | "^@\\(top\\|chapter\\|\\(sub\\)*section\\|unnumbered\\(\\(sub\\)*sec\\)?\\|\ | |
48 | \\(chap\\|\\(sub\\)+\\|major\\)?heading\\|appendix\\(\\(sub\\)*sec\\)?\\|\ | |
49 | centerchap\\|def\\(var\\|un\\|fn\\|opt\\)x?\\)" | |
50 | "Regular expression used to find special sections in a Texinfo file.") | |
51 | ||
52 | (defvar semantic-texi-name-field-list | |
53 | '( ("defvar" . 1) | |
54 | ("defvarx" . 1) | |
55 | ("defun" . 1) | |
56 | ("defunx" . 1) | |
57 | ("defopt" . 1) | |
58 | ("deffn" . 2) | |
59 | ("deffnx" . 2) | |
60 | ) | |
61 | "List of definition commands, and the field position. | |
62 | The field position is the field number (based at 1) where the | |
63 | name of this section is.") | |
64 | ||
65 | ;;; Code: | |
66 | (defun semantic-texi-parse-region (&rest ignore) | |
67 | "Parse the current texinfo buffer for semantic tags. | |
68 | IGNORE any arguments, always parse the whole buffer. | |
69 | Each tag returned is of the form: | |
70 | (\"NAME\" section (:members CHILDREN)) | |
71 | or | |
72 | (\"NAME\" def) | |
73 | ||
74 | It is an override of 'parse-region and must be installed by the | |
75 | function `semantic-install-function-overrides'." | |
76 | (mapcar 'semantic-texi-expand-tag | |
77 | (semantic-texi-parse-headings))) | |
78 | ||
79 | (defun semantic-texi-parse-changes () | |
80 | "Parse changes in the current texinfo buffer." | |
81 | ;; NOTE: For now, just schedule a full reparse. | |
82 | ;; To be implemented later. | |
83 | (semantic-parse-tree-set-needs-rebuild)) | |
84 | ||
85 | (defun semantic-texi-expand-tag (tag) | |
86 | "Expand the texinfo tag TAG." | |
87 | (let ((chil (semantic-tag-components tag))) | |
88 | (if chil | |
89 | (semantic-tag-put-attribute | |
90 | tag :members (mapcar 'semantic-texi-expand-tag chil))) | |
91 | (car (semantic--tag-expand tag)))) | |
92 | ||
93 | (defun semantic-texi-parse-headings () | |
94 | "Parse the current texinfo buffer for all semantic tags now." | |
95 | (let ((pass1 nil)) | |
96 | ;; First search and snarf. | |
97 | (save-excursion | |
98 | (goto-char (point-min)) | |
99 | (let ((semantic--progress-reporter | |
100 | (make-progress-reporter | |
101 | (format "Parsing %s..." | |
102 | (file-name-nondirectory buffer-file-name)) | |
103 | (point-min) (point-max)))) | |
104 | (while (re-search-forward semantic-texi-super-regex nil t) | |
105 | (setq pass1 (cons (match-beginning 0) pass1)) | |
106 | (progress-reporter-update semantic--progress-reporter (point))) | |
107 | (progress-reporter-done semantic--progress-reporter))) | |
108 | (setq pass1 (nreverse pass1)) | |
109 | ;; Now, make some tags while creating a set of children. | |
110 | (car (semantic-texi-recursive-combobulate-list pass1 0)) | |
111 | )) | |
112 | ||
113 | (defsubst semantic-texi-new-section-tag (name members start end) | |
114 | "Create a semantic tag of class section. | |
115 | NAME is the name of this section. | |
116 | MEMBERS is a list of semantic tags representing the elements that make | |
117 | up this section. | |
118 | START and END define the location of data described by the tag." | |
119 | (append (semantic-tag name 'section :members members) | |
120 | (list start end))) | |
121 | ||
122 | (defsubst semantic-texi-new-def-tag (name start end) | |
123 | "Create a semantic tag of class def. | |
124 | NAME is the name of this definition. | |
125 | START and END define the location of data described by the tag." | |
126 | (append (semantic-tag name 'def) | |
127 | (list start end))) | |
128 | ||
129 | (defun semantic-texi-set-endpoint (metataglist pnt) | |
130 | "Set the end point of the first section tag in METATAGLIST to PNT. | |
131 | METATAGLIST is a list of tags in the intermediate tag format used by the | |
132 | texinfo parser. PNT is the new point to set." | |
133 | (let ((metatag nil)) | |
134 | (while (and metataglist | |
135 | (not (eq (semantic-tag-class (car metataglist)) 'section))) | |
136 | (setq metataglist (cdr metataglist))) | |
137 | (setq metatag (car metataglist)) | |
138 | (when metatag | |
139 | (setcar (nthcdr (1- (length metatag)) metatag) pnt) | |
140 | metatag))) | |
141 | ||
142 | (defun semantic-texi-recursive-combobulate-list (sectionlist level) | |
143 | "Rearrange SECTIONLIST to be a hierarchical tag list starting at LEVEL. | |
144 | Return the rearranged new list, with all remaining tags from | |
145 | SECTIONLIST starting at ELT 2. Sections not are not dealt with as soon as a | |
146 | tag with greater section value than LEVEL is found." | |
147 | (let ((newl nil) | |
148 | (oldl sectionlist) | |
149 | tag | |
150 | ) | |
151 | (save-excursion | |
152 | (catch 'level-jump | |
153 | (while oldl | |
154 | (goto-char (car oldl)) | |
155 | (if (looking-at "@\\(\\w+\\)") | |
156 | (let* ((word (match-string 1)) | |
157 | (levelmatch (assoc word texinfo-section-list)) | |
158 | text begin tmp | |
159 | ) | |
160 | ;; Set begin to the right location | |
161 | (setq begin (point)) | |
162 | ;; Get out of here if there if we made it that far. | |
163 | (if (and levelmatch (<= (car (cdr levelmatch)) level)) | |
164 | (progn | |
165 | (when newl | |
166 | (semantic-texi-set-endpoint newl begin)) | |
167 | (throw 'level-jump t))) | |
168 | ;; Recombobulate | |
169 | (if levelmatch | |
170 | (let ((end (match-end 1))) | |
171 | ;; Levels sometimes have a @node just in front. | |
172 | ;; That node statement should be included in the space | |
173 | ;; for this entry. | |
174 | (save-excursion | |
175 | (skip-chars-backward "\n \t") | |
176 | (beginning-of-line) | |
177 | (when (looking-at "@node\\>") | |
178 | (setq begin (point)))) | |
179 | ;; When there is a match, the descriptive text | |
180 | ;; consists of the rest of the line. | |
181 | (goto-char end) | |
182 | (skip-chars-forward " \t") | |
183 | (setq text (buffer-substring-no-properties | |
184 | (point) | |
185 | (progn (end-of-line) (point)))) | |
186 | ;; Next, recurse into the body to find the end. | |
187 | (setq tmp (semantic-texi-recursive-combobulate-list | |
188 | (cdr oldl) (car (cdr levelmatch)))) | |
189 | ;; Build a tag | |
190 | (setq tag (semantic-texi-new-section-tag | |
191 | text (car tmp) begin (point))) | |
192 | ;; Before appending the newtag, update the previous tag | |
193 | ;; if it is a section tag. | |
194 | (when newl | |
195 | (semantic-texi-set-endpoint newl begin)) | |
196 | ;; Append new tag to our master list. | |
197 | (setq newl (cons tag newl)) | |
198 | ;; continue | |
199 | (setq oldl (cdr tmp)) | |
200 | ) | |
201 | ;; No match means we have a def*, so get the name from | |
202 | ;; it based on the type of thingy we found. | |
203 | (setq levelmatch (assoc word semantic-texi-name-field-list) | |
204 | tmp (or (cdr levelmatch) 1)) | |
205 | (forward-sexp tmp) | |
206 | (skip-chars-forward " \t") | |
207 | (setq text (buffer-substring-no-properties | |
208 | (point) | |
209 | (progn (forward-sexp 1) (point)))) | |
210 | ;; Seek the end of this definition | |
211 | (goto-char begin) | |
212 | (semantic-texi-forward-deffn) | |
213 | (setq tag (semantic-texi-new-def-tag text begin (point)) | |
214 | newl (cons tag newl)) | |
215 | ;; continue | |
216 | (setq oldl (cdr oldl))) | |
217 | ) | |
218 | (error "Problem finding section in semantic/texi parser")) | |
219 | ;; (setq oldl (cdr oldl)) | |
220 | ) | |
221 | ;; When oldl runs out, force a new endpoint as point-max | |
222 | (when (not oldl) | |
223 | (semantic-texi-set-endpoint newl (point-max))) | |
224 | )) | |
225 | (cons (nreverse newl) oldl))) | |
226 | ||
227 | (defun semantic-texi-forward-deffn () | |
228 | "Move forward over one deffn type definition. | |
229 | The cursor should be on the @ sign." | |
230 | (when (looking-at "@\\(\\w+\\)") | |
231 | (let* ((type (match-string 1)) | |
232 | (seek (concat "^@end\\s-+" (regexp-quote type)))) | |
233 | (re-search-forward seek nil t)))) | |
234 | ||
235 | (define-mode-local-override semantic-tag-components | |
236 | texinfo-mode (tag) | |
237 | "Return components belonging to TAG." | |
238 | (semantic-tag-get-attribute tag :members)) | |
239 | ||
240 | \f | |
241 | ;;; Overrides: Context Parsing | |
242 | ;; | |
243 | ;; How to treat texi as a language? | |
244 | ;; | |
245 | (defvar semantic-texi-environment-regexp | |
246 | (if (string-match texinfo-environment-regexp "@menu") | |
247 | ;; Make sure our Emacs has menus in it. | |
248 | texinfo-environment-regexp | |
249 | ;; If no menus, then merge in the menu concept. | |
250 | (when (string-match "cartouche" texinfo-environment-regexp) | |
251 | (concat (substring texinfo-environment-regexp | |
252 | 0 (match-beginning 0)) | |
253 | "menu\\|" | |
254 | (substring texinfo-environment-regexp | |
255 | (match-beginning 0))))) | |
256 | "Regular expression for matching texinfo enviroments. | |
257 | uses `texinfo-environment-regexp', but makes sure that it | |
258 | can handle the @menu environment.") | |
259 | ||
260 | (define-mode-local-override semantic-up-context texinfo-mode () | |
261 | "Handle texinfo constructs which do not use parenthetical nesting." | |
262 | (let ((done nil)) | |
263 | (save-excursion | |
264 | (let ((parenthetical (semantic-up-context-default)) | |
265 | ) | |
266 | (when (not parenthetical) | |
267 | ;; We are in parenthises. Are they the types of parens | |
268 | ;; belonging to a texinfo construct? | |
269 | (forward-word -1) | |
270 | (when (looking-at "@\\w+{") | |
271 | (setq done (point)))))) | |
272 | ;; If we are not in a parenthetical node, then find a block instead. | |
273 | ;; Use the texinfo support to find block start/end constructs. | |
274 | (save-excursion | |
275 | (while (and (not done) | |
276 | (re-search-backward semantic-texi-environment-regexp nil t)) | |
277 | ;; For any hit, if we find an @end foo, then jump to the | |
278 | ;; matching @foo. If it is not an end, then we win! | |
279 | (if (not (looking-at "@end\\s-+\\(\\w+\\)")) | |
280 | (setq done (point)) | |
281 | ;; Skip over this block | |
282 | (let ((env (match-string 1))) | |
283 | (re-search-backward (concat "@" env)))) | |
284 | )) | |
285 | ;; All over, post what we find. | |
286 | (if done | |
287 | ;; We found something, so use it. | |
288 | (progn (goto-char done) | |
289 | nil) | |
290 | t))) | |
291 | ||
292 | (define-mode-local-override semantic-beginning-of-context texinfo-mode (&optional point) | |
293 | "Move to the beginning of the context surrounding POINT." | |
294 | (if (semantic-up-context point) | |
295 | ;; If we can't go up, we can't do this either. | |
296 | t | |
297 | ;; We moved, so now we need to skip into whatever this thing is. | |
298 | (forward-word 1) ;; skip the command | |
299 | (if (looking-at "\\s-*{") | |
300 | ;; In a short command. Go in. | |
301 | (down-list 1) | |
302 | ;; An environment. Go to the next line. | |
303 | (end-of-line) | |
304 | (forward-char 1)) | |
305 | nil)) | |
306 | ||
307 | (define-mode-local-override semantic-ctxt-current-class-list | |
308 | texinfo-mode (&optional point) | |
309 | "Determine the class of tags that can be used at POINT. | |
310 | For texinfo, there two possibilities returned. | |
311 | 1) 'function - for a call to a texinfo function | |
312 | 2) 'word - indicates an english word. | |
313 | It would be nice to know function arguments too, but not today." | |
314 | (let ((sym (semantic-ctxt-current-symbol))) | |
315 | (if (and sym (= (aref (car sym) 0) ?@)) | |
316 | '(function) | |
317 | '(word)))) | |
318 | ||
319 | \f | |
320 | ;;; Overrides : Formatting | |
321 | ;; | |
322 | ;; Various override to better format texi tags. | |
323 | ;; | |
324 | ||
325 | (define-mode-local-override semantic-format-tag-abbreviate | |
326 | texinfo-mode (tag &optional parent color) | |
327 | "Texinfo tags abbreviation." | |
328 | (let ((class (semantic-tag-class tag)) | |
329 | (name (semantic-format-tag-name tag parent color)) | |
330 | ) | |
331 | (cond ((eq class 'function) | |
332 | (concat name "{ }")) | |
333 | (t (semantic-format-tag-abbreviate-default tag parent color))) | |
334 | )) | |
335 | ||
336 | (define-mode-local-override semantic-format-tag-prototype | |
337 | texinfo-mode (tag &optional parent color) | |
338 | "Texinfo tags abbreviation." | |
339 | (semantic-format-tag-abbreviate tag parent color)) | |
340 | ||
341 | \f | |
342 | ;;; Texi Unique Features | |
343 | ;; | |
344 | (defun semantic-tag-texi-section-text-bounds (tag) | |
345 | "Get the bounds to the text of TAG. | |
346 | The text bounds is the text belonging to this node excluding | |
347 | the text of any child nodes, but including any defuns." | |
348 | (let ((memb (semantic-tag-components tag))) | |
349 | ;; Members.. if one is a section, check it out. | |
350 | (while (and memb (not (semantic-tag-of-class-p (car memb) 'section))) | |
351 | (setq memb (cdr memb))) | |
352 | ;; No members? ... then a simple problem! | |
353 | (if (not memb) | |
354 | (semantic-tag-bounds tag) | |
355 | ;; Our end is their beginning... | |
356 | (list (semantic-tag-start tag) (semantic-tag-start (car memb)))))) | |
357 | ||
358 | (defun semantic-texi-current-environment (&optional point) | |
359 | "Return as a string the type of the current environment. | |
360 | Optional argument POINT is where to look for the environment." | |
361 | (save-excursion | |
362 | (when point (goto-char (point))) | |
363 | (while (and (or (not (looking-at semantic-texi-environment-regexp)) | |
364 | (looking-at "@end")) | |
365 | (not (semantic-up-context))) | |
366 | ) | |
367 | (when (looking-at semantic-texi-environment-regexp) | |
368 | (match-string 1)))) | |
369 | ||
370 | \f | |
371 | ;;; Analyzer | |
372 | ;; | |
373 | (eval-when-compile | |
374 | (require 'semantic/analyze)) | |
375 | ||
376 | (define-mode-local-override semantic-analyze-current-context | |
377 | texinfo-mode (point) | |
378 | "Analysis context makes no sense for texinfo. Return nil." | |
379 | (let* ((prefixandbounds (semantic-ctxt-current-symbol-and-bounds (point))) | |
380 | (prefix (car prefixandbounds)) | |
381 | (bounds (nth 2 prefixandbounds)) | |
382 | (prefixclass (semantic-ctxt-current-class-list)) | |
383 | ) | |
384 | (when prefix | |
55b522b2 | 385 | (require 'semantic/analyze) |
9573e58b CY |
386 | (semantic-analyze-context |
387 | "Context-for-texinfo" | |
388 | :buffer (current-buffer) | |
389 | :scope nil | |
390 | :bounds bounds | |
391 | :prefix prefix | |
392 | :prefixtypes nil | |
393 | :prefixclass prefixclass) | |
394 | ) | |
395 | )) | |
396 | ||
397 | (defvar semantic-texi-command-completion-list | |
398 | (append (mapcar (lambda (a) (car a)) texinfo-section-list) | |
399 | (condition-case nil | |
400 | texinfo-environments | |
401 | (error | |
402 | ;; XEmacs doesn't use the above. Split up its regexp | |
403 | (split-string texinfo-environment-regexp "\\\\|\\|\\^@\\\\(\\|\\\\)") | |
404 | )) | |
405 | ;; Is there a better list somewhere? Here are few | |
406 | ;; of the top of my head. | |
407 | "anchor" "asis" | |
408 | "bullet" | |
409 | "code" "copyright" | |
410 | "defun" "deffn" "defoption" "defvar" "dfn" | |
411 | "emph" "end" | |
412 | "ifinfo" "iftex" "inforef" "item" "itemx" | |
413 | "kdb" | |
414 | "node" | |
415 | "ref" | |
416 | "set" "setfilename" "settitle" | |
417 | "value" "var" | |
418 | "xref" | |
419 | ) | |
420 | "List of commands that we might bother completing.") | |
421 | ||
422 | (define-mode-local-override semantic-analyze-possible-completions | |
423 | texinfo-mode (context) | |
424 | "List smart completions at point. | |
425 | Since texinfo is not a programming language the default version is not | |
426 | useful. Insted, look at the current symbol. If it is a command | |
427 | do primitive texinfo built ins. If not, use ispell to lookup words | |
428 | that start with that symbol." | |
429 | (let ((prefix (car (oref context :prefix))) | |
430 | ) | |
431 | (cond ((member 'function (oref context :prefixclass)) | |
432 | ;; Do completion for texinfo commands | |
433 | (let* ((cmd (substring prefix 1)) | |
434 | (lst (all-completions | |
435 | cmd semantic-texi-command-completion-list))) | |
436 | (mapcar (lambda (f) (semantic-tag (concat "@" f) 'function)) | |
437 | lst)) | |
438 | ) | |
439 | ((member 'word (oref context :prefixclass)) | |
440 | ;; Do completion for words via ispell. | |
441 | (require 'ispell) | |
442 | (let ((word-list (lookup-words prefix))) | |
443 | (mapcar (lambda (f) (semantic-tag f 'word)) word-list)) | |
444 | ) | |
445 | (t nil)) | |
446 | )) | |
447 | ||
448 | \f | |
449 | ;;; Parser Setup | |
450 | ;; | |
451 | (defun semantic-default-texi-setup () | |
452 | "Set up a buffer for parsing of Texinfo files." | |
453 | ;; This will use our parser. | |
454 | (semantic-install-function-overrides | |
455 | '((parse-region . semantic-texi-parse-region) | |
456 | (parse-changes . semantic-texi-parse-changes))) | |
457 | (setq semantic-parser-name "TEXI" | |
458 | ;; Setup a dummy parser table to enable parsing! | |
459 | semantic--parse-table t | |
460 | imenu-create-index-function 'semantic-create-imenu-index | |
461 | semantic-command-separation-character "@" | |
462 | semantic-type-relation-separator-character '(":") | |
463 | semantic-symbol->name-assoc-list '((section . "Section") | |
464 | (def . "Definition") | |
465 | ) | |
466 | semantic-imenu-expandable-tag-classes '(section) | |
467 | semantic-imenu-bucketize-file nil | |
468 | semantic-imenu-bucketize-type-members nil | |
469 | senator-step-at-start-end-tag-classes '(section) | |
470 | semantic-stickyfunc-sticky-classes '(section) | |
471 | ) | |
472 | (local-set-key [(f9)] 'semantic-texi-update-doc-from-texi) | |
473 | ) | |
474 | ||
475 | (add-hook 'texinfo-mode-hook 'semantic-default-texi-setup) | |
476 | ||
477 | \f | |
478 | ;;; Special features of Texinfo tag streams | |
479 | ;; | |
480 | ;; This section provides specialized access into texinfo files. | |
481 | ;; Because texinfo files often directly refer to functions and programs | |
482 | ;; it is useful to access the texinfo file from the C code for document | |
483 | ;; maintainance. | |
484 | (defun semantic-texi-associated-files (&optional buffer) | |
485 | "Find texinfo files associated with BUFFER." | |
486 | (save-excursion | |
487 | (if buffer (set-buffer buffer)) | |
488 | (cond ((and (fboundp 'ede-documentation-files) | |
489 | ede-minor-mode (ede-current-project)) | |
490 | ;; When EDE is active, ask it. | |
491 | (ede-documentation-files) | |
492 | ) | |
55b522b2 | 493 | ((and (featurep 'semantic/db) (semanticdb-minor-mode-p)) |
9573e58b CY |
494 | ;; See what texinfo files we have loaded in the database |
495 | (let ((tabs (semanticdb-get-database-tables | |
496 | semanticdb-current-database)) | |
497 | (r nil)) | |
498 | (while tabs | |
499 | (if (eq (oref (car tabs) major-mode) 'texinfo-mode) | |
500 | (setq r (cons (oref (car tabs) file) r))) | |
501 | (setq tabs (cdr tabs))) | |
502 | r)) | |
503 | (t | |
504 | (directory-files default-directory nil "\\.texi$")) | |
505 | ))) | |
506 | ||
507 | ;; Turns out this might not be useful. | |
508 | ;; Delete later if that is true. | |
509 | (defun semantic-texi-find-documentation (name &optional type) | |
510 | "Find the function or variable NAME of TYPE in the texinfo source. | |
511 | NAME is a string representing some functional symbol. | |
512 | TYPE is a string, such as \"variable\" or \"Command\" used to find | |
513 | the correct definition in case NAME qualifies as several things. | |
514 | When this function exists, POINT is at the definition. | |
515 | If the doc was not found, an error is thrown. | |
516 | Note: TYPE not yet implemented." | |
517 | (let ((f (semantic-texi-associated-files)) | |
518 | stream match) | |
519 | (while (and f (not match)) | |
520 | (unless stream | |
521 | (with-current-buffer (find-file-noselect (car f)) | |
522 | (setq stream (semantic-fetch-tags)))) | |
523 | (setq match (semantic-find-first-tag-by-name name stream)) | |
524 | (when match | |
525 | (set-buffer (semantic-tag-buffer match)) | |
526 | (goto-char (semantic-tag-start match))) | |
527 | (setq f (cdr f))))) | |
528 | ||
529 | (defun semantic-texi-update-doc-from-texi (&optional tag) | |
530 | "Update the documentation in the texinfo deffn class tag TAG. | |
531 | The current buffer must be a texinfo file containing TAG. | |
532 | If TAG is nil, determine a tag based on the current position." | |
533 | (interactive) | |
55b522b2 | 534 | (unless (or (featurep 'semantic/db) (semanticdb-minor-mode-p)) |
9573e58b CY |
535 | (error "Texinfo updating only works when `semanticdb' is being used")) |
536 | (semantic-fetch-tags) | |
537 | (unless tag | |
538 | (beginning-of-line) | |
539 | (setq tag (semantic-current-tag))) | |
540 | (unless (semantic-tag-of-class-p tag 'def) | |
541 | (error "Only deffns (or defun or defvar) can be updated")) | |
542 | (let* ((name (semantic-tag-name tag)) | |
543 | (tags (semanticdb-strip-find-results | |
544 | (semanticdb-with-match-any-mode | |
545 | (semanticdb-brute-deep-find-tags-by-name name)) | |
546 | 'name)) | |
547 | (docstring nil) | |
548 | (docstringproto nil) | |
549 | (docstringvar nil) | |
550 | (doctag nil) | |
551 | (doctagproto nil) | |
552 | (doctagvar nil) | |
553 | ) | |
554 | (save-excursion | |
555 | (while (and tags (not docstring)) | |
556 | (let ((sourcetag (car tags))) | |
557 | ;; There could be more than one! Come up with a better | |
558 | ;; solution someday. | |
559 | (when (semantic-tag-buffer sourcetag) | |
560 | (set-buffer (semantic-tag-buffer sourcetag)) | |
561 | (unless (eq major-mode 'texinfo-mode) | |
562 | (cond ((semantic-tag-get-attribute sourcetag :prototype-flag) | |
563 | ;; If we found a match with doc that is a prototype, then store | |
564 | ;; that, but don't exit till we find the real deal. | |
565 | (setq docstringproto (semantic-documentation-for-tag sourcetag) | |
566 | doctagproto sourcetag)) | |
567 | ((eq (semantic-tag-class sourcetag) 'variable) | |
568 | (setq docstringvar (semantic-documentation-for-tag sourcetag) | |
569 | doctagvar sourcetag)) | |
570 | ((semantic-tag-get-attribute sourcetag :override-function-flag) | |
571 | nil) | |
572 | (t | |
573 | (setq docstring (semantic-documentation-for-tag sourcetag)))) | |
574 | (setq doctag (if docstring sourcetag nil)))) | |
575 | (setq tags (cdr tags))))) | |
576 | ;; If we found a prototype of the function that has some doc, but not the | |
577 | ;; actual function, lets make due with that. | |
578 | (if (not docstring) | |
579 | (cond ((stringp docstringvar) | |
580 | (setq docstring docstringvar | |
581 | doctag doctagvar)) | |
582 | ((stringp docstringproto) | |
583 | (setq docstring docstringproto | |
584 | doctag doctagproto)))) | |
585 | ;; Test for doc string | |
586 | (unless docstring | |
587 | (error "Could not find documentation for %s" (semantic-tag-name tag))) | |
588 | ;; If we have a string, do the replacement. | |
589 | (delete-region (semantic-tag-start tag) | |
590 | (semantic-tag-end tag)) | |
591 | ;; Use useful functions from the docaument library. | |
592 | (require 'document) | |
593 | (document-insert-texinfo doctag (semantic-tag-buffer doctag)) | |
594 | )) | |
595 | ||
596 | (defun semantic-texi-update-doc-from-source (&optional tag) | |
597 | "Update the documentation for the source TAG. | |
598 | The current buffer must be a non-texinfo source file containing TAG. | |
599 | If TAG is nil, determine the tag based on the current position. | |
600 | The current buffer must include TAG." | |
601 | (interactive) | |
602 | (when (eq major-mode 'texinfo-mode) | |
603 | (error "Not a source file")) | |
604 | (semantic-fetch-tags) | |
605 | (unless tag | |
606 | (setq tag (semantic-current-tag))) | |
607 | (unless (semantic-documentation-for-tag tag) | |
608 | (error "Cannot find interesting documentation to use for %s" | |
609 | (semantic-tag-name tag))) | |
610 | (let* ((name (semantic-tag-name tag)) | |
611 | (texi (semantic-texi-associated-files)) | |
612 | (doctag nil) | |
613 | (docbuff nil)) | |
614 | (while (and texi (not doctag)) | |
615 | (set-buffer (find-file-noselect (car texi))) | |
616 | (setq doctag (car (semantic-deep-find-tags-by-name | |
617 | name (semantic-fetch-tags))) | |
618 | docbuff (if doctag (current-buffer) nil)) | |
619 | (setq texi (cdr texi))) | |
620 | (unless doctag | |
621 | (error "Tag %s is not yet documented. Use the `document' command" | |
622 | name)) | |
623 | ;; Ok, we should have everything we need. Do the deed. | |
624 | (if (get-buffer-window docbuff) | |
625 | (set-buffer docbuff) | |
626 | (switch-to-buffer docbuff)) | |
627 | (goto-char (semantic-tag-start doctag)) | |
628 | (delete-region (semantic-tag-start doctag) | |
629 | (semantic-tag-end doctag)) | |
630 | ;; Use useful functions from the document library. | |
631 | (require 'document) | |
632 | (document-insert-texinfo tag (semantic-tag-buffer tag)) | |
633 | )) | |
634 | ||
635 | (defun semantic-texi-update-doc (&optional tag) | |
636 | "Update the documentation for TAG. | |
637 | If the current buffer is a texinfo file, then find the source doc, and | |
638 | update it. If the current buffer is a source file, then get the | |
639 | documentation for this item, find the existing doc in the associated | |
640 | manual, and update that." | |
641 | (interactive) | |
642 | (cond ((eq major-mode 'texinfo-mode) | |
643 | (semantic-texi-update-doc-from-texi tag)) | |
644 | (t | |
645 | (semantic-texi-update-doc-from-source tag)))) | |
646 | ||
647 | (defun semantic-texi-goto-source (&optional tag) | |
648 | "Jump to the source for the definition in the texinfo file TAG. | |
649 | If TAG is nil, it is derived from the deffn under POINT." | |
650 | (interactive) | |
55b522b2 | 651 | (unless (or (featurep 'semantic/db) (semanticdb-minor-mode-p)) |
9573e58b CY |
652 | (error "Texinfo updating only works when `semanticdb' is being used")) |
653 | (semantic-fetch-tags) | |
654 | (unless tag | |
655 | (beginning-of-line) | |
656 | (setq tag (semantic-current-tag))) | |
657 | (unless (semantic-tag-of-class-p tag 'def) | |
658 | (error "Only deffns (or defun or defvar) can be updated")) | |
659 | (let* ((name (semantic-tag-name tag)) | |
660 | (tags (semanticdb-fast-strip-find-results | |
661 | (semanticdb-with-match-any-mode | |
662 | (semanticdb-brute-deep-find-tags-by-name name nil 'name)) | |
663 | )) | |
664 | ||
665 | (done nil) | |
666 | ) | |
667 | (save-excursion | |
668 | (while (and tags (not done)) | |
669 | (set-buffer (semantic-tag-buffer (car tags))) | |
670 | (unless (eq major-mode 'texinfo-mode) | |
671 | (switch-to-buffer (semantic-tag-buffer (car tags))) | |
672 | (goto-char (semantic-tag-start (car tags))) | |
673 | (setq done t)) | |
674 | (setq tags (cdr tags))) | |
675 | (if (not done) | |
676 | (error "Could not find tag for %s" (semantic-tag-name tag))) | |
677 | ))) | |
678 | ||
679 | (provide 'semantic/texi) | |
680 | ||
55b522b2 | 681 | ;;; semantic/texi.el ends here |