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

   1 ;;; semantic-doc.el --- Routines for documentation strings
   2
   3 ;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2005 Eric M. Ludlam
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6 ;; Keywords: syntax
   7 ;; X-RCS: $Id: semantic-doc.el,v 1.1 2007-11-26 15:10:35 michaels Exp $
   8
   9 ;; This file is not part of GNU Emacs.
  10
  11 ;; Semantic is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; This software is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27 ;;
  28 ;; It is good practice to write documenation for your functions and
  29 ;; variables.  These core routines deal with these documentation
  30 ;; comments or strings.  They can exist either as a tag property
  31 ;; (:documentation) or as a comment just before the symbol, or after
  32 ;; the symbol on the same line.
  33
  34 (require 'semantic-tag)
  35
  36 ;;; Code:
  37
  38 ;;;###autoload
  39 (define-overload semantic-documentation-for-tag (&optional tag nosnarf)
  40   "Find documentation from TAG and return it as a clean string.
  41 TAG might have DOCUMENTATION set in it already.  If not, there may be
  42 some documentation in a comment preceding TAG's definition which we
  43 can look for.  When appropriate, this can be overridden by a language specific
  44 enhancement.
  45 Optional argument NOSNARF means to only return the lexical analyzer token for it.
  46 If nosnarf if 'lex, then only return the lex token."
  47   (if (not tag) (setq tag (semantic-current-tag)))
  48   (:override
  49    ;; No override.  Try something simple to find documentation nearby
  50    (save-excursion
  51      (set-buffer (semantic-tag-buffer tag))
  52      (semantic-go-to-tag tag)
  53      (or
  54       ;; Is there doc in the tag???
  55       (if (semantic-tag-docstring tag)
  56           (if (stringp (semantic-tag-docstring tag))
  57               (semantic-tag-docstring tag)
  58             (goto-char (semantic-tag-docstring tag))
  59             (semantic-doc-snarf-comment-for-tag nosnarf)))
  60       ;; Check just before the definition.
  61       (semantic-documentation-comment-preceeding-tag tag nosnarf)
  62       ;;  Lets look for comments either after the definition, but before code:
  63       ;; Not sure yet.  Fill in something clever later....
  64       nil))))
  65
  66 (defun semantic-documentation-comment-preceeding-tag (&optional tag nosnarf)
  67   "Find a comment preceeding TAG.
  68 If TAG is nil.  use the tag under point.
  69 Searches the space between TAG and the preceeding tag for a comment,
  70 and converts the comment into clean documentation.
  71 Optional argument NOSNARF means to return just the lexical token and
  72 not the string."
  73   (if (not tag) (setq tag (semantic-current-tag)))
  74   (save-excursion
  75     ;; Find this tag.
  76     (semantic-go-to-tag tag)
  77     (let* ((end (point))
  78            (starttag (semantic-find-tag-by-overlay-prev
  79                       (semantic-tag-start tag)))
  80            (start (if starttag
  81                       (semantic-tag-end starttag)
  82                     (point-min))))
  83       (when (re-search-backward comment-start-skip start t)
  84         ;; We found a comment that doesn't belong to the body
  85         ;; of a function.
  86         (semantic-doc-snarf-comment-for-tag nosnarf)))
  87     ))
  88
  89 (make-obsolete-overload 'semantic-find-documentation
  90                         'semantic-documentation-for-tag)
  91
  92 (defun semantic-doc-snarf-comment-for-tag (nosnarf)
  93   "Snarf up the comment at POINT for `semantic-documentation-for-tag'.
  94 Attempt to strip out comment syntactic sugar.
  95 Argument NOSNARF means don't modify the found text.
  96 If NOSNARF is 'lex, then return the lex token."
  97   (let* ((semantic-ignore-comments nil)
  98          (semantic-lex-analyzer #'semantic-comment-lexer))
  99     (if (memq nosnarf '(lex flex)) ;; keep `flex' for compatibility
 100         (car (semantic-lex (point) (1+ (point))))
 101       (let ((ct (semantic-lex-token-text
 102                  (car (semantic-lex (point) (1+ (point)))))))
 103         (if nosnarf
 104             nil
 105           ;; ok, try to clean the text up.
 106           ;; Comment start thingy
 107           (while (string-match (concat "^\\s-*" comment-start-skip) ct)
 108             (setq ct (concat (substring ct 0 (match-beginning 0))
 109                              (substring ct (match-end 0)))))
 110           ;; Arbitrary punctuation at the beginning of each line.
 111           (while (string-match "^\\s-*\\s.+\\s-*" ct)
 112             (setq ct (concat (substring ct 0 (match-beginning 0))
 113                              (substring ct (match-end 0)))))
 114           ;; End of a block comment.
 115           (if (and block-comment-end (string-match block-comment-end ct))
 116               (setq ct (concat (substring ct 0 (match-beginning 0))
 117                                (substring ct (match-end 0)))))
 118           ;; In case it's a real string, STRIPIT.
 119           (while (string-match "\\s-*\\s\"+\\s-*" ct)
 120             (setq ct (concat (substring ct 0 (match-beginning 0))
 121                              (substring ct (match-end 0))))))
 122         ;; Now return the text.
 123         ct))))
 124
 125 ;;;###autoload
 126 (semantic-alias-obsolete 'semantic-find-documentation
 127                          'semantic-documentation-for-tag)
 128
 129 (provide 'semantic-doc)
 130
 131 ;;; semantic-doc.el ends here