view lisp/cedet/srecode/texi.el @ 107617:c5f9e4613394

Merge from mainline.

;;; srecode-texi.el --- Srecode texinfo support.

;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.

;; Author: Eric M. Ludlam <[e-mail]>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Texinfo semantic recoder support.
;;
;; Contains some handlers, and a few simple texinfo srecoder applications.

(require 'semantic)
(require 'semantic/texi)
(require 'srecode/semantic)

;;; Code:

(defun srecode-texi-add-menu (newnode)
  "Add an item into the current menu.  Add @node statements as well.
Argument NEWNODE is the name of the new node."
  (interactive "sName of new node: ")
  (srecode-load-tables-for-mode major-mode)
  (semantic-fetch-tags)
  (let ((currnode (reverse (semantic-find-tag-by-overlay)))
	(nodebounds nil))
    (when (not currnode)
      (error "Cannot find node to put menu item into"))
    (setq currnode (car currnode))
    (setq nodebounds (semantic-tag-texi-section-text-bounds currnode))
    ;; Step 1:
    ;;   Limit search within this node.
    ;; Step 2:
    ;;   Find the menu.  If there isn't one, add one to the end.
    ;; Step 3:
    ;;   Add new item to end of menu list.
    ;; Step 4:
    ;;   Find correct node new item should show up after, and stick
    ;;   the new node there.
    (if (string= (semantic-texi-current-environment) "menu")
	;; We are already in a menu, so insert the new item right here.
	(beginning-of-line)
      ;; Else, try to find a menu item to append to.
      (goto-char (car nodebounds))
      (if (not (re-search-forward "^@menu" (car (cdr nodebounds)) t))
	  (progn
	    (goto-char (car (cdr nodebounds)))
	    (if (not (y-or-n-p "Add menu here? "))
		(error "Abort"))
	    (srecode-insert "declaration:menu"))
	;; Else, find the end
	(re-search-forward "@end menu")
	(beginning-of-line)))
    ;; At this point, we are in a menu... or not.
    ;; If we are, do stuff, else error.
    (when (string= (semantic-texi-current-environment) "menu")
      (let ((menuname newnode)
	    (returnpoint nil))
	(srecode-insert "declaration:menuitem" "NAME" menuname)
	(set-mark (point))
	(setq returnpoint (make-marker))
	;; Update the bound since we added text
	(setq nodebounds (semantic-tag-texi-section-text-bounds currnode))
	(beginning-of-line)
	(forward-char -1)
	(beginning-of-line)
	(let ((end nil))
	  (if (not (looking-at "\\* \\([^:]+\\):"))
	      (setq end (car (cdr nodebounds)))
	    (let* ((nname (match-string 1))
		   (tag
		    (semantic-deep-find-tags-by-name nname (current-buffer))))
	      (when tag
		(setq end (semantic-tag-end (car tag))))
	      ))
	  (when (not end)
	    (goto-char returnpoint)
	    (error "Could not find location for new node" ))
	  (when end
	    (goto-char end)
	    (when (bolp) (forward-char -1))
	    (insert "\n")
	    (if (eq (semantic-current-tag) currnode)
		(srecode-insert "declaration:subnode" "NAME" menuname)
	      (srecode-insert "declaration:node" "NAME" menuname))
	    )
	  )))
    ))

;;;###autoload
(defun srecode-semantic-handle-:texi (dict)
  "Add macros into the dictionary DICT based on the current texinfo file.
Adds the following:
  LEVEL - chapter, section, subsection, etc
  NEXTLEVEL - One below level"

  ;; LEVEL and NEXTLEVEL calculation
  (semantic-fetch-tags)
  (let ((tags (reverse (semantic-find-tag-by-overlay)))
	(level nil))
    (while (and tags (not (semantic-tag-of-class-p (car tags) 'section)))
      (setq tags (cdr tags)))
    (when tags
      (save-excursion
	(goto-char (semantic-tag-start (car tags)))
	(when (looking-at "@node")
	  (forward-line 1)
	  (beginning-of-line))
	(when (looking-at "@\\(\\w+\\)")
	  (setq level (match-string 1))
	  )))
    (srecode-dictionary-set-value dict "LEVEL" (or level "chapter"))
    (let ((nl (assoc level '( ( nil . "top" )
			      ("top" . "chapter")
			      ("chapter" . "section")
			      ("section" . "subsection")
			      ("subsection" . "subsubsection")
			      ("subsubsection" . "subsubsection")
			      ))))
      (srecode-dictionary-set-value dict "NEXTLEVEL" (cdr nl))))
  )

;;;###autoload
(defun srecode-semantic-handle-:texitag (dict)
  "Add macros into the dictionary DICT based on the current :tag file.
Adds the following:
  TAGDOC - Texinfo formatted doc string for :tag."

  ;; If we also have a TAG, what is the doc?
  (let ((tag (srecode-dictionary-lookup-name dict "TAG"))
	(doc nil)
	)

    ;; If the user didn't apply :tag, then do so now.
    (when (not tag)
      (srecode-semantic-handle-:tag dict))

    (setq tag (srecode-dictionary-lookup-name dict "TAG"))

    (when (not tag)
      (error "No tag to insert for :texitag template argument"))

    ;; Extract the tag out of the compound object.
    (setq tag (oref tag :prime))

    ;; Extract the doc string
    (setq doc (semantic-documentation-for-tag tag))

    (when doc
      (srecode-dictionary-set-value dict "TAGDOC"
				    (srecode-texi-massage-to-texinfo
				     tag (semantic-tag-buffer tag)
				     doc)))
    ))

;;; OVERRIDES
;;
;; Override some semantic and srecode features with texi specific
;; versions.

(define-mode-local-override semantic-insert-foreign-tag
  texinfo-mode (foreign-tag)
  "Insert TAG from a foreign buffer in TAGFILE.
Assume TAGFILE is a source buffer, and create a documentation
thingy from it using the `document' tool."
  (let ((srecode-semantic-selected-tag foreign-tag))
    ;; @todo - choose of the many types of tags to insert,
    ;; or put all that logic into srecode.
    (srecode-insert "declaration:function")))



;;; Texinfo mangling.

(define-overloadable-function srecode-texi-texify-docstring
  (docstring)
  "Texify the doc string DOCSTRING.
Takes plain text formatting that may exist, and converts it to
using TeXinfo formatting.")

(defun srecode-texi-texify-docstring-default (docstring)
  "Texify the doc string DOCSTRING.
Takes a few very generic guesses as to what the formatting is."
  (let ((case-fold-search nil)
	(start 0))
    (while (string-match
	    "\\(^\\|[^{]\\)\\<\\([A-Z0-9_-]+\\)\\>\\($\\|[^}]\\)"
	    docstring start)
      (let ((ms (match-string 2 docstring)))
	;(when (eq mode 'emacs-lisp-mode)
	;  (setq ms (downcase ms)))

	(when (not (or (string= ms "A")
		       (string= ms "a")
		       ))
	  (setq docstring (concat (substring docstring 0 (match-beginning 2))
			       "@var{"
			       ms
			       "}"
			       (substring docstring (match-end 2))))))
      (setq start (match-end 2)))
    ;; Return our modified doc string.
    docstring))

(defun srecode-texi-massage-to-texinfo (tag buffer string)
  "Massage TAG's documentation from BUFFER as STRING.
This is to take advantage of TeXinfo's markup symbols."
  (save-excursion
    (if buffer
	(progn (set-buffer buffer)
	       (srecode-texi-texify-docstring string))
      ;; Else, no buffer, so lets do something else
      (with-mode-local texinfo-mode
	(srecode-texi-texify-docstring string)))))

(define-mode-local-override srecode-texi-texify-docstring emacs-lisp-mode
  (string)
  "Take STRING, (a normal doc string), and convert it into a texinfo string.
For instances where CLASS is the class being referenced, do not Xref
that class.

 `function' => @dfn{function}
 `variable' => @code{variable}
 `class'    => @code{class} @xref{class}
 `unknown'  => @code{unknonwn}
 \"text\"     => ``text''
 'quoteme   => @code{quoteme}
 non-nil    => non-@code{nil}
 t          => @code{t}
 :tag       => @code{:tag}
 [ stuff ]  => @code{[ stuff ]}
 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
	    (concat
	     (replace-match (concat
			     (if (fboundp v)
				 "@dfn{" "@code{")
			     vs "}")
		    nil t 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)
    (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\\)\\)\\( \\|\\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)))
  ;; Also do base docstring type.
  (srecode-texi-texify-docstring-default string))

(provide 'srecode/texi)

;; Local variables:
;; generated-autoload-file: "loaddefs.el"
;; generated-autoload-load-name: "srecode/texi"
;; End:

;; arch-tag: 6f0e7f45-2281-49e4-b73c-680cba477094
;;; srecode/texi.el ends here