Mercurial > emacs
view lisp/cedet/semantic/tag-write.el @ 110763:0fe64d68a522
Merge changes made in Gnus trunk.
shr.el: Implement table rendering.
shr.el (shr-make-table): Tweak table generation.
shr.el (shr-make-table): Fix typo.
nnimap.el (nnimap-open-connection): Allow tls as a synonym for ssl.
gnus-util.el (gnus-emacs-completing-read): Mapcar collection to list, for XEmacs.
nnimap.el (nnimap-close-server): Implement.
gnus-salt.el: Remove all gnus-carpal stuff -- it's not useful.
nnir.el (nnir-run-imap): Remove spurious space in search string.
message.el (message-idna-to-ascii-rhs-1): Don't bug out on addresses without @ signs.
gnus-sum.el (gnus-widen-article-window): New variable.
shr.el (browse-url): Required.
shr.el (shr-ensure-paragraph): Don't insert a new newline after empty-ish lines.
shr.el (shr-show-alt-text, shr-browse-image): New commands.
gravatar.el (gravatar-retrieved): kill buffer when retrieved.
shr.el (shr-browse-url, shr-copy-url): New commands.
shr.el (shr-render-td): Protect against too-wide text.
spam-report.el (spam-report-url-ping-plain): Don't query about killing the process.
nnimap.el (nnimap-finish-retrieve-group-infos): Message while waiting for data.
shr.el (shr-tag-blockquote): Ensure paragraph after quote, too.
mml-smime.el: Fix gnus-completing-read usage.
shr.el (shr-get-image-data): Ensure against the cache file missing.
nnimap.el (nnimap-open-connection): Give an error if nnimap-stream is unknown.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Mon, 04 Oct 2010 22:26:51 +0000 |
parents | 1d1d5d9bd884 |
children | 376148b31b5e |
line wrap: on
line source
;;; semantic/tag-write.el --- Write tags to a text stream ;; Copyright (C) 2008, 2009, 2010 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 hygiene. ;; (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-load-name: "semantic/tag-write" ;; End: ;; arch-tag: aa2301b3-f0c5-4d73-b456-43eaba5b2198 ;;; semantic/tag-write.el ends here