Commit | Line | Data |
---|---|---|
d2ddb974 KH |
1 | ;;; vhdl-mode.el --- major mode for editing VHDL code |
2 | ||
3 | ;; Copyright (C) 1992, 93, 94, 95, 96, 1997 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Authors: Reto Zimmermann <mailto:Reto.Zimmermann@iaeth.ch> | |
6 | ;; <http://www.iis.ee.ethz.ch/~zimmi/> | |
7 | ;; Rodney J. Whitby <mailto:rwhitby@geocities.com> | |
8 | ;; <http://www.geocities.com/SiliconValley/Park/8287/> | |
9 | ;; Maintainer: vhdl-mode@geocities.com | |
10 | ;; Maintainers' Version: 3.19 | |
11 | ;; Keywords: languages vhdl | |
12 | ||
13 | ;; This file is part of GNU Emacs. | |
14 | ||
15 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
16 | ;; it under the terms of the GNU General Public License as published by | |
17 | ;; the Free Software Foundation; either version 2, or (at your option) | |
18 | ;; any later version. | |
19 | ||
20 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
21 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
22 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
23 | ;; GNU General Public License for more details. | |
24 | ||
25 | ;; You should have received a copy of the GNU General Public License | |
26 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
27 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
28 | ;; Boston, MA 02111-1307, USA. | |
29 | ||
30 | ;; ############################################################################ | |
31 | ;;; Commentary: | |
32 | ;; ############################################################################ | |
33 | ||
34 | ;; This package provides an Emacs major mode for editing VHDL code. | |
35 | ;; It includes the following features: | |
36 | ||
37 | ;; - Highlighting of VHDL syntax | |
38 | ;; - Indentation based on versatile syntax analysis | |
39 | ;; - Template insertion (electrification) for most VHDL constructs | |
40 | ;; - Insertion of customizable VHDL file headers | |
41 | ;; - Word completion (dynamic abbreviations) | |
42 | ;; - Menu containing all VHDL Mode commands | |
43 | ;; - Index menu (jump index to main units and blocks in a file) | |
44 | ;; - Source file menu (menu of all source files in current directory) | |
45 | ;; - Source file compilation (syntax analysis) | |
46 | ;; - Postscript printing with fontification | |
47 | ;; - Lower and upper case keywords | |
48 | ;; - Hiding blocks of code | |
49 | ;; - Alignment functions | |
50 | ;; - Easy customization | |
2f402702 | 51 | ;; - Works under Emacs and XEmacs |
d2ddb974 KH |
52 | |
53 | ;; ############################################################################ | |
54 | ;; Usage | |
55 | ;; ############################################################################ | |
56 | ||
57 | ;; see below (comment in vhdl-mode function) or type `C-c C-h' in Emacs. | |
58 | ||
59 | ;; ############################################################################ | |
60 | ;; Emacs Versions | |
61 | ;; ############################################################################ | |
62 | ||
63 | ;; - Emacs 20 | |
64 | ;; - XEmacs 19.15 | |
65 | ;; - This version does not support Emacs 19 (use VHDL Mode 3.10 instead) | |
66 | ||
67 | ||
68 | ;; ############################################################################ | |
69 | ;; Acknowledgements | |
70 | ;; ############################################################################ | |
71 | ||
72 | ;; Electrification ideas by Bob Pack <rlpst@cislabs.pitt.edu> | |
73 | ;; and Steve Grout | |
74 | ||
75 | ;; Fontification approach suggested by Ken Wood <ken@eda.com.au> | |
76 | ;; Source file menu suggested by Michael Laajanen <mila@enea.se> | |
77 | ;; Ideas about alignment from John Wiegley <johnw@borland.com> | |
78 | ||
79 | ;; Many thanks to all the users who sent me bug reports and enhancement | |
80 | ;; requests. | |
81 | ;; Special thanks go to Dan Nicolaescu <done@ece.arizona.edu> for reviewing | |
82 | ;; the code and for his valuable hints. | |
83 | ||
84 | ;;; Code: | |
85 | ||
86 | ;; ############################################################################ | |
87 | ;; User definable variables | |
88 | ;; ############################################################################ | |
89 | ||
90 | ;; ############################################################################ | |
91 | ;; Variables for customization | |
92 | ||
93 | (defgroup vhdl nil | |
94 | "Customizations for VHDL Mode." | |
95 | :prefix "vhdl-" | |
42dfe0ad DN |
96 | :group 'languages |
97 | :version "20.3") | |
d2ddb974 KH |
98 | |
99 | ||
100 | (defgroup vhdl-mode nil | |
101 | "Customizations for modes." | |
102 | :group 'vhdl) | |
103 | ||
104 | (defcustom vhdl-electric-mode t | |
105 | "*If non-nil, electrification (automatic template generation) is enabled. | |
106 | If nil, template generators can still be invoked through key bindings | |
107 | and menu. Can be toggled by `\\[vhdl-electric-mode]'." | |
108 | :type 'boolean | |
109 | :group 'vhdl-mode) | |
110 | ||
111 | (defcustom vhdl-stutter-mode t | |
112 | "*If non-nil, stuttering is enabled. | |
113 | Can be toggled by `\\[vhdl-stutter-mode]'." | |
114 | :type 'boolean | |
115 | :group 'vhdl-mode) | |
116 | ||
117 | (defcustom vhdl-indent-tabs-mode t | |
118 | "*Indentation can insert tabs if this is non-nil. | |
119 | Overrides local variable `indent-tabs-mode'." | |
120 | :type 'boolean | |
121 | :group 'vhdl-mode) | |
122 | ||
123 | ||
124 | (defgroup vhdl-compile nil | |
125 | "Customizations for compilation." | |
126 | :group 'vhdl) | |
127 | ||
128 | (defcustom vhdl-compiler 'v-system | |
129 | "*VHDL compiler to be used for syntax analysis. | |
130 | cadence Cadence Design Systems (`cv -file') | |
131 | ikos Ikos Voyager (`analyze') | |
132 | quickhdl QuickHDL, Mentor Graphics (`qvhcom') | |
133 | synopsys Synopsys, VHDL Analyzer (`vhdlan') | |
134 | vantage Vantage Analysis Systems (`analyze -libfile vsslib.ini -src') | |
135 | viewlogic Viewlogic (`analyze -libfile vsslib.ini -src') | |
136 | v-system V-System, Model Technology (`vcom') | |
137 | For incorporation of additional compilers, please send me their command syntax | |
138 | and some example error messages." | |
139 | :type '(choice | |
140 | (const cadence) | |
141 | (const ikos) | |
142 | (const quickhdl) | |
143 | (const synopsys) | |
144 | (const vantage) | |
145 | (const viewlogic) | |
146 | (const v-system) | |
147 | ) | |
148 | :group 'vhdl-compile) | |
149 | ||
150 | (defcustom vhdl-compiler-options "" | |
151 | "*Options to be added to the compile command." | |
152 | :type 'string | |
153 | :group 'vhdl-compile) | |
154 | ||
155 | ||
156 | (defgroup vhdl-style nil | |
157 | "Customizations for code styles." | |
158 | :group 'vhdl) | |
159 | ||
160 | (defcustom vhdl-basic-offset 4 | |
161 | "*Amount of basic offset used for indentation. | |
162 | This value is used by + and - symbols in `vhdl-offsets-alist'." | |
163 | :type 'integer | |
164 | :group 'vhdl-style) | |
165 | ||
166 | ||
167 | (defgroup vhdl-word-case nil | |
168 | "Customizations for case of VHDL words." | |
169 | :group 'vhdl-style) | |
170 | ||
171 | (defcustom vhdl-upper-case-keywords nil | |
172 | "*If non-nil, keywords are converted to upper case | |
173 | when typed or by the fix case functions." | |
174 | :type 'boolean | |
175 | :group 'vhdl-word-case) | |
176 | ||
177 | (defcustom vhdl-upper-case-types nil | |
178 | "*If non-nil, standardized types are converted to upper case | |
179 | by the fix case functions." | |
180 | :type 'boolean | |
181 | :group 'vhdl-word-case) | |
182 | ||
183 | (defcustom vhdl-upper-case-attributes nil | |
184 | "*If non-nil, standardized attributes are converted to upper case | |
185 | by the fix case functions." | |
186 | :type 'boolean | |
187 | :group 'vhdl-word-case) | |
188 | ||
189 | (defcustom vhdl-upper-case-enum-values nil | |
190 | "*If non-nil, standardized enumeration values are converted to upper case | |
191 | by the fix case functions." | |
192 | :type 'boolean | |
193 | :group 'vhdl-word-case) | |
194 | ||
195 | ||
196 | (defgroup vhdl-electric nil | |
197 | "Customizations for comments." | |
198 | :group 'vhdl) | |
199 | ||
200 | (defcustom vhdl-auto-align nil | |
201 | "*If non-nil, some templates are automatically aligned after generation." | |
202 | :type 'boolean | |
203 | :group 'vhdl-electric) | |
204 | ||
205 | (defcustom vhdl-additional-empty-lines t | |
206 | "*If non-nil, additional empty lines are inserted in some templates. | |
207 | This improves readability of code." | |
208 | :type 'boolean | |
209 | :group 'vhdl-electric) | |
210 | ||
211 | (defcustom vhdl-argument-list-indent t | |
212 | "*If non-nil, argument lists are indented relative to the opening paren. | |
213 | Normal indentation is applied otherwise." | |
214 | :type 'boolean | |
215 | :group 'vhdl-electric) | |
216 | ||
217 | (defcustom vhdl-conditions-in-parenthesis nil | |
218 | "*If non-nil, parenthesis are placed around condition expressions." | |
219 | :type 'boolean | |
220 | :group 'vhdl-electric) | |
221 | ||
222 | (defcustom vhdl-date-format 'scientific | |
223 | "*Specifies date format to be used in header. | |
224 | Date formats are: | |
225 | american (09/17/1997) | |
226 | european (17.09.1997) | |
227 | scientific (1997/09/17)" | |
228 | :type '(choice (const american) | |
229 | (const european) | |
230 | (const scientific)) | |
231 | :group 'vhdl-electric) | |
232 | ||
233 | (defcustom vhdl-header-file nil | |
234 | "*Pathname/filename of the file to be inserted as header. | |
235 | If the header contains RCS keywords, they may be written as <RCS>Keyword<RCS> | |
236 | if the header needs to be version controlled. | |
237 | ||
238 | The following keywords for template generation are supported: | |
239 | <filename> : replaced by the name of the buffer | |
240 | <author> : replaced by the user name and email address | |
241 | <date> : replaced by the current date | |
242 | <... string> : replaced by a prompted string (... is the prompt word) | |
243 | <cursor> : final cursor position | |
244 | ||
245 | Example: | |
246 | ----------------------------------------- | |
247 | -- Title : <title string> | |
248 | -- File : <filename> | |
249 | -- Author : <author> | |
250 | -- Created : <date> | |
251 | -- Description : <cursor> | |
252 | -----------------------------------------" | |
253 | :type 'string | |
254 | :group 'vhdl-electric) | |
255 | ||
256 | (defcustom vhdl-modify-date-prefix-string "-- Last modified : " | |
257 | "*Prefix string of modification date in VHDL file header. | |
258 | If actualization of the modification date is called (menu, `\\[vhdl-modify]'), | |
259 | this string is searched and the rest of the line replaced by the current date." | |
260 | :type 'string | |
261 | :group 'vhdl-electric) | |
262 | ||
263 | (defcustom vhdl-zero-string "'0'" | |
264 | "*String to use for a logic zero." | |
265 | :type 'string | |
266 | :group 'vhdl-electric) | |
267 | ||
268 | (defcustom vhdl-one-string "'1'" | |
269 | "*String to use for a logic one." | |
270 | :type 'string | |
271 | :group 'vhdl-electric) | |
272 | ||
273 | ||
274 | (defgroup vhdl-comment nil | |
275 | "Customizations for comments." | |
276 | :group 'vhdl-electric) | |
277 | ||
278 | (defcustom vhdl-self-insert-comments t | |
279 | "*If non-nil, variables templates automatically insert help comments." | |
280 | :type 'boolean | |
281 | :group 'vhdl-comment) | |
282 | ||
283 | (defcustom vhdl-prompt-for-comments t | |
284 | "*If non-nil, various templates prompt for user definable comments." | |
285 | :type 'boolean | |
286 | :group 'vhdl-comment) | |
287 | ||
288 | (defcustom vhdl-comment-column 40 | |
289 | "*Column to indent right-margin comments to. | |
290 | Overrides local variable `comment-column'." | |
291 | :type 'integer | |
292 | :group 'vhdl-comment) | |
293 | ||
294 | (defcustom vhdl-end-comment-column 79 | |
295 | "*End of comment column." | |
296 | :type 'integer | |
297 | :group 'vhdl-comment) | |
298 | ||
299 | (defvar end-comment-column 79 | |
300 | "*End of comment column.") | |
301 | ||
302 | ||
303 | (defgroup vhdl-highlight nil | |
304 | "Customizations for highlighting." | |
305 | :group 'vhdl) | |
306 | ||
307 | (defcustom vhdl-highlight-names t | |
308 | "*If non-nil, unit names, subprogram names, and labels are highlighted." | |
309 | :type 'boolean | |
310 | :group 'vhdl-highlight) | |
311 | ||
312 | (defcustom vhdl-highlight-keywords t | |
313 | "*If non-nil, VHDL keywords and other predefined words are highlighted. | |
314 | That is, keywords, predefined types, predefined attributes, and predefined | |
315 | enumeration values are highlighted." | |
316 | :type 'boolean | |
317 | :group 'vhdl-highlight) | |
318 | ||
319 | (defcustom vhdl-highlight-signals nil | |
320 | "*If non-nil, signals of different classes are highlighted using colors. | |
321 | Signal classes are: clock, reset, status/control, data, and test." | |
322 | :type 'boolean | |
323 | :group 'vhdl-highlight) | |
324 | ||
325 | (defcustom vhdl-highlight-case-sensitive nil | |
326 | "*If non-nil, case is considered for highlighting. | |
327 | Possible trade-off: | |
328 | non-nil also upper-case VHDL words are highlighted, but case of signal names | |
329 | is not considered (may lead to highlighting of unwanted words), | |
330 | nil only lower-case VHDL words are highlighted, but case of signal names | |
331 | is considered. | |
332 | Overrides local variable `font-lock-keywords-case-fold-search'." | |
333 | :type 'boolean | |
334 | :group 'vhdl-highlight) | |
335 | ||
2f402702 RS |
336 | (defcustom vhdl-customize-colors nil |
337 | "*If non-nil, colors are customized to go with the additional signal colors. | |
338 | NOTE: this alters the behavior of Emacs for *all* modes, | |
339 | so it is not enabled by default." | |
d2ddb974 KH |
340 | :type 'boolean |
341 | :group 'vhdl-highlight) | |
342 | ||
2f402702 RS |
343 | (defcustom vhdl-customize-faces t |
344 | "*If non-nil, faces are customized to work better with VHDL Mode. | |
345 | This variable comes only into effect if no colors are used | |
346 | for highlighting or printing (i.e. variable `ps-print-color-p' is nil). | |
347 | ||
348 | NOTE: this alters the behavior of Emacs for *all* modes, | |
349 | so it is not enabled by default." | |
d2ddb974 KH |
350 | :type 'boolean |
351 | :group 'vhdl-highlight) | |
352 | ||
353 | ||
354 | (defgroup vhdl-signal-syntax nil | |
355 | "Customizations of signal syntax for highlighting." | |
356 | :group 'vhdl-highlight) | |
357 | ||
358 | (defcustom vhdl-signal-syntax-doc-string " | |
359 | Must be of the form \"\\ \<\\\(...\\\)\\\>\", where ... specifies the actual syntax. | |
360 | (delete this space ^ , it's only a workaround to get this doc string.) | |
361 | The basic regexp elements are: | |
362 | [A-Z] any upper case letter | |
363 | [A-Za-z] any letter | |
364 | [0-9] any digit | |
365 | \\w any letter or digit (corresponds to [A-Za-z0-9]) | |
366 | [XY] letter \"X\" or \"Y\" | |
367 | [^XY] neither letter \"X\" nor \"Y\" | |
368 | x letter \"x\" | |
369 | * postfix operator for matching previous regexp element any times | |
370 | + postfix operator for matching previous regexp element at least once | |
371 | ? postfix operator for matching previous regexp element at most once" | |
372 | "Common document string used for the custom variables below. Must be | |
373 | defined as custom variable due to a bug in XEmacs.") | |
374 | ||
375 | (defcustom vhdl-clock-signal-syntax "\\<\\([A-Z]\\w*xC\\w*\\)\\>" | |
376 | (concat | |
377 | "*Regular expression (regexp) for syntax of clock signals." | |
378 | vhdl-signal-syntax-doc-string) | |
379 | :type 'regexp | |
380 | :group 'vhdl-signal-syntax) | |
381 | ||
382 | (defcustom vhdl-reset-signal-syntax "\\<\\([A-Z]\\w*xR\\w*\\)\\>" | |
383 | (concat | |
384 | "*Regular expression (regexp) for syntax of (asynchronous) reset signals." | |
385 | vhdl-signal-syntax-doc-string) | |
386 | :type 'regexp | |
387 | :group 'vhdl-signal-syntax) | |
388 | ||
389 | (defcustom vhdl-control-signal-syntax "\\<\\([A-Z]\\w*x[IS]\\w*\\)\\>" | |
390 | (concat | |
391 | "*Regular expression (regexp) for syntax of status/control signals." | |
392 | vhdl-signal-syntax-doc-string) | |
393 | :type 'regexp | |
394 | :group 'vhdl-signal-syntax) | |
395 | ||
396 | (defcustom vhdl-data-signal-syntax "\\<\\([A-Z]\\w*xD\\w*\\)\\>" | |
397 | (concat | |
398 | "*Regular expression (regexp) for syntax of data signals." | |
399 | vhdl-signal-syntax-doc-string) | |
400 | :type 'regexp | |
401 | :group 'vhdl-signal-syntax) | |
402 | ||
403 | (defcustom vhdl-test-signal-syntax "\\<\\([A-Z]\\w*xT\\w*\\)\\>" | |
404 | (concat | |
405 | "*Regular expression (regexp) for syntax of test signals." | |
406 | vhdl-signal-syntax-doc-string) | |
407 | :type 'regexp | |
408 | :group 'vhdl-signal-syntax) | |
409 | ||
410 | ||
411 | (defgroup vhdl-menu nil | |
412 | "Customizations for menues." | |
413 | :group 'vhdl) | |
414 | ||
415 | (defcustom vhdl-source-file-menu t | |
416 | "*If non-nil, a menu of all source files in the current directory is created." | |
417 | :type 'boolean | |
418 | :group 'vhdl-menu) | |
419 | ||
420 | (defcustom vhdl-index-menu t | |
421 | "*If non-nil, an index menu for the current source file is created." | |
422 | :type 'boolean | |
423 | :group 'vhdl-menu) | |
424 | ||
425 | (defcustom vhdl-hideshow-menu (not (string-match "XEmacs" emacs-version)) | |
426 | "*If non-nil, hideshow menu and functionality is added. | |
427 | Hideshow allows hiding code of VHDL processes and blocks. | |
428 | (Does not work under XEmacs.)" | |
429 | :type 'boolean | |
430 | :group 'vhdl-menu) | |
431 | ||
432 | ||
433 | (defgroup vhdl-print nil | |
434 | "Customizations for printing." | |
435 | :group 'vhdl) | |
436 | ||
437 | (defcustom vhdl-print-two-column t | |
438 | "*If non-nil, code is printed in two columns and landscape format." | |
439 | :type 'boolean | |
440 | :group 'vhdl-print) | |
441 | ||
442 | ||
443 | (defgroup vhdl-misc nil | |
444 | "Miscellaneous customizations." | |
445 | :group 'vhdl) | |
446 | ||
447 | (defcustom vhdl-intelligent-tab t | |
448 | "*If non-nil, `TAB' does indentation, word completion, and tab insertion. | |
449 | That is, if preceeding character is part of a word then complete word, | |
450 | else if not at beginning of line then insert tab, | |
451 | else if last command was a `TAB' or `RET' then dedent one step, | |
452 | else indent current line (i.e. `TAB' is bound to `vhdl-tab'). | |
453 | If nil, TAB always indents current line (i.e. `TAB' is bound to | |
454 | `vhdl-indent-line')." | |
455 | :type 'boolean | |
456 | :group 'vhdl-misc) | |
457 | ||
458 | (defcustom vhdl-template-key-binding-prefix "\C-t" | |
459 | "*`C-c' plus this key gives the key binding prefix for all VHDL templates. | |
460 | Default key binding prefix for templates is `C-c C-t' (example: architecture | |
461 | `C-c C-t a'). If you have no own `C-c LETTER' bindings, you can shorten the | |
462 | template key binding prefix to `C-c' (example: architecture `C-c a') by | |
463 | assigning the empty character (\"\") to this variable. The syntax to enter | |
464 | control keys is \"\\C-t\"." | |
465 | :type 'sexp | |
466 | :group 'vhdl-misc) | |
467 | ||
468 | (defcustom vhdl-word-completion-in-minibuffer t | |
469 | "*If non-nil, word completion works in minibuffer (for template prompts)." | |
470 | :type 'boolean | |
471 | :group 'vhdl-misc) | |
472 | ||
473 | (defcustom vhdl-underscore-is-part-of-word nil | |
474 | "*If non-nil, the underscore character `_' is considered as part of word. | |
475 | An identifier containing underscores is then treated as a single word in | |
476 | select and move operations. All parts of an identifier separated by underscore | |
477 | are treated as single words otherwise." | |
478 | :type 'boolean | |
479 | :group 'vhdl-misc) | |
480 | ||
481 | ;; ############################################################################ | |
482 | ;; Other variables | |
483 | ||
484 | (defvar vhdl-inhibit-startup-warnings-p nil | |
485 | "*If non-nil, inhibits start up compatibility warnings.") | |
486 | ||
487 | (defvar vhdl-strict-syntax-p nil | |
488 | "*If non-nil, all syntactic symbols must be found in `vhdl-offsets-alist'. | |
489 | If the syntactic symbol for a particular line does not match a symbol | |
490 | in the offsets alist, an error is generated, otherwise no error is | |
491 | reported and the syntactic symbol is ignored.") | |
492 | ||
493 | (defvar vhdl-echo-syntactic-information-p nil | |
494 | "*If non-nil, syntactic info is echoed when the line is indented.") | |
495 | ||
496 | (defconst vhdl-offsets-alist-default | |
497 | '((string . -1000) | |
498 | (block-open . 0) | |
499 | (block-close . 0) | |
500 | (statement . 0) | |
501 | (statement-cont . vhdl-lineup-statement-cont) | |
502 | (statement-block-intro . +) | |
503 | (statement-case-intro . +) | |
504 | (case-alternative . +) | |
505 | (comment . vhdl-lineup-comment) | |
506 | (arglist-intro . +) | |
507 | (arglist-cont . 0) | |
508 | (arglist-cont-nonempty . vhdl-lineup-arglist) | |
509 | (arglist-close . vhdl-lineup-arglist) | |
510 | (entity . 0) | |
511 | (configuration . 0) | |
512 | (package . 0) | |
513 | (architecture . 0) | |
514 | (package-body . 0) | |
515 | ) | |
516 | "Default settings for offsets of syntactic elements. | |
517 | Do not change this constant! See the variable `vhdl-offsets-alist' for | |
518 | more information.") | |
519 | ||
520 | (defvar vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default) | |
521 | "*Association list of syntactic element symbols and indentation offsets. | |
522 | As described below, each cons cell in this list has the form: | |
523 | ||
524 | (SYNTACTIC-SYMBOL . OFFSET) | |
525 | ||
526 | When a line is indented, vhdl-mode first determines the syntactic | |
527 | context of the line by generating a list of symbols called syntactic | |
528 | elements. This list can contain more than one syntactic element and | |
529 | the global variable `vhdl-syntactic-context' contains the context list | |
530 | for the line being indented. Each element in this list is actually a | |
531 | cons cell of the syntactic symbol and a buffer position. This buffer | |
532 | position is call the relative indent point for the line. Some | |
533 | syntactic symbols may not have a relative indent point associated with | |
534 | them. | |
535 | ||
536 | After the syntactic context list for a line is generated, vhdl-mode | |
537 | calculates the absolute indentation for the line by looking at each | |
538 | syntactic element in the list. First, it compares the syntactic | |
539 | element against the SYNTACTIC-SYMBOL's in `vhdl-offsets-alist'. When it | |
540 | finds a match, it adds the OFFSET to the column of the relative indent | |
541 | point. The sum of this calculation for each element in the syntactic | |
542 | list is the absolute offset for line being indented. | |
543 | ||
544 | If the syntactic element does not match any in the `vhdl-offsets-alist', | |
545 | an error is generated if `vhdl-strict-syntax-p' is non-nil, otherwise | |
546 | the element is ignored. | |
547 | ||
548 | Actually, OFFSET can be an integer, a function, a variable, or one of | |
549 | the following symbols: `+', `-', `++', or `--'. These latter | |
550 | designate positive or negative multiples of `vhdl-basic-offset', | |
551 | respectively: *1, *-1, *2, and *-2. If OFFSET is a function, it is | |
552 | called with a single argument containing the cons of the syntactic | |
553 | element symbol and the relative indent point. The function should | |
554 | return an integer offset. | |
555 | ||
556 | Here is the current list of valid syntactic element symbols: | |
557 | ||
558 | string -- inside multi-line string | |
559 | block-open -- statement block open | |
560 | block-close -- statement block close | |
561 | statement -- a VHDL statement | |
562 | statement-cont -- a continuation of a VHDL statement | |
563 | statement-block-intro -- the first line in a new statement block | |
564 | statement-case-intro -- the first line in a case alternative block | |
565 | case-alternative -- a case statement alternative clause | |
566 | comment -- a line containing only a comment | |
567 | arglist-intro -- the first line in an argument list | |
568 | arglist-cont -- subsequent argument list lines when no | |
569 | arguments follow on the same line as the | |
570 | the arglist opening paren | |
571 | arglist-cont-nonempty -- subsequent argument list lines when at | |
572 | least one argument follows on the same | |
573 | line as the arglist opening paren | |
574 | arglist-close -- the solo close paren of an argument list | |
575 | entity -- inside an entity declaration | |
576 | configuration -- inside a configuration declaration | |
577 | package -- inside a package declaration | |
578 | architecture -- inside an architecture body | |
579 | package-body -- inside a package body | |
580 | ") | |
581 | ||
582 | (defvar vhdl-comment-only-line-offset 0 | |
583 | "*Extra offset for line which contains only the start of a comment. | |
584 | Can contain an integer or a cons cell of the form: | |
585 | ||
586 | (NON-ANCHORED-OFFSET . ANCHORED-OFFSET) | |
587 | ||
588 | Where NON-ANCHORED-OFFSET is the amount of offset given to | |
589 | non-column-zero anchored comment-only lines, and ANCHORED-OFFSET is | |
590 | the amount of offset to give column-zero anchored comment-only lines. | |
591 | Just an integer as value is equivalent to (<val> . 0)") | |
592 | ||
593 | (defvar vhdl-special-indent-hook nil | |
594 | "*Hook for user defined special indentation adjustments. | |
595 | This hook gets called after a line is indented by the mode.") | |
596 | ||
597 | (defvar vhdl-style-alist | |
598 | '(("IEEE" | |
599 | (vhdl-basic-offset . 4) | |
600 | (vhdl-offsets-alist . ()) | |
601 | ) | |
602 | ) | |
603 | "Styles of Indentation. | |
604 | Elements of this alist are of the form: | |
605 | ||
606 | (STYLE-STRING (VARIABLE . VALUE) [(VARIABLE . VALUE) ...]) | |
607 | ||
608 | where STYLE-STRING is a short descriptive string used to select a | |
609 | style, VARIABLE is any vhdl-mode variable, and VALUE is the intended | |
610 | value for that variable when using the selected style. | |
611 | ||
612 | There is one special case when VARIABLE is `vhdl-offsets-alist'. In this | |
613 | case, the VALUE is a list containing elements of the form: | |
614 | ||
615 | (SYNTACTIC-SYMBOL . VALUE) | |
616 | ||
617 | as described in `vhdl-offsets-alist'. These are passed directly to | |
618 | `vhdl-set-offset' so there is no need to set every syntactic symbol in | |
619 | your style, only those that are different from the default.") | |
620 | ||
621 | ;; dynamically append the default value of most variables | |
622 | (or (assoc "Default" vhdl-style-alist) | |
623 | (let* ((varlist '(vhdl-inhibit-startup-warnings-p | |
624 | vhdl-strict-syntax-p | |
625 | vhdl-echo-syntactic-information-p | |
626 | vhdl-basic-offset | |
627 | vhdl-offsets-alist | |
628 | vhdl-comment-only-line-offset)) | |
629 | (default (cons "Default" | |
630 | (mapcar | |
631 | (function | |
632 | (lambda (var) | |
633 | (cons var (symbol-value var)) | |
634 | )) | |
635 | varlist)))) | |
636 | (setq vhdl-style-alist (cons default vhdl-style-alist)))) | |
637 | ||
638 | (defvar vhdl-mode-hook nil | |
639 | "*Hook called by `vhdl-mode'.") | |
640 | ||
641 | ||
642 | ;; ############################################################################ | |
643 | ;; Emacs variant handling | |
644 | ;; ############################################################################ | |
645 | ||
646 | ;; active regions | |
647 | ||
648 | (defun vhdl-keep-region-active () | |
649 | ;; do whatever is necessary to keep the region active in XEmacs | |
650 | ;; (formerly Lucid). ignore byte-compiler warnings you might see | |
651 | (and (boundp 'zmacs-region-stays) | |
652 | (setq zmacs-region-stays t))) | |
653 | ||
654 | (defconst vhdl-emacs-features | |
655 | (let ((major (and (boundp 'emacs-major-version) | |
656 | emacs-major-version)) | |
657 | (minor (and (boundp 'emacs-minor-version) | |
658 | emacs-minor-version)) | |
659 | flavor) | |
660 | ;; figure out version numbers if not already discovered | |
661 | (and (or (not major) (not minor)) | |
662 | (string-match "\\([0-9]+\\).\\([0-9]+\\)" emacs-version) | |
663 | (setq major (string-to-int (substring emacs-version | |
664 | (match-beginning 1) | |
665 | (match-end 1))) | |
666 | minor (string-to-int (substring emacs-version | |
667 | (match-beginning 2) | |
668 | (match-end 2))))) | |
669 | (if (not (and major minor)) | |
670 | (error "Cannot figure out the major and minor version numbers.")) | |
671 | ;; calculate the major version | |
672 | (cond | |
673 | ((= major 18) (setq major 'v18)) ;Emacs 18 | |
674 | ((= major 4) (setq major 'v18)) ;Epoch 4 | |
675 | ((= major 19) (setq major 'v19 ;Emacs 19 | |
676 | flavor (cond | |
677 | ((string-match "Win-Emacs" emacs-version) | |
678 | 'Win-Emacs) | |
679 | ((or (string-match "Lucid" emacs-version) | |
680 | (string-match "XEmacs" emacs-version)) | |
681 | 'XEmacs) | |
682 | (t | |
683 | t)))) | |
684 | ((= major 20) (setq major 'v20 ;Emacs 20 | |
685 | flavor (cond | |
686 | ((string-match "Win-Emacs" emacs-version) | |
687 | 'Win-Emacs) | |
688 | ((or (string-match "Lucid" emacs-version) | |
689 | (string-match "XEmacs" emacs-version)) | |
690 | 'XEmacs) | |
691 | (t | |
692 | t)))) | |
693 | ;; I don't know | |
694 | (t (error "Cannot recognize major version number: %s" major))) | |
695 | ;; lets do some minimal sanity checking. | |
696 | (if (and (or | |
697 | ;; Emacs 18 is brain dead | |
698 | (eq major 'v18) | |
699 | ;; Lemacs before 19.6 had bugs | |
700 | (and (eq major 'v19) (eq flavor 'XEmacs) (< minor 6)) | |
701 | ;; Emacs 19 before 19.21 had bugs | |
702 | (and (eq major 'v19) (eq flavor t) (< minor 21))) | |
703 | (not vhdl-inhibit-startup-warnings-p)) | |
704 | (with-output-to-temp-buffer "*vhdl-mode warnings*" | |
705 | (print (format | |
706 | "The version of Emacs that you are running, %s, | |
707 | has known bugs in its syntax.c parsing routines which will affect the | |
708 | performance of vhdl-mode. You should strongly consider upgrading to the | |
709 | latest available version. vhdl-mode may continue to work, after a | |
710 | fashion, but strange indentation errors could be encountered." | |
711 | emacs-version)))) | |
712 | (list major flavor)) | |
713 | "A list of features extant in the Emacs you are using. | |
714 | There are many flavors of Emacs out there, each with different | |
715 | features supporting those needed by vhdl-mode. Here's the current | |
716 | supported list, along with the values for this variable: | |
717 | ||
718 | Emacs 18/Epoch 4: (v18) | |
719 | XEmacs (formerly Lucid) 19: (v19 XEmacs) | |
720 | Win-Emacs 1.35: (V19 Win-Emacs) | |
721 | Emacs 19: (v19 t) | |
722 | Emacs 20: (v20 t).") | |
723 | ||
724 | ||
725 | ;; ############################################################################ | |
726 | ;; Bindings | |
727 | ;; ############################################################################ | |
728 | ||
729 | ;; ############################################################################ | |
730 | ;; Key bindings | |
731 | ||
732 | (defvar vhdl-template-map () | |
733 | "Keymap for VHDL templates.") | |
734 | ||
735 | (if vhdl-template-map () | |
736 | (setq vhdl-template-map (make-sparse-keymap)) | |
737 | ;; key bindings for VHDL templates | |
738 | (define-key vhdl-template-map "\M-A" 'vhdl-alias) | |
739 | (define-key vhdl-template-map "a" 'vhdl-architecture) | |
740 | (define-key vhdl-template-map "A" 'vhdl-array) | |
741 | (define-key vhdl-template-map "\M-a" 'vhdl-assert) | |
742 | (define-key vhdl-template-map "b" 'vhdl-block) | |
743 | (define-key vhdl-template-map "c" 'vhdl-case) | |
744 | (define-key vhdl-template-map "\M-c" 'vhdl-component) | |
745 | (define-key vhdl-template-map "I" 'vhdl-component-instance) | |
746 | (define-key vhdl-template-map "\M-s" 'vhdl-concurrent-signal-assignment) | |
747 | (define-key vhdl-template-map "\M-Cb"'vhdl-block-configuration) | |
748 | (define-key vhdl-template-map "\M-Cc"'vhdl-component-configuration) | |
749 | (define-key vhdl-template-map "\M-Cd"'vhdl-configuration-decl) | |
750 | (define-key vhdl-template-map "\M-Cs"'vhdl-configuration-spec) | |
751 | (define-key vhdl-template-map "C" 'vhdl-constant) | |
752 | (define-key vhdl-template-map "d" 'vhdl-disconnect) | |
753 | (define-key vhdl-template-map "\M-e" 'vhdl-else) | |
754 | (define-key vhdl-template-map "E" 'vhdl-elsif) | |
755 | (define-key vhdl-template-map "e" 'vhdl-entity) | |
756 | (define-key vhdl-template-map "x" 'vhdl-exit) | |
757 | (define-key vhdl-template-map "f" 'vhdl-for) | |
758 | (define-key vhdl-template-map "F" 'vhdl-function) | |
759 | (define-key vhdl-template-map "g" 'vhdl-generate) | |
760 | (define-key vhdl-template-map "G" 'vhdl-generic) | |
761 | (define-key vhdl-template-map "h" 'vhdl-header) | |
762 | (define-key vhdl-template-map "i" 'vhdl-if) | |
763 | (define-key vhdl-template-map "L" 'vhdl-library) | |
764 | (define-key vhdl-template-map "l" 'vhdl-loop) | |
765 | (define-key vhdl-template-map "m" 'vhdl-modify) | |
766 | (define-key vhdl-template-map "M" 'vhdl-map) | |
767 | (define-key vhdl-template-map "n" 'vhdl-next) | |
768 | (define-key vhdl-template-map "k" 'vhdl-package) | |
769 | (define-key vhdl-template-map "(" 'vhdl-paired-parens) | |
770 | (define-key vhdl-template-map "\M-p" 'vhdl-port) | |
771 | (define-key vhdl-template-map "p" 'vhdl-procedure) | |
772 | (define-key vhdl-template-map "P" 'vhdl-process) | |
773 | (define-key vhdl-template-map "R" 'vhdl-record) | |
774 | (define-key vhdl-template-map "r" 'vhdl-return-value) | |
775 | (define-key vhdl-template-map "\M-S" 'vhdl-selected-signal-assignment) | |
776 | (define-key vhdl-template-map "s" 'vhdl-signal) | |
777 | (define-key vhdl-template-map "S" 'vhdl-subtype) | |
778 | (define-key vhdl-template-map "t" 'vhdl-type) | |
779 | (define-key vhdl-template-map "u" 'vhdl-use) | |
780 | (define-key vhdl-template-map "v" 'vhdl-variable) | |
781 | (define-key vhdl-template-map "W" 'vhdl-wait) | |
782 | (define-key vhdl-template-map "w" 'vhdl-while-loop) | |
783 | (define-key vhdl-template-map "\M-w" 'vhdl-with) | |
784 | (define-key vhdl-template-map "\M-W" 'vhdl-clocked-wait) | |
785 | (define-key vhdl-template-map "Kb" 'vhdl-package-numeric-bit) | |
786 | (define-key vhdl-template-map "Kn" 'vhdl-package-numeric-std) | |
787 | (define-key vhdl-template-map "Ks" 'vhdl-package-std-logic-1164) | |
788 | (define-key vhdl-template-map "Kt" 'vhdl-package-textio) | |
789 | ) | |
790 | ||
791 | (defvar vhdl-mode-map () | |
792 | "Keymap for VHDL Mode.") | |
793 | ||
794 | (if vhdl-mode-map () | |
795 | (setq vhdl-mode-map (make-sparse-keymap)) | |
796 | ;; key bindings for templates | |
797 | (define-key vhdl-mode-map | |
798 | (concat "\C-c" vhdl-template-key-binding-prefix) vhdl-template-map) | |
799 | ;; standard key bindings | |
800 | (define-key vhdl-mode-map "\M-a" 'vhdl-beginning-of-statement) | |
801 | (define-key vhdl-mode-map "\M-e" 'vhdl-end-of-statement) | |
802 | (define-key vhdl-mode-map "\M-\C-f" 'vhdl-forward-sexp) | |
803 | (define-key vhdl-mode-map "\M-\C-b" 'vhdl-backward-sexp) | |
804 | (define-key vhdl-mode-map "\M-\C-u" 'vhdl-backward-up-list) | |
805 | ;(define-key vhdl-mode-map "\M-\C-d" 'vhdl-down-list) | |
806 | (define-key vhdl-mode-map "\M-\C-a" 'vhdl-beginning-of-defun) | |
807 | (define-key vhdl-mode-map "\M-\C-e" 'vhdl-end-of-defun) | |
808 | (define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun) | |
809 | (define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp) | |
810 | (define-key vhdl-mode-map "\177" 'backward-delete-char-untabify) | |
811 | (define-key vhdl-mode-map "\r" 'vhdl-return) | |
812 | (if vhdl-intelligent-tab | |
813 | (define-key vhdl-mode-map "\t" 'vhdl-tab) | |
814 | (define-key vhdl-mode-map "\t" 'vhdl-indent-line)) | |
815 | (define-key vhdl-mode-map " " 'vhdl-outer-space) | |
816 | ;; new key bindings for VHDL Mode, with no counterpart to BOCM | |
817 | (define-key vhdl-mode-map "\C-c\C-e" 'vhdl-electric-mode) | |
818 | (define-key vhdl-mode-map "\C-c\C-s" 'vhdl-stutter-mode) | |
819 | (define-key vhdl-mode-map "\C-c\C-u" 'vhdl-fix-case-buffer) | |
820 | (define-key vhdl-mode-map "\C-c\C-f" 'font-lock-fontify-buffer) | |
821 | (define-key vhdl-mode-map "\C-c\C-x" 'vhdl-show-syntactic-information) | |
822 | (define-key vhdl-mode-map "\C-c\C-r" 'vhdl-regress-line) | |
823 | (define-key vhdl-mode-map "\C-c\C-i" 'vhdl-indent-line) | |
824 | (define-key vhdl-mode-map "\C-c\C-a" 'vhdl-align-noindent-region) | |
825 | (define-key vhdl-mode-map "\C-c\M-\C-a" 'vhdl-align-comment-region) | |
826 | (define-key vhdl-mode-map "\C-c\C-c" 'vhdl-comment-uncomment-region) | |
827 | (define-key vhdl-mode-map "\C-c-" 'vhdl-inline-comment) | |
828 | (define-key vhdl-mode-map "\C-c\M--" 'vhdl-display-comment-line) | |
829 | (define-key vhdl-mode-map "\C-c\C-o" 'vhdl-open-line) | |
830 | (define-key vhdl-mode-map "\C-c\C-g" 'goto-line) | |
831 | (define-key vhdl-mode-map "\C-c\C-d" 'vhdl-kill-line) | |
832 | (define-key vhdl-mode-map "\C-c\C-h" 'vhdl-help) | |
833 | (define-key vhdl-mode-map "\C-c\C-v" 'vhdl-version) | |
834 | (define-key vhdl-mode-map "\C-c\C-b" 'vhdl-submit-bug-report) | |
835 | (define-key vhdl-mode-map "\C-c\C-k" 'vhdl-compile) | |
836 | (define-key vhdl-mode-map "\C-c\M-\C-k" 'vhdl-make) | |
837 | (define-key vhdl-mode-map "\M-\t" 'tab-to-tab-stop) | |
838 | ;; key bindings for stuttering | |
839 | (define-key vhdl-mode-map "-" 'vhdl-stutter-mode-dash) | |
840 | (define-key vhdl-mode-map "'" 'vhdl-stutter-mode-quote) | |
841 | (define-key vhdl-mode-map ";" 'vhdl-stutter-mode-semicolon) | |
842 | (define-key vhdl-mode-map "[" 'vhdl-stutter-mode-open-bracket) | |
843 | (define-key vhdl-mode-map "]" 'vhdl-stutter-mode-close-bracket) | |
844 | (define-key vhdl-mode-map "." 'vhdl-stutter-mode-period) | |
845 | (define-key vhdl-mode-map "," 'vhdl-stutter-mode-comma) | |
846 | (let ((c 97)) | |
847 | (while (< c 123) ; for little a-z | |
848 | (define-key vhdl-mode-map (char-to-string c) 'vhdl-stutter-mode-caps) | |
849 | (setq c (1+ c)) | |
850 | )) | |
851 | ) | |
852 | ||
853 | ;; define special minibuffer keymap for enabling word completion in minibuffer | |
854 | ;; (useful in template generator prompts) | |
855 | (defvar vhdl-minibuffer-local-map (copy-keymap minibuffer-local-map) | |
856 | "Keymap for minibuffer used in VHDL Mode.") | |
857 | ||
858 | (define-key vhdl-minibuffer-local-map "\t" 'vhdl-minibuffer-tab) | |
859 | ||
860 | (defvar vhdl-mode-syntax-table nil | |
861 | "Syntax table used in vhdl-mode buffers.") | |
862 | ||
863 | (if vhdl-mode-syntax-table () | |
864 | (setq vhdl-mode-syntax-table (make-syntax-table)) | |
865 | ;; DO NOT TRY TO SET _ (UNDERSCORE) TO WORD CLASS! | |
866 | ;; why not? (is left to the user here) | |
867 | (if vhdl-underscore-is-part-of-word | |
868 | (modify-syntax-entry ?_ "w" vhdl-mode-syntax-table)) | |
869 | (modify-syntax-entry ?\" "\"" vhdl-mode-syntax-table) | |
870 | (modify-syntax-entry ?\$ "." vhdl-mode-syntax-table) | |
871 | (modify-syntax-entry ?\% "." vhdl-mode-syntax-table) | |
872 | (modify-syntax-entry ?\& "." vhdl-mode-syntax-table) | |
873 | (modify-syntax-entry ?\' "." vhdl-mode-syntax-table) | |
874 | (modify-syntax-entry ?\( "()" vhdl-mode-syntax-table) | |
875 | (modify-syntax-entry ?\) ")(" vhdl-mode-syntax-table) | |
876 | (modify-syntax-entry ?\* "." vhdl-mode-syntax-table) | |
877 | (modify-syntax-entry ?\+ "." vhdl-mode-syntax-table) | |
878 | (modify-syntax-entry ?\. "." vhdl-mode-syntax-table) | |
879 | (modify-syntax-entry ?\/ "." vhdl-mode-syntax-table) | |
880 | (modify-syntax-entry ?\: "." vhdl-mode-syntax-table) | |
881 | (modify-syntax-entry ?\; "." vhdl-mode-syntax-table) | |
882 | (modify-syntax-entry ?\< "." vhdl-mode-syntax-table) | |
883 | (modify-syntax-entry ?\= "." vhdl-mode-syntax-table) | |
884 | (modify-syntax-entry ?\> "." vhdl-mode-syntax-table) | |
885 | (modify-syntax-entry ?\[ "(]" vhdl-mode-syntax-table) | |
886 | (modify-syntax-entry ?\\ "\\" vhdl-mode-syntax-table) | |
887 | (modify-syntax-entry ?\] ")[" vhdl-mode-syntax-table) | |
888 | (modify-syntax-entry ?\{ "(}" vhdl-mode-syntax-table) | |
889 | (modify-syntax-entry ?\| "." vhdl-mode-syntax-table) | |
890 | (modify-syntax-entry ?\} "){" vhdl-mode-syntax-table) | |
891 | ;; add comment syntax | |
892 | (modify-syntax-entry ?\- ". 12" vhdl-mode-syntax-table) | |
893 | (modify-syntax-entry ?\n ">" vhdl-mode-syntax-table) | |
894 | (modify-syntax-entry ?\^M ">" vhdl-mode-syntax-table)) | |
895 | ||
896 | (defvar vhdl-syntactic-context nil | |
897 | "Buffer local variable containing syntactic analysis list.") | |
898 | (make-variable-buffer-local 'vhdl-syntactic-context) | |
899 | ||
900 | ;; ############################################################################ | |
901 | ;; Abbrev hook bindings | |
902 | ||
903 | (defvar vhdl-mode-abbrev-table nil | |
904 | "Abbrev table in use in vhdl-mode buffers.") | |
905 | ||
906 | (define-abbrev-table 'vhdl-mode-abbrev-table | |
907 | '( | |
908 | ("--" "" vhdl-display-comment-hook 0) | |
909 | ("abs" "" vhdl-default-hook 0) | |
910 | ("access" "" vhdl-default-hook 0) | |
911 | ("after" "" vhdl-default-hook 0) | |
912 | ("alias" "" vhdl-alias-hook 0) | |
913 | ("all" "" vhdl-default-hook 0) | |
914 | ("and" "" vhdl-default-hook 0) | |
915 | ("arch" "" vhdl-architecture-hook 0) | |
916 | ("architecture" "" vhdl-architecture-hook 0) | |
917 | ("array" "" vhdl-array-hook 0) | |
918 | ("assert" "" vhdl-assert-hook 0) | |
919 | ("attr" "" vhdl-attribute-hook 0) | |
920 | ("attribute" "" vhdl-attribute-hook 0) | |
921 | ("begin" "" vhdl-default-indent-hook 0) | |
922 | ("block" "" vhdl-block-hook 0) | |
923 | ("body" "" vhdl-default-hook 0) | |
924 | ("buffer" "" vhdl-default-hook 0) | |
925 | ("bus" "" vhdl-default-hook 0) | |
926 | ("case" "" vhdl-case-hook 0) | |
927 | ("comp" "" vhdl-component-hook 0) | |
928 | ("component" "" vhdl-component-hook 0) | |
929 | ("conc" "" vhdl-concurrent-signal-assignment-hook 0) | |
930 | ("concurrent" "" vhdl-concurrent-signal-assignment-hook 0) | |
931 | ("conf" "" vhdl-configuration-hook 0) | |
932 | ("configuration" "" vhdl-configuration-hook 0) | |
933 | ("cons" "" vhdl-constant-hook 0) | |
934 | ("constant" "" vhdl-constant-hook 0) | |
935 | ("disconnect" "" vhdl-disconnect-hook 0) | |
936 | ("downto" "" vhdl-default-hook 0) | |
937 | ("else" "" vhdl-else-hook 0) | |
938 | ("elseif" "" vhdl-elsif-hook 0) | |
939 | ("elsif" "" vhdl-elsif-hook 0) | |
940 | ("end" "" vhdl-default-indent-hook 0) | |
941 | ("entity" "" vhdl-entity-hook 0) | |
942 | ("exit" "" vhdl-exit-hook 0) | |
943 | ("file" "" vhdl-default-hook 0) | |
944 | ("for" "" vhdl-for-hook 0) | |
945 | ("func" "" vhdl-function-hook 0) | |
946 | ("function" "" vhdl-function-hook 0) | |
947 | ("gen" "" vhdl-generate-hook 0) | |
948 | ("generate" "" vhdl-generate-hook 0) | |
949 | ("generic" "" vhdl-generic-hook 0) | |
950 | ("group" "" vhdl-default-hook 0) | |
951 | ("guarded" "" vhdl-default-hook 0) | |
952 | ("header" "" vhdl-header-hook 0) | |
953 | ("if" "" vhdl-if-hook 0) | |
954 | ("impure" "" vhdl-default-hook 0) | |
955 | ("in" "" vhdl-default-hook 0) | |
956 | ("inertial" "" vhdl-default-hook 0) | |
957 | ("inout" "" vhdl-default-hook 0) | |
958 | ("inst" "" vhdl-component-instance-hook 0) | |
959 | ("instance" "" vhdl-component-instance-hook 0) | |
960 | ("is" "" vhdl-default-hook 0) | |
961 | ("label" "" vhdl-default-hook 0) | |
962 | ("library" "" vhdl-library-hook 0) | |
963 | ("linkage" "" vhdl-default-hook 0) | |
964 | ("literal" "" vhdl-default-hook 0) | |
965 | ("loop" "" vhdl-loop-hook 0) | |
966 | ("map" "" vhdl-map-hook 0) | |
967 | ("mod" "" vhdl-default-hook 0) | |
968 | ("modify" "" vhdl-modify-hook 0) | |
969 | ("nand" "" vhdl-default-hook 0) | |
970 | ("new" "" vhdl-default-hook 0) | |
971 | ("next" "" vhdl-next-hook 0) | |
972 | ("nor" "" vhdl-default-hook 0) | |
973 | ("not" "" vhdl-default-hook 0) | |
974 | ("null" "" vhdl-default-hook 0) | |
975 | ("of" "" vhdl-default-hook 0) | |
976 | ("on" "" vhdl-default-hook 0) | |
977 | ("open" "" vhdl-default-hook 0) | |
978 | ("or" "" vhdl-default-hook 0) | |
979 | ("others" "" vhdl-default-hook 0) | |
980 | ("out" "" vhdl-default-hook 0) | |
981 | ("pack" "" vhdl-package-hook 0) | |
982 | ("package" "" vhdl-package-hook 0) | |
983 | ("port" "" vhdl-port-hook 0) | |
984 | ("postponed" "" vhdl-default-hook 0) | |
985 | ("procedure" "" vhdl-procedure-hook 0) | |
986 | ("process" "" vhdl-process-hook 0) | |
987 | ("pure" "" vhdl-default-hook 0) | |
988 | ("range" "" vhdl-default-hook 0) | |
989 | ("record" "" vhdl-record-hook 0) | |
990 | ("register" "" vhdl-default-hook 0) | |
991 | ("reject" "" vhdl-default-hook 0) | |
992 | ("rem" "" vhdl-default-hook 0) | |
993 | ("report" "" vhdl-default-hook 0) | |
994 | ("ret" "" vhdl-return-hook 0) | |
995 | ("return" "" vhdl-return-hook 0) | |
996 | ("rol" "" vhdl-default-hook 0) | |
997 | ("ror" "" vhdl-default-hook 0) | |
998 | ("select" "" vhdl-selected-signal-assignment-hook 0) | |
999 | ("severity" "" vhdl-default-hook 0) | |
1000 | ("shared" "" vhdl-default-hook 0) | |
1001 | ("sig" "" vhdl-signal-hook 0) | |
1002 | ("signal" "" vhdl-signal-hook 0) | |
1003 | ("sla" "" vhdl-default-hook 0) | |
1004 | ("sll" "" vhdl-default-hook 0) | |
1005 | ("sra" "" vhdl-default-hook 0) | |
1006 | ("srl" "" vhdl-default-hook 0) | |
1007 | ("sub" "" vhdl-subtype-hook 0) | |
1008 | ("subtype" "" vhdl-subtype-hook 0) | |
1009 | ("then" "" vhdl-default-hook 0) | |
1010 | ("to" "" vhdl-default-hook 0) | |
1011 | ("transport" "" vhdl-default-hook 0) | |
1012 | ("type" "" vhdl-type-hook 0) | |
1013 | ("unaffected" "" vhdl-default-hook 0) | |
1014 | ("units" "" vhdl-default-hook 0) | |
1015 | ("until" "" vhdl-default-hook 0) | |
1016 | ("use" "" vhdl-use-hook 0) | |
1017 | ("var" "" vhdl-variable-hook 0) | |
1018 | ("variable" "" vhdl-variable-hook 0) | |
1019 | ("wait" "" vhdl-wait-hook 0) | |
1020 | ("warning" "" vhdl-default-hook 0) | |
1021 | ("when" "" vhdl-when-hook 0) | |
1022 | ("while" "" vhdl-while-loop-hook 0) | |
1023 | ("with" "" vhdl-selected-signal-assignment-hook 0) | |
1024 | ("xnor" "" vhdl-default-hook 0) | |
1025 | ("xor" "" vhdl-default-hook 0) | |
1026 | )) | |
1027 | ||
1028 | ||
1029 | ;; ############################################################################ | |
1030 | ;; Menues | |
1031 | ;; ############################################################################ | |
1032 | ||
1033 | ;; ############################################################################ | |
1034 | ;; VHDL menu (using `easy-menu.el') | |
1035 | ||
1036 | ;; `customize-menu-create' is included in `cus-edit.el' version 1.9954, | |
1037 | ;; which is not yet distributed with XEmacs 19.15 | |
1038 | (defun vhdl-customize-menu-create (symbol &optional name) | |
1039 | "Return a customize menu for customization group SYMBOL. | |
1040 | If optional NAME is given, use that as the name of the menu. | |
1041 | Otherwise the menu will be named `Customize'. | |
1042 | The format is suitable for use with `easy-menu-define'." | |
1043 | (unless name | |
1044 | (setq name "Customize")) | |
1045 | (if (memq 'XEmacs vhdl-emacs-features) | |
1046 | ;; We can delay it under XEmacs. | |
1047 | `(,name | |
1048 | :filter (lambda (&rest junk) | |
1049 | (cdr (custom-menu-create ',symbol)))) | |
1050 | ;; But we must create it now under Emacs. | |
1051 | (cons name (cdr (custom-menu-create symbol))))) | |
1052 | ||
1053 | (defvar vhdl-mode-menu | |
1054 | (append | |
1055 | '("VHDL" | |
1056 | ("Mode" | |
1057 | ["Electric" vhdl-electric-mode :style toggle :selected vhdl-electric-mode] | |
1058 | ["Stutter" vhdl-stutter-mode :style toggle :selected vhdl-stutter-mode] | |
1059 | ) | |
1060 | "--" | |
1061 | ("Compile" | |
1062 | ["Compile Buffer" vhdl-compile t] | |
1063 | ["Stop Compilation" kill-compilation t] | |
1064 | "--" | |
1065 | ["Make" vhdl-make t] | |
1066 | ["Generate Makefile" vhdl-generate-makefile t] | |
1067 | "--" | |
1068 | ["Next Error" next-error t] | |
1069 | ["Previous Error" previous-error t] | |
1070 | ["First Error" first-error t] | |
1071 | ) | |
1072 | "--" | |
1073 | ("Template" | |
1074 | ("VHDL Construct 1" | |
1075 | ["Alias" vhdl-alias t] | |
1076 | ["Architecture" vhdl-architecture t] | |
1077 | ["Array" vhdl-array t] | |
1078 | ["Assert" vhdl-assert t] | |
1079 | ["Attribute" vhdl-attribute t] | |
1080 | ["Block" vhdl-block t] | |
1081 | ["Case" vhdl-case t] | |
1082 | ["Component" vhdl-component t] | |
1083 | ["Concurrent (Signal Asst)" vhdl-concurrent-signal-assignment t] | |
1084 | ["Configuration (Block)" vhdl-block-configuration t] | |
1085 | ["Configuration (Comp)" vhdl-component-configuration t] | |
1086 | ["Configuration (Decl)" vhdl-configuration-decl t] | |
1087 | ["Configuration (Spec)" vhdl-configuration-spec t] | |
1088 | ["Constant" vhdl-constant t] | |
1089 | ["Disconnect" vhdl-disconnect t] | |
1090 | ["Else" vhdl-else t] | |
1091 | ["Elsif" vhdl-elsif t] | |
1092 | ["Entity" vhdl-entity t] | |
1093 | ["Exit" vhdl-exit t] | |
1094 | ["For (Loop)" vhdl-for t] | |
1095 | ["Function" vhdl-function t] | |
1096 | ["(For/If) Generate" vhdl-generate t] | |
1097 | ["Generic" vhdl-generic t] | |
1098 | ) | |
1099 | ("VHDL Construct 2" | |
1100 | ["If" vhdl-if t] | |
1101 | ["Instance" vhdl-component-instance t] | |
1102 | ["Library" vhdl-library t] | |
1103 | ["Loop" vhdl-loop t] | |
1104 | ["Map" vhdl-map t] | |
1105 | ["Next" vhdl-next t] | |
1106 | ["Package" vhdl-package t] | |
1107 | ["Port" vhdl-port t] | |
1108 | ["Procedure" vhdl-procedure t] | |
1109 | ["Process" vhdl-process t] | |
1110 | ["Record" vhdl-record t] | |
1111 | ["Return" vhdl-return-value t] | |
1112 | ["Select" vhdl-selected-signal-assignment t] | |
1113 | ["Signal" vhdl-signal t] | |
1114 | ["Subtype" vhdl-subtype t] | |
1115 | ["Type" vhdl-type t] | |
1116 | ["Use" vhdl-use t] | |
1117 | ["Variable" vhdl-variable t] | |
1118 | ["Wait" vhdl-wait t] | |
1119 | ["(Clocked Wait)" vhdl-clocked-wait t] | |
1120 | ["When" vhdl-when t] | |
1121 | ["While (Loop)" vhdl-while-loop t] | |
1122 | ["With" vhdl-with t] | |
1123 | ) | |
1124 | ("Standard Package" | |
1125 | ["numeric_bit" vhdl-package-numeric-bit t] | |
1126 | ["numeric_std" vhdl-package-numeric-std t] | |
1127 | ["std_logic_1164" vhdl-package-std-logic-1164 t] | |
1128 | ["textio" vhdl-package-textio t] | |
1129 | ) | |
1130 | ["Header" vhdl-header t] | |
1131 | ["Modify (Date)" vhdl-modify t] | |
1132 | ) | |
1133 | ("Comment" | |
1134 | ["(Un)Comment Out Region" vhdl-comment-uncomment-region (mark)] | |
1135 | ["Insert Inline Comment" vhdl-inline-comment t] | |
1136 | ["Insert Horizontal Line" vhdl-display-comment-line t] | |
1137 | ["Insert Display Comment" vhdl-display-comment t] | |
1138 | ["Fill Comment" fill-paragraph t] | |
1139 | ["Fill Comment Region" fill-region (mark)] | |
1140 | ) | |
1141 | ("Indent" | |
1142 | ["Line" vhdl-indent-line t] | |
1143 | ["Region" indent-region (mark)] | |
1144 | ["Buffer" vhdl-indent-buffer t] | |
1145 | ) | |
1146 | ("Align" | |
1147 | ["Region" vhdl-align-noindent-region (mark)] | |
1148 | ["Comment Region" vhdl-align-comment-region (mark)] | |
1149 | ) | |
1150 | ("Line" | |
1151 | ["Open" vhdl-open-line t] | |
1152 | ["Delete" vhdl-kill-line t] | |
1153 | ["Join" delete-indentation t] | |
1154 | ["Goto" goto-line t] | |
1155 | ) | |
1156 | ("Move" | |
1157 | ["Forward Statement" vhdl-end-of-statement t] | |
1158 | ["Backward Statement" vhdl-beginning-of-statement t] | |
1159 | ["Forward Expression" vhdl-forward-sexp t] | |
1160 | ["Backward Expression" vhdl-backward-sexp t] | |
1161 | ["Forward Function" vhdl-end-of-defun t] | |
1162 | ["Backward Function" vhdl-beginning-of-defun t] | |
1163 | ) | |
1164 | "--" | |
1165 | ("Fix Case" | |
1166 | ["Buffer" vhdl-fix-case-buffer t] | |
1167 | ["Region" vhdl-fix-case-region (mark)] | |
1168 | ) | |
1169 | ["Fontify Buffer" font-lock-fontify-buffer t] | |
1170 | ["Syntactic Info" vhdl-show-syntactic-information t] | |
1171 | "--" | |
1172 | ["Help" vhdl-help t] | |
1173 | ["Version" vhdl-version t] | |
1174 | ["Bug Report" vhdl-submit-bug-report t] | |
1175 | "--" | |
1176 | ) | |
1177 | (list (vhdl-customize-menu-create 'vhdl)) | |
1178 | )) | |
1179 | ||
1180 | (require 'easymenu) | |
1181 | ||
1182 | ;; ############################################################################ | |
1183 | ;; Index menu (using `imenu.el') | |
1184 | ||
1185 | (defvar vhdl-imenu-generic-expression | |
1186 | '( | |
1187 | ("Entity" | |
1188 | "^\\s-*\\(entity\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" | |
1189 | 2) | |
1190 | ("Architecture" | |
1191 | "^\\s-*\\(architecture\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)" | |
1192 | 2) | |
1193 | ("Configuration" | |
1194 | "^\\s-*\\(configuration\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)" | |
1195 | 2) | |
1196 | ("Package Body" | |
1197 | "^\\s-*\\(package body\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" | |
1198 | 2) | |
1199 | ("Package" | |
1200 | "^\\s-*\\(package\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" | |
1201 | 2) | |
1202 | ("Type" | |
1203 | "^\\s-*\\(sub\\)?type\\s-+\\(\\(\\w\\|\\s_\\)+\\)" | |
1204 | 2) | |
1205 | ("Component" | |
1206 | "^\\s-*\\(component\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" | |
1207 | 2) | |
1208 | ("Function / Procedure" | |
1209 | "^\\s-*\\(procedure\\|function\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" | |
1210 | 2) | |
1211 | ("Process / Block" | |
1212 | "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(process\\|block\\)" | |
1213 | 1) | |
1214 | ("Instance" | |
1215 | "^\\s-*\\(\\(\\w\\|\\s_\\)+\\s-*:\\(\\s-\\|\n\\)*\\(\\w\\|\\s_\\)+\\)\\(\\s-\\|\n\\)+\\(generic\\|port\\)\\s-+map\\>" | |
1216 | 1) | |
1217 | ) | |
1218 | "Imenu generic expression for VHDL Mode. See `imenu-generic-expression'.") | |
1219 | ||
1220 | (defun vhdl-add-index-menu () | |
1221 | (make-local-variable 'imenu-generic-expression) | |
1222 | (setq imenu-generic-expression vhdl-imenu-generic-expression) | |
1223 | (imenu-add-to-menubar "Index")) | |
1224 | ||
1225 | ;; ############################################################################ | |
1226 | ;; Source file menu (using `easy-menu.el') | |
1227 | ||
1228 | (defvar vhdl-extlist '("[A-Za-z0-9_.]*.vhdl?$")) | |
1229 | (defvar vhdl-filelist-menu nil) | |
1230 | ||
1231 | (defun vhdl-add-source-files-menu () | |
1232 | "Scan directory of current source file for all VHDL source files, and | |
1233 | generate menu." | |
1234 | (interactive) | |
1235 | (message "Scanning directory for source files ...") | |
1236 | (let (filelist menulist tmpextlist found | |
1237 | (newmap (current-local-map))) | |
1238 | (cd (file-name-directory (buffer-file-name))) | |
1239 | ;; find files | |
1240 | (setq menulist '()) | |
1241 | (setq tmpextlist vhdl-extlist) | |
1242 | (while tmpextlist | |
1243 | (setq filelist (nreverse (directory-files | |
1244 | (file-name-directory (buffer-file-name)) | |
1245 | nil (car tmpextlist) nil))) | |
1246 | ;; Create list for menu | |
1247 | (setq found nil) | |
1248 | (while filelist | |
1249 | (setq found t) | |
1250 | (setq menulist (cons (vector (car filelist) | |
1251 | (list 'find-file (car filelist)) t) | |
1252 | menulist)) | |
1253 | (setq filelist (cdr filelist))) | |
1254 | (setq menulist (vhdl-menu-split menulist 25)) | |
1255 | (if found | |
1256 | (setq menulist (cons "--" menulist))) | |
1257 | (setq tmpextlist (cdr tmpextlist))) | |
1258 | (setq menulist (cons ["*Rescan*" vhdl-add-source-files-menu t] menulist)) | |
1259 | (setq menulist (cons "Sources" menulist)) | |
1260 | ;; Create menu | |
1261 | (easy-menu-add menulist) | |
1262 | (easy-menu-define vhdl-filelist-menu newmap | |
1263 | "VHDL source files menu" menulist) | |
1264 | ; (use-local-map (append (current-local-map) newmap)) | |
1265 | ; (use-local-map newmap) | |
1266 | ) | |
1267 | (message "")) | |
1268 | ||
1269 | (defun vhdl-menu-split (list n) | |
1270 | "Split menu into several submenues, if number of elements > n." | |
1271 | (if (> (length list) n) | |
1272 | (let ((remain list) | |
1273 | (result '()) | |
1274 | (sublist '()) | |
1275 | (menuno 1) | |
1276 | (i 0)) | |
1277 | (while remain | |
1278 | (setq sublist (cons (car remain) sublist)) | |
1279 | (setq remain (cdr remain)) | |
1280 | (setq i (+ i 1)) | |
1281 | (if (= i n) | |
1282 | (progn | |
1283 | (setq result (cons (cons (format "Sources %s" menuno) | |
1284 | (nreverse sublist)) result)) | |
1285 | (setq i 0) | |
1286 | (setq menuno (+ menuno 1)) | |
1287 | (setq sublist '())))) | |
1288 | (and sublist | |
1289 | (setq result (cons (cons (format "Sources %s" menuno) | |
1290 | (nreverse sublist)) result))) | |
1291 | (nreverse result)) | |
1292 | list)) | |
1293 | ||
1294 | ||
1295 | ;; ############################################################################ | |
1296 | ;; VHDL Mode definition | |
1297 | ;; ############################################################################ | |
1c36bac6 | 1298 | ;;;###autoload |
d2ddb974 KH |
1299 | (defun vhdl-mode () |
1300 | "Major mode for editing VHDL code. | |
1301 | ||
1302 | Usage: | |
1303 | ------ | |
1304 | ||
1305 | - TEMPLATE INSERTION (electrification) (`\\[vhdl-outer-space]'): After typing | |
1306 | a VHDL keyword and entering `\\[vhdl-outer-space]', you are prompted for | |
1307 | arguments while a template is generated for that VHDL construct. Typing | |
1308 | `\\[vhdl-return]' (or `\\[keyboard-quit]' in yes-no queries) at the first | |
1309 | prompt aborts the current template generation. Typing `\\[just-one-space]' | |
1310 | after a keyword inserts a space without calling the template generator. | |
1311 | Automatic calling of the template generators (i.e. electrification) can be | |
1312 | disabled (enabled) by setting the variable `vhdl-electric-mode' to nil | |
1313 | (non-nil) or by typing `\\[vhdl-electric-mode]' (toggles electrification | |
1314 | mode). | |
1315 | Template generators can be called using the VHDL menu, the key bindings, or | |
1316 | by typing the keyword (first word of menu entry not in parenthesis) and | |
1317 | `\\[vhdl-outer-space]'. The following abbreviations can also be used: | |
1318 | arch, attr, conc, conf, comp, cons, func, inst, pack, ret, sig, sub, var. | |
1319 | ||
1320 | - HEADER INSERTION (`\\[vhdl-header]'): A customized header can be inserted | |
1321 | including the actual file name, user name, and current date as well as | |
1322 | prompted title strings. A custom header can be defined in a separate file | |
1323 | (see custom variable `vhdl-header-file'). | |
1324 | ||
1325 | - STUTTERING (double strike): Double striking of some keys inserts cumbersome | |
1326 | VHDL syntax elements. Stuttering can be disabled by variable | |
1327 | `vhdl-stutter-mode' and be toggled by typing `\\[vhdl-stutter-mode]'. | |
1328 | '' --> \" [ --> ( -- --> comment | |
1329 | ;; --> \" : \" [[ --> [ --CR --> comment-out code | |
1330 | ;;; --> \" := \" ] --> ) --- --> horizontal line | |
1331 | .. --> \" => \" ]] --> ] ---- --> display comment | |
1332 | ,, --> \" <= \" aa --> A - zz --> Z | |
1333 | ||
1334 | - WORD COMPLETION (`\\[vhdl-tab]'): Typing `\\[vhdl-tab]' after a (not | |
1335 | completed) word looks for a word in the buffer that starts alike and | |
1336 | inserts it. Re-typing `\\[vhdl-tab]' toggles through alternative word | |
1337 | completions. This also works in the minibuffer (i.e. in template generator | |
1338 | prompts). | |
1339 | ||
1340 | Typing `\\[vhdl-tab]' after a non-word character indents the line if at the | |
1341 | beginning of a line (i.e. no preceding non-blank characters), and inserts a | |
1342 | tabulator stop otherwise. `\\[tab-to-tab-stop]' always inserts a tabulator | |
1343 | stop. | |
1344 | ||
1345 | - COMMENTS (`--', `---', `----', `--CR'): | |
1346 | `--' puts a single comment. | |
1347 | `---' draws a horizontal line for separating code segments. | |
1348 | `----' inserts a display comment, i.e. two horizontal lines with a | |
1349 | comment in between. | |
1350 | `--CR' comments out code on that line. Re-hitting CR comments out | |
1351 | following lines. | |
1352 | `\\[vhdl-comment-uncomment-region]' comments out a region if not | |
1353 | commented out, uncomments out a region if already | |
1354 | commented out. | |
1355 | ||
1356 | You are prompted for comments after object definitions (i.e. signals, | |
1357 | variables, constants, ports) and after subprogram and process specifications | |
1358 | if variable `vhdl-prompt-for-comments' is non-nil. Comments are | |
1359 | automatically inserted as additional labels (e.g. after begin statements) | |
1360 | and help comments if `vhdl-self-insert-comments' is non-nil. | |
1361 | Inline comments (i.e. comments after a piece of code on the same line) are | |
1362 | indented at least to `vhdl-comment-column'. Comments go at maximum to | |
1363 | `vhdl-end-comment-column'. `\\[vhdl-return]' after a space in a comment will | |
1364 | open a new comment line. Typing beyond `vhdl-end-comment-column' in a | |
1365 | comment automatically opens a new comment line. `\\[fill-paragraph]' | |
1366 | re-fills multi-line comments. | |
1367 | ||
1368 | - INDENTATION: `\\[vhdl-tab]' indents a line if at the beginning of the line. | |
1369 | The amount of indentation is specified by variable `vhdl-basic-offset'. | |
1370 | `\\[vhdl-indent-line]' always indents the current line (is bound to `TAB' | |
1371 | if variable `vhdl-intelligent-tab' is nil). Indentation can be done for | |
1372 | an entire region (`\\[indent-region]') or buffer (menu). Argument and | |
1373 | port lists are indented normally (nil) or relative to the opening | |
1374 | parenthesis (non-nil) according to variable `vhdl-argument-list-indent'. | |
1375 | If variable `vhdl-indent-tabs-mode' is nil, spaces are used instead of tabs. | |
1376 | `\\[tabify]' and `\\[untabify]' allow to convert spaces to tabs and vice | |
1377 | versa. | |
1378 | ||
1379 | - ALIGNMENT: `\\[vhdl-align-noindent-region]' aligns port maps, signal and | |
1380 | variable assignments, inline comments, some keywords, etc., on consecutive | |
1381 | lines relative to each other within a defined region. | |
1382 | `\\[vhdl-align-comment-region]' only aligns inline comments (i.e. comments | |
1383 | that are at the end of a line of code). Some templates are automatically | |
1384 | aligned after generation if custom variable `vhdl-auto-align' is non-nil. | |
1385 | ||
1386 | - KEY BINDINGS: Key bindings (`C-c ...') exist for most commands (see in menu). | |
1387 | ||
1388 | - VHDL MENU: All commands can be called from the VHDL menu. | |
1389 | ||
1390 | - INDEX MENU: For each VHDL source file, an index of the contained entities, | |
1391 | architectures, packages, procedures, processes, etc., is created as a menu. | |
1392 | Selecting a meny entry causes the cursor to jump to the corresponding | |
1393 | position in the file. Controlled by variable `vhdl-index-menu'. | |
1394 | ||
1395 | - SOURCE FILE MENU: A menu containing all VHDL source files in the directory | |
1396 | of the current file is generated. Selecting a menu entry loads the file. | |
1397 | Controlled by variable `vhdl-source-file-menu'. | |
1398 | ||
1399 | - SOURCE FILE COMPILATION: The syntax of the current buffer can be analyzed | |
1400 | by calling a VHDL compiler (menu, `\\[vhdl-compile]'). The compiler to be | |
1401 | used is defined by variable `vhdl-compiler'. Currently supported are | |
1402 | `cadence', `ikos', `quickhdl', `synopsys', `vantage', `viewlogic', and | |
1403 | `v-system'. Not all compilers are tested. Please contact me for | |
1404 | incorporating additional VHDL compilers. An entire hierarchy of source | |
1405 | files can be compiled by the `make' command (menu, `\\[vhdl-make]'). | |
1406 | This only works if an appropriate `Makefile' exists. Compiler options can | |
1407 | be defined by variable `vhdl-compiler-options'. | |
1408 | ||
1409 | - KEYWORD CASE: Lower and upper case for keywords, predefined types, predefined | |
1410 | attributes, and predefined enumeration values is supported. If the variable | |
1411 | `vhdl-upper-case-keywords' is set to non-nil, keywords can be typed in | |
1412 | lower case and are converted into upper case automatically (not for types, | |
1413 | attributes, and enumeration values). The case of keywords, types, | |
1414 | attributes, and enumeration values can be fixed for an entire region (menu) | |
1415 | or buffer (`\\[vhdl-fix-case-buffer]') according to the variables | |
1416 | `vhdl-upper-case-{keywords,types,attributes,enum-values}'. | |
1417 | ||
1418 | - HIGHLIGHTING (fontification): Keywords, predefined types, predefined | |
1419 | attributes, and predefined enumeration values (controlled by variable | |
1420 | `vhdl-highlight-keywords'), as well as comments, strings, and template | |
1421 | prompts are highlighted using different colors. Unit and subprogram names | |
1422 | as well as labels are highlighted if variable `vhdl-highlight-names' is | |
1423 | non-nil. The default colors from `font-lock.el' are used if variable | |
2f402702 | 1424 | `vhdl-customize-colors' is nil. Otherwise, an optimized set of colors |
d2ddb974 | 1425 | is taken, which uses bright colors for signals and muted colors for |
2f402702 | 1426 | everything else. Variable `vhdl-customize-faces' does the same on |
d2ddb974 KH |
1427 | monochrome monitors. |
1428 | ||
1429 | Signal highlighting allows distinction between clock, reset, | |
1430 | status/control, data, and test signals according to some signal | |
1431 | naming convention. Their syntax is defined by variables | |
1432 | `vhdl-{clock,reset,control,data,test}-signal-syntax'. Signal coloring | |
1433 | is controlled by the variable `vhdl-highlight-signals'. The default | |
1434 | signal naming convention is as follows: | |
1435 | ||
1436 | Signal attributes: | |
1437 | C clock S control and status | |
1438 | R asynchronous reset D data and address | |
1439 | I synchronous reset T test | |
1440 | ||
1441 | Syntax: | |
1442 | signal name ::= \"[A-Z][a-zA-Z0-9]*x[CRISDT][a-zA-Z0-9]*\" | |
1443 | signal identifier -^^^^^^^^^^^^^^^^^ | |
1444 | delimiter --------------------------^ | |
1445 | above signal attributes -------------^^^^^^^^ | |
1446 | additional attributes -----------------------^^^^^^^^^^^^ | |
1447 | ||
1448 | (`x' is used as delimiter because `_' is reserved by the VITAL standard.) | |
1449 | Examples: ClkxCfast, ResetxRB, ClearxI, SelectDataxS, DataxD, ScanEnablexT. | |
1450 | ||
1451 | If all VHDL words are written in lower case (i.e. variables | |
1452 | `vhdl-upper-case-{keywords,types,attributes,enum-values}' are set to nil), | |
1453 | make highlighting case sensitive by setting variable | |
1454 | `vhdl-highlight-case-sensitive' to non-nil. This way, only names fulfilling | |
1455 | the above signal syntax including case are highlighted. | |
1456 | ||
1457 | - HIDE/SHOW: The code of entire VHDL processes or blocks can be hidden using | |
1458 | the `Hide/Show' menu or by pressing `S-mouse-2' within the code | |
1459 | (not in XEmacs). | |
1460 | ||
1461 | - PRINTING: Postscript printing with different fonts (`ps-print-color-p' is | |
2f402702 RS |
1462 | nil, default faces from `font-lock.el' used if `vhdl-customize-faces' is |
1463 | nil) or colors (`ps-print-color-p' is non-nil) is possible using the | |
d2ddb974 KH |
1464 | standard Emacs postscript printing commands. Variable `vhdl-print-two-column' |
1465 | defines appropriate default settings for nice landscape two-column printing. | |
1466 | The paper format can be set by variable `ps-paper-type'. | |
1467 | ||
1468 | - CUSTOMIZATION: All variables can easily be customized using the `Customize' | |
1469 | menu entry. For some variables, customization only takes effect after | |
1470 | re-starting Emacs. Customization can also be done globally (i.e. site-wide, | |
1471 | read INSTALL file). Variables of VHDL Mode must NOT be set using the | |
1472 | `vhdl-mode-hook' in the .emacs file anymore (delete them if they still are). | |
1473 | ||
1474 | ||
1475 | Maintenance: | |
1476 | ------------ | |
1477 | ||
1478 | To submit a bug report, enter `\\[vhdl-submit-bug-report]' within VHDL Mode. | |
1479 | Add a description of the problem and include a reproducible test case. | |
1480 | ||
1481 | Questions and enhancement requests can be sent to <vhdl-mode@geocities.com>. | |
1482 | ||
1483 | The `vhdl-mode-announce' mailing list informs about new VHDL Mode releases. | |
1484 | The `vhdl-mode-victims' mailing list informs about new VHDL Mode beta releases. | |
1485 | You are kindly invited to participate in beta testing. Subscribe to above | |
1486 | mailing lists by sending an email to <vhdl-mode@geocities.com>. | |
1487 | ||
1488 | The archive with the latest version is located at | |
1489 | <http://www.geocities.com/SiliconValley/Peaks/8287>. | |
1490 | ||
1491 | ||
1492 | Bugs and Limitations: | |
1493 | --------------------- | |
1494 | ||
1495 | - Index menu does not work under XEmacs (limitation of XEmacs ?!). | |
1496 | ||
1497 | - Re-indenting large regions or expressions can be slow. | |
1498 | ||
1499 | - Hideshow does not work under XEmacs. | |
1500 | ||
1501 | - Parsing compilation error messages for Ikos and Vantage VHDL compilers | |
1502 | does not work under XEmacs. | |
1503 | ||
1504 | ||
1505 | Key bindings: | |
1506 | ------------- | |
1507 | ||
1508 | \\{vhdl-mode-map}" | |
1509 | (interactive) | |
1510 | (kill-all-local-variables) | |
1511 | (set-syntax-table vhdl-mode-syntax-table) | |
1512 | (setq major-mode 'vhdl-mode) | |
1513 | (setq mode-name "VHDL") | |
1514 | (setq local-abbrev-table vhdl-mode-abbrev-table) | |
1515 | (use-local-map vhdl-mode-map) | |
1516 | ;; set local variable values | |
1517 | (set (make-local-variable 'paragraph-start) "\\s-*\\(---\\|[a-zA-Z]\\|$\\)") | |
1518 | (set (make-local-variable 'paragraph-separate) paragraph-start) | |
1519 | (set (make-local-variable 'paragraph-ignore-fill-prefix) t) | |
1520 | (set (make-local-variable 'require-final-newline) t) | |
1521 | (set (make-local-variable 'parse-sexp-ignore-comments) t) | |
1522 | (set (make-local-variable 'indent-line-function) 'vhdl-indent-line) | |
1523 | (set (make-local-variable 'comment-start) "--") | |
1524 | (set (make-local-variable 'comment-end) "") | |
1525 | (set (make-local-variable 'comment-column) vhdl-comment-column) | |
1526 | (set (make-local-variable 'end-comment-column) vhdl-end-comment-column) | |
1527 | (set (make-local-variable 'comment-start-skip) "--+\\s-*") | |
1528 | (set (make-local-variable 'dabbrev-case-fold-search) nil) | |
1529 | (set (make-local-variable 'indent-tabs-mode) vhdl-indent-tabs-mode) | |
1530 | ||
1531 | ;; setup the comment indent variable in a Emacs version portable way | |
1532 | ;; ignore any byte compiler warnings you might get here | |
1533 | (if (boundp 'comment-indent-function) | |
1534 | (progn (make-local-variable 'comment-indent-function) | |
1535 | (setq comment-indent-function 'vhdl-comment-indent))) | |
1536 | ||
1537 | ;; initialize font locking | |
1538 | (require 'font-lock) | |
1539 | (vhdl-font-lock-init) | |
1540 | (make-local-variable 'font-lock-defaults) | |
1541 | (setq font-lock-defaults (list 'vhdl-font-lock-keywords nil | |
1542 | (not vhdl-highlight-case-sensitive) | |
1543 | '((?\_ . "w")))) | |
1544 | (turn-on-font-lock) | |
1545 | ||
1546 | ;; variables for source file compilation | |
1547 | (make-local-variable 'compile-command) | |
1548 | (set (make-local-variable 'compilation-error-regexp-alist) | |
1549 | vhdl-compilation-error-regexp-alist) | |
1550 | ||
1551 | ;; add menus | |
1552 | (if vhdl-index-menu | |
1553 | (if (or (not (consp font-lock-maximum-size)) | |
1554 | (> font-lock-maximum-size (buffer-size))) | |
1555 | (vhdl-add-index-menu) | |
1556 | (message "Scanning buffer for index...buffer too big"))) | |
1557 | (if vhdl-source-file-menu (vhdl-add-source-files-menu)) | |
1558 | (easy-menu-add vhdl-mode-menu) | |
1559 | (easy-menu-define vhdl-mode-easy-menu vhdl-mode-map | |
1560 | "Menu keymap for VHDL Mode." vhdl-mode-menu) | |
1561 | (run-hooks 'menu-bar-update-hook) | |
1562 | ||
1563 | ;; initialize hideshow and add menu | |
1564 | (if vhdl-hideshow-menu (hs-minor-mode)) | |
1565 | ||
1566 | ;; initialize postscript printing | |
1567 | (vhdl-ps-init) | |
1568 | ||
1569 | (setq mode-name (if vhdl-electric-mode "Electric VHDL" "VHDL")) | |
1570 | (message "Type C-c C-h for VHDL Mode documentation.") | |
1571 | ||
1572 | (run-hooks 'vhdl-mode-hook) | |
1573 | ) | |
1574 | ||
1575 | ||
1576 | ;; ############################################################################ | |
1577 | ;; Keywords and predefined words in VHDL'93 | |
1578 | ;; ############################################################################ | |
1579 | ||
1580 | ;; `regexp-opt' was not used at this place because it is not yet implemented | |
1581 | ;; in XEmacs and because it resulted in SLOWER regexps!! | |
1582 | ||
1583 | (defconst vhdl-93-keywords-regexp | |
1584 | (eval-when-compile | |
1585 | (concat | |
1586 | "\\<\\(" | |
1587 | (mapconcat | |
1588 | 'identity | |
1589 | '( | |
1590 | "abs" "access" "after" "alias" "all" "and" "architecture" "array" | |
1591 | "assert" "attribute" | |
1592 | "begin" "block" "body" "buffer" "bus" | |
1593 | "case" "component" "configuration" "constant" | |
1594 | "disconnect" "downto" | |
1595 | "else" "elsif" "end" "entity" "exit" | |
1596 | "file" "for" "function" | |
1597 | "generate" "generic" "group" "guarded" | |
1598 | "if" "impure" "in" "inertial" "inout" "is" | |
1599 | "label" "library" "linkage" "literal" "loop" | |
1600 | "map" "mod" | |
1601 | "nand" "new" "next" "nor" "not" "null" | |
1602 | "of" "on" "open" "or" "others" "out" | |
1603 | "package" "port" "postponed" "procedure" "process" "pure" | |
1604 | "range" "record" "register" "reject" "rem" "report" "return" | |
1605 | "rol" "ror" | |
1606 | "select" "severity" "shared" "signal" "sla" "sll" "sra" "srl" "subtype" | |
1607 | "then" "to" "transport" "type" | |
1608 | "unaffected" "units" "until" "use" | |
1609 | "variable" | |
1610 | "wait" "warning" "when" "while" "with" | |
1611 | "xnor" "xor" | |
1612 | ) | |
1613 | "\\|") | |
1614 | "\\)\\>")) | |
1615 | "Regexp for VHDL'93 keywords.") | |
1616 | ||
1617 | (defconst vhdl-93-types-regexp | |
1618 | (eval-when-compile | |
1619 | (concat | |
1620 | "\\<\\(" | |
1621 | (mapconcat | |
1622 | 'identity | |
1623 | '( | |
1624 | "boolean" "bit" "bit_vector" "character" "severity_level" "integer" | |
1625 | "real" "time" "natural" "positive" "string" "text" "line" | |
1626 | "unsigned" "signed" | |
1627 | "std_logic" "std_logic_vector" | |
1628 | "std_ulogic" "std_ulogic_vector" | |
1629 | ) | |
1630 | "\\|") | |
1631 | "\\)\\>")) | |
1632 | "Regexp for VHDL'93 standardized types.") | |
1633 | ||
1634 | (defconst vhdl-93-attributes-regexp | |
1635 | (eval-when-compile | |
1636 | (concat | |
1637 | "\\<\\(" | |
1638 | (mapconcat | |
1639 | 'identity | |
1640 | '( | |
1641 | "base" "left" "right" "high" "low" "pos" "val" "succ" | |
1642 | "pred" "leftof" "rightof" "range" "reverse_range" | |
1643 | "length" "delayed" "stable" "quiet" "transaction" | |
1644 | "event" "active" "last_event" "last_active" "last_value" | |
1645 | "driving" "driving_value" "ascending" "value" "image" | |
1646 | "simple_name" "instance_name" "path_name" | |
1647 | "foreign" | |
1648 | ) | |
1649 | "\\|") | |
1650 | "\\)\\>")) | |
1651 | "Regexp for VHDL'93 standardized attributes.") | |
1652 | ||
1653 | (defconst vhdl-93-enum-values-regexp | |
1654 | (eval-when-compile | |
1655 | (concat | |
1656 | "\\<\\(" | |
1657 | (mapconcat | |
1658 | 'identity | |
1659 | '( | |
1660 | "true" "false" | |
1661 | "note" "warning" "error" "failure" | |
1662 | "fs" "ps" "ns" "us" "ms" "sec" "min" "hr" | |
1663 | ) | |
1664 | "\\|") | |
1665 | "\\)\\>")) | |
1666 | "Regexp for VHDL'93 standardized enumeration values.") | |
1667 | ||
1668 | ||
1669 | ;; ############################################################################ | |
1670 | ;; Syntax analysis and indentation | |
1671 | ;; ############################################################################ | |
1672 | ||
1673 | ;; ############################################################################ | |
1674 | ;; Syntax analysis | |
1675 | ||
1676 | ;; constant regular expressions for looking at various constructs | |
1677 | ||
1678 | (defconst vhdl-symbol-key "\\(\\w\\|\\s_\\)+" | |
1679 | "Regexp describing a VHDL symbol. | |
1680 | We cannot use just `word' syntax class since `_' cannot be in word | |
1681 | class. Putting underscore in word class breaks forward word movement | |
1682 | behavior that users are familiar with.") | |
1683 | ||
1684 | (defconst vhdl-case-header-key "case[( \t\n][^;=>]+[) \t\n]is" | |
1685 | "Regexp describing a case statement header key.") | |
1686 | ||
1687 | (defconst vhdl-label-key | |
1688 | (concat "\\(" vhdl-symbol-key "\\s-*:\\)[^=]") | |
1689 | "Regexp describing a VHDL label.") | |
1690 | ||
1691 | ;; Macro definitions: | |
1692 | ||
1693 | (defmacro vhdl-point (position) | |
1694 | ;; Returns the value of point at certain commonly referenced POSITIONs. | |
1695 | ;; POSITION can be one of the following symbols: | |
1696 | ;; | |
1697 | ;; bol -- beginning of line | |
1698 | ;; eol -- end of line | |
1699 | ;; bod -- beginning of defun | |
1700 | ;; boi -- back to indentation | |
1701 | ;; eoi -- last whitespace on line | |
1702 | ;; ionl -- indentation of next line | |
1703 | ;; iopl -- indentation of previous line | |
1704 | ;; bonl -- beginning of next line | |
1705 | ;; bopl -- beginning of previous line | |
1706 | ;; | |
1707 | ;; This function does not modify point or mark. | |
1708 | (or (and (eq 'quote (car-safe position)) | |
1709 | (null (cdr (cdr position)))) | |
1710 | (error "bad buffer position requested: %s" position)) | |
1711 | (setq position (nth 1 position)) | |
1712 | (` (let ((here (point))) | |
1713 | (,@ (cond | |
1714 | ((eq position 'bol) '((beginning-of-line))) | |
1715 | ((eq position 'eol) '((end-of-line))) | |
1716 | ((eq position 'bod) '((save-match-data | |
1717 | (vhdl-beginning-of-defun)))) | |
1718 | ((eq position 'boi) '((back-to-indentation))) | |
1719 | ((eq position 'eoi) '((end-of-line)(skip-chars-backward " \t"))) | |
1720 | ((eq position 'bonl) '((forward-line 1))) | |
1721 | ((eq position 'bopl) '((forward-line -1))) | |
1722 | ((eq position 'iopl) | |
1723 | '((forward-line -1) | |
1724 | (back-to-indentation))) | |
1725 | ((eq position 'ionl) | |
1726 | '((forward-line 1) | |
1727 | (back-to-indentation))) | |
1728 | (t (error "unknown buffer position requested: %s" position)) | |
1729 | )) | |
1730 | (prog1 | |
1731 | (point) | |
1732 | (goto-char here)) | |
1733 | ;; workaround for an Emacs18 bug -- blech! Well, at least it | |
1734 | ;; doesn't hurt for v19 | |
1735 | (,@ nil) | |
1736 | ))) | |
1737 | ||
1738 | (defmacro vhdl-safe (&rest body) | |
1739 | ;; safely execute BODY, return nil if an error occurred | |
1740 | (` (condition-case nil | |
1741 | (progn (,@ body)) | |
1742 | (error nil)))) | |
1743 | ||
1744 | (defmacro vhdl-add-syntax (symbol &optional relpos) | |
1745 | ;; a simple macro to append the syntax in symbol to the syntax list. | |
1746 | ;; try to increase performance by using this macro | |
1747 | (` (setq vhdl-syntactic-context | |
1748 | (cons (cons (, symbol) (, relpos)) vhdl-syntactic-context)))) | |
1749 | ||
1750 | (defmacro vhdl-has-syntax (symbol) | |
1751 | ;; a simple macro to return check the syntax list. | |
1752 | ;; try to increase performance by using this macro | |
1753 | (` (assoc (, symbol) vhdl-syntactic-context))) | |
1754 | ||
1755 | ;; Syntactic element offset manipulation: | |
1756 | ||
1757 | (defun vhdl-read-offset (langelem) | |
1758 | ;; read new offset value for LANGELEM from minibuffer. return a | |
1759 | ;; legal value only | |
1760 | (let ((oldoff (format "%s" (cdr-safe (assq langelem vhdl-offsets-alist)))) | |
1761 | (errmsg "Offset must be int, func, var, or one of +, -, ++, --: ") | |
1762 | (prompt "Offset: ") | |
1763 | offset input interned) | |
1764 | (while (not offset) | |
1765 | (setq input (read-string prompt oldoff) | |
1766 | offset (cond ((string-equal "+" input) '+) | |
1767 | ((string-equal "-" input) '-) | |
1768 | ((string-equal "++" input) '++) | |
1769 | ((string-equal "--" input) '--) | |
1770 | ((string-match "^-?[0-9]+$" input) | |
1771 | (string-to-int input)) | |
1772 | ((fboundp (setq interned (intern input))) | |
1773 | interned) | |
1774 | ((boundp interned) interned) | |
1775 | ;; error, but don't signal one, keep trying | |
1776 | ;; to read an input value | |
1777 | (t (ding) | |
1778 | (setq prompt errmsg) | |
1779 | nil)))) | |
1780 | offset)) | |
1781 | ||
1782 | (defun vhdl-set-offset (symbol offset &optional add-p) | |
1783 | "Change the value of a syntactic element symbol in `vhdl-offsets-alist'. | |
1784 | SYMBOL is the syntactic element symbol to change and OFFSET is the new | |
1785 | offset for that syntactic element. Optional ADD says to add SYMBOL to | |
1786 | `vhdl-offsets-alist' if it doesn't already appear there." | |
1787 | (interactive | |
1788 | (let* ((langelem | |
1789 | (intern (completing-read | |
1790 | (concat "Syntactic symbol to change" | |
1791 | (if current-prefix-arg " or add" "") | |
1792 | ": ") | |
1793 | (mapcar | |
1794 | (function | |
1795 | (lambda (langelem) | |
1796 | (cons (format "%s" (car langelem)) nil))) | |
1797 | vhdl-offsets-alist) | |
1798 | nil (not current-prefix-arg) | |
1799 | ;; initial contents tries to be the last element | |
1800 | ;; on the syntactic analysis list for the current | |
1801 | ;; line | |
1802 | (let* ((syntax (vhdl-get-syntactic-context)) | |
1803 | (len (length syntax)) | |
1804 | (ic (format "%s" (car (nth (1- len) syntax))))) | |
1805 | (if (memq 'v19 vhdl-emacs-features) | |
1806 | (cons ic 0) | |
1807 | ic)) | |
1808 | ))) | |
1809 | (offset (vhdl-read-offset langelem))) | |
1810 | (list langelem offset current-prefix-arg))) | |
1811 | ;; sanity check offset | |
1812 | (or (eq offset '+) | |
1813 | (eq offset '-) | |
1814 | (eq offset '++) | |
1815 | (eq offset '--) | |
1816 | (integerp offset) | |
1817 | (fboundp offset) | |
1818 | (boundp offset) | |
1819 | (error "Offset must be int, func, var, or one of +, -, ++, --: %s" | |
1820 | offset)) | |
1821 | (let ((entry (assq symbol vhdl-offsets-alist))) | |
1822 | (if entry | |
1823 | (setcdr entry offset) | |
1824 | (if add-p | |
1825 | (setq vhdl-offsets-alist (cons (cons symbol offset) vhdl-offsets-alist)) | |
1826 | (error "%s is not a valid syntactic symbol." symbol)))) | |
1827 | (vhdl-keep-region-active)) | |
1828 | ||
1829 | (defun vhdl-set-style (style &optional local) | |
1830 | "Set vhdl-mode variables to use one of several different indentation styles. | |
1831 | STYLE is a string representing the desired style and optional LOCAL is | |
1832 | a flag which, if non-nil, means to make the style variables being | |
1833 | changed buffer local, instead of the default, which is to set the | |
1834 | global variables. Interactively, the flag comes from the prefix | |
1835 | argument. The styles are chosen from the `vhdl-style-alist' variable." | |
1836 | (interactive (list (completing-read "Use which VHDL indentation style? " | |
1837 | vhdl-style-alist nil t) | |
1838 | current-prefix-arg)) | |
1839 | (let ((vars (cdr (assoc style vhdl-style-alist)))) | |
1840 | (or vars | |
1841 | (error "Invalid VHDL indentation style `%s'" style)) | |
1842 | ;; set all the variables | |
1843 | (mapcar | |
1844 | (function | |
1845 | (lambda (varentry) | |
1846 | (let ((var (car varentry)) | |
1847 | (val (cdr varentry))) | |
1848 | (and local | |
1849 | (make-local-variable var)) | |
1850 | ;; special case for vhdl-offsets-alist | |
1851 | (if (not (eq var 'vhdl-offsets-alist)) | |
1852 | (set var val) | |
1853 | ;; reset vhdl-offsets-alist to the default value first | |
1854 | (setq vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default)) | |
1855 | ;; now set the langelems that are different | |
1856 | (mapcar | |
1857 | (function | |
1858 | (lambda (langentry) | |
1859 | (let ((langelem (car langentry)) | |
1860 | (offset (cdr langentry))) | |
1861 | (vhdl-set-offset langelem offset) | |
1862 | ))) | |
1863 | val)) | |
1864 | ))) | |
1865 | vars)) | |
1866 | (vhdl-keep-region-active)) | |
1867 | ||
1868 | (defun vhdl-get-offset (langelem) | |
1869 | ;; Get offset from LANGELEM which is a cons cell of the form: | |
1870 | ;; (SYMBOL . RELPOS). The symbol is matched against | |
1871 | ;; vhdl-offsets-alist and the offset found there is either returned, | |
1872 | ;; or added to the indentation at RELPOS. If RELPOS is nil, then | |
1873 | ;; the offset is simply returned. | |
1874 | (let* ((symbol (car langelem)) | |
1875 | (relpos (cdr langelem)) | |
1876 | (match (assq symbol vhdl-offsets-alist)) | |
1877 | (offset (cdr-safe match))) | |
1878 | ;; offset can be a number, a function, a variable, or one of the | |
1879 | ;; symbols + or - | |
1880 | (cond | |
1881 | ((not match) | |
1882 | (if vhdl-strict-syntax-p | |
1883 | (error "don't know how to indent a %s" symbol) | |
1884 | (setq offset 0 | |
1885 | relpos 0))) | |
1886 | ((eq offset '+) (setq offset vhdl-basic-offset)) | |
1887 | ((eq offset '-) (setq offset (- vhdl-basic-offset))) | |
1888 | ((eq offset '++) (setq offset (* 2 vhdl-basic-offset))) | |
1889 | ((eq offset '--) (setq offset (* 2 (- vhdl-basic-offset)))) | |
1890 | ((and (not (numberp offset)) | |
1891 | (fboundp offset)) | |
1892 | (setq offset (funcall offset langelem))) | |
1893 | ((not (numberp offset)) | |
1894 | (setq offset (eval offset))) | |
1895 | ) | |
1896 | (+ (if (and relpos | |
1897 | (< relpos (vhdl-point 'bol))) | |
1898 | (save-excursion | |
1899 | (goto-char relpos) | |
1900 | (current-column)) | |
1901 | 0) | |
1902 | offset))) | |
1903 | ||
1904 | ;; Syntactic support functions: | |
1905 | ||
1906 | ;; Returns `comment' if in a comment, `string' if in a string literal, | |
1907 | ;; or nil if not in a literal at all. Optional LIM is used as the | |
1908 | ;; backward limit of the search. If omitted, or nil, (point-min) is | |
1909 | ;; used. | |
1910 | ||
1911 | (defun vhdl-in-literal (&optional lim) | |
1912 | ;; Determine if point is in a VHDL literal. | |
1913 | (save-excursion | |
1914 | (let* ((lim (or lim (point-min))) | |
1915 | (state (parse-partial-sexp lim (point)))) | |
1916 | (cond | |
1917 | ((nth 3 state) 'string) | |
1918 | ((nth 4 state) 'comment) | |
1919 | (t nil))) | |
1920 | )) | |
1921 | ||
1922 | ;; This is the best we can do in Win-Emacs. | |
1923 | (defun vhdl-win-il (&optional lim) | |
1924 | ;; Determine if point is in a VHDL literal | |
1925 | (save-excursion | |
1926 | (let* ((here (point)) | |
1927 | (state nil) | |
1928 | (match nil) | |
1929 | (lim (or lim (vhdl-point 'bod)))) | |
1930 | (goto-char lim ) | |
1931 | (while (< (point) here) | |
1932 | (setq match | |
1933 | (and (re-search-forward "--\\|[\"']" | |
1934 | here 'move) | |
1935 | (buffer-substring (match-beginning 0) (match-end 0)))) | |
1936 | (setq state | |
1937 | (cond | |
1938 | ;; no match | |
1939 | ((null match) nil) | |
1940 | ;; looking at the opening of a VHDL style comment | |
1941 | ((string= "--" match) | |
1942 | (if (<= here (progn (end-of-line) (point))) 'comment)) | |
1943 | ;; looking at the opening of a double quote string | |
1944 | ((string= "\"" match) | |
1945 | (if (not (save-restriction | |
1946 | ;; this seems to be necessary since the | |
1947 | ;; re-search-forward will not work without it | |
1948 | (narrow-to-region (point) here) | |
1949 | (re-search-forward | |
1950 | ;; this regexp matches a double quote | |
1951 | ;; which is preceded by an even number | |
1952 | ;; of backslashes, including zero | |
1953 | "\\([^\\]\\|^\\)\\(\\\\\\\\\\)*\"" here 'move))) | |
1954 | 'string)) | |
1955 | ;; looking at the opening of a single quote string | |
1956 | ((string= "'" match) | |
1957 | (if (not (save-restriction | |
1958 | ;; see comments from above | |
1959 | (narrow-to-region (point) here) | |
1960 | (re-search-forward | |
1961 | ;; this matches a single quote which is | |
1962 | ;; preceded by zero or two backslashes. | |
1963 | "\\([^\\]\\|^\\)\\(\\\\\\\\\\)?'" | |
1964 | here 'move))) | |
1965 | 'string)) | |
1966 | (t nil))) | |
1967 | ) ; end-while | |
1968 | state))) | |
1969 | ||
1970 | (and (memq 'Win-Emacs vhdl-emacs-features) | |
1971 | (fset 'vhdl-in-literal 'vhdl-win-il)) | |
1972 | ||
1973 | ;; Skipping of "syntactic whitespace". Syntactic whitespace is | |
1974 | ;; defined as lexical whitespace or comments. Search no farther back | |
1975 | ;; or forward than optional LIM. If LIM is omitted, (point-min) is | |
1976 | ;; used for backward skipping, (point-max) is used for forward | |
1977 | ;; skipping. | |
1978 | ||
1979 | (defun vhdl-forward-syntactic-ws (&optional lim) | |
1980 | ;; Forward skip of syntactic whitespace. | |
1981 | (save-restriction | |
1982 | (let* ((lim (or lim (point-max))) | |
1983 | (here lim) | |
1984 | (hugenum (point-max))) | |
1985 | (narrow-to-region lim (point)) | |
1986 | (while (/= here (point)) | |
1987 | (setq here (point)) | |
1988 | (forward-comment hugenum)) | |
1989 | ))) | |
1990 | ||
1991 | ;; This is the best we can do in Win-Emacs. | |
1992 | (defun vhdl-win-fsws (&optional lim) | |
1993 | ;; Forward skip syntactic whitespace for Win-Emacs. | |
1994 | (let ((lim (or lim (point-max))) | |
1995 | stop) | |
1996 | (while (not stop) | |
1997 | (skip-chars-forward " \t\n\r\f" lim) | |
1998 | (cond | |
1999 | ;; vhdl comment | |
2000 | ((looking-at "--") (end-of-line)) | |
2001 | ;; none of the above | |
2002 | (t (setq stop t)) | |
2003 | )))) | |
2004 | ||
2005 | (and (memq 'Win-Emacs vhdl-emacs-features) | |
2006 | (fset 'vhdl-forward-syntactic-ws 'vhdl-win-fsws)) | |
2007 | ||
2008 | (defun vhdl-backward-syntactic-ws (&optional lim) | |
2009 | ;; Backward skip over syntactic whitespace. | |
2010 | (save-restriction | |
2011 | (let* ((lim (or lim (point-min))) | |
2012 | (here lim) | |
2013 | (hugenum (- (point-max)))) | |
2014 | (if (< lim (point)) | |
2015 | (progn | |
2016 | (narrow-to-region lim (point)) | |
2017 | (while (/= here (point)) | |
2018 | (setq here (point)) | |
2019 | (forward-comment hugenum) | |
2020 | ))) | |
2021 | ))) | |
2022 | ||
2023 | ;; This is the best we can do in Win-Emacs. | |
2024 | (defun vhdl-win-bsws (&optional lim) | |
2025 | ;; Backward skip syntactic whitespace for Win-Emacs. | |
2026 | (let ((lim (or lim (vhdl-point 'bod))) | |
2027 | stop) | |
2028 | (while (not stop) | |
2029 | (skip-chars-backward " \t\n\r\f" lim) | |
2030 | (cond | |
2031 | ;; vhdl comment | |
2032 | ((eq (vhdl-in-literal lim) 'comment) | |
2033 | (skip-chars-backward "^-" lim) | |
2034 | (skip-chars-backward "-" lim) | |
2035 | (while (not (or (and (= (following-char) ?-) | |
2036 | (= (char-after (1+ (point))) ?-)) | |
2037 | (<= (point) lim))) | |
2038 | (skip-chars-backward "^-" lim) | |
2039 | (skip-chars-backward "-" lim))) | |
2040 | ;; none of the above | |
2041 | (t (setq stop t)) | |
2042 | )))) | |
2043 | ||
2044 | (and (memq 'Win-Emacs vhdl-emacs-features) | |
2045 | (fset 'vhdl-backward-syntactic-ws 'vhdl-win-bsws)) | |
2046 | ||
2047 | ;; Functions to help finding the correct indentation column: | |
2048 | ||
2049 | (defun vhdl-first-word (point) | |
2050 | "If the keyword at POINT is at boi, then return (current-column) at | |
2051 | that point, else nil." | |
2052 | (save-excursion | |
2053 | (and (goto-char point) | |
2054 | (eq (point) (vhdl-point 'boi)) | |
2055 | (current-column)))) | |
2056 | ||
2057 | (defun vhdl-last-word (point) | |
2058 | "If the keyword at POINT is at eoi, then return (current-column) at | |
2059 | that point, else nil." | |
2060 | (save-excursion | |
2061 | (and (goto-char point) | |
2062 | (save-excursion (or (eq (progn (forward-sexp) (point)) | |
2063 | (vhdl-point 'eoi)) | |
2064 | (looking-at "\\s-*\\(--\\)?"))) | |
2065 | (current-column)))) | |
2066 | ||
2067 | ;; Core syntactic evaluation functions: | |
2068 | ||
2069 | (defconst vhdl-libunit-re | |
2070 | "\\b\\(architecture\\|configuration\\|entity\\|package\\)\\b[^_]") | |
2071 | ||
2072 | (defun vhdl-libunit-p () | |
2073 | (and | |
2074 | (save-excursion | |
2075 | (forward-sexp) | |
2076 | (skip-chars-forward " \t\n") | |
2077 | (not (looking-at "is\\b[^_]"))) | |
2078 | (save-excursion | |
2079 | (backward-sexp) | |
2080 | (and (not (looking-at "use\\b[^_]")) | |
2081 | (progn | |
2082 | (forward-sexp) | |
2083 | (vhdl-forward-syntactic-ws) | |
2084 | (/= (following-char) ?:)))) | |
2085 | )) | |
2086 | ||
2087 | (defconst vhdl-defun-re | |
2088 | "\\b\\(architecture\\|block\\|configuration\\|entity\\|package\\|process\\|procedure\\|function\\)\\b[^_]") | |
2089 | ||
2090 | (defun vhdl-defun-p () | |
2091 | (save-excursion | |
2092 | (if (looking-at "block\\|process") | |
2093 | ;; "block", "process": | |
2094 | (save-excursion | |
2095 | (backward-sexp) | |
2096 | (not (looking-at "end\\s-+\\w"))) | |
2097 | ;; "architecture", "configuration", "entity", | |
2098 | ;; "package", "procedure", "function": | |
2099 | t))) | |
2100 | ||
2101 | (defun vhdl-corresponding-defun () | |
2102 | "If the word at the current position corresponds to a \"defun\" | |
2103 | keyword, then return a string that can be used to find the | |
2104 | corresponding \"begin\" keyword, else return nil." | |
2105 | (save-excursion | |
2106 | (and (looking-at vhdl-defun-re) | |
2107 | (vhdl-defun-p) | |
2108 | (if (looking-at "block\\|process") | |
2109 | ;; "block", "process": | |
2110 | (buffer-substring (match-beginning 0) (match-end 0)) | |
2111 | ;; "architecture", "configuration", "entity", "package", | |
2112 | ;; "procedure", "function": | |
2113 | "is")))) | |
2114 | ||
2115 | (defconst vhdl-begin-fwd-re | |
2116 | "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|units\\|record\\|for\\)\\b\\([^_]\\|\\'\\)" | |
2117 | "A regular expression for searching forward that matches all known | |
2118 | \"begin\" keywords.") | |
2119 | ||
2120 | (defconst vhdl-begin-bwd-re | |
2121 | "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|units\\|record\\|for\\)\\b[^_]" | |
2122 | "A regular expression for searching backward that matches all known | |
2123 | \"begin\" keywords.") | |
2124 | ||
2125 | (defun vhdl-begin-p (&optional lim) | |
2126 | "Return t if we are looking at a real \"begin\" keyword. | |
2127 | Assumes that the caller will make sure that we are looking at | |
2128 | vhdl-begin-fwd-re, and are not inside a literal, and that we are not in | |
2129 | the middle of an identifier that just happens to contain a \"begin\" | |
2130 | keyword." | |
2131 | (cond | |
2132 | ;; "[architecture|case|configuration|entity|package| | |
2133 | ;; procedure|function] ... is": | |
2134 | ((and (looking-at "i") | |
2135 | (save-excursion | |
2136 | ;; Skip backward over first sexp (needed to skip over a | |
2137 | ;; procedure interface list, and is harmless in other | |
2138 | ;; situations). Note that we need "return" in the | |
2139 | ;; following search list so that we don't run into | |
2140 | ;; semicolons in the function interface list. | |
2141 | (backward-sexp) | |
2142 | (let (foundp) | |
2143 | (while (and (not foundp) | |
2144 | (re-search-backward | |
2145 | ";\\|\\b\\(architecture\\|case\\|configuration\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|block\\)\\b[^_]" | |
2146 | lim 'move)) | |
2147 | (if (or (= (preceding-char) ?_) | |
2148 | (vhdl-in-literal lim)) | |
2149 | (backward-char) | |
2150 | (setq foundp t)))) | |
2151 | (and (/= (following-char) ?\;) | |
2152 | (not (looking-at "is\\|begin\\|process\\|block"))))) | |
2153 | t) | |
2154 | ;; "begin", "then": | |
2155 | ((looking-at "be\\|t") | |
2156 | t) | |
2157 | ;; "else": | |
2158 | ((and (looking-at "e") | |
2159 | ;; make sure that the "else" isn't inside a | |
2160 | ;; conditional signal assignment. | |
2161 | (save-excursion | |
2162 | (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move) | |
2163 | (or (eq (following-char) ?\;) | |
2164 | (eq (point) lim)))) | |
2165 | t) | |
2166 | ;; "block", "generate", "loop", "process", | |
2167 | ;; "units", "record": | |
2168 | ((and (looking-at "bl\\|[glpur]") | |
2169 | (save-excursion | |
2170 | (backward-sexp) | |
2171 | (not (looking-at "end\\s-+\\w")))) | |
2172 | t) | |
2173 | ;; "component": | |
2174 | ((and (looking-at "c") | |
2175 | (save-excursion | |
2176 | (backward-sexp) | |
2177 | (not (looking-at "end\\s-+\\w"))) | |
2178 | ;; look out for the dreaded entity class in an attribute | |
2179 | (save-excursion | |
2180 | (vhdl-backward-syntactic-ws lim) | |
2181 | (/= (preceding-char) ?:))) | |
2182 | t) | |
2183 | ;; "for" (inside configuration declaration): | |
2184 | ((and (looking-at "f") | |
2185 | (save-excursion | |
2186 | (backward-sexp) | |
2187 | (not (looking-at "end\\s-+\\w"))) | |
2188 | (vhdl-has-syntax 'configuration)) | |
2189 | t) | |
2190 | )) | |
2191 | ||
2192 | (defun vhdl-corresponding-mid (&optional lim) | |
2193 | (cond | |
2194 | ((looking-at "is\\|block\\|process") | |
2195 | "begin") | |
2196 | ((looking-at "then") | |
2197 | "<else>") | |
2198 | (t | |
2199 | "end"))) | |
2200 | ||
2201 | (defun vhdl-corresponding-end (&optional lim) | |
2202 | "If the word at the current position corresponds to a \"begin\" | |
2203 | keyword, then return a vector containing enough information to find | |
2204 | the corresponding \"end\" keyword, else return nil. The keyword to | |
2205 | search forward for is aref 0. The column in which the keyword must | |
2206 | appear is aref 1 or nil if any column is suitable. | |
2207 | Assumes that the caller will make sure that we are not in the middle | |
2208 | of an identifier that just happens to contain a \"begin\" keyword." | |
2209 | (save-excursion | |
2210 | (and (looking-at vhdl-begin-fwd-re) | |
2211 | (/= (preceding-char) ?_) | |
2212 | (not (vhdl-in-literal lim)) | |
2213 | (vhdl-begin-p lim) | |
2214 | (cond | |
2215 | ;; "is", "generate", "loop": | |
2216 | ((looking-at "[igl]") | |
2217 | (vector "end" | |
2218 | (and (vhdl-last-word (point)) | |
2219 | (or (vhdl-first-word (point)) | |
2220 | (save-excursion | |
2221 | (vhdl-beginning-of-statement-1 lim) | |
2222 | (vhdl-backward-skip-label lim) | |
2223 | (vhdl-first-word (point))))))) | |
2224 | ;; "begin", "else", "for": | |
2225 | ((looking-at "be\\|[ef]") | |
2226 | (vector "end" | |
2227 | (and (vhdl-last-word (point)) | |
2228 | (or (vhdl-first-word (point)) | |
2229 | (save-excursion | |
2230 | (vhdl-beginning-of-statement-1 lim) | |
2231 | (vhdl-backward-skip-label lim) | |
2232 | (vhdl-first-word (point))))))) | |
2233 | ;; "component", "units", "record": | |
2234 | ((looking-at "[cur]") | |
2235 | ;; The first end found will close the block | |
2236 | (vector "end" nil)) | |
2237 | ;; "block", "process": | |
2238 | ((looking-at "bl\\|p") | |
2239 | (vector "end" | |
2240 | (or (vhdl-first-word (point)) | |
2241 | (save-excursion | |
2242 | (vhdl-beginning-of-statement-1 lim) | |
2243 | (vhdl-backward-skip-label lim) | |
2244 | (vhdl-first-word (point)))))) | |
2245 | ;; "then": | |
2246 | ((looking-at "t") | |
2247 | (vector "elsif\\|else\\|end\\s-+if" | |
2248 | (and (vhdl-last-word (point)) | |
2249 | (or (vhdl-first-word (point)) | |
2250 | (save-excursion | |
2251 | (vhdl-beginning-of-statement-1 lim) | |
2252 | (vhdl-backward-skip-label lim) | |
2253 | (vhdl-first-word (point))))))) | |
2254 | )))) | |
2255 | ||
2256 | (defconst vhdl-end-fwd-re "\\b\\(end\\|else\\|elsif\\)\\b\\([^_]\\|\\'\\)") | |
2257 | ||
2258 | (defconst vhdl-end-bwd-re "\\b\\(end\\|else\\|elsif\\)\\b[^_]") | |
2259 | ||
2260 | (defun vhdl-end-p (&optional lim) | |
2261 | "Return t if we are looking at a real \"end\" keyword. | |
2262 | Assumes that the caller will make sure that we are looking at | |
2263 | vhdl-end-fwd-re, and are not inside a literal, and that we are not in | |
2264 | the middle of an identifier that just happens to contain an \"end\" | |
2265 | keyword." | |
2266 | (or (not (looking-at "else")) | |
2267 | ;; make sure that the "else" isn't inside a conditional signal | |
2268 | ;; assignment. | |
2269 | (save-excursion | |
2270 | (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move) | |
2271 | (or (eq (following-char) ?\;) | |
2272 | (eq (point) lim))))) | |
2273 | ||
2274 | (defun vhdl-corresponding-begin (&optional lim) | |
2275 | "If the word at the current position corresponds to an \"end\" | |
2276 | keyword, then return a vector containing enough information to find | |
2277 | the corresponding \"begin\" keyword, else return nil. The keyword to | |
2278 | search backward for is aref 0. The column in which the keyword must | |
2279 | appear is aref 1 or nil if any column is suitable. The supplementary | |
2280 | keyword to search forward for is aref 2 or nil if this is not | |
2281 | required. If aref 3 is t, then the \"begin\" keyword may be found in | |
2282 | the middle of a statement. | |
2283 | Assumes that the caller will make sure that we are not in the middle | |
2284 | of an identifier that just happens to contain an \"end\" keyword." | |
2285 | (save-excursion | |
2286 | (let (pos) | |
2287 | (if (and (looking-at vhdl-end-fwd-re) | |
2288 | (not (vhdl-in-literal lim)) | |
2289 | (vhdl-end-p lim)) | |
2290 | (if (looking-at "el") | |
2291 | ;; "else", "elsif": | |
2292 | (vector "if\\|elsif" (vhdl-first-word (point)) "then" nil) | |
2293 | ;; "end ...": | |
2294 | (setq pos (point)) | |
2295 | (forward-sexp) | |
2296 | (skip-chars-forward " \t\n") | |
2297 | (cond | |
2298 | ;; "end if": | |
2299 | ((looking-at "if\\b[^_]") | |
2300 | (vector "else\\|elsif\\|if" | |
2301 | (vhdl-first-word pos) | |
2302 | "else\\|then" nil)) | |
2303 | ;; "end component": | |
2304 | ((looking-at "component\\b[^_]") | |
2305 | (vector (buffer-substring (match-beginning 1) | |
2306 | (match-end 1)) | |
2307 | (vhdl-first-word pos) | |
2308 | nil nil)) | |
2309 | ;; "end units", "end record": | |
2310 | ((looking-at "\\(units\\|record\\)\\b[^_]") | |
2311 | (vector (buffer-substring (match-beginning 1) | |
2312 | (match-end 1)) | |
2313 | (vhdl-first-word pos) | |
2314 | nil t)) | |
2315 | ;; "end block", "end process": | |
2316 | ((looking-at "\\(block\\|process\\)\\b[^_]") | |
2317 | (vector "begin" (vhdl-first-word pos) nil nil)) | |
2318 | ;; "end case": | |
2319 | ((looking-at "case\\b[^_]") | |
2320 | (vector "case" (vhdl-first-word pos) "is" nil)) | |
2321 | ;; "end generate": | |
2322 | ((looking-at "generate\\b[^_]") | |
2323 | (vector "generate\\|for\\|if" | |
2324 | (vhdl-first-word pos) | |
2325 | "generate" nil)) | |
2326 | ;; "end loop": | |
2327 | ((looking-at "loop\\b[^_]") | |
2328 | (vector "loop\\|while\\|for" | |
2329 | (vhdl-first-word pos) | |
2330 | "loop" nil)) | |
2331 | ;; "end for" (inside configuration declaration): | |
2332 | ((looking-at "for\\b[^_]") | |
2333 | (vector "for" (vhdl-first-word pos) nil nil)) | |
2334 | ;; "end [id]": | |
2335 | (t | |
2336 | (vector "begin\\|architecture\\|configuration\\|entity\\|package\\|procedure\\|function" | |
2337 | (vhdl-first-word pos) | |
2338 | ;; return an alist of (statement . keyword) mappings | |
2339 | '( | |
2340 | ;; "begin ... end [id]": | |
2341 | ("begin" . nil) | |
2342 | ;; "architecture ... is ... begin ... end [id]": | |
2343 | ("architecture" . "is") | |
2344 | ;; "configuration ... is ... end [id]": | |
2345 | ("configuration" . "is") | |
2346 | ;; "entity ... is ... end [id]": | |
2347 | ("entity" . "is") | |
2348 | ;; "package ... is ... end [id]": | |
2349 | ("package" . "is") | |
2350 | ;; "procedure ... is ... begin ... end [id]": | |
2351 | ("procedure" . "is") | |
2352 | ;; "function ... is ... begin ... end [id]": | |
2353 | ("function" . "is") | |
2354 | ) | |
2355 | nil)) | |
2356 | ))) ; "end ..." | |
2357 | ))) | |
2358 | ||
2359 | (defconst vhdl-leader-re | |
2360 | "\\b\\(block\\|component\\|process\\|for\\)\\b[^_]") | |
2361 | ||
2362 | (defun vhdl-end-of-leader () | |
2363 | (save-excursion | |
2364 | (cond ((looking-at "block\\|process") | |
2365 | (if (save-excursion | |
2366 | (forward-sexp) | |
2367 | (skip-chars-forward " \t\n") | |
2368 | (= (following-char) ?\()) | |
2369 | (forward-sexp 2) | |
2370 | (forward-sexp)) | |
2371 | (point)) | |
2372 | ((looking-at "component") | |
2373 | (forward-sexp 2) | |
2374 | (point)) | |
2375 | ((looking-at "for") | |
2376 | (forward-sexp 2) | |
2377 | (skip-chars-forward " \t\n") | |
2378 | (while (looking-at "[,:(]") | |
2379 | (forward-sexp) | |
2380 | (skip-chars-forward " \t\n")) | |
2381 | (point)) | |
2382 | (t nil) | |
2383 | ))) | |
2384 | ||
2385 | (defconst vhdl-trailer-re | |
2386 | "\\b\\(is\\|then\\|generate\\|loop\\)\\b[^_]") | |
2387 | ||
2388 | (defconst vhdl-statement-fwd-re | |
2389 | "\\b\\(if\\|for\\|while\\)\\b\\([^_]\\|\\'\\)" | |
2390 | "A regular expression for searching forward that matches all known | |
2391 | \"statement\" keywords.") | |
2392 | ||
2393 | (defconst vhdl-statement-bwd-re | |
2394 | "\\b\\(if\\|for\\|while\\)\\b[^_]" | |
2395 | "A regular expression for searching backward that matches all known | |
2396 | \"statement\" keywords.") | |
2397 | ||
2398 | (defun vhdl-statement-p (&optional lim) | |
2399 | "Return t if we are looking at a real \"statement\" keyword. | |
2400 | Assumes that the caller will make sure that we are looking at | |
2401 | vhdl-statement-fwd-re, and are not inside a literal, and that we are not in | |
2402 | the middle of an identifier that just happens to contain a \"statement\" | |
2403 | keyword." | |
2404 | (cond | |
2405 | ;; "for" ... "generate": | |
2406 | ((and (looking-at "f") | |
2407 | ;; Make sure it's the start of a parameter specification. | |
2408 | (save-excursion | |
2409 | (forward-sexp 2) | |
2410 | (skip-chars-forward " \t\n") | |
2411 | (looking-at "in\\b[^_]")) | |
2412 | ;; Make sure it's not an "end for". | |
2413 | (save-excursion | |
2414 | (backward-sexp) | |
2415 | (not (looking-at "end\\s-+\\w")))) | |
2416 | t) | |
2417 | ;; "if" ... "then", "if" ... "generate", "if" ... "loop": | |
2418 | ((and (looking-at "i") | |
2419 | ;; Make sure it's not an "end if". | |
2420 | (save-excursion | |
2421 | (backward-sexp) | |
2422 | (not (looking-at "end\\s-+\\w")))) | |
2423 | t) | |
2424 | ;; "while" ... "loop": | |
2425 | ((looking-at "w") | |
2426 | t) | |
2427 | )) | |
2428 | ||
2429 | (defconst vhdl-case-alternative-re "when[( \t\n][^;=>]+=>" | |
2430 | "Regexp describing a case statement alternative key.") | |
2431 | ||
2432 | (defun vhdl-case-alternative-p (&optional lim) | |
2433 | "Return t if we are looking at a real case alternative. | |
2434 | Assumes that the caller will make sure that we are looking at | |
2435 | vhdl-case-alternative-re, and are not inside a literal, and that | |
2436 | we are not in the middle of an identifier that just happens to | |
2437 | contain a \"when\" keyword." | |
2438 | (save-excursion | |
2439 | (let (foundp) | |
2440 | (while (and (not foundp) | |
2441 | (re-search-backward ";\\|<=" lim 'move)) | |
2442 | (if (or (= (preceding-char) ?_) | |
2443 | (vhdl-in-literal lim)) | |
2444 | (backward-char) | |
2445 | (setq foundp t))) | |
2446 | (or (eq (following-char) ?\;) | |
2447 | (eq (point) lim))) | |
2448 | )) | |
2449 | ||
2450 | ;; Core syntactic movement functions: | |
2451 | ||
2452 | (defconst vhdl-b-t-b-re | |
2453 | (concat vhdl-begin-bwd-re "\\|" vhdl-end-bwd-re)) | |
2454 | ||
2455 | (defun vhdl-backward-to-block (&optional lim) | |
2456 | "Move backward to the previous \"begin\" or \"end\" keyword." | |
2457 | (let (foundp) | |
2458 | (while (and (not foundp) | |
2459 | (re-search-backward vhdl-b-t-b-re lim 'move)) | |
2460 | (if (or (= (preceding-char) ?_) | |
2461 | (vhdl-in-literal lim)) | |
2462 | (backward-char) | |
2463 | (cond | |
2464 | ;; "begin" keyword: | |
2465 | ((and (looking-at vhdl-begin-fwd-re) | |
2466 | (/= (preceding-char) ?_) | |
2467 | (vhdl-begin-p lim)) | |
2468 | (setq foundp 'begin)) | |
2469 | ;; "end" keyword: | |
2470 | ((and (looking-at vhdl-end-fwd-re) | |
2471 | (/= (preceding-char) ?_) | |
2472 | (vhdl-end-p lim)) | |
2473 | (setq foundp 'end)) | |
2474 | )) | |
2475 | ) | |
2476 | foundp | |
2477 | )) | |
2478 | ||
2479 | (defun vhdl-forward-sexp (&optional count lim) | |
2480 | "Move forward across one balanced expression (sexp). | |
2481 | With COUNT, do it that many times." | |
2482 | (interactive "p") | |
2483 | (let ((count (or count 1)) | |
2484 | (case-fold-search t) | |
2485 | end-vec target) | |
2486 | (save-excursion | |
2487 | (while (> count 0) | |
2488 | ;; skip whitespace | |
2489 | (skip-chars-forward " \t\n") | |
2490 | ;; Check for an unbalanced "end" keyword | |
2491 | (if (and (looking-at vhdl-end-fwd-re) | |
2492 | (/= (preceding-char) ?_) | |
2493 | (not (vhdl-in-literal lim)) | |
2494 | (vhdl-end-p lim) | |
2495 | (not (looking-at "else"))) | |
2496 | (error | |
2497 | "Containing expression ends prematurely in vhdl-forward-sexp")) | |
2498 | ;; If the current keyword is a "begin" keyword, then find the | |
2499 | ;; corresponding "end" keyword. | |
2500 | (if (setq end-vec (vhdl-corresponding-end lim)) | |
2501 | (let ( | |
2502 | ;; end-re is the statement keyword to search for | |
2503 | (end-re | |
2504 | (concat "\\b\\(" (aref end-vec 0) "\\)\\b\\([^_]\\|\\'\\)")) | |
2505 | ;; column is either the statement keyword target column | |
2506 | ;; or nil | |
2507 | (column (aref end-vec 1)) | |
2508 | (eol (vhdl-point 'eol)) | |
2509 | foundp literal placeholder) | |
2510 | ;; Look for the statement keyword. | |
2511 | (while (and (not foundp) | |
2512 | (re-search-forward end-re nil t) | |
2513 | (setq placeholder (match-end 1)) | |
2514 | (goto-char (match-beginning 0))) | |
2515 | ;; If we are in a literal, or not in the right target | |
2516 | ;; column and not on the same line as the begin, then | |
2517 | ;; try again. | |
2518 | (if (or (and column | |
2519 | (/= (current-indentation) column) | |
2520 | (> (point) eol)) | |
2521 | (= (preceding-char) ?_) | |
2522 | (setq literal (vhdl-in-literal lim))) | |
2523 | (if (eq literal 'comment) | |
2524 | (end-of-line) | |
2525 | (forward-char)) | |
2526 | ;; An "else" keyword corresponds to both the opening brace | |
2527 | ;; of the following sexp and the closing brace of the | |
2528 | ;; previous sexp. | |
2529 | (if (not (looking-at "else")) | |
2530 | (goto-char placeholder)) | |
2531 | (setq foundp t)) | |
2532 | ) | |
2533 | (if (not foundp) | |
2534 | (error "Unbalanced keywords in vhdl-forward-sexp")) | |
2535 | ) | |
2536 | ;; If the current keyword is not a "begin" keyword, then just | |
2537 | ;; perform the normal forward-sexp. | |
2538 | (forward-sexp) | |
2539 | ) | |
2540 | (setq count (1- count)) | |
2541 | ) | |
2542 | (setq target (point))) | |
2543 | (goto-char target) | |
2544 | nil)) | |
2545 | ||
2546 | (defun vhdl-backward-sexp (&optional count lim) | |
2547 | "Move backward across one balanced expression (sexp). | |
2548 | With COUNT, do it that many times. LIM bounds any required backward | |
2549 | searches." | |
2550 | (interactive "p") | |
2551 | (let ((count (or count 1)) | |
2552 | (case-fold-search t) | |
2553 | begin-vec target) | |
2554 | (save-excursion | |
2555 | (while (> count 0) | |
2556 | ;; Perform the normal backward-sexp, unless we are looking at | |
2557 | ;; "else" - an "else" keyword corresponds to both the opening brace | |
2558 | ;; of the following sexp and the closing brace of the previous sexp. | |
2559 | (if (and (looking-at "else\\b\\([^_]\\|\\'\\)") | |
2560 | (/= (preceding-char) ?_) | |
2561 | (not (vhdl-in-literal lim))) | |
2562 | nil | |
2563 | (backward-sexp) | |
2564 | (if (and (looking-at vhdl-begin-fwd-re) | |
2565 | (/= (preceding-char) ?_) | |
2566 | (not (vhdl-in-literal lim)) | |
2567 | (vhdl-begin-p lim)) | |
2568 | (error "Containing expression ends prematurely in vhdl-backward-sexp"))) | |
2569 | ;; If the current keyword is an "end" keyword, then find the | |
2570 | ;; corresponding "begin" keyword. | |
2571 | (if (and (setq begin-vec (vhdl-corresponding-begin lim)) | |
2572 | (/= (preceding-char) ?_)) | |
2573 | (let ( | |
2574 | ;; begin-re is the statement keyword to search for | |
2575 | (begin-re | |
2576 | (concat "\\b\\(" (aref begin-vec 0) "\\)\\b[^_]")) | |
2577 | ;; column is either the statement keyword target column | |
2578 | ;; or nil | |
2579 | (column (aref begin-vec 1)) | |
2580 | ;; internal-p controls where the statement keyword can | |
2581 | ;; be found. | |
2582 | (internal-p (aref begin-vec 3)) | |
2583 | (last-backward (point)) last-forward | |
2584 | foundp literal keyword) | |
2585 | ;; Look for the statement keyword. | |
2586 | (while (and (not foundp) | |
2587 | (re-search-backward begin-re lim t) | |
2588 | (setq keyword | |
2589 | (buffer-substring (match-beginning 1) | |
2590 | (match-end 1)))) | |
2591 | ;; If we are in a literal or in the wrong column, | |
2592 | ;; then try again. | |
2593 | (if (or (and column | |
2594 | (and (/= (current-indentation) column) | |
2595 | ;; possibly accept current-column as | |
2596 | ;; well as current-indentation. | |
2597 | (or (not internal-p) | |
2598 | (/= (current-column) column)))) | |
2599 | (= (preceding-char) ?_) | |
2600 | (vhdl-in-literal lim)) | |
2601 | (backward-char) | |
2602 | ;; If there is a supplementary keyword, then | |
2603 | ;; search forward for it. | |
2604 | (if (and (setq begin-re (aref begin-vec 2)) | |
2605 | (or (not (listp begin-re)) | |
2606 | ;; If begin-re is an alist, then find the | |
2607 | ;; element corresponding to the actual | |
2608 | ;; keyword that we found. | |
2609 | (progn | |
2610 | (setq begin-re | |
2611 | (assoc keyword begin-re)) | |
2612 | (and begin-re | |
2613 | (setq begin-re (cdr begin-re)))))) | |
2614 | (and | |
2615 | (setq begin-re | |
2616 | (concat "\\b\\(" begin-re "\\)\\b[^_]")) | |
2617 | (save-excursion | |
2618 | (setq last-forward (point)) | |
2619 | ;; Look for the supplementary keyword | |
2620 | ;; (bounded by the backward search start | |
2621 | ;; point). | |
2622 | (while (and (not foundp) | |
2623 | (re-search-forward begin-re | |
2624 | last-backward t) | |
2625 | (goto-char (match-beginning 1))) | |
2626 | ;; If we are in a literal, then try again. | |
2627 | (if (or (= (preceding-char) ?_) | |
2628 | (setq literal | |
2629 | (vhdl-in-literal last-forward))) | |
2630 | (if (eq literal 'comment) | |
2631 | (goto-char | |
2632 | (min (vhdl-point 'eol) last-backward)) | |
2633 | (forward-char)) | |
2634 | ;; We have found the supplementary keyword. | |
2635 | ;; Save the position of the keyword in foundp. | |
2636 | (setq foundp (point))) | |
2637 | ) | |
2638 | foundp) | |
2639 | ;; If the supplementary keyword was found, then | |
2640 | ;; move point to the supplementary keyword. | |
2641 | (goto-char foundp)) | |
2642 | ;; If there was no supplementary keyword, then | |
2643 | ;; point is already at the statement keyword. | |
2644 | (setq foundp t))) | |
2645 | ) ; end of the search for the statement keyword | |
2646 | (if (not foundp) | |
2647 | (error "Unbalanced keywords in vhdl-backward-sexp")) | |
2648 | )) | |
2649 | (setq count (1- count)) | |
2650 | ) | |
2651 | (setq target (point))) | |
2652 | (goto-char target) | |
2653 | nil)) | |
2654 | ||
2655 | (defun vhdl-backward-up-list (&optional count limit) | |
2656 | "Move backward out of one level of blocks. | |
2657 | With argument, do this that many times." | |
2658 | (interactive "p") | |
2659 | (let ((count (or count 1)) | |
2660 | target) | |
2661 | (save-excursion | |
2662 | (while (> count 0) | |
2663 | (if (looking-at vhdl-defun-re) | |
2664 | (error "Unbalanced blocks")) | |
2665 | (vhdl-backward-to-block limit) | |
2666 | (setq count (1- count))) | |
2667 | (setq target (point))) | |
2668 | (goto-char target))) | |
2669 | ||
2670 | (defun vhdl-end-of-defun (&optional count) | |
2671 | "Move forward to the end of a VHDL defun." | |
2672 | (interactive) | |
2673 | (let ((case-fold-search t)) | |
2674 | (vhdl-beginning-of-defun) | |
2675 | (if (not (looking-at "block\\|process")) | |
2676 | (re-search-forward "\\bis\\b")) | |
2677 | (vhdl-forward-sexp))) | |
2678 | ||
2679 | (defun vhdl-mark-defun () | |
2680 | "Put mark at end of this \"defun\", point at beginning." | |
2681 | (interactive) | |
2682 | (let ((case-fold-search t)) | |
2683 | (push-mark) | |
2684 | (vhdl-beginning-of-defun) | |
2685 | (push-mark) | |
2686 | (if (not (looking-at "block\\|process")) | |
2687 | (re-search-forward "\\bis\\b")) | |
2688 | (vhdl-forward-sexp) | |
2689 | (exchange-point-and-mark))) | |
2690 | ||
2691 | (defun vhdl-beginning-of-libunit () | |
2692 | "Move backward to the beginning of a VHDL library unit. | |
2693 | Returns the location of the corresponding begin keyword, unless search | |
2694 | stops due to beginning or end of buffer." | |
2695 | ;; Note that if point is between the "libunit" keyword and the | |
2696 | ;; corresponding "begin" keyword, then that libunit will not be | |
2697 | ;; recognised, and the search will continue backwards. If point is | |
2698 | ;; at the "begin" keyword, then the defun will be recognised. The | |
2699 | ;; returned point is at the first character of the "libunit" keyword. | |
2700 | (let ((last-forward (point)) | |
2701 | (last-backward | |
2702 | ;; Just in case we are actually sitting on the "begin" | |
2703 | ;; keyword, allow for the keyword and an extra character, | |
2704 | ;; as this will be used when looking forward for the | |
2705 | ;; "begin" keyword. | |
2706 | (save-excursion (forward-word 1) (1+ (point)))) | |
2707 | foundp literal placeholder) | |
2708 | ;; Find the "libunit" keyword. | |
2709 | (while (and (not foundp) | |
2710 | (re-search-backward vhdl-libunit-re nil 'move)) | |
2711 | ;; If we are in a literal, or not at a real libunit, then try again. | |
2712 | (if (or (= (preceding-char) ?_) | |
2713 | (vhdl-in-literal (point-min)) | |
2714 | (not (vhdl-libunit-p))) | |
2715 | (backward-char) | |
2716 | ;; Find the corresponding "begin" keyword. | |
2717 | (setq last-forward (point)) | |
2718 | (while (and (not foundp) | |
2719 | (re-search-forward "\\bis\\b[^_]" last-backward t) | |
2720 | (setq placeholder (match-beginning 0))) | |
2721 | (if (or (= (preceding-char) ?_) | |
2722 | (setq literal (vhdl-in-literal last-forward))) | |
2723 | ;; It wasn't a real keyword, so keep searching. | |
2724 | (if (eq literal 'comment) | |
2725 | (goto-char | |
2726 | (min (vhdl-point 'eol) last-backward)) | |
2727 | (forward-char)) | |
2728 | ;; We have found the begin keyword, loop will exit. | |
2729 | (setq foundp placeholder))) | |
2730 | ;; Go back to the libunit keyword | |
2731 | (goto-char last-forward))) | |
2732 | foundp)) | |
2733 | ||
2734 | (defun vhdl-beginning-of-defun (&optional count) | |
2735 | "Move backward to the beginning of a VHDL defun. | |
2736 | With argument, do it that many times. | |
2737 | Returns the location of the corresponding begin keyword, unless search | |
2738 | stops due to beginning or end of buffer." | |
2739 | ;; Note that if point is between the "defun" keyword and the | |
2740 | ;; corresponding "begin" keyword, then that defun will not be | |
2741 | ;; recognised, and the search will continue backwards. If point is | |
2742 | ;; at the "begin" keyword, then the defun will be recognised. The | |
2743 | ;; returned point is at the first character of the "defun" keyword. | |
2744 | (interactive "p") | |
2745 | (let ((count (or count 1)) | |
2746 | (case-fold-search t) | |
2747 | (last-forward (point)) | |
2748 | foundp) | |
2749 | (while (> count 0) | |
2750 | (setq foundp nil) | |
2751 | (goto-char last-forward) | |
2752 | (let ((last-backward | |
2753 | ;; Just in case we are actually sitting on the "begin" | |
2754 | ;; keyword, allow for the keyword and an extra character, | |
2755 | ;; as this will be used when looking forward for the | |
2756 | ;; "begin" keyword. | |
2757 | (save-excursion (forward-word 1) (1+ (point)))) | |
2758 | begin-string literal) | |
2759 | (while (and (not foundp) | |
2760 | (re-search-backward vhdl-defun-re nil 'move)) | |
2761 | ;; If we are in a literal, then try again. | |
2762 | (if (or (= (preceding-char) ?_) | |
2763 | (vhdl-in-literal (point-min))) | |
2764 | (backward-char) | |
2765 | (if (setq begin-string (vhdl-corresponding-defun)) | |
2766 | ;; This is a real defun keyword. | |
2767 | ;; Find the corresponding "begin" keyword. | |
2768 | ;; Look for the begin keyword. | |
2769 | (progn | |
2770 | ;; Save the search start point. | |
2771 | (setq last-forward (point)) | |
2772 | (while (and (not foundp) | |
2773 | (search-forward begin-string last-backward t)) | |
2774 | (if (or (= (preceding-char) ?_) | |
2775 | (save-match-data | |
2776 | (setq literal (vhdl-in-literal last-forward)))) | |
2777 | ;; It wasn't a real keyword, so keep searching. | |
2778 | (if (eq literal 'comment) | |
2779 | (goto-char | |
2780 | (min (vhdl-point 'eol) last-backward)) | |
2781 | (forward-char)) | |
2782 | ;; We have found the begin keyword, loop will exit. | |
2783 | (setq foundp (match-beginning 0))) | |
2784 | ) | |
2785 | ;; Go back to the defun keyword | |
2786 | (goto-char last-forward)) ; end search for begin keyword | |
2787 | )) | |
2788 | ) ; end of the search for the defun keyword | |
2789 | ) | |
2790 | (setq count (1- count)) | |
2791 | ) | |
2792 | (vhdl-keep-region-active) | |
2793 | foundp)) | |
2794 | ||
2795 | (defun vhdl-beginning-of-statement (&optional count lim) | |
2796 | "Go to the beginning of the innermost VHDL statement. | |
2797 | With prefix arg, go back N - 1 statements. If already at the | |
2798 | beginning of a statement then go to the beginning of the preceding | |
2799 | one. If within a string or comment, or next to a comment (only | |
2800 | whitespace between), move by sentences instead of statements. | |
2801 | ||
2802 | When called from a program, this function takes 2 optional args: the | |
2803 | prefix arg, and a buffer position limit which is the farthest back to | |
2804 | search." | |
2805 | (interactive "p") | |
2806 | (let ((count (or count 1)) | |
2807 | (case-fold-search t) | |
2808 | (lim (or lim (point-min))) | |
2809 | (here (point)) | |
2810 | state) | |
2811 | (save-excursion | |
2812 | (goto-char lim) | |
2813 | (setq state (parse-partial-sexp (point) here nil nil))) | |
2814 | (if (and (interactive-p) | |
2815 | (or (nth 3 state) | |
2816 | (nth 4 state) | |
2817 | (looking-at (concat "[ \t]*" comment-start-skip)))) | |
2818 | (forward-sentence (- count)) | |
2819 | (while (> count 0) | |
2820 | (vhdl-beginning-of-statement-1 lim) | |
2821 | (setq count (1- count)))) | |
2822 | ;; its possible we've been left up-buf of lim | |
2823 | (goto-char (max (point) lim)) | |
2824 | ) | |
2825 | (vhdl-keep-region-active)) | |
2826 | ||
2827 | (defconst vhdl-e-o-s-re | |
2828 | (concat ";\\|" vhdl-begin-fwd-re "\\|" vhdl-statement-fwd-re)) | |
2829 | ||
2830 | (defun vhdl-end-of-statement () | |
2831 | "Very simple implementation." | |
2832 | (interactive) | |
2833 | (re-search-forward vhdl-e-o-s-re)) | |
2834 | ||
2835 | (defconst vhdl-b-o-s-re | |
2836 | (concat ";\\|\(\\|\)\\|\\bwhen\\b[^_]\\|" | |
2837 | vhdl-begin-bwd-re "\\|" vhdl-statement-bwd-re)) | |
2838 | ||
2839 | (defun vhdl-beginning-of-statement-1 (&optional lim) | |
2840 | ;; move to the start of the current statement, or the previous | |
2841 | ;; statement if already at the beginning of one. | |
2842 | (let ((lim (or lim (point-min))) | |
2843 | (here (point)) | |
2844 | (pos (point)) | |
2845 | donep) | |
2846 | ;; go backwards one balanced expression, but be careful of | |
2847 | ;; unbalanced paren being reached | |
2848 | (if (not (vhdl-safe (progn (backward-sexp) t))) | |
2849 | (progn | |
2850 | (backward-up-list 1) | |
2851 | (forward-char) | |
2852 | (vhdl-forward-syntactic-ws here) | |
2853 | (setq donep t))) | |
2854 | (while (and (not donep) | |
2855 | (not (bobp)) | |
2856 | ;; look backwards for a statement boundary | |
2857 | (re-search-backward vhdl-b-o-s-re lim 'move)) | |
2858 | (if (or (= (preceding-char) ?_) | |
2859 | (vhdl-in-literal lim)) | |
2860 | (backward-char) | |
2861 | (cond | |
2862 | ;; If we are looking at an open paren, then stop after it | |
2863 | ((eq (following-char) ?\() | |
2864 | (forward-char) | |
2865 | (vhdl-forward-syntactic-ws here) | |
2866 | (setq donep t)) | |
2867 | ;; If we are looking at a close paren, then skip it | |
2868 | ((eq (following-char) ?\)) | |
2869 | (forward-char) | |
2870 | (setq pos (point)) | |
2871 | (backward-sexp) | |
2872 | (if (< (point) lim) | |
2873 | (progn (goto-char pos) | |
2874 | (vhdl-forward-syntactic-ws here) | |
2875 | (setq donep t)))) | |
2876 | ;; If we are looking at a semicolon, then stop | |
2877 | ((eq (following-char) ?\;) | |
2878 | (progn | |
2879 | (forward-char) | |
2880 | (vhdl-forward-syntactic-ws here) | |
2881 | (setq donep t))) | |
2882 | ;; If we are looking at a "begin", then stop | |
2883 | ((and (looking-at vhdl-begin-fwd-re) | |
2884 | (/= (preceding-char) ?_) | |
2885 | (vhdl-begin-p nil)) | |
2886 | ;; If it's a leader "begin", then find the | |
2887 | ;; right place | |
2888 | (if (looking-at vhdl-leader-re) | |
2889 | (save-excursion | |
2890 | ;; set a default stop point at the begin | |
2891 | (setq pos (point)) | |
2892 | ;; is the start point inside the leader area ? | |
2893 | (goto-char (vhdl-end-of-leader)) | |
2894 | (vhdl-forward-syntactic-ws here) | |
2895 | (if (< (point) here) | |
2896 | ;; start point was not inside leader area | |
2897 | ;; set stop point at word after leader | |
2898 | (setq pos (point)))) | |
2899 | (forward-word 1) | |
2900 | (vhdl-forward-syntactic-ws here) | |
2901 | (setq pos (point))) | |
2902 | (goto-char pos) | |
2903 | (setq donep t)) | |
2904 | ;; If we are looking at a "statement", then stop | |
2905 | ((and (looking-at vhdl-statement-fwd-re) | |
2906 | (/= (preceding-char) ?_) | |
2907 | (vhdl-statement-p nil)) | |
2908 | (setq donep t)) | |
2909 | ;; If we are looking at a case alternative key, then stop | |
2910 | ((and (looking-at vhdl-case-alternative-re) | |
2911 | (vhdl-case-alternative-p lim)) | |
2912 | (save-excursion | |
2913 | ;; set a default stop point at the when | |
2914 | (setq pos (point)) | |
2915 | ;; is the start point inside the case alternative key ? | |
2916 | (looking-at vhdl-case-alternative-re) | |
2917 | (goto-char (match-end 0)) | |
2918 | (vhdl-forward-syntactic-ws here) | |
2919 | (if (< (point) here) | |
2920 | ;; start point was not inside the case alternative key | |
2921 | ;; set stop point at word after case alternative keyleader | |
2922 | (setq pos (point)))) | |
2923 | (goto-char pos) | |
2924 | (setq donep t)) | |
2925 | ;; Bogus find, continue | |
2926 | (t | |
2927 | (backward-char))))) | |
2928 | )) | |
2929 | ||
2930 | ;; Defuns for calculating the current syntactic state: | |
2931 | ||
2932 | (defun vhdl-get-library-unit (bod placeholder) | |
2933 | ;; If there is an enclosing library unit at bod, with it's \"begin\" | |
2934 | ;; keyword at placeholder, then return the library unit type. | |
2935 | (let ((here (vhdl-point 'bol))) | |
2936 | (if (save-excursion | |
2937 | (goto-char placeholder) | |
2938 | (vhdl-safe (vhdl-forward-sexp 1 bod)) | |
2939 | (<= here (point))) | |
2940 | (save-excursion | |
2941 | (goto-char bod) | |
2942 | (cond | |
2943 | ((looking-at "e") 'entity) | |
2944 | ((looking-at "a") 'architecture) | |
2945 | ((looking-at "c") 'configuration) | |
2946 | ((looking-at "p") | |
2947 | (save-excursion | |
2948 | (goto-char bod) | |
2949 | (forward-sexp) | |
2950 | (vhdl-forward-syntactic-ws here) | |
2951 | (if (looking-at "body\\b[^_]") | |
2952 | 'package-body 'package)))))) | |
2953 | )) | |
2954 | ||
2955 | (defun vhdl-get-block-state (&optional lim) | |
2956 | ;; Finds and records all the closest opens. | |
2957 | ;; lim is the furthest back we need to search (it should be the | |
2958 | ;; previous libunit keyword). | |
2959 | (let ((here (point)) | |
2960 | (lim (or lim (point-min))) | |
2961 | keyword sexp-start sexp-mid sexp-end | |
2962 | preceding-sexp containing-sexp | |
2963 | containing-begin containing-mid containing-paren) | |
2964 | (save-excursion | |
2965 | ;; Find the containing-paren, and use that as the limit | |
2966 | (if (setq containing-paren | |
2967 | (save-restriction | |
2968 | (narrow-to-region lim (point)) | |
2969 | (vhdl-safe (scan-lists (point) -1 1)))) | |
2970 | (setq lim containing-paren)) | |
2971 | ;; Look backwards for "begin" and "end" keywords. | |
2972 | (while (and (> (point) lim) | |
2973 | (not containing-sexp)) | |
2974 | (setq keyword (vhdl-backward-to-block lim)) | |
2975 | (cond | |
2976 | ((eq keyword 'begin) | |
2977 | ;; Found a "begin" keyword | |
2978 | (setq sexp-start (point)) | |
2979 | (setq sexp-mid (vhdl-corresponding-mid lim)) | |
2980 | (setq sexp-end (vhdl-safe | |
2981 | (save-excursion | |
2982 | (vhdl-forward-sexp 1 lim) (point)))) | |
2983 | (if (and sexp-end (<= sexp-end here)) | |
2984 | ;; we want to record this sexp, but we only want to | |
2985 | ;; record the last-most of any of them before here | |
2986 | (or preceding-sexp | |
2987 | (setq preceding-sexp sexp-start)) | |
2988 | ;; we're contained in this sexp so put sexp-start on | |
2989 | ;; front of list | |
2990 | (setq containing-sexp sexp-start) | |
2991 | (setq containing-mid sexp-mid) | |
2992 | (setq containing-begin t))) | |
2993 | ((eq keyword 'end) | |
2994 | ;; Found an "end" keyword | |
2995 | (forward-sexp) | |
2996 | (setq sexp-end (point)) | |
2997 | (setq sexp-mid nil) | |
2998 | (setq sexp-start | |
2999 | (or (vhdl-safe (vhdl-backward-sexp 1 lim) (point)) | |
3000 | (progn (backward-sexp) (point)))) | |
3001 | ;; we want to record this sexp, but we only want to | |
3002 | ;; record the last-most of any of them before here | |
3003 | (or preceding-sexp | |
3004 | (setq preceding-sexp sexp-start))) | |
3005 | ))) | |
3006 | ;; Check if the containing-paren should be the containing-sexp | |
3007 | (if (and containing-paren | |
3008 | (or (null containing-sexp) | |
3009 | (< containing-sexp containing-paren))) | |
3010 | (setq containing-sexp containing-paren | |
3011 | preceding-sexp nil | |
3012 | containing-begin nil | |
3013 | containing-mid nil)) | |
3014 | (vector containing-sexp preceding-sexp containing-begin containing-mid) | |
3015 | )) | |
3016 | ||
3017 | ||
3018 | (defconst vhdl-s-c-a-re | |
3019 | (concat vhdl-case-alternative-re "\\|" vhdl-case-header-key)) | |
3020 | ||
3021 | (defun vhdl-skip-case-alternative (&optional lim) | |
3022 | ;; skip forward over case/when bodies, with optional maximal | |
3023 | ;; limit. if no next case alternative is found, nil is returned and point | |
3024 | ;; is not moved | |
3025 | (let ((lim (or lim (point-max))) | |
3026 | (here (point)) | |
3027 | donep foundp) | |
3028 | (while (and (< (point) lim) | |
3029 | (not donep)) | |
3030 | (if (and (re-search-forward vhdl-s-c-a-re lim 'move) | |
3031 | (save-match-data | |
3032 | (not (vhdl-in-literal))) | |
3033 | (/= (match-beginning 0) here)) | |
3034 | (progn | |
3035 | (goto-char (match-beginning 0)) | |
3036 | (cond | |
3037 | ((and (looking-at "case") | |
3038 | (re-search-forward "\\bis[^_]" lim t)) | |
3039 | (backward-sexp) | |
3040 | (vhdl-forward-sexp)) | |
3041 | (t | |
3042 | (setq donep t | |
3043 | foundp t)))))) | |
3044 | (if (not foundp) | |
3045 | (goto-char here)) | |
3046 | foundp)) | |
3047 | ||
3048 | (defun vhdl-backward-skip-label (&optional lim) | |
3049 | ;; skip backward over a label, with optional maximal | |
3050 | ;; limit. if label is not found, nil is returned and point | |
3051 | ;; is not moved | |
3052 | (let ((lim (or lim (point-min))) | |
3053 | placeholder) | |
3054 | (if (save-excursion | |
3055 | (vhdl-backward-syntactic-ws lim) | |
3056 | (and (eq (preceding-char) ?:) | |
3057 | (progn | |
3058 | (backward-sexp) | |
3059 | (setq placeholder (point)) | |
3060 | (looking-at vhdl-label-key)))) | |
3061 | (goto-char placeholder)) | |
3062 | )) | |
3063 | ||
3064 | (defun vhdl-forward-skip-label (&optional lim) | |
3065 | ;; skip forward over a label, with optional maximal | |
3066 | ;; limit. if label is not found, nil is returned and point | |
3067 | ;; is not moved | |
3068 | (let ((lim (or lim (point-max)))) | |
3069 | (if (looking-at vhdl-label-key) | |
3070 | (progn | |
3071 | (goto-char (match-end 0)) | |
3072 | (vhdl-forward-syntactic-ws lim))) | |
3073 | )) | |
3074 | ||
3075 | (defun vhdl-get-syntactic-context () | |
3076 | ;; guess the syntactic description of the current line of VHDL code. | |
3077 | (save-excursion | |
3078 | (save-restriction | |
3079 | (beginning-of-line) | |
3080 | (let* ((indent-point (point)) | |
3081 | (case-fold-search t) | |
3082 | vec literal containing-sexp preceding-sexp | |
3083 | containing-begin containing-mid containing-leader | |
3084 | char-before-ip char-after-ip begin-after-ip end-after-ip | |
3085 | placeholder lim library-unit | |
3086 | ) | |
3087 | ||
3088 | ;; Reset the syntactic context | |
3089 | (setq vhdl-syntactic-context nil) | |
3090 | ||
3091 | (save-excursion | |
3092 | ;; Move to the start of the previous library unit, and | |
3093 | ;; record the position of the "begin" keyword. | |
3094 | (setq placeholder (vhdl-beginning-of-libunit)) | |
3095 | ;; The position of the "libunit" keyword gives us a gross | |
3096 | ;; limit point. | |
3097 | (setq lim (point)) | |
3098 | ) | |
3099 | ||
3100 | ;; If there is a previous library unit, and we are enclosed by | |
3101 | ;; it, then set the syntax accordingly. | |
3102 | (and placeholder | |
3103 | (setq library-unit (vhdl-get-library-unit lim placeholder)) | |
3104 | (vhdl-add-syntax library-unit lim)) | |
3105 | ||
3106 | ;; Find the surrounding state. | |
3107 | (if (setq vec (vhdl-get-block-state lim)) | |
3108 | (progn | |
3109 | (setq containing-sexp (aref vec 0)) | |
3110 | (setq preceding-sexp (aref vec 1)) | |
3111 | (setq containing-begin (aref vec 2)) | |
3112 | (setq containing-mid (aref vec 3)) | |
3113 | )) | |
3114 | ||
3115 | ;; set the limit on the farthest back we need to search | |
3116 | (setq lim (if containing-sexp | |
3117 | (save-excursion | |
3118 | (goto-char containing-sexp) | |
3119 | ;; set containing-leader if required | |
3120 | (if (looking-at vhdl-leader-re) | |
3121 | (setq containing-leader (vhdl-end-of-leader))) | |
3122 | (vhdl-point 'bol)) | |
3123 | (point-min))) | |
3124 | ||
3125 | ;; cache char before and after indent point, and move point to | |
3126 | ;; the most likely position to perform the majority of tests | |
3127 | (goto-char indent-point) | |
3128 | (skip-chars-forward " \t") | |
3129 | (setq literal (vhdl-in-literal lim)) | |
3130 | (setq char-after-ip (following-char)) | |
3131 | (setq begin-after-ip (and | |
3132 | (not literal) | |
3133 | (looking-at vhdl-begin-fwd-re) | |
3134 | (vhdl-begin-p))) | |
3135 | (setq end-after-ip (and | |
3136 | (not literal) | |
3137 | (looking-at vhdl-end-fwd-re) | |
3138 | (vhdl-end-p))) | |
3139 | (vhdl-backward-syntactic-ws lim) | |
3140 | (setq char-before-ip (preceding-char)) | |
3141 | (goto-char indent-point) | |
3142 | (skip-chars-forward " \t") | |
3143 | ||
3144 | ;; now figure out syntactic qualities of the current line | |
3145 | (cond | |
3146 | ;; CASE 1: in a string or comment. | |
3147 | ((memq literal '(string comment)) | |
3148 | (vhdl-add-syntax literal (vhdl-point 'bopl))) | |
3149 | ;; CASE 2: Line is at top level. | |
3150 | ((null containing-sexp) | |
3151 | ;; Find the point to which indentation will be relative | |
3152 | (save-excursion | |
3153 | (if (null preceding-sexp) | |
3154 | ;; CASE 2X.1 | |
3155 | ;; no preceding-sexp -> use the preceding statement | |
3156 | (vhdl-beginning-of-statement-1 lim) | |
3157 | ;; CASE 2X.2 | |
3158 | ;; if there is a preceding-sexp then indent relative to it | |
3159 | (goto-char preceding-sexp) | |
3160 | ;; if not at boi, then the block-opening keyword is | |
3161 | ;; probably following a label, so we need a different | |
3162 | ;; relpos | |
3163 | (if (/= (point) (vhdl-point 'boi)) | |
3164 | ;; CASE 2X.3 | |
3165 | (vhdl-beginning-of-statement-1 lim))) | |
3166 | ;; v-b-o-s could have left us at point-min | |
3167 | (and (bobp) | |
3168 | ;; CASE 2X.4 | |
3169 | (vhdl-forward-syntactic-ws indent-point)) | |
3170 | (setq placeholder (point))) | |
3171 | (cond | |
3172 | ;; CASE 2A : we are looking at a block-open | |
3173 | (begin-after-ip | |
3174 | (vhdl-add-syntax 'block-open placeholder)) | |
3175 | ;; CASE 2B: we are looking at a block-close | |
3176 | (end-after-ip | |
3177 | (vhdl-add-syntax 'block-close placeholder)) | |
3178 | ;; CASE 2C: we are looking at a top-level statement | |
3179 | ((progn | |
3180 | (vhdl-backward-syntactic-ws lim) | |
3181 | (or (bobp) | |
3182 | (= (preceding-char) ?\;))) | |
3183 | (vhdl-add-syntax 'statement placeholder)) | |
3184 | ;; CASE 2D: we are looking at a top-level statement-cont | |
3185 | (t | |
3186 | (vhdl-beginning-of-statement-1 lim) | |
3187 | ;; v-b-o-s could have left us at point-min | |
3188 | (and (bobp) | |
3189 | ;; CASE 2D.1 | |
3190 | (vhdl-forward-syntactic-ws indent-point)) | |
3191 | (vhdl-add-syntax 'statement-cont (point))) | |
3192 | )) ; end CASE 2 | |
3193 | ;; CASE 3: line is inside parentheses. Most likely we are | |
3194 | ;; either in a subprogram argument (interface) list, or a | |
3195 | ;; continued expression containing parentheses. | |
3196 | ((null containing-begin) | |
3197 | (vhdl-backward-syntactic-ws containing-sexp) | |
3198 | (cond | |
3199 | ;; CASE 3A: we are looking at the arglist closing paren | |
3200 | ((eq char-after-ip ?\)) | |
3201 | (goto-char containing-sexp) | |
3202 | (vhdl-add-syntax 'arglist-close (vhdl-point 'boi))) | |
3203 | ;; CASE 3B: we are looking at the first argument in an empty | |
3204 | ;; argument list. | |
3205 | ((eq char-before-ip ?\() | |
3206 | (goto-char containing-sexp) | |
3207 | (vhdl-add-syntax 'arglist-intro (vhdl-point 'boi))) | |
3208 | ;; CASE 3C: we are looking at an arglist continuation line, | |
3209 | ;; but the preceding argument is on the same line as the | |
3210 | ;; opening paren. This case includes multi-line | |
3211 | ;; expression paren groupings. | |
3212 | ((and (save-excursion | |
3213 | (goto-char (1+ containing-sexp)) | |
3214 | (skip-chars-forward " \t") | |
3215 | (not (eolp)) | |
3216 | (not (looking-at "--"))) | |
3217 | (save-excursion | |
3218 | (vhdl-beginning-of-statement-1 containing-sexp) | |
3219 | (skip-chars-backward " \t(") | |
3220 | (<= (point) containing-sexp))) | |
3221 | (goto-char containing-sexp) | |
3222 | (vhdl-add-syntax 'arglist-cont-nonempty (vhdl-point 'boi))) | |
3223 | ;; CASE 3D: we are looking at just a normal arglist | |
3224 | ;; continuation line | |
3225 | (t (vhdl-beginning-of-statement-1 containing-sexp) | |
3226 | (vhdl-forward-syntactic-ws indent-point) | |
3227 | (vhdl-add-syntax 'arglist-cont (vhdl-point 'boi))) | |
3228 | )) | |
3229 | ;; CASE 4: A block mid open | |
3230 | ((and begin-after-ip | |
3231 | (looking-at containing-mid)) | |
3232 | (goto-char containing-sexp) | |
3233 | ;; If the \"begin\" keyword is a trailer, then find v-b-o-s | |
3234 | (if (looking-at vhdl-trailer-re) | |
3235 | ;; CASE 4.1 | |
3236 | (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) | |
3237 | (vhdl-backward-skip-label (vhdl-point 'boi)) | |
3238 | (vhdl-add-syntax 'block-open (point))) | |
3239 | ;; CASE 5: block close brace | |
3240 | (end-after-ip | |
3241 | (goto-char containing-sexp) | |
3242 | ;; If the \"begin\" keyword is a trailer, then find v-b-o-s | |
3243 | (if (looking-at vhdl-trailer-re) | |
3244 | ;; CASE 5.1 | |
3245 | (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) | |
3246 | (vhdl-backward-skip-label (vhdl-point 'boi)) | |
3247 | (vhdl-add-syntax 'block-close (point))) | |
3248 | ;; CASE 6: A continued statement | |
3249 | ((and (/= char-before-ip ?\;) | |
3250 | ;; check it's not a trailer begin keyword, or a begin | |
3251 | ;; keyword immediately following a label. | |
3252 | (not (and begin-after-ip | |
3253 | (or (looking-at vhdl-trailer-re) | |
3254 | (save-excursion | |
3255 | (vhdl-backward-skip-label containing-sexp))))) | |
3256 | ;; check it's not a statement keyword | |
3257 | (not (and (looking-at vhdl-statement-fwd-re) | |
3258 | (vhdl-statement-p))) | |
3259 | ;; see if the b-o-s is before the indent point | |
3260 | (> indent-point | |
3261 | (save-excursion | |
3262 | (vhdl-beginning-of-statement-1 containing-sexp) | |
3263 | ;; If we ended up after a leader, then this will | |
3264 | ;; move us forward to the start of the first | |
3265 | ;; statement. Note that a containing sexp here is | |
3266 | ;; always a keyword, not a paren, so this will | |
3267 | ;; have no effect if we hit the containing-sexp. | |
3268 | (vhdl-forward-syntactic-ws indent-point) | |
3269 | (setq placeholder (point)))) | |
3270 | ;; check it's not a block-intro | |
3271 | (/= placeholder containing-sexp) | |
3272 | ;; check it's not a case block-intro | |
3273 | (save-excursion | |
3274 | (goto-char placeholder) | |
3275 | (or (not (looking-at vhdl-case-alternative-re)) | |
3276 | (> (match-end 0) indent-point)))) | |
3277 | ;; Make placeholder skip a label, but only if it puts us | |
3278 | ;; before the indent point at the start of a line. | |
3279 | (let ((new placeholder)) | |
3280 | (if (and (> indent-point | |
3281 | (save-excursion | |
3282 | (goto-char placeholder) | |
3283 | (vhdl-forward-skip-label indent-point) | |
3284 | (setq new (point)))) | |
3285 | (save-excursion | |
3286 | (goto-char new) | |
3287 | (eq new (progn (back-to-indentation) (point))))) | |
3288 | (setq placeholder new))) | |
3289 | (vhdl-add-syntax 'statement-cont placeholder) | |
3290 | (if begin-after-ip | |
3291 | (vhdl-add-syntax 'block-open))) | |
3292 | ;; Statement. But what kind? | |
3293 | ;; CASE 7: A case alternative key | |
3294 | ((and (looking-at vhdl-case-alternative-re) | |
3295 | (vhdl-case-alternative-p containing-sexp)) | |
3296 | ;; for a case alternative key, we set relpos to the first | |
3297 | ;; non-whitespace char on the line containing the "case" | |
3298 | ;; keyword. | |
3299 | (goto-char containing-sexp) | |
3300 | ;; If the \"begin\" keyword is a trailer, then find v-b-o-s | |
3301 | (if (looking-at vhdl-trailer-re) | |
3302 | (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) | |
3303 | (vhdl-add-syntax 'case-alternative (vhdl-point 'boi))) | |
3304 | ;; CASE 8: statement catchall | |
3305 | (t | |
3306 | ;; we know its a statement, but we need to find out if it is | |
3307 | ;; the first statement in a block | |
3308 | (if containing-leader | |
3309 | (goto-char containing-leader) | |
3310 | (goto-char containing-sexp) | |
3311 | ;; Note that a containing sexp here is always a keyword, | |
3312 | ;; not a paren, so skip over the keyword. | |
3313 | (forward-sexp)) | |
3314 | ;; move to the start of the first statement | |
3315 | (vhdl-forward-syntactic-ws indent-point) | |
3316 | (setq placeholder (point)) | |
3317 | ;; we want to ignore case alternatives keys when skipping forward | |
3318 | (let (incase-p) | |
3319 | (while (looking-at vhdl-case-alternative-re) | |
3320 | (setq incase-p (point)) | |
3321 | ;; we also want to skip over the body of the | |
3322 | ;; case/when statement if that doesn't put us at | |
3323 | ;; after the indent-point | |
3324 | (while (vhdl-skip-case-alternative indent-point)) | |
3325 | ;; set up the match end | |
3326 | (looking-at vhdl-case-alternative-re) | |
3327 | (goto-char (match-end 0)) | |
3328 | ;; move to the start of the first case alternative statement | |
3329 | (vhdl-forward-syntactic-ws indent-point) | |
3330 | (setq placeholder (point))) | |
3331 | (cond | |
3332 | ;; CASE 8A: we saw a case/when statement so we must be | |
3333 | ;; in a switch statement. find out if we are at the | |
3334 | ;; statement just after a case alternative key | |
3335 | ((and incase-p | |
3336 | (= (point) indent-point)) | |
3337 | ;; relpos is the "when" keyword | |
3338 | (vhdl-add-syntax 'statement-case-intro incase-p)) | |
3339 | ;; CASE 8B: any old statement | |
3340 | ((< (point) indent-point) | |
3341 | ;; relpos is the first statement of the block | |
3342 | (vhdl-add-syntax 'statement placeholder) | |
3343 | (if begin-after-ip | |
3344 | (vhdl-add-syntax 'block-open))) | |
3345 | ;; CASE 8C: first statement in a block | |
3346 | (t | |
3347 | (goto-char containing-sexp) | |
3348 | ;; If the \"begin\" keyword is a trailer, then find v-b-o-s | |
3349 | (if (looking-at vhdl-trailer-re) | |
3350 | (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) | |
3351 | (vhdl-backward-skip-label (vhdl-point 'boi)) | |
3352 | (vhdl-add-syntax 'statement-block-intro (point)) | |
3353 | (if begin-after-ip | |
3354 | (vhdl-add-syntax 'block-open))) | |
3355 | ))) | |
3356 | ) | |
3357 | ||
3358 | ;; now we need to look at any modifiers | |
3359 | (goto-char indent-point) | |
3360 | (skip-chars-forward " \t") | |
3361 | (if (looking-at "--") | |
3362 | (vhdl-add-syntax 'comment)) | |
3363 | ;; return the syntax | |
3364 | vhdl-syntactic-context)))) | |
3365 | ||
3366 | ;; Standard indentation line-ups: | |
3367 | ||
3368 | (defun vhdl-lineup-arglist (langelem) | |
3369 | ;; lineup the current arglist line with the arglist appearing just | |
3370 | ;; after the containing paren which starts the arglist. | |
3371 | (save-excursion | |
3372 | (let* ((containing-sexp | |
3373 | (save-excursion | |
3374 | ;; arglist-cont-nonempty gives relpos == | |
3375 | ;; to boi of containing-sexp paren. This | |
3376 | ;; is good when offset is +, but bad | |
3377 | ;; when it is vhdl-lineup-arglist, so we | |
3378 | ;; have to special case a kludge here. | |
3379 | (if (memq (car langelem) '(arglist-intro arglist-cont-nonempty)) | |
3380 | (progn | |
3381 | (beginning-of-line) | |
3382 | (backward-up-list 1) | |
3383 | (skip-chars-forward " \t" (vhdl-point 'eol))) | |
3384 | (goto-char (cdr langelem))) | |
3385 | (point))) | |
3386 | (cs-curcol (save-excursion | |
3387 | (goto-char (cdr langelem)) | |
3388 | (current-column)))) | |
3389 | (if (save-excursion | |
3390 | (beginning-of-line) | |
3391 | (looking-at "[ \t]*)")) | |
3392 | (progn (goto-char (match-end 0)) | |
3393 | (backward-sexp) | |
3394 | (forward-char) | |
3395 | (vhdl-forward-syntactic-ws) | |
3396 | (- (current-column) cs-curcol)) | |
3397 | (goto-char containing-sexp) | |
3398 | (or (eolp) | |
3399 | (let ((eol (vhdl-point 'eol)) | |
3400 | (here (progn | |
3401 | (forward-char) | |
3402 | (skip-chars-forward " \t") | |
3403 | (point)))) | |
3404 | (vhdl-forward-syntactic-ws) | |
3405 | (if (< (point) eol) | |
3406 | (goto-char here)))) | |
3407 | (- (current-column) cs-curcol) | |
3408 | )))) | |
3409 | ||
3410 | (defun vhdl-lineup-arglist-intro (langelem) | |
3411 | ;; lineup an arglist-intro line to just after the open paren | |
3412 | (save-excursion | |
3413 | (let ((cs-curcol (save-excursion | |
3414 | (goto-char (cdr langelem)) | |
3415 | (current-column))) | |
3416 | (ce-curcol (save-excursion | |
3417 | (beginning-of-line) | |
3418 | (backward-up-list 1) | |
3419 | (skip-chars-forward " \t" (vhdl-point 'eol)) | |
3420 | (current-column)))) | |
3421 | (- ce-curcol cs-curcol -1)))) | |
3422 | ||
3423 | (defun vhdl-lineup-comment (langelem) | |
3424 | ;; support old behavior for comment indentation. we look at | |
3425 | ;; vhdl-comment-only-line-offset to decide how to indent comment | |
3426 | ;; only-lines | |
3427 | (save-excursion | |
3428 | (back-to-indentation) | |
3429 | ;; at or to the right of comment-column | |
3430 | (if (>= (current-column) comment-column) | |
3431 | (vhdl-comment-indent) | |
3432 | ;; otherwise, indent as specified by vhdl-comment-only-line-offset | |
3433 | (if (not (bolp)) | |
3434 | (or (car-safe vhdl-comment-only-line-offset) | |
3435 | vhdl-comment-only-line-offset) | |
3436 | (or (cdr-safe vhdl-comment-only-line-offset) | |
3437 | (car-safe vhdl-comment-only-line-offset) | |
3438 | -1000 ;jam it against the left side | |
3439 | ))))) | |
3440 | ||
3441 | (defun vhdl-lineup-statement-cont (langelem) | |
3442 | ;; line up statement-cont after the assignment operator | |
3443 | (save-excursion | |
3444 | (let* ((relpos (cdr langelem)) | |
3445 | (assignp (save-excursion | |
3446 | (goto-char (vhdl-point 'boi)) | |
3447 | (and (re-search-forward "\\(<\\|:\\)=" | |
3448 | (vhdl-point 'eol) t) | |
3449 | (- (point) (vhdl-point 'boi))))) | |
3450 | (curcol (progn | |
3451 | (goto-char relpos) | |
3452 | (current-column))) | |
3453 | foundp) | |
3454 | (while (and (not foundp) | |
3455 | (< (point) (vhdl-point 'eol))) | |
3456 | (re-search-forward "\\(<\\|:\\)=\\|(" (vhdl-point 'eol) 'move) | |
3457 | (if (vhdl-in-literal (cdr langelem)) | |
3458 | (forward-char) | |
3459 | (if (= (preceding-char) ?\() | |
3460 | ;; skip over any parenthesized expressions | |
3461 | (goto-char (min (vhdl-point 'eol) | |
3462 | (scan-lists (point) 1 1))) | |
3463 | ;; found an assignment operator (not at eol) | |
3464 | (setq foundp (not (looking-at "\\s-*$")))))) | |
3465 | (if (not foundp) | |
3466 | ;; there's no assignment operator on the line | |
3467 | vhdl-basic-offset | |
3468 | ;; calculate indentation column after assign and ws, unless | |
3469 | ;; our line contains an assignment operator | |
3470 | (if (not assignp) | |
3471 | (progn | |
3472 | (forward-char) | |
3473 | (skip-chars-forward " \t") | |
3474 | (setq assignp 0))) | |
3475 | (- (current-column) assignp curcol)) | |
3476 | ))) | |
3477 | ||
3478 | ;; ############################################################################ | |
3479 | ;; Indentation commands | |
3480 | ||
3481 | (defun vhdl-tab (&optional pre-arg) | |
3482 | "If preceeding character is part of a word then dabbrev-expand, | |
3483 | else if right of non whitespace on line then tab-to-tab-stop, | |
3484 | else if last command was a tab or return then dedent one step, | |
3485 | else indent `correctly'." | |
3486 | (interactive "*P") | |
3487 | (cond ((= (char-syntax (preceding-char)) ?w) | |
3488 | (let ((case-fold-search nil)) (dabbrev-expand pre-arg))) | |
3489 | ((> (current-column) (current-indentation)) | |
3490 | (tab-to-tab-stop)) | |
3491 | ((and (or (eq last-command 'vhdl-tab) | |
3492 | (eq last-command 'vhdl-return)) | |
3493 | (/= 0 (current-indentation))) | |
3494 | (backward-delete-char-untabify vhdl-basic-offset nil)) | |
3495 | ((vhdl-indent-line)) | |
3496 | ) | |
3497 | (setq this-command 'vhdl-tab) | |
3498 | ) | |
3499 | ||
3500 | (defun vhdl-untab () | |
3501 | "Delete backwards to previous tab stop." | |
3502 | (interactive) | |
3503 | (backward-delete-char-untabify vhdl-basic-offset nil) | |
3504 | ) | |
3505 | ||
3506 | (defun vhdl-return () | |
3507 | "newline-and-indent or indent-new-comment-line if in comment and preceding | |
3508 | character is a space." | |
3509 | (interactive) | |
3510 | (if (and (= (preceding-char) ? ) (vhdl-in-comment-p)) | |
3511 | (indent-new-comment-line) | |
3512 | (newline-and-indent) | |
3513 | ) | |
3514 | ) | |
3515 | ||
3516 | (defun vhdl-indent-line () | |
3517 | "Indent the current line as VHDL code. Returns the amount of | |
3518 | indentation change." | |
3519 | (interactive) | |
3520 | (let* ((syntax (vhdl-get-syntactic-context)) | |
3521 | (pos (- (point-max) (point))) | |
3522 | (indent (apply '+ (mapcar 'vhdl-get-offset syntax))) | |
3523 | (shift-amt (- (current-indentation) indent))) | |
3524 | (and vhdl-echo-syntactic-information-p | |
3525 | (message "syntax: %s, indent= %d" syntax indent)) | |
3526 | (if (zerop shift-amt) | |
3527 | nil | |
3528 | (delete-region (vhdl-point 'bol) (vhdl-point 'boi)) | |
3529 | (beginning-of-line) | |
3530 | (indent-to indent)) | |
3531 | (if (< (point) (vhdl-point 'boi)) | |
3532 | (back-to-indentation) | |
3533 | ;; If initial point was within line's indentation, position after | |
3534 | ;; the indentation. Else stay at same point in text. | |
3535 | (if (> (- (point-max) pos) (point)) | |
3536 | (goto-char (- (point-max) pos))) | |
3537 | ) | |
3538 | (run-hooks 'vhdl-special-indent-hook) | |
3539 | shift-amt)) | |
3540 | ||
3541 | (defun vhdl-indent-buffer () | |
3542 | "Indent whole buffer as VHDL code." | |
3543 | (interactive) | |
3544 | (indent-region (point-min) (point-max) nil) | |
3545 | ) | |
3546 | ||
3547 | (defun vhdl-indent-sexp (&optional endpos) | |
3548 | "Indent each line of the list starting just after point. | |
3549 | If optional arg ENDPOS is given, indent each line, stopping when | |
3550 | ENDPOS is encountered." | |
3551 | (interactive) | |
3552 | (save-excursion | |
3553 | (let ((beg (point)) | |
3554 | (end (progn | |
3555 | (vhdl-forward-sexp nil endpos) | |
3556 | (point)))) | |
3557 | (indent-region beg end nil)))) | |
3558 | ||
3559 | ;; ############################################################################ | |
3560 | ;; Miscellaneous commands | |
3561 | ||
3562 | (defun vhdl-show-syntactic-information () | |
3563 | "Show syntactic information for current line." | |
3564 | (interactive) | |
3565 | (message "syntactic analysis: %s" (vhdl-get-syntactic-context)) | |
3566 | (vhdl-keep-region-active)) | |
3567 | ||
3568 | ;; Verification and regression functions: | |
3569 | ||
3570 | (defun vhdl-regress-line (&optional arg) | |
3571 | "Check syntactic information for current line." | |
3572 | (interactive "P") | |
3573 | (let ((expected (save-excursion | |
3574 | (end-of-line) | |
3575 | (if (search-backward " -- ((" (vhdl-point 'bol) t) | |
3576 | (progn | |
3577 | (forward-char 4) | |
3578 | (read (current-buffer)))))) | |
3579 | (actual (vhdl-get-syntactic-context)) | |
3580 | (expurgated)) | |
3581 | ;; remove the library unit symbols | |
3582 | (mapcar | |
3583 | (function | |
3584 | (lambda (elt) | |
3585 | (if (memq (car elt) '(entity configuration package | |
3586 | package-body architecture)) | |
3587 | nil | |
3588 | (setq expurgated (append expurgated (list elt)))))) | |
3589 | actual) | |
3590 | (if (and (not arg) expected (listp expected)) | |
3591 | (if (not (equal expected expurgated)) | |
3592 | (error "Should be: %s, is: %s" expected expurgated)) | |
3593 | (save-excursion | |
3594 | (beginning-of-line) | |
3595 | (if (not (looking-at "^\\s-*\\(--.*\\)?$")) | |
3596 | (progn | |
3597 | (end-of-line) | |
3598 | (if (search-backward " -- ((" (vhdl-point 'bol) t) | |
3599 | (kill-line)) | |
3600 | (insert " -- ") | |
3601 | (insert (format "%s" expurgated))))))) | |
3602 | (vhdl-keep-region-active)) | |
3603 | ||
3604 | ||
3605 | ;; ############################################################################ | |
3606 | ;; Alignment | |
3607 | ;; ############################################################################ | |
3608 | ||
3609 | (defvar vhdl-align-alist | |
3610 | '( | |
3611 | ;; after some keywords | |
3612 | (vhdl-mode "\\<\\(alias\\|constant\\|signal\\|subtype\\|type\\|variable\\)[ \t]" | |
3613 | "\\<\\(alias\\|constant\\|signal\\|subtype\\|type\\|variable\\)\\([ \t]+\\)" 2) | |
3614 | ;; before ':' | |
3615 | (vhdl-mode ":[^=]" "[^ \t]\\([ \t]*\\):[^=]") | |
3616 | ;; after ':' | |
3617 | (vhdl-mode ":[^=]" ":\\([ \t]*\\)[^=]" 1) | |
3618 | ;; after direction specifications | |
3619 | (vhdl-mode ":[ \t]*\\(in\\|out\\|inout\\|buffer\\)\\>" | |
3620 | ":[ \t]*\\(in\\|out\\|inout\\|buffer\\)\\([ \t]+\\)" 2) | |
3621 | ;; before "<=", "=>", and ":=" | |
3622 | (vhdl-mode "<=" "[^ \t]\\([ \t]*\\)<=" 1) | |
3623 | (vhdl-mode "=>" "[^ \t]\\([ \t]*\\)=>" 1) | |
3624 | (vhdl-mode ":=" "[^ \t]\\([ \t]*\\):=" 1) | |
3625 | ;; after "<=", "=>", and ":=" | |
3626 | (vhdl-mode "<=" "<=\\([ \t]*\\)" 1) | |
3627 | (vhdl-mode "=>" "=>\\([ \t]*\\)" 1) | |
3628 | (vhdl-mode ":=" ":=\\([ \t]*\\)" 1) | |
3629 | ;; before some keywords | |
3630 | (vhdl-mode "[ \t]after\\>" "[^ \t]\\([ \t]+\\)after\\>" 1) | |
3631 | (vhdl-mode "[ \t]\\(fs\\|ps\\|ns\\|us\\|ms\\|sec\\|min\\|hr\\)\\>" | |
3632 | "[^ \t]\\([ \t]+\\)\\(fs\\|ps\\|ns\\|us\\|ms\\|sec\\|min\\|hr\\)\\>" 1) | |
3633 | (vhdl-mode "[ \t]when\\>" "[^ \t]\\([ \t]+\\)when\\>" 1) | |
3634 | (vhdl-mode "[ \t]else\\>" "[^ \t]\\([ \t]+\\)else\\>" 1) | |
3635 | (vhdl-mode "[ \t]is\\>" "[^ \t]\\([ \t]+\\)is\\>" 1) | |
3636 | (vhdl-mode "[ \t]of\\>" "[^ \t]\\([ \t]+\\)of\\>" 1) | |
3637 | (vhdl-mode "[ \t]use\\>" "[^ \t]\\([ \t]+\\)use\\>" 1) | |
3638 | ;; before comments (two steps required for correct insertion of two spaces) | |
3639 | (vhdl-mode "--" "[^ \t]\\([ \t]*\\)--" 1) | |
3640 | (vhdl-mode "--" "[^ \t][ \t]\\([ \t]*\\)--" 1) | |
3641 | ) | |
3642 | "The format of this alist is | |
3643 | (MODES [or MODE] REGEXP ALIGN-PATTERN SUBEXP). | |
3644 | It is searched in order. If REGEXP is found anywhere in the first | |
3645 | line of a region to be aligned, ALIGN-PATTERN will be used for that | |
3646 | region. ALIGN-PATTERN must include the whitespace to be expanded or | |
3647 | contracted. It may also provide regexps for the text surrounding the | |
3648 | whitespace. SUBEXP specifies which sub-expression of | |
3649 | ALIGN-PATTERN matches the white space to be expanded/contracted.") | |
3650 | ||
3651 | (defvar vhdl-align-try-all-clauses t | |
3652 | "If REGEXP is not found on the first line of the region that clause | |
3653 | is ignored. If this variable is non-nil, then the clause is tried anyway.") | |
3654 | ||
3655 | (defun vhdl-align (begin end spacing &optional alignment-list quick) | |
3656 | "Attempt to align a range of lines based on the content of the | |
3657 | lines. The definition of 'alignment-list' determines the matching | |
3658 | order and the manner in which the lines are aligned. If ALIGNMENT-LIST | |
3659 | is not specified 'vhdl-align-alist' is used. If QUICK is non-nil, no | |
3660 | indentation is done before aligning." | |
3661 | (interactive "r\np") | |
3662 | (if (not alignment-list) | |
3663 | (setq alignment-list vhdl-align-alist)) | |
3664 | (if (not spacing) | |
3665 | (setq spacing 1)) | |
3666 | (save-excursion | |
3667 | (let (bol indent) | |
3668 | (goto-char end) | |
3669 | (setq end (point-marker)) | |
3670 | (goto-char begin) | |
3671 | (setq bol | |
3672 | (setq begin (progn (beginning-of-line) (point)))) | |
3673 | (untabify bol end) | |
3674 | (if quick | |
3675 | nil | |
3676 | (indent-region bol end nil)))) | |
3677 | (let ((copy (copy-alist alignment-list))) | |
3678 | (while copy | |
3679 | (save-excursion | |
3680 | (goto-char begin) | |
3681 | (let (element | |
3682 | (eol (save-excursion (progn (end-of-line) (point))))) | |
3683 | (setq element (nth 0 copy)) | |
3684 | (if (and (or (and (listp (car element)) | |
3685 | (memq major-mode (car element))) | |
3686 | (eq major-mode (car element))) | |
3687 | (or vhdl-align-try-all-clauses | |
3688 | (re-search-forward (car (cdr element)) eol t))) | |
3689 | (progn | |
3690 | (vhdl-align-region begin end (car (cdr (cdr element))) | |
3691 | (car (cdr (cdr (cdr element)))) spacing))) | |
3692 | (setq copy (cdr copy))))))) | |
3693 | ||
3694 | (defun vhdl-align-region (begin end match &optional substr spacing) | |
3695 | "Align a range of lines from BEGIN to END. The regular expression | |
3696 | MATCH must match exactly one fields: the whitespace to be | |
3697 | contracted/expanded. The alignment column will equal the | |
3698 | rightmost column of the widest whitespace block. SPACING is | |
3699 | the amount of extra spaces to add to the calculated maximum required. | |
3700 | SPACING defaults to 1 so that at least one space is inserted after | |
3701 | the token in MATCH." | |
3702 | (if (not spacing) | |
3703 | (setq spacing 1)) | |
3704 | (if (not substr) | |
3705 | (setq substr 1)) | |
3706 | (save-excursion | |
3707 | (let (distance (max 0) (lines 0) bol eol width) | |
3708 | ;; Determine the greatest whitespace distance to the alignment | |
3709 | ;; character | |
3710 | (goto-char begin) | |
3711 | (setq eol (progn (end-of-line) (point)) | |
3712 | bol (setq begin (progn (beginning-of-line) (point)))) | |
3713 | (while (< bol end) | |
3714 | (save-excursion | |
3715 | (if (re-search-forward match eol t) | |
3716 | (progn | |
3717 | (setq distance (- (match-beginning substr) bol)) | |
3718 | (if (> distance max) | |
3719 | (setq max distance))))) | |
3720 | (forward-line) | |
3721 | (setq bol (point) | |
3722 | eol (save-excursion | |
3723 | (end-of-line) | |
3724 | (point))) | |
3725 | (setq lines (1+ lines))) | |
3726 | ;; Now insert enough maxs to push each assignment operator to | |
3727 | ;; the same column. We need to use 'lines' as a counter, since | |
3728 | ;; the location of the mark may change | |
3729 | (goto-char (setq bol begin)) | |
3730 | (setq eol (save-excursion | |
3731 | (end-of-line) | |
3732 | (point))) | |
3733 | (while (> lines 0) | |
3734 | (if (re-search-forward match eol t) | |
3735 | (progn | |
3736 | (setq width (- (match-end substr) (match-beginning substr))) | |
3737 | (setq distance (- (match-beginning substr) bol)) | |
3738 | (goto-char (match-beginning substr)) | |
3739 | (delete-char width) | |
3740 | (insert-char ? (+ (- max distance) spacing)))) | |
3741 | (beginning-of-line) | |
3742 | (forward-line) | |
3743 | (setq bol (point) | |
3744 | eol (save-excursion | |
3745 | (end-of-line) | |
3746 | (point))) | |
3747 | (setq lines (1- lines)) | |
3748 | )))) | |
3749 | ||
3750 | (defun vhdl-align-comment-region (begin end spacing) | |
3751 | "Aligns inline comments within a region relative to first comment." | |
3752 | (interactive "r\nP") | |
3753 | (vhdl-align begin end (or spacing 2) | |
3754 | `((vhdl-mode "--" "[^ \t]\\([ \t]*\\)--" 1)) t)) | |
3755 | ||
3756 | (defun vhdl-align-noindent-region (begin end spacing) | |
3757 | "Align without indentation." | |
3758 | (interactive "r\nP") | |
3759 | (vhdl-align begin end spacing nil t) | |
3760 | ) | |
3761 | ||
3762 | ||
3763 | ;; ############################################################################ | |
3764 | ;; VHDL electrification | |
3765 | ;; ############################################################################ | |
3766 | ||
3767 | ;; ############################################################################ | |
3768 | ;; Stuttering | |
3769 | ||
3770 | (defun vhdl-stutter-mode-caps (count) | |
3771 | "Double first letters of a word replaced by a single capital of the letter." | |
3772 | (interactive "p") | |
3773 | (if vhdl-stutter-mode | |
3774 | (if (and | |
3775 | (= (preceding-char) last-input-char) ; doubled | |
3776 | (or (= (point) 2) ; beginning of buffer | |
3777 | (/= (char-syntax (char-after (- (point) 2))) ?w) ;not mid-word | |
3778 | (< (char-after (- (point) 2)) ?A))) ;alfa-numeric | |
3779 | (progn (delete-char -1) (insert-char (- last-input-char 32) count)) | |
3780 | (self-insert-command count)) | |
3781 | (self-insert-command count) | |
3782 | )) | |
3783 | ||
3784 | (defun vhdl-stutter-mode-close-bracket (count) " ']' --> ')', ')]' --> ']'" | |
3785 | (interactive "p") | |
3786 | (if (and vhdl-stutter-mode (= count 1)) | |
3787 | (progn | |
3788 | (if (= (preceding-char) 41) ; close-paren | |
3789 | (progn (delete-char -1) (insert-char 93 1)) ; close-bracket | |
3790 | (insert-char 41 1) ; close-paren | |
3791 | ) | |
3792 | (blink-matching-open)) | |
3793 | (self-insert-command count) | |
3794 | )) | |
3795 | ||
3796 | (defun vhdl-stutter-mode-semicolon (count) " ';;' --> ' : ', ': ;' --> ' := '" | |
3797 | (interactive "p") | |
3798 | (if (and vhdl-stutter-mode (= count 1)) | |
3799 | (progn | |
3800 | (cond ((= (preceding-char) last-input-char) | |
3801 | (progn (delete-char -1) | |
3802 | (if (not (eq (preceding-char) ? )) (insert " ")) | |
3803 | (insert ": "))) | |
3804 | ((and | |
3805 | (eq last-command 'vhdl-stutter-mode-colon) (= (preceding-char) ? )) | |
3806 | (progn (delete-char -1) (insert "= "))) | |
3807 | (t | |
3808 | (insert-char 59 1)) ; semi-colon | |
3809 | ) | |
3810 | (setq this-command 'vhdl-stutter-mode-colon)) | |
3811 | (self-insert-command count) | |
3812 | )) | |
3813 | ||
3814 | (defun vhdl-stutter-mode-open-bracket (count) " '[' --> '(', '([' --> '['" | |
3815 | (interactive "p") | |
3816 | (if (and vhdl-stutter-mode (= count 1)) | |
3817 | (if (= (preceding-char) 40) ; open-paren | |
3818 | (progn (delete-char -1) (insert-char 91 1)) ; open-bracket | |
3819 | (insert-char 40 1)) ; open-paren | |
3820 | (self-insert-command count) | |
3821 | )) | |
3822 | ||
3823 | (defun vhdl-stutter-mode-quote (count) " '' --> \"" | |
3824 | (interactive "p") | |
3825 | (if (and vhdl-stutter-mode (= count 1)) | |
3826 | (if (= (preceding-char) last-input-char) | |
3827 | (progn (delete-backward-char 1) (insert-char 34 1)) ; double-quote | |
3828 | (insert-char 39 1)) ; single-quote | |
3829 | (self-insert-command count) | |
3830 | )) | |
3831 | ||
3832 | (defun vhdl-stutter-mode-comma (count) " ',,' --> ' <= '" | |
3833 | (interactive "p") | |
3834 | (if (and vhdl-stutter-mode (= count 1)) | |
3835 | (cond ((= (preceding-char) last-input-char) | |
3836 | (progn (delete-char -1) | |
3837 | (if (not (eq (preceding-char) ? )) (insert " ")) | |
3838 | (insert "<= "))) | |
3839 | (t | |
3840 | (insert-char 44 1))) ; comma | |
3841 | (self-insert-command count) | |
3842 | )) | |
3843 | ||
3844 | (defun vhdl-stutter-mode-period (count) " '..' --> ' => '" | |
3845 | (interactive "p") | |
3846 | (if (and vhdl-stutter-mode (= count 1)) | |
3847 | (cond ((= (preceding-char) last-input-char) | |
3848 | (progn (delete-char -1) | |
3849 | (if (not (eq (preceding-char) ? )) (insert " ")) | |
3850 | (insert "=> "))) | |
3851 | (t | |
3852 | (insert-char 46 1))) ; period | |
3853 | (self-insert-command count) | |
3854 | )) | |
3855 | ||
3856 | (defun vhdl-paired-parens () | |
3857 | "Insert a pair of round parentheses, placing point between them." | |
3858 | (interactive) | |
3859 | (insert "()") | |
3860 | (backward-char) | |
3861 | ) | |
3862 | ||
3863 | (defun vhdl-stutter-mode-dash (count) | |
3864 | "-- starts a comment, --- draws a horizontal line, | |
3865 | ---- starts a display comment" | |
3866 | (interactive "p") | |
3867 | (if vhdl-stutter-mode | |
3868 | (cond ((and abbrev-start-location (= abbrev-start-location (point))) | |
3869 | (setq abbrev-start-location nil) | |
3870 | (goto-char last-abbrev-location) | |
3871 | (beginning-of-line nil) | |
3872 | (vhdl-display-comment)) | |
3873 | ((/= (preceding-char) ?-) ; standard dash (minus) | |
3874 | (self-insert-command count)) | |
3875 | (t | |
3876 | (self-insert-command count) | |
3877 | (message "Enter - for horiz. line, CR for commenting-out code, else 1st char of comment") | |
3878 | (let ((next-input (read-char))) | |
3879 | (if (= next-input ?-) ; triple dash | |
3880 | (progn | |
3881 | (vhdl-display-comment-line) | |
3882 | (message | |
3883 | "Enter - for display comment, else continue with coding") | |
3884 | (let ((next-input (read-char))) | |
3885 | (if (= next-input ?-) ; four dashes | |
3886 | (vhdl-display-comment t) | |
3887 | (setq unread-command-events ;pushback the char | |
3888 | (list | |
3889 | (vhdl-character-to-event-hack next-input))) | |
3890 | ))) | |
3891 | (setq unread-command-events ;pushback the char | |
3892 | (list (vhdl-character-to-event-hack next-input))) | |
3893 | (vhdl-inline-comment) | |
3894 | )))) | |
3895 | (self-insert-command count) | |
3896 | )) | |
3897 | ||
3898 | ;; ############################################################################ | |
3899 | ;; VHDL templates | |
3900 | ||
3901 | (defun vhdl-alias () | |
3902 | "Insert alias declaration." | |
3903 | (interactive) | |
3904 | (vhdl-insert-keyword "ALIAS ") | |
3905 | (if (equal (vhdl-field "name") "") | |
3906 | nil | |
3907 | (insert " : ") | |
3908 | (vhdl-field "type") | |
3909 | (vhdl-insert-keyword " IS ") | |
3910 | (vhdl-field "name" ";") | |
3911 | (vhdl-declaration-comment) | |
3912 | )) | |
3913 | ||
3914 | (defun vhdl-architecture () | |
3915 | "Insert architecture template." | |
3916 | (interactive) | |
3917 | (let ((margin (current-column)) | |
3918 | (vhdl-architecture-name) | |
3919 | (position) | |
3920 | (entity-exists) | |
3921 | (string) | |
3922 | (case-fold-search t)) | |
3923 | (vhdl-insert-keyword "ARCHITECTURE ") | |
3924 | (if (equal (setq vhdl-architecture-name (vhdl-field "name")) "") | |
3925 | nil | |
3926 | (vhdl-insert-keyword " OF ") | |
3927 | (setq position (point)) | |
3928 | (setq entity-exists | |
3929 | (re-search-backward "entity \\(\\(\\w\\|\\s_\\)+\\) is" nil t)) | |
3930 | (setq string (match-string 1)) | |
3931 | (goto-char position) | |
3932 | (if (and entity-exists (not (equal string ""))) | |
3933 | (insert string) | |
3934 | (vhdl-field "entity name")) | |
3935 | (vhdl-insert-keyword " IS") | |
3936 | (vhdl-begin-end (cons vhdl-architecture-name margin)) | |
3937 | (vhdl-block-comment) | |
3938 | ))) | |
3939 | ||
3940 | ||
3941 | (defun vhdl-array () | |
3942 | "Insert array type definition." | |
3943 | (interactive) | |
3944 | (vhdl-insert-keyword "ARRAY (") | |
3945 | (if (equal (vhdl-field "range") "") | |
3946 | (delete-char -1) | |
3947 | (vhdl-insert-keyword ") OF ") | |
3948 | (vhdl-field "type") | |
3949 | (vhdl-insert-keyword ";") | |
3950 | )) | |
3951 | ||
3952 | (defun vhdl-assert () | |
3953 | "Inserts a assertion statement." | |
3954 | (interactive) | |
3955 | (vhdl-insert-keyword "ASSERT ") | |
3956 | (if vhdl-conditions-in-parenthesis (insert "(")) | |
3957 | (if (equal (vhdl-field "condition (negated)") "") | |
3958 | (progn (undo 0) (insert " ")) | |
3959 | (if vhdl-conditions-in-parenthesis (insert ")")) | |
3960 | (vhdl-insert-keyword " REPORT \"") | |
3961 | (vhdl-field "string-expression" "\" ") | |
3962 | (vhdl-insert-keyword "SEVERITY ") | |
3963 | (if (equal (vhdl-field "[note | warning | error | failure]") "") | |
3964 | (delete-char -10)) | |
3965 | (insert ";") | |
3966 | )) | |
3967 | ||
3968 | (defun vhdl-attribute () | |
3969 | "Inserts an attribute declaration or specification." | |
3970 | (interactive) | |
3971 | (vhdl-insert-keyword "ATTRIBUTE ") | |
3972 | (if (y-or-n-p "declaration (or specification)? ") | |
3973 | (progn | |
3974 | (vhdl-field "name" " : ") | |
3975 | (vhdl-field "type" ";") | |
3976 | (vhdl-declaration-comment)) | |
3977 | (vhdl-field "name") | |
3978 | (vhdl-insert-keyword " OF ") | |
3979 | (vhdl-field "entity name" " : ") | |
3980 | (vhdl-field "entity class") | |
3981 | (vhdl-insert-keyword " IS ") | |
3982 | (vhdl-field "expression" ";") | |
3983 | )) | |
3984 | ||
3985 | (defun vhdl-block () | |
3986 | "Insert a block template." | |
3987 | (interactive) | |
3988 | (let ((position (point))) | |
3989 | (vhdl-insert-keyword " : BLOCK ") | |
3990 | (goto-char position)) | |
3991 | (let* ((margin (current-column)) | |
3992 | (name (vhdl-field "label"))) | |
3993 | (if (equal name "") | |
3994 | (progn (undo 0) (insert " ")) | |
3995 | (end-of-line) | |
3996 | (insert "(") | |
3997 | (if (equal (vhdl-field "[guard expression]") "") | |
3998 | (delete-char -2) | |
3999 | (insert ")")) | |
4000 | (vhdl-begin-end (cons (concat (vhdl-case-keyword "BLOCK ") name) margin)) | |
4001 | (vhdl-block-comment) | |
4002 | ))) | |
4003 | ||
4004 | (defun vhdl-block-configuration () | |
4005 | "Insert a block configuration statement." | |
4006 | (interactive) | |
4007 | (let ((margin (current-column))) | |
4008 | (vhdl-insert-keyword "FOR ") | |
4009 | (if (equal (setq name (vhdl-field "block specification")) "") | |
4010 | nil | |
4011 | (vhdl-insert-keyword "\n\n") | |
4012 | (indent-to margin) | |
4013 | (vhdl-insert-keyword "END FOR;") | |
4014 | (end-of-line 0) | |
4015 | (indent-to (+ margin vhdl-basic-offset)) | |
4016 | ))) | |
4017 | ||
4018 | (defun vhdl-case () | |
4019 | "Inserts a case statement." | |
4020 | (interactive) | |
4021 | (let ((margin (current-column)) | |
4022 | (name)) | |
4023 | (vhdl-insert-keyword "CASE ") | |
4024 | (if (equal (setq name (vhdl-field "expression")) "") | |
4025 | nil | |
4026 | (vhdl-insert-keyword " IS\n\n") | |
4027 | (indent-to margin) | |
4028 | (vhdl-insert-keyword "END CASE;") | |
4029 | ; (if vhdl-self-insert-comments (insert " -- " name)) | |
4030 | (forward-line -1) | |
4031 | (indent-to (+ margin vhdl-basic-offset)) | |
4032 | (vhdl-insert-keyword "WHEN => ") | |
4033 | (backward-char 4) | |
4034 | ))) | |
4035 | ||
4036 | (defun vhdl-component () | |
4037 | "Inserts a component declaration." | |
4038 | (interactive) | |
4039 | (let ((margin (current-column))) | |
4040 | (vhdl-insert-keyword "COMPONENT ") | |
4041 | (if (equal (vhdl-field "name") "") | |
4042 | nil | |
4043 | (insert "\n\n") | |
4044 | (indent-to margin) | |
4045 | (vhdl-insert-keyword "END COMPONENT;") | |
4046 | (end-of-line -0) | |
4047 | (indent-to (+ margin vhdl-basic-offset)) | |
4048 | (vhdl-insert-keyword "GENERIC (") | |
4049 | (vhdl-get-generic t t) | |
4050 | (insert "\n") | |
4051 | (indent-to (+ margin vhdl-basic-offset)) | |
4052 | (vhdl-insert-keyword "PORT (") | |
4053 | (vhdl-get-port t t) | |
4054 | (forward-line 1)) | |
4055 | )) | |
4056 | ||
4057 | (defun vhdl-component-configuration () | |
4058 | "Inserts a component configuration (uses `vhdl-configuration-spec' since | |
4059 | these are almost equivalent)." | |
4060 | (interactive) | |
4061 | (let ((margin (current-column))) | |
4062 | (vhdl-configuration-spec) | |
4063 | (insert "\n") | |
4064 | (indent-to margin) | |
4065 | (vhdl-insert-keyword "END FOR;") | |
4066 | )) | |
4067 | ||
4068 | (defun vhdl-component-instance () | |
4069 | "Inserts a component instantiation statement." | |
4070 | (interactive) | |
4071 | (let ((margin (current-column))) | |
4072 | (if (equal (vhdl-field "instance label") "") | |
4073 | nil | |
4074 | (insert " : ") | |
4075 | (vhdl-field "component name" "\n") | |
4076 | (indent-to (+ margin vhdl-basic-offset)) | |
4077 | (let ((position (point))) | |
4078 | (vhdl-insert-keyword "GENERIC MAP (") | |
4079 | (if (equal (vhdl-field "[association list]") "") | |
4080 | (progn (goto-char position) | |
4081 | (kill-line)) | |
4082 | (insert ")\n") | |
4083 | (indent-to (+ margin vhdl-basic-offset)))) | |
4084 | (vhdl-insert-keyword "PORT MAP (") | |
4085 | (vhdl-field "association list" ");") | |
4086 | ))) | |
4087 | ||
4088 | (defun vhdl-concurrent-signal-assignment () | |
4089 | "Inserts a concurrent signal assignment." | |
4090 | (interactive) | |
4091 | (if (equal (vhdl-field "target signal") "") | |
4092 | nil | |
4093 | (insert " <= ") | |
4094 | ; (if (not (equal (vhdl-field "[GUARDED] [TRANSPORT]") "")) | |
4095 | ; (insert " ")) | |
4096 | (let ((margin (current-column)) | |
4097 | (start (point))) | |
4098 | (vhdl-field "waveform") | |
4099 | (vhdl-insert-keyword " WHEN ") | |
4100 | (if vhdl-conditions-in-parenthesis (insert "(")) | |
4101 | (while (not (equal (vhdl-field "[condition]") "")) | |
4102 | (if vhdl-conditions-in-parenthesis (insert ")")) | |
4103 | (vhdl-insert-keyword " ELSE") | |
4104 | (insert "\n") | |
4105 | (indent-to margin) | |
4106 | (vhdl-field "waveform") | |
4107 | (vhdl-insert-keyword " WHEN ") | |
4108 | (if vhdl-conditions-in-parenthesis (insert "("))) | |
4109 | (delete-char -6) | |
4110 | (if vhdl-conditions-in-parenthesis (delete-char -1)) | |
4111 | (insert ";") | |
4112 | (if vhdl-auto-align (vhdl-align start (point) 1)) | |
4113 | ))) | |
4114 | ||
4115 | (defun vhdl-configuration () | |
4116 | "Inserts a configuration specification if within an architecture, | |
4117 | a block or component configuration if within a configuration declaration, | |
4118 | a configuration declaration if not within a design unit." | |
4119 | (interactive) | |
4120 | (cond ((equal (car (car (cdr (vhdl-get-syntactic-context)))) 'architecture) | |
4121 | (vhdl-configuration-spec)) | |
4122 | ((equal (car (car (cdr (vhdl-get-syntactic-context)))) 'configuration) | |
4123 | (if (y-or-n-p "block configuration (or component configuration)? ") | |
4124 | (vhdl-block-configuration) | |
4125 | (vhdl-component-configuration))) | |
4126 | (t (vhdl-configuration-decl))) | |
4127 | ) | |
4128 | ||
4129 | (defun vhdl-configuration-spec () | |
4130 | "Inserts a configuration specification." | |
4131 | (interactive) | |
4132 | (let ((margin (current-column))) | |
4133 | (vhdl-insert-keyword "FOR ") | |
4134 | (if (equal (vhdl-field "(component names | ALL)" " : ") "") | |
4135 | (progn (undo 0) (insert " ")) | |
4136 | (vhdl-field "component type" "\n") | |
4137 | (indent-to (+ margin vhdl-basic-offset)) | |
4138 | (vhdl-insert-keyword "USE ENTITY ") | |
4139 | (vhdl-field "library name" ".") | |
4140 | (vhdl-field "entity name" "(") | |
4141 | (if (equal (vhdl-field "[architecture name]") "") | |
4142 | (delete-char -1) | |
4143 | (insert ")")) | |
4144 | (insert "\n") | |
4145 | (indent-to (+ margin vhdl-basic-offset)) | |
4146 | (vhdl-insert-keyword "GENERIC MAP (") | |
4147 | (if (equal (vhdl-field "[association list]") "") | |
4148 | (progn (kill-line -0) | |
4149 | (indent-to (+ margin vhdl-basic-offset))) | |
4150 | (insert ")\n") | |
4151 | (indent-to (+ margin vhdl-basic-offset))) | |
4152 | (vhdl-insert-keyword "PORT MAP (") | |
4153 | (if (equal (vhdl-field "[association list]") "") | |
4154 | (progn (kill-line -0) | |
4155 | (delete-char -1)) | |
4156 | (insert ")")) | |
4157 | (insert ";") | |
4158 | ))) | |
4159 | ||
4160 | (defun vhdl-configuration-decl () | |
4161 | "Inserts a configuration declaration." | |
4162 | (interactive) | |
4163 | (let ((margin (current-column)) | |
4164 | (position) | |
4165 | (entity-exists) | |
4166 | (string) | |
4167 | (name)) | |
4168 | (vhdl-insert-keyword "CONFIGURATION ") | |
4169 | (if (equal (setq name (vhdl-field "name")) "") | |
4170 | nil | |
4171 | (vhdl-insert-keyword " OF ") | |
4172 | (setq position (point)) | |
4173 | (setq entity-exists | |
4174 | (re-search-backward "entity \\(\\(\\w\\|\\s_\\)*\\) is" nil t)) | |
4175 | (setq string (match-string 1)) | |
4176 | (goto-char position) | |
4177 | (if (and entity-exists (not (equal string ""))) | |
4178 | (insert string) | |
4179 | (vhdl-field "entity name")) | |
4180 | (vhdl-insert-keyword " IS\n\n") | |
4181 | (indent-to margin) | |
4182 | (vhdl-insert-keyword "END ") | |
4183 | (insert name ";") | |
4184 | (end-of-line 0) | |
4185 | (indent-to (+ margin vhdl-basic-offset)) | |
4186 | ))) | |
4187 | ||
4188 | (defun vhdl-constant () | |
4189 | "Inserts a constant declaration." | |
4190 | (interactive) | |
4191 | (vhdl-insert-keyword "CONSTANT ") | |
4192 | (let ((in-arglist (string-match "arglist" | |
4193 | (format "%s" (car (car (vhdl-get-syntactic-context))))))) | |
4194 | (if (not in-arglist) | |
4195 | (let ((opoint (point))) | |
4196 | (beginning-of-line) | |
4197 | (setq in-arglist (looking-at ".*(")) | |
4198 | (goto-char opoint))) | |
4199 | (if (equal (vhdl-field "name") "") | |
4200 | nil | |
4201 | (insert " : ") | |
4202 | (if in-arglist (vhdl-insert-keyword "IN ")) | |
4203 | (vhdl-field "type") | |
4204 | (if in-arglist | |
4205 | (insert ";") | |
4206 | (let ((position (point))) | |
4207 | (insert " := ") | |
4208 | (if (equal (vhdl-field "[initialization]" ";") "") | |
4209 | (progn (goto-char position) (kill-line) (insert ";"))) | |
4210 | (vhdl-declaration-comment)) | |
4211 | )))) | |
4212 | ||
4213 | (defun vhdl-default () | |
4214 | "Insert nothing." | |
4215 | (interactive) | |
4216 | (insert " ") | |
4217 | (unexpand-abbrev) | |
4218 | (backward-word 1) | |
4219 | (vhdl-case-word 1) | |
4220 | (forward-char 1) | |
4221 | ) | |
4222 | ||
4223 | (defun vhdl-default-indent () | |
4224 | "Insert nothing and indent." | |
4225 | (interactive) | |
4226 | (insert " ") | |
4227 | (unexpand-abbrev) | |
4228 | (backward-word 1) | |
4229 | (vhdl-case-word 1) | |
4230 | (forward-char 1) | |
4231 | (vhdl-indent-line) | |
4232 | ) | |
4233 | ||
4234 | (defun vhdl-disconnect () | |
4235 | "Insert a disconnect statement." | |
4236 | (interactive) | |
4237 | (vhdl-insert-keyword "DISCONNECT ") | |
4238 | (if (equal (vhdl-field "guarded signal specification") "") | |
4239 | nil | |
4240 | (vhdl-insert-keyword " AFTER ") | |
4241 | (vhdl-field "time expression" ";") | |
4242 | )) | |
4243 | ||
4244 | (defun vhdl-else () | |
4245 | "Insert an else statement." | |
4246 | (interactive) | |
4247 | (let ((margin)) | |
4248 | (vhdl-insert-keyword "ELSE") | |
4249 | (if (not (equal 'block-close (car (car (vhdl-get-syntactic-context))))) | |
4250 | (insert " ") | |
4251 | (vhdl-indent-line) | |
4252 | (setq margin (current-indentation)) | |
4253 | (insert "\n") | |
4254 | (indent-to (+ margin vhdl-basic-offset)) | |
4255 | ))) | |
4256 | ||
4257 | (defun vhdl-elsif () | |
4258 | "Insert an elsif statement." | |
4259 | (interactive) | |
4260 | (let ((margin)) | |
4261 | (vhdl-insert-keyword "ELSIF ") | |
4262 | (if vhdl-conditions-in-parenthesis (insert "(")) | |
4263 | (if (equal (vhdl-field "condition") "") | |
4264 | (progn (undo 0) (insert " ")) | |
4265 | (if vhdl-conditions-in-parenthesis (insert ")")) | |
4266 | (vhdl-indent-line) | |
4267 | (setq margin (current-indentation)) | |
4268 | (vhdl-insert-keyword " THEN\n") | |
4269 | (indent-to (+ margin vhdl-basic-offset)) | |
4270 | ))) | |
4271 | ||
4272 | (defun vhdl-entity () | |
4273 | "Insert an entity template." | |
4274 | (interactive) | |
4275 | (let ((margin (current-column)) | |
4276 | (vhdl-entity-name)) | |
4277 | (vhdl-insert-keyword "ENTITY ") | |
4278 | (if (equal (setq vhdl-entity-name (vhdl-field "entity name")) "") | |
4279 | nil | |
4280 | (vhdl-insert-keyword " IS\n\n") | |
4281 | (indent-to margin) | |
4282 | (vhdl-insert-keyword "END ") | |
4283 | (insert vhdl-entity-name ";") | |
4284 | (end-of-line -0) | |
4285 | (indent-to (+ margin vhdl-basic-offset)) | |
4286 | (vhdl-entity-body) | |
4287 | ))) | |
4288 | ||
4289 | (defun vhdl-entity-body () | |
4290 | "Insert an entity body." | |
4291 | (interactive) | |
4292 | (let ((margin (current-column))) | |
4293 | (if vhdl-additional-empty-lines (insert "\n")) | |
4294 | (indent-to margin) | |
4295 | (vhdl-insert-keyword "GENERIC (") | |
4296 | (if (vhdl-get-generic t) | |
4297 | (if vhdl-additional-empty-lines (insert "\n"))) | |
4298 | (insert "\n") | |
4299 | (indent-to margin) | |
4300 | (vhdl-insert-keyword "PORT (") | |
4301 | (if (vhdl-get-port t) | |
4302 | (if vhdl-additional-empty-lines (insert "\n"))) | |
4303 | (end-of-line 2) | |
4304 | )) | |
4305 | ||
4306 | (defun vhdl-exit () | |
4307 | "Insert an exit statement." | |
4308 | (interactive) | |
4309 | (vhdl-insert-keyword "EXIT ") | |
4310 | (if (string-equal (vhdl-field "[loop label]") "") | |
4311 | (delete-char -1)) | |
4312 | (let ((opoint (point))) | |
4313 | (vhdl-insert-keyword " WHEN ") | |
4314 | (if vhdl-conditions-in-parenthesis (insert "(")) | |
4315 | (if (equal (vhdl-field "[condition]") "") | |
4316 | (progn (goto-char opoint) | |
4317 | (kill-line)) | |
4318 | (if vhdl-conditions-in-parenthesis (insert ")")))) | |
4319 | (insert ";") | |
4320 | ) | |
4321 | ||
4322 | (defun vhdl-for () | |
4323 | "Inserts a block or component configuration if within a configuration | |
4324 | declaration, a for loop otherwise." | |
4325 | (interactive) | |
4326 | (if (equal (car (car (cdr (vhdl-get-syntactic-context)))) 'configuration) | |
4327 | (if (y-or-n-p "block configuration (or component configuration)? ") | |
4328 | (vhdl-block-configuration) | |
4329 | (vhdl-component-configuration)) | |
4330 | (vhdl-for-loop))) | |
4331 | ||
4332 | (defun vhdl-for-loop () | |
4333 | "Insert a for loop template." | |
4334 | (interactive) | |
4335 | (let ((position (point))) | |
4336 | (vhdl-insert-keyword " : FOR ") | |
4337 | (goto-char position)) | |
4338 | (let* ((margin (current-column)) | |
4339 | (name (vhdl-field "[label]")) | |
4340 | (named (not (string-equal name ""))) | |
4341 | (index)) | |
4342 | (if (not named) (delete-char 3)) | |
4343 | (end-of-line) | |
4344 | (if (equal (setq index (vhdl-field "loop variable")) "") | |
4345 | nil | |
4346 | (vhdl-insert-keyword " IN ") | |
4347 | (vhdl-field "range") | |
4348 | (vhdl-insert-keyword " LOOP\n\n") | |
4349 | (indent-to margin) | |
4350 | (vhdl-insert-keyword "END LOOP") | |
4351 | (if named (insert " " name ";") | |
4352 | (insert ";") | |
4353 | (if vhdl-self-insert-comments (insert " -- " index))) | |
4354 | (forward-line -1) | |
4355 | (indent-to (+ margin vhdl-basic-offset)) | |
4356 | ))) | |
4357 | ||
4358 | (defun vhdl-function () | |
4359 | "Insert function specification or body template." | |
4360 | (interactive) | |
4361 | (let ((margin (current-column)) | |
4362 | (name)) | |
4363 | (vhdl-insert-keyword "FUNCTION ") | |
4364 | (if (equal (setq name (vhdl-field "name")) "") | |
4365 | nil | |
4366 | (vhdl-get-arg-list) | |
4367 | (vhdl-insert-keyword " RETURN ") | |
4368 | (vhdl-field "type" " ") | |
4369 | (if (y-or-n-p "insert body? ") | |
4370 | (progn (vhdl-insert-keyword "IS") | |
4371 | (vhdl-begin-end (cons name margin)) | |
4372 | (vhdl-block-comment)) | |
4373 | (delete-char -1) | |
4374 | (insert ";\n") | |
4375 | (indent-to margin))) | |
4376 | )) | |
4377 | ||
4378 | (defun vhdl-generate () | |
4379 | "Insert a generate template." | |
4380 | (interactive) | |
4381 | (let ((position (point))) | |
4382 | (vhdl-insert-keyword " GENERATE") | |
4383 | (goto-char position)) | |
4384 | (let ((margin (current-column)) | |
4385 | (label (vhdl-field "label")) | |
4386 | (string)) | |
4387 | (if (equal label "") | |
4388 | (progn (undo 0) (insert " ")) | |
4389 | (insert " : ") | |
4390 | (setq string (vhdl-field "(FOR | IF)")) | |
4391 | (insert " ") | |
4392 | (if (equal (upcase string) "IF") | |
4393 | (progn | |
4394 | (if vhdl-conditions-in-parenthesis (insert "(")) | |
4395 | (vhdl-field "condition") | |
4396 | (if vhdl-conditions-in-parenthesis (insert ")"))) | |
4397 | (vhdl-field "loop variable") | |
4398 | (vhdl-insert-keyword " IN ") | |
4399 | (vhdl-field "range")) | |
4400 | (end-of-line) | |
4401 | (insert "\n\n") | |
4402 | (indent-to margin) | |
4403 | (vhdl-insert-keyword "END GENERATE ") | |
4404 | (insert label ";") | |
4405 | (end-of-line 0) | |
4406 | (indent-to (+ margin vhdl-basic-offset)) | |
4407 | ))) | |
4408 | ||
4409 | (defun vhdl-generic () | |
4410 | "Insert generic declaration, or generic map in instantiation statements." | |
4411 | (interactive) | |
4412 | (vhdl-insert-keyword "GENERIC (") | |
4413 | (cond ((equal (car (car (cdr (vhdl-get-syntactic-context)))) 'entity) | |
4414 | (vhdl-get-generic nil)) | |
4415 | ((or (equal 'statement-cont (car (car (vhdl-get-syntactic-context)))) | |
4416 | (save-excursion | |
4417 | (and (backward-word 2) (skip-chars-backward " ") | |
4418 | (eq (preceding-char) ?:)))) | |
4419 | (delete-char -1) (vhdl-map)) | |
4420 | (t (vhdl-get-generic nil t)))) | |
4421 | ||
4422 | (defun vhdl-header () | |
4423 | "Insert a VHDL file header." | |
4424 | (interactive) | |
4425 | (let (eot) | |
4426 | (save-excursion | |
4427 | (save-restriction | |
4428 | (widen) | |
4429 | (goto-char (point-min)) | |
4430 | (if vhdl-header-file | |
4431 | (setq eot (car (cdr (insert-file-contents vhdl-header-file)))) | |
4432 | ; insert default header | |
4433 | (insert "\ | |
4434 | ------------------------------------------------------------------------------- | |
4435 | -- Title : <title string> | |
4436 | -- Project : <project string> | |
4437 | ------------------------------------------------------------------------------- | |
4438 | -- File : <filename> | |
4439 | -- Author : <author> | |
4440 | -- Created : <date> | |
4441 | -- Last modified : <date> | |
4442 | ------------------------------------------------------------------------------- | |
4443 | -- Description : | |
4444 | -- <cursor> | |
4445 | ------------------------------------------------------------------------------- | |
4446 | -- Modification history : | |
4447 | -- <date> : created | |
4448 | ------------------------------------------------------------------------------- | |
4449 | ||
4450 | ") | |
4451 | (setq eot (point))) | |
4452 | (narrow-to-region (point-min) eot) | |
4453 | (goto-char (point-min)) | |
4454 | (while (search-forward "<filename>" nil t) | |
4455 | (replace-match (buffer-name) t t)) | |
4456 | (goto-char (point-min)) | |
4457 | (while (search-forward "<author>" nil t) | |
4458 | (replace-match "" t t) | |
4459 | (insert (user-full-name) " <" user-mail-address ">")) | |
4460 | (goto-char (point-min)) | |
4461 | ;; Replace <RCS> with $, so that RCS for the source is | |
4462 | ;; not over-enthusiastic with replacements | |
4463 | (while (search-forward "<RCS>" nil t) | |
4464 | (replace-match "$" nil t)) | |
4465 | (goto-char (point-min)) | |
4466 | (while (search-forward "<date>" nil t) | |
4467 | (replace-match "" t t) | |
4468 | (vhdl-insert-date)) | |
4469 | (goto-char (point-min)) | |
4470 | (let (string) | |
4471 | (while (re-search-forward "<\\(\\w*\\) string>" nil t) | |
4472 | (setq string (read-string (concat (match-string 1) ": "))) | |
4473 | (replace-match string t t))))) | |
4474 | (goto-char (point-min)) | |
4475 | (if (search-forward "<cursor>" nil t) | |
4476 | (replace-match "" t t)))) | |
4477 | ||
4478 | (defun vhdl-if () | |
4479 | "Insert an if statement template." | |
4480 | (interactive) | |
4481 | (let ((margin (current-column))) | |
4482 | (vhdl-insert-keyword "IF ") | |
4483 | (if vhdl-conditions-in-parenthesis (insert "(")) | |
4484 | (if (equal (vhdl-field "condition") "") | |
4485 | (progn (undo 0) (insert " ")) | |
4486 | (if vhdl-conditions-in-parenthesis (insert ")")) | |
4487 | (vhdl-insert-keyword " THEN\n\n") | |
4488 | (indent-to margin) | |
4489 | (vhdl-insert-keyword "END IF;") | |
4490 | (forward-line -1) | |
4491 | (indent-to (+ margin vhdl-basic-offset)) | |
4492 | ))) | |
4493 | ||
4494 | (defun vhdl-library () | |
4495 | "Insert a library specification." | |
4496 | (interactive) | |
4497 | (let ((margin (current-column)) | |
4498 | (lib-name)) | |
4499 | (vhdl-insert-keyword "LIBRARY ") | |
4500 | (if (equal (setq lib-name (vhdl-field "library name")) "") | |
4501 | nil | |
4502 | (insert ";\n") | |
4503 | (indent-to margin) | |
4504 | (vhdl-insert-keyword "USE ") | |
4505 | (insert lib-name) | |
4506 | (vhdl-insert-keyword "..ALL;") | |
4507 | (backward-char 5) | |
4508 | (if (equal (vhdl-field "package name") "") | |
4509 | (progn (vhdl-kill-entire-line) | |
4510 | (end-of-line -0)) | |
4511 | (end-of-line) | |
4512 | )))) | |
4513 | ||
4514 | (defun vhdl-loop () | |
4515 | "Insert a loop template." | |
4516 | (interactive) | |
4517 | (let ((position (point))) | |
4518 | (vhdl-insert-keyword " : LOOP") | |
4519 | (goto-char position)) | |
4520 | (let* ((margin (current-column)) | |
4521 | (name (vhdl-field "[label]")) | |
4522 | (named (not (string-equal name "")))) | |
4523 | (if (not named) (delete-char 3)) | |
4524 | (end-of-line) | |
4525 | (insert "\n\n") | |
4526 | (indent-to margin) | |
4527 | (vhdl-insert-keyword "END LOOP") | |
23cec91f | 4528 | (insert (if named (concat " " name ";") ?\;)) |
d2ddb974 KH |
4529 | (forward-line -1) |
4530 | (indent-to (+ margin vhdl-basic-offset)) | |
4531 | )) | |
4532 | ||
4533 | (defun vhdl-map () | |
4534 | "Insert a map specification." | |
4535 | (interactive) | |
4536 | (vhdl-insert-keyword "MAP (") | |
4537 | (if (equal (vhdl-field "[association list]") "") | |
4538 | (progn (undo 0) (insert " ")) | |
4539 | (insert ")") | |
4540 | )) | |
4541 | ||
4542 | (defun vhdl-modify () | |
4543 | "Actualize modification date." | |
4544 | (interactive) | |
4545 | (goto-char (point-min)) | |
4546 | (if (search-forward vhdl-modify-date-prefix-string nil t) | |
4547 | (progn (kill-line) | |
4548 | (vhdl-insert-date)) | |
4549 | (message (concat "Modification date prefix string \"" | |
4550 | vhdl-modify-date-prefix-string | |
4551 | "\" not found!")) | |
4552 | (beep))) | |
4553 | ||
4554 | (defun vhdl-next () | |
4555 | "Inserts a next statement." | |
4556 | (interactive) | |
4557 | (vhdl-insert-keyword "NEXT ") | |
4558 | (if (string-equal (vhdl-field "[loop label]") "") | |
4559 | (delete-char -1)) | |
4560 | (let ((opoint (point))) | |
4561 | (vhdl-insert-keyword " WHEN ") | |
4562 | (if vhdl-conditions-in-parenthesis (insert "(")) | |
4563 | (if (equal (vhdl-field "[condition]") "") | |
4564 | (progn (goto-char opoint) | |
4565 | (kill-line)) | |
4566 | (if vhdl-conditions-in-parenthesis (insert ")")))) | |
4567 | (insert ";") | |
4568 | ) | |
4569 | ||
4570 | (defun vhdl-package () | |
4571 | "Insert a package specification or body." | |
4572 | (interactive) | |
4573 | (let ((margin (current-column)) | |
4574 | (name)) | |
4575 | (vhdl-insert-keyword "PACKAGE ") | |
4576 | (if (y-or-n-p "body? ") | |
4577 | (vhdl-insert-keyword "BODY ")) | |
4578 | (setq name (vhdl-field "name" " is\n\n")) | |
4579 | (indent-to margin) | |
4580 | (vhdl-insert-keyword "END ") | |
4581 | (insert name ";") | |
4582 | (forward-line -1) | |
4583 | (indent-to (+ margin vhdl-basic-offset)) | |
4584 | )) | |
4585 | ||
4586 | (defun vhdl-port () | |
4587 | "Insert a port declaration, or port map in instantiation statements." | |
4588 | (interactive) | |
4589 | (vhdl-insert-keyword "PORT (") | |
4590 | (cond ((equal (car (car (cdr (vhdl-get-syntactic-context)))) 'entity) | |
4591 | (vhdl-get-port nil)) | |
4592 | ((or (equal 'statement-cont (car (car (vhdl-get-syntactic-context)))) | |
4593 | (save-excursion | |
4594 | (and (backward-word 2) (skip-chars-backward " ") | |
4595 | (eq (preceding-char) ?:)))) | |
4596 | (delete-char -1) (vhdl-map)) | |
4597 | (t (vhdl-get-port nil t)))) | |
4598 | ||
4599 | (defun vhdl-procedure () | |
4600 | "Insert a procedure specification or body template." | |
4601 | (interactive) | |
4602 | (let ((margin (current-column)) | |
4603 | (name)) | |
4604 | (vhdl-insert-keyword "PROCEDURE ") | |
4605 | (if (equal (setq name (vhdl-field "name")) "") | |
4606 | nil | |
4607 | (vhdl-get-arg-list) | |
4608 | (insert " ") | |
4609 | (if (y-or-n-p "insert body? ") | |
4610 | (progn (vhdl-insert-keyword "IS") | |
4611 | (vhdl-begin-end (cons name margin)) | |
4612 | (vhdl-block-comment)) | |
4613 | (delete-char -1) | |
4614 | (insert ";\n") | |
4615 | (indent-to margin) | |
4616 | )))) | |
4617 | ||
4618 | (defun vhdl-process () | |
4619 | "Insert a process template." | |
4620 | (interactive) | |
4621 | (let ((clocked)) | |
4622 | (let ((position (point))) | |
4623 | (vhdl-insert-keyword "PROCESS") | |
4624 | (setq clocked (y-or-n-p "clocked process? ")) | |
4625 | (goto-char position) | |
4626 | (insert " : ") | |
4627 | (goto-char position)) | |
4628 | (let* ((margin (current-column)) | |
4629 | (finalline) | |
4630 | (name (vhdl-field "[label]")) | |
4631 | (named (not (string-equal name ""))) | |
4632 | (clock) (reset) | |
4633 | (case-fold-search t)) | |
4634 | (if (not named) (delete-char 3)) | |
4635 | (end-of-line) | |
4636 | (insert " (") | |
4637 | (if (not clocked) | |
4638 | (if (equal (vhdl-field "[sensitivity list]" ")") "") | |
4639 | (delete-char -3)) | |
4640 | (setq clock (vhdl-field "clock name" ", ")) | |
4641 | (setq reset (vhdl-field "reset name" ")"))) | |
4642 | (vhdl-begin-end (cons (concat (vhdl-case-keyword "PROCESS") | |
4643 | (if named (concat " " name))) margin)) | |
4644 | (if clocked (vhdl-clock-async-reset clock reset)) | |
4645 | (if vhdl-prompt-for-comments | |
4646 | (progn | |
4647 | (setq finalline (vhdl-current-line)) | |
4648 | (if (and (re-search-backward "\\<begin\\>" nil t) | |
4649 | (re-search-backward "\\<process\\>" nil t)) | |
4650 | (progn | |
4651 | (end-of-line -0) | |
4652 | (insert "\n") | |
4653 | (indent-to margin) | |
4654 | (insert "-- purpose: ") | |
4655 | (if (equal (vhdl-field "description") "") | |
4656 | (vhdl-kill-entire-line) | |
4657 | (newline) | |
4658 | (indent-to margin) | |
4659 | (insert "-- type: ") | |
4660 | (insert (if clocked "memorizing" "memoryless") "\n") | |
4661 | (indent-to margin) | |
4662 | (insert "-- inputs: ") | |
4663 | (if clocked | |
4664 | (insert clock ", " reset ", ")) | |
4665 | (if (and (equal (vhdl-field "signal names") "") | |
4666 | clocked) | |
4667 | (delete-char -2)) | |
4668 | (insert "\n") | |
4669 | (indent-to margin) | |
4670 | (insert "-- outputs: ") | |
4671 | (vhdl-field "signal names") | |
4672 | (setq finalline (+ finalline 4))))) | |
4673 | (goto-line finalline) | |
4674 | (end-of-line) | |
4675 | ))))) | |
4676 | ||
4677 | (defun vhdl-record () | |
4678 | "Insert a record type declaration." | |
4679 | (interactive) | |
4680 | (let ((margin (current-column)) | |
4681 | (start (point)) | |
4682 | (first t)) | |
4683 | (vhdl-insert-keyword "RECORD\n") | |
4684 | (indent-to (+ margin vhdl-basic-offset)) | |
4685 | (if (equal (vhdl-field "identifiers") "") | |
4686 | (progn (kill-line -0) | |
4687 | (delete-char -1) | |
4688 | (insert " ")) | |
4689 | (while (or first (not (equal (vhdl-field "[identifiers]") ""))) | |
4690 | (insert " : ") | |
4691 | (vhdl-field "type" ";") | |
4692 | (vhdl-declaration-comment) | |
4693 | (newline) | |
4694 | (indent-to (+ margin vhdl-basic-offset)) | |
4695 | (setq first nil)) | |
4696 | (kill-line -0) | |
4697 | (indent-to margin) | |
4698 | (vhdl-insert-keyword "END RECORD;") | |
4699 | (if vhdl-auto-align (vhdl-align start (point) 1)) | |
4700 | ))) | |
4701 | ||
4702 | (defun vhdl-return-value () | |
4703 | "Insert a return statement." | |
4704 | (interactive) | |
4705 | (vhdl-insert-keyword "RETURN ") | |
4706 | (if (equal (vhdl-field "[expression]") "") | |
4707 | (delete-char -1)) | |
4708 | (insert ";") | |
4709 | ) | |
4710 | ||
4711 | (defun vhdl-selected-signal-assignment () | |
4712 | "Insert a selected signal assignment." | |
4713 | (interactive) | |
4714 | (let ((margin (current-column)) | |
4715 | (start (point))) | |
4716 | (let ((position (point))) | |
4717 | (vhdl-insert-keyword " SELECT") | |
4718 | (goto-char position)) | |
4719 | (vhdl-insert-keyword "WITH ") | |
4720 | (if (equal (vhdl-field "selector expression") "") | |
4721 | (progn (undo 0) (insert " ")) | |
4722 | (end-of-line) | |
4723 | (insert "\n") | |
4724 | (indent-to (+ margin vhdl-basic-offset)) | |
4725 | (vhdl-field "target signal" " <= ") | |
4726 | ; (vhdl-field "[GUARDED] [TRANSPORT]") | |
4727 | (insert "\n") | |
4728 | (indent-to (+ margin vhdl-basic-offset)) | |
4729 | (while (not (equal (vhdl-field "[waveform]") "")) | |
4730 | (vhdl-insert-keyword " WHEN ") | |
4731 | (vhdl-field "choices" ",") | |
4732 | (newline) | |
4733 | (indent-to (+ margin vhdl-basic-offset))) | |
4734 | (if (not (equal (vhdl-field "[alternative waveform]") "")) | |
4735 | (vhdl-insert-keyword " WHEN OTHERS") | |
4736 | (fixup-whitespace) | |
4737 | (delete-char -2)) | |
4738 | (insert ";") | |
4739 | (if vhdl-auto-align (vhdl-align start (point) 1)) | |
4740 | ))) | |
4741 | ||
4742 | (defun vhdl-signal () | |
4743 | "Insert a signal declaration." | |
4744 | (interactive) | |
4745 | (vhdl-insert-keyword "SIGNAL ") | |
4746 | (let ((in-arglist (string-match "arglist" | |
4747 | (format "%s" (car (car (vhdl-get-syntactic-context))))))) | |
4748 | (if (not in-arglist) | |
4749 | (let ((opoint (point))) | |
4750 | (beginning-of-line) | |
4751 | (setq in-arglist (looking-at ".*(")) | |
4752 | (goto-char opoint))) | |
4753 | (if (equal (vhdl-field "names") "") | |
4754 | nil | |
4755 | (insert " : ") | |
4756 | (if in-arglist | |
4757 | (progn (vhdl-field "direction") | |
4758 | (insert " "))) | |
4759 | (vhdl-field "type") | |
4760 | (if in-arglist | |
4761 | (insert ";") | |
4762 | (let ((position (point))) | |
4763 | (insert " := ") | |
4764 | (if (equal (vhdl-field "[initialization]" ";") "") | |
4765 | (progn (goto-char position) (kill-line) (insert ";"))) | |
4766 | (vhdl-declaration-comment)) | |
4767 | )))) | |
4768 | ||
4769 | (defun vhdl-subtype () | |
4770 | "Insert a subtype declaration." | |
4771 | (interactive) | |
4772 | (vhdl-insert-keyword "SUBTYPE ") | |
4773 | (if (equal (vhdl-field "name") "") | |
4774 | nil | |
4775 | (vhdl-insert-keyword " IS ") | |
4776 | (vhdl-field "type" " ") | |
4777 | (if (equal (vhdl-field "[RANGE value range | ( index range )]") "") | |
4778 | (delete-char -1)) | |
4779 | (insert ";") | |
4780 | (vhdl-declaration-comment) | |
4781 | )) | |
4782 | ||
4783 | (defun vhdl-type () | |
4784 | "Insert a type declaration." | |
4785 | (interactive) | |
4786 | (vhdl-insert-keyword "TYPE ") | |
4787 | (if (equal (vhdl-field "name") "") | |
4788 | nil | |
4789 | (vhdl-insert-keyword " IS ") | |
4790 | (let ((definition (upcase (vhdl-field "(scalar type | ARRAY | RECORD | ACCESS | FILE)")))) | |
4791 | (cond ((equal definition "ARRAY") | |
4792 | (kill-word -1) (vhdl-array)) | |
4793 | ((equal definition "RECORD") | |
4794 | (kill-word -1) (vhdl-record)) | |
4795 | ((equal definition "ACCESS") | |
4796 | (insert " ") (vhdl-field "type" ";")) | |
4797 | ((equal definition "FILE") | |
4798 | (vhdl-insert-keyword " OF ") (vhdl-field "type" ";")) | |
4799 | (t (insert ";"))) | |
4800 | (vhdl-declaration-comment) | |
4801 | ))) | |
4802 | ||
4803 | (defun vhdl-use () | |
4804 | "Insert a use clause." | |
4805 | (interactive) | |
4806 | (vhdl-insert-keyword "USE ..ALL;") | |
4807 | (backward-char 6) | |
4808 | (if (equal (vhdl-field "library name") "") | |
4809 | (progn (undo 0) (insert " ")) | |
4810 | (forward-char 1) | |
4811 | (vhdl-field "package name") | |
4812 | (end-of-line) | |
4813 | )) | |
4814 | ||
4815 | (defun vhdl-variable () | |
4816 | "Insert a variable declaration." | |
4817 | (interactive) | |
4818 | (vhdl-insert-keyword "VARIABLE ") | |
4819 | (let ((in-arglist (string-match "arglist" | |
4820 | (format "%s" (car (car (vhdl-get-syntactic-context))))))) | |
4821 | (if (not in-arglist) | |
4822 | (let ((opoint (point))) | |
4823 | (beginning-of-line) | |
4824 | (setq in-arglist (looking-at ".*(")) | |
4825 | (goto-char opoint))) | |
4826 | (if (equal (vhdl-field "names") "") | |
4827 | nil | |
4828 | (insert " : ") | |
4829 | (if in-arglist | |
4830 | (progn (vhdl-field "direction") | |
4831 | (insert " "))) | |
4832 | (vhdl-field "type") | |
4833 | (if in-arglist | |
4834 | (insert ";") | |
4835 | (let ((position (point))) | |
4836 | (insert " := ") | |
4837 | (if (equal (vhdl-field "[initialization]" ";") "") | |
4838 | (progn (goto-char position) (kill-line) (insert ";"))) | |
4839 | (vhdl-declaration-comment)) | |
4840 | )))) | |
4841 | ||
4842 | (defun vhdl-wait () | |
4843 | "Insert a wait statement." | |
4844 | (interactive) | |
4845 | (vhdl-insert-keyword "WAIT ") | |
4846 | (if (equal (vhdl-field | |
4847 | "[ON sensitivity list] [UNTIL condition] [FOR time expression]") | |
4848 | "") | |
4849 | (delete-char -1)) | |
4850 | (insert ";") | |
4851 | ) | |
4852 | ||
4853 | (defun vhdl-when () | |
4854 | "Indent correctly if within a case statement." | |
4855 | (interactive) | |
4856 | (let ((position (point)) | |
4857 | (margin)) | |
4858 | (if (and (re-search-forward "\\<end\\>" nil t) | |
4859 | (looking-at "\\s-*\\<case\\>")) | |
4860 | (progn | |
4861 | (setq margin (current-indentation)) | |
4862 | (goto-char position) | |
4863 | (delete-horizontal-space) | |
4864 | (indent-to (+ margin vhdl-basic-offset))) | |
4865 | (goto-char position) | |
4866 | ) | |
4867 | (vhdl-insert-keyword "WHEN ") | |
4868 | )) | |
4869 | ||
4870 | (defun vhdl-while-loop () | |
4871 | "Insert a while loop template." | |
4872 | (interactive) | |
4873 | (let ((position (point))) | |
4874 | (vhdl-insert-keyword " : WHILE ") | |
4875 | (goto-char position)) | |
4876 | (let* ((margin (current-column)) | |
4877 | (name (vhdl-field "[label]")) | |
4878 | (named (not (string-equal name "")))) | |
4879 | (if (not named) (delete-char 3)) | |
4880 | (end-of-line) | |
4881 | (if vhdl-conditions-in-parenthesis (insert "(")) | |
4882 | (if (equal (vhdl-field "condition") "") | |
4883 | (progn (undo 0) (insert " ")) | |
4884 | (if vhdl-conditions-in-parenthesis (insert ")")) | |
4885 | (vhdl-insert-keyword " LOOP\n\n") | |
4886 | (indent-to margin) | |
4887 | (vhdl-insert-keyword "END LOOP") | |
23cec91f | 4888 | (insert (if named (concat " " name ";") ?\;)) |
d2ddb974 KH |
4889 | (forward-line -1) |
4890 | (indent-to (+ margin vhdl-basic-offset)) | |
4891 | ))) | |
4892 | ||
4893 | (defun vhdl-with () | |
4894 | "Insert a with statement (i.e. selected signal assignment)." | |
4895 | (interactive) | |
4896 | (vhdl-selected-signal-assignment) | |
4897 | ) | |
4898 | ||
4899 | ;; ############################################################################ | |
4900 | ;; Custom functions | |
4901 | ||
4902 | (defun vhdl-clocked-wait () | |
4903 | "Insert a wait statement for rising clock edge." | |
4904 | (interactive) | |
4905 | (vhdl-insert-keyword "WAIT UNTIL ") | |
4906 | (let* ((clock (vhdl-field "clock name"))) | |
4907 | (insert "'event") | |
4908 | (vhdl-insert-keyword " AND ") | |
4909 | (insert clock) | |
4910 | (insert " = " vhdl-one-string ";") | |
4911 | )) | |
4912 | ||
4913 | (defun vhdl-clock-async-reset (clock reset) | |
4914 | "Insert a template reacting on asynchronous reset and rising clock edge | |
4915 | for inside a memorizing processes." | |
4916 | (interactive) | |
4917 | (let* ( (margin (current-column)) | |
4918 | (opoint)) | |
4919 | (if vhdl-self-insert-comments | |
4920 | (insert "-- activities triggered by asynchronous reset (active low)\n")) | |
4921 | (indent-to margin) | |
4922 | (vhdl-insert-keyword "IF ") | |
4923 | (insert reset " = " vhdl-zero-string) | |
4924 | (vhdl-insert-keyword " THEN\n") | |
4925 | (indent-to (+ margin vhdl-basic-offset)) | |
4926 | (setq opoint (point)) | |
4927 | (newline) | |
4928 | (indent-to margin) | |
4929 | (if vhdl-self-insert-comments | |
4930 | (insert "-- activities triggered by rising edge of clock\n")) | |
4931 | (indent-to margin) | |
4932 | (vhdl-insert-keyword "ELSIF ") | |
4933 | (insert clock "'event") | |
4934 | (vhdl-insert-keyword " AND ") | |
4935 | (insert clock " = " vhdl-one-string) | |
4936 | (vhdl-insert-keyword " THEN\n") | |
4937 | (indent-to (+ margin vhdl-basic-offset)) | |
4938 | (newline) | |
4939 | (indent-to margin) | |
4940 | (vhdl-insert-keyword "END IF;") | |
4941 | ; (if vhdl-self-insert-comments (insert " -- " clock)) | |
4942 | (goto-char opoint) | |
4943 | )) | |
4944 | ||
4945 | (defun vhdl-standard-package (library package) | |
4946 | "Insert specification of a standard package." | |
4947 | (interactive) | |
4948 | (let ((margin (current-column))) | |
4949 | (vhdl-insert-keyword "LIBRARY ") | |
4950 | (insert library ";\n") | |
4951 | (indent-to margin) | |
4952 | (vhdl-insert-keyword "USE ") | |
4953 | (insert library "." package) | |
4954 | (vhdl-insert-keyword ".ALL;") | |
4955 | )) | |
4956 | ||
4957 | (defun vhdl-package-numeric-bit () | |
4958 | "Insert specification of 'numeric_bit' package." | |
4959 | (interactive) | |
4960 | (vhdl-standard-package "ieee" "numeric_bit")) | |
4961 | ||
4962 | (defun vhdl-package-numeric-std () | |
4963 | "Insert specification of 'numeric_std' package." | |
4964 | (interactive) | |
4965 | (vhdl-standard-package "ieee" "numeric_std")) | |
4966 | ||
4967 | (defun vhdl-package-std-logic-1164 () | |
4968 | "Insert specification of 'std_logic_1164' package." | |
4969 | (interactive) | |
4970 | (vhdl-standard-package "ieee" "std_logic_1164")) | |
4971 | ||
4972 | (defun vhdl-package-textio () | |
4973 | "Insert specification of 'textio' package." | |
4974 | (interactive) | |
4975 | (vhdl-standard-package "std" "textio")) | |
4976 | ||
4977 | ;; ############################################################################ | |
4978 | ;; Comment functions | |
4979 | ||
4980 | (defun vhdl-comment-indent () | |
4981 | (let* ((opoint (point)) | |
4982 | (col (progn | |
4983 | (forward-line -1) | |
4984 | (if (re-search-forward "--" opoint t) | |
4985 | (- (current-column) 2) ;Existing comment at bol stays there. | |
4986 | (goto-char opoint) | |
4987 | (skip-chars-backward " \t") | |
4988 | (max comment-column ;else indent to comment column | |
4989 | (1+ (current-column))) ;except leave at least one space. | |
4990 | )))) | |
4991 | (goto-char opoint) | |
4992 | col | |
4993 | )) | |
4994 | ||
4995 | (defun vhdl-inline-comment () | |
4996 | "Start a comment at the end of the line. | |
4997 | if on line with code, indent at least comment-column. | |
4998 | if starting after end-comment-column, start a new line." | |
4999 | (interactive) | |
5000 | (if (> (current-column) end-comment-column) (newline-and-indent)) | |
5001 | (if (or (looking-at "\\s-*$") ;end of line | |
5002 | (and (not unread-command-events) ; called with key binding or menu | |
5003 | (not (end-of-line)))) | |
5004 | (let ((margin)) | |
5005 | (while (= (preceding-char) ?-) (delete-char -1)) | |
5006 | (setq margin (current-column)) | |
5007 | (delete-horizontal-space) | |
5008 | (if (bolp) | |
5009 | (progn (indent-to margin) (insert "--")) | |
5010 | (insert " ") | |
5011 | (indent-to comment-column) | |
5012 | (insert "--")) | |
5013 | (if (not unread-command-events) (insert " "))) | |
5014 | ; else code following current point implies commenting out code | |
5015 | (let (next-input code) | |
5016 | (while (= (preceding-char) ?-) (delete-char -2)) | |
5017 | (while (= (setq next-input (read-char)) 13) ; CR | |
5018 | (insert "--"); or have a space after it? | |
5019 | (forward-char -2) | |
5020 | (forward-line 1) | |
5021 | (message "Enter CR if commenting out a line of code.") | |
5022 | (setq code t) | |
5023 | ) | |
5024 | (if (not code) (progn | |
5025 | ; (indent-to comment-column) | |
5026 | (insert "--") ;hardwire to 1 space or use vhdl-basic-offset? | |
5027 | )) | |
5028 | (setq unread-command-events | |
5029 | (list (vhdl-character-to-event-hack next-input))) ;pushback the char | |
5030 | ))) | |
5031 | ||
5032 | (defun vhdl-display-comment (&optional line-exists) | |
5033 | "Add 2 comment lines at the current indent, making a display comment." | |
5034 | (interactive) | |
5035 | (if (not line-exists) | |
5036 | (vhdl-display-comment-line)) | |
5037 | (let* ((col (current-column)) | |
5038 | (len (- end-comment-column col))) | |
5039 | (insert "\n") | |
5040 | (insert-char ? col) | |
5041 | (insert-char ?- len) | |
5042 | (insert "\n") | |
5043 | (insert-char ? col) | |
5044 | (end-of-line -1) | |
5045 | ) | |
5046 | (insert "-- ") | |
5047 | ) | |
5048 | ||
5049 | (defun vhdl-display-comment-line () | |
5050 | "Displays one line of dashes." | |
5051 | (interactive) | |
5052 | (while (= (preceding-char) ?-) (delete-char -2)) | |
5053 | (let* ((col (current-column)) | |
5054 | (len (- end-comment-column col))) | |
5055 | (insert-char ?- len) | |
5056 | (insert-char ?\n 1) | |
5057 | (insert-char ? col) | |
5058 | )) | |
5059 | ||
5060 | (defun vhdl-declaration-comment () | |
5061 | (if vhdl-prompt-for-comments | |
5062 | (let ((position (point))) | |
5063 | (insert " ") | |
5064 | (indent-to comment-column) | |
5065 | (insert "-- ") | |
5066 | (if (equal (vhdl-field "comment") "") | |
5067 | (progn (goto-char position) (kill-line)) | |
5068 | )))) | |
5069 | ||
5070 | (defun vhdl-block-comment () | |
5071 | (if vhdl-prompt-for-comments | |
5072 | (let ((finalline (vhdl-current-line)) | |
5073 | (case-fold-search t)) | |
5074 | (beginning-of-line -0) | |
5075 | (if (re-search-backward "\\<\\(architecture\\|block\\|function\\|procedure\\|process\\)\\>" nil t) | |
5076 | (let ((margin)) | |
5077 | (back-to-indentation) | |
5078 | (setq margin (current-column)) | |
5079 | (end-of-line -0) | |
5080 | (insert "\n") | |
5081 | (indent-to margin) | |
5082 | (insert "-- purpose: ") | |
5083 | (if (equal (vhdl-field "description") "") | |
5084 | (vhdl-kill-entire-line) | |
5085 | (setq finalline (+ finalline 1))))) | |
5086 | (goto-line finalline) | |
5087 | (end-of-line) | |
5088 | ))) | |
5089 | ||
5090 | (defun vhdl-comment-uncomment-region (beg end &optional arg) | |
5091 | "Comment out region if not commented out, uncomment out region if already | |
5092 | commented out." | |
5093 | (interactive "r\nP") | |
5094 | (goto-char beg) | |
5095 | (if (looking-at comment-start) | |
5096 | (comment-region beg end -1) | |
5097 | (comment-region beg end) | |
5098 | )) | |
5099 | ||
5100 | ;; ############################################################################ | |
5101 | ;; Help functions | |
5102 | ||
5103 | (defun vhdl-outer-space (count) | |
5104 | "Expand abbreviations and self-insert space(s), do indent-new-comment-line | |
5105 | if in comment and past end-comment-column." | |
5106 | (interactive "p") | |
5107 | (if (or (and (>= (preceding-char) ?a) (<= (preceding-char) ?z)) | |
5108 | (and (>= (preceding-char) ?A) (<= (preceding-char) ?Z))) | |
5109 | (expand-abbrev)) | |
5110 | (if (not (vhdl-in-comment-p)) | |
5111 | (self-insert-command count) | |
5112 | (if (< (current-column) end-comment-column) | |
5113 | (self-insert-command count) | |
5114 | (while (> (current-column) end-comment-column) (forward-word -1)) | |
5115 | (while (> (preceding-char) ? ) (forward-word -1)) | |
5116 | (delete-horizontal-space) | |
5117 | (indent-new-comment-line) | |
5118 | (end-of-line nil) | |
5119 | (insert-char ? count) | |
5120 | ))) | |
5121 | ||
5122 | (defun vhdl-field (prompt &optional following-string) | |
5123 | "Prompt for string and insert it in buffer with optional following-string." | |
5124 | (let ((opoint (point))) | |
5125 | (insert "<" prompt ">") | |
5126 | (let ((string (read-from-minibuffer (concat prompt ": ") "" | |
5127 | vhdl-minibuffer-local-map))) | |
5128 | (delete-region opoint (point)) | |
5129 | (insert string (or following-string "")) | |
5130 | (if vhdl-upper-case-keywords | |
5131 | (vhdl-fix-case-region-1 | |
5132 | opoint (point) t vhdl-93-keywords-regexp)) | |
5133 | string | |
5134 | ))) | |
5135 | ||
5136 | (defun vhdl-in-comment-p () | |
5137 | "Check if point is to right of beginning comment delimiter." | |
5138 | (interactive) | |
5139 | (let ((opoint (point))) | |
5140 | (save-excursion ; finds an unquoted comment | |
5141 | (beginning-of-line) | |
5142 | (re-search-forward "^\\([^\"]*\"[^\"]*\"\\)*[^\"]*--" opoint t) | |
5143 | ))) | |
5144 | ||
5145 | (defun vhdl-in-string-p () | |
5146 | "Check if point is in a string." | |
5147 | (interactive) | |
5148 | (let ((opoint (point))) | |
5149 | (save-excursion ; preceeded by odd number of string delimiters? | |
5150 | (beginning-of-line) | |
5151 | (equal | |
5152 | opoint | |
5153 | (re-search-forward "^\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*" opoint t)) | |
5154 | ))) | |
5155 | ||
5156 | (defun vhdl-begin-end (list) | |
5157 | "Insert a begin ... end pair with optional name after the end. | |
5158 | Point is left between them." | |
5159 | (let ((return) | |
5160 | (name (car list)) | |
5161 | (margin (cdr list))) | |
5162 | (if vhdl-additional-empty-lines | |
5163 | (progn | |
5164 | (insert "\n") | |
5165 | (indent-to (+ margin vhdl-basic-offset)))) | |
5166 | (insert "\n") | |
5167 | (indent-to margin) | |
5168 | (vhdl-insert-keyword "BEGIN") | |
5169 | (if vhdl-self-insert-comments | |
5170 | (insert (and name (concat " -- " name)))) | |
5171 | (insert "\n") | |
5172 | (indent-to (+ margin vhdl-basic-offset)) | |
5173 | (setq return (point)) | |
5174 | (newline) | |
5175 | (indent-to margin) | |
5176 | (vhdl-insert-keyword "END") | |
5177 | (insert (and name (concat " " name)) ";") | |
5178 | (goto-char return) | |
5179 | )) | |
5180 | ||
5181 | (defun vhdl-get-arg-list () | |
5182 | "Read from user a procedure or function argument list." | |
5183 | (insert " (") | |
5184 | (let ((margin (current-column))) | |
5185 | (if (not vhdl-argument-list-indent) | |
5186 | (let ((opoint (point))) | |
5187 | (back-to-indentation) | |
5188 | (setq margin (+ (current-column) vhdl-basic-offset)) | |
5189 | (goto-char opoint) | |
5190 | (newline) | |
5191 | (indent-to margin))) | |
5192 | (let (not-empty interface) | |
5193 | (setq interface (vhdl-field "[CONSTANT] [SIGNAL] [VARIABLE]")) | |
5194 | (if (not (equal interface "")) | |
5195 | (insert " ")) | |
5196 | (while (not (string-equal (vhdl-field "[names]") "")) | |
5197 | (setq not-empty t) | |
5198 | (insert " : ") | |
5199 | (if (not (equal (vhdl-field "[direction]") "")) | |
5200 | (insert " ")) | |
5201 | (vhdl-field "type" ";\n") | |
5202 | (indent-to margin) | |
5203 | (setq interface (vhdl-field "[CONSTANT] [SIGNAL] [VARIABLE]")) | |
5204 | (if (not (equal interface "")) | |
5205 | (insert " "))) | |
5206 | (if not-empty | |
5207 | (progn (kill-line -0) | |
5208 | (delete-char -2) | |
5209 | (if (not vhdl-argument-list-indent) | |
5210 | (progn (insert "\n") (indent-to margin))) | |
5211 | (insert ")")) | |
5212 | (if vhdl-argument-list-indent | |
5213 | (backward-delete-char 2) | |
5214 | (kill-line -0) | |
5215 | (backward-delete-char 3))) | |
5216 | ; (while (string-match "[,;]$" args) | |
5217 | ; (newline) | |
5218 | ; (indent-to margin) (setq args (vhdl-field "next argument"))) | |
5219 | ; (insert 41) ;close-paren | |
5220 | ))) | |
5221 | ||
5222 | (defun vhdl-get-port (optional &optional no-comment) | |
5223 | "Read from user a port spec argument list." | |
5224 | (let ((margin (current-column)) | |
5225 | (start (point))) | |
5226 | (if (not vhdl-argument-list-indent) | |
5227 | (let ((opoint (point))) | |
5228 | (back-to-indentation) | |
5229 | (setq margin (+ (current-column) vhdl-basic-offset)) | |
5230 | (goto-char opoint) | |
5231 | (newline) | |
5232 | (indent-to margin))) | |
5233 | (let ((vhdl-ports (vhdl-field "[names]"))) | |
5234 | (if (string-equal vhdl-ports "") | |
5235 | (if optional | |
5236 | (progn (vhdl-kill-entire-line) (forward-line -1) | |
5237 | (if (not vhdl-argument-list-indent) | |
5238 | (progn (vhdl-kill-entire-line) (forward-line -1)))) | |
5239 | (progn (undo 0) (insert " ")) | |
5240 | nil ) | |
5241 | (insert " : ") | |
5242 | (progn | |
5243 | (let ((semicolon-pos)) | |
5244 | (while (not (string-equal "" vhdl-ports)) | |
5245 | (vhdl-field "direction") | |
5246 | (insert " ") | |
5247 | (vhdl-field "type") | |
5248 | (setq semicolon-pos (point)) | |
5249 | (insert ";") | |
5250 | (if (not no-comment) | |
5251 | (vhdl-declaration-comment)) | |
5252 | (newline) | |
5253 | (indent-to margin) | |
5254 | (setq vhdl-ports (vhdl-field "[names]" " : "))) | |
5255 | (goto-char semicolon-pos) | |
5256 | (if (not vhdl-argument-list-indent) | |
5257 | (progn (insert "\n") (indent-to margin))) | |
5258 | (insert ")") | |
5259 | (forward-char 1) | |
5260 | (if (= (following-char) ? ) | |
5261 | (delete-char 1)) | |
5262 | (forward-line 1) | |
5263 | (vhdl-kill-entire-line) | |
5264 | (end-of-line -0) | |
5265 | (if vhdl-auto-align (vhdl-align start (point) 1)) | |
5266 | t)))))) | |
5267 | ||
5268 | (defun vhdl-get-generic (optional &optional no-value ) | |
5269 | "Read from user a generic spec argument list." | |
5270 | (let ((margin (current-column)) | |
5271 | (start (point))) | |
5272 | (if (not vhdl-argument-list-indent) | |
5273 | (let ((opoint (point))) | |
5274 | (back-to-indentation) | |
5275 | (setq margin (+ (current-column) vhdl-basic-offset)) | |
5276 | (goto-char opoint) | |
5277 | (newline) | |
5278 | (indent-to margin))) | |
5279 | (let ((vhdl-generic)) | |
5280 | (if no-value | |
5281 | (setq vhdl-generic (vhdl-field "[names]")) | |
5282 | (setq vhdl-generic (vhdl-field "[name]"))) | |
5283 | (if (string-equal vhdl-generic "") | |
5284 | (if optional | |
5285 | (progn (vhdl-kill-entire-line) (end-of-line -0) | |
5286 | (if (not vhdl-argument-list-indent) | |
5287 | (progn (vhdl-kill-entire-line) (end-of-line -0)))) | |
5288 | (progn (undo 0) (insert " ")) | |
5289 | nil ) | |
5290 | (insert " : ") | |
5291 | (progn | |
5292 | (let ((semicolon-pos)) | |
5293 | (while (not(string-equal "" vhdl-generic)) | |
5294 | (vhdl-field "type") | |
5295 | (if no-value | |
5296 | (progn (setq semicolon-pos (point)) | |
5297 | (insert ";")) | |
5298 | (insert " := ") | |
5299 | (if (equal (vhdl-field "[value]") "") | |
5300 | (delete-char -4)) | |
5301 | (setq semicolon-pos (point)) | |
5302 | (insert ";") | |
5303 | (vhdl-declaration-comment)) | |
5304 | (newline) | |
5305 | (indent-to margin) | |
5306 | (if no-value | |
5307 | (setq vhdl-generic (vhdl-field "[names]" " : ")) | |
5308 | (setq vhdl-generic (vhdl-field "[name]" " : ")))) | |
5309 | (goto-char semicolon-pos) | |
5310 | (if (not vhdl-argument-list-indent) | |
5311 | (progn (insert "\n") (indent-to margin))) | |
5312 | (insert ")") | |
5313 | (forward-char 1) | |
5314 | (if (= (following-char) ? ) | |
5315 | (delete-char 1)) | |
5316 | (forward-line 1) | |
5317 | (vhdl-kill-entire-line) | |
5318 | (end-of-line -0) | |
5319 | (if vhdl-auto-align (vhdl-align start (point) 1)) | |
5320 | t)))))) | |
5321 | ||
5322 | (defun vhdl-insert-date () | |
5323 | "Insert date in appropriate format." | |
5324 | (interactive) | |
5325 | (insert | |
5326 | (cond | |
5327 | ((eq vhdl-date-format 'american) (format-time-string "%m/%d/%Y" nil)) | |
5328 | ((eq vhdl-date-format 'european) (format-time-string "%d.%m.%Y" nil)) | |
5329 | ((eq vhdl-date-format 'scientific) (format-time-string "%Y/%m/%d" nil)) | |
5330 | ))) | |
5331 | ||
5332 | (defun vhdl-insert-keyword (keyword) | |
5333 | (insert (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword))) | |
5334 | ) | |
5335 | ||
5336 | (defun vhdl-case-keyword (keyword) | |
5337 | (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword)) | |
5338 | ) | |
5339 | ||
5340 | (defun vhdl-case-word (num) | |
5341 | (if vhdl-upper-case-keywords (upcase-word num) (downcase-word num)) | |
5342 | ) | |
5343 | ||
5344 | (defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count) | |
5345 | "Convert all words matching word-regexp in region to lower or upper case, | |
5346 | depending on parameter upper-case." | |
5347 | (let ((case-fold-search t) | |
5348 | (case-replace nil) | |
5349 | (busy-counter 0)) | |
5350 | (modify-syntax-entry ?_ "w" vhdl-mode-syntax-table) | |
5351 | (save-excursion | |
5352 | (goto-char beg) | |
5353 | (while (re-search-forward word-regexp end t) | |
5354 | (or (vhdl-in-comment-p) | |
5355 | (vhdl-in-string-p) | |
5356 | (if upper-case | |
5357 | (upcase-word -1) | |
5358 | (downcase-word -1))) | |
5359 | (if (and count | |
5360 | (/= busy-counter (setq busy-counter | |
5361 | (+ (* count 25) (/ (* 25 (- (point) beg)) (- end beg)))))) | |
5362 | (message (format "Fixing case ... (%2d%s)" busy-counter "%%")))) | |
5363 | (goto-char end)) | |
5364 | (if (not vhdl-underscore-is-part-of-word) | |
5365 | (modify-syntax-entry ?_ "_" vhdl-mode-syntax-table)) | |
5366 | (message "") | |
5367 | )) | |
5368 | ||
5369 | (defun vhdl-fix-case-region (beg end &optional arg) | |
5370 | "Convert all VHDL words in region to lower or upper case, depending on | |
5371 | variables vhdl-upper-case-{keywords,types,attributes,enum-values}." | |
5372 | (interactive "r\nP") | |
5373 | (vhdl-fix-case-region-1 | |
5374 | beg end vhdl-upper-case-keywords vhdl-93-keywords-regexp 0) | |
5375 | (vhdl-fix-case-region-1 | |
5376 | beg end vhdl-upper-case-types vhdl-93-types-regexp 1) | |
5377 | (vhdl-fix-case-region-1 | |
5378 | beg end vhdl-upper-case-attributes vhdl-93-attributes-regexp 2) | |
5379 | (vhdl-fix-case-region-1 | |
5380 | beg end vhdl-upper-case-enum-values vhdl-93-enum-values-regexp 3) | |
5381 | ) | |
5382 | ||
5383 | (defun vhdl-fix-case-buffer () | |
5384 | "Convert all VHDL words in buffer to lower or upper case, depending on | |
5385 | variables vhdl-upper-case-{keywords,types,attributes,enum-values}." | |
5386 | (interactive) | |
5387 | (vhdl-fix-case-region (point-min) (point-max)) | |
5388 | ) | |
5389 | ||
5390 | (defun vhdl-minibuffer-tab (&optional prefix-arg) | |
5391 | "If preceeding character is part of a word then dabbrev-expand, | |
5392 | else if right of non whitespace on line then tab-to-tab-stop, | |
5393 | else indent line in proper way for current major mode | |
5394 | (used for word completion in VHDL minibuffer)." | |
5395 | (interactive "P") | |
5396 | (cond ((= (char-syntax (preceding-char)) ?w) | |
5397 | (let ((case-fold-search nil)) (dabbrev-expand prefix-arg))) | |
5398 | ((> (current-column) (current-indentation)) | |
5399 | (tab-to-tab-stop)) | |
5400 | (t | |
5401 | (if (eq indent-line-function 'indent-to-left-margin) | |
5402 | (insert-tab prefix-arg) | |
5403 | (if prefix-arg | |
5404 | (funcall indent-line-function prefix-arg) | |
5405 | (funcall indent-line-function)))))) | |
5406 | ||
5407 | (defun vhdl-help () | |
5408 | "Display help information in '*Help*' buffer ." | |
5409 | (interactive) | |
5410 | (with-output-to-temp-buffer "*Help*" | |
5411 | (princ mode-name) | |
5412 | (princ " mode:\n") | |
5413 | (princ (documentation major-mode)) | |
5414 | (save-excursion | |
5415 | (set-buffer standard-output) | |
5416 | (help-mode)) | |
5417 | (print-help-return-message))) | |
5418 | ||
5419 | (defun vhdl-current-line () | |
5420 | "Return the line number of the line containing point." | |
5421 | (save-restriction | |
5422 | (widen) | |
5423 | (save-excursion | |
5424 | (beginning-of-line) | |
5425 | (1+ (count-lines 1 (point))))) | |
5426 | ) | |
5427 | ||
5428 | (defun vhdl-kill-entire-line () | |
5429 | "Delete entire line." | |
5430 | (interactive) | |
5431 | (end-of-line) | |
5432 | (kill-line -0) | |
5433 | (delete-char 1) | |
5434 | ) | |
5435 | ||
5436 | (defun vhdl-open-line () | |
5437 | "Open a new line and indent." | |
5438 | (interactive) | |
5439 | (end-of-line) | |
5440 | (newline-and-indent) | |
5441 | ) | |
5442 | ||
5443 | (defun vhdl-kill-line () | |
5444 | "Kill current line." | |
5445 | (interactive) | |
5446 | (vhdl-kill-entire-line) | |
5447 | ) | |
5448 | ||
5449 | (defun vhdl-character-to-event-hack (char) | |
5450 | (if (memq 'XEmacs vhdl-emacs-features) | |
5451 | (character-to-event char) | |
5452 | char)) | |
5453 | ||
5454 | ;; ############################################################################ | |
5455 | ;; Abbrev hooks | |
5456 | ||
5457 | (defun vhdl-electric-mode () | |
5458 | "Toggle VHDL Electric mode." | |
5459 | (interactive) | |
5460 | (setq vhdl-electric-mode (not vhdl-electric-mode)) | |
5461 | (setq mode-name (if vhdl-electric-mode "Electric VHDL" "VHDL")) | |
5462 | (force-mode-line-update) | |
5463 | ) | |
5464 | ||
5465 | (defun vhdl-stutter-mode () | |
5466 | "Toggle VHDL Stuttering mode." | |
5467 | (interactive) | |
5468 | (setq vhdl-stutter-mode (not vhdl-stutter-mode)) | |
5469 | ) | |
5470 | ||
5471 | (defun vhdl-hooked-abbrev (fun) | |
5472 | "Do function, if syntax says abbrev is a keyword, invoked by hooked abbrev, | |
5473 | but not if inside a comment or quote)" | |
5474 | (if (or (vhdl-in-comment-p) | |
5475 | (vhdl-in-string-p) | |
5476 | (save-excursion (forward-word -1) (looking-at "end"))) | |
5477 | (progn | |
5478 | (insert " ") | |
5479 | (unexpand-abbrev) | |
5480 | (delete-char -1)) | |
5481 | (if (not vhdl-electric-mode) | |
5482 | (progn | |
5483 | (insert " ") | |
5484 | (unexpand-abbrev) | |
5485 | (backward-word 1) | |
5486 | (vhdl-case-word 1) | |
5487 | (delete-char 1) | |
5488 | ) | |
5489 | (let ((invoke-char last-command-char) (abbrev-mode -1)) | |
5490 | (funcall fun) | |
5491 | (if (= invoke-char ?-) (setq abbrev-start-location (point))) | |
5492 | ;; delete CR which is still in event queue | |
5493 | (if (memq 'XEmacs vhdl-emacs-features) | |
5494 | (enqueue-eval-event 'delete-char -1) | |
5495 | (setq unread-command-events ; push back a delete char | |
5496 | (list (vhdl-character-to-event-hack ?\177)))) | |
5497 | )))) | |
5498 | ||
5499 | (defun vhdl-alias-hook () "hooked version of vhdl-alias." | |
5500 | (vhdl-hooked-abbrev 'vhdl-alias)) | |
5501 | (defun vhdl-architecture-hook () "hooked version of vhdl-architecture." | |
5502 | (vhdl-hooked-abbrev 'vhdl-architecture)) | |
5503 | (defun vhdl-array-hook () "hooked version of vhdl-array." | |
5504 | (vhdl-hooked-abbrev 'vhdl-array)) | |
5505 | (defun vhdl-assert-hook () "hooked version of vhdl-assert." | |
5506 | (vhdl-hooked-abbrev 'vhdl-assert)) | |
5507 | (defun vhdl-attribute-hook () "hooked version of vhdl-attribute." | |
5508 | (vhdl-hooked-abbrev 'vhdl-attribute)) | |
5509 | (defun vhdl-block-hook () "hooked version of vhdl-block." | |
5510 | (vhdl-hooked-abbrev 'vhdl-block)) | |
5511 | (defun vhdl-case-hook () "hooked version of vhdl-case." | |
5512 | (vhdl-hooked-abbrev 'vhdl-case)) | |
5513 | (defun vhdl-component-hook () "hooked version of vhdl-component." | |
5514 | (vhdl-hooked-abbrev 'vhdl-component)) | |
5515 | (defun vhdl-component-instance-hook () | |
5516 | "hooked version of vhdl-component-instance." | |
5517 | (vhdl-hooked-abbrev 'vhdl-component-instance)) | |
5518 | (defun vhdl-concurrent-signal-assignment-hook () | |
5519 | "hooked version of vhdl-concurrent-signal-assignment." | |
5520 | (vhdl-hooked-abbrev 'vhdl-concurrent-signal-assignment)) | |
5521 | (defun vhdl-configuration-hook () | |
5522 | "hooked version of vhdl-configuration." | |
5523 | (vhdl-hooked-abbrev 'vhdl-configuration)) | |
5524 | (defun vhdl-constant-hook () "hooked version of vhdl-constant." | |
5525 | (vhdl-hooked-abbrev 'vhdl-constant)) | |
5526 | (defun vhdl-disconnect-hook () "hooked version of vhdl-disconnect." | |
5527 | (vhdl-hooked-abbrev 'vhdl-disconnect)) | |
5528 | (defun vhdl-display-comment-hook () "hooked version of vhdl-display-comment." | |
5529 | (vhdl-hooked-abbrev 'vhdl-display-comment)) | |
5530 | (defun vhdl-else-hook () "hooked version of vhdl-else." | |
5531 | (vhdl-hooked-abbrev 'vhdl-else)) | |
5532 | (defun vhdl-elsif-hook () "hooked version of vhdl-elsif." | |
5533 | (vhdl-hooked-abbrev 'vhdl-elsif)) | |
5534 | (defun vhdl-entity-hook () "hooked version of vhdl-entity." | |
5535 | (vhdl-hooked-abbrev 'vhdl-entity)) | |
5536 | (defun vhdl-exit-hook () "hooked version of vhdl-exit." | |
5537 | (vhdl-hooked-abbrev 'vhdl-exit)) | |
5538 | (defun vhdl-for-hook () "hooked version of vhdl-for." | |
5539 | (vhdl-hooked-abbrev 'vhdl-for)) | |
5540 | (defun vhdl-function-hook () "hooked version of vhdl-function." | |
5541 | (vhdl-hooked-abbrev 'vhdl-function)) | |
5542 | (defun vhdl-generate-hook () "hooked version of vhdl-generate." | |
5543 | (vhdl-hooked-abbrev 'vhdl-generate)) | |
5544 | (defun vhdl-generic-hook () "hooked version of vhdl-generic." | |
5545 | (vhdl-hooked-abbrev 'vhdl-generic)) | |
5546 | (defun vhdl-library-hook () "hooked version of vhdl-library." | |
5547 | (vhdl-hooked-abbrev 'vhdl-library)) | |
5548 | (defun vhdl-header-hook () "hooked version of vhdl-header." | |
5549 | (vhdl-hooked-abbrev 'vhdl-header)) | |
5550 | (defun vhdl-if-hook () "hooked version of vhdl-if." | |
5551 | (vhdl-hooked-abbrev 'vhdl-if)) | |
5552 | (defun vhdl-loop-hook () "hooked version of vhdl-loop." | |
5553 | (vhdl-hooked-abbrev 'vhdl-loop)) | |
5554 | (defun vhdl-map-hook () "hooked version of vhdl-map." | |
5555 | (vhdl-hooked-abbrev 'vhdl-map)) | |
5556 | (defun vhdl-modify-hook () "hooked version of vhdl-modify." | |
5557 | (vhdl-hooked-abbrev 'vhdl-modify)) | |
5558 | (defun vhdl-next-hook () "hooked version of vhdl-next." | |
5559 | (vhdl-hooked-abbrev 'vhdl-next)) | |
5560 | (defun vhdl-package-hook () "hooked version of vhdl-package." | |
5561 | (vhdl-hooked-abbrev 'vhdl-package)) | |
5562 | (defun vhdl-port-hook () "hooked version of vhdl-port." | |
5563 | (vhdl-hooked-abbrev 'vhdl-port)) | |
5564 | (defun vhdl-procedure-hook () "hooked version of vhdl-procedure." | |
5565 | (vhdl-hooked-abbrev 'vhdl-procedure)) | |
5566 | (defun vhdl-process-hook () "hooked version of vhdl-process." | |
5567 | (vhdl-hooked-abbrev 'vhdl-process)) | |
5568 | (defun vhdl-record-hook () "hooked version of vhdl-record." | |
5569 | (vhdl-hooked-abbrev 'vhdl-record)) | |
5570 | (defun vhdl-return-hook () "hooked version of vhdl-return-value." | |
5571 | (vhdl-hooked-abbrev 'vhdl-return-value)) | |
5572 | (defun vhdl-selected-signal-assignment-hook () | |
5573 | "hooked version of vhdl-selected-signal-assignment." | |
5574 | (vhdl-hooked-abbrev 'vhdl-selected-signal-assignment)) | |
5575 | (defun vhdl-signal-hook () "hooked version of vhdl-signal." | |
5576 | (vhdl-hooked-abbrev 'vhdl-signal)) | |
5577 | (defun vhdl-subtype-hook () "hooked version of vhdl-subtype." | |
5578 | (vhdl-hooked-abbrev 'vhdl-subtype)) | |
5579 | (defun vhdl-type-hook () "hooked version of vhdl-type." | |
5580 | (vhdl-hooked-abbrev 'vhdl-type)) | |
5581 | (defun vhdl-use-hook () "hooked version of vhdl-use." | |
5582 | (vhdl-hooked-abbrev 'vhdl-use)) | |
5583 | (defun vhdl-variable-hook () "hooked version of vhdl-variable." | |
5584 | (vhdl-hooked-abbrev 'vhdl-variable)) | |
5585 | (defun vhdl-wait-hook () "hooked version of vhdl-wait." | |
5586 | (vhdl-hooked-abbrev 'vhdl-wait)) | |
5587 | (defun vhdl-when-hook () "hooked version of vhdl-when." | |
5588 | (vhdl-hooked-abbrev 'vhdl-when)) | |
5589 | (defun vhdl-while-loop-hook () "hooked version of vhdl-while-loop." | |
5590 | (vhdl-hooked-abbrev 'vhdl-while-loop)) | |
5591 | (defun vhdl-and-hook () "hooked version of vhdl-and." | |
5592 | (vhdl-hooked-abbrev 'vhdl-and)) | |
5593 | (defun vhdl-or-hook () "hooked version of vhdl-or." | |
5594 | (vhdl-hooked-abbrev 'vhdl-or)) | |
5595 | (defun vhdl-nand-hook () "hooked version of vhdl-nand." | |
5596 | (vhdl-hooked-abbrev 'vhdl-nand)) | |
5597 | (defun vhdl-nor-hook () "hooked version of vhdl-nor." | |
5598 | (vhdl-hooked-abbrev 'vhdl-nor)) | |
5599 | (defun vhdl-xor-hook () "hooked version of vhdl-xor." | |
5600 | (vhdl-hooked-abbrev 'vhdl-xor)) | |
5601 | (defun vhdl-xnor-hook () "hooked version of vhdl-xnor." | |
5602 | (vhdl-hooked-abbrev 'vhdl-xnor)) | |
5603 | (defun vhdl-not-hook () "hooked version of vhdl-not." | |
5604 | (vhdl-hooked-abbrev 'vhdl-not)) | |
5605 | ||
5606 | (defun vhdl-default-hook () "hooked version of vhdl-default." | |
5607 | (vhdl-hooked-abbrev 'vhdl-default)) | |
5608 | (defun vhdl-default-indent-hook () "hooked version of vhdl-default-indent." | |
5609 | (vhdl-hooked-abbrev 'vhdl-default-indent)) | |
5610 | ||
5611 | ||
5612 | ;; ############################################################################ | |
5613 | ;; Font locking | |
5614 | ;; ############################################################################ | |
5615 | ;; (using `font-lock.el') | |
5616 | ||
5617 | ;; ############################################################################ | |
5618 | ;; Syntax definitions | |
5619 | ||
5620 | (defvar vhdl-font-lock-keywords nil | |
5621 | "Regular expressions to highlight in VHDL Mode.") | |
5622 | ||
5623 | (defconst vhdl-font-lock-keywords-0 | |
5624 | (list | |
5625 | ;; highlight template prompts | |
5626 | '("\\(^\\|[ (.\t]\\)\\(<[^ =].*[^ =]>\\)\\([ .]\\|$\\)" | |
5627 | 2 vhdl-font-lock-prompt-face) | |
5628 | ||
5629 | ;; highlight character literals | |
5630 | '("'\\(.\\)'" 1 'font-lock-string-face) | |
5631 | ) | |
5632 | "For consideration as a value of `vhdl-font-lock-keywords'. | |
5633 | This does highlighting of template prompts and character literals.") | |
5634 | ||
5635 | (defconst vhdl-font-lock-keywords-1 | |
5636 | (list | |
5637 | ;; highlight names of units, subprograms, and components when declared | |
5638 | (list | |
5639 | (concat | |
5640 | "^\\s-*\\(" | |
5641 | "architecture\\|configuration\\|entity\\|package\\(\\s-+body\\|\\)\\|" | |
5642 | "function\\|procedure\\|component" | |
5643 | "\\)\\s-+\\(\\w+\\)") | |
5644 | 3 'font-lock-function-name-face) | |
5645 | ||
5646 | ;; highlight labels of common constructs | |
5647 | (list | |
5648 | (concat | |
5649 | "^\\s-*\\(\\w+\\)\\s-*:\\(\\s-\\|\n\\)*\\(" | |
5650 | "assert\\|block\\|case\\|exit\\|for\\|if\\|loop\\|" | |
5651 | "next\\|null\\|process\\| with\\|while\\|" | |
5652 | "\\w+\\(\\s-\\|\n\\)+\\(generic\\|port\\)\\s-+map" | |
5653 | "\\)\\>") | |
5654 | 1 'font-lock-function-name-face) | |
5655 | ||
5656 | ;; highlight entity names of architectures and configurations | |
5657 | (list | |
5658 | "^\\s-*\\(architecture\\|configuration\\)\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)" | |
5659 | 2 'font-lock-function-name-face) | |
5660 | ||
5661 | ;; highlight names and labels at end of constructs | |
5662 | (list | |
5663 | (concat | |
5664 | "^\\s-*end\\s-+\\(" | |
5665 | "\\(block\\|case\\|component\\|for\\|generate\\|if\\|loop\\|" | |
5666 | "process\\|record\\|units\\)\\>\\|" | |
5667 | "\\)\\s-*\\(\\w*\\)") | |
5668 | 3 'font-lock-function-name-face) | |
5669 | ) | |
5670 | "For consideration as a value of `vhdl-font-lock-keywords'. | |
5671 | This does highlighting of names and labels.") | |
5672 | ||
5673 | (defconst vhdl-font-lock-keywords-2 | |
5674 | (list | |
5675 | ;; highlight keywords, and types, standardized attributes, enumeration values | |
5676 | (list (concat "'" vhdl-93-attributes-regexp) | |
5677 | 1 'vhdl-font-lock-attribute-face) | |
5678 | (list vhdl-93-types-regexp 1 'font-lock-type-face) | |
5679 | (list vhdl-93-enum-values-regexp 1 'vhdl-font-lock-value-face) | |
5680 | (list vhdl-93-keywords-regexp 1 'font-lock-keyword-face) | |
5681 | ) | |
5682 | "For consideration as a value of `vhdl-font-lock-keywords'. | |
5683 | This does highlighting of comments, keywords, and standard types.") | |
5684 | ||
5685 | (defconst vhdl-font-lock-keywords-3 | |
5686 | (list | |
5687 | ;; highlight clock signals. | |
5688 | (cons vhdl-clock-signal-syntax 'vhdl-font-lock-clock-signal-face) | |
5689 | (cons vhdl-reset-signal-syntax 'vhdl-font-lock-reset-signal-face) | |
5690 | (cons vhdl-control-signal-syntax 'vhdl-font-lock-control-signal-face) | |
5691 | (cons vhdl-data-signal-syntax 'vhdl-font-lock-data-signal-face) | |
5692 | (cons vhdl-test-signal-syntax 'vhdl-font-lock-test-signal-face) | |
5693 | ) | |
5694 | "For consideration as a value of `vhdl-font-lock-keywords'. | |
5695 | This does highlighting of signal names with specific syntax.") | |
5696 | ||
5697 | ;; ############################################################################ | |
5698 | ;; Font and color definitions | |
5699 | ||
5700 | (defvar vhdl-font-lock-prompt-face 'vhdl-font-lock-prompt-face | |
5701 | "Face name to use for prompts.") | |
5702 | ||
5703 | (defvar vhdl-font-lock-attribute-face 'vhdl-font-lock-attribute-face | |
5704 | "Face name to use for attributes.") | |
5705 | ||
5706 | (defvar vhdl-font-lock-value-face 'vhdl-font-lock-value-face | |
5707 | "Face name to use for enumeration values.") | |
5708 | ||
5709 | (defvar vhdl-font-lock-clock-signal-face 'vhdl-font-lock-clock-signal-face | |
5710 | "Face name to use for clock signals.") | |
5711 | ||
5712 | (defvar vhdl-font-lock-reset-signal-face 'vhdl-font-lock-reset-signal-face | |
5713 | "Face name to use for reset signals.") | |
5714 | ||
5715 | (defvar vhdl-font-lock-control-signal-face 'vhdl-font-lock-control-signal-face | |
5716 | "Face name to use for control signals.") | |
5717 | ||
5718 | (defvar vhdl-font-lock-data-signal-face 'vhdl-font-lock-data-signal-face | |
5719 | "Face name to use for data signals.") | |
5720 | ||
5721 | (defvar vhdl-font-lock-test-signal-face 'vhdl-font-lock-test-signal-face | |
5722 | "Face name to use for test signals.") | |
5723 | ||
5724 | (defface vhdl-font-lock-prompt-face | |
5725 | '((((class color) (background light)) (:foreground "Red")) | |
5726 | (((class color) (background dark)) (:foreground "Red")) | |
5727 | (t (:inverse-video t))) | |
5728 | "Font Lock mode face used to highlight prompts." | |
5729 | :group 'font-lock-highlighting-faces) | |
5730 | ||
5731 | (defface vhdl-font-lock-attribute-face | |
5732 | '((((class color) (background light)) (:foreground "CadetBlue")) | |
5733 | (((class color) (background dark)) (:foreground "CadetBlue")) | |
5734 | (t (:italic t :bold t))) | |
5735 | "Font Lock mode face used to highlight attributes." | |
5736 | :group 'font-lock-highlighting-faces) | |
5737 | ||
5738 | (defface vhdl-font-lock-value-face | |
5739 | '((((class color) (background light)) (:foreground "DarkGoldenrod")) | |
5740 | (((class color) (background dark)) (:foreground "DarkGoldenrod")) | |
5741 | (t (:italic t :bold t))) | |
5742 | "Font Lock mode face used to highlight enumeration values." | |
5743 | :group 'font-lock-highlighting-faces) | |
5744 | ||
5745 | (defface vhdl-font-lock-clock-signal-face | |
5746 | '((((class color) (background light)) (:foreground "LimeGreen")) | |
5747 | (((class color) (background dark)) (:foreground "LimeGreen")) | |
5748 | (t ())) | |
5749 | "Font Lock mode face used to highlight clock signals." | |
5750 | :group 'font-lock-highlighting-faces) | |
5751 | ||
5752 | (defface vhdl-font-lock-reset-signal-face | |
5753 | '((((class color) (background light)) (:foreground "Red")) | |
5754 | (((class color) (background dark)) (:foreground "Red")) | |
5755 | (t ())) | |
5756 | "Font Lock mode face used to highlight reset signals." | |
5757 | :group 'font-lock-highlighting-faces) | |
5758 | ||
5759 | (defface vhdl-font-lock-control-signal-face | |
5760 | '((((class color) (background light)) (:foreground "Blue")) | |
5761 | (((class color) (background dark)) (:foreground "Blue")) | |
5762 | (t ())) | |
5763 | "Font Lock mode face used to highlight control signals." | |
5764 | :group 'font-lock-highlighting-faces) | |
5765 | ||
5766 | (defface vhdl-font-lock-data-signal-face | |
5767 | '((((class color) (background light)) (:foreground "Black")) | |
5768 | (((class color) (background dark)) (:foreground "Black")) | |
5769 | (t ())) | |
5770 | "Font Lock mode face used to highlight data signals." | |
5771 | :group 'font-lock-highlighting-faces) | |
5772 | ||
5773 | (defface vhdl-font-lock-test-signal-face | |
5774 | '((((class color) (background light)) (:foreground "Gold")) | |
5775 | (((class color) (background dark)) (:foreground "Gold")) | |
5776 | (t ())) | |
5777 | "Font Lock mode face used to highlight test signals." | |
5778 | :group 'font-lock-highlighting-faces) | |
5779 | ||
5780 | ;; Custom color definitions for existing faces | |
5781 | (defun vhdl-set-face-foreground () | |
5782 | (set-face-foreground 'font-lock-comment-face "IndianRed") | |
5783 | (set-face-foreground 'font-lock-function-name-face "MediumOrchid") | |
5784 | (set-face-foreground 'font-lock-keyword-face "SlateBlue") | |
5785 | (set-face-foreground 'font-lock-string-face "RosyBrown") | |
5786 | (set-face-foreground 'font-lock-type-face "ForestGreen") | |
5787 | ) | |
5788 | ||
5789 | (defun vhdl-set-face-grayscale () | |
5790 | (interactive) | |
5791 | (set-face-bold-p 'font-lock-comment-face nil) | |
5792 | (set-face-inverse-video-p 'font-lock-comment-face nil) | |
5793 | (set-face-italic-p 'font-lock-comment-face t) | |
5794 | (set-face-underline-p 'font-lock-comment-face nil) | |
5795 | ||
5796 | (set-face-bold-p 'font-lock-function-name-face nil) | |
5797 | (set-face-inverse-video-p 'font-lock-function-name-face nil) | |
5798 | (set-face-italic-p 'font-lock-function-name-face t) | |
5799 | (set-face-underline-p 'font-lock-function-name-face nil) | |
5800 | ||
5801 | (set-face-bold-p 'font-lock-keyword-face t) | |
5802 | (set-face-inverse-video-p 'font-lock-keyword-face nil) | |
5803 | (set-face-italic-p 'font-lock-keyword-face nil) | |
5804 | (set-face-underline-p 'font-lock-keyword-face nil) | |
5805 | ||
5806 | (set-face-bold-p 'font-lock-string-face nil) | |
5807 | (set-face-inverse-video-p 'font-lock-string-face nil) | |
5808 | (set-face-italic-p 'font-lock-string-face nil) | |
5809 | (set-face-underline-p 'font-lock-string-face t) | |
5810 | ||
5811 | (set-face-bold-p 'font-lock-type-face t) | |
5812 | (set-face-inverse-video-p 'font-lock-type-face nil) | |
5813 | (set-face-italic-p 'font-lock-type-face t) | |
5814 | (set-face-underline-p 'font-lock-type-face nil) | |
5815 | ) | |
5816 | ||
5817 | ;; ############################################################################ | |
5818 | ;; Font lock initialization | |
5819 | ||
5820 | (defun vhdl-font-lock-init () | |
5821 | "Initializes fontification." | |
5822 | (setq vhdl-font-lock-keywords | |
5823 | (append vhdl-font-lock-keywords-0 | |
5824 | (if vhdl-highlight-names vhdl-font-lock-keywords-1) | |
5825 | (if vhdl-highlight-keywords vhdl-font-lock-keywords-2) | |
5826 | (if (and vhdl-highlight-signals (x-display-color-p)) | |
5827 | vhdl-font-lock-keywords-3))) | |
5828 | (if (x-display-color-p) | |
2f402702 RS |
5829 | (if vhdl-customize-colors (vhdl-set-face-foreground)) |
5830 | (if vhdl-customize-faces (vhdl-set-face-grayscale)) | |
d2ddb974 KH |
5831 | )) |
5832 | ||
5833 | ;; ############################################################################ | |
5834 | ;; Fontification for postscript printing | |
5835 | ||
5836 | (defun vhdl-ps-init () | |
5837 | "Initializes face and page settings for postscript printing." | |
5838 | (require 'ps-print) | |
2f402702 | 5839 | (unless (or (not vhdl-customize-faces) |
d2ddb974 KH |
5840 | ps-print-color-p) |
5841 | (set (make-local-variable 'ps-bold-faces) | |
5842 | '(font-lock-keyword-face | |
5843 | font-lock-type-face | |
5844 | vhdl-font-lock-attribute-face | |
5845 | vhdl-font-lock-value-face)) | |
5846 | (set (make-local-variable 'ps-italic-faces) | |
5847 | '(font-lock-comment-face | |
5848 | font-lock-function-name-face | |
5849 | font-lock-type-face | |
5850 | vhdl-font-lock-prompt-face | |
5851 | vhdl-font-lock-attribute-face | |
5852 | vhdl-font-lock-value-face)) | |
5853 | (set (make-local-variable 'ps-underlined-faces) | |
5854 | '(font-lock-string-face)) | |
5855 | ) | |
5856 | ;; define page settings, so that a line containing 79 characters (default) | |
5857 | ;; fits into one column | |
5858 | (if vhdl-print-two-column | |
5859 | (progn | |
5860 | (set (make-local-variable 'ps-landscape-mode) t) | |
5861 | (set (make-local-variable 'ps-number-of-columns) 2) | |
5862 | (set (make-local-variable 'ps-font-size) 7.0) | |
5863 | (set (make-local-variable 'ps-header-title-font-size) 10.0) | |
5864 | (set (make-local-variable 'ps-header-font-size) 9.0) | |
5865 | (set (make-local-variable 'ps-header-offset) 12.0) | |
5866 | (if (eq ps-paper-type 'letter) | |
5867 | (progn | |
5868 | (set (make-local-variable 'ps-inter-column) 40.0) | |
5869 | (set (make-local-variable 'ps-left-margin) 40.0) | |
5870 | (set (make-local-variable 'ps-right-margin) 40.0) | |
5871 | ))))) | |
5872 | ||
5873 | ||
5874 | ;; ############################################################################ | |
5875 | ;; Hideshow | |
5876 | ;; ############################################################################ | |
5877 | ;; (using `hideshow.el') | |
5878 | ||
5879 | (defun vhdl-forward-sexp-function (&optional count) | |
5880 | "Find begin and end of VHDL process or block (for hideshow)." | |
5881 | (interactive "p") | |
5882 | (let (name | |
5883 | (case-fold-search t)) | |
5884 | (end-of-line) | |
5885 | (if (< count 0) | |
5886 | (re-search-backward "\\s-*\\(\\w\\|\\s_\\)+\\s-*:\\s-*\\(process\\|block\\)\\>" nil t) | |
5887 | (re-search-forward "\\s-*\\<end\\s-+\\(process\\|block\\)\\>" nil t) | |
5888 | ))) | |
5889 | ||
daa02ea5 DN |
5890 | ;; Not needed `hs-special-modes-alist' is autoloaded. |
5891 | ;(require 'hideshow) | |
d2ddb974 KH |
5892 | |
5893 | (unless (assq 'vhdl-mode hs-special-modes-alist) | |
5894 | (setq hs-special-modes-alist | |
5895 | (cons | |
5896 | '(vhdl-mode | |
5897 | "\\s-*\\(\\w\\|\\s_\\)+\\s-*:\\s-*\\(process\\|PROCESS\\|block\\|BLOCK\\)\\>" | |
5898 | "\\s-*\\<\\(end\\|END\\)\\s-+\\(process\\|PROCESS\\|block\\|BLOCK\\)\\>" | |
5899 | "-- " | |
5900 | vhdl-forward-sexp-function) | |
5901 | hs-special-modes-alist))) | |
5902 | ||
5903 | ||
5904 | ;; ############################################################################ | |
5905 | ;; Compilation | |
5906 | ;; ############################################################################ | |
5907 | ;; (using `compile.el') | |
5908 | ||
5909 | (defvar vhdl-compile-commands | |
5910 | '( | |
5911 | (cadence "cv -file" nil) | |
5912 | (ikos "analyze" nil) | |
5913 | (quickhdl "qvhcom" nil) | |
5914 | (synopsys "vhdlan" nil) | |
5915 | (vantage "analyze -libfile vsslib.ini -src" nil) | |
5916 | (viewlogic "analyze -libfile vsslib.ini -src" nil) | |
5917 | (v-system "vcom" "vmake > Makefile") | |
5918 | ) | |
5919 | "Commands to be called in the shell for compilation (syntax analysis) of a | |
5920 | single buffer and `Makefile' generation for different tools. First item is tool | |
5921 | identifier, second item is shell command for compilation, and third item is | |
5922 | shell command for `Makefile' generation. A tool is specified by assigning a | |
5923 | tool identifier to variable `vhdl-compiler'.") | |
5924 | ||
5925 | (defvar vhdl-compilation-error-regexp-alist | |
5926 | (list | |
5927 | ;; Cadence Design Systems: cv -file test.vhd | |
5928 | ;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared | |
5929 | '("duluth: \\*E,[0-9]+ (\\(.+\\),\\([0-9]+\\)):" 1 2) | |
5930 | ||
5931 | ;; Ikos Voyager: analyze test.vhd | |
5932 | ;; E L4/C5: this library unit is inaccessible | |
5933 | ; Xemacs does not support error messages without included file name | |
5934 | (if (not (memq 'XEmacs vhdl-emacs-features)) | |
5935 | '("E L\\([0-9]+\\)/C[0-9]+:" nil 1) | |
5936 | '("E L\\([0-9]+\\)/C[0-9]+:" 2 1) | |
5937 | ) | |
5938 | ||
5939 | ;; QuickHDL, Mentor Graphics: qvhcom test.vhd | |
5940 | ;; ERROR: test.vhd(24): near "dnd": expecting: END | |
5941 | '("ERROR: \\(.+\\)(\\([0-9]+\\)):" 1 2) | |
5942 | ||
5943 | ;; Synopsys, VHDL Analyzer: vhdlan test.vhd | |
5944 | ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context. | |
5945 | '("\\*\\*Error: vhdlan,[0-9]+ \\(.+\\)(\\([0-9]+\\)):" 1 2) | |
5946 | ||
5947 | ;; Vantage Analysis Systems: analyze -libfile vsslib.ini -src test.vhd | |
5948 | ;; **Error: LINE 499 *** No aggregate value is valid in this context. | |
5949 | ; Xemacs does not support error messages without included file name | |
5950 | (if (not (memq 'XEmacs vhdl-emacs-features)) | |
5951 | '("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1) | |
5952 | '("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" 2 1) | |
5953 | ) | |
5954 | ||
5955 | ;; Viewlogic: analyze -libfile vsslib.ini -src test.vhd | |
5956 | ;; **Error: LINE 499 *** No aggregate value is valid in this context. | |
5957 | ;; same regexp as for Vantage | |
5958 | ||
5959 | ;; V-System, Model Technology: vcom test.vhd | |
5960 | ;; ERROR: test.vhd(14): Unknown identifier: positiv | |
5961 | ;; same regexp as for QuickHDL | |
5962 | ||
5963 | ) "Alist that specifies how to match errors in VHDL compiler output.") | |
5964 | ||
5965 | (defvar compilation-file-regexp-alist | |
5966 | '( | |
5967 | ;; Ikos Voyager: analyze -libfile vsslib.ini -src test.vhd | |
5968 | ;; analyze sdrctl.vhd | |
5969 | ("^analyze +\\(.+ +\\)*\\(.+\\)$" 2) | |
5970 | ||
5971 | ;; Vantage Analysis Systems: analyze -libfile vsslib.ini -src test.vhd | |
5972 | ;; Compiling "pcu.vhd" line 1... | |
5973 | (" *Compiling \"\\(.+\\)\" " 1) | |
5974 | ||
5975 | ;; Viewlogic: analyze -libfile vsslib.ini -src test.vhd | |
5976 | ;; Compiling "pcu.vhd" line 1... | |
5977 | ;; same regexp as for Vantage | |
5978 | ||
5979 | ) "Alist specifying how to match lines that indicate a new current file. | |
5980 | Used for compilers with no file name in the error messages.") | |
5981 | ||
5982 | (defun vhdl-compile () | |
5983 | "Compile current buffer using the VHDL compiler specified in | |
5984 | `vhdl-compiler'." | |
5985 | (interactive) | |
5986 | (let ((command-list vhdl-compile-commands) | |
5987 | command) | |
5988 | (while command-list | |
5989 | (if (eq vhdl-compiler (car (car command-list))) | |
5990 | (setq command (car (cdr (car command-list))))) | |
5991 | (setq command-list (cdr command-list))) | |
5992 | (if command | |
5993 | (compile (concat command " " vhdl-compiler-options | |
5994 | (if (not (string-equal vhdl-compiler-options "")) " ") | |
5995 | (file-name-nondirectory (buffer-file-name))))))) | |
5996 | ||
5997 | (defun vhdl-make () | |
5998 | "Call make command for compilation of all updated source files | |
5999 | (requires `Makefile')." | |
6000 | (interactive) | |
6001 | (compile "make")) | |
6002 | ||
6003 | (defun vhdl-generate-makefile () | |
6004 | "Generate new `Makefile'." | |
6005 | (interactive) | |
6006 | (let ((command-list vhdl-compile-commands) | |
6007 | command) | |
6008 | (while command-list | |
6009 | (if (eq vhdl-compiler (car (car command-list))) | |
6010 | (setq command (car (cdr (cdr (car command-list)))))) | |
6011 | (setq command-list (cdr command-list))) | |
6012 | (if command | |
6013 | (compile command ) | |
6014 | (message (format "Not implemented for `%s'!" vhdl-compiler)) | |
6015 | (beep)))) | |
6016 | ||
6017 | ||
6018 | ;; ############################################################################ | |
6019 | ;; Bug reports | |
6020 | ;; ############################################################################ | |
6021 | ;; (using `reporter.el') | |
6022 | ||
6023 | (defconst vhdl-version "3.19" | |
6024 | "VHDL Mode version number.") | |
6025 | ||
6026 | (defconst vhdl-mode-help-address "vhdl-mode@geocities.com" | |
6027 | "Address for VHDL Mode bug reports.") | |
6028 | ||
6029 | (defun vhdl-version () | |
6030 | "Echo the current version of VHDL Mode in the minibuffer." | |
6031 | (interactive) | |
6032 | (message "Using VHDL Mode version %s" vhdl-version) | |
6033 | (vhdl-keep-region-active)) | |
6034 | ||
6035 | ;; get reporter-submit-bug-report when byte-compiling | |
6036 | (and (fboundp 'eval-when-compile) | |
6037 | (eval-when-compile | |
6038 | (require 'reporter))) | |
6039 | ||
6040 | (defun vhdl-submit-bug-report () | |
6041 | "Submit via mail a bug report on VHDL Mode." | |
6042 | (interactive) | |
6043 | ;; load in reporter | |
6044 | (and | |
6045 | (y-or-n-p "Do you want to submit a report on VHDL Mode? ") | |
6046 | (require 'reporter) | |
6047 | (reporter-submit-bug-report | |
6048 | vhdl-mode-help-address | |
6049 | (concat "VHDL Mode " vhdl-version) | |
6050 | (list | |
6051 | ;; report all important variables | |
6052 | 'vhdl-basic-offset | |
6053 | 'vhdl-offsets-alist | |
6054 | 'vhdl-comment-only-line-offset | |
6055 | 'tab-width | |
6056 | 'vhdl-electric-mode | |
6057 | 'vhdl-stutter-mode | |
6058 | 'vhdl-indent-tabs-mode | |
6059 | 'vhdl-compiler | |
6060 | 'vhdl-compiler-options | |
6061 | 'vhdl-upper-case-keywords | |
6062 | 'vhdl-upper-case-types | |
6063 | 'vhdl-upper-case-attributes | |
6064 | 'vhdl-upper-case-enum-values | |
6065 | 'vhdl-auto-align | |
6066 | 'vhdl-additional-empty-lines | |
6067 | 'vhdl-argument-list-indent | |
6068 | 'vhdl-conditions-in-parenthesis | |
6069 | 'vhdl-date-format | |
6070 | 'vhdl-header-file | |
6071 | 'vhdl-modify-date-prefix-string | |
6072 | 'vhdl-zero-string | |
6073 | 'vhdl-one-string | |
6074 | 'vhdl-self-insert-comments | |
6075 | 'vhdl-prompt-for-comments | |
6076 | 'vhdl-comment-column | |
6077 | 'vhdl-end-comment-column | |
6078 | 'vhdl-highlight-names | |
6079 | 'vhdl-highlight-keywords | |
6080 | 'vhdl-highlight-signals | |
6081 | 'vhdl-highlight-case-sensitive | |
2f402702 RS |
6082 | 'vhdl-customize-colors |
6083 | 'vhdl-customize-faces | |
d2ddb974 KH |
6084 | 'vhdl-clock-signal-syntax |
6085 | 'vhdl-reset-signal-syntax | |
6086 | 'vhdl-control-signal-syntax | |
6087 | 'vhdl-data-signal-syntax | |
6088 | 'vhdl-test-signal-syntax | |
6089 | 'vhdl-source-file-menu | |
6090 | 'vhdl-index-menu | |
6091 | 'vhdl-hideshow-menu | |
6092 | 'vhdl-print-two-column | |
6093 | 'vhdl-intelligent-tab | |
6094 | 'vhdl-template-key-binding-prefix | |
6095 | 'vhdl-word-completion-in-minibuffer | |
6096 | 'vhdl-underscore-is-part-of-word | |
6097 | 'vhdl-mode-hook | |
6098 | ) | |
6099 | (function | |
6100 | (lambda () | |
6101 | (insert | |
6102 | (if vhdl-special-indent-hook | |
6103 | (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n" | |
6104 | "vhdl-special-indent-hook is set to '" | |
6105 | (format "%s" vhdl-special-indent-hook) | |
6106 | ".\nPerhaps this is your problem?\n" | |
6107 | "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n") | |
6108 | "\n") | |
6109 | (format "vhdl-emacs-features: %s\n" vhdl-emacs-features) | |
6110 | ))) | |
6111 | nil | |
6112 | "Dear VHDL Mode maintainers," | |
6113 | ))) | |
6114 | ||
6115 | ||
6116 | ;; ############################################################################ | |
6117 | ||
6118 | (provide 'vhdl-mode) | |
6119 | ||
6120 | ;;; vhdl-mode.el ends here |