Source

semantic / document.el

Diff from to

document.el

-;;; document.el --- Use the bovinator to aid in generating documentation.
+;;; document.el --- Use the semantic parser to generate documentation.
 
-;;; Copyright (C) 2000, 2001, 2002 Eric M. Ludlam
+;;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2007 Eric M. Ludlam
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Keywords: doc
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 ;;
 ;; This contains most variable settings for auto-comment generation.
 (require 'document-vars)
 
-;; XEmacs change: needed to define macros at compile time.
-(eval-when-compile
-  (require 'semantic)
-  (require 'semantic-util))
+(require 'semantic)
+(require 'semantic-util)
 
 ;;; Code:
 
 ;;; User Functions
 ;;
 (defun document (&optional resetfile)
-  "Document the function or variable the cursor is in.
+  "Document in a texinfo file the function or variable the cursor is in.
 Optional argument RESETFILE is provided w/ universal argument.
-When non-nil, query for a new documentation file."
+When non-nil, query for a new documentation file.
+To document a function in a source file, use `document-inline'."
   (interactive (if current-prefix-arg
 		   (save-excursion
 		     (list (document-locate-file
 			    (current-buffer) t)))))
   ;; First, garner some information from Semantic.
-  (semantic-bovinate-toplevel t)
-  (let ((cdi (semantic-find-nonterminal-by-position (point) (current-buffer)))
+  (semantic-fetch-tags)
+  (let ((cdi (semantic-current-tag))
 	(cdib (current-buffer)))
     ;; Make sure we have a file.
     (document-locate-file (current-buffer))
 (defun document-inline ()
   "Document the current function with an inline comment."
   (interactive)
-  (semantic-bovinate-toplevel t)
-  (let ((cf (semantic-find-nonterminal-by-position (point) (current-buffer))))
+  (semantic-fetch-tags)
+  (let ((cf (semantic-current-tag)))
     (document-insert-defun-comment cf (current-buffer))))
 
 ;;; Documentation insertion functions
 ;;
-(defun document-insert-texinfo (nonterm buffer)
-  "Insert texinfo documentation about NONTERM from BUFFER."
-  (let ((tt (semantic-token-token nonterm)))
+(defun document-insert-texinfo (tag buffer)
+  "Insert texinfo documentation about TAG from BUFFER."
+  (let ((tt (semantic-tag-class tag)))
     (insert "@"
 	    (cond ((eq tt 'variable)
-		   (if (semantic-token-extra-spec nonterm 'user-visible)
+		   (if (semantic-tag-get-attribute tag :user-visible-flag)
 		       "deffn Option"
 		     "defvar"))
 		  ((eq tt 'function)
-		   (if (semantic-token-extra-spec nonterm 'user-visible)
+		   (if (semantic-tag-get-attribute tag :user-visible-flag)
 		       "deffn Command"
 		     "defun"))
 		  ((eq tt 'type)
-		   "deftype")
+		   "deffn Type")
 		  (t (error "Don't know how to document that")))
 	    " "
-	    (semantic-token-name nonterm))
+	    (semantic-tag-name tag))
     (if (eq tt 'function)
-	(let ((args (semantic-token-function-args nonterm)))
+	(let ((args (semantic-tag-function-arguments tag)))
 	  (while args
 	    (insert " ")
 	    (if (stringp (car args))
 		(insert (car args))
-	      (insert (semantic-token-name (car args))))
+	      (insert (semantic-tag-name (car args))))
 	    (setq args (cdr args)))))
-    (insert "\n")
+    (insert "\n@anchor{" (semantic-tag-name tag) "}\n")
     (insert (document-massage-to-texinfo
-	     nonterm
+	     tag
 	     buffer
-	     (document-generate-documentation nonterm buffer)))
+	     (document-generate-documentation tag buffer)))
     (insert "\n@end "
 	    (cond ((eq tt 'variable)
-		   (if (semantic-token-extra-spec nonterm 'user-visible)
+		   (if (semantic-tag-get-attribute tag :user-visible-flag)
 		       "deffn"
 		     "defvar"))
 		  ((eq tt 'function)
-		   (if (semantic-token-extra-spec nonterm 'user-visible)
+		   (if (semantic-tag-get-attribute tag :user-visible-flag)
 		       "deffn"
 		     "defun"))
 		  ((eq tt 'type)
-		   "deftype"))
+		   "deffn"))
 	    )))
 
-(defun document-insert-defun-comment (nonterm buffer)
-  "Insert mode-comment documentation about NONTERM from BUFFER."
+(defun document-insert-defun-comment (tag buffer)
+  "Insert mode-comment documentation about TAG from BUFFER."
   (interactive)
   (let ((document-runflags nil)
-	(tt (semantic-token-token nonterm)))
+	(tt (semantic-tag-class tag)))
     (cond
      ((eq tt 'function)
-      (if (semantic-find-documentation nonterm t)
-	  (document-update-comment nonterm)
-	(document-insert-function-comment-new nonterm))
+      (if (semantic-documentation-for-tag tag t)
+	  (document-update-comment tag)
+	(document-insert-function-comment-new tag))
       (message "Done..."))
      (t
       (error "Type %S is not yet managed by document `document-inline'" tt)))))
 
-(defun document-update-comment (nonterm)
-  "Update an existing comment for NONTERM."
-  (let ((comment (semantic-find-documentation nonterm 'flex)))
+(defun document-update-comment (tag)
+  "Update an existing comment for TAG."
+  (let ((comment (semantic-documentation-for-tag tag 'lex)))
     (save-excursion
-      (document-update-paramlist nonterm comment))
-    (semantic-bovinate-toplevel t)
-    (let ((ct (semantic-find-nonterminal-by-position
+      (document-update-paramlist tag comment))
+    (semantic-fetch-tags)
+    (let ((ct (semantic-brute-find-tag-by-position
 	       (point) (current-buffer))))
-      (setq comment (semantic-find-documentation nonterm 'flex))
+      (setq comment (semantic-documentation-for-tag tag 'lex))
       (document-update-history comment (document-get-history-elt "")))))
 
 (defun document-insert-new-file-header (header)
 
 ;;; Documentatation generation functions
 ;;
-(defun document-generate-documentation (nonterm buffer)
-  "Return a plain string documenting NONTERM from BUFFER."
+(defun document-generate-documentation (tag buffer)
+  "Return a plain string documenting TAG from BUFFER."
   (save-excursion
     (set-buffer buffer)
     (let ((doc ;; Second, does this thing have docs in the source buffer which
 	   ;; an override method might be able to find?
-	   (semantic-find-documentation nonterm)
+	   (semantic-documentation-for-tag tag)
 	   ))
       (if (not doc)
-	  (document-generate-new-documentation nonterm buffer)
+	  (document-generate-new-documentation tag buffer)
 	;; Ok, now lets see what sort of formatting there might be,
 	;; and see about removing some of it.. (Tables of arguments,
 	;; and that sort of thing.)
 	;; Return the string.
 	doc))))
 
-(defun document-generate-new-documentation (nonterm buffer)
-  "Look at elements of NONTERM in BUFFER to make documentation.
+(defun document-generate-new-documentation (tag buffer)
+  "Look at elements of TAG in BUFFER to make documentation.
 This will create a new documentation string from scratch."
   ;; We probably want more than this, but for now it's close.
-  (document-function-name-comment nonterm))
+  (document-function-name-comment tag))
 
 ;;; Inline comment mangling.
 ;;
-(defun document-insert-function-comment-new (nonterm)
-  "Insert a new comment which explains the function found in NONTERM."
+(defun document-insert-function-comment-new (tag)
+  "Insert a new comment which explains the function found in TAG."
   (let ((hist (document-get-history-elt ""))
 	(pnt 0)
 	(upnt 0)
 	(st 0)
 	(zpnt 0)
-	(fname (semantic-token-name nonterm))
-	(returns (semantic-token-type nonterm))
-	(params (semantic-token-function-args nonterm))
+	(fname (semantic-tag-name tag))
+	(returns (semantic-tag-type tag))
+	(params (semantic-tag-function-arguments tag))
 	)
     (if (listp returns)
 	;; convert a type list into a long string to analyze.
 	(setq returns (car returns)))
-    ;; nonterm should always be correct.
-    (goto-char (semantic-token-start nonterm))
+    ;; tag should always be correct.
+    (goto-char (semantic-tag-start tag))
     (setq st (point))
     (insert (Sformat (list (list ?F fname)
 			   (list ?f '(lambda () (setq zpnt (Sformat-point)) ""))
 			   (list ?p '(lambda () (setq pnt (Sformat-point)) ""))
-			   (list ?D (document-function-name-comment nonterm))
+			   (list ?D (document-function-name-comment tag))
 			   (list ?R (document-insert-return returns))
 			   (list ?P '(lambda ()
 				       (document-insert-parameters params)))
     )
   )
 
-(defun document-function-name-comment (nonterm)
-  "Create documentation for the function defined in NONTERM.
+(defun document-function-name-comment (tag)
+  "Create documentation for the function defined in TAG.
 If we can identify a verb in the list followed by some
 name part then check the return value to see if we can use that to
 finish off the sentence.  ie. any function with 'alloc' in it will be
 	(dropit nil)
 	(tailit nil)
 	(news "")
-	(fname (semantic-token-name nonterm))
-	(retval (or (semantic-token-type nonterm) "")))
+	(fname (semantic-tag-name tag))
+	(retval (or (semantic-tag-type tag) "")))
     (if (listp retval)
 	;; convert a type list into a long string to analyze.
 	(setq retval (car retval)))
 	 (newp ""))
     (while newl
       (let* ((n (car newl))
-	     (nn (if (stringp n) n (semantic-token-name n)))
-	     (al (if (stringp n) nil (semantic-token-variable-modifiers n)))
-	     (nt (if (stringp n) "" (semantic-token-type n))))
+	     (nn (if (stringp n) n (semantic-tag-name n)))
+	     (al (if (stringp n) nil (semantic-tag-modifiers n)))
+	     (nt (if (stringp n) "" (semantic-tag-type n))))
 	(if (listp nt)
 	    ;; make sure this is a string.
 	    (setq nt (car nt)))
   )
 
 (defun document-parameter-comment (param &optional commentlist)
-  "Convert nonterminal or string PARAM into a name,comment pair.
+  "Convert tag or string PARAM into a name,comment pair.
 Optional COMMENTLIST is list of previously existing comments to
 use instead in alist form.  If the name doesn't appear in the list of
 standard names, then englishify it instead."
   (let ((cmt "")
 	(aso document-autocomment-param-alist)
 	(fnd nil)
-	(name (if (stringp param) param (semantic-token-name param)))
-	(tt (if (stringp param) nil (semantic-token-type param))))
+	(name (if (stringp param) param (semantic-tag-name param)))
+	(tt (if (stringp param) nil (semantic-tag-type param))))
     ;; Make sure the type is a string.
     (if (listp tt)
-	(setq tt (semantic-token-name tt)))
+	(setq tt (semantic-tag-name tt)))
     ;; Find name description parts.
     (while aso
       (if (string-match (car (car aso)) name)
     (if (/= (length cmt) 0)
 	nil
       ;; finally check for array parts
-      (if (and (not (stringp param)) (semantic-token-variable-modifiers param))
+      (if (and (not (stringp param)) (semantic-tag-modifiers param))
 	  (setq cmt (concat cmt "array of ")))
       (setq aso document-autocomment-param-type-alist)
       (while (and aso tt)
 	   " \\([0-9]*\\)$")
            date))
 	 (wkdy (substring date (match-beginning 1) (match-end 1)))
-	 (hour (string-to-int
+	 (hour (string-to-number
 		(substring date (match-beginning 4) (match-end 4))))
 	 (min (substring date (match-beginning 5) (match-end 5)))
 	 (sec (substring date (match-beginning 6) (match-end 6)))
 ;;
 (defun document-update-history (comment history)
   "Update COMMENT with the text HISTORY.
-COMMENT is a flex token."
+COMMENT is a `semantic-lex' token."
   (let ((endpos 0))
     (save-excursion
-      (goto-char (semantic-flex-end comment))
+      (goto-char (semantic-lex-token-end comment))
       (if (not (re-search-backward (regexp-quote (document-comment-start))
-				   (semantic-flex-start comment) t))
+				   (semantic-lex-token-start comment) t))
 	  (error "Comment confuses me"))
       (let ((s (document-just-after-token-regexp ?H document-function-comment)))
 	(if (not s) (error "Can't find where to enter new history element"))
 	(if (re-search-forward (concat "\\(" s "\\)")
-			       (1+ (semantic-flex-end comment)) t)
+			       (1+ (semantic-lex-token-end comment)) t)
 	    (progn
 	      (goto-char (match-beginning 1))
 	      (insert (concat "\n" (document-comment-line-prefix) " "))
 (defun document-argument-name (arg)
   "Return a string representing the name of ARG.
 Arguments can be semantic tokens, or strings."
-  (cond ((semantic-token-p arg)
-	 (semantic-token-name arg))
+  (cond ((semantic-tag-p arg)
+	 (semantic-tag-name arg))
 	((stringp arg)
 	 arg)
 	(t (format "%s" arg))))
 
-(defun document-update-paramlist (nonterm comment)
-  "Update NONTERM's comment found in the flex token COMMENT."
+(defun document-update-paramlist (tag comment)
+  "Update TAG's comment found in the `semantic-lex' token COMMENT."
   (let ((endpos 0) st en (il nil)
 	(case-fold-search nil)
-	(l (semantic-token-function-args nonterm)))
+	(l (semantic-tag-function-arguments tag)))
     (save-excursion
-      (goto-char (semantic-flex-start comment))
+      (goto-char (semantic-lex-token-start comment))
       (let ((s (document-just-after-token-regexp ?P document-function-comment))
 	    (s2 (document-just-before-token-regexp ?P document-function-comment)))
 	(if (or (not s) (not s2))
 	    (error "Cannot break format string into findable begin and end tokens"))
 	(if (not (re-search-forward (concat "\\(" s "\\)")
-				    (1+ (semantic-flex-end comment)) t))
+				    (1+ (semantic-lex-token-end comment)) t))
 	    (error "Comment is not formatted correctly for param check"))
 	(goto-char (match-beginning 1))
 	(setq en (point))
-	(goto-char (semantic-flex-start comment))
-	(if (not (re-search-forward s2 (semantic-flex-end comment) t))
+	(goto-char (semantic-lex-token-start comment))
+	(if (not (re-search-forward s2 (semantic-lex-token-end comment) t))
 	    (error "Comment is not formatted correctly for param check"))
 	(setq st (point))
 	;; At this point we have the beginning and end of the
 	  (let ((n (buffer-substring (match-beginning 1) (match-end 1)))
 		(c nil))
 	    (setq c (point))
-	    (re-search-forward "$" (semantic-flex-end comment) t)
+	    (re-search-forward "$" (semantic-lex-token-end comment) t)
 	    (setq c (buffer-substring c (point)))
 	    (setq il (cons (cons n c) il))))
 	;; run verify on two lists of parameters to make sure they
 	(nn nil))
     (while list
       (setq nn (if (stringp (car list)) (car list)
-		 (semantic-token-name (car list))))
+		 (semantic-tag-name (car list))))
       (if (< longest (length nn))
 	  (setq longest (length nn)))
       (setq list (cdr list)))
 
 ;;; Texinfo mangling.
 ;;
-(defun document-massage-to-texinfo (nonterm buffer string)
-  "Massage NONTERM's documentation from BUFFER as STRING.
+(defun document-massage-to-texinfo (tag buffer string)
+  "Massage TAG's documentation from BUFFER as STRING.
 This is to take advantage of TeXinfo's markup symbols."
-  (if (save-excursion (set-buffer buffer)
-		      (eq major-mode 'emacs-lisp-mode))
+  (let ((mode (with-current-buffer buffer (semantic-tag-mode tag))))
+    (when (eq mode 'emacs-lisp-mode)
       ;; Elisp has a few advantages.  Hack it in.
       (setq string (document-texify-elisp-docstring string)))
-  ;; Else, other languages are simpler.  Also, might as well
-  ;; run the elisp version through also.
-  (let ((case-fold-search nil)
-	(start 0))
-    (while (string-match
-	    "\\(^\\|[^{]\\)\\<\\([A-Z0-9_-]+\\)\\>\\($\\|[^}]\\)"
-	    string start)
-      (setq string (concat (substring string 0 (match-beginning 2))
-			   "@var{"
-			   (match-string 2 string)
-			   "}"
-			   (substring string (match-end 2)))
-	    start (match-end 2)))
-    )
-  string)
+    ;; Else, other languages are simpler.  Also, might as well
+    ;; run the elisp version through also.
+    (let ((case-fold-search nil)
+          (start 0))
+      (while (string-match
+              "\\(^\\|[^{]\\)\\<\\([A-Z0-9_-]+\\)\\>\\($\\|[^}]\\)"
+              string start)
+	(let ((ms (match-string 2 string)))
+	  (when (eq mode 'emacs-lisp-mode)
+	    (setq ms (downcase ms)))
+	
+	  (when (not (or (string= ms "A")
+			 (string= ms "a")
+			 ))
+	    (setq string (concat (substring string 0 (match-beginning 2))
+				 "@var{"
+				 ms
+				 "}"
+				 (substring string (match-end 2))))))
+	(setq start (match-end 2)))
+      )
+    string))
 
 ;; This FN was taken from EIEIO and modified.  Maybe convert later.
 (defun document-texify-elisp-docstring (string)
  t          => @code{t}
  :tag       => @code{:tag}
  [ stuff ]  => @code{[ stuff ]}
- Key        => @kbd{Key}     (key is C\\-h, M\\-h, SPC, RET, TAB and the like)"
-  (while (string-match "`\\([-a-zA-Z0-9]+\\)'" string)
+ Key        => @kbd{Key}     (key is C\\-h, M\\-h, SPC, RET, TAB and the like)
+ ...        => @dots{}"
+  (while (string-match "`\\([-a-zA-Z0-9<>.]+\\)'" string)
     (let* ((vs (substring string (match-beginning 1) (match-end 1)))
 	   (v (intern-soft vs)))
       (setq string
 				 "@dfn{" "@code{")
 			     vs "}")
 		    nil t string)))))
-  (while (string-match "\\( \\|^\\)\\(nil\\|t\\|'[-a-zA-Z0-9]+\\|:[-a-zA-Z0-9]+\\)\\([ ,]\\|$\\)" string)
+  (while (string-match "\\( \\|^\\)\\(nil\\|t\\|'[-a-zA-Z0-9]+\\|:[-a-zA-Z0-9]+\\)\\([. ,]\\|$\\)" string)
     (setq string (replace-match "@code{\\2}" t nil string 2)))
-  (while (string-match "\\( \\|^\\)\\(\\(non-\\)\\(nil\\)\\)\\([ ,]\\|$\\)" string)
+  (while (string-match "\\( \\|^\\)\\(\\(non-\\)\\(nil\\)\\)\\([. ,]\\|$\\)" string)
     (setq string (replace-match "\\3@code{\\4}" t nil string 2)))
   (while (string-match "\\( \\|^\\)\\(\\[[^]]+\\]\\)\\( \\|$\\)" string)
     (setq string (replace-match "@code{\\2}" t nil string 2)))
-  (while (string-match "\\( \\|^\\)\\(\\(\\(C-\\|M-\\|S-\\)+\\([^ \t\n]\\|RET\\|SPC\\|TAB\\)\\)\\|\\(RET\\|SPC\\|TAB\\)\\)\\( \\|$\\)" string)
+  (while (string-match "\\( \\|^\\)\\(\\(\\(C-\\|M-\\|S-\\)+\\([^ \t\n]\\|RET\\|SPC\\|TAB\\)\\)\\|\\(RET\\|SPC\\|TAB\\)\\)\\( \\|\\s.\\|$\\)" string)
     (setq string (replace-match "@kbd{\\2}" t nil string 2)))
   (while (string-match "\"\\(.+\\)\"" string)
     (setq string (replace-match "``\\1''" t nil string 0)))
+  (while (string-match "\\.\\.\\." string)
+    (setq string (replace-match "@dots{}" t nil string 0)))
   string)
 
 ;;; Buffer finding and managing
   (if (eq (point) (point-min))
       (progn
 	(switch-to-buffer (current-buffer))
-	(error "Position cursor in %s, and try inserting documentation again"))
+	(error "Position cursor in %s, and try inserting documentation again"
+	       file))
     (point-marker)))
 
 (defun document-locate-file (buffer &optional override)