1
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
31
32
33
34
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
|
;;; srecode/ctxt.el --- Derive a context from the source buffer.
;; Copyright (C) 2007-2017 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:
;;
;; Manage context calculations for Semantic Recoder.
;;
;; SRecode templates are always bound to a context. By calculating
;; the current context, we can narrow down the selection of possible
;; templates to something reasonable.
;;
;; Alternately, code here will find a context for templates that
;; require different pieces of code placed in multiple areas.
(require 'semantic)
(require 'semantic/tag-ls)
(declare-function srecode-dictionary-show-section "srecode/dictionary")
(declare-function srecode-dictionary-set-value "srecode/dictionary")
;;; Code:
(define-overload srecode-calculate-context ()
"Calculate the context at the current point.
The returned context is a list, with the top-most context first.
Each returned context is a string that would show up in a `context'
statement in an `.srt' file.
Some useful context values used by the provided srecode templates are:
\"file\" - Templates that for a file (such as an empty file.)
\"empty\" - The file is empty
\"declaration\" - Top-level declarations in a file.
\"include\" - In or near include statements
\"package\" - In or near provide statements
\"function\" - In or near function statements
\"NAME\" - Near functions within NAME namespace or class
\"variable\" - In or near variable statements.
\"type\" - In or near type declarations.
\"comment\" - In a comment
\"classdecl\" - Declarations within a class/struct/etc.
\"variable\" - In or near class fields
\"function\" - In or near methods/functions
\"virtual\" - Nearby items are virtual
\"pure\" - and those virtual items are pure virtual
\"type\" - In or near type declarations.
\"comment\" - In a comment in a block of code
-- these items show up at the end of the context list. --
\"public\", \"protected\", \"private\" -
In or near a section of public/protected/private entries.
\"code\" - In a block of code.
\"string\" - In a string in a block of code
\"comment\" - In a comment in a block of code
... More later."
)
(defun srecode-calculate-nearby-things ()
;; NOTE: May need to add bounds to this FCN
"Calculate the CONTEXT type items nearby the current point.
Assume that what we want to insert next is based on what is just
before point. If there is nothing, then assume it is whatever is
after point."
;; @todo - ADD BOUNDS TO THE PREV/NEXT TAG SEARCH
;; thus classdecl "near" stuff cannot be
;; outside the bounds of the type in question.
(let ((near (semantic-find-tag-by-overlay-prev))
(prot nil)
(ans nil))
(if (not near)
(setq near (semantic-find-tag-by-overlay-next)))
(when near
;; Calculate the type of thing we are near.
(if (not (semantic-tag-of-class-p near 'function))
(setq ans (cons (symbol-name (semantic-tag-class near)) ans))
;; if the symbol NEAR has a parent,
(let ((p (semantic-tag-function-parent near)))
(setq ans (cons (symbol-name (semantic-tag-class near)) ans))
(cond ((semantic-tag-p p)
(setq ans (cons (semantic-tag-name p) ans)))
((stringp p)
(setq ans (cons p ans)))
(t nil)))
;; Was it virtual?
(when (semantic-tag-get-attribute near :virtual)
(setq ans (cons "virtual" ans)))
;; Was it pure?
(when (semantic-tag-get-attribute near :pure-virtual-flag)
(setq ans (cons "pure" ans)))
)
;; Calculate the protection
(setq prot (semantic-tag-protection near))
(when (and prot (not (eq prot 'unknown)))
(setq ans (cons (symbol-name prot) ans)))
)
(nreverse ans)))
(defun srecode-calculate-context-font-lock ()
"Calculate an srecode context by using font-lock."
(let ((face (get-text-property (point) 'face))
)
(cond ((member face '(font-lock-string-face
font-lock-doc-face))
(list "string"))
((member face '(font-lock-comment-face
font-lock-comment-delimiter-face))
(list "comment"))
)
))
(defun srecode-calculate-context-default ()
"Generic method for calculating a context for srecode."
(if (= (point-min) (point-max))
(list "file" "empty")
(semantic-fetch-tags)
(let ((ct (semantic-find-tag-by-overlay))
)
(cond ((or (not ct)
;; Ok, below is a bit C specific.
(and (eq (semantic-tag-class (car ct)) 'type)
(string= (semantic-tag-type (car ct)) "namespace")))
(cons "declaration"
(or (srecode-calculate-context-font-lock)
(srecode-calculate-nearby-things)
))
)
((eq (semantic-tag-class (car ct)) 'function)
(cons "code" (srecode-calculate-context-font-lock))
)
((eq (semantic-tag-class (car ct)) 'type) ; We know not namespace
(cons "classdecl"
(or (srecode-calculate-context-font-lock)
(srecode-calculate-nearby-things)))
)
((and (car (cdr ct))
(eq (semantic-tag-class (car (cdr ct))) 'type))
(list "classdecl"
(symbol-name (semantic-tag-class (car ct))))
)
)
)))
;;; HANDLERS
;;
;; The calculated context is one thing, but more info is often available.
;; The context handlers can add info into the active dictionary that is
;; based on the context, such as a method parent name, protection scheme,
;; or other feature.
(defun srecode-semantic-handle-:ctxt (dict &optional template)
"Add macros into the dictionary DICT based on the current Emacs Lisp file.
Argument TEMPLATE is the template object adding context dictionary
entries.
This might add the following:
VIRTUAL - show a section if a function is virtual
PURE - show a section if a function is pure virtual.
PARENT - The name of a parent type for functions.
PROTECTION - Show a protection section, and what the protection is."
(require 'srecode/dictionary)
(when template
(let ((name (oref template object-name))
(cc (if (boundp 'srecode-insertion-start-context)
srecode-insertion-start-context))
;(context (oref template context))
)
; (when (and cc
; (null (string= (car cc) context))
; )
; ;; No current context, or the base is different, then
; ;; this is the section where we need to recalculate
; ;; the context based on user choice, if possible.
; ;;
; ;; The recalculation is complex, as there are many possibilities
; ;; that need to be divined. Set "cc" to the new context
; ;; at the end.
; ;;
; ;; @todo -
;
; )
;; The various context all have different features.
(let ((ct (nth 0 cc))
(it (nth 1 cc))
(last (last cc))
(parent nil)
)
(cond ((string= it "function")
(setq parent (nth 2 cc))
(when parent
(cond ((string= parent "virtual")
(srecode-dictionary-show-section dict "VIRTUAL")
(when (nth 3 cc)
(srecode-dictionary-show-section dict "PURE"))
)
(t
(srecode-dictionary-set-value dict "PARENT" parent))))
)
((and (string= it "type")
(or (string= name "function") (string= name "method")))
;; If we have a type, but we insert a fcn, then use that type
;; as the function parent.
(let ((near (semantic-find-tag-by-overlay-prev)))
(when (and near (semantic-tag-of-class-p near 'type))
(srecode-dictionary-set-value
dict "PARENT" (semantic-tag-name near))))
)
((string= ct "code")
;;(let ((analyzer (semantic-analyze-current-context)))
;; @todo - Use the analyze to setup things like local
;; variables we might use or something.
nil
;;)
)
(t
nil))
(when (member last '("public" "private" "protected"))
;; Hey, fancy that, we can do both.
(srecode-dictionary-set-value dict "PROTECTION" parent)
(srecode-dictionary-show-section dict "PROTECTION"))
))
))
(provide 'srecode/ctxt)
;;; srecode/ctxt.el ends here
|
