Mercurial > emacs
annotate lisp/cedet/srecode/insert.el @ 108712:056a00ed4b81
Use terminfo rather than termcap on recent NetBSD.
* configure.in: On NetBSD, if terminfo is found, use it in preference
to termcap. (Bug#6190)
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Wed, 19 May 2010 23:37:29 -0700 |
parents | 907ba0dc2be7 |
children | 67ff8ad45bd5 |
rev | line source |
---|---|
104498 | 1 ;;; srecode/insert --- Insert srecode templates to an output stream. |
2 | |
106815 | 3 ;; Copyright (C) 2005, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
104498 | 4 |
5 ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
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 ;; Define and implements specific inserter objects. | |
25 ;; | |
26 ;; Manage the insertion process for a template. | |
27 ;; | |
28 | |
29 (require 'srecode/compile) | |
30 (require 'srecode/find) | |
31 (require 'srecode/dictionary) | |
105408
cc49bd9e784b
* cedet/srecode/insert.el: Require srecode/args.
Chong Yidong <cyd@stupidchicken.com>
parents:
105377
diff
changeset
|
32 (require 'srecode/args) |
104498 | 33 |
34 (defvar srecode-template-inserter-point) | |
35 (declare-function srecode-overlaid-activate "srecode/fields") | |
36 (declare-function srecode-template-inserted-region "srecode/fields") | |
37 | |
38 ;;; Code: | |
39 | |
40 (defcustom srecode-insert-ask-variable-method 'ask | |
41 "Determine how to ask for a dictionary value when inserting a template. | |
42 Only the ASK style inserter will query the user for a value. | |
43 Dictionary value references that ask begin with the ? character. | |
44 Possible values are: | |
45 'ask - Prompt in the minibuffer as the value is inserted. | |
46 'field - Use the dictionary macro name as the inserted value, | |
47 and place a field there. Matched fields change together. | |
48 | |
49 NOTE: The field feature does not yet work with XEmacs." | |
50 :group 'srecode | |
51 :type '(choice (const :tag "Ask" ask) | |
52 (cons :tag "Field" field))) | |
53 | |
54 (defvar srecode-insert-with-fields-in-progress nil | |
55 "Non-nil means that we are actively inserting a template with fields.") | |
56 | |
57 ;;; INSERTION COMMANDS | |
58 ;; | |
59 ;; User level commands for inserting stuff. | |
60 (defvar srecode-insertion-start-context nil | |
61 "The context that was at point at the beginning of the template insertion.") | |
62 | |
63 (defun srecode-insert-again () | |
64 "Insert the previously inserted template (by name) again." | |
65 (interactive) | |
66 (let ((prev (car srecode-read-template-name-history))) | |
67 (if prev | |
68 (srecode-insert prev) | |
69 (call-interactively 'srecode-insert)))) | |
70 | |
71 ;;;###autoload | |
72 (defun srecode-insert (template-name &rest dict-entries) | |
105328 | 73 "Insert the template TEMPLATE-NAME into the current buffer at point. |
104498 | 74 DICT-ENTRIES are additional dictionary values to add." |
75 (interactive (list (srecode-read-template-name "Template Name: "))) | |
76 (if (not (srecode-table)) | |
77 (error "No template table found for mode %s" major-mode)) | |
78 (let ((newdict (srecode-create-dictionary)) | |
79 (temp (srecode-template-get-table (srecode-table) template-name)) | |
80 (srecode-insertion-start-context (srecode-calculate-context)) | |
81 ) | |
82 (if (not temp) | |
83 (error "No Template named %s" template-name)) | |
84 (while dict-entries | |
85 (srecode-dictionary-set-value newdict | |
86 (car dict-entries) | |
87 (car (cdr dict-entries))) | |
88 (setq dict-entries (cdr (cdr dict-entries)))) | |
89 ;;(srecode-resolve-arguments temp newdict) | |
90 (srecode-insert-fcn temp newdict) | |
91 ;; Don't put code here. We need to return the end-mark | |
92 ;; for this insertion step. | |
93 )) | |
94 | |
95 (defun srecode-insert-fcn (template dictionary &optional stream skipresolver) | |
96 "Insert TEMPLATE using DICTIONARY into STREAM. | |
97 Optional SKIPRESOLVER means to avoid refreshing the tag list, | |
98 or resolving any template arguments. It is assumed the caller | |
99 has set everything up already." | |
100 ;; Perform the insertion. | |
101 (let ((standard-output (or stream (current-buffer))) | |
102 (end-mark nil)) | |
103 (unless skipresolver | |
104 ;; Make sure the semantic tags are up to date. | |
105 (semantic-fetch-tags) | |
106 ;; Resolve the arguments | |
107 (srecode-resolve-arguments template dictionary)) | |
108 ;; Insert | |
109 (if (bufferp standard-output) | |
110 ;; If there is a buffer, turn off various hooks. This will cause | |
111 ;; the mod hooks to be buffered up during the insert, but | |
112 ;; prevent tools like font-lock from fontifying mid-template. | |
113 ;; Especialy important during insertion of complex comments that | |
114 ;; cause the new font-lock to comment-color stuff after the inserted | |
115 ;; comment. | |
116 ;; | |
117 ;; I'm not sure about the motion hooks. It seems like a good | |
118 ;; idea though. | |
119 ;; | |
120 ;; Borrowed these concepts out of font-lock. | |
121 ;; | |
122 ;; I tried `combine-after-change-calls', but it did not have | |
123 ;; the effect I wanted. | |
124 (let ((start (point))) | |
125 (let ((inhibit-point-motion-hooks t) | |
126 (inhibit-modification-hooks t) | |
127 ) | |
128 (srecode--insert-into-buffer template dictionary) | |
129 ) | |
130 ;; Now call those after change functions. | |
131 (run-hook-with-args 'after-change-functions | |
132 start (point) 0) | |
133 ) | |
134 (srecode-insert-method template dictionary)) | |
135 ;; Handle specialization of the POINT inserter. | |
136 (when (and (bufferp standard-output) | |
137 (slot-boundp 'srecode-template-inserter-point 'point) | |
138 ) | |
139 (set-buffer standard-output) | |
140 (setq end-mark (point-marker)) | |
141 (goto-char (oref srecode-template-inserter-point point))) | |
142 (oset-default 'srecode-template-inserter-point point eieio-unbound) | |
143 | |
144 ;; Return the end-mark. | |
145 (or end-mark (point))) | |
146 ) | |
147 | |
148 (defun srecode--insert-into-buffer (template dictionary) | |
149 "Insert a TEMPLATE with DICTIONARY into a buffer. | |
150 Do not call this function yourself. Instead use: | |
151 `srecode-insert' - Inserts by name. | |
152 `srecode-insert-fcn' - Insert with objects. | |
153 This function handles the case from one of the above functions when | |
154 the template is inserted into a buffer. It looks | |
155 at `srecode-insert-ask-variable-method' to decide if unbound dictionary | |
156 entries ask questions or insert editable fields. | |
157 | |
158 Buffer based features related to change hooks is handled one level up." | |
159 ;; This line prevents the field archive from being let bound | |
160 ;; while the field insert tool is loaded via autoloads during | |
161 ;; the insert. | |
162 (when (eq srecode-insert-ask-variable-method 'field) | |
104506
801834237f9c
* menu-bar.el: Remove ediff-misc from Tools menu.
Chong Yidong <cyd@stupidchicken.com>
parents:
104498
diff
changeset
|
163 (require 'srecode/fields)) |
104498 | 164 |
165 (let ((srecode-field-archive nil) ; Prevent field leaks during insert | |
166 (start (point)) ; Beginning of the region. | |
167 ) | |
168 ;; This sub-let scopes the 'in-progress' piece so we know | |
169 ;; when to setup the end-template. | |
170 (let ((srecode-insert-with-fields-in-progress | |
171 (if (eq srecode-insert-ask-variable-method 'field) t nil)) | |
172 ) | |
173 (srecode-insert-method template dictionary) | |
174 ) | |
175 ;; If we are not in-progress, and we insert fields, then | |
176 ;; create the end-template with fields editable area. | |
177 (when (and (not srecode-insert-with-fields-in-progress) | |
178 (eq srecode-insert-ask-variable-method 'field) ; Only if user asked | |
179 srecode-field-archive ; Only if there were fields created | |
180 ) | |
181 (let ((reg | |
182 ;; Create the field-driven editable area. | |
183 (srecode-template-inserted-region | |
184 "TEMPLATE" :start start :end (point)))) | |
185 (srecode-overlaid-activate reg)) | |
186 ) | |
187 ;; We return with 'point being the end of the template insertion | |
188 ;; area. Return value is not important. | |
189 )) | |
190 | |
191 ;;; TEMPLATE ARGUMENTS | |
192 ;; | |
107149
907ba0dc2be7
Fix typos in comments.
Juanma Barranquero <lekktu@gmail.com>
parents:
106840
diff
changeset
|
193 ;; Some templates have arguments. Each argument is associated with |
104498 | 194 ;; a function that can resolve the inputs needed. |
195 (defun srecode-resolve-arguments (temp dict) | |
196 "Resolve all the arguments needed by the template TEMP. | |
197 Apply anything learned to the dictionary DICT." | |
198 (srecode-resolve-argument-list (oref temp args) dict temp)) | |
199 | |
200 (defun srecode-resolve-argument-list (args dict &optional temp) | |
201 "Resolve arguments in the argument list ARGS. | |
202 ARGS is a list of symbols, such as :blank, or :file. | |
203 Apply values to DICT. | |
106840
5df8e547a422
Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
204 Optional argument TEMP is the template that is getting its arguments resolved." |
104498 | 205 (let ((fcn nil)) |
206 (while args | |
207 (setq fcn (intern-soft (concat "srecode-semantic-handle-" | |
208 (symbol-name (car args))))) | |
209 (if (not fcn) | |
210 (error "Error resolving template argument %S" (car args))) | |
211 (if temp | |
212 (condition-case nil | |
213 ;; Allow some to accept a 2nd argument optionally. | |
214 ;; They throw an error if not available, so try again. | |
215 (funcall fcn dict temp) | |
216 (wrong-number-of-arguments (funcall fcn dict))) | |
217 (funcall fcn dict)) | |
218 (setq args (cdr args))) | |
219 )) | |
220 | |
221 ;;; INSERTION STACK & METHOD | |
222 ;; | |
223 ;; Code managing the top-level insert method and the current | |
224 ;; insertion stack. | |
225 ;; | |
226 (defmethod srecode-push ((st srecode-template)) | |
227 "Push the srecoder template ST onto the active stack." | |
228 (oset st active (cons st (oref st active)))) | |
229 | |
230 (defmethod srecode-pop :STATIC ((st srecode-template)) | |
231 "Pop the srecoder template ST onto the active stack. | |
232 ST can be a class, or an object." | |
233 (oset st active (cdr (oref st active)))) | |
234 | |
235 (defmethod srecode-peek :STATIC ((st srecode-template)) | |
236 "Fetch the topmost active template record. ST can be a class." | |
237 (car (oref st active))) | |
238 | |
239 (defmethod srecode-insert-method ((st srecode-template) dictionary) | |
240 "Insert the srecoder template ST." | |
241 ;; Merge any template entries into the input dictionary. | |
242 (when (slot-boundp st 'dictionary) | |
243 (srecode-dictionary-merge dictionary (oref st dictionary))) | |
244 ;; Do an insertion. | |
245 (unwind-protect | |
246 (let ((c (oref st code))) | |
247 (srecode-push st) | |
248 (srecode-insert-code-stream c dictionary)) | |
249 ;; Poping the stack is protected | |
250 (srecode-pop st))) | |
251 | |
252 (defun srecode-insert-code-stream (code dictionary) | |
253 "Insert the CODE from a template into `standard-output'. | |
254 Use DICTIONARY to resolve any macros." | |
255 (while code | |
256 (cond ((stringp (car code)) | |
257 (princ (car code))) | |
258 (t | |
259 (srecode-insert-method (car code) dictionary))) | |
260 (setq code (cdr code)))) | |
261 | |
262 ;;; INSERTERS | |
263 ;; | |
264 ;; Specific srecode inserters. | |
265 ;; The base class is from srecode-compile. | |
266 ;; | |
267 ;; Each inserter handles various macro codes from the temlate. | |
268 ;; The `code' slot specifies a character used to identify which | |
269 ;; inserter is to be created. | |
270 ;; | |
271 (defclass srecode-template-inserter-newline (srecode-template-inserter) | |
272 ((key :initform "\n" | |
273 :allocation :class | |
274 :documentation | |
275 "The character code used to identify inserters of this style.") | |
276 (hard :initform nil | |
277 :initarg :hard | |
278 :documentation | |
279 "Is this a hard newline (always inserted) or optional? | |
280 Optional newlines don't insert themselves if they are on a blank line | |
281 by themselves.") | |
282 ) | |
283 "Insert a newline, and possibly do indenting. | |
284 Specify the :indent argument to enable automatic indentation when newlines | |
285 occur in your template.") | |
286 | |
287 (defmethod srecode-insert-method ((sti srecode-template-inserter-newline) | |
288 dictionary) | |
289 "Insert the STI inserter." | |
290 ;; To be safe, indent the previous line since the template will | |
291 ;; change what is there to indent | |
292 (let ((i (srecode-dictionary-lookup-name dictionary "INDENT")) | |
293 (inbuff (bufferp standard-output)) | |
294 (doit t) | |
295 (pm (point-marker))) | |
296 (when (and inbuff (not (oref sti hard))) | |
297 ;; If this is not a hard newline, we need do the calculation | |
298 ;; and set "doit" to nil. | |
299 (beginning-of-line) | |
300 (save-restriction | |
301 (narrow-to-region (point) pm) | |
302 (when (looking-at "\\s-*$") | |
303 (setq doit nil))) | |
304 (goto-char pm) | |
305 ) | |
306 ;; Do indentation reguardless of the newline. | |
307 (when (and (eq i t) inbuff) | |
308 (indent-according-to-mode) | |
309 (goto-char pm)) | |
310 | |
311 (when doit | |
312 (princ "\n") | |
313 ;; Indent after the newline, particularly for numeric indents. | |
314 (cond ((and (eq i t) (bufferp standard-output)) | |
315 ;; WARNING - indent according to mode requires that standard-output | |
316 ;; is a buffer! | |
317 ;; @todo - how to indent in a string??? | |
318 (setq pm (point-marker)) | |
319 (indent-according-to-mode) | |
320 (goto-char pm)) | |
321 ((numberp i) | |
322 (princ (make-string i " "))) | |
323 ((stringp i) | |
324 (princ i)))))) | |
325 | |
326 (defmethod srecode-dump ((ins srecode-template-inserter-newline) indent) | |
327 "Dump the state of the SRecode template inserter INS." | |
328 (call-next-method) | |
329 (when (oref ins hard) | |
330 (princ " : hard") | |
331 )) | |
332 | |
333 (defclass srecode-template-inserter-blank (srecode-template-inserter) | |
334 ((key :initform "\r" | |
335 :allocation :class | |
336 :documentation | |
106840
5df8e547a422
Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
337 "The character representing this inserter style. |
104498 | 338 Can't be blank, or it might be used by regular variable insertion.") |
339 (where :initform 'begin | |
340 :initarg :where | |
341 :documentation | |
106840
5df8e547a422
Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
342 "This should be 'begin or 'end, indicating where to insert a CR. |
104498 | 343 When set to 'begin, it will insert a CR if we are not at 'bol'. |
106840
5df8e547a422
Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
344 When set to 'end it will insert a CR if we are not at 'eol'.") |
104498 | 345 ;; @TODO - Add slot and control for the number of blank |
346 ;; lines before and after point. | |
347 ) | |
348 "Insert a newline before and after a template, and possibly do indenting. | |
349 Specify the :blank argument to enable this inserter.") | |
350 | |
351 (defmethod srecode-insert-method ((sti srecode-template-inserter-blank) | |
352 dictionary) | |
353 "Make sure there is no text before or after point." | |
354 (let ((i (srecode-dictionary-lookup-name dictionary "INDENT")) | |
355 (inbuff (bufferp standard-output)) | |
356 (pm (point-marker))) | |
357 (when (and inbuff | |
358 ;; Don't do this if we are not the active template. | |
359 (= (length (oref srecode-template active)) 1)) | |
360 | |
361 (when (and (eq i t) inbuff (not (eq (oref sti where) 'begin))) | |
362 (indent-according-to-mode) | |
363 (goto-char pm)) | |
364 | |
365 (cond ((and (eq (oref sti where) 'begin) (not (bolp))) | |
366 (princ "\n")) | |
367 ((eq (oref sti where) 'end) | |
368 ;; If there is whitespace after pnt, then clear it out. | |
369 (when (looking-at "\\s-*$") | |
370 (delete-region (point) (point-at-eol))) | |
371 (when (not (eolp)) | |
372 (princ "\n"))) | |
373 ) | |
374 (setq pm (point-marker)) | |
375 (when (and (eq i t) inbuff (not (eq (oref sti where) 'end))) | |
376 (indent-according-to-mode) | |
377 (goto-char pm)) | |
378 ))) | |
379 | |
380 (defclass srecode-template-inserter-comment (srecode-template-inserter) | |
381 ((key :initform ?! | |
382 :allocation :class | |
383 :documentation | |
384 "The character code used to identify inserters of this style.") | |
385 ) | |
386 "Allow comments within template coding. This inserts nothing.") | |
387 | |
388 (defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-comment) | |
389 escape-start escape-end) | |
390 "Insert an example using inserter INS. | |
391 Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." | |
392 (princ " ") | |
393 (princ escape-start) | |
394 (princ "! Miscellaneous text commenting in your template. ") | |
395 (princ escape-end) | |
396 (terpri) | |
397 ) | |
398 | |
399 (defmethod srecode-insert-method ((sti srecode-template-inserter-comment) | |
400 dictionary) | |
401 "Don't insert anything for comment macros in STI." | |
402 nil) | |
403 | |
404 | |
405 (defclass srecode-template-inserter-variable (srecode-template-inserter) | |
406 ((key :initform nil | |
407 :allocation :class | |
408 :documentation | |
409 "The character code used to identify inserters of this style.")) | |
106840
5df8e547a422
Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
410 "Insert the value of a dictionary entry. |
104498 | 411 If there is no entry, insert nothing.") |
412 | |
413 (defvar srecode-inserter-variable-current-dictionary nil | |
414 "The active dictionary when calling a variable filter.") | |
415 | |
416 (defmethod srecode-insert-variable-secondname-handler | |
417 ((sti srecode-template-inserter-variable) dictionary value secondname) | |
418 "For VALUE handle SECONDNAME behaviors for this variable inserter. | |
419 Return the result as a string. | |
420 By default, treat as a function name. | |
421 If SECONDNAME is nil, return VALUE." | |
422 (if secondname | |
423 (let ((fcnpart (read secondname))) | |
424 (if (fboundp fcnpart) | |
425 (let ((srecode-inserter-variable-current-dictionary dictionary)) | |
426 (funcall fcnpart value)) | |
427 ;; Else, warn. | |
105328 | 428 (error "Variable insertion second arg %s is not a function" |
104498 | 429 secondname))) |
430 value)) | |
431 | |
432 (defmethod srecode-insert-method ((sti srecode-template-inserter-variable) | |
433 dictionary) | |
434 "Insert the STI inserter." | |
435 ;; Convert the name into a name/fcn pair | |
436 (let* ((name (oref sti :object-name)) | |
437 (fcnpart (oref sti :secondname)) | |
438 (val (srecode-dictionary-lookup-name | |
439 dictionary name)) | |
440 (do-princ t) | |
441 ) | |
442 ;; Alert if a macro wasn't found. | |
443 (when (not val) | |
444 (message "Warning: macro %S was not found in the dictionary." name) | |
445 (setq val "")) | |
446 ;; If there was a functional part, call that function. | |
447 (cond ;; Strings | |
448 ((stringp val) | |
449 (setq val (srecode-insert-variable-secondname-handler | |
450 sti dictionary val fcnpart))) | |
451 ;; Compound data value | |
452 ((srecode-dictionary-compound-value-child-p val) | |
453 ;; Force FCN to be a symbol | |
454 (when fcnpart (setq fcnpart (read fcnpart))) | |
455 ;; Convert compound value to a string with the fcn. | |
456 (setq val (srecode-compound-toString val fcnpart dictionary)) | |
457 ;; If the value returned is nil, then it may be a special | |
458 ;; field inserter that requires us to set do-princ to nil. | |
459 (when (not val) | |
460 (setq do-princ nil) | |
461 ) | |
462 ) | |
463 ;; Dictionaries... not allowed in this style | |
464 ((srecode-dictionary-child-p val) | |
105328 | 465 (error "Macro %s cannot insert a dictionary - use section macros instead" |
104498 | 466 name)) |
467 ;; Other stuff... convert | |
468 (t | |
105328 | 469 (error "Macro %s cannot insert arbitrary data" name) |
104498 | 470 ;;(if (and val (not (stringp val))) |
471 ;; (setq val (format "%S" val)))) | |
472 )) | |
473 ;; Output the dumb thing unless the type of thing specifically | |
474 ;; did the inserting forus. | |
475 (when do-princ | |
476 (princ val)))) | |
477 | |
478 (defclass srecode-template-inserter-ask (srecode-template-inserter-variable) | |
479 ((key :initform ?? | |
480 :allocation :class | |
481 :documentation | |
482 "The character code used to identify inserters of this style.") | |
483 (prompt :initarg :prompt | |
484 :initform nil | |
485 :documentation | |
486 "The prompt used to query for this dictionary value.") | |
487 (defaultfcn :initarg :defaultfcn | |
488 :initform nil | |
489 :documentation | |
490 "The function which can calculate a default value.") | |
491 (read-fcn :initarg :read-fcn | |
492 :initform 'read-string | |
493 :documentation | |
494 "The function used to read in the text for this prompt.") | |
495 ) | |
106840
5df8e547a422
Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
496 "Insert the value of a dictionary entry. |
104498 | 497 If there is no entry, prompt the user for the value to use. |
498 The prompt text used is derived from the previous PROMPT command in the | |
499 template file.") | |
500 | |
501 (defmethod srecode-inserter-apply-state ((ins srecode-template-inserter-ask) STATE) | |
502 "For the template inserter INS, apply information from STATE. | |
503 Loop over the prompts to see if we have a match." | |
504 (let ((prompts (oref STATE prompts)) | |
505 ) | |
506 (while prompts | |
507 (when (string= (semantic-tag-name (car prompts)) | |
508 (oref ins :object-name)) | |
509 (oset ins :prompt | |
510 (semantic-tag-get-attribute (car prompts) :text)) | |
511 (oset ins :defaultfcn | |
512 (semantic-tag-get-attribute (car prompts) :default)) | |
513 (oset ins :read-fcn | |
514 (or (semantic-tag-get-attribute (car prompts) :read) | |
515 'read-string)) | |
516 ) | |
517 (setq prompts (cdr prompts))) | |
518 )) | |
519 | |
520 (defmethod srecode-insert-method ((sti srecode-template-inserter-ask) | |
521 dictionary) | |
522 "Insert the STI inserter." | |
523 (let ((val (srecode-dictionary-lookup-name | |
524 dictionary (oref sti :object-name)))) | |
525 (if val | |
526 ;; Does some extra work. Oh well. | |
527 (call-next-method) | |
528 | |
529 ;; How is our -ask value determined? | |
530 (if srecode-insert-with-fields-in-progress | |
531 ;; Setup editable fields. | |
532 (setq val (srecode-insert-method-field sti dictionary)) | |
533 ;; Ask the question... | |
534 (setq val (srecode-insert-method-ask sti dictionary))) | |
535 | |
536 ;; After asking, save in the dictionary so that | |
537 ;; the user can use the same name again later. | |
538 (srecode-dictionary-set-value | |
539 (srecode-root-dictionary dictionary) | |
540 (oref sti :object-name) val) | |
541 | |
542 ;; Now that this value is safely stowed in the dictionary, | |
543 ;; we can do what regular inserters do. | |
544 (call-next-method)))) | |
545 | |
546 (defmethod srecode-insert-ask-default ((sti srecode-template-inserter-ask) | |
547 dictionary) | |
548 "Derive the default value for an askable inserter STI. | |
549 DICTIONARY is used to derive some values." | |
550 (let ((defaultfcn (oref sti :defaultfcn))) | |
551 (cond ((stringp defaultfcn) | |
552 defaultfcn) | |
553 ((functionp defaultfcn) | |
554 (funcall defaultfcn)) | |
555 ((and (listp defaultfcn) | |
556 (eq (car defaultfcn) 'macro)) | |
557 (srecode-dictionary-lookup-name | |
558 dictionary (cdr defaultfcn))) | |
559 ((null defaultfcn) | |
560 "") | |
561 (t | |
562 (error "Unknown default for prompt: %S" | |
563 defaultfcn))))) | |
564 | |
565 (defmethod srecode-insert-method-ask ((sti srecode-template-inserter-ask) | |
566 dictionary) | |
567 "Do the \"asking\" for the template inserter STI. | |
568 Use DICTIONARY to resolve values." | |
569 (let* ((prompt (oref sti prompt)) | |
570 (default (srecode-insert-ask-default sti dictionary)) | |
571 (reader (oref sti :read-fcn)) | |
572 (val nil) | |
573 ) | |
574 (cond ((eq reader 'y-or-n-p) | |
575 (if (y-or-n-p (or prompt | |
576 (format "%s? " | |
577 (oref sti :object-name)))) | |
578 (setq val default) | |
579 (setq val ""))) | |
580 ((eq reader 'read-char) | |
581 (setq val (format | |
582 "%c" | |
583 (read-char (or prompt | |
584 (format "Char for %s: " | |
585 (oref sti :object-name)))))) | |
586 ) | |
587 (t | |
588 (save-excursion | |
589 (setq val (funcall reader | |
590 (or prompt | |
591 (format "Specify %s: " | |
592 (oref sti :object-name))) | |
593 default | |
594 ))))) | |
595 ;; Return our derived value. | |
596 val) | |
597 ) | |
598 | |
599 (defmethod srecode-insert-method-field ((sti srecode-template-inserter-ask) | |
600 dictionary) | |
601 "Create an editable field for the template inserter STI. | |
602 Use DICTIONARY to resolve values." | |
603 (let* ((default (srecode-insert-ask-default sti dictionary)) | |
604 (compound-value | |
605 (srecode-field-value (oref sti :object-name) | |
606 :firstinserter sti | |
607 :defaultvalue default)) | |
608 ) | |
609 ;; Return this special compound value as the thing to insert. | |
610 ;; This special compound value will repeat our asked question | |
611 ;; across multiple locations. | |
612 compound-value)) | |
613 | |
614 (defmethod srecode-dump ((ins srecode-template-inserter-ask) indent) | |
615 "Dump the state of the SRecode template inserter INS." | |
616 (call-next-method) | |
617 (princ " : \"") | |
618 (princ (oref ins prompt)) | |
619 (princ "\"") | |
620 ) | |
621 | |
622 (defclass srecode-template-inserter-width (srecode-template-inserter-variable) | |
623 ((key :initform ?| | |
624 :allocation :class | |
625 :documentation | |
626 "The character code used to identify inserters of this style.") | |
627 ) | |
628 "Inserts the value of a dictionary variable with a specific width. | |
106840
5df8e547a422
Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
629 The second argument specifies the width, and a pad, separated by a colon. |
5df8e547a422
Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
630 Thus a specification of `10:left' will insert the value of A |
104498 | 631 to 10 characters, with spaces added to the left. Use `right' for adding |
632 spaces to the right.") | |
633 | |
634 (defmethod srecode-insert-variable-secondname-handler | |
635 ((sti srecode-template-inserter-width) dictionary value width) | |
636 "For VALUE handle WIDTH behaviors for this variable inserter. | |
637 Return the result as a string. | |
638 By default, treat as a function name." | |
639 (if width | |
640 ;; Trim or pad to new length | |
641 (let* ((split (split-string width ":")) | |
642 (width (string-to-number (nth 0 split))) | |
643 (second (nth 1 split)) | |
644 (pad (cond ((or (null second) (string= "right" second)) | |
645 'right) | |
646 ((string= "left" second) | |
647 'left) | |
648 (t | |
649 (error "Unknown pad type %s" second))))) | |
650 (if (>= (length value) width) | |
651 ;; Simple case - too long. | |
652 (substring value 0 width) | |
653 ;; We need to pad on one side or the other. | |
654 (let ((padchars (make-string (- width (length value)) ? ))) | |
655 (if (eq pad 'left) | |
656 (concat padchars value) | |
657 (concat value padchars))))) | |
105328 | 658 (error "Width not specified for variable/width inserter"))) |
104498 | 659 |
660 (defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-width) | |
661 escape-start escape-end) | |
662 "Insert an example using inserter INS. | |
663 Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." | |
664 (princ " ") | |
665 (princ escape-start) | |
666 (princ "|A:10:right") | |
667 (princ escape-end) | |
668 (terpri) | |
669 ) | |
670 | |
671 (defvar srecode-template-inserter-point-override nil | |
105328 | 672 "When non-nil, the point inserter will do this function instead.") |
104498 | 673 |
674 (defclass srecode-template-inserter-point (srecode-template-inserter) | |
675 ((key :initform ?^ | |
676 :allocation :class | |
677 :documentation | |
678 "The character code used to identify inserters of this style.") | |
679 (point :type (or null marker) | |
680 :allocation :class | |
681 :documentation | |
682 "Record the value of (point) in this class slot. | |
683 It is the responsibility of the inserter algorithm to clear this | |
684 after a successful insertion.")) | |
685 "Record the value of (point) when inserted. | |
686 The cursor is placed at the ^ macro after insertion. | |
687 Some inserter macros, such as `srecode-template-inserter-include-wrap' | |
688 will place text at the ^ macro from the included macro.") | |
689 | |
690 (defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-point) | |
691 escape-start escape-end) | |
692 "Insert an example using inserter INS. | |
693 Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." | |
694 (princ " ") | |
695 (princ escape-start) | |
696 (princ "^") | |
697 (princ escape-end) | |
698 (terpri) | |
699 ) | |
700 | |
701 (defmethod srecode-insert-method ((sti srecode-template-inserter-point) | |
702 dictionary) | |
703 "Insert the STI inserter. | |
704 Save point in the class allocated 'point' slot. | |
705 If `srecode-template-inserter-point-override' then this generalized | |
706 marker will do something else. See `srecode-template-inserter-include-wrap' | |
707 as an example." | |
708 (if srecode-template-inserter-point-override | |
709 ;; Disable the old override while we do this. | |
710 (let ((over srecode-template-inserter-point-override) | |
711 (srecode-template-inserter-point-override nil)) | |
712 (funcall over dictionary) | |
713 ) | |
714 (oset sti point (point-marker)) | |
715 )) | |
716 | |
717 (defclass srecode-template-inserter-subtemplate (srecode-template-inserter) | |
718 () | |
719 "Wrap a section of a template under the control of a macro." | |
720 :abstract t) | |
721 | |
722 (defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-subtemplate) | |
723 escape-start escape-end) | |
724 "Insert an example using inserter INS. | |
725 Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." | |
726 (call-next-method) | |
727 (princ " Template Text to control") | |
728 (terpri) | |
729 (princ " ") | |
730 (princ escape-start) | |
731 (princ "/VARNAME") | |
732 (princ escape-end) | |
733 (terpri) | |
734 ) | |
735 | |
736 (defmethod srecode-insert-subtemplate ((sti srecode-template-inserter-subtemplate) | |
737 dict slot) | |
738 "Insert a subtemplate for the inserter STI with dictionary DICT." | |
739 ;; make sure that only dictionaries are used. | |
740 (when (not (srecode-dictionary-child-p dict)) | |
741 (error "Only section dictionaries allowed for %s" | |
742 (object-name-string sti))) | |
743 ;; Output the code from the sub-template. | |
744 (srecode-insert-method (slot-value sti slot) dict) | |
745 ) | |
746 | |
747 (defmethod srecode-insert-method-helper ((sti srecode-template-inserter-subtemplate) | |
748 dictionary slot) | |
749 "Do the work for inserting the STI inserter. | |
750 Loops over the embedded CODE which was saved here during compilation. | |
751 The template to insert is stored in SLOT." | |
752 (let ((dicts (srecode-dictionary-lookup-name | |
753 dictionary (oref sti :object-name)))) | |
754 ;; If there is no section dictionary, then don't output anything | |
755 ;; from this section. | |
756 (while dicts | |
757 (srecode-insert-subtemplate sti (car dicts) slot) | |
758 (setq dicts (cdr dicts))))) | |
759 | |
760 (defmethod srecode-insert-method ((sti srecode-template-inserter-subtemplate) | |
761 dictionary) | |
762 "Insert the STI inserter. | |
763 Calls back to `srecode-insert-method-helper' for this class." | |
764 (srecode-insert-method-helper sti dictionary 'template)) | |
765 | |
766 | |
767 (defclass srecode-template-inserter-section-start (srecode-template-inserter-subtemplate) | |
768 ((key :initform ?# | |
769 :allocation :class | |
770 :documentation | |
771 "The character code used to identify inserters of this style.") | |
772 (template :initarg :template | |
773 :documentation | |
106840
5df8e547a422
Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
774 "A template used to frame the codes from this inserter.") |
104498 | 775 ) |
776 "Apply values from a sub-dictionary to a template section. | |
777 The dictionary saved at the named dictionary entry will be | |
778 applied to the text between the section start and the | |
779 `srecode-template-inserter-section-end' macro.") | |
780 | |
781 (defmethod srecode-parse-input ((ins srecode-template-inserter-section-start) | |
782 tag input STATE) | |
783 "For the section inserter INS, parse INPUT. | |
784 Shorten input until the END token is found. | |
785 Return the remains of INPUT." | |
786 (let* ((out (srecode-compile-split-code tag input STATE | |
787 (oref ins :object-name)))) | |
788 (oset ins template (srecode-template | |
789 (object-name-string ins) | |
790 :context nil | |
791 :args nil | |
792 :code (cdr out))) | |
793 (car out))) | |
794 | |
795 (defmethod srecode-dump ((ins srecode-template-inserter-section-start) indent) | |
796 "Dump the state of the SRecode template inserter INS." | |
797 (call-next-method) | |
798 (princ "\n") | |
799 (srecode-dump-code-list (oref (oref ins template) code) | |
800 (concat indent " ")) | |
801 ) | |
802 | |
803 (defclass srecode-template-inserter-section-end (srecode-template-inserter) | |
804 ((key :initform ?/ | |
805 :allocation :class | |
806 :documentation | |
807 "The character code used to identify inserters of this style.") | |
808 ) | |
106840
5df8e547a422
Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
809 "All template segments between the section-start and section-end |
104498 | 810 are treated specially.") |
811 | |
812 (defmethod srecode-insert-method ((sti srecode-template-inserter-section-end) | |
813 dictionary) | |
814 "Insert the STI inserter." | |
815 ) | |
816 | |
817 (defmethod srecode-match-end ((ins srecode-template-inserter-section-end) name) | |
818 | |
819 "For the template inserter INS, do I end a section called NAME?" | |
820 (string= name (oref ins :object-name))) | |
821 | |
822 (defclass srecode-template-inserter-include (srecode-template-inserter-subtemplate) | |
823 ((key :initform ?> | |
824 :allocation :class | |
825 :documentation | |
826 "The character code used to identify inserters of this style.") | |
827 (includedtemplate | |
828 :initarg :includedtemplate | |
829 :documentation | |
830 "The template included for this inserter.")) | |
831 "Include a different template into this one. | |
832 The included template will have additional dictionary entries from the subdictionary | |
833 stored specified by this macro.") | |
834 | |
835 (defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-include) | |
836 escape-start escape-end) | |
837 "Insert an example using inserter INS. | |
838 Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." | |
839 (princ " ") | |
840 (princ escape-start) | |
841 (princ ">DICTNAME:contextname:templatename") | |
842 (princ escape-end) | |
843 (terpri) | |
844 ) | |
845 | |
846 (defmethod srecode-insert-include-lookup ((sti srecode-template-inserter-include) | |
847 dictionary) | |
848 "For the template inserter STI, lookup the template to include. | |
849 Finds the template with this macro function part and stores it in | |
850 this template instance." | |
851 (let* ((templatenamepart (oref sti :secondname)) | |
852 ) | |
853 ;; If there was no template name, throw an error | |
854 (if (not templatenamepart) | |
105328 | 855 (error "Include macro %s needs a template name" (oref sti :object-name))) |
104498 | 856 ;; Find the template by name, and save it. |
857 (if (or (not (slot-boundp sti 'includedtemplate)) | |
858 (not (oref sti includedtemplate))) | |
859 (let ((tmpl (srecode-template-get-table (srecode-table) | |
860 templatenamepart)) | |
861 (active (oref srecode-template active)) | |
862 ctxt) | |
863 (when (not tmpl) | |
864 ;; If it isn't just available, scan back through | |
865 ;; the active template stack, searching for a matching | |
866 ;; context. | |
867 (while (and (not tmpl) active) | |
868 (setq ctxt (oref (car active) context)) | |
869 (setq tmpl (srecode-template-get-table (srecode-table) | |
870 templatenamepart | |
871 ctxt)) | |
872 (when (not tmpl) | |
873 (when (slot-boundp (car active) 'table) | |
874 (let ((app (oref (oref (car active) table) application))) | |
875 (when app | |
876 (setq tmpl (srecode-template-get-table | |
877 (srecode-table) | |
878 templatenamepart | |
879 ctxt app))) | |
880 ))) | |
881 (setq active (cdr active))) | |
882 (when (not tmpl) | |
883 ;; If it wasn't in this context, look to see if it | |
106840
5df8e547a422
Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
884 ;; defines its own context |
104498 | 885 (setq tmpl (srecode-template-get-table (srecode-table) |
886 templatenamepart))) | |
887 ) | |
888 (oset sti :includedtemplate tmpl))) | |
889 | |
890 (if (not (oref sti includedtemplate)) | |
891 ;; @todo - Call into a debugger to help find the template in question. | |
892 (error "No template \"%s\" found for include macro `%s'" | |
893 templatenamepart (oref sti :object-name))) | |
894 )) | |
895 | |
896 (defmethod srecode-insert-method ((sti srecode-template-inserter-include) | |
897 dictionary) | |
898 "Insert the STI inserter. | |
899 Finds the template with this macro function part, and inserts it | |
106840
5df8e547a422
Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
900 with the dictionaries found in the dictionary." |
104498 | 901 (srecode-insert-include-lookup sti dictionary) |
902 ;; Insert the template. | |
903 ;; Our baseclass has a simple way to do this. | |
904 (if (srecode-dictionary-lookup-name dictionary (oref sti :object-name)) | |
905 ;; If we have a value, then call the next method | |
906 (srecode-insert-method-helper sti dictionary 'includedtemplate) | |
907 ;; If we don't have a special dictitonary, then just insert with the | |
908 ;; current dictionary. | |
909 (srecode-insert-subtemplate sti dictionary 'includedtemplate)) | |
910 ) | |
911 | |
912 ;; | |
913 ;; This template combines the include template and the sectional template. | |
914 ;; It will first insert the included template, then insert the embedded | |
915 ;; template wherever the $^$ in the included template was. | |
916 ;; | |
917 ;; Since it uses dual inheretance, it will magically get the end-matching | |
918 ;; behavior of #, with the including feature of >. | |
919 ;; | |
920 (defclass srecode-template-inserter-include-wrap (srecode-template-inserter-include srecode-template-inserter-section-start) | |
921 ((key :initform ?< | |
922 :allocation :class | |
923 :documentation | |
924 "The character code used to identify inserters of this style.") | |
925 ) | |
926 "Include a different template into this one, and add text at the ^ macro. | |
927 The included template will have additional dictionary entries from the subdictionary | |
928 stored specified by this macro. If the included macro includes a ^ macro, | |
929 then the text between this macro and the end macro will be inserted at | |
930 the ^ macro.") | |
931 | |
932 (defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-include-wrap) | |
933 escape-start escape-end) | |
934 "Insert an example using inserter INS. | |
935 Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." | |
936 (princ " ") | |
937 (princ escape-start) | |
938 (princ "<DICTNAME:contextname:templatename") | |
939 (princ escape-end) | |
940 (terpri) | |
941 (princ " Template Text to insert at ^ macro") | |
942 (terpri) | |
943 (princ " ") | |
944 (princ escape-start) | |
945 (princ "/DICTNAME") | |
946 (princ escape-end) | |
947 (terpri) | |
948 ) | |
949 | |
950 (defmethod srecode-insert-method ((sti srecode-template-inserter-include-wrap) | |
951 dictionary) | |
952 "Insert the template STI. | |
953 This will first insert the include part via inheritance, then | |
954 insert the section it wraps into the location in the included | |
106840
5df8e547a422
Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
955 template where a ^ inserter occurs." |
104498 | 956 ;; Step 1: Look up the included inserter |
957 (srecode-insert-include-lookup sti dictionary) | |
958 ;; Step 2: Temporarilly override the point inserter. | |
959 (let* ((vaguely-unique-name sti) | |
960 (srecode-template-inserter-point-override | |
961 (lambda (dict2) | |
962 (if (srecode-dictionary-lookup-name | |
963 dict2 (oref vaguely-unique-name :object-name)) | |
964 ;; Insert our sectional part with looping. | |
965 (srecode-insert-method-helper | |
966 vaguely-unique-name dict2 'template) | |
967 ;; Insert our sectional part just once. | |
968 (srecode-insert-subtemplate vaguely-unique-name | |
969 dict2 'template)) | |
970 ))) | |
971 ;; Do a regular insertion for an include, but with our override in | |
972 ;; place. | |
973 (call-next-method) | |
974 )) | |
975 | |
976 (provide 'srecode/insert) | |
977 | |
978 ;; Local variables: | |
979 ;; generated-autoload-file: "loaddefs.el" | |
980 ;; generated-autoload-load-name: "srecode/insert" | |
981 ;; End: | |
982 | |
105377 | 983 ;; arch-tag: a5aa3401-924a-4617-8513-2f0f01256872 |
104498 | 984 ;;; srecode/insert.el ends here |