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
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
|
;;;; srecode/find.el --- Tools for finding templates in the database.
;; Copyright (C) 2007-2015 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:
;;
;; Various routines that search through various template tables
;; in search of the right template.
(require 'srecode/ctxt)
(require 'srecode/table)
(require 'srecode/map)
(declare-function srecode-compile-file "srecode/compile")
;;; Code:
(defun srecode-table (&optional mode)
"Return the currently active Semantic Recoder table for this buffer.
Optional argument MODE specifies the mode table to use."
(let* ((modeq (or mode major-mode))
(table (srecode-get-mode-table modeq)))
;; If there isn't one, keep searching backwards for a table.
(while (and (not table) (setq modeq (get-mode-local-parent modeq)))
(setq table (srecode-get-mode-table modeq)))
;; Last ditch effort.
(when (not table)
(setq table (srecode-get-mode-table 'default)))
table))
;;; TRACKER
;;
;; Template file tracker for between sessions.
;;
(defun srecode-load-tables-for-mode (mmode &optional appname)
"Load all the template files for MMODE.
Templates are found in the SRecode Template Map.
See `srecode-get-maps' for more.
APPNAME is the name of an application. In this case,
all template files for that application will be loaded."
(require 'srecode/compile)
(let ((files
(if appname
(apply 'append
(mapcar
(lambda (map)
(srecode-map-entries-for-app-and-mode map appname mmode))
(srecode-get-maps)))
(apply 'append
(mapcar
(lambda (map)
(srecode-map-entries-for-mode map mmode))
(srecode-get-maps)))))
)
;; Don't recurse if we are already the 'default state.
(when (not (eq mmode 'default))
;; Are we a derived mode? If so, get the parent mode's
;; templates loaded too.
(if (get-mode-local-parent mmode)
(srecode-load-tables-for-mode (get-mode-local-parent mmode)
appname)
;; No parent mode, all templates depend on the defaults being
;; loaded in, so get that in instead.
(srecode-load-tables-for-mode 'default appname)))
;; Load in templates for our major mode.
(dolist (f files)
(let ((mt (srecode-get-mode-table mmode))
)
(when (or (not mt) (not (srecode-mode-table-find mt (car f))))
(srecode-compile-file (car f)))
))
))
;;; PROJECT
;;
;; Find if a template table has a project set, and if so, is the
;; current buffer in that project.
(cl-defmethod srecode-template-table-in-project-p ((tab srecode-template-table))
"Return non-nil if the table TAB can be used in the current project.
If TAB has a :project set, check that the directories match.
If TAB is nil, then always return t."
(let ((proj (oref tab :project)))
;; Return t if the project wasn't set.
(if (not proj) t
;; If the project directory was set, let's check it.
(let ((dd (expand-file-name default-directory))
(projexp (regexp-quote (directory-file-name proj))))
(if (string-match (concat "^" projexp) dd)
t nil)))))
;;; SEARCH
;;
;; Find a given template based on name, and features of the current
;; buffer.
(cl-defmethod srecode-template-get-table ((tab srecode-template-table)
template-name &optional
context application)
"Find in the template in table TAB, the template with TEMPLATE-NAME.
Optional argument CONTEXT specifies that the template should part
of a particular context.
The APPLICATION argument is unused."
(when (srecode-template-table-in-project-p tab)
(if context
;; If a context is specified, then look it up there.
(let ((ctxth (gethash context (oref tab contexthash))))
(when ctxth
(gethash template-name ctxth)))
;; No context, perhaps a merged name?
(gethash template-name (oref tab namehash)))))
(cl-defmethod srecode-template-get-table ((tab srecode-mode-table)
template-name &optional
context application)
"Find in the template in mode table TAB, the template with TEMPLATE-NAME.
Optional argument CONTEXT specifies a context a particular template
would belong to.
Optional argument APPLICATION restricts searches to only template tables
belonging to a specific application. If APPLICATION is nil, then only
tables that do not belong to an application will be searched."
(let* ((mt tab)
(tabs (oref mt :tables))
(ans nil))
(while (and (not ans) tabs)
(let ((app (oref (car tabs) :application)))
(when (or (and (not application) (null app))
(and application (eq app application)))
(setq ans (srecode-template-get-table (car tabs) template-name
context)))
(setq tabs (cdr tabs))))
(or ans
;; Recurse to the default.
(when (not (equal (oref tab :major-mode) 'default))
(srecode-template-get-table (srecode-get-mode-table 'default)
template-name context application)))))
;;
;; Find a given template based on a key binding.
;;
(cl-defmethod srecode-template-get-table-for-binding
((tab srecode-template-table) binding &optional context)
"Find in the template name in table TAB, the template with BINDING.
Optional argument CONTEXT specifies that the template should part
of a particular context."
(when (srecode-template-table-in-project-p tab)
(let* ((keyout nil)
(hashfcn (lambda (key value)
(when (and (slot-boundp value 'binding)
(oref value binding)
(= (aref (oref value binding) 0) binding))
(setq keyout key))))
(contextstr (cond ((listp context)
(car-safe context))
((stringp context)
context)
(t nil)))
)
(if context
(let ((ctxth (gethash contextstr (oref tab contexthash))))
(when ctxth
;; If a context is specified, then look it up there.
(maphash hashfcn ctxth)
;; Context hashes EXCLUDE the context prefix which
;; we need to include, so concat it here
(when keyout
(setq keyout (concat contextstr ":" keyout)))
)))
(when (not keyout)
;; No context, or binding in context. Try full hash.
(maphash hashfcn (oref tab namehash)))
keyout)))
(cl-defmethod srecode-template-get-table-for-binding
((tab srecode-mode-table) binding &optional context application)
"Find in the template name in mode table TAB, the template with BINDING.
Optional argument CONTEXT specifies a context a particular template
would belong to.
Optional argument APPLICATION restricts searches to only template tables
belonging to a specific application. If APPLICATION is nil, then only
tables that do not belong to an application will be searched."
(let* ((mt tab)
(tabs (oref mt :tables))
(ans nil))
(while (and (not ans) tabs)
(let ((app (oref (car tabs) :application)))
(when (or (and (not application) (null app))
(and application (eq app application)))
(setq ans (srecode-template-get-table-for-binding
(car tabs) binding context)))
(setq tabs (cdr tabs))))
(or ans
;; Recurse to the default.
(when (not (equal (oref tab :major-mode) 'default))
(srecode-template-get-table-for-binding
(srecode-get-mode-table 'default) binding context)))))
;;; Interactive
;;
;; Interactive queries into the template data.
;;
(defvar srecode-read-template-name-history nil
"History for completing reads for template names.")
(defun srecode-user-template-p (template)
"Non-nil if TEMPLATE is intended for user insertion.
Templates not matching this predicate are used for code
generation or other internal purposes."
t)
(defun srecode-all-template-hash (&optional mode hash predicate)
"Create a hash table of all the currently available templates.
Optional argument MODE is the major mode to look for.
Optional argument HASH is the hash table to fill in.
Optional argument PREDICATE can be used to filter the returned
templates."
(let* ((mhash (or hash (make-hash-table :test 'equal)))
(mmode (or mode major-mode))
(parent-mode (get-mode-local-parent mmode)))
;; Get the parent hash table filled into our current hash.
(unless (eq mode 'default)
(srecode-all-template-hash (or parent-mode 'default) mhash))
;; Load up the hash table for our current mode.
(let* ((mt (srecode-get-mode-table mmode))
(tabs (when mt (oref mt :tables))))
(dolist (tab tabs)
;; Exclude templates for a particular application.
(when (and (not (oref tab :application))
(srecode-template-table-in-project-p tab))
(maphash (lambda (key temp)
(when (or (not predicate)
(funcall predicate temp))
(puthash key temp mhash)))
(oref tab namehash))))
mhash)))
(defun srecode-calculate-default-template-string (hash)
"Calculate the name of the template to use as a DEFAULT.
Templates are read from HASH.
Context into which the template is inserted is calculated
with `srecode-calculate-context'."
(let* ((ctxt (srecode-calculate-context))
(ans (concat (nth 0 ctxt) ":" (nth 1 ctxt))))
(if (gethash ans hash)
ans
;; No hash at the specifics, at least offer
;; the prefix for the completing read
(concat (nth 0 ctxt) ":"))))
(defun srecode-read-template-name (prompt &optional initial hist default)
"Completing read for Semantic Recoder template names.
PROMPT is used to query for the name of the template desired.
INITIAL is the initial string to use.
HIST is a history variable to use.
DEFAULT is what to use if the user presses RET."
(srecode-load-tables-for-mode major-mode)
(let* ((hash (srecode-all-template-hash))
(def (or initial
(srecode-calculate-default-template-string hash))))
(completing-read prompt hash
nil t def
(or hist
'srecode-read-template-name-history))))
(provide 'srecode/find)
;;; srecode/find.el ends here
|
