tag-write.el 5.39 KB
Newer Older
1
;;; semantic/tag-write.el --- Write tags to a text stream
Chong Yidong's avatar
Chong Yidong committed
2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30

;; 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
Glenn Morris's avatar
Glenn Morris committed
31
;; that they conform to good semantic tag hygiene.
Chong Yidong's avatar
Chong Yidong committed
32 33
;;

34
(require 'semantic)
Chong Yidong's avatar
Chong Yidong committed
35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160

;;; 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
161
;;;###autoload
Chong Yidong's avatar
Chong Yidong committed
162 163 164 165 166 167 168 169 170 171
(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)
172 173 174 175 176 177 178

;; Local variables:
;; generated-autoload-file: "loaddefs.el"
;; generated-autoload-feature: semantic/loaddefs
;; generated-autoload-load-name: "semantic/tag-write"
;; End:

179
;;; semantic/tag-write.el ends here