Mercurial > emacs
view lisp/cedet/semantic/tag-write.el @ 104513:a6a812dd2d88
* cedet/semantic/lex.el (semantic-lex-reset-hooks): Doc fix.
* cedet/semantic/idle.el
(semantic-before-idle-scheduler-reparse-hook)
(semantic-after-idle-scheduler-reparse-hook): Rename from *-hooks.
Make old name an obsolete alias.
* cedet/semantic/edit.el (semantic-after-partial-cache-change-hook)
(semantic-change-hooks, semantic-edits-new-change-hooks)
(semantic-edits-delete-change-hooks)
(semantic-edits-move-change-hook)
(semantic-edits-reparse-change-hooks)
(semantic-edits-incremental-reparse-failed-hooks): Doc fixes.
* cedet/semantic/debug.el (semantic-debug-mode): Rename hook
symbols.
* cedet/semantic/db-mode.el (semanticdb-mode-hook): Rename from
semanticdb-mode-hooks.
(global-semanticdb-minor-mode): Use the new name.
(semanticdb-hooks): Use semantic-init-db-hook instead of obsolete
alias semantic-init-db-hooks.
* cedet/semantic/db-global.el (semanticdb-enable-gnu-global-databases):
Use semantic-init-hook instead of obsolete alias
semantic-init-hooks.
* cedet/semantic/db-file.el (semanticdb-save-database-hook):
Rename from semanticdb-save-database-hooks. Make old name an
obsolete alias.
* cedet/semantic/decorate/mode.el
(semantic-decorate-pending-decoration-hook): Rename from
semantic-decorate-pending-decoration-hooks. Make old name an
obsolete alias.
* cedet/srecode/map.el (srecode-map-validate-file-for-mode): Use
semantic-init-hook instead of obsolete alias semantic-init-hooks.
* cedet/semantic/fw.el (semantic-find-file-noselect): Use
semantic-init-hook instead of obsolete alias semantic-init-hooks.
* cedet/ede/project-am.el (project-am-with-makefile-current): Use
semantic-init-hook instead of obsolete alias semantic-init-hooks.
* cedet/semantic/util.el (semantic-describe-buffer): Use
semantic-init-hook and semantic-init-db-hook instead of obsolete
aliases.
* cedet/semantic/util-modes.el (semantic-mode-line-update)
(semantic-toggle-minor-mode-globally): Use semantic-init-hook
instead of obsolete alias semantic-init-hooks.
Synch to Eric Ludlam's upstream CEDET repository:
* cedet/semantic/bovine/c.el (semantic-c-parse-token-hack-depth):
New var.
(semantic-c-parse-lexical-token): Save match data when setting up
the secondary parse buffer. Allow recursion. Protect against
initializing the major mode from throwing errors, ie user hooks.
* cedet/semantic/lex-spp.el (semantic-lex-spp-lex-text-string):
Protect installing a major mode from throwing errors.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sat, 26 Sep 2009 17:47:11 +0000 |
parents | a4e1a12c8b97 |
children | adbff0886e10 |
line wrap: on
line source
;;; semantic/tag-write.el --- Write tags to a text stream ;; Copyright (C) 2008, 2009 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <eric@siege-engine.com> ;; 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: ;; ;; Routine for writing out a list of tags to a text stream. ;; ;; These routines will be used by semanticdb to output a tag list into ;; a text stream to be saved to a file. Ideally, you could use tag streams ;; to share tags between processes as well. ;; ;; As a bonus, these routines will also validate the tag structure, and make sure ;; that they conform to good semantic tag hygene. ;; (require 'semantic) ;;; Code: (defun semantic-tag-write-one-tag (tag &optional indent) "Write a single tag TAG to standard out. INDENT is the amount of indentation to use for this tag." (when (not (semantic-tag-p tag)) (signal 'wrong-type-argument (list tag 'semantic-tag-p))) (when (not indent) (setq indent 0)) ;(princ (make-string indent ? )) (princ "(\"") ;; Base parts (let ((name (semantic-tag-name tag)) (class (semantic-tag-class tag))) (princ name) (princ "\" ") (princ (symbol-name class)) ) (let ((attr (semantic-tag-attributes tag)) ) ;; Attributes (cond ((not attr) (princ " nil")) ((= (length attr) 2) ;; One item (princ " (") (semantic-tag-write-one-attribute attr indent) (princ ")") ) (t ;; More than one tag. (princ "\n") (princ (make-string (+ indent 3) ? )) (princ "(") (while attr (semantic-tag-write-one-attribute attr (+ indent 4)) (setq attr (cdr (cdr attr))) (when attr (princ "\n") (princ (make-string (+ indent 4) ? ))) ) (princ ")\n") (princ (make-string (+ indent 3) ? )) )) ;; Properties - for now, always nil. (let ((rs (semantic--tag-get-property tag 'reparse-symbol))) (if (not rs) (princ " nil") ;; Else, put in the property list. (princ " (reparse-symbol ") (princ (symbol-name rs)) (princ ")")) )) ;; Overlay (if (semantic-tag-with-position-p tag) (let ((bounds (semantic-tag-bounds tag))) (princ " ") (prin1 (apply 'vector bounds)) ) (princ " nil")) ;; End it. (princ ")") ) (defun semantic-tag-write-tag-list (tlist &optional indent dontaddnewline) "Write the tag list TLIST to the current stream. INDENT indicates the current indentation level. If optional DONTADDNEWLINE is non-nil, then don't add a newline." (if (not indent) (setq indent 0) (unless dontaddnewline ;; Assume cursor at end of current line. Add a CR, and make the list. (princ "\n") (princ (make-string indent ? )))) (princ "( ") (while tlist (if (semantic-tag-p (car tlist)) (semantic-tag-write-one-tag (car tlist) (+ indent 2)) ;; If we don't have a tag in the tag list, use the below hack, and hope ;; it doesn't contain anything bad. If we find something bad, go back here ;; and start extending what's expected here. (princ (format "%S" (car tlist)))) (setq tlist (cdr tlist)) (when tlist (princ "\n") (princ (make-string (+ indent 2) ? ))) ) (princ ")") (princ (make-string indent ? )) ) ;; Writing out random stuff. (defun semantic-tag-write-one-attribute (attrs indent) "Write out one attribute from the head of the list of attributes ATTRS. INDENT is the current amount of indentation." (when (not attrs) (signal 'wrong-type-argument (list 'listp attrs))) (when (not (symbolp (car attrs))) (error "Bad Attribute List in tag")) (princ (symbol-name (car attrs))) (princ " ") (semantic-tag-write-one-value (car (cdr attrs)) indent) ) (defun semantic-tag-write-one-value (value indent) "Write out a VALUE for something in a tag. INDENT is the current tag indentation. Items that are long lists of tags may need their own line." (cond ;; Another tag. ((semantic-tag-p value) (semantic-tag-write-one-tag value (+ indent 2))) ;; A list of more tags ((and (listp value) (semantic-tag-p (car value))) (semantic-tag-write-tag-list value (+ indent 2)) ) ;; Some arbitrary data. (t (let ((str (format "%S" value))) ;; Protect against odd data types in tags. (if (= (aref str 0) ?#) (progn (princ "nil") (message "Warning: Value %s not writable in tag." str)) (princ str))))) ) ;;; EIEIO USAGE ;;;###autoload (defun semantic-tag-write-list-slot-value (value) "Write out the VALUE of a slot for EIEIO. The VALUE is a list of tags." (if (not value) (princ "nil") (princ "\n '") (semantic-tag-write-tag-list value 10 t) )) (provide 'semantic/tag-write) ;; Local variables: ;; generated-autoload-file: "loaddefs.el" ;; generated-autoload-feature: semantic/loaddefs ;; generated-autoload-load-name: "semantic/tag-write" ;; End: ;;; semantic/tag-write.el ends here