lisp/cedet/semantic/texi.el

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