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-2015 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 if '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