code.delx.au - gnu-emacs/blob - lisp/cedet/semantic/doc.el

   1 ;;; semantic/doc.el --- Routines for documentation strings
   2
   3 ;; Copyright (C) 1999-2003, 2005, 2008-2016 Free Software Foundation,
   4 ;; Inc.
   5
   6 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   7 ;; Keywords: syntax
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs 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 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs 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.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25 ;;
  26 ;; It is good practice to write documentation for your functions and
  27 ;; variables.  These core routines deal with these documentation
  28 ;; comments or strings.  They can exist either as a tag property
  29 ;; (:documentation) or as a comment just before the symbol, or after
  30 ;; the symbol on the same line.
  31
  32 (require 'semantic/tag)
  33
  34 ;;; Code:
  35
  36 ;;;###autoload
  37 (define-overloadable-function semantic-documentation-for-tag (&optional tag nosnarf)
  38   "Find documentation from TAG and return it as a clean string.
  39 TAG might have DOCUMENTATION set in it already.  If not, there may be
  40 some documentation in a comment preceding TAG's definition which we
  41 can look for.  When appropriate, this can be overridden by a language specific
  42 enhancement.
  43 Optional argument NOSNARF means to only return the lexical analyzer token for it.
  44 If NOSNARF is `lex', then only return the lex token."
  45   (if (not tag) (setq tag (semantic-current-tag)))
  46   (save-excursion
  47     (when (semantic-tag-with-position-p tag)
  48       (set-buffer (semantic-tag-buffer tag)))
  49     (:override
  50      ;; No override.  Try something simple to find documentation nearby
  51      (save-excursion
  52        (semantic-go-to-tag tag)
  53        (let ((doctmp (semantic-tag-docstring tag (current-buffer))))
  54          (or
  55           ;; Is there doc in the tag???
  56           doctmp
  57           ;; Check just before the definition.
  58           (when (semantic-tag-with-position-p tag)
  59             (semantic-documentation-comment-preceding-tag tag nosnarf))
  60           ;;  Let's look for comments either after the definition, but before code:
  61           ;; Not sure yet.  Fill in something clever later....
  62           nil))))))
  63
  64 (defun semantic-documentation-comment-preceding-tag (&optional tag nosnarf)
  65   "Find a comment preceding TAG.
  66 If TAG is nil.  use the tag under point.
  67 Searches the space between TAG and the preceding tag for a comment,
  68 and converts the comment into clean documentation.
  69 Optional argument NOSNARF with a value of `lex' means to return
  70 just the lexical token and not the string."
  71   (if (not tag) (setq tag (semantic-current-tag)))
  72   (save-excursion
  73     ;; Find this tag.
  74     (semantic-go-to-tag tag)
  75     (let* ((starttag (semantic-find-tag-by-overlay-prev
  76                       (semantic-tag-start tag)))
  77            (start (if starttag
  78                       (semantic-tag-end starttag)
  79                     (point-min))))
  80       (when (and comment-start-skip
  81                  (re-search-backward comment-start-skip start t))
  82         ;; We found a comment that doesn't belong to the body
  83         ;; of a function.
  84         (semantic-doc-snarf-comment-for-tag nosnarf)))
  85     ))
  86 (define-obsolete-function-alias
  87   'semantic-documentation-comment-preceeding-tag
  88   'semantic-documentation-comment-preceding-tag
  89   "25.1")
  90
  91 (defun semantic-doc-snarf-comment-for-tag (nosnarf)
  92   "Snarf up the comment at POINT for `semantic-documentation-for-tag'.
  93 Attempt to strip out comment syntactic sugar.
  94 Argument NOSNARF means don't modify the found text.
  95 If NOSNARF is `lex', then return the lex token."
  96   (let* ((semantic-ignore-comments nil)
  97          (semantic-lex-analyzer #'semantic-comment-lexer))
  98     (if (memq nosnarf '(lex flex)) ;; keep `flex' for compatibility
  99         (car (semantic-lex (point) (1+ (point))))
 100       (let ((ct (semantic-lex-token-text
 101                  (car (semantic-lex (point) (1+ (point)))))))
 102         (if nosnarf
 103             nil
 104           ;; ok, try to clean the text up.
 105           ;; Comment start thingy
 106           (while (string-match (concat "^\\s-*" comment-start-skip) ct)
 107             (setq ct (concat (substring ct 0 (match-beginning 0))
 108                              (substring ct (match-end 0)))))
 109           ;; Arbitrary punctuation at the beginning of each line.
 110           (while (string-match "^\\s-*\\s.+\\s-*" ct)
 111             (setq ct (concat (substring ct 0 (match-beginning 0))
 112                              (substring ct (match-end 0)))))
 113           ;; End of a block comment.
 114           (if (and (boundp 'block-comment-end)
 115                    block-comment-end
 116                    (string-match block-comment-end ct))
 117               (setq ct (concat (substring ct 0 (match-beginning 0))
 118                                (substring ct (match-end 0)))))
 119           ;; In case it's a real string, STRIPIT.
 120           (while (string-match "\\s-*\\s\"+\\s-*" ct)
 121             (setq ct (concat (substring ct 0 (match-beginning 0))
 122                              (substring ct (match-end 0)))))
 123           ;; Remove comment delimiter at the end of the string.
 124           (when (and comment-end (not (string= comment-end ""))
 125                      (string-match (concat (regexp-quote comment-end) "$") ct))
 126             (setq ct (substring ct 0 (match-beginning 0)))))
 127         ;; Now return the text.
 128         ct))))
 129
 130 (provide 'semantic/doc)
 131
 132 ;; Local variables:
 133 ;; generated-autoload-file: "loaddefs.el"
 134 ;; generated-autoload-load-name: "semantic/doc"
 135 ;; End:
 136
 137 ;;; semantic/doc.el ends here