Commit | Line | Data |
---|---|---|
4d902e6f CY |
1 | ;;; srecode/ctxt.el --- Derive a context from the source buffer. |
2 | ||
73b0cd50 | 3 | ;; Copyright (C) 2007-2011 Free Software Foundation, Inc. |
4d902e6f CY |
4 | |
5 | ;; Author: Eric M. Ludlam <eric@siege-engine.com> | |
6 | ||
7 | ;; This file is part of GNU Emacs. | |
8 | ||
9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
11 | ;; the Free Software Foundation, either version 3 of the License, or | |
12 | ;; (at your option) any later version. | |
13 | ||
14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ||
19 | ;; You should have received a copy of the GNU General Public License | |
20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
21 | ||
22 | ;;; Commentary: | |
23 | ;; | |
24 | ;; Manage context calculations for Semantic Recoder. | |
25 | ;; | |
26 | ;; SRecode templates are always bound to a context. By calculating | |
27 | ;; the current context, we can narrow down the selection of possible | |
28 | ;; templates to something reasonable. | |
29 | ;; | |
30 | ;; Alternately, code here will find a context for templates that | |
31 | ;; require different pieces of code placed in multiple areas. | |
32 | ||
33 | (require 'semantic) | |
34 | (require 'semantic/tag-ls) | |
35 | ||
36 | (declare-function srecode-dictionary-show-section "srecode/dictionary") | |
37 | (declare-function srecode-dictionary-set-value "srecode/dictionary") | |
38 | ||
39 | ;;; Code: | |
40 | ||
41 | (define-overload srecode-calculate-context () | |
42 | "Calculate the context at the current point. | |
43 | The returned context is a list, with the top-most context first. | |
44 | Each returned context is a string that that would show up in a `context' | |
45 | statement in an `.srt' file. | |
46 | ||
47 | Some useful context values used by the provided srecode templates are: | |
48 | \"file\" - Templates that for a file (such as an empty file.) | |
49 | \"empty\" - The file is empty | |
50 | \"declaration\" - Top-level declarations in a file. | |
51 | \"include\" - In or near include statements | |
52 | \"package\" - In or near provide statements | |
53 | \"function\" - In or near function statements | |
54 | \"NAME\" - Near functions within NAME namespace or class | |
55 | \"variable\" - In or near variable statements. | |
56 | \"type\" - In or near type declarations. | |
57 | \"comment\" - In a comment | |
58 | \"classdecl\" - Declarations within a class/struct/etc. | |
59 | \"variable\" - In or near class fields | |
60 | \"function\" - In or near methods/functions | |
61 | \"virtual\" - Nearby items are virtual | |
62 | \"pure\" - and those virtual items are pure virtual | |
63 | \"type\" - In or near type declarations. | |
64 | \"comment\" - In a comment in a block of code | |
65 | -- these items show up at the end of the context list. -- | |
66 | \"public\", \"protected\", \"private\" - | |
67 | In or near a section of public/pritected/private entries. | |
68 | \"code\" - In a block of code. | |
69 | \"string\" - In a string in a block of code | |
70 | \"comment\" - In a comment in a block of code | |
71 | ||
72 | ... More later." | |
73 | ) | |
74 | ||
75 | (defun srecode-calculate-nearby-things () | |
76 | ;; NOTE: May need to add bounes to this FCN | |
77 | "Calculate the CONTEXT type items nearby the current point. | |
78 | Assume that what we want to insert next is based on what is just | |
79 | before point. If there is nothing, then assume it is whatever is | |
80 | after point." | |
81 | ;; @todo - ADD BOUNDS TO THE PREV/NEXT TAG SEARCH | |
82 | ;; thus classdecl "near" stuff cannot be | |
83 | ;; outside the bounds of the type in question. | |
84 | (let ((near (semantic-find-tag-by-overlay-prev)) | |
85 | (prot nil) | |
86 | (ans nil)) | |
87 | (if (not near) | |
88 | (setq near (semantic-find-tag-by-overlay-next))) | |
89 | (when near | |
90 | ;; Calculate the type of thing we are near. | |
91 | (if (not (semantic-tag-of-class-p near 'function)) | |
92 | (setq ans (cons (symbol-name (semantic-tag-class near)) ans)) | |
93 | ;; if the symbol NEAR has a parent, | |
94 | (let ((p (semantic-tag-function-parent near))) | |
95 | (setq ans (cons (symbol-name (semantic-tag-class near)) ans)) | |
96 | (cond ((semantic-tag-p p) | |
97 | (setq ans (cons (semantic-tag-name p) ans))) | |
98 | ((stringp p) | |
99 | (setq ans (cons p ans))) | |
100 | (t nil))) | |
101 | ;; Was it virtual? | |
102 | (when (semantic-tag-get-attribute near :virtual) | |
103 | (setq ans (cons "virtual" ans))) | |
104 | ;; Was it pure? | |
105 | (when (semantic-tag-get-attribute near :pure-virtual-flag) | |
106 | (setq ans (cons "pure" ans))) | |
107 | ) | |
108 | ;; Calculate the protection | |
109 | (setq prot (semantic-tag-protection near)) | |
110 | (when (and prot (not (eq prot 'unknown))) | |
111 | (setq ans (cons (symbol-name prot) ans))) | |
112 | ) | |
113 | (nreverse ans))) | |
114 | ||
115 | (defun srecode-calculate-context-font-lock () | |
116 | "Calculate an srecode context by using font-lock." | |
117 | (let ((face (get-text-property (point) 'face)) | |
118 | ) | |
119 | (cond ((member face '(font-lock-string-face | |
120 | font-lock-doc-face)) | |
121 | (list "string")) | |
122 | ((member face '(font-lock-comment-face | |
123 | font-lock-comment-delimiter-face)) | |
124 | (list "comment")) | |
125 | ) | |
126 | )) | |
127 | ||
128 | (defun srecode-calculate-context-default () | |
129 | "Generic method for calculating a context for srecode." | |
130 | (if (= (point-min) (point-max)) | |
131 | (list "file" "empty") | |
132 | ||
133 | (semantic-fetch-tags) | |
134 | (let ((ct (semantic-find-tag-by-overlay)) | |
135 | ) | |
136 | (cond ((or (not ct) | |
137 | ;; Ok, below is a bit C specific. | |
138 | (and (eq (semantic-tag-class (car ct)) 'type) | |
139 | (string= (semantic-tag-type (car ct)) "namespace"))) | |
140 | (cons "declaration" | |
141 | (or (srecode-calculate-context-font-lock) | |
142 | (srecode-calculate-nearby-things) | |
143 | )) | |
144 | ) | |
145 | ((eq (semantic-tag-class (car ct)) 'function) | |
146 | (cons "code" (srecode-calculate-context-font-lock)) | |
147 | ) | |
148 | ((eq (semantic-tag-class (car ct)) 'type) ; We know not namespace | |
149 | (cons "classdecl" | |
150 | (or (srecode-calculate-context-font-lock) | |
151 | (srecode-calculate-nearby-things))) | |
152 | ) | |
153 | ((and (car (cdr ct)) | |
154 | (eq (semantic-tag-class (car (cdr ct))) 'type)) | |
155 | (list "classdecl" | |
156 | (symbol-name (semantic-tag-class (car ct)))) | |
157 | ) | |
158 | ) | |
159 | ))) | |
160 | ||
161 | \f | |
162 | ;;; HANDLERS | |
163 | ;; | |
164 | ;; The calculated context is one thing, but more info is often available. | |
165 | ;; The context handlers can add info into the active dictionary that is | |
166 | ;; based on the context, such as a method parent name, protection scheme, | |
167 | ;; or other feature. | |
168 | ||
169 | (defun srecode-semantic-handle-:ctxt (dict &optional template) | |
170 | "Add macros into the dictionary DICT based on the current Emacs Lisp file. | |
171 | Argument TEMPLATE is the template object adding context dictionary | |
172 | entries. | |
173 | This might add the following: | |
174 | VIRTUAL - show a section if a function is virtual | |
175 | PURE - show a section if a function is pure virtual. | |
176 | PARENT - The name of a parent type for functions. | |
177 | PROTECTION - Show a protection section, and what the protection is." | |
178 | (require 'srecode/dictionary) | |
179 | (when template | |
180 | ||
181 | (let ((name (oref template object-name)) | |
182 | (cc (if (boundp 'srecode-insertion-start-context) | |
183 | srecode-insertion-start-context)) | |
184 | ;(context (oref template context)) | |
185 | ) | |
186 | ||
187 | ; (when (and cc | |
188 | ; (null (string= (car cc) context)) | |
189 | ; ) | |
190 | ; ;; No current context, or the base is different, then | |
191 | ; ;; this is the section where we need to recalculate | |
192 | ; ;; the context based on user choice, if possible. | |
193 | ; ;; | |
194 | ; ;; The recalculation is complex, as there are many possibilities | |
195 | ; ;; that need to be divined. Set "cc" to the new context | |
196 | ; ;; at the end. | |
197 | ; ;; | |
198 | ; ;; @todo - | |
199 | ; | |
200 | ; ) | |
201 | ||
202 | ;; The various context all have different features. | |
203 | (let ((ct (nth 0 cc)) | |
204 | (it (nth 1 cc)) | |
205 | (last (last cc)) | |
206 | (parent nil) | |
207 | ) | |
208 | (cond ((string= it "function") | |
209 | (setq parent (nth 2 cc)) | |
210 | (when parent | |
211 | (cond ((string= parent "virtual") | |
212 | (srecode-dictionary-show-section dict "VIRTUAL") | |
213 | (when (nth 3 cc) | |
214 | (srecode-dictionary-show-section dict "PURE")) | |
215 | ) | |
216 | (t | |
217 | (srecode-dictionary-set-value dict "PARENT" parent)))) | |
218 | ) | |
219 | ((and (string= it "type") | |
220 | (or (string= name "function") (string= name "method"))) | |
221 | ;; If we have a type, but we insert a fcn, then use that type | |
222 | ;; as the function parent. | |
223 | (let ((near (semantic-find-tag-by-overlay-prev))) | |
224 | (when (and near (semantic-tag-of-class-p near 'type)) | |
225 | (srecode-dictionary-set-value | |
226 | dict "PARENT" (semantic-tag-name near)))) | |
227 | ) | |
228 | ((string= ct "code") | |
229 | ;;(let ((analyzer (semantic-analyze-current-context))) | |
230 | ;; @todo - Use the analyze to setup things like local | |
231 | ;; variables we might use or something. | |
232 | nil | |
233 | ;;) | |
234 | ) | |
235 | (t | |
236 | nil)) | |
237 | (when (member last '("public" "private" "protected")) | |
238 | ;; Hey, fancy that, we can do both. | |
239 | (srecode-dictionary-set-value dict "PROTECTION" parent) | |
240 | (srecode-dictionary-show-section dict "PROTECTION")) | |
241 | )) | |
242 | )) | |
243 | ||
244 | ||
245 | (provide 'srecode/ctxt) | |
246 | ||
247 | ;;; srecode/ctxt.el ends here |