1 ;;;; srecode/find.el --- Tools for finding templates in the database.
3 ;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5 ;; Author: Eric M. Ludlam <eric@siege-engine.com>
7 ;; This file is part of GNU Emacs.
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.
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.
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/>.
24 ;; Various routines that search through various template tables
25 ;; in search of the right template.
27 (require 'srecode
/ctxt
)
28 (require 'srecode
/table
)
29 (require 'srecode
/map
)
31 (declare-function srecode-compile-file
"srecode/compile")
35 (defun srecode-table (&optional mode
)
36 "Return the currently active Semantic Recoder table for this buffer.
37 Optional argument MODE specifies the mode table to use."
38 (let* ((modeq (or mode major-mode
))
39 (table (srecode-get-mode-table modeq
)))
41 ;; If there isn't one, keep searching backwards for a table.
42 (while (and (not table
) (setq modeq
(get-mode-local-parent modeq
)))
43 (setq table
(srecode-get-mode-table modeq
)))
47 (setq table
(srecode-get-mode-table 'default
)))
53 ;; Template file tracker for between sessions.
55 (defun srecode-load-tables-for-mode (mmode &optional appname
)
56 "Load all the template files for MMODE.
57 Templates are found in the SRecode Template Map.
58 See `srecode-get-maps' for more.
59 APPNAME is the name of an application. In this case,
60 all template files for that application will be loaded."
61 (require 'srecode
/compile
)
67 (srecode-map-entries-for-app-and-mode map appname mmode
))
72 (srecode-map-entries-for-mode map mmode
))
73 (srecode-get-maps)))))
75 ;; Don't recurse if we are already the 'default state.
76 (when (not (eq mmode
'default
))
77 ;; Are we a derived mode? If so, get the parent mode's
78 ;; templates loaded too.
79 (if (get-mode-local-parent mmode
)
80 (srecode-load-tables-for-mode (get-mode-local-parent mmode
)
82 ;; No parent mode, all templates depend on the defaults being
83 ;; loaded in, so get that in instead.
84 (srecode-load-tables-for-mode 'default appname
)))
86 ;; Load in templates for our major mode.
88 (let ((mt (srecode-get-mode-table mmode
))
90 (when (or (not mt
) (not (srecode-mode-table-find mt
(car f
))))
91 (srecode-compile-file (car f
)))
97 ;; Find a given template based on name, and features of the current
99 (defmethod srecode-template-get-table ((tab srecode-template-table
)
100 template-name
&optional
102 "Find in the template in table TAB, the template with TEMPLATE-NAME.
103 Optional argument CONTEXT specifies that the template should part
104 of a particular context.
105 The APPLICATION argument is unused."
107 ;; If a context is specified, then look it up there.
108 (let ((ctxth (gethash context
(oref tab contexthash
))))
110 (gethash template-name ctxth
)))
111 ;; No context, perhaps a merged name?
112 (gethash template-name
(oref tab namehash
))))
114 (defmethod srecode-template-get-table ((tab srecode-mode-table
)
115 template-name
&optional
117 "Find in the template in mode table TAB, the template with TEMPLATE-NAME.
118 Optional argument CONTEXT specifies a context a particular template
120 Optional argument APPLICATION restricts searches to only template tables
121 belonging to a specific application. If APPLICATION is nil, then only
122 tables that do not belong to an application will be searched."
124 (tabs (oref mt
:tables
))
126 (while (and (not ans
) tabs
)
127 (let ((app (oref (car tabs
) :application
)))
128 (when (or (and (not application
) (null app
))
129 (and application
(eq app application
)))
130 (setq ans
(srecode-template-get-table (car tabs
) template-name
132 (setq tabs
(cdr tabs
))))
134 ;; Recurse to the default.
135 (when (not (equal (oref tab
:major-mode
) 'default
))
136 (srecode-template-get-table (srecode-get-mode-table 'default
)
137 template-name context application
)))))
140 ;; Find a given template based on a key binding.
142 (defmethod srecode-template-get-table-for-binding
143 ((tab srecode-template-table
) binding
&optional context
)
144 "Find in the template name in table TAB, the template with BINDING.
145 Optional argument CONTEXT specifies that the template should part
146 of a particular context."
148 (hashfcn (lambda (key value
)
149 (when (and (slot-boundp value
'binding
)
151 (= (aref (oref value binding
) 0) binding
))
153 (contextstr (cond ((listp context
)
160 (let ((ctxth (gethash contextstr
(oref tab contexthash
))))
162 ;; If a context is specified, then look it up there.
163 (maphash hashfcn ctxth
)
164 ;; Context hashes EXCLUDE the context prefix which
165 ;; we need to include, so concat it here
167 (setq keyout
(concat contextstr
":" keyout
)))
170 ;; No context, or binding in context. Try full hash.
171 (maphash hashfcn
(oref tab namehash
)))
174 (defmethod srecode-template-get-table-for-binding
175 ((tab srecode-mode-table
) binding
&optional context application
)
176 "Find in the template name in mode table TAB, the template with BINDING.
177 Optional argument CONTEXT specifies a context a particular template
179 Optional argument APPLICATION restricts searches to only template tables
180 belonging to a specific application. If APPLICATION is nil, then only
181 tables that do not belong to an application will be searched."
183 (tabs (oref mt
:tables
))
185 (while (and (not ans
) tabs
)
186 (let ((app (oref (car tabs
) :application
)))
187 (when (or (and (not application
) (null app
))
188 (and application
(eq app application
)))
189 (setq ans
(srecode-template-get-table-for-binding
190 (car tabs
) binding context
)))
191 (setq tabs
(cdr tabs
))))
193 ;; Recurse to the default.
194 (when (not (equal (oref tab
:major-mode
) 'default
))
195 (srecode-template-get-table-for-binding
196 (srecode-get-mode-table 'default
) binding context
)))))
199 ;; Interactive queries into the template data.
201 (defvar srecode-read-template-name-history nil
202 "History for completing reads for template names.")
204 (defun srecode-all-template-hash (&optional mode hash
)
205 "Create a hash table of all the currently available templates.
206 Optional argument MODE is the major mode to look for.
207 Optional argument HASH is the hash table to fill in."
208 (let* ((mhash (or hash
(make-hash-table :test
'equal
)))
209 (mmode (or mode major-mode
))
210 (mp (get-mode-local-parent mmode
))
212 ;; Get the parent hash table filled into our current hash.
213 (when (not (eq mode
'default
))
215 (srecode-all-template-hash mp mhash
)
216 (srecode-all-template-hash 'default mhash
)))
217 ;; Load up the hash table for our current mode.
218 (let* ((mt (srecode-get-mode-table mmode
))
219 (tabs (when mt
(oref mt
:tables
)))
222 ;; Exclude templates for a perticular application.
223 (when (not (oref (car tabs
) :application
))
224 (maphash (lambda (key temp
)
225 (puthash key temp mhash
)
227 (oref (car tabs
) namehash
)))
228 (setq tabs
(cdr tabs
)))
231 (defun srecode-calculate-default-template-string (hash)
232 "Calculate the name of the template to use as a DEFAULT.
233 Templates are read from HASH.
234 Context into which the template is inserted is calculated
235 with `srecode-calculate-context'."
236 (let* ((ctxt (srecode-calculate-context))
237 (ans (concat (nth 0 ctxt
) ":" (nth 1 ctxt
))))
238 (if (gethash ans hash
)
240 ;; No hash at the specifics, at least offer
241 ;; the prefix for the completing read
242 (concat (nth 0 ctxt
) ":"))))
244 (defun srecode-read-template-name (prompt &optional initial hist default
)
245 "Completing read for Semantic Recoder template names.
246 PROMPT is used to query for the name of the template desired.
247 INITIAL is the initial string to use.
248 HIST is a history variable to use.
249 DEFAULT is what to use if the user presses RET."
250 (srecode-load-tables-for-mode major-mode
)
251 (let* ((hash (srecode-all-template-hash))
253 (srecode-calculate-default-template-string hash
))))
254 (completing-read prompt hash
257 'srecode-read-template-name-history
))))
259 (provide 'srecode
/find
)
261 ;; arch-tag: 49d18e58-45a0-48f5-92e1-4a1dcd4e36a6
262 ;;; srecode/find.el ends here