cgit.sxemacs.org Git - packages/blob - xemacs-packages/semantic/semantic-texi.el

   1 ;;; semantic-texi.el --- Semantic details for Texinfo files
   2
   3 ;;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2007 Eric M. Ludlam
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6 ;; X-RCS: $Id: semantic-texi.el,v 1.35 2007/05/20 16:06:35 zappo Exp $
   7
   8 ;; This file is not part of GNU Emacs.
   9
  10 ;; This 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 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This software 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; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26 ;;
  27 ;; Parse Texinfo buffers using regular expressions.  The core parser
  28 ;; engine is the function `semantic-texi-parse-headings'.  The
  29 ;; parser plug-in is the function `semantic-texi-parse-region' that
  30 ;; overrides `semantic-parse-region'.
  31
  32 (require 'semantic)
  33 (require 'semantic-format)
  34 (require 'texinfo)
  35
  36 (eval-when-compile
  37   (require 'semanticdb)
  38   (require 'semanticdb-find)
  39   (require 'semantic-ctxt)
  40   (require 'semantic-imenu)
  41   (require 'semantic-doc)
  42   (require 'senator))
  43
  44 (defvar semantic-texi-super-regex
  45   "^@\\(chapter\\|\\(sub\\)*section\\|unnumbered\\(\\(sub\\)*sec\\)?\\|\
  46 \\(chap\\|\\(sub\\)+\\|major\\)?heading\\|appendix\\(\\(sub\\)*sec\\)?\\|\
  47 centerchap\\|def\\(var\\|un\\|fn\\|opt\\)x?\\)"
  48   "Regular expression used to find special sections in a Texinfo file.")
  49
  50 (defvar semantic-texi-name-field-list
  51   '( ("defvar" . 1)
  52      ("defvarx" . 1)
  53      ("defun" . 1)
  54      ("defunx" . 1)
  55      ("defopt" . 1)
  56      ("deffn" . 2)
  57      ("deffnx" . 2)
  58      )
  59   "List of definition commands, and the field position.
  60 The field position is the field number (based at 1) where the
  61 name of this section is.")
  62
  63 ;;; Code:
  64 (defun semantic-texi-parse-region (&rest ignore)
  65   "Parse the current texinfo buffer for semantic tags.
  66 IGNORE any arguments, always parse the whole buffer.
  67 Each tag returned is of the form:
  68  (\"NAME\" section (:members CHILDREN))
  69 or
  70  (\"NAME\" def)
  71
  72 It is an override of 'parse-region and must be installed by the
  73 function `semantic-install-function-overrides'."
  74   (mapcar 'semantic-texi-expand-tag
  75           (semantic-texi-parse-headings)))
  76
  77 (defun semantic-texi-parse-changes ()
  78   "Parse changes in the current texinfo buffer."
  79   ;; NOTE: For now, just schedule a full reparse.
  80   ;;       To be implemented later.
  81   (semantic-parse-tree-set-needs-rebuild))
  82
  83 (defun semantic-texi-expand-tag (tag)
  84   "Expand the texinfo tag TAG."
  85   (let ((chil (semantic-tag-components tag)))
  86     (if chil
  87         (semantic-tag-put-attribute
  88          tag :members (mapcar 'semantic-texi-expand-tag chil)))
  89     (car (semantic--tag-expand tag))))
  90
  91 (defun semantic-texi-parse-headings ()
  92   "Parse the current texinfo buffer for all semantic tags now."
  93   (let ((pass1 nil))
  94     ;; First search and snarf.
  95     (save-excursion
  96       (goto-char (point-min))
  97       (working-status-forms (file-name-nondirectory buffer-file-name) "done"
  98         (while (re-search-forward semantic-texi-super-regex nil t)
  99           (setq pass1 (cons (match-beginning 0) pass1))
 100           (working-status)
 101           )
 102         (working-status t)))
 103     (setq pass1 (nreverse pass1))
 104     ;; Now, make some tags while creating a set of children.
 105     (car (semantic-texi-recursive-combobulate-list pass1 0))
 106     ))
 107
 108 (defsubst semantic-texi-new-section-tag (name members start end)
 109   "Create a semantic tag of class section.
 110 NAME is the name of this section.
 111 MEMBERS is a list of semantic tags representing the elements that make
 112 up this section.
 113 START and END define the location of data described by the tag."
 114   (append (semantic-tag name 'section :members members)
 115           (list start end)))
 116
 117 (defsubst semantic-texi-new-def-tag (name start end)
 118   "Create a semantic tag of class def.
 119 NAME is the name of this definition.
 120 START and END define the location of data described by the tag."
 121   (append (semantic-tag name 'def)
 122           (list start end)))
 123
 124 (defun semantic-texi-set-endpoint (metataglist pnt)
 125   "Set the end point of the first section tag in METATAGLIST to PNT.
 126 METATAGLIST is a list of tags in the intermediate tag format used by the
 127 texinfo parser.  PNT is the new point to set."
 128   (let ((metatag nil))
 129     (while (and metataglist
 130                 (not (eq (semantic-tag-class (car metataglist)) 'section)))
 131       (setq metataglist (cdr metataglist)))
 132     (setq metatag (car metataglist))
 133     (when metatag
 134       (setcar (nthcdr (1- (length metatag)) metatag) pnt)
 135       metatag)))
 136
 137 (defun semantic-texi-recursive-combobulate-list (sectionlist level)
 138   "Rearrange SECTIONLIST to be a hierarchical tag list starting at LEVEL.
 139 Return the rearranged new list, with all remaining tags from
 140 SECTIONLIST starting at ELT 2.  Sections not are not dealt with as soon as a
 141 tag with greater section value than LEVEL is found."
 142   (let ((newl nil)
 143         (oldl sectionlist)
 144         tag
 145         )
 146     (save-excursion
 147       (catch 'level-jump
 148         (while oldl
 149           (goto-char (car oldl))
 150           (if (looking-at "@\\(\\w+\\)")
 151               (let* ((word (match-string 1))
 152                      (levelmatch (assoc word texinfo-section-list))
 153                      text begin tmp
 154                      )
 155                 ;; Set begin to the right location
 156                 (setq begin (point))
 157                 ;; Get out of here if there if we made it that far.
 158                 (if (and levelmatch (<= (car (cdr levelmatch)) level))
 159                     (progn
 160                       (when newl
 161                         (semantic-texi-set-endpoint newl begin))
 162                       (throw 'level-jump t)))
 163                 ;; Recombobulate
 164                 (if levelmatch
 165                     (progn
 166                       ;; When there is a match, the descriptive text
 167                       ;; consists of the rest of the line.
 168                       (goto-char (match-end 1))
 169                       (skip-chars-forward " \t")
 170                       (setq text (buffer-substring-no-properties
 171                                   (point)
 172                                   (progn (end-of-line) (point))))
 173                       ;; Next, recurse into the body to find the end.
 174                       (setq tmp (semantic-texi-recursive-combobulate-list
 175                                  (cdr oldl) (car (cdr levelmatch))))
 176                       ;; Build a tag
 177                       (setq tag (semantic-texi-new-section-tag
 178                                  text (car tmp) begin (point)))
 179                       ;; Before appending the newtag, update the previous tag
 180                       ;; if it is a section tag.
 181                       (when newl
 182                         (semantic-texi-set-endpoint newl begin))
 183                       ;; Append new tag to our master list.
 184                       (setq newl (cons tag newl))
 185                       ;; continue
 186                       (setq oldl (cdr tmp))
 187                       )
 188                   ;; No match means we have a def*, so get the name from
 189                   ;; it based on the type of thingy we found.
 190                   (setq levelmatch (assoc word semantic-texi-name-field-list)
 191                         tmp (or (cdr levelmatch) 1))
 192                   (forward-sexp tmp)
 193                   (skip-chars-forward " \t")
 194                   (setq text (buffer-substring-no-properties
 195                               (point)
 196                               (progn (forward-sexp 1) (point))))
 197                   ;; Seek the end of this definition
 198                   (goto-char begin)
 199                   (semantic-texi-forward-deffn)
 200                   (setq tag (semantic-texi-new-def-tag text begin (point))
 201                         newl (cons tag newl))
 202                   ;; continue
 203                   (setq oldl (cdr oldl)))
 204                 )
 205             (error "Problem finding section in semantic/texi parser"))
 206           ;; (setq oldl (cdr oldl))
 207           )))
 208     (cons (nreverse newl) oldl)))
 209
 210 (defun semantic-texi-forward-deffn ()
 211   "Move forward over one deffn type definition.
 212 The cursor should be on the @ sign."
 213   (when (looking-at "@\\(\\w+\\)")
 214     (let* ((type (match-string 1))
 215            (seek (concat "^@end\\s-+" (regexp-quote type))))
 216       (re-search-forward seek nil t))))
 217
 218 (define-mode-local-override semantic-tag-components
 219   texinfo-mode (tag)
 220   "Return components belonging to TAG."
 221   (semantic-tag-get-attribute tag :members))
 222
 223 (define-mode-local-override semantic-insert-foreign-tag
 224   texinfo-mode (foreign-tag)
 225   "Insert TAG from a foreign buffer in TAGFILE.
 226 Assume TAGFILE is a source buffer, and create a documentation
 227 thingy from it using the `document' tool."
 228   ;; This makes sure that TAG will be in an active buffer.
 229   (let ((b (semantic-tag-buffer foreign-tag)))
 230     ;; Now call the document insert thingy.
 231     (require 'document)
 232     (document-insert-texinfo foreign-tag b)))
 233
 234
 235 (define-mode-local-override semantic-ctxt-current-class-list
 236   texinfo-mode (&optional point)
 237   "Determine the class of tags that can be used at POINT.
 238 For texinfo, there two possibilities returned.
 239 1) 'function - for a call to a texinfo function
 240 2) 'word     - indicates an english word.
 241 It would be nice to know function arguments too, but not today."
 242   (let ((sym (semantic-ctxt-current-symbol)))
 243     (if (and sym (= (aref (car sym) 0) ?@))
 244         '(function)
 245       '(word))))
 246
 247 (define-mode-local-override semantic-format-tag-abbreviate
 248   texinfo-mode  (tag &optional parent color)
 249   "Texinfo tags abbreviation."
 250   (let ((class (semantic-tag-class tag))
 251         (name (semantic-format-tag-name tag parent color))
 252         )
 253     (cond ((eq class 'function)
 254            (concat name "{ }"))
 255           (t (semantic-format-tag-abbreviate-default tag parent color)))
 256     ))
 257
 258 (define-mode-local-override semantic-format-tag-prototype
 259   texinfo-mode  (tag &optional parent color)
 260   "Texinfo tags abbreviation."
 261   (semantic-format-tag-abbreviate tag parent color))
 262
 263 (eval-when-compile
 264   (require 'semantic-analyze))
 265
 266 (define-mode-local-override semantic-analyze-current-context
 267   texinfo-mode (point)
 268   "Analysis context makes no sense for texinfo.  Return nil."
 269   (let* ((prefixandbounds (semantic-analyze-calculate-bounds))
 270          (prefix (car prefixandbounds))
 271          (endsym (nth 1 prefixandbounds))
 272          (bounds (nth 2 prefixandbounds))
 273          (prefixclass (semantic-ctxt-current-class-list))
 274          )
 275     (when prefix
 276       (require 'semantic-analyze)
 277       (semantic-analyze-context
 278        "Context-for-texinfo"
 279        :buffer (current-buffer)
 280        :scope nil
 281        :scopetypes nil
 282        :localvariables nil
 283        :bounds bounds
 284        :prefix prefix
 285        :prefixtypes nil
 286        :prefixclass prefixclass)
 287       )
 288     ))
 289
 290 (defvar semantic-texi-command-completion-list
 291   (append (mapcar (lambda (a) (car a)) texinfo-section-list)
 292           texinfo-environments
 293           ;; Is there a better list somewhere?  Here are few
 294           ;; of the top of my head.
 295           "anchor" "asis"
 296           "bullet"
 297           "code" "copyright"
 298           "defun" "deffn" "defoption" "defvar" "dfn"
 299           "emph" "end"
 300           "ifinfo" "iftex" "inforef" "item" "itemx"
 301           "kdb"
 302           "node"
 303           "ref"
 304           "set" "setfilename" "settitle"
 305           "value" "var"
 306           "xref"
 307           )
 308   "List of commands that we might bother completing.")
 309
 310 (define-mode-local-override semantic-analyze-possible-completions
 311   texinfo-mode (context)
 312   "List smart completions at point.
 313 Since texinfo is not a programming language the default version is not
 314 useful.  Insted, look at the current symbol.  If it is a command
 315 do primitive texinfo built ins.  If not, use ispell to lookup words
 316 that start with that symbol."
 317   (let ((prefix (car (oref context :prefix)))
 318         )
 319     (cond ((member 'function (oref context :prefixclass))
 320            ;; Do completion for texinfo commands
 321            (let* ((cmd (substring prefix 1))
 322                   (lst (all-completions
 323                         cmd semantic-texi-command-completion-list)))
 324              (mapcar (lambda (f) (semantic-tag (concat "@" f) 'function))
 325                      lst))
 326            )
 327           ((member 'word (oref context :prefixclass))
 328            ;; Do completion for words via ispell.
 329            (require 'ispell)
 330            (let ((word-list (lookup-words prefix)))
 331              (mapcar (lambda (f) (semantic-tag f 'word)) word-list))
 332            )
 333           (t nil))
 334     ))
 335
 336 ;;;###autoload
 337 (defun semantic-default-texi-setup ()
 338   "Set up a buffer for parsing of Texinfo files."
 339   ;; This will use our parser.
 340   (semantic-install-function-overrides
 341    '((parse-region . semantic-texi-parse-region)
 342      (parse-changes . semantic-texi-parse-changes)))
 343   (setq semantic-parser-name "TEXI"
 344         ;; Setup a dummy parser table to enable parsing!
 345         semantic--parse-table t
 346         imenu-create-index-function 'semantic-create-imenu-index
 347         semantic-command-separation-character "@"
 348         semantic-type-relation-separator-character '(":")
 349         semantic-symbol->name-assoc-list '((section . "Section")
 350                                            (def . "Definition")
 351                                            )
 352         semantic-imenu-expandable-tag-classes '(section)
 353         semantic-imenu-bucketize-file nil
 354         semantic-imenu-bucketize-type-members nil
 355         senator-step-at-start-end-tag-classes '(section)
 356         semantic-stickyfunc-sticky-classes '(section)
 357         )
 358   (local-set-key [(f9)] 'semantic-texi-update-doc-from-texi)
 359   )
 360
 361 ;;;###autoload
 362 (add-hook 'texinfo-mode-hook 'semantic-default-texi-setup)
 363
 364 \f
 365 ;;; Special features of Texinfo tag streams
 366 ;;
 367 ;; This section provides specialized access into texinfo files.
 368 ;; Because texinfo files often directly refer to functions and programs
 369 ;; it is useful to access the texinfo file from the C code for document
 370 ;; maintainance.
 371 (defun semantic-texi-associated-files (&optional buffer)
 372   "Find texinfo files associated with BUFFER."
 373   (save-excursion
 374     (if buffer (set-buffer buffer))
 375     (cond ((and (fboundp 'ede-documentation-files)
 376                 ede-minor-mode (ede-current-project))
 377            ;; When EDE is active, ask it.
 378            (ede-documentation-files)
 379            )
 380           ((and (featurep 'semanticdb) (semanticdb-minor-mode-p))
 381            ;; See what texinfo files we have loaded in the database
 382            (let ((tabs (semanticdb-get-database-tables
 383                         semanticdb-current-database))
 384                  (r nil))
 385              (while tabs
 386                (if (eq (oref (car tabs) major-mode) 'texinfo-mode)
 387                    (setq r (cons (oref (car tabs) file) r)))
 388                (setq tabs (cdr tabs)))
 389              r))
 390           (t
 391            (directory-files default-directory nil "\\.texi$"))
 392           )))
 393
 394 ;; Turns out this might not be useful.
 395 ;; Delete later if that is true.
 396 (defun semantic-texi-find-documentation (name &optional type)
 397   "Find the function or variable NAME of TYPE in the texinfo source.
 398 NAME is a string representing some functional symbol.
 399 TYPE is a string, such as \"variable\" or \"Command\" used to find
 400 the correct definition in case NAME qualifies as several things.
 401 When this function exists, POINT is at the definition.
 402 If the doc was not found, an error is thrown.
 403 Note: TYPE not yet implemented."
 404   (let ((f (semantic-texi-associated-files))
 405         stream match)
 406     (while (and f (not match))
 407       (unless stream
 408         (with-current-buffer (find-file-noselect (car f))
 409           (setq stream (semantic-fetch-tags))))
 410       (setq match (semantic-find-first-tag-by-name name stream))
 411       (when match
 412         (set-buffer (semantic-tag-buffer match))
 413         (goto-char (semantic-tag-start match)))
 414       (setq f (cdr f)))))
 415
 416 (defun semantic-texi-update-doc-from-texi (&optional tag)
 417   "Update the documentation in the texinfo deffn class tag TAG.
 418 The current buffer must be a texinfo file containing TAG.
 419 If TAG is nil, determine a tag based on the current position."
 420   (interactive)
 421   (unless (or (featurep 'semanticdb) (semanticdb-minor-mode-p))
 422     (error "Texinfo updating only works when `semanticdb' is being used"))
 423   (semantic-fetch-tags)
 424   (unless tag
 425     (beginning-of-line)
 426     (setq tag (semantic-current-tag)))
 427   (unless (semantic-tag-of-class-p tag 'def)
 428     (error "Only deffns (or defun or defvar) can be updated"))
 429   (let* ((name (semantic-tag-name tag))
 430          (tags (semanticdb-strip-find-results
 431                 (semanticdb-with-match-any-mode
 432                   (semanticdb-brute-deep-find-tags-by-name name))
 433                 t))
 434          (docstring nil)
 435          (docstringproto nil)
 436          (docstringvar nil)
 437          (doctag nil)
 438          (doctagproto nil)
 439          (doctagvar nil)
 440          )
 441     (save-excursion
 442       (while (and tags (not docstring))
 443         (let ((sourcetag (car tags)))
 444           ;; There could be more than one!  Come up with a better
 445           ;; solution someday.
 446           (when (semantic-tag-buffer sourcetag)
 447             (set-buffer (semantic-tag-buffer sourcetag))
 448             (unless (eq major-mode 'texinfo-mode)
 449             (cond ((semantic-tag-get-attribute sourcetag :prototype-flag)
 450                    ;; If we found a match with doc that is a prototype, then store
 451                    ;; that, but don't exit till we find the real deal.
 452                    (setq docstringproto (semantic-documentation-for-tag sourcetag)
 453                          doctagproto sourcetag))
 454                   ((eq (semantic-tag-class sourcetag) 'variable)
 455                    (setq docstringvar (semantic-documentation-for-tag sourcetag)
 456                          doctagvar sourcetag))
 457                   ((semantic-tag-get-attribute sourcetag :override-function-flag)
 458                    nil)
 459                   (t
 460                    (setq docstring (semantic-documentation-for-tag sourcetag))))
 461             (setq doctag (if docstring sourcetag nil))))
 462           (setq tags (cdr tags)))))
 463     ;; If we found a prototype of the function that has some doc, but not the
 464     ;; actual function, lets make due with that.
 465     (if (not docstring)
 466         (cond ((stringp docstringvar)
 467                (setq docstring docstringvar
 468                      doctag doctagvar))
 469               ((stringp docstringproto)
 470                (setq docstring docstringproto
 471                      doctag doctagproto))))
 472     ;; Test for doc string
 473     (unless docstring
 474       (error "Could not find documentation for %s" (semantic-tag-name tag)))
 475     ;; If we have a string, do the replacement.
 476     (delete-region (semantic-tag-start tag)
 477                    (semantic-tag-end tag))
 478     ;; Use useful functions from the docaument library.
 479     (require 'document)
 480     (document-insert-texinfo doctag (semantic-tag-buffer doctag))
 481     ))
 482
 483 (defun semantic-texi-update-doc-from-source (&optional tag)
 484   "Update the documentation for the source TAG.
 485 The current buffer must be a non-texinfo source file containing TAG.
 486 If TAG is nil, determine the tag based on the current position.
 487 The current buffer must include TAG."
 488   (interactive)
 489   (when (eq major-mode 'texinfo-mode)
 490     (error "Not a source file"))
 491   (semantic-fetch-tags)
 492   (unless tag
 493     (setq tag (semantic-current-tag)))
 494   (unless (semantic-documentation-for-tag tag)
 495     (error "Cannot find interesting documentation to use for %s"
 496            (semantic-tag-name tag)))
 497   (let* ((name (semantic-tag-name tag))
 498          (texi (semantic-texi-associated-files))
 499          (doctag nil)
 500          (docbuff nil))
 501     (while (and texi (not doctag))
 502       (set-buffer (find-file-noselect (car texi)))
 503       (setq doctag (car (semantic-deep-find-tags-by-name
 504                          name (semantic-fetch-tags)))
 505             docbuff (if doctag (current-buffer) nil))
 506       (setq texi (cdr texi)))
 507     (unless doctag
 508       (error "Tag %s is not yet documented.  Use the `document' command"
 509              name))
 510     ;; Ok, we should have everything we need.  Do the deed.
 511     (if (get-buffer-window docbuff)
 512         (set-buffer docbuff)
 513       (switch-to-buffer docbuff))
 514     (goto-char (semantic-tag-start doctag))
 515     (delete-region (semantic-tag-start doctag)
 516                    (semantic-tag-end doctag))
 517     ;; Use useful functions from the document library.
 518     (require 'document)
 519     (document-insert-texinfo tag (semantic-tag-buffer tag))
 520     ))
 521
 522 (defun semantic-texi-update-doc (&optional tag)
 523   "Update the documentation for TAG.
 524 If the current buffer is a texinfo file, then find the source doc, and
 525 update it.  If the current buffer is a source file, then get the
 526 documentation for this item, find the existing doc in the associated
 527 manual, and update that."
 528   (interactive)
 529   (cond ((eq major-mode 'texinfo-mode)
 530          (semantic-texi-update-doc-from-texi tag))
 531         (t
 532          (semantic-texi-update-doc-from-source tag))))
 533
 534 (defun semantic-texi-goto-source (&optional tag)
 535   "Jump to the source for the definition in the texinfo file TAG.
 536 If TAG is nil, it is derived from the deffn under POINT."
 537   (interactive)
 538   (unless (or (featurep 'semanticdb) (semanticdb-minor-mode-p))
 539     (error "Texinfo updating only works when `semanticdb' is being used"))
 540   (semantic-fetch-tags)
 541   (unless tag
 542     (beginning-of-line)
 543     (setq tag (semantic-current-tag)))
 544   (unless (semantic-tag-of-class-p tag 'def)
 545     (error "Only deffns (or defun or defvar) can be updated"))
 546   (let* ((name (semantic-tag-name tag))
 547          (tags (semanticdb-strip-find-results
 548                 (semanticdb-with-match-any-mode
 549                   (semanticdb-brute-deep-find-tags-by-name name nil t))
 550                 ))
 551          (done nil)
 552          )
 553     (save-excursion
 554       (while (and tags (not done))
 555         (set-buffer (semantic-tag-buffer (car tags)))
 556         (unless (eq major-mode 'texinfo-mode)
 557           (switch-to-buffer (semantic-tag-buffer (car tags)))
 558           (goto-char (semantic-tag-start (car tags)))
 559           (setq done t))
 560         (setq tags (cdr tags)))
 561       (if (not done)
 562           (error "Could not find tag for %s" (semantic-tag-name tag)))
 563       )))
 564
 565 (provide 'semantic-texi)
 566
 567 ;;; semantic-texi.el ends here