1 ;;; vhdl-mode.el --- major mode for editing VHDL code
3 ;; Copyright (C) 1992-2014 Free Software Foundation, Inc.
5 ;; Authors: Reto Zimmermann <reto@gnu.org>
6 ;; Rodney J. Whitby <software.vhdl-mode@rwhitby.net>
7 ;; Maintainer: Reto Zimmermann <reto@gnu.org>
8 ;; Keywords: languages vhdl
9 ;; WWW: http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html
11 ;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this
12 ;; file on 18/3/2008, and the maintainer agreed that when a bug is
13 ;; filed in the Emacs bug reporting system against this file, a copy
14 ;; of the bug report be sent to the maintainer's email address.
16 (defconst vhdl-version
"3.35.1"
17 "VHDL Mode version number.")
19 (defconst vhdl-time-stamp
"2014-03-11"
20 "VHDL Mode time stamp for last update.")
22 ;; This file is part of GNU Emacs.
24 ;; GNU Emacs is free software: you can redistribute it and/or modify
25 ;; it under the terms of the GNU General Public License as published by
26 ;; the Free Software Foundation, either version 3 of the License, or
27 ;; (at your option) any later version.
29 ;; GNU Emacs is distributed in the hope that it will be useful,
30 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
31 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
32 ;; GNU General Public License for more details.
34 ;; You should have received a copy of the GNU General Public License
35 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
37 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
39 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
41 ;; This package provides an Emacs major mode for editing VHDL code.
42 ;; It includes the following features:
44 ;; - Syntax highlighting
46 ;; - Template insertion (electrification)
47 ;; - Insertion of file headers
48 ;; - Insertion of user-specified models
49 ;; - Port translation / testbench generation
50 ;; - Structural composition
51 ;; - Configuration generation
52 ;; - Sensitivity list updating
54 ;; - Design hierarchy browser
55 ;; - Source file compilation (syntax analysis)
56 ;; - Makefile generation
58 ;; - Word/keyword completion
60 ;; - Code fixing/alignment/beautification
61 ;; - PostScript printing
62 ;; - VHDL'87/'93 and VHDL-AMS supported
63 ;; - Comprehensive menu
64 ;; - Fully customizable
65 ;; - Works under GNU Emacs (recommended) and XEmacs
67 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
70 ;; See comment string of function `vhdl-mode' or type `C-c C-h' in Emacs.
72 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75 ;; this updated version was only tested on: GNU Emacs 24.1
77 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
80 ;; Prerequisites: GNU Emacs 20/21/22/23/24, XEmacs 20/21.
82 ;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation
83 ;; or into an arbitrary directory that is added to the load path by the
84 ;; following line in your Emacs start-up file `.emacs':
86 ;; (push (expand-file-name "<directory-name>") load-path)
88 ;; If you already have the compiled `vhdl-mode.elc' file, put it in the same
89 ;; directory. Otherwise, byte-compile the source file:
90 ;; Emacs: M-x byte-compile-file RET vhdl-mode.el RET
91 ;; Unix: emacs -batch -q -no-site-file -f batch-byte-compile vhdl-mode.el
93 ;; Add the following lines to the `site-start.el' file in the `site-lisp'
94 ;; directory of your Emacs installation or to your Emacs start-up file `.emacs'
95 ;; (not required in Emacs 20 and higher):
97 ;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t)
98 ;; (push '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist)
100 ;; More detailed installation instructions are included in the official
101 ;; VHDL Mode distribution.
103 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
106 ;; Electrification ideas by Bob Pack <rlpst@cislabs.pitt.edu>
109 ;; Fontification approach suggested by Ken Wood <ken@eda.com.au>.
110 ;; Ideas about alignment from John Wiegley <johnw@gnu.org>.
112 ;; Many thanks to all the users who sent me bug reports and enhancement
114 ;; Thanks to Colin Marquardt for his serious beta testing, his innumerable
115 ;; enhancement suggestions and the fruitful discussions.
116 ;; Thanks to Dan Nicolaescu for reviewing the code and for his valuable hints.
117 ;; Thanks to Ulf Klaperski for the indentation speedup hint.
119 ;; Special thanks go to Wolfgang Fichtner and the crew from the Integrated
120 ;; Systems Laboratory, Swiss Federal Institute of Technology Zurich, for
121 ;; giving me the opportunity to develop this code.
122 ;; This work has been funded in part by MICROSWISS, a Microelectronics Program
123 ;; of the Swiss Government.
125 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
129 ;; Emacs 21+ handling
130 (defconst vhdl-emacs-21
(and (<= 21 emacs-major-version
) (not (featurep 'xemacs
)))
131 "Non-nil if GNU Emacs 21, 22, ... is used.")
132 ;; Emacs 22+ handling
133 (defconst vhdl-emacs-22
(and (<= 22 emacs-major-version
) (not (featurep 'xemacs
)))
134 "Non-nil if GNU Emacs 22, ... is used.")
136 (defvar compilation-file-regexp-alist
)
141 (defvar itimer-version
)
142 (defvar lazy-lock-defer-contextually
)
143 (defvar lazy-lock-defer-on-scrolling
)
144 (defvar lazy-lock-defer-on-the-fly
)
145 (defvar speedbar-attached-frame
)
148 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
150 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
152 ;; help function for user options
153 (defun vhdl-custom-set (variable value
&rest functions
)
154 "Set variables as in `custom-set-default' and call FUNCTIONS afterwards."
155 (if (fboundp 'custom-set-default
)
156 (custom-set-default variable value
)
157 (set-default variable value
))
159 (when (fboundp (car functions
)) (funcall (car functions
)))
160 (setq functions
(cdr functions
))))
162 (defun vhdl-widget-directory-validate (widget)
163 "Check that the value of WIDGET is a valid directory entry (i.e. ends with
165 (let ((val (widget-value widget
)))
166 (unless (string-match "^\\(\\|.*/\\)$" val
)
167 (widget-put widget
:error
"Invalid directory entry: must end with '/'")
170 ;; help string for user options
171 (defconst vhdl-name-doc-string
"
173 FROM REGEXP is a regular expression matching the original name:
174 \".*\" matches the entire string
175 \"\\(...\\)\" matches a substring
176 TO STRING specifies the string to be inserted as new name:
177 \"\\&\" means substitute entire matched text
178 \"\\N\" means substitute what matched the Nth \"\\(...\\)\"
180 \".*\" \"\\&\" inserts original string
181 \".*\" \"\\&_i\" attaches \"_i\" to original string
182 \"\\(.*\\)_[io]$\" \"\\1\" strips off \"_i\" or \"_o\" from original string
183 \".*\" \"foo\" inserts constant string \"foo\"
184 \".*\" \"\" inserts empty string")
186 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
187 ;; User variables (customization options)
190 "Customizations for VHDL Mode."
193 ; :version "21.2" ; comment out for XEmacs
196 (defgroup vhdl-mode nil
197 "Customizations for modes."
200 (defcustom vhdl-indent-tabs-mode nil
201 "Non-nil means indentation can insert tabs.
202 Overrides local variable `indent-tabs-mode'."
207 (defgroup vhdl-compile nil
208 "Customizations for compilation."
211 (defcustom vhdl-compiler-alist
213 ;; 60: docal <= false;
215 ;; [Error] Assignment error: variable is illegal target of signal assignment
216 ("ADVance MS" "vacom" "-work \\1" "make" "-f \\1"
217 nil
"valib \\1; vamap \\2 \\1" "./" "work/" "Makefile" "adms"
218 ("^\\s-+\\([0-9]+\\):\\s-+" nil
1 nil
) ("Compiling file \\(.+\\)" 1)
219 ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif"
220 "PACK/\\1.vif" "BODY/\\1.vif" upcase
))
222 ;; COMP96 ERROR COMP96_0018: "Identifier expected." "test.vhd" 66 3
223 ("Aldec" "vcom" "-work \\1" "make" "-f \\1"
224 nil
"vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "aldec"
225 (".* ERROR [^:]+: \".*\" \"\\([^ \\t\\n]+\\)\" \\([0-9]+\\) \\([0-9]+\\)" 1 2 3) ("" 0)
227 ;; Cadence Leapfrog: cv -file test.vhd
228 ;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared
229 ("Cadence Leapfrog" "cv" "-work \\1 -file" "make" "-f \\1"
230 nil
"mkdir \\1" "./" "work/" "Makefile" "leapfrog"
231 ("duluth: \\*E,[0-9]+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)):" 1 2 nil
) ("" 0)
232 ("\\1/entity" "\\2/\\1" "\\1/configuration"
233 "\\1/package" "\\1/body" downcase
))
234 ;; Cadence Affirma NC vhdl: ncvhdl test.vhd
235 ;; ncvhdl_p: *E,IDENTU (test.vhd,13|25): identifier
236 ;; (PLL_400X_TOP) is not declared [10.3].
237 ("Cadence NC" "ncvhdl" "-work \\1" "make" "-f \\1"
238 nil
"mkdir \\1" "./" "work/" "Makefile" "ncvhdl"
239 ("ncvhdl_p: \\*E,\\w+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
240 ("\\1/entity/pc.db" "\\2/\\1/pc.db" "\\1/configuration/pc.db"
241 "\\1/package/pc.db" "\\1/body/pc.db" downcase
))
242 ;; ghdl vhdl: ghdl test.vhd
243 ("GHDL" "ghdl" "-i --workdir=\\1 --ieee=synopsys -fexplicit " "make" "-f \\1"
244 nil
"mkdir \\1" "./" "work/" "Makefile" "ghdl"
245 ("ghdl_p: \\*E,\\w+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
246 ("\\1/entity" "\\2/\\1" "\\1/configuration"
247 "\\1/package" "\\1/body" downcase
))
249 ;; 00 COACHDL* | [CCHDL-1]: File: adder.vhd, line.column: 120.6
250 ("IBM Compiler" "g2tvc" "-src" "precomp" "\\1"
251 nil
"mkdir \\1" "./" "work/" "Makefile" "ibm"
252 ("[0-9]+ COACHDL.*: File: \\([^ \\t\\n]+\\), line.column: \\([0-9]+\\).\\([0-9]+\\)" 1 2 3) (" " 0)
254 ;; Ikos Voyager: analyze test.vhd
256 ;; E L4/C5: this library unit is inaccessible
257 ("Ikos" "analyze" "-l \\1" "make" "-f \\1"
258 nil
"mkdir \\1" "./" "work/" "Makefile" "ikos"
259 ("E L\\([0-9]+\\)/C\\([0-9]+\\):" nil
1 2)
260 ("^analyze +\\(.+ +\\)*\\(.+\\)$" 2)
262 ;; ModelSim, Model Technology: vcom test.vhd
263 ;; ERROR: test.vhd(14): Unknown identifier: positiv
264 ;; WARNING[2]: test.vhd(85): Possible infinite loop
265 ;; ** Warning: [4] ../src/emacsvsim.vhd(43): An abstract ...
266 ;; ** Error: adder.vhd(190): Unknown identifier: ctl_numb
267 ("ModelSim" "vcom" "-93 -work \\1" "make" "-f \\1"
268 nil
"vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "modelsim"
269 ("\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*:\\( *\[[0-9]+\]\\)? \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 3 4 nil
) ("" 0)
270 ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat"
271 "\\1/_primary.dat" "\\1/body.dat" downcase
))
272 ;; ProVHDL, Synopsys LEDA: provhdl -w work -f test.vhd
273 ;; test.vhd:34: error message
274 ("LEDA ProVHDL" "provhdl" "-w \\1 -f" "make" "-f \\1"
275 nil
"mkdir \\1" "./" "work/" "Makefile" "provhdl"
276 ("\\([^ \\t\\n]+\\):\\([0-9]+\\): " 1 2 nil
) ("" 0)
277 ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif"
278 "PACK/\\1.vif" "BODY/BODY-\\1.vif" upcase
))
280 ;; Error: VHDL error at dvi2sdi.vhd(473): object k2_alto_out_lvl is used
281 ;; Error: Verilog HDL syntax error at otsuif_v1_top.vhd(147) near text
282 ;; Error: VHDL syntax error at otsuif_v1_top.vhd(147): clk_ is an illegal
283 ;; Error: VHDL Use Clause error at otsuif_v1_top.vhd(455): design library
284 ;; Warning: VHDL Process Statement warning at dvi2sdi_tst.vhd(172): ...
285 ("Quartus" "make" "-work \\1" "make" "-f \\1"
286 nil
"mkdir \\1" "./" "work/" "Makefile" "quartus"
287 ("\\(Error\\|Warning\\): .* \\([^ \\t\\n]+\\)(\\([0-9]+\\))" 2 3 nil
) ("" 0)
289 ;; QuickHDL, Mentor Graphics: qvhcom test.vhd
290 ;; ERROR: test.vhd(24): near "dnd": expecting: END
291 ;; WARNING[4]: test.vhd(30): A space is required between ...
292 ("QuickHDL" "qvhcom" "-work \\1" "make" "-f \\1"
293 nil
"mkdir \\1" "./" "work/" "Makefile" "quickhdl"
294 ("\\(ERROR\\|WARNING\\)[^:]*: \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 2 3 nil
) ("" 0)
295 ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat"
296 "\\1/_primary.dat" "\\1/body.dat" downcase
))
297 ;; Savant: scram -publish-cc test.vhd
298 ;; test.vhd:87: _set_passed_through_out_port(IIR_Boolean) not defined for
299 ("Savant" "scram" "-publish-cc -design-library-name \\1" "make" "-f \\1"
300 nil
"mkdir \\1" "./" "work._savant_lib/" "Makefile" "savant"
301 ("\\([^ \\t\\n]+\\):\\([0-9]+\\): " 1 2 nil
) ("" 0)
302 ("\\1_entity.vhdl" "\\2_secondary_units._savant_lib/\\2_\\1.vhdl"
303 "\\1_config.vhdl" "\\1_package.vhdl"
304 "\\1_secondary_units._savant_lib/\\1_package_body.vhdl" downcase
))
305 ;; Simili: vhdlp -work test.vhd
306 ;; Error: CSVHDL0002: test.vhd: (line 97): Invalid prefix
307 ("Simili" "vhdlp" "-work \\1" "make" "-f \\1"
308 nil
"mkdir \\1" "./" "work/" "Makefile" "simili"
309 ("\\(Error\\|Warning\\): \\w+: \\([^ \\t\\n]+\\): (line \\([0-9]+\\)): " 2 3 nil
) ("" 0)
310 ("\\1/prim.var" "\\2/_\\1.var" "\\1/prim.var"
311 "\\1/prim.var" "\\1/_body.var" downcase
))
312 ;; Speedwave (Innoveda): analyze -libfile vsslib.ini -src test.vhd
313 ;; ERROR[11]::File test.vhd Line 100: Use of undeclared identifier
314 ("Speedwave" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
315 nil
"mkdir \\1" "./" "work/" "Makefile" "speedwave"
316 ("^ *ERROR\[[0-9]+\]::File \\([^ \\t\\n]+\\) Line \\([0-9]+\\):" 1 2 nil
) ("" 0)
318 ;; Synopsys, VHDL Analyzer (sim): vhdlan -nc test.vhd
319 ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context.
320 ("Synopsys" "vhdlan" "-nc -work \\1" "make" "-f \\1"
321 nil
"mkdir \\1" "./" "work/" "Makefile" "synopsys"
322 ("\\*\\*Error: vhdlan,[0-9]+ \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 1 2 nil
) ("" 0)
323 ("\\1.sim" "\\2__\\1.sim" "\\1.sim" "\\1.sim" "\\1__.sim" upcase
))
324 ;; Synopsys, VHDL Analyzer (syn): vhdlan -nc -spc test.vhd
325 ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context.
326 ("Synopsys Design Compiler" "vhdlan" "-nc -spc -work \\1" "make" "-f \\1"
327 nil
"mkdir \\1" "./" "work/" "Makefile" "synopsys_dc"
328 ("\\*\\*Error: vhdlan,[0-9]+ \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 1 2 nil
) ("" 0)
329 ("\\1.syn" "\\2__\\1.syn" "\\1.syn" "\\1.syn" "\\1__.syn" upcase
))
331 ;; @W:"test.vhd":57:8:57:9|Optimizing register bit count_x(5) to a constant 0
332 ("Synplify" "n/a" "n/a" "make" "-f \\1"
333 nil
"mkdir \\1" "./" "work/" "Makefile" "synplify"
334 ("@[EWN]:\"\\([^ \\t\\n]+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3) ("" 0)
336 ;; Vantage: analyze -libfile vsslib.ini -src test.vhd
337 ;; Compiling "test.vhd" line 1...
338 ;; **Error: LINE 49 *** No aggregate value is valid in this context.
339 ("Vantage" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
340 nil
"mkdir \\1" "./" "work/" "Makefile" "vantage"
341 ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil
1 nil
)
342 ("^ *Compiling \"\\(.+\\)\" " 1)
344 ;; VeriBest: vc vhdl test.vhd
345 ;; (no file name printed out!)
346 ;; 32: Z <= A and BitA ;
348 ;; [Error] Name BITA is unknown
349 ("VeriBest" "vc" "vhdl" "make" "-f \\1"
350 nil
"mkdir \\1" "./" "work/" "Makefile" "veribest"
351 ("^ +\\([0-9]+\\): +[^ ]" nil
1 nil
) ("" 0)
353 ;; Viewlogic: analyze -libfile vsslib.ini -src test.vhd
354 ;; Compiling "test.vhd" line 1...
355 ;; **Error: LINE 49 *** No aggregate value is valid in this context.
356 ("Viewlogic" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
357 nil
"mkdir \\1" "./" "work/" "Makefile" "viewlogic"
358 ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil
1 nil
)
359 ("^ *Compiling \"\\(.+\\)\" " 1)
362 ;; ERROR:HDLParsers:164 - "test.vhd" Line 3. parse error
363 ("Xilinx XST" "xflow" "" "make" "-f \\1"
364 nil
"mkdir \\1" "./" "work/" "Makefile" "xilinx"
365 ("^ERROR:HDLParsers:[0-9]+ - \"\\([^ \\t\\n]+\\)\" Line \\([0-9]+\\)\." 1 2 nil
) ("" 0)
368 "List of available VHDL compilers and their properties.
369 Each list entry specifies the following items for a compiler:
371 Compiler name : name used in option `vhdl-compiler' to choose compiler
372 Compile command : command used for source file compilation
373 Compile options : compile options (\"\\1\" inserts library name)
374 Make command : command used for compilation using a Makefile
375 Make options : make options (\"\\1\" inserts Makefile name)
376 Generate Makefile: use built-in function or command to generate a Makefile
377 \(\"\\1\" inserts Makefile name, \"\\2\" inserts library name)
378 Library command : command to create library directory \(\"\\1\" inserts
379 library directory, \"\\2\" inserts library name)
380 Compile directory: where compilation is run and the Makefile is placed
381 Library directory: directory of default library
382 Makefile name : name of Makefile (default is \"Makefile\")
383 ID string : compiler identification string (see `vhdl-project-alist')
385 Regexp : regular expression to match error messages (*)
386 File subexp index: index of subexpression that matches the file name
387 Line subexp index: index of subexpression that matches the line number
388 Column subexp idx: index of subexpression that matches the column number
390 Regexp : regular expression to match a file name message
391 File subexp index: index of subexpression that matches the file name
392 Unit-to-file name mapping: mapping of library unit names to names of files
393 generated by the compiler (used for Makefile generation)
394 To string : string a name is mapped to (\"\\1\" inserts the unit name,
395 \"\\2\" inserts the entity name for architectures,
396 \"\\3\" inserts the library name)
397 Case adjustment : adjust case of inserted unit names
399 \(*) The regular expression must match the error message starting from the
400 beginning of the line (but not necessarily to the end of the line).
402 Compile options allows insertion of the library name (see `vhdl-project-alist')
403 in order to set the compilers library option (e.g. \"vcom -work my_lib\").
405 For Makefile generation, the built-in function can be used (requires
406 specification of the unit-to-file name mapping). Alternatively, an
407 external command can be specified. Work directory allows specification of
408 an alternative \"work\" library path (e.g. \"WORK/\" instead of \"work/\",
409 used for Makefile generation). To use another library name than \"work\",
410 customize `vhdl-project-alist'. The library command is inserted in Makefiles
411 to automatically create the library directory if not existent.
413 Compile options, compile directory, library directory, and Makefile name are
414 overwritten by the project settings if a project is defined (see
415 `vhdl-project-alist'). Directory paths are relative to the source file
418 Some compilers do not include the file name in the error message, but print
419 out a file name message in advance. In this case, set \"File Subexp Index\"
420 under \"Error Message\" to 0 and fill out the \"File Message\" entries.
421 If no file name at all is printed out, set both \"File Message\" entries to 0
422 \(a default file name message will be printed out instead, does not work in
425 A compiler is selected for syntax analysis (`\\[vhdl-compile]') by
426 assigning its name to option `vhdl-compiler'.
428 Please send any missing or erroneous compiler properties to the maintainer for
431 NOTE: Activate new error and file message regexps and reflect the new setting
432 in the choice list of option `vhdl-compiler' by restarting Emacs."
434 (list :tag
"Compiler" :indent
2
435 (string :tag
"Compiler name ")
436 (string :tag
"Compile command ")
437 (string :tag
"Compile options " "-work \\1")
438 (string :tag
"Make command " "make")
439 (string :tag
"Make options " "-f \\1")
440 (choice :tag
"Generate Makefile "
441 (const :tag
"Built-in function" nil
)
442 (string :tag
"Command" "vmake \\2 > \\1"))
443 (string :tag
"Library command " "mkdir \\1")
444 (directory :tag
"Compile directory "
445 :validate vhdl-widget-directory-validate
"./")
446 (directory :tag
"Library directory "
447 :validate vhdl-widget-directory-validate
"work/")
448 (file :tag
"Makefile name " "Makefile")
449 (string :tag
"ID string ")
450 (list :tag
"Error message" :indent
4
451 (regexp :tag
"Regexp ")
452 (choice :tag
"File subexp "
453 (integer :tag
"Index")
454 (const :tag
"No file name" nil
))
455 (integer :tag
"Line subexp index")
456 (choice :tag
"Column subexp "
457 (integer :tag
"Index")
458 (const :tag
"No column number" nil
)))
459 (list :tag
"File message" :indent
4
460 (regexp :tag
"Regexp ")
461 (integer :tag
"File subexp index"))
462 (choice :tag
"Unit-to-file name mapping"
463 :format
"%t: %[Value Menu%] %v\n"
464 (const :tag
"Not defined" nil
)
465 (list :tag
"To string" :indent
4
466 (string :tag
"Entity " "\\1.vhd")
467 (string :tag
"Architecture " "\\2_\\1.vhd")
468 (string :tag
"Configuration " "\\1.vhd")
469 (string :tag
"Package " "\\1.vhd")
470 (string :tag
"Package Body " "\\1_body.vhd")
471 (choice :tag
"Case adjustment "
472 (const :tag
"None" identity
)
473 (const :tag
"Upcase" upcase
)
474 (const :tag
"Downcase" downcase
))))))
475 :set
(lambda (variable value
)
476 (vhdl-custom-set variable value
'vhdl-update-mode-menu
))
478 :group
'vhdl-compile
)
480 (defcustom vhdl-compiler
"GHDL"
481 "Specifies the VHDL compiler to be used for syntax analysis.
482 Select a compiler name from the ones defined in option `vhdl-compiler-alist'."
483 :type
(let ((alist vhdl-compiler-alist
) list
)
485 (push (list 'const
(caar alist
)) list
)
486 (setq alist
(cdr alist
)))
487 (append '(choice) (nreverse list
)))
488 :group
'vhdl-compile
)
490 (defcustom vhdl-compile-use-local-error-regexp t
491 "Non-nil means use buffer-local `compilation-error-regexp-alist'.
492 In this case, only error message regexps for VHDL compilers are active if
493 compilation is started from a VHDL buffer. Otherwise, the error message
494 regexps are appended to the predefined global regexps, and all regexps are
495 active all the time. Note that by doing that, the predefined global regexps
496 might result in erroneous parsing of error messages for some VHDL compilers.
498 NOTE: Activate the new setting by restarting Emacs."
500 :group
'vhdl-compile
)
502 (defcustom vhdl-makefile-default-targets
'("all" "clean" "library")
503 "List of default target names in Makefiles.
504 Automatically generated Makefiles include three default targets to compile
505 the entire design, clean the entire design and to create the design library.
506 This option allows to change the names of these targets to avoid conflicts
507 with other user Makefiles."
508 :type
'(list (string :tag
"Compile entire design")
509 (string :tag
"Clean entire design ")
510 (string :tag
"Create design library"))
512 :group
'vhdl-compile
)
514 (defcustom vhdl-makefile-generation-hook nil
515 "Functions to run at the end of Makefile generation.
516 Allows to insert user specific parts into a Makefile.
520 \(re-search-backward \"^# Rule for compiling entire design\")
521 \(insert \"# My target\\n\\n.MY_TARGET :\\n\\n\\n\"))"
523 :group
'vhdl-compile
)
525 (defcustom vhdl-default-library
"work"
526 "Name of default library.
527 Is overwritten by project settings if a project is active."
529 :group
'vhdl-compile
)
532 (defgroup vhdl-project nil
533 "Customizations for projects."
536 (defcustom vhdl-project-alist
537 '(("Example 1" "Source files in two directories, custom library name, VHDL'87"
538 "~/example1/" ("src/system/" "src/components/") ""
539 (("ModelSim" "-87 \\2" "-f \\1 top_level" nil
)
540 ("Synopsys" "-vhdl87 \\2" "-f \\1 top_level" ((".*/datapath/.*" .
"-optimize \\3") (".*_tb\\.vhd" . nil
))))
541 "lib/" "example3_lib" "lib/example3/" "Makefile_\\2" "")
542 ("Example 2" "Individual source files, multiple compilers in different directories"
543 "$EXAMPLE2/" ("vhdl/system.vhd" "vhdl/component_*.vhd") ""
544 nil
"\\1/" "work" "\\1/work/" "Makefile" "")
545 ("Example 3" "Source files in a directory tree, multiple compilers in same directory"
546 "/home/me/example3/" ("-r ./*/vhdl/") "/CVS/"
547 nil
"./" "work" "work-\\1/" "Makefile-\\1" "\
548 -------------------------------------------------------------------------------
549 -- This is a multi-line project description
550 -- that can be used as a project dependent part of the file header.
552 "List of projects and their properties.
553 Name : name used in option `vhdl-project' to choose project
554 Title : title of project (single-line string)
555 Default directory: default project directory (absolute path)
556 Sources : a) source files : path + \"/\" + file name
557 b) directory : path + \"/\"
558 c) directory tree: \"-r \" + path + \"/\"
559 Exclude regexp : matches file/directory names to be excluded as sources
560 Compile options : project-specific options for each compiler
561 Compiler name : name of compiler for which these options are valid
562 Compile options: project-specific compiler options
563 (\"\\1\" inserts library name, \"\\2\" default options)
564 Make options: project-specific make options
565 (\"\\1\" inserts Makefile name, \"\\2\" default options)
566 Exceptions : file-specific exceptions
567 File name regexp: matches file names for which exceptions are valid
568 - Options : file-specific compiler options string
569 (\"\\1\" inserts library name, \"\\2\" default options,
570 \"\\3\" project-specific options)
571 - Do not compile: do not compile this file (in Makefile)
572 Compile directory: where compilation is run and the Makefile is placed
573 \(\"\\1\" inserts compiler ID string)
574 Library name : name of library (default is \"work\")
575 Library directory: path to library (\"\\1\" inserts compiler ID string)
576 Makefile name : name of Makefile
577 (\"\\1\" inserts compiler ID string, \"\\2\" library name)
578 Description : description of project (multi-line string)
580 Project title and description are used to insert into the file header (see
581 option `vhdl-file-header').
583 The default directory must have an absolute path (use `M-TAB' for completion).
584 All other paths can be absolute or relative to the default directory. All
585 paths must end with '/'.
587 The design units found in the sources (files and directories) are shown in the
588 hierarchy browser. Path and file name can contain wildcards `*' and `?' as
589 well as \"./\" and \"../\" (\"sh\" syntax). Paths can also be absolute.
590 Environment variables (e.g. \"$EXAMPLE2\") are resolved. If no sources are
591 specified, the default directory is taken as source directory. Otherwise,
592 the default directory is only taken as source directory if there is a sources
593 entry with the empty string or \"./\". Exclude regexp allows to filter out
594 specific file and directory names from the list of sources (e.g. CVS
597 Files are compiled in the compile directory. Makefiles are also placed into
598 the compile directory. Library directory specifies which directory the
599 compiler compiles into (used to generate the Makefile).
601 Since different compile/library directories and Makefiles may exist for
602 different compilers within one project, these paths and names allow the
603 insertion of a compiler-dependent ID string (defined in `vhdl-compiler-alist').
604 Compile options, compile directory, library directory, and Makefile name
605 overwrite the settings of the current compiler.
607 File-specific compiler options (highest priority) overwrite project-specific
608 options which overwrite default options (lowest priority). Lower priority
609 options can be inserted in higher priority options. This allows to reuse
610 default options (e.g. \"-file\") in project- or file-specific options (e.g.
613 NOTE: Reflect the new setting in the choice list of option `vhdl-project'
614 by restarting Emacs."
616 (list :tag
"Project" :indent
2
617 (string :tag
"Name ")
618 (string :tag
"Title ")
619 (directory :tag
"Default directory"
620 :validate vhdl-widget-directory-validate
621 ,(abbreviate-file-name default-directory
))
622 (repeat :tag
"Sources " :indent
4
623 (directory :format
" %v" "./"))
624 (regexp :tag
"Exclude regexp ")
626 :tag
"Compile options " :indent
4
627 (list :tag
"Compiler" :indent
6
628 ,(let ((alist vhdl-compiler-alist
) list
)
630 (push (list 'const
(caar alist
)) list
)
631 (setq alist
(cdr alist
)))
632 (append '(choice :tag
"Compiler name")
634 (string :tag
"Compile options" "\\2")
635 (string :tag
"Make options " "\\2")
637 :tag
"Exceptions " :indent
8
639 (regexp :tag
"File name regexp ")
640 (choice :format
"%[Value Menu%] %v"
641 (string :tag
"Options" "\\3")
642 (const :tag
"Do not compile" nil
))))))
643 (directory :tag
"Compile directory"
644 :validate vhdl-widget-directory-validate
"./")
645 (string :tag
"Library name " "work")
646 (directory :tag
"Library directory"
647 :validate vhdl-widget-directory-validate
"work/")
648 (file :tag
"Makefile name " "Makefile")
649 (string :tag
"Description: (type `C-j' for newline)"
650 :format
"%t\n%v\n")))
651 :set
(lambda (variable value
)
652 (vhdl-custom-set variable value
653 'vhdl-update-mode-menu
654 'vhdl-speedbar-refresh
))
655 :group
'vhdl-project
)
657 (defcustom vhdl-project nil
658 "Specifies the default for the current project.
659 Select a project name from the ones defined in option `vhdl-project-alist'.
660 Is used to determine the project title and description to be inserted in file
661 headers and the source files/directories to be scanned in the hierarchy
662 browser. The current project can also be changed temporarily in the menu."
663 :type
(let ((alist vhdl-project-alist
) list
)
665 (push (list 'const
(caar alist
)) list
)
666 (setq alist
(cdr alist
)))
667 (append '(choice (const :tag
"None" nil
) (const :tag
"--"))
669 :group
'vhdl-project
)
671 (defcustom vhdl-project-file-name
'("\\1.prj")
672 "List of file names/paths for importing/exporting project setups.
673 \"\\1\" is replaced by the project name (SPC is replaced by `_'), \"\\2\" is
674 replaced by the user name (allows to have user-specific project setups).
675 The first entry is used as file name to import/export individual project
676 setups. All entries are used to automatically import project setups at
677 startup (see option `vhdl-project-auto-load'). Projects loaded from the
678 first entry are automatically made current. Hint: specify local project
679 setups in first entry, global setups in following entries; loading a local
680 project setup will make it current, while loading the global setups
681 is done without changing the current project.
682 Names can also have an absolute path (i.e. project setups can be stored
683 in global directories)."
684 :type
'(repeat (string :tag
"File name" "\\1.prj"))
685 :group
'vhdl-project
)
687 (defcustom vhdl-project-auto-load
'(startup)
688 "Automatically load project setups from files.
689 All project setup files that match the file names specified in option
690 `vhdl-project-file-name' are automatically loaded. The project of the
691 \(alphabetically) last loaded setup of the first `vhdl-project-file-name'
693 A project setup file can be obtained by exporting a project (see menu).
694 At startup: project setup file is loaded at Emacs startup"
695 :type
'(set (const :tag
"At startup" startup
))
696 :group
'vhdl-project
)
698 (defcustom vhdl-project-sort t
699 "Non-nil means projects are displayed in alphabetical order."
701 :group
'vhdl-project
)
704 (defgroup vhdl-style nil
705 "Customizations for coding styles."
707 :group
'vhdl-template
709 :group
'vhdl-compose
)
711 (defcustom vhdl-standard
'(93 nil
)
712 "VHDL standards used.
714 VHDL'87 : IEEE Std 1076-1987
715 VHDL'93/02 : IEEE Std 1076-1993/2002
716 Additional standards:
717 VHDL-AMS : IEEE Std 1076.1 (analog-mixed-signal)
718 Math packages: IEEE Std 1076.2 (`math_real', `math_complex')
720 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
721 \"Activate Options\"."
722 :type
'(list (choice :tag
"Basic standard"
723 (const :tag
"VHDL'87" 87)
724 (const :tag
"VHDL'93/02" 93))
725 (set :tag
"Additional standards" :indent
2
726 (const :tag
"VHDL-AMS" ams
)
727 (const :tag
"Math packages" math
)))
728 :set
(lambda (variable value
)
729 (vhdl-custom-set variable value
730 'vhdl-template-map-init
731 'vhdl-mode-abbrev-table-init
732 'vhdl-template-construct-alist-init
733 'vhdl-template-package-alist-init
734 'vhdl-update-mode-menu
735 'vhdl-words-init
'vhdl-font-lock-init
))
738 (defcustom vhdl-basic-offset
2
739 "Amount of basic offset used for indentation.
740 This value is used by + and - symbols in `vhdl-offsets-alist'."
744 (defcustom vhdl-upper-case-keywords nil
745 "Non-nil means convert keywords to upper case.
746 This is done when typed or expanded or by the fix case functions."
748 :set
(lambda (variable value
)
749 (vhdl-custom-set variable value
'vhdl-abbrev-list-init
))
752 (defcustom vhdl-upper-case-types nil
753 "Non-nil means convert standardized types to upper case.
754 This is done when expanded or by the fix case functions."
756 :set
(lambda (variable value
)
757 (vhdl-custom-set variable value
'vhdl-abbrev-list-init
))
760 (defcustom vhdl-upper-case-attributes nil
761 "Non-nil means convert standardized attributes to upper case.
762 This is done when expanded or by the fix case functions."
764 :set
(lambda (variable value
)
765 (vhdl-custom-set variable value
'vhdl-abbrev-list-init
))
768 (defcustom vhdl-upper-case-enum-values nil
769 "Non-nil means convert standardized enumeration values to upper case.
770 This is done when expanded or by the fix case functions."
772 :set
(lambda (variable value
)
773 (vhdl-custom-set variable value
'vhdl-abbrev-list-init
))
776 (defcustom vhdl-upper-case-constants t
777 "Non-nil means convert standardized constants to upper case.
778 This is done when expanded."
780 :set
(lambda (variable value
)
781 (vhdl-custom-set variable value
'vhdl-abbrev-list-init
))
784 (defcustom vhdl-use-direct-instantiation
'standard
785 "Non-nil means use VHDL'93 direct component instantiation.
787 Standard: only in VHDL standards that allow it (VHDL'93 and higher)
789 :type
'(choice (const :tag
"Never" never
)
790 (const :tag
"Standard" standard
)
791 (const :tag
"Always" always
))
794 (defcustom vhdl-array-index-record-field-in-sensitivity-list t
795 "Non-nil means include array indices / record fields in sensitivity list.
796 If a signal read in a process is a record field or pointed to by an array
797 index, the record field or array index is included with the record name in
798 the sensitivity list (e.g. \"in1(0)\", \"in2.f0\").
799 Otherwise, only the record name is included (e.g. \"in1\", \"in2\")."
804 (defgroup vhdl-naming nil
805 "Customizations for naming conventions."
808 (defcustom vhdl-entity-file-name
'(".*" .
"\\&")
810 "Specifies how the entity file name is obtained.
811 The entity file name can be obtained by modifying the entity name (e.g.
812 attaching or stripping off a substring). The file extension is automatically
813 taken from the file name of the current buffer."
814 vhdl-name-doc-string
)
815 :type
'(cons (regexp :tag
"From regexp")
816 (string :tag
"To string "))
818 :group
'vhdl-compose
)
820 (defcustom vhdl-architecture-file-name
'("\\(.*\\) \\(.*\\)" .
"\\1_\\2")
822 "Specifies how the architecture file name is obtained.
823 The architecture file name can be obtained by modifying the entity
824 and/or architecture name (e.g. attaching or stripping off a substring). The
825 file extension is automatically taken from the file name of the current
826 buffer. The string that is matched against the regexp is the concatenation
827 of the entity and the architecture name separated by a space. This gives
828 access to both names (see default setting as example)."
829 vhdl-name-doc-string
)
830 :type
'(cons (regexp :tag
"From regexp")
831 (string :tag
"To string "))
833 :group
'vhdl-compose
)
835 (defcustom vhdl-configuration-file-name
'(".*" .
"\\&")
837 "Specifies how the configuration file name is obtained.
838 The configuration file name can be obtained by modifying the configuration
839 name (e.g. attaching or stripping off a substring). The file extension is
840 automatically taken from the file name of the current buffer."
841 vhdl-name-doc-string
)
842 :type
'(cons (regexp :tag
"From regexp")
843 (string :tag
"To string "))
845 :group
'vhdl-compose
)
847 (defcustom vhdl-package-file-name
'(".*" .
"\\&")
849 "Specifies how the package file name is obtained.
850 The package file name can be obtained by modifying the package name (e.g.
851 attaching or stripping off a substring). The file extension is automatically
852 taken from the file name of the current buffer. Package files can be created
853 in a different directory by prepending a relative or absolute path to the
855 vhdl-name-doc-string
)
856 :type
'(cons (regexp :tag
"From regexp")
857 (string :tag
"To string "))
859 :group
'vhdl-compose
)
861 (defcustom vhdl-file-name-case
'identity
862 "Specifies how to change case for obtaining file names.
863 When deriving a file name from a VHDL unit name, case can be changed as
865 As Is: case is not changed (taken as is)
866 Lower Case: whole name is changed to lower case
867 Upper Case: whole name is changed to upper case
868 Capitalize: first letter of each word in name is capitalized"
869 :type
'(choice (const :tag
"As Is" identity
)
870 (const :tag
"Lower Case" downcase
)
871 (const :tag
"Upper Case" upcase
)
872 (const :tag
"Capitalize" capitalize
))
874 :group
'vhdl-compose
)
877 (defgroup vhdl-template nil
878 "Customizations for electrification."
881 (defcustom vhdl-electric-keywords
'(vhdl user
)
882 "Type of keywords for which electrification is enabled.
883 VHDL keywords: invoke built-in templates
884 User keywords: invoke user models (see option `vhdl-model-alist')"
885 :type
'(set (const :tag
"VHDL keywords" vhdl
)
886 (const :tag
"User model keywords" user
))
887 :set
(lambda (variable value
)
888 (vhdl-custom-set variable value
'vhdl-mode-abbrev-table-init
))
889 :group
'vhdl-template
)
891 (defcustom vhdl-optional-labels
'process
892 "Constructs for which labels are to be queried.
893 Template generators prompt for optional labels for:
895 Processes only: processes only (also procedurals in VHDL-AMS)
896 All constructs: all constructs with optional labels and keyword END"
897 :type
'(choice (const :tag
"None" none
)
898 (const :tag
"Processes only" process
)
899 (const :tag
"All constructs" all
))
900 :group
'vhdl-template
)
902 (defcustom vhdl-insert-empty-lines
'unit
903 "Specifies whether to insert empty lines in some templates.
904 This improves readability of code. Empty lines are inserted in:
906 Design units only: entities, architectures, configurations, packages only
907 All constructs : also all constructs with BEGIN...END parts
909 Replaces option `vhdl-additional-empty-lines'."
910 :type
'(choice (const :tag
"None" none
)
911 (const :tag
"Design units only" unit
)
912 (const :tag
"All constructs" all
))
913 :group
'vhdl-template
915 :group
'vhdl-compose
)
917 (defcustom vhdl-argument-list-indent nil
918 "Non-nil means indent argument lists relative to opening parenthesis.
919 That is, argument, association, and port lists start on the same line as the
920 opening parenthesis and subsequent lines are indented accordingly.
921 Otherwise, lists start on a new line and are indented as normal code."
923 :group
'vhdl-template
925 :group
'vhdl-compose
)
927 (defcustom vhdl-association-list-with-formals t
928 "Non-nil means write association lists with formal parameters.
929 Templates prompt for formal and actual parameters (ports/generics).
930 When pasting component instantiations, formals are included.
931 If nil, only a list of actual parameters is entered."
933 :group
'vhdl-template
935 :group
'vhdl-compose
)
937 (defcustom vhdl-conditions-in-parenthesis nil
938 "Non-nil means place parenthesis around condition expressions."
940 :group
'vhdl-template
)
942 (defcustom vhdl-zero-string
"'0'"
943 "String to use for a logic zero."
945 :group
'vhdl-template
)
947 (defcustom vhdl-one-string
"'1'"
948 "String to use for a logic one."
950 :group
'vhdl-template
)
953 (defgroup vhdl-header nil
954 "Customizations for file header."
955 :group
'vhdl-template
956 :group
'vhdl-compose
)
958 (defcustom vhdl-file-header
"\
959 -------------------------------------------------------------------------------
960 -- Title : <title string>
961 -- Project : <project>
962 -------------------------------------------------------------------------------
965 -- Company : <company>
967 -- Last update: <date>
968 -- Platform : <platform>
969 -- Standard : <standard>
970 <projectdesc>-------------------------------------------------------------------------------
971 -- Description: <cursor>
972 <copyright>-------------------------------------------------------------------------------
974 -- Date Version Author Description
975 -- <date> 1.0 <login>\tCreated
976 -------------------------------------------------------------------------------
979 "String or file to insert as file header.
980 If the string specifies an existing file name, the contents of the file is
981 inserted, otherwise the string itself is inserted as file header.
982 Type `C-j' for newlines.
983 If the header contains RCS keywords, they may be written as <RCS>Keyword<RCS>
984 if the header needs to be version controlled.
986 The following keywords for template generation are supported:
987 <filename> : replaced by the name of the buffer
988 <author> : replaced by the user name and email address
989 \(`user-full-name',`mail-host-address', `user-mail-address')
990 <authorfull> : replaced by the user full name (`user-full-name')
991 <login> : replaced by user login name (`user-login-name')
992 <company> : replaced by contents of option `vhdl-company-name'
993 <date> : replaced by the current date
994 <year> : replaced by the current year
995 <project> : replaced by title of current project (`vhdl-project')
996 <projectdesc> : replaced by description of current project (`vhdl-project')
997 <copyright> : replaced by copyright string (`vhdl-copyright-string')
998 <platform> : replaced by contents of option `vhdl-platform-spec'
999 <standard> : replaced by the VHDL language standard(s) used
1000 <... string> : replaced by a queried string (\"...\" is the prompt word)
1001 <title string>: replaced by file title in automatically generated files
1002 <cursor> : final cursor position
1004 The (multi-line) project description <projectdesc> can be used as a project
1005 dependent part of the file header and can also contain the above keywords."
1007 :group
'vhdl-header
)
1009 (defcustom vhdl-file-footer
""
1010 "String or file to insert as file footer.
1011 If the string specifies an existing file name, the contents of the file is
1012 inserted, otherwise the string itself is inserted as file footer (i.e. at
1013 the end of the file).
1014 Type `C-j' for newlines.
1015 The same keywords as in option `vhdl-file-header' can be used."
1017 :group
'vhdl-header
)
1019 (defcustom vhdl-company-name
""
1020 "Name of company to insert in file header.
1021 See option `vhdl-file-header'."
1023 :group
'vhdl-header
)
1025 (defcustom vhdl-copyright-string
"\
1026 -------------------------------------------------------------------------------
1027 -- Copyright (c) <year> <company>
1029 "Copyright string to insert in file header.
1030 Can be multi-line string (type `C-j' for newline) and contain other file
1031 header keywords (see option `vhdl-file-header')."
1033 :group
'vhdl-header
)
1035 (defcustom vhdl-platform-spec
""
1036 "Specification of VHDL platform to insert in file header.
1037 The platform specification should contain names and versions of the
1038 simulation and synthesis tools used.
1039 See option `vhdl-file-header'."
1041 :group
'vhdl-header
)
1043 (defcustom vhdl-date-format
"%Y-%m-%d"
1044 "Specifies the date format to use in the header.
1045 This string is passed as argument to the command `format-time-string'.
1046 For more information on format strings, see the documentation for the
1047 `format-time-string' command (C-h f `format-time-string')."
1049 :group
'vhdl-header
)
1051 (defcustom vhdl-modify-date-prefix-string
"-- Last update: "
1052 "Prefix string of modification date in VHDL file header.
1053 If actualization of the modification date is called (menu,
1054 `\\[vhdl-template-modify]'), this string is searched and the rest
1055 of the line replaced by the current date."
1057 :group
'vhdl-header
)
1059 (defcustom vhdl-modify-date-on-saving t
1060 "Non-nil means update the modification date when the buffer is saved.
1061 Calls function `\\[vhdl-template-modify]').
1063 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1064 \"Activate Options\"."
1066 :group
'vhdl-header
)
1069 (defgroup vhdl-sequential-process nil
1070 "Customizations for sequential processes."
1071 :group
'vhdl-template
)
1073 (defcustom vhdl-reset-kind
'async
1074 "Specifies which kind of reset to use in sequential processes."
1075 :type
'(choice (const :tag
"None" none
)
1076 (const :tag
"Synchronous" sync
)
1077 (const :tag
"Asynchronous" async
)
1078 (const :tag
"Query" query
))
1079 :group
'vhdl-sequential-process
)
1081 (defcustom vhdl-reset-active-high nil
1082 "Non-nil means reset in sequential processes is active high.
1083 Otherwise, reset is active low."
1085 :group
'vhdl-sequential-process
)
1087 (defcustom vhdl-clock-rising-edge t
1088 "Non-nil means rising edge of clock triggers sequential processes.
1089 Otherwise, falling edge triggers."
1091 :group
'vhdl-sequential-process
)
1093 (defcustom vhdl-clock-edge-condition
'standard
1094 "Syntax of the clock edge condition.
1095 Standard: \"clk'event and clk = '1'\"
1096 Function: \"rising_edge(clk)\""
1097 :type
'(choice (const :tag
"Standard" standard
)
1098 (const :tag
"Function" function
))
1099 :group
'vhdl-sequential-process
)
1101 (defcustom vhdl-clock-name
""
1102 "Name of clock signal to use in templates."
1104 :group
'vhdl-sequential-process
)
1106 (defcustom vhdl-reset-name
""
1107 "Name of reset signal to use in templates."
1109 :group
'vhdl-sequential-process
)
1112 (defgroup vhdl-model nil
1113 "Customizations for user models."
1116 (defcustom vhdl-model-alist
1118 "<label> : process (<clock>, <reset>)
1119 begin -- process <label>
1120 if <reset> = '0' then -- asynchronous reset (active low)
1122 elsif <clock>'event and <clock> = '1' then -- rising clock edge
1123 if <enable> = '1' then -- synchronous load
1127 end process <label>;"
1129 "List of user models.
1130 VHDL models (templates) can be specified by the user in this list. They can be
1131 invoked from the menu, through key bindings (`C-c C-m ...'), or by keyword
1132 electrification (i.e. overriding existing or creating new keywords, see
1133 option `vhdl-electric-keywords').
1134 Name : name of model (string of words and spaces)
1135 String : string or name of file to be inserted as model (newline: `C-j')
1136 Key Binding: key binding to invoke model, added to prefix `C-c C-m'
1137 (must be in double-quotes, examples: \"i\", \"\\C-p\", \"\\M-s\")
1138 Keyword : keyword to invoke model
1140 The models can contain prompts to be queried. A prompt is of the form \"<...>\".
1141 A prompt that appears several times is queried once and replaced throughout
1142 the model. Special prompts are:
1143 <clock> : name specified in `vhdl-clock-name' (if not empty)
1144 <reset> : name specified in `vhdl-reset-name' (if not empty)
1145 <cursor>: final cursor position
1146 File header prompts (see variable `vhdl-file-header') are automatically
1147 replaced, so that user models can also be used to insert different types of
1150 If the string specifies an existing file name, the contents of the file is
1151 inserted, otherwise the string itself is inserted.
1152 The code within the models should be correctly indented.
1153 Type `C-j' for newlines.
1155 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1156 \"Activate Options\"."
1157 :type
'(repeat (list :tag
"Model" :indent
2
1158 (string :tag
"Name ")
1159 (string :tag
"String : (type `C-j' for newline)"
1161 (sexp :tag
"Key binding" x
)
1162 (string :tag
"Keyword " :format
"%t: %v\n")))
1163 :set
(lambda (variable value
)
1164 (vhdl-custom-set variable value
1165 'vhdl-model-map-init
1167 'vhdl-mode-abbrev-table-init
1168 'vhdl-update-mode-menu
))
1172 (defgroup vhdl-compose nil
1173 "Customizations for structural composition."
1176 (defcustom vhdl-compose-architecture-name
'(".*" .
"str")
1178 "Specifies how the component architecture name is obtained.
1179 The component architecture name can be obtained by modifying the entity name
1180 \(e.g. attaching or stripping off a substring).
1181 If TO STRING is empty, the architecture name is queried."
1182 vhdl-name-doc-string
)
1183 :type
'(cons (regexp :tag
"From regexp")
1184 (string :tag
"To string "))
1185 :group
'vhdl-compose
)
1187 (defcustom vhdl-compose-configuration-name
1188 '("\\(.*\\) \\(.*\\)" .
"\\1_\\2_cfg")
1190 "Specifies how the configuration name is obtained.
1191 The configuration name can be obtained by modifying the entity and/or
1192 architecture name (e.g. attaching or stripping off a substring). The string
1193 that is matched against the regexp is the concatenation of the entity and the
1194 architecture name separated by a space. This gives access to both names (see
1195 default setting as example)."
1196 vhdl-name-doc-string
)
1197 :type
'(cons (regexp :tag
"From regexp")
1198 (string :tag
"To string "))
1199 :group
'vhdl-compose
)
1201 (defcustom vhdl-components-package-name
1202 '((".*" .
"\\&_components") .
"components")
1204 "Specifies how the name for the components package is obtained.
1205 The components package is a package containing all component declarations for
1206 the current design. Its name can be obtained by modifying the project name
1207 \(e.g. attaching or stripping off a substring). If no project is defined, the
1208 DIRECTORY entry is chosen."
1209 vhdl-name-doc-string
)
1210 :type
'(cons (cons :tag
"Project" :indent
2
1211 (regexp :tag
"From regexp")
1212 (string :tag
"To string "))
1213 (string :tag
"Directory:\n String "))
1214 :group
'vhdl-compose
)
1216 (defcustom vhdl-use-components-package nil
1217 "Non-nil means use a separate components package for component declarations.
1218 Otherwise, component declarations are inserted and searched for in the
1219 architecture declarative parts."
1221 :group
'vhdl-compose
)
1223 (defcustom vhdl-compose-include-header t
1224 "Non-nil means include a header in automatically generated files."
1226 :group
'vhdl-compose
)
1228 (defcustom vhdl-compose-create-files
'single
1229 "Specifies whether new files should be created for the new component.
1230 The component's entity and architecture are inserted:
1231 None : in current buffer
1232 Single file : in new single file
1233 Separate files: in two separate files
1234 The file names are obtained from variables `vhdl-entity-file-name' and
1235 `vhdl-architecture-file-name'."
1236 :type
'(choice (const :tag
"None" none
)
1237 (const :tag
"Single file" single
)
1238 (const :tag
"Separate files" separate
))
1239 :group
'vhdl-compose
)
1241 (defcustom vhdl-compose-configuration-create-file nil
1242 "Specifies whether a new file should be created for the configuration.
1243 If non-nil, a new file is created for the configuration.
1244 The file name is obtained from variable `vhdl-configuration-file-name'."
1246 :group
'vhdl-compose
)
1248 (defcustom vhdl-compose-configuration-hierarchical t
1249 "Specifies whether hierarchical configurations should be created.
1250 If non-nil, automatically created configurations are hierarchical and include
1251 the whole hierarchy of subcomponents. Otherwise the configuration only
1252 includes one level of subcomponents."
1254 :group
'vhdl-compose
)
1256 (defcustom vhdl-compose-configuration-use-subconfiguration t
1257 "Specifies whether subconfigurations should be used inside configurations.
1258 If non-nil, automatically created configurations use configurations in binding
1259 indications for subcomponents, if such configurations exist. Otherwise,
1260 entities are used in binding indications for subcomponents."
1262 :group
'vhdl-compose
)
1265 (defgroup vhdl-port nil
1266 "Customizations for port translation functions."
1268 :group
'vhdl-compose
)
1270 (defcustom vhdl-include-port-comments nil
1271 "Non-nil means include port comments when a port is pasted."
1275 (defcustom vhdl-include-direction-comments nil
1276 "Non-nil means include port direction in instantiations as comments."
1280 (defcustom vhdl-include-type-comments nil
1281 "Non-nil means include generic/port type in instantiations as comments."
1285 (defcustom vhdl-include-group-comments
'never
1286 "Specifies whether to include group comments and spacings.
1287 The comments and empty lines between groups of ports are pasted:
1289 Declarations: in entity/component/constant/signal declarations only
1290 Always : also in generic/port maps"
1291 :type
'(choice (const :tag
"Never" never
)
1292 (const :tag
"Declarations" decl
)
1293 (const :tag
"Always" always
))
1296 (defcustom vhdl-actual-generic-name
'(".*" .
"\\&")
1298 "Specifies how actual generic names are obtained from formal generic names.
1299 In a component instantiation, an actual generic name can be
1300 obtained by modifying the formal generic name (e.g. attaching or stripping
1302 vhdl-name-doc-string
)
1303 :type
'(cons (regexp :tag
"From regexp")
1304 (string :tag
"To string "))
1308 (defcustom vhdl-actual-port-name
'(".*" .
"\\&")
1310 "Specifies how actual port names are obtained from formal port names.
1311 In a component instantiation, an actual port name can be obtained by
1312 modifying the formal port name (e.g. attaching or stripping off a substring)."
1313 vhdl-name-doc-string
)
1314 :type
'(cons (regexp :tag
"From regexp")
1315 (string :tag
"To string "))
1318 (defcustom vhdl-instance-name
'(".*" .
"\\&_%d")
1320 "Specifies how an instance name is obtained.
1321 The instance name can be obtained by modifying the name of the component to be
1322 instantiated (e.g. attaching or stripping off a substring). \"%d\" is replaced
1323 by a unique number (starting with 1).
1324 If TO STRING is empty, the instance name is queried."
1325 vhdl-name-doc-string
)
1326 :type
'(cons (regexp :tag
"From regexp")
1327 (string :tag
"To string "))
1331 (defgroup vhdl-testbench nil
1332 "Customizations for testbench generation."
1335 (defcustom vhdl-testbench-entity-name
'(".*" .
"\\&_tb")
1337 "Specifies how the testbench entity name is obtained.
1338 The entity name of a testbench can be obtained by modifying the name of
1339 the component to be tested (e.g. attaching or stripping off a substring)."
1340 vhdl-name-doc-string
)
1341 :type
'(cons (regexp :tag
"From regexp")
1342 (string :tag
"To string "))
1343 :group
'vhdl-testbench
)
1345 (defcustom vhdl-testbench-architecture-name
'(".*" .
"")
1347 "Specifies how the testbench architecture name is obtained.
1348 The testbench architecture name can be obtained by modifying the name of
1349 the component to be tested (e.g. attaching or stripping off a substring).
1350 If TO STRING is empty, the architecture name is queried."
1351 vhdl-name-doc-string
)
1352 :type
'(cons (regexp :tag
"From regexp")
1353 (string :tag
"To string "))
1354 :group
'vhdl-testbench
)
1356 (defcustom vhdl-testbench-configuration-name vhdl-compose-configuration-name
1358 "Specifies how the testbench configuration name is obtained.
1359 The configuration name of a testbench can be obtained by modifying the entity
1360 and/or architecture name (e.g. attaching or stripping off a substring). The
1361 string that is matched against the regexp is the concatenation of the entity
1362 and the architecture name separated by a space. This gives access to both
1363 names (see default setting as example)."
1364 vhdl-name-doc-string
)
1365 :type
'(cons (regexp :tag
"From regexp")
1366 (string :tag
"To string "))
1367 :group
'vhdl-testbench
)
1369 (defcustom vhdl-testbench-dut-name
'(".*" .
"DUT")
1371 "Specifies how a DUT instance name is obtained.
1372 The design-under-test instance name (i.e. the component instantiated in the
1373 testbench) can be obtained by modifying the component name (e.g. attaching
1374 or stripping off a substring)."
1375 vhdl-name-doc-string
)
1376 :type
'(cons (regexp :tag
"From regexp")
1377 (string :tag
"To string "))
1378 :group
'vhdl-testbench
)
1380 (defcustom vhdl-testbench-include-header t
1381 "Non-nil means include a header in automatically generated files."
1383 :group
'vhdl-testbench
)
1385 (defcustom vhdl-testbench-declarations
"\
1387 signal Clk : std_logic := '1';
1389 "String or file to be inserted in the testbench declarative part.
1390 If the string specifies an existing file name, the contents of the file is
1391 inserted, otherwise the string itself is inserted in the testbench
1392 architecture before the BEGIN keyword.
1393 Type `C-j' for newlines."
1395 :group
'vhdl-testbench
)
1397 (defcustom vhdl-testbench-statements
"\
1399 Clk <= not Clk after 10 ns;
1401 -- waveform generation
1402 WaveGen_Proc: process
1404 -- insert signal assignments here
1406 wait until Clk = '1';
1407 end process WaveGen_Proc;
1409 "String or file to be inserted in the testbench statement part.
1410 If the string specifies an existing file name, the contents of the file is
1411 inserted, otherwise the string itself is inserted in the testbench
1412 architecture before the END keyword.
1413 Type `C-j' for newlines."
1415 :group
'vhdl-testbench
)
1417 (defcustom vhdl-testbench-initialize-signals nil
1418 "Non-nil means initialize signals with `0' when declared in testbench."
1420 :group
'vhdl-testbench
)
1422 (defcustom vhdl-testbench-include-library t
1423 "Non-nil means a library/use clause for std_logic_1164 is included."
1425 :group
'vhdl-testbench
)
1427 (defcustom vhdl-testbench-include-configuration t
1428 "Non-nil means a testbench configuration is attached at the end."
1430 :group
'vhdl-testbench
)
1432 (defcustom vhdl-testbench-create-files
'single
1433 "Specifies whether new files should be created for the testbench.
1434 testbench entity and architecture are inserted:
1435 None : in current buffer
1436 Single file : in new single file
1437 Separate files: in two separate files
1438 The file names are obtained from variables `vhdl-testbench-entity-file-name'
1439 and `vhdl-testbench-architecture-file-name'."
1440 :type
'(choice (const :tag
"None" none
)
1441 (const :tag
"Single file" single
)
1442 (const :tag
"Separate files" separate
))
1443 :group
'vhdl-testbench
)
1445 (defcustom vhdl-testbench-entity-file-name vhdl-entity-file-name
1447 "Specifies how the testbench entity file name is obtained.
1448 The entity file name can be obtained by modifying the testbench entity name
1449 \(e.g. attaching or stripping off a substring). The file extension is
1450 automatically taken from the file name of the current buffer. Testbench
1451 files can be created in a different directory by prepending a relative or
1452 absolute path to the file name."
1453 vhdl-name-doc-string
)
1454 :type
'(cons (regexp :tag
"From regexp")
1455 (string :tag
"To string "))
1456 :group
'vhdl-testbench
)
1458 (defcustom vhdl-testbench-architecture-file-name vhdl-architecture-file-name
1460 "Specifies how the testbench architecture file name is obtained.
1461 The architecture file name can be obtained by modifying the testbench entity
1462 and/or architecture name (e.g. attaching or stripping off a substring). The
1463 string that is matched against the regexp is the concatenation of the entity
1464 and the architecture name separated by a space. This gives access to both
1465 names (see default setting as example). Testbench files can be created in
1466 a different directory by prepending a relative or absolute path to the file
1468 vhdl-name-doc-string
)
1469 :type
'(cons (regexp :tag
"From regexp")
1470 (string :tag
"To string "))
1471 :group
'vhdl-testbench
)
1474 (defgroup vhdl-comment nil
1475 "Customizations for comments."
1478 (defcustom vhdl-self-insert-comments t
1479 "Non-nil means various templates automatically insert help comments."
1481 :group
'vhdl-comment
)
1483 (defcustom vhdl-prompt-for-comments t
1484 "Non-nil means various templates prompt for user definable comments."
1486 :group
'vhdl-comment
)
1488 (defcustom vhdl-inline-comment-column
40
1489 "Column to indent and align inline comments to.
1490 Overrides local option `comment-column'.
1492 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1493 \"Activate Options\"."
1495 :group
'vhdl-comment
)
1497 (defcustom vhdl-end-comment-column
79
1498 "End of comment column.
1499 Comments that exceed this column number are wrapped.
1501 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1502 \"Activate Options\"."
1504 :group
'vhdl-comment
)
1506 (defvar end-comment-column
)
1509 (defgroup vhdl-beautify nil
1510 "Customizations for beautification."
1513 (defcustom vhdl-auto-align t
1514 "Non-nil means align some templates automatically after generation."
1516 :group
'vhdl-beautify
)
1518 (defcustom vhdl-align-groups t
1519 "Non-nil means align groups of code lines separately.
1520 A group of code lines is a region of consecutive lines between two lines that
1521 match the regexp in option `vhdl-align-group-separate'."
1523 :group
'vhdl-beautify
)
1525 (defcustom vhdl-align-group-separate
"^\\s-*$"
1526 "Regexp for matching a line that separates groups of lines for alignment.
1528 \"^\\s-*$\": matches an empty line
1529 \"^\\s-*\\(--.*\\)?$\": matches an empty line or a comment-only line"
1531 :group
'vhdl-beautify
)
1533 (defcustom vhdl-align-same-indent t
1534 "Non-nil means align blocks with same indent separately.
1535 When a region or the entire buffer is aligned, the code is divided into
1536 blocks of same indent which are aligned separately (except for argument/port
1537 lists). This gives nicer alignment in most cases.
1538 Option `vhdl-align-groups' still applies within these blocks."
1540 :group
'vhdl-beautify
)
1542 (defcustom vhdl-beautify-options
'(t t t t t
)
1543 "List of options for beautifying code. Allows to disable individual
1544 features of code beautification."
1545 :type
'(list (boolean :tag
"Whitespace cleanup ")
1546 (boolean :tag
"Single statement per line")
1547 (boolean :tag
"Indentation ")
1548 (boolean :tag
"Alignment ")
1549 (boolean :tag
"Case fixing "))
1550 :group
'vhdl-beautify
1554 (defgroup vhdl-highlight nil
1555 "Customizations for highlighting."
1558 (defcustom vhdl-highlight-keywords t
1559 "Non-nil means highlight VHDL keywords and other standardized words.
1560 The following faces are used:
1561 `font-lock-keyword-face' : keywords
1562 `font-lock-type-face' : standardized types
1563 `vhdl-font-lock-attribute-face': standardized attributes
1564 `vhdl-font-lock-enumvalue-face': standardized enumeration values
1565 `vhdl-font-lock-function-face' : standardized function and package names
1567 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1568 entry \"Fontify Buffer\")."
1570 :set
(lambda (variable value
)
1571 (vhdl-custom-set variable value
'vhdl-font-lock-init
))
1572 :group
'vhdl-highlight
)
1574 (defcustom vhdl-highlight-names t
1575 "Non-nil means highlight declaration names and construct labels.
1576 The following faces are used:
1577 `font-lock-function-name-face' : names in declarations of units,
1578 subprograms, components, as well as labels of VHDL constructs
1579 `font-lock-type-face' : names in type/nature declarations
1580 `vhdl-font-lock-attribute-face': names in attribute declarations
1581 `font-lock-variable-name-face' : names in declarations of signals,
1582 variables, constants, subprogram parameters, generics, and ports
1584 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1585 entry \"Fontify Buffer\")."
1587 :set
(lambda (variable value
)
1588 (vhdl-custom-set variable value
'vhdl-font-lock-init
))
1589 :group
'vhdl-highlight
)
1591 (defcustom vhdl-highlight-special-words nil
1592 "Non-nil means highlight words with special syntax.
1593 The words with syntax and color specified in option `vhdl-special-syntax-alist'
1594 are highlighted accordingly.
1595 Can be used for visual support of naming conventions.
1597 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1598 entry \"Fontify Buffer\")."
1600 :set
(lambda (variable value
)
1601 (vhdl-custom-set variable value
'vhdl-font-lock-init
))
1602 :group
'vhdl-highlight
)
1604 (defcustom vhdl-highlight-forbidden-words nil
1605 "Non-nil means highlight forbidden words.
1606 The reserved words specified in option `vhdl-forbidden-words' or having the
1607 syntax specified in option `vhdl-forbidden-syntax' are highlighted in a
1608 warning color (face `vhdl-font-lock-reserved-words-face') to indicate not to
1611 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1612 entry \"Fontify Buffer\")."
1614 :set
(lambda (variable value
)
1615 (vhdl-custom-set variable value
1616 'vhdl-words-init
'vhdl-font-lock-init
))
1617 :group
'vhdl-highlight
)
1619 (defcustom vhdl-highlight-verilog-keywords nil
1620 "Non-nil means highlight Verilog keywords as reserved words.
1621 Verilog keywords are highlighted in a warning color (face
1622 `vhdl-font-lock-reserved-words-face') to indicate not to use them.
1624 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1625 entry \"Fontify Buffer\")."
1627 :set
(lambda (variable value
)
1628 (vhdl-custom-set variable value
1629 'vhdl-words-init
'vhdl-font-lock-init
))
1630 :group
'vhdl-highlight
)
1632 (defcustom vhdl-highlight-translate-off nil
1633 "Non-nil means background-highlight code excluded from translation.
1634 That is, all code between \"-- pragma translate_off\" and
1635 \"-- pragma translate_on\" is highlighted using a different background color
1636 \(face `vhdl-font-lock-translate-off-face').
1637 Note: this might slow down on-the-fly fontification (and thus editing).
1639 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1640 entry \"Fontify Buffer\")."
1642 :set
(lambda (variable value
)
1643 (vhdl-custom-set variable value
'vhdl-font-lock-init
))
1644 :group
'vhdl-highlight
)
1646 (defcustom vhdl-highlight-case-sensitive nil
1647 "Non-nil means consider case for highlighting.
1649 non-nil also upper-case VHDL words are highlighted, but case of words with
1650 special syntax is not considered
1651 nil only lower-case VHDL words are highlighted, but case of words with
1652 special syntax is considered
1653 Overrides local option `font-lock-keywords-case-fold-search'.
1655 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1656 entry \"Fontify Buffer\")."
1658 :group
'vhdl-highlight
)
1660 (defcustom vhdl-special-syntax-alist
1661 '(("generic/constant" "\\<\\w+_[cg]\\>" "Gold3" "BurlyWood1" nil
)
1662 ("type" "\\<\\w+_t\\>" "ForestGreen" "PaleGreen" nil
)
1663 ("variable" "\\<\\w+_v\\>" "Grey50" "Grey80" nil
))
1664 "List of special syntax to be highlighted.
1665 If option `vhdl-highlight-special-words' is non-nil, words with the specified
1666 syntax (as regular expression) are highlighted in the corresponding color.
1668 Name : string of words and spaces
1669 Regexp : regular expression describing word syntax
1670 (e.g. \"\\\\=\<\\\w+_c\\\\=\>\" matches word with suffix \"_c\")
1671 expression must start with \"\\\\=\<\" and end with \"\\\\=\>\"
1672 if only whole words should be matched (no substrings)
1673 Color (light): foreground color for light background
1674 (matching color examples: Gold3, Grey50, LimeGreen, Tomato,
1675 LightSeaGreen, DodgerBlue, Gold, PaleVioletRed)
1676 Color (dark) : foreground color for dark background
1677 (matching color examples: BurlyWood1, Grey80, Green, Coral,
1678 AquaMarine2, LightSkyBlue1, Yellow, PaleVioletRed1)
1679 In comments : If non-nil, words are also highlighted inside comments
1681 Can be used for visual support of naming conventions, such as highlighting
1682 different kinds of signals (e.g. \"Clk50\", \"Rst_n\") or objects (e.g.
1683 \"Signal_s\", \"Variable_v\", \"Constant_c\") by distinguishing them using
1684 common substrings or name suffices.
1685 For each entry, a new face is generated with the specified colors and name
1686 \"vhdl-font-lock-\" + name + \"-face\".
1688 NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu
1689 entry \"Fontify Buffer\"). All other changes require restarting Emacs."
1690 :type
'(repeat (list :tag
"Face" :indent
2
1691 (string :tag
"Name ")
1692 (regexp :tag
"Regexp " "\\w+_")
1693 (string :tag
"Color (light)")
1694 (string :tag
"Color (dark) ")
1695 (boolean :tag
"In comments ")))
1696 :set
(lambda (variable value
)
1697 (vhdl-custom-set variable value
'vhdl-font-lock-init
))
1698 :group
'vhdl-highlight
)
1700 (defcustom vhdl-forbidden-words
'()
1701 "List of forbidden words to be highlighted.
1702 If option `vhdl-highlight-forbidden-words' is non-nil, these reserved
1703 words are highlighted in a warning color to indicate not to use them.
1705 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1706 entry \"Fontify Buffer\")."
1707 :type
'(repeat (string :format
"%v"))
1708 :set
(lambda (variable value
)
1709 (vhdl-custom-set variable value
1710 'vhdl-words-init
'vhdl-font-lock-init
))
1711 :group
'vhdl-highlight
)
1713 (defcustom vhdl-forbidden-syntax
""
1714 "Syntax of forbidden words to be highlighted.
1715 If option `vhdl-highlight-forbidden-words' is non-nil, words with this
1716 syntax are highlighted in a warning color to indicate not to use them.
1717 Can be used to highlight too long identifiers (e.g. \"\\w\\w\\w\\w\\w\\w\\w\\w\\w\\w+\"
1718 highlights identifiers with 10 or more characters).
1720 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1721 entry \"Fontify Buffer\")."
1723 :set
(lambda (variable value
)
1724 (vhdl-custom-set variable value
1725 'vhdl-words-init
'vhdl-font-lock-init
))
1726 :group
'vhdl-highlight
)
1728 (defcustom vhdl-directive-keywords
'("pragma" "synopsys")
1729 "List of compiler directive keywords recognized for highlighting.
1731 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1732 entry \"Fontify Buffer\")."
1733 :type
'(repeat (string :format
"%v"))
1734 :set
(lambda (variable value
)
1735 (vhdl-custom-set variable value
1736 'vhdl-words-init
'vhdl-font-lock-init
))
1737 :group
'vhdl-highlight
)
1740 (defgroup vhdl-speedbar nil
1741 "Customizations for speedbar."
1744 (defcustom vhdl-speedbar-auto-open nil
1745 "Non-nil means automatically open speedbar at startup.
1746 Alternatively, the speedbar can be opened from the VHDL menu."
1748 :group
'vhdl-speedbar
)
1750 (defcustom vhdl-speedbar-display-mode
'files
1751 "Specifies the default displaying mode when opening speedbar.
1752 Alternatively, the displaying mode can be selected from the speedbar menu or
1753 by typing `f' (files), `h' (directory hierarchy) or `H' (project hierarchy)."
1754 :type
'(choice (const :tag
"Files" files
)
1755 (const :tag
"Directory hierarchy" directory
)
1756 (const :tag
"Project hierarchy" project
))
1757 :group
'vhdl-speedbar
)
1759 (defcustom vhdl-speedbar-scan-limit
'(10000000 (1000000 50))
1760 "Limits scanning of large files and netlists.
1761 Design units: maximum file size to scan for design units
1762 Hierarchy (instances of subcomponents):
1763 File size: maximum file size to scan for instances (in bytes)
1764 Instances per arch: maximum number of instances to scan per architecture
1766 \"None\" always means that there is no limit.
1767 In case of files not or incompletely scanned, a warning message and the file
1768 names are printed out.
1769 Background: scanning for instances is considerably slower than scanning for
1770 design units, especially when there are many instances. These limits should
1771 prevent the scanning of large netlists."
1772 :type
'(list (choice :tag
"Design units"
1773 :format
"%t : %[Value Menu%] %v"
1774 (const :tag
"None" nil
)
1775 (integer :tag
"File size"))
1776 (list :tag
"Hierarchy" :indent
2
1777 (choice :tag
"File size"
1778 :format
"%t : %[Value Menu%] %v"
1779 (const :tag
"None" nil
)
1780 (integer :tag
"Size "))
1781 (choice :tag
"Instances per arch"
1782 (const :tag
"None" nil
)
1783 (integer :tag
"Number "))))
1784 :group
'vhdl-speedbar
)
1786 (defcustom vhdl-speedbar-jump-to-unit t
1787 "Non-nil means jump to the design unit code when opened in a buffer.
1788 The buffer cursor position is left unchanged otherwise."
1790 :group
'vhdl-speedbar
)
1792 (defcustom vhdl-speedbar-update-on-saving t
1793 "Automatically update design hierarchy when buffer is saved."
1795 :group
'vhdl-speedbar
)
1797 (defcustom vhdl-speedbar-save-cache
'(hierarchy display
)
1798 "Automatically save modified hierarchy caches when exiting Emacs.
1799 Hierarchy: design hierarchy information
1800 Display: displaying information (which design units to expand)"
1801 :type
'(set (const :tag
"Hierarchy" hierarchy
)
1802 (const :tag
"Display" display
))
1803 :group
'vhdl-speedbar
)
1805 (defcustom vhdl-speedbar-cache-file-name
".emacs-vhdl-cache-\\1-\\2"
1806 "Name of file for saving hierarchy cache.
1807 \"\\1\" is replaced by the project name if a project is specified,
1808 \"directory\" otherwise. \"\\2\" is replaced by the user name (allows for
1809 different users to have cache files in the same directory). Can also have
1810 an absolute path (i.e. all caches can be stored in one global directory)."
1812 :group
'vhdl-speedbar
)
1815 (defgroup vhdl-menu nil
1816 "Customizations for menus."
1819 (defcustom vhdl-index-menu nil
1820 "Non-nil means add an index menu for a source file when loading.
1821 Alternatively, the speedbar can be used. Note that the index menu scans a file
1822 when it is opened, while speedbar only scans the file upon request."
1826 (defcustom vhdl-source-file-menu nil
1827 "Non-nil means add a menu of all source files in current directory.
1828 Alternatively, the speedbar can be used."
1832 (defcustom vhdl-hideshow-menu nil
1833 "Non-nil means add hideshow menu and functionality at startup.
1834 Hideshow can also be enabled from the VHDL Mode menu.
1835 Hideshow allows hiding code of various VHDL constructs.
1837 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1838 \"Activate Options\"."
1842 (defcustom vhdl-hide-all-init nil
1843 "Non-nil means hide all design units initially after a file is loaded."
1848 (defgroup vhdl-print nil
1849 "Customizations for printing."
1852 (defcustom vhdl-print-two-column t
1853 "Non-nil means print code in two columns and landscape format.
1854 Adjusts settings in a way that PostScript printing (\"File\" menu, `ps-print')
1855 prints VHDL files in a nice two-column landscape style.
1857 NOTE: Activate the new setting by restarting Emacs.
1858 Overrides `ps-print' settings locally."
1862 (defcustom vhdl-print-customize-faces t
1863 "Non-nil means use an optimized set of faces for PostScript printing.
1865 NOTE: Activate the new setting by restarting Emacs.
1866 Overrides `ps-print' settings locally."
1871 (defgroup vhdl-misc nil
1872 "Miscellaneous customizations."
1875 (defcustom vhdl-intelligent-tab t
1876 "Non-nil means `TAB' does indentation, word completion and tab insertion.
1877 That is, if preceding character is part of a word then complete word,
1878 else if not at beginning of line then insert tab,
1879 else if last command was a `TAB' or `RET' then dedent one step,
1880 else indent current line (i.e. `TAB' is bound to `vhdl-electric-tab').
1881 If nil, TAB always indents current line (i.e. `TAB' is bound to
1882 `indent-according-to-mode').
1884 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1885 \"Activate Options\"."
1889 (defcustom vhdl-indent-syntax-based t
1890 "Non-nil means indent lines of code based on their syntactic context.
1891 Otherwise, a line is indented like the previous nonblank line. This can be
1892 useful in large files where syntax-based indentation gets very slow."
1896 (defcustom vhdl-indent-comment-like-next-code-line t
1897 "Non-nil means comment lines are indented like the following code line.
1898 Otherwise, comment lines are indented like the preceding code line.
1899 Indenting comment lines like the following code line gives nicer indentation
1900 when comments precede the code that they refer to."
1905 (defcustom vhdl-word-completion-case-sensitive nil
1906 "Non-nil means word completion using `TAB' is case sensitive.
1907 That is, `TAB' completes words that start with the same letters and case.
1908 Otherwise, case is ignored."
1912 (defcustom vhdl-word-completion-in-minibuffer t
1913 "Non-nil enables word completion in minibuffer (for template prompts).
1915 NOTE: Activate the new setting by restarting Emacs."
1919 (defcustom vhdl-underscore-is-part-of-word nil
1920 "Non-nil means consider the underscore character `_' as part of word.
1921 An identifier containing underscores is then treated as a single word in
1922 select and move operations. All parts of an identifier separated by underscore
1923 are treated as single words otherwise."
1926 (make-obsolete-variable 'vhdl-underscore-is-part-of-word
1927 'superword-mode
"24.4")
1930 (defgroup vhdl-related nil
1931 "Related general customizations."
1934 ;; add related general customizations
1935 (custom-add-to-group 'vhdl-related
'hideshow
'custom-group
)
1936 (if (featurep 'xemacs
)
1937 (custom-add-to-group 'vhdl-related
'paren-mode
'custom-variable
)
1938 (custom-add-to-group 'vhdl-related
'paren-showing
'custom-group
))
1939 (custom-add-to-group 'vhdl-related
'ps-print
'custom-group
)
1940 (custom-add-to-group 'vhdl-related
'speedbar
'custom-group
)
1941 (custom-add-to-group 'vhdl-related
'comment-style
'custom-variable
)
1942 (custom-add-to-group 'vhdl-related
'line-number-mode
'custom-variable
)
1943 (unless (featurep 'xemacs
)
1944 (custom-add-to-group 'vhdl-related
'transient-mark-mode
'custom-variable
))
1945 (custom-add-to-group 'vhdl-related
'user-full-name
'custom-variable
)
1946 (custom-add-to-group 'vhdl-related
'mail-host-address
'custom-variable
)
1947 (custom-add-to-group 'vhdl-related
'user-mail-address
'custom-variable
)
1949 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1950 ;; Hidden user variables
1952 (defvar vhdl-compile-absolute-path nil
1953 "If non-nil, use absolute instead of relative path for compiled files.")
1955 (defvar vhdl-comment-display-line-char ?-
1956 "Character to use in comment display line.")
1958 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1959 ;; Internal variables
1961 (defvar vhdl-menu-max-size
20
1962 "Specifies the maximum size of a menu before splitting it into submenus.")
1964 (defvar vhdl-progress-interval
1
1965 "Interval used to update progress status during long operations.
1966 If a number, percentage complete gets updated after each interval of
1967 that many seconds. To inhibit all messages, set this option to nil.")
1969 (defvar vhdl-inhibit-startup-warnings-p nil
1970 "If non-nil, inhibits start up compatibility warnings.")
1972 (defvar vhdl-strict-syntax-p nil
1973 "If non-nil, all syntactic symbols must be found in `vhdl-offsets-alist'.
1974 If the syntactic symbol for a particular line does not match a symbol
1975 in the offsets alist, an error is generated, otherwise no error is
1976 reported and the syntactic symbol is ignored.")
1978 (defvar vhdl-echo-syntactic-information-p nil
1979 "If non-nil, syntactic info is echoed when the line is indented.")
1981 (defconst vhdl-offsets-alist-default
1987 (statement-cont . vhdl-lineup-statement-cont
)
1988 (statement-block-intro .
+)
1989 (statement-case-intro .
+)
1990 (case-alternative .
+)
1991 (comment . vhdl-lineup-comment
)
1994 (arglist-cont-nonempty . vhdl-lineup-arglist
)
1995 (arglist-close . vhdl-lineup-arglist
)
2002 "Default settings for offsets of syntactic elements.
2003 Do not change this constant! See the variable `vhdl-offsets-alist' for
2006 (defvar vhdl-offsets-alist
(copy-alist vhdl-offsets-alist-default
)
2007 "Association list of syntactic element symbols and indentation offsets.
2008 As described below, each cons cell in this list has the form:
2010 (SYNTACTIC-SYMBOL . OFFSET)
2012 When a line is indented, `vhdl-mode' first determines the syntactic
2013 context of the line by generating a list of symbols called syntactic
2014 elements. This list can contain more than one syntactic element and
2015 the global variable `vhdl-syntactic-context' contains the context list
2016 for the line being indented. Each element in this list is actually a
2017 cons cell of the syntactic symbol and a buffer position. This buffer
2018 position is call the relative indent point for the line. Some
2019 syntactic symbols may not have a relative indent point associated with
2022 After the syntactic context list for a line is generated, `vhdl-mode'
2023 calculates the absolute indentation for the line by looking at each
2024 syntactic element in the list. First, it compares the syntactic
2025 element against the SYNTACTIC-SYMBOL's in `vhdl-offsets-alist'. When it
2026 finds a match, it adds the OFFSET to the column of the relative indent
2027 point. The sum of this calculation for each element in the syntactic
2028 list is the absolute offset for line being indented.
2030 If the syntactic element does not match any in the `vhdl-offsets-alist',
2031 an error is generated if `vhdl-strict-syntax-p' is non-nil, otherwise
2032 the element is ignored.
2034 Actually, OFFSET can be an integer, a function, a variable, or one of
2035 the following symbols: `+', `-', `++', or `--'. These latter
2036 designate positive or negative multiples of `vhdl-basic-offset',
2037 respectively: *1, *-1, *2, and *-2. If OFFSET is a function, it is
2038 called with a single argument containing the cons of the syntactic
2039 element symbol and the relative indent point. The function should
2040 return an integer offset.
2042 Here is the current list of valid syntactic element symbols:
2044 string -- inside multi-line string
2045 block-open -- statement block open
2046 block-close -- statement block close
2047 statement -- a VHDL statement
2048 statement-cont -- a continuation of a VHDL statement
2049 statement-block-intro -- the first line in a new statement block
2050 statement-case-intro -- the first line in a case alternative block
2051 case-alternative -- a case statement alternative clause
2052 comment -- a line containing only a comment
2053 arglist-intro -- the first line in an argument list
2054 arglist-cont -- subsequent argument list lines when no
2055 arguments follow on the same line as
2056 the arglist opening paren
2057 arglist-cont-nonempty -- subsequent argument list lines when at
2058 least one argument follows on the same
2059 line as the arglist opening paren
2060 arglist-close -- the solo close paren of an argument list
2061 entity -- inside an entity declaration
2062 configuration -- inside a configuration declaration
2063 package -- inside a package declaration
2064 architecture -- inside an architecture body
2065 package-body -- inside a package body")
2067 (defvar vhdl-comment-only-line-offset
0
2068 "Extra offset for line which contains only the start of a comment.
2069 Can contain an integer or a cons cell of the form:
2071 (NON-ANCHORED-OFFSET . ANCHORED-OFFSET)
2073 Where NON-ANCHORED-OFFSET is the amount of offset given to
2074 non-column-zero anchored comment-only lines, and ANCHORED-OFFSET is
2075 the amount of offset to give column-zero anchored comment-only lines.
2076 Just an integer as value is equivalent to (<val> . 0)")
2078 (defvar vhdl-special-indent-hook nil
2079 "Hook for user defined special indentation adjustments.
2080 This hook gets called after a line is indented by the mode.")
2082 (defvar vhdl-style-alist
2084 (vhdl-basic-offset .
4)
2085 (vhdl-offsets-alist .
())))
2086 "Styles of Indentation.
2087 Elements of this alist are of the form:
2089 (STYLE-STRING (VARIABLE . VALUE) [(VARIABLE . VALUE) ...])
2091 where STYLE-STRING is a short descriptive string used to select a
2092 style, VARIABLE is any `vhdl-mode' variable, and VALUE is the intended
2093 value for that variable when using the selected style.
2095 There is one special case when VARIABLE is `vhdl-offsets-alist'. In this
2096 case, the VALUE is a list containing elements of the form:
2098 (SYNTACTIC-SYMBOL . VALUE)
2100 as described in `vhdl-offsets-alist'. These are passed directly to
2101 `vhdl-set-offset' so there is no need to set every syntactic symbol in
2102 your style, only those that are different from the default.")
2104 ;; dynamically append the default value of most variables
2105 (or (assoc "Default" vhdl-style-alist
)
2106 (let* ((varlist '(vhdl-inhibit-startup-warnings-p
2107 vhdl-strict-syntax-p
2108 vhdl-echo-syntactic-information-p
2111 vhdl-comment-only-line-offset
))
2112 (default (cons "Default"
2116 (cons var
(symbol-value var
))))
2118 (push default vhdl-style-alist
)))
2120 (defvar vhdl-mode-hook nil
2121 "Hook called by `vhdl-mode'.")
2124 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2125 ;;; Required packages
2126 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2130 (require 'compile
) ; XEmacs
2132 (require 'hippie-exp
)
2134 ;; optional (minimize warning messages during compile)
2135 (unless (featurep 'xemacs
)
2137 (require 'font-lock
)
2139 (require 'speedbar
))) ; for speedbar-with-writable
2142 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2144 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2146 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2147 ;; XEmacs compatibility
2150 (defun vhdl-keep-region-active ()
2151 "Do whatever is necessary to keep the region active in XEmacs.
2152 Ignore byte-compiler warnings you might see."
2153 (and (featurep 'xemacs
)
2154 (setq zmacs-region-stays t
)))
2156 ;; `wildcard-to-regexp' is included only in XEmacs 21
2157 (unless (fboundp 'wildcard-to-regexp
)
2158 (defun wildcard-to-regexp (wildcard)
2159 "Simplified version of `wildcard-to-regexp' from Emacs's `files.el'."
2160 (let* ((i (string-match "[*?]" wildcard
))
2161 (result (substring wildcard
0 i
))
2162 (len (length wildcard
)))
2165 (let ((ch (aref wildcard i
)))
2166 (setq result
(concat result
2167 (cond ((eq ch ?
*) "[^\000]*")
2168 ((eq ch ??
) "[^\000]")
2169 (t (char-to-string ch
)))))
2171 (concat "\\`" result
"\\'"))))
2173 ;; `regexp-opt' undefined (`xemacs-devel' not installed)
2174 ;; `regexp-opt' accelerates fontification by 10-20%
2175 (unless (fboundp 'regexp-opt
)
2176 ; (vhdl-warning-when-idle "Please install `xemacs-devel' package.")
2177 (defun regexp-opt (strings &optional paren
)
2178 (let ((open (if paren
"\\(" "")) (close (if paren
"\\)" "")))
2179 (concat open
(mapconcat 'regexp-quote strings
"\\|") close
))))
2181 ;; `match-string-no-properties' undefined (XEmacs, what else?)
2182 (unless (fboundp 'match-string-no-properties
)
2183 (defalias 'match-string-no-properties
'match-string
))
2185 ;; `subst-char-in-string' undefined (XEmacs)
2186 (unless (fboundp 'subst-char-in-string
)
2187 (defun subst-char-in-string (fromchar tochar string
&optional inplace
)
2188 (let ((i (length string
))
2189 (newstr (if inplace string
(copy-sequence string
))))
2192 (if (eq (aref newstr i
) fromchar
) (aset newstr i tochar
)))
2195 ;; `itimer.el': idle timer bug fix in version 1.09 (XEmacs 21.1.9)
2196 (when (and (featurep 'xemacs
) (string< itimer-version
"1.09")
2197 (not noninteractive
))
2199 (when (string< itimer-version
"1.09")
2200 (message "WARNING: Install included `itimer.el' patch first (see INSTALL file)")
2201 (beep) (sit-for 5)))
2203 ;; `file-expand-wildcards' undefined (XEmacs)
2204 (unless (fboundp 'file-expand-wildcards
)
2205 (defun file-expand-wildcards (pattern &optional full
)
2206 "Taken from Emacs's `files.el'."
2207 (let* ((nondir (file-name-nondirectory pattern
))
2208 (dirpart (file-name-directory pattern
))
2209 (dirs (if (and dirpart
(string-match "[[*?]" dirpart
))
2210 (mapcar 'file-name-as-directory
2211 (file-expand-wildcards (directory-file-name dirpart
)))
2215 (when (or (null (car dirs
)) ; Possible if DIRPART is not wild.
2216 (file-directory-p (directory-file-name (car dirs
))))
2217 (let ((this-dir-contents
2219 (mapcar #'(lambda (name)
2220 (unless (string-match "\\`\\.\\.?\\'"
2221 (file-name-nondirectory name
))
2223 (directory-files (or (car dirs
) ".") full
2224 (wildcard-to-regexp nondir
))))))
2227 (if (and (car dirs
) (not full
))
2228 (mapcar (function (lambda (name) (concat (car dirs
) name
)))
2232 (setq dirs
(cdr dirs
)))
2235 ;; `member-ignore-case' undefined (XEmacs)
2236 (unless (fboundp 'member-ignore-case
)
2237 (defalias 'member-ignore-case
'member
))
2239 ;; `last-input-char' obsolete in Emacs 24, `last-input-event' different
2240 ;; behavior in XEmacs
2241 (defvar vhdl-last-input-event
)
2242 (if (featurep 'xemacs
)
2243 (defvaralias 'vhdl-last-input-event
'last-input-char
)
2244 (defvaralias 'vhdl-last-input-event
'last-input-event
))
2246 ;; `help-print-return-message' changed to `print-help-return-message' in Emacs
2247 ;;;(unless (fboundp 'help-print-return-message)
2248 ;;; (defalias 'help-print-return-message 'print-help-return-message))
2250 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2251 ;; Compatibility with older VHDL Mode versions
2253 (defvar vhdl-warnings nil
2254 "Warnings to tell the user during start up.")
2256 (defun vhdl-run-when-idle (secs repeat function
)
2257 "Wait until idle, then run FUNCTION."
2258 (if (fboundp 'start-itimer
)
2259 (start-itimer "vhdl-mode" function secs repeat t
)
2260 ;; explicitly activate timer (necessary when Emacs is already idle)
2261 (aset (run-with-idle-timer secs repeat function
) 0 nil
)))
2263 (defun vhdl-warning-when-idle (&rest args
)
2264 "Wait until idle, then print out warning STRING and beep."
2266 (vhdl-warning (apply 'format args
) t
)
2267 (unless vhdl-warnings
2268 (vhdl-run-when-idle .1 nil
'vhdl-print-warnings
))
2269 (push (apply 'format args
) vhdl-warnings
)))
2271 (defun vhdl-warning (string &optional nobeep
)
2272 "Print out warning STRING and beep."
2273 (message "WARNING: %s" string
)
2274 (unless (or nobeep noninteractive
) (beep)))
2276 (defun vhdl-print-warnings ()
2277 "Print out messages in variable `vhdl-warnings'."
2278 (let ((no-warnings (length vhdl-warnings
)))
2279 (setq vhdl-warnings
(nreverse vhdl-warnings
))
2280 (while vhdl-warnings
2281 (message "WARNING: %s" (car vhdl-warnings
))
2282 (setq vhdl-warnings
(cdr vhdl-warnings
)))
2284 (when (> no-warnings
1)
2285 (message "WARNING: See warnings in message buffer (type `C-c M-m')."))))
2287 ;; Backward compatibility checks and fixes
2288 ;; option `vhdl-compiler' changed format
2289 (unless (stringp vhdl-compiler
)
2290 (setq vhdl-compiler
"ModelSim")
2291 (vhdl-warning-when-idle "Option `vhdl-compiler' has changed format; customize again"))
2293 ;; option `vhdl-standard' changed format
2294 (unless (listp vhdl-standard
)
2295 (setq vhdl-standard
'(87 nil
))
2296 (vhdl-warning-when-idle "Option `vhdl-standard' has changed format; customize again"))
2298 ;; option `vhdl-model-alist' changed format
2299 (when (= (length (car vhdl-model-alist
)) 3)
2300 (let ((old-alist vhdl-model-alist
)
2303 (push (append (car old-alist
) '("")) new-alist
)
2304 (setq old-alist
(cdr old-alist
)))
2305 (setq vhdl-model-alist
(nreverse new-alist
)))
2306 (customize-save-variable 'vhdl-model-alist vhdl-model-alist
))
2308 ;; option `vhdl-project-alist' changed format
2309 (when (= (length (car vhdl-project-alist
)) 3)
2310 (let ((old-alist vhdl-project-alist
)
2313 (push (append (car old-alist
) '("")) new-alist
)
2314 (setq old-alist
(cdr old-alist
)))
2315 (setq vhdl-project-alist
(nreverse new-alist
)))
2316 (customize-save-variable 'vhdl-project-alist vhdl-project-alist
))
2318 ;; option `vhdl-project-alist' changed format (3.31.1)
2319 (when (= (length (car vhdl-project-alist
)) 4)
2320 (let ((old-alist vhdl-project-alist
)
2323 (setq elem
(car old-alist
))
2325 (cons (list (nth 0 elem
) (nth 1 elem
) "" (nth 2 elem
)
2326 nil
"./" "work" "work/" "Makefile" (nth 3 elem
))
2328 (setq old-alist
(cdr old-alist
)))
2329 (setq vhdl-project-alist
(nreverse new-alist
)))
2330 (vhdl-warning-when-idle "Option `vhdl-project-alist' changed format; please re-customize"))
2332 ;; option `vhdl-project-alist' changed format (3.31.12)
2333 (when (= (length (car vhdl-project-alist
)) 10)
2334 (let ((tmp-alist vhdl-project-alist
))
2336 (setcdr (nthcdr 3 (car tmp-alist
))
2337 (cons "" (nthcdr 4 (car tmp-alist
))))
2338 (setq tmp-alist
(cdr tmp-alist
))))
2339 (customize-save-variable 'vhdl-project-alist vhdl-project-alist
))
2341 ;; option `vhdl-compiler-alist' changed format (3.31.1)
2342 (when (= (length (car vhdl-compiler-alist
)) 7)
2343 (let ((old-alist vhdl-compiler-alist
)
2346 (setq elem
(car old-alist
))
2348 (cons (list (nth 0 elem
) (nth 1 elem
) "" "make -f \\1"
2349 (if (equal (nth 3 elem
) "") nil
(nth 3 elem
))
2350 (nth 4 elem
) "work/" "Makefile" (downcase (nth 0 elem
))
2351 (nth 5 elem
) (nth 6 elem
) nil
)
2353 (setq old-alist
(cdr old-alist
)))
2354 (setq vhdl-compiler-alist
(nreverse new-alist
)))
2355 (vhdl-warning-when-idle "Option `vhdl-compiler-alist' changed; please reset and re-customize"))
2357 ;; option `vhdl-compiler-alist' changed format (3.31.10)
2358 (when (= (length (car vhdl-compiler-alist
)) 12)
2359 (let ((tmp-alist vhdl-compiler-alist
))
2361 (setcdr (nthcdr 4 (car tmp-alist
))
2362 (cons "mkdir \\1" (nthcdr 5 (car tmp-alist
))))
2363 (setq tmp-alist
(cdr tmp-alist
))))
2364 (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist
))
2366 ;; option `vhdl-compiler-alist' changed format (3.31.11)
2367 (when (= (length (car vhdl-compiler-alist
)) 13)
2368 (let ((tmp-alist vhdl-compiler-alist
))
2370 (setcdr (nthcdr 3 (car tmp-alist
))
2371 (cons "" (nthcdr 4 (car tmp-alist
))))
2372 (setq tmp-alist
(cdr tmp-alist
))))
2373 (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist
))
2375 ;; option `vhdl-compiler-alist' changed format (3.32.7)
2376 (when (= (length (nth 11 (car vhdl-compiler-alist
))) 3)
2377 (let ((tmp-alist vhdl-compiler-alist
))
2379 (setcdr (nthcdr 2 (nth 11 (car tmp-alist
)))
2381 (setq tmp-alist
(cdr tmp-alist
))))
2382 (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist
))
2384 ;; option `vhdl-project': empty value changed from "" to nil (3.31.1)
2385 (when (equal vhdl-project
"")
2386 (setq vhdl-project nil
)
2387 (customize-save-variable 'vhdl-project vhdl-project
))
2389 ;; option `vhdl-project-file-name': changed format (3.31.17 beta)
2390 (when (stringp vhdl-project-file-name
)
2391 (setq vhdl-project-file-name
(list vhdl-project-file-name
))
2392 (customize-save-variable 'vhdl-project-file-name vhdl-project-file-name
))
2394 ;; option `speedbar-indentation-width': introduced in speedbar 0.10
2395 (if (not (boundp 'speedbar-indentation-width
))
2396 (defvar speedbar-indentation-width
2)
2397 ;; set default to 2 if not already customized
2398 (unless (get 'speedbar-indentation-width
'saved-value
)
2399 (setq speedbar-indentation-width
2)))
2401 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2402 ;;; Help functions / inline substitutions / macros
2403 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2405 (defun vhdl-standard-p (standard)
2406 "Check if STANDARD is specified as used standard."
2407 (or (eq standard
(car vhdl-standard
))
2408 (memq standard
(cadr vhdl-standard
))))
2410 (defun vhdl-project-p (&optional warning
)
2411 "Return non-nil if a project is displayed, i.e. directories or files are
2413 (if (assoc vhdl-project vhdl-project-alist
)
2415 (when (and vhdl-project warning
)
2416 (vhdl-warning-when-idle "Project does not exist: \"%s\"" vhdl-project
))
2419 (defun vhdl-resolve-env-variable (string)
2420 "Resolve environment variables in STRING."
2421 (while (string-match "\\(.*\\)${?\\(\\(\\w\\|_\\)+\\)}?\\(.*\\)" string
)
2422 (setq string
(concat (match-string 1 string
)
2423 (getenv (match-string 2 string
))
2424 (match-string 4 string
))))
2427 (defun vhdl-default-directory ()
2428 "Return the default directory of the current project or the directory of the
2429 current buffer if no project is defined."
2430 (if (vhdl-project-p)
2431 (expand-file-name (vhdl-resolve-env-variable
2432 (nth 1 (aget vhdl-project-alist vhdl-project
))))
2435 (defmacro vhdl-prepare-search-1
(&rest body
)
2436 "Enable case insensitive search and switch to syntax table that includes '_',
2437 then execute BODY, and finally restore the old environment. Used for
2438 consistent searching."
2439 `(let ((case-fold-search t
)) ; case insensitive search
2440 ;; use extended syntax table
2441 (with-syntax-table vhdl-mode-ext-syntax-table
2444 (defmacro vhdl-prepare-search-2
(&rest body
)
2445 "Enable case insensitive search, switch to syntax table that includes '_',
2446 and remove `intangible' overlays, then execute BODY, and finally restore the
2447 old environment. Used for consistent searching."
2448 ;; FIXME: Why not just let-bind `inhibit-point-motion-hooks'? --Stef
2449 `(let ((case-fold-search t
) ; case insensitive search
2450 (current-syntax-table (syntax-table))
2451 overlay-all-list overlay-intangible-list overlay
)
2452 ;; use extended syntax table
2453 (set-syntax-table vhdl-mode-ext-syntax-table
)
2454 ;; remove `intangible' overlays
2455 (when (fboundp 'overlay-lists
)
2456 (setq overlay-all-list
(overlay-lists))
2457 (setq overlay-all-list
2458 (append (car overlay-all-list
) (cdr overlay-all-list
)))
2459 (while overlay-all-list
2460 (setq overlay
(car overlay-all-list
))
2461 (when (memq 'intangible
(overlay-properties overlay
))
2462 (setq overlay-intangible-list
2463 (cons overlay overlay-intangible-list
))
2464 (overlay-put overlay
'intangible nil
))
2465 (setq overlay-all-list
(cdr overlay-all-list
))))
2466 ;; execute BODY safely
2469 ;; restore syntax table
2470 (set-syntax-table current-syntax-table
)
2471 ;; restore `intangible' overlays
2472 (when (fboundp 'overlay-lists
)
2473 (while overlay-intangible-list
2474 (overlay-put (car overlay-intangible-list
) 'intangible t
)
2475 (setq overlay-intangible-list
2476 (cdr overlay-intangible-list
)))))))
2478 (defmacro vhdl-visit-file
(file-name issue-error
&rest body
)
2479 "Visit file FILE-NAME and execute BODY."
2480 `(if (null ,file-name
)
2482 (unless (file-directory-p ,file-name
)
2483 (let ((source-buffer (current-buffer))
2484 (visiting-buffer (find-buffer-visiting ,file-name
))
2486 (when (or (and visiting-buffer
(set-buffer visiting-buffer
))
2488 (progn (set-buffer (create-file-buffer ,file-name
))
2489 (setq file-opened t
)
2490 (vhdl-insert-file-contents ,file-name
)
2491 ;; FIXME: This modifies a global syntax-table!
2492 (modify-syntax-entry ?\-
". 12" (syntax-table))
2493 (modify-syntax-entry ?
\n ">" (syntax-table))
2494 (modify-syntax-entry ?\^M
">" (syntax-table))
2495 (modify-syntax-entry ?_
"w" (syntax-table))
2500 (when file-opened
(kill-buffer (current-buffer)))
2501 (set-buffer source-buffer
)
2502 (error "ERROR: File cannot be opened: \"%s\"" ,file-name
))
2503 (vhdl-warning (format "File cannot be opened: \"%s\"" ,file-name
) t
)
2505 (condition-case info
2510 (when file-opened
(kill-buffer (current-buffer)))
2511 (set-buffer source-buffer
)
2512 (error (cadr info
)))
2513 (vhdl-warning (cadr info
))))))
2514 (when file-opened
(kill-buffer (current-buffer)))
2515 (set-buffer source-buffer
)))))
2517 (defun vhdl-insert-file-contents (filename)
2518 "Nicked from `insert-file-contents-literally', but allow coding system
2520 (let ((format-alist nil
)
2521 (after-insert-file-functions nil
)
2522 (jka-compr-compression-info-list nil
))
2523 (insert-file-contents filename t
)))
2525 (defun vhdl-sort-alist (alist)
2527 (sort alist
(function (lambda (a b
) (string< (car a
) (car b
))))))
2529 (defun vhdl-get-subdirs (directory)
2530 "Recursively get subdirectories of DIRECTORY."
2531 (let ((dir-list (list (file-name-as-directory directory
)))
2533 (setq file-list
(vhdl-directory-files directory t
"\\w.*"))
2535 (when (file-directory-p (car file-list
))
2536 (setq dir-list
(append dir-list
(vhdl-get-subdirs (car file-list
)))))
2537 (setq file-list
(cdr file-list
)))
2540 (defun vhdl-aput (alist-symbol key
&optional value
)
2541 "As `aput', but delete key-value pair if VALUE is nil."
2543 (aput alist-symbol key value
)
2544 (adelete alist-symbol key
)))
2546 (defun vhdl-delete (elt list
)
2547 "Delete by side effect the first occurrence of ELT as a member of LIST."
2550 (while (and (cdr list1
) (not (equal elt
(cadr list1
))))
2551 (setq list1
(cdr list1
)))
2553 (setcdr list1
(cddr list1
))))
2556 (declare-function speedbar-refresh
"speedbar" (&optional arg
))
2557 (declare-function speedbar-do-function-pointer
"speedbar" ())
2559 (defun vhdl-speedbar-refresh (&optional key
)
2560 "Refresh directory or project with name KEY."
2561 (when (and (boundp 'speedbar-frame
)
2562 (frame-live-p speedbar-frame
))
2564 (last-frame (selected-frame)))
2567 (select-frame speedbar-frame
)
2568 (when (save-excursion
2569 (goto-char (point-min))
2570 (re-search-forward (concat "^\\([0-9]+:\\s-*<\\)->\\s-+" key
"$") nil t
))
2571 (goto-char (match-end 1))
2572 (speedbar-do-function-pointer)
2574 (speedbar-do-function-pointer)
2575 (message "Refreshing speedbar...done"))
2576 (select-frame last-frame
)))))
2578 (defun vhdl-show-messages ()
2579 "Get *Messages* buffer to show recent messages."
2581 (display-buffer (if (featurep 'xemacs
) " *Message-Log*" "*Messages*")))
2583 (defun vhdl-use-direct-instantiation ()
2584 "Return whether direct instantiation is used."
2585 (or (eq vhdl-use-direct-instantiation
'always
)
2586 (and (eq vhdl-use-direct-instantiation
'standard
)
2587 (not (vhdl-standard-p '87)))))
2589 (defun vhdl-max-marker (marker1 marker2
)
2590 "Return larger marker."
2591 (if (> marker1 marker2
) marker1 marker2
))
2593 (defun vhdl-goto-marker (marker)
2594 "Goto marker in appropriate buffer."
2595 (when (markerp marker
)
2596 (set-buffer (marker-buffer marker
)))
2599 (defun vhdl-menu-split (list title
)
2600 "Split menu LIST into several submenus, if number of
2601 elements > `vhdl-menu-max-size'."
2602 (if (> (length list
) vhdl-menu-max-size
)
2609 (push (car remain
) sublist
)
2610 (setq remain
(cdr remain
))
2612 (if (= i vhdl-menu-max-size
)
2614 (push (cons (format "%s %s" title menuno
)
2615 (nreverse sublist
)) result
)
2617 (setq menuno
(+ menuno
1))
2618 (setq sublist
'()))))
2620 (push (cons (format "%s %s" title menuno
)
2621 (nreverse sublist
)) result
))
2626 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2628 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2630 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2633 (defvar vhdl-template-map nil
2634 "Keymap for VHDL templates.")
2636 (defun vhdl-template-map-init ()
2637 "Initialize `vhdl-template-map'."
2638 (setq vhdl-template-map
(make-sparse-keymap))
2639 ;; key bindings for VHDL templates
2640 (define-key vhdl-template-map
"al" 'vhdl-template-alias
)
2641 (define-key vhdl-template-map
"ar" 'vhdl-template-architecture
)
2642 (define-key vhdl-template-map
"at" 'vhdl-template-assert
)
2643 (define-key vhdl-template-map
"ad" 'vhdl-template-attribute-decl
)
2644 (define-key vhdl-template-map
"as" 'vhdl-template-attribute-spec
)
2645 (define-key vhdl-template-map
"bl" 'vhdl-template-block
)
2646 (define-key vhdl-template-map
"ca" 'vhdl-template-case-is
)
2647 (define-key vhdl-template-map
"cd" 'vhdl-template-component-decl
)
2648 (define-key vhdl-template-map
"ci" 'vhdl-template-component-inst
)
2649 (define-key vhdl-template-map
"cs" 'vhdl-template-conditional-signal-asst
)
2650 (define-key vhdl-template-map
"Cb" 'vhdl-template-block-configuration
)
2651 (define-key vhdl-template-map
"Cc" 'vhdl-template-component-conf
)
2652 (define-key vhdl-template-map
"Cd" 'vhdl-template-configuration-decl
)
2653 (define-key vhdl-template-map
"Cs" 'vhdl-template-configuration-spec
)
2654 (define-key vhdl-template-map
"co" 'vhdl-template-constant
)
2655 (define-key vhdl-template-map
"di" 'vhdl-template-disconnect
)
2656 (define-key vhdl-template-map
"el" 'vhdl-template-else
)
2657 (define-key vhdl-template-map
"ei" 'vhdl-template-elsif
)
2658 (define-key vhdl-template-map
"en" 'vhdl-template-entity
)
2659 (define-key vhdl-template-map
"ex" 'vhdl-template-exit
)
2660 (define-key vhdl-template-map
"fi" 'vhdl-template-file
)
2661 (define-key vhdl-template-map
"fg" 'vhdl-template-for-generate
)
2662 (define-key vhdl-template-map
"fl" 'vhdl-template-for-loop
)
2663 (define-key vhdl-template-map
"\C-f" 'vhdl-template-footer
)
2664 (define-key vhdl-template-map
"fb" 'vhdl-template-function-body
)
2665 (define-key vhdl-template-map
"fd" 'vhdl-template-function-decl
)
2666 (define-key vhdl-template-map
"ge" 'vhdl-template-generic
)
2667 (define-key vhdl-template-map
"gd" 'vhdl-template-group-decl
)
2668 (define-key vhdl-template-map
"gt" 'vhdl-template-group-template
)
2669 (define-key vhdl-template-map
"\C-h" 'vhdl-template-header
)
2670 (define-key vhdl-template-map
"ig" 'vhdl-template-if-generate
)
2671 (define-key vhdl-template-map
"it" 'vhdl-template-if-then
)
2672 (define-key vhdl-template-map
"li" 'vhdl-template-library
)
2673 (define-key vhdl-template-map
"lo" 'vhdl-template-bare-loop
)
2674 (define-key vhdl-template-map
"\C-m" 'vhdl-template-modify
)
2675 (define-key vhdl-template-map
"\C-t" 'vhdl-template-insert-date
)
2676 (define-key vhdl-template-map
"ma" 'vhdl-template-map
)
2677 (define-key vhdl-template-map
"ne" 'vhdl-template-next
)
2678 (define-key vhdl-template-map
"ot" 'vhdl-template-others
)
2679 (define-key vhdl-template-map
"Pd" 'vhdl-template-package-decl
)
2680 (define-key vhdl-template-map
"Pb" 'vhdl-template-package-body
)
2681 (define-key vhdl-template-map
"(" 'vhdl-template-paired-parens
)
2682 (define-key vhdl-template-map
"po" 'vhdl-template-port
)
2683 (define-key vhdl-template-map
"pb" 'vhdl-template-procedure-body
)
2684 (define-key vhdl-template-map
"pd" 'vhdl-template-procedure-decl
)
2685 (define-key vhdl-template-map
"pc" 'vhdl-template-process-comb
)
2686 (define-key vhdl-template-map
"ps" 'vhdl-template-process-seq
)
2687 (define-key vhdl-template-map
"rp" 'vhdl-template-report
)
2688 (define-key vhdl-template-map
"rt" 'vhdl-template-return
)
2689 (define-key vhdl-template-map
"ss" 'vhdl-template-selected-signal-asst
)
2690 (define-key vhdl-template-map
"si" 'vhdl-template-signal
)
2691 (define-key vhdl-template-map
"su" 'vhdl-template-subtype
)
2692 (define-key vhdl-template-map
"ty" 'vhdl-template-type
)
2693 (define-key vhdl-template-map
"us" 'vhdl-template-use
)
2694 (define-key vhdl-template-map
"va" 'vhdl-template-variable
)
2695 (define-key vhdl-template-map
"wa" 'vhdl-template-wait
)
2696 (define-key vhdl-template-map
"wl" 'vhdl-template-while-loop
)
2697 (define-key vhdl-template-map
"wi" 'vhdl-template-with
)
2698 (define-key vhdl-template-map
"wc" 'vhdl-template-clocked-wait
)
2699 (define-key vhdl-template-map
"\C-pb" 'vhdl-template-package-numeric-bit
)
2700 (define-key vhdl-template-map
"\C-pn" 'vhdl-template-package-numeric-std
)
2701 (define-key vhdl-template-map
"\C-ps" 'vhdl-template-package-std-logic-1164
)
2702 (define-key vhdl-template-map
"\C-pA" 'vhdl-template-package-std-logic-arith
)
2703 (define-key vhdl-template-map
"\C-pM" 'vhdl-template-package-std-logic-misc
)
2704 (define-key vhdl-template-map
"\C-pS" 'vhdl-template-package-std-logic-signed
)
2705 (define-key vhdl-template-map
"\C-pT" 'vhdl-template-package-std-logic-textio
)
2706 (define-key vhdl-template-map
"\C-pU" 'vhdl-template-package-std-logic-unsigned
)
2707 (define-key vhdl-template-map
"\C-pt" 'vhdl-template-package-textio
)
2708 (define-key vhdl-template-map
"\C-dn" 'vhdl-template-directive-translate-on
)
2709 (define-key vhdl-template-map
"\C-df" 'vhdl-template-directive-translate-off
)
2710 (define-key vhdl-template-map
"\C-dN" 'vhdl-template-directive-synthesis-on
)
2711 (define-key vhdl-template-map
"\C-dF" 'vhdl-template-directive-synthesis-off
)
2712 (define-key vhdl-template-map
"\C-q" 'vhdl-template-search-prompt
)
2713 (when (vhdl-standard-p 'ams
)
2714 (define-key vhdl-template-map
"br" 'vhdl-template-break
)
2715 (define-key vhdl-template-map
"cu" 'vhdl-template-case-use
)
2716 (define-key vhdl-template-map
"iu" 'vhdl-template-if-use
)
2717 (define-key vhdl-template-map
"lm" 'vhdl-template-limit
)
2718 (define-key vhdl-template-map
"na" 'vhdl-template-nature
)
2719 (define-key vhdl-template-map
"pa" 'vhdl-template-procedural
)
2720 (define-key vhdl-template-map
"qf" 'vhdl-template-quantity-free
)
2721 (define-key vhdl-template-map
"qb" 'vhdl-template-quantity-branch
)
2722 (define-key vhdl-template-map
"qs" 'vhdl-template-quantity-source
)
2723 (define-key vhdl-template-map
"sn" 'vhdl-template-subnature
)
2724 (define-key vhdl-template-map
"te" 'vhdl-template-terminal
)
2726 (when (vhdl-standard-p 'math
)
2727 (define-key vhdl-template-map
"\C-pc" 'vhdl-template-package-math-complex
)
2728 (define-key vhdl-template-map
"\C-pr" 'vhdl-template-package-math-real
)
2731 ;; initialize template map for VHDL Mode
2732 (vhdl-template-map-init)
2734 (defun vhdl-function-name (prefix string
&optional postfix
)
2735 "Generate a Lisp function name.
2736 PREFIX, STRING and optional POSTFIX are concatenated by '-' and spaces in
2737 STRING are replaced by `-' and substrings are converted to lower case."
2738 (let ((name prefix
))
2739 (while (string-match "\\(\\w+\\)\\s-*\\(.*\\)" string
)
2741 (concat name
"-" (downcase (substring string
0 (match-end 1)))))
2742 (setq string
(substring string
(match-beginning 2))))
2743 (when postfix
(setq name
(concat name
"-" postfix
)))
2746 (defvar vhdl-model-map nil
2747 "Keymap for VHDL models.")
2749 (defun vhdl-model-map-init ()
2750 "Initialize `vhdl-model-map'."
2751 (setq vhdl-model-map
(make-sparse-keymap))
2752 ;; key bindings for VHDL models
2753 (let ((model-alist vhdl-model-alist
) model
)
2755 (setq model
(car model-alist
))
2756 (define-key vhdl-model-map
(nth 2 model
)
2757 (vhdl-function-name "vhdl-model" (nth 0 model
)))
2758 (setq model-alist
(cdr model-alist
)))))
2760 ;; initialize user model map for VHDL Mode
2761 (vhdl-model-map-init)
2763 (defvar vhdl-mode-map nil
2764 "Keymap for VHDL Mode.")
2766 (defun vhdl-mode-map-init ()
2767 "Initialize `vhdl-mode-map'."
2768 (setq vhdl-mode-map
(make-sparse-keymap))
2769 ;; template key bindings
2770 (define-key vhdl-mode-map
"\C-c\C-t" vhdl-template-map
)
2771 ;; model key bindings
2772 (define-key vhdl-mode-map
"\C-c\C-m" vhdl-model-map
)
2773 ;; standard key bindings
2774 (define-key vhdl-mode-map
"\M-a" 'vhdl-beginning-of-statement
)
2775 (define-key vhdl-mode-map
"\M-e" 'vhdl-end-of-statement
)
2776 (define-key vhdl-mode-map
"\M-\C-f" 'vhdl-forward-sexp
)
2777 (define-key vhdl-mode-map
"\M-\C-b" 'vhdl-backward-sexp
)
2778 (define-key vhdl-mode-map
"\M-\C-u" 'vhdl-backward-up-list
)
2779 (define-key vhdl-mode-map
"\M-\C-a" 'vhdl-backward-same-indent
)
2780 (define-key vhdl-mode-map
"\M-\C-e" 'vhdl-forward-same-indent
)
2781 (unless (featurep 'xemacs
) ; would override `M-backspace' in XEmacs
2782 (define-key vhdl-mode-map
"\M-\C-h" 'vhdl-mark-defun
))
2783 (define-key vhdl-mode-map
"\M-\C-q" 'vhdl-indent-sexp
)
2784 (define-key vhdl-mode-map
"\M-^" 'vhdl-delete-indentation
)
2785 ;; mode specific key bindings
2786 (define-key vhdl-mode-map
"\C-c\C-m\C-e" 'vhdl-electric-mode
)
2787 (define-key vhdl-mode-map
"\C-c\C-m\C-s" 'vhdl-stutter-mode
)
2788 (define-key vhdl-mode-map
"\C-c\C-s\C-p" 'vhdl-set-project
)
2789 (define-key vhdl-mode-map
"\C-c\C-p\C-d" 'vhdl-duplicate-project
)
2790 (define-key vhdl-mode-map
"\C-c\C-p\C-m" 'vhdl-import-project
)
2791 (define-key vhdl-mode-map
"\C-c\C-p\C-x" 'vhdl-export-project
)
2792 (define-key vhdl-mode-map
"\C-c\C-s\C-k" 'vhdl-set-compiler
)
2793 (define-key vhdl-mode-map
"\C-c\C-k" 'vhdl-compile
)
2794 (define-key vhdl-mode-map
"\C-c\M-\C-k" 'vhdl-make
)
2795 (define-key vhdl-mode-map
"\C-c\M-k" 'vhdl-generate-makefile
)
2796 (define-key vhdl-mode-map
"\C-c\C-p\C-w" 'vhdl-port-copy
)
2797 (define-key vhdl-mode-map
"\C-c\C-p\M-w" 'vhdl-port-copy
)
2798 (define-key vhdl-mode-map
"\C-c\C-p\C-e" 'vhdl-port-paste-entity
)
2799 (define-key vhdl-mode-map
"\C-c\C-p\C-c" 'vhdl-port-paste-component
)
2800 (define-key vhdl-mode-map
"\C-c\C-p\C-i" 'vhdl-port-paste-instance
)
2801 (define-key vhdl-mode-map
"\C-c\C-p\C-s" 'vhdl-port-paste-signals
)
2802 (define-key vhdl-mode-map
"\C-c\C-p\M-c" 'vhdl-port-paste-constants
)
2803 (if (featurep 'xemacs
) ; `... C-g' not allowed in XEmacs
2804 (define-key vhdl-mode-map
"\C-c\C-p\M-g" 'vhdl-port-paste-generic-map
)
2805 (define-key vhdl-mode-map
"\C-c\C-p\C-g" 'vhdl-port-paste-generic-map
))
2806 (define-key vhdl-mode-map
"\C-c\C-p\C-z" 'vhdl-port-paste-initializations
)
2807 (define-key vhdl-mode-map
"\C-c\C-p\C-t" 'vhdl-port-paste-testbench
)
2808 (define-key vhdl-mode-map
"\C-c\C-p\C-f" 'vhdl-port-flatten
)
2809 (define-key vhdl-mode-map
"\C-c\C-p\C-r" 'vhdl-port-reverse-direction
)
2810 (define-key vhdl-mode-map
"\C-c\C-s\C-w" 'vhdl-subprog-copy
)
2811 (define-key vhdl-mode-map
"\C-c\C-s\M-w" 'vhdl-subprog-copy
)
2812 (define-key vhdl-mode-map
"\C-c\C-s\C-d" 'vhdl-subprog-paste-declaration
)
2813 (define-key vhdl-mode-map
"\C-c\C-s\C-b" 'vhdl-subprog-paste-body
)
2814 (define-key vhdl-mode-map
"\C-c\C-s\C-c" 'vhdl-subprog-paste-call
)
2815 (define-key vhdl-mode-map
"\C-c\C-s\C-f" 'vhdl-subprog-flatten
)
2816 (define-key vhdl-mode-map
"\C-c\C-m\C-n" 'vhdl-compose-new-component
)
2817 (define-key vhdl-mode-map
"\C-c\C-m\C-p" 'vhdl-compose-place-component
)
2818 (define-key vhdl-mode-map
"\C-c\C-m\C-w" 'vhdl-compose-wire-components
)
2819 (define-key vhdl-mode-map
"\C-c\C-m\C-f" 'vhdl-compose-configuration
)
2820 (define-key vhdl-mode-map
"\C-c\C-m\C-k" 'vhdl-compose-components-package
)
2821 (define-key vhdl-mode-map
"\C-c\C-c" 'vhdl-comment-uncomment-region
)
2822 (define-key vhdl-mode-map
"\C-c-" 'vhdl-comment-append-inline
)
2823 (define-key vhdl-mode-map
"\C-c\M--" 'vhdl-comment-display-line
)
2824 (define-key vhdl-mode-map
"\C-c\C-i\C-l" 'indent-according-to-mode
)
2825 (define-key vhdl-mode-map
"\C-c\C-i\C-g" 'vhdl-indent-group
)
2826 (define-key vhdl-mode-map
"\M-\C-\\" 'vhdl-indent-region
)
2827 (define-key vhdl-mode-map
"\C-c\C-i\C-b" 'vhdl-indent-buffer
)
2828 (define-key vhdl-mode-map
"\C-c\C-a\C-g" 'vhdl-align-group
)
2829 (define-key vhdl-mode-map
"\C-c\C-a\C-a" 'vhdl-align-group
)
2830 (define-key vhdl-mode-map
"\C-c\C-a\C-i" 'vhdl-align-same-indent
)
2831 (define-key vhdl-mode-map
"\C-c\C-a\C-l" 'vhdl-align-list
)
2832 (define-key vhdl-mode-map
"\C-c\C-a\C-d" 'vhdl-align-declarations
)
2833 (define-key vhdl-mode-map
"\C-c\C-a\M-a" 'vhdl-align-region
)
2834 (define-key vhdl-mode-map
"\C-c\C-a\C-b" 'vhdl-align-buffer
)
2835 (define-key vhdl-mode-map
"\C-c\C-a\C-c" 'vhdl-align-inline-comment-group
)
2836 (define-key vhdl-mode-map
"\C-c\C-a\M-c" 'vhdl-align-inline-comment-region
)
2837 (define-key vhdl-mode-map
"\C-c\C-f\C-l" 'vhdl-fill-list
)
2838 (define-key vhdl-mode-map
"\C-c\C-f\C-f" 'vhdl-fill-list
)
2839 (define-key vhdl-mode-map
"\C-c\C-f\C-g" 'vhdl-fill-group
)
2840 (define-key vhdl-mode-map
"\C-c\C-f\C-i" 'vhdl-fill-same-indent
)
2841 (define-key vhdl-mode-map
"\C-c\C-f\M-f" 'vhdl-fill-region
)
2842 (define-key vhdl-mode-map
"\C-c\C-l\C-w" 'vhdl-line-kill
)
2843 (define-key vhdl-mode-map
"\C-c\C-l\M-w" 'vhdl-line-copy
)
2844 (define-key vhdl-mode-map
"\C-c\C-l\C-y" 'vhdl-line-yank
)
2845 (define-key vhdl-mode-map
"\C-c\C-l\t" 'vhdl-line-expand
)
2846 (define-key vhdl-mode-map
"\C-c\C-l\C-n" 'vhdl-line-transpose-next
)
2847 (define-key vhdl-mode-map
"\C-c\C-l\C-p" 'vhdl-line-transpose-previous
)
2848 (define-key vhdl-mode-map
"\C-c\C-l\C-o" 'vhdl-line-open
)
2849 (define-key vhdl-mode-map
"\C-c\C-l\C-g" 'goto-line
)
2850 (define-key vhdl-mode-map
"\C-c\C-l\C-c" 'vhdl-comment-uncomment-line
)
2851 (define-key vhdl-mode-map
"\C-c\C-x\C-s" 'vhdl-fix-statement-region
)
2852 (define-key vhdl-mode-map
"\C-c\C-x\M-s" 'vhdl-fix-statement-buffer
)
2853 (define-key vhdl-mode-map
"\C-c\C-x\C-p" 'vhdl-fix-clause
)
2854 (define-key vhdl-mode-map
"\C-c\C-x\M-c" 'vhdl-fix-case-region
)
2855 (define-key vhdl-mode-map
"\C-c\C-x\C-c" 'vhdl-fix-case-buffer
)
2856 (define-key vhdl-mode-map
"\C-c\C-x\M-w" 'vhdl-fixup-whitespace-region
)
2857 (define-key vhdl-mode-map
"\C-c\C-x\C-w" 'vhdl-fixup-whitespace-buffer
)
2858 (define-key vhdl-mode-map
"\C-c\M-b" 'vhdl-beautify-region
)
2859 (define-key vhdl-mode-map
"\C-c\C-b" 'vhdl-beautify-buffer
)
2860 (define-key vhdl-mode-map
"\C-c\C-u\C-s" 'vhdl-update-sensitivity-list-process
)
2861 (define-key vhdl-mode-map
"\C-c\C-u\M-s" 'vhdl-update-sensitivity-list-buffer
)
2862 (define-key vhdl-mode-map
"\C-c\C-i\C-f" 'vhdl-fontify-buffer
)
2863 (define-key vhdl-mode-map
"\C-c\C-i\C-s" 'vhdl-statistics-buffer
)
2864 (define-key vhdl-mode-map
"\C-c\M-m" 'vhdl-show-messages
)
2865 (define-key vhdl-mode-map
"\C-c\C-h" 'vhdl-doc-mode
)
2866 (define-key vhdl-mode-map
"\C-c\C-v" 'vhdl-version
)
2867 (define-key vhdl-mode-map
"\M-\t" 'insert-tab
)
2868 ;; insert commands bindings
2869 (define-key vhdl-mode-map
"\C-c\C-i\C-t" 'vhdl-template-insert-construct
)
2870 (define-key vhdl-mode-map
"\C-c\C-i\C-p" 'vhdl-template-insert-package
)
2871 (define-key vhdl-mode-map
"\C-c\C-i\C-d" 'vhdl-template-insert-directive
)
2872 (define-key vhdl-mode-map
"\C-c\C-i\C-m" 'vhdl-model-insert
)
2873 ;; electric key bindings
2874 (define-key vhdl-mode-map
" " 'vhdl-electric-space
)
2875 (when vhdl-intelligent-tab
2876 (define-key vhdl-mode-map
"\t" 'vhdl-electric-tab
))
2877 (define-key vhdl-mode-map
"\r" 'vhdl-electric-return
)
2878 (define-key vhdl-mode-map
"-" 'vhdl-electric-dash
)
2879 (define-key vhdl-mode-map
"[" 'vhdl-electric-open-bracket
)
2880 (define-key vhdl-mode-map
"]" 'vhdl-electric-close-bracket
)
2881 (define-key vhdl-mode-map
"'" 'vhdl-electric-quote
)
2882 (define-key vhdl-mode-map
";" 'vhdl-electric-semicolon
)
2883 (define-key vhdl-mode-map
"," 'vhdl-electric-comma
)
2884 (define-key vhdl-mode-map
"." 'vhdl-electric-period
)
2885 (when (vhdl-standard-p 'ams
)
2886 (define-key vhdl-mode-map
"=" 'vhdl-electric-equal
)))
2888 ;; initialize mode map for VHDL Mode
2889 (vhdl-mode-map-init)
2891 ;; define special minibuffer keymap for enabling word completion in minibuffer
2892 ;; (useful in template generator prompts)
2893 (defvar vhdl-minibuffer-local-map
2894 (let ((map (make-sparse-keymap)))
2895 (set-keymap-parent map minibuffer-local-map
)
2896 (when vhdl-word-completion-in-minibuffer
2897 (define-key map
"\t" 'vhdl-minibuffer-tab
))
2899 "Keymap for minibuffer used in VHDL Mode.")
2901 ;; set up electric character functions to work with
2902 ;; `delete-selection-mode' (Emacs) and `pending-delete-mode' (XEmacs)
2906 (put sym
'delete-selection t
) ; for `delete-selection-mode' (Emacs)
2907 (put sym
'pending-delete t
))) ; for `pending-delete-mode' (XEmacs)
2908 '(vhdl-electric-space
2910 vhdl-electric-return
2912 vhdl-electric-open-bracket
2913 vhdl-electric-close-bracket
2915 vhdl-electric-semicolon
2917 vhdl-electric-period
2918 vhdl-electric-equal
))
2920 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2923 (defvar vhdl-mode-syntax-table
2924 (let ((st (make-syntax-table)))
2925 ;; define punctuation
2926 (modify-syntax-entry ?\
# "." st
)
2927 (modify-syntax-entry ?\$
"." st
)
2928 (modify-syntax-entry ?\%
"." st
)
2929 (modify-syntax-entry ?\
& "." st
)
2930 (modify-syntax-entry ?
\' "." st
)
2931 (modify-syntax-entry ?\
* "." st
)
2932 (modify-syntax-entry ?\
+ "." st
)
2933 (modify-syntax-entry ?\.
"." st
)
2934 (modify-syntax-entry ?\
/ "." st
)
2935 (modify-syntax-entry ?\
: "." st
)
2936 (modify-syntax-entry ?\
; "." st)
2937 (modify-syntax-entry ?\
< "." st
)
2938 (modify-syntax-entry ?\
= "." st
)
2939 (modify-syntax-entry ?\
> "." st
)
2940 (modify-syntax-entry ?
\\ "." st
)
2941 (modify-syntax-entry ?\|
"." st
)
2943 (modify-syntax-entry ?
\" "\"" st
)
2944 ;; define underscore
2945 (modify-syntax-entry ?\_
(if vhdl-underscore-is-part-of-word
"w" "_") st
)
2946 ;; a single hyphen is punctuation, but a double hyphen starts a comment
2947 (modify-syntax-entry ?\-
". 12" st
)
2948 ;; and \n and \^M end a comment
2949 (modify-syntax-entry ?
\n ">" st
)
2950 (modify-syntax-entry ?\^M
">" st
)
2951 ;; define parentheses to match
2952 (modify-syntax-entry ?\
( "()" st
)
2953 (modify-syntax-entry ?\
) ")(" st
)
2954 (modify-syntax-entry ?\
[ "(]" st
)
2955 (modify-syntax-entry ?\
] ")[" st
)
2956 (modify-syntax-entry ?\
{ "(}" st
)
2957 (modify-syntax-entry ?\
} "){" st
)
2959 "Syntax table used in `vhdl-mode' buffers.")
2961 (defvar vhdl-mode-ext-syntax-table
2962 ;; Extended syntax table including '_' (for simpler search regexps).
2963 (let ((st (copy-syntax-table vhdl-mode-syntax-table
)))
2964 (modify-syntax-entry ?_
"w" st
)
2966 "Syntax table extended by `_' used in `vhdl-mode' buffers.")
2968 (defvar vhdl-syntactic-context nil
2969 "Buffer local variable containing syntactic analysis list.")
2970 (make-variable-buffer-local 'vhdl-syntactic-context
)
2972 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2973 ;; Abbrev hook bindings
2975 (defvar vhdl-mode-abbrev-table nil
2976 "Abbrev table to use in `vhdl-mode' buffers.")
2978 (defun vhdl-mode-abbrev-table-init ()
2979 "Initialize `vhdl-mode-abbrev-table'."
2980 (define-abbrev-table 'vhdl-mode-abbrev-table
2982 (when (memq 'vhdl vhdl-electric-keywords
)
2984 (mapcar (if (featurep 'xemacs
)
2985 (lambda (x) (list (car x
) "" (cdr x
) 0))
2986 (lambda (x) (list (car x
) "" (cdr x
) 0 'system
)))
2988 ("--" . vhdl-template-display-comment-hook
)
2989 ("abs" . vhdl-template-default-hook
)
2990 ("access" . vhdl-template-default-hook
)
2991 ("after" . vhdl-template-default-hook
)
2992 ("alias" . vhdl-template-alias-hook
)
2993 ("all" . vhdl-template-default-hook
)
2994 ("and" . vhdl-template-default-hook
)
2995 ("arch" . vhdl-template-architecture-hook
)
2996 ("architecture" . vhdl-template-architecture-hook
)
2997 ("array" . vhdl-template-default-hook
)
2998 ("assert" . vhdl-template-assert-hook
)
2999 ("attr" . vhdl-template-attribute-hook
)
3000 ("attribute" . vhdl-template-attribute-hook
)
3001 ("begin" . vhdl-template-default-indent-hook
)
3002 ("block" . vhdl-template-block-hook
)
3003 ("body" . vhdl-template-default-hook
)
3004 ("buffer" . vhdl-template-default-hook
)
3005 ("bus" . vhdl-template-default-hook
)
3006 ("case" . vhdl-template-case-hook
)
3007 ("comp" . vhdl-template-component-hook
)
3008 ("component" . vhdl-template-component-hook
)
3009 ("cond" . vhdl-template-conditional-signal-asst-hook
)
3010 ("conditional" . vhdl-template-conditional-signal-asst-hook
)
3011 ("conf" . vhdl-template-configuration-hook
)
3012 ("configuration" . vhdl-template-configuration-hook
)
3013 ("cons" . vhdl-template-constant-hook
)
3014 ("constant" . vhdl-template-constant-hook
)
3015 ("disconnect" . vhdl-template-disconnect-hook
)
3016 ("downto" . vhdl-template-default-hook
)
3017 ("else" . vhdl-template-else-hook
)
3018 ("elseif" . vhdl-template-elsif-hook
)
3019 ("elsif" . vhdl-template-elsif-hook
)
3020 ("end" . vhdl-template-default-indent-hook
)
3021 ("entity" . vhdl-template-entity-hook
)
3022 ("exit" . vhdl-template-exit-hook
)
3023 ("file" . vhdl-template-file-hook
)
3024 ("for" . vhdl-template-for-hook
)
3025 ("func" . vhdl-template-function-hook
)
3026 ("function" . vhdl-template-function-hook
)
3027 ("generic" . vhdl-template-generic-hook
)
3028 ("group" . vhdl-template-group-hook
)
3029 ("guarded" . vhdl-template-default-hook
)
3030 ("if" . vhdl-template-if-hook
)
3031 ("impure" . vhdl-template-default-hook
)
3032 ("in" . vhdl-template-default-hook
)
3033 ("inertial" . vhdl-template-default-hook
)
3034 ("inout" . vhdl-template-default-hook
)
3035 ("inst" . vhdl-template-instance-hook
)
3036 ("instance" . vhdl-template-instance-hook
)
3037 ("is" . vhdl-template-default-hook
)
3038 ("label" . vhdl-template-default-hook
)
3039 ("library" . vhdl-template-library-hook
)
3040 ("linkage" . vhdl-template-default-hook
)
3041 ("literal" . vhdl-template-default-hook
)
3042 ("loop" . vhdl-template-bare-loop-hook
)
3043 ("map" . vhdl-template-map-hook
)
3044 ("mod" . vhdl-template-default-hook
)
3045 ("nand" . vhdl-template-default-hook
)
3046 ("new" . vhdl-template-default-hook
)
3047 ("next" . vhdl-template-next-hook
)
3048 ("nor" . vhdl-template-default-hook
)
3049 ("not" . vhdl-template-default-hook
)
3050 ("null" . vhdl-template-default-hook
)
3051 ("of" . vhdl-template-default-hook
)
3052 ("on" . vhdl-template-default-hook
)
3053 ("open" . vhdl-template-default-hook
)
3054 ("or" . vhdl-template-default-hook
)
3055 ("others" . vhdl-template-others-hook
)
3056 ("out" . vhdl-template-default-hook
)
3057 ("pack" . vhdl-template-package-hook
)
3058 ("package" . vhdl-template-package-hook
)
3059 ("port" . vhdl-template-port-hook
)
3060 ("postponed" . vhdl-template-default-hook
)
3061 ("procedure" . vhdl-template-procedure-hook
)
3062 ("process" . vhdl-template-process-hook
)
3063 ("pure" . vhdl-template-default-hook
)
3064 ("range" . vhdl-template-default-hook
)
3065 ("record" . vhdl-template-default-hook
)
3066 ("register" . vhdl-template-default-hook
)
3067 ("reject" . vhdl-template-default-hook
)
3068 ("rem" . vhdl-template-default-hook
)
3069 ("report" . vhdl-template-report-hook
)
3070 ("return" . vhdl-template-return-hook
)
3071 ("rol" . vhdl-template-default-hook
)
3072 ("ror" . vhdl-template-default-hook
)
3073 ("select" . vhdl-template-selected-signal-asst-hook
)
3074 ("severity" . vhdl-template-default-hook
)
3075 ("shared" . vhdl-template-default-hook
)
3076 ("sig" . vhdl-template-signal-hook
)
3077 ("signal" . vhdl-template-signal-hook
)
3078 ("sla" . vhdl-template-default-hook
)
3079 ("sll" . vhdl-template-default-hook
)
3080 ("sra" . vhdl-template-default-hook
)
3081 ("srl" . vhdl-template-default-hook
)
3082 ("subtype" . vhdl-template-subtype-hook
)
3083 ("then" . vhdl-template-default-hook
)
3084 ("to" . vhdl-template-default-hook
)
3085 ("transport" . vhdl-template-default-hook
)
3086 ("type" . vhdl-template-type-hook
)
3087 ("unaffected" . vhdl-template-default-hook
)
3088 ("units" . vhdl-template-default-hook
)
3089 ("until" . vhdl-template-default-hook
)
3090 ("use" . vhdl-template-use-hook
)
3091 ("var" . vhdl-template-variable-hook
)
3092 ("variable" . vhdl-template-variable-hook
)
3093 ("wait" . vhdl-template-wait-hook
)
3094 ("when" . vhdl-template-when-hook
)
3095 ("while" . vhdl-template-while-loop-hook
)
3096 ("with" . vhdl-template-with-hook
)
3097 ("xnor" . vhdl-template-default-hook
)
3098 ("xor" . vhdl-template-default-hook
)
3100 ;; VHDL-AMS keywords
3101 (when (and (memq 'vhdl vhdl-electric-keywords
) (vhdl-standard-p 'ams
))
3102 (mapcar (if (featurep 'xemacs
)
3103 (lambda (x) (list (car x
) "" (cdr x
) 0))
3104 (lambda (x) (list (car x
) "" (cdr x
) 0 'system
)))
3106 ("across" . vhdl-template-default-hook
)
3107 ("break" . vhdl-template-break-hook
)
3108 ("limit" . vhdl-template-limit-hook
)
3109 ("nature" . vhdl-template-nature-hook
)
3110 ("noise" . vhdl-template-default-hook
)
3111 ("procedural" . vhdl-template-procedural-hook
)
3112 ("quantity" . vhdl-template-quantity-hook
)
3113 ("reference" . vhdl-template-default-hook
)
3114 ("spectrum" . vhdl-template-default-hook
)
3115 ("subnature" . vhdl-template-subnature-hook
)
3116 ("terminal" . vhdl-template-terminal-hook
)
3117 ("through" . vhdl-template-default-hook
)
3118 ("tolerance" . vhdl-template-default-hook
)
3120 ;; user model keywords
3121 (when (memq 'user vhdl-electric-keywords
)
3122 (let (abbrev-list keyword
)
3123 (dolist (elem vhdl-model-alist
)
3124 (setq keyword
(nth 3 elem
))
3125 (unless (equal keyword
"")
3126 (push (list keyword
""
3128 "vhdl-model" (nth 0 elem
) "hook") 0 'system
)
3132 ;; initialize abbrev table for VHDL Mode
3133 (vhdl-mode-abbrev-table-init)
3135 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3136 ;; Template completion lists
3138 (defvar vhdl-template-construct-alist nil
3139 "List of built-in construct templates.")
3141 (defun vhdl-template-construct-alist-init ()
3142 "Initialize `vhdl-template-construct-alist'."
3144 vhdl-template-construct-alist
3147 ("alias declaration" vhdl-template-alias
)
3148 ("architecture body" vhdl-template-architecture
)
3149 ("assertion" vhdl-template-assert
)
3150 ("attribute declaration" vhdl-template-attribute-decl
)
3151 ("attribute specification" vhdl-template-attribute-spec
)
3152 ("block configuration" vhdl-template-block-configuration
)
3153 ("block statement" vhdl-template-block
)
3154 ("case statement" vhdl-template-case-is
)
3155 ("component configuration" vhdl-template-component-conf
)
3156 ("component declaration" vhdl-template-component-decl
)
3157 ("component instantiation statement" vhdl-template-component-inst
)
3158 ("conditional signal assignment" vhdl-template-conditional-signal-asst
)
3159 ("configuration declaration" vhdl-template-configuration-decl
)
3160 ("configuration specification" vhdl-template-configuration-spec
)
3161 ("constant declaration" vhdl-template-constant
)
3162 ("disconnection specification" vhdl-template-disconnect
)
3163 ("entity declaration" vhdl-template-entity
)
3164 ("exit statement" vhdl-template-exit
)
3165 ("file declaration" vhdl-template-file
)
3166 ("generate statement" vhdl-template-generate
)
3167 ("generic clause" vhdl-template-generic
)
3168 ("group declaration" vhdl-template-group-decl
)
3169 ("group template declaration" vhdl-template-group-template
)
3170 ("if statement" vhdl-template-if-then
)
3171 ("library clause" vhdl-template-library
)
3172 ("loop statement" vhdl-template-loop
)
3173 ("next statement" vhdl-template-next
)
3174 ("package declaration" vhdl-template-package-decl
)
3175 ("package body" vhdl-template-package-body
)
3176 ("port clause" vhdl-template-port
)
3177 ("process statement" vhdl-template-process
)
3178 ("report statement" vhdl-template-report
)
3179 ("return statement" vhdl-template-return
)
3180 ("selected signal assignment" vhdl-template-selected-signal-asst
)
3181 ("signal declaration" vhdl-template-signal
)
3182 ("subprogram declaration" vhdl-template-subprogram-decl
)
3183 ("subprogram body" vhdl-template-subprogram-body
)
3184 ("subtype declaration" vhdl-template-subtype
)
3185 ("type declaration" vhdl-template-type
)
3186 ("use clause" vhdl-template-use
)
3187 ("variable declaration" vhdl-template-variable
)
3188 ("wait statement" vhdl-template-wait
)
3190 (when (vhdl-standard-p 'ams
)
3192 ("break statement" vhdl-template-break
)
3193 ("nature declaration" vhdl-template-nature
)
3194 ("quantity declaration" vhdl-template-quantity
)
3195 ("simultaneous case statement" vhdl-template-case-use
)
3196 ("simultaneous if statement" vhdl-template-if-use
)
3197 ("simultaneous procedural statement" vhdl-template-procedural
)
3198 ("step limit specification" vhdl-template-limit
)
3199 ("subnature declaration" vhdl-template-subnature
)
3200 ("terminal declaration" vhdl-template-terminal
)
3203 ;; initialize for VHDL Mode
3204 (vhdl-template-construct-alist-init)
3206 (defvar vhdl-template-package-alist nil
3207 "List of built-in package templates.")
3209 (defun vhdl-template-package-alist-init ()
3210 "Initialize `vhdl-template-package-alist'."
3212 vhdl-template-package-alist
3215 ("numeric_bit" vhdl-template-package-numeric-bit
)
3216 ("numeric_std" vhdl-template-package-numeric-std
)
3217 ("std_logic_1164" vhdl-template-package-std-logic-1164
)
3218 ("std_logic_arith" vhdl-template-package-std-logic-arith
)
3219 ("std_logic_misc" vhdl-template-package-std-logic-misc
)
3220 ("std_logic_signed" vhdl-template-package-std-logic-signed
)
3221 ("std_logic_textio" vhdl-template-package-std-logic-textio
)
3222 ("std_logic_unsigned" vhdl-template-package-std-logic-unsigned
)
3223 ("textio" vhdl-template-package-textio
)
3225 (when (vhdl-standard-p 'math
)
3227 ("math_complex" vhdl-template-package-math-complex
)
3228 ("math_real" vhdl-template-package-math-real
)
3231 ;; initialize for VHDL Mode
3232 (vhdl-template-package-alist-init)
3234 (defvar vhdl-template-directive-alist
3236 ("translate_on" vhdl-template-directive-translate-on
)
3237 ("translate_off" vhdl-template-directive-translate-off
)
3238 ("synthesis_on" vhdl-template-directive-synthesis-on
)
3239 ("synthesis_off" vhdl-template-directive-synthesis-off
)
3241 "List of built-in directive templates.")
3244 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3246 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3248 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3249 ;; VHDL menu (using `easy-menu.el')
3251 (defun vhdl-customize ()
3252 "Call the customize function with `vhdl' as argument."
3254 (customize-browse 'vhdl
))
3256 (defun vhdl-create-mode-menu ()
3257 "Create VHDL Mode menu."
3261 ["None" (vhdl-set-project "")
3262 :style radio
:selected
(null vhdl-project
)]
3264 ;; add menu entries for defined projects
3265 (let ((project-alist vhdl-project-alist
) menu-list name
)
3266 (while project-alist
3267 (setq name
(caar project-alist
))
3269 (cons `[,name
(vhdl-set-project ,name
)
3270 :style radio
:selected
(equal ,name vhdl-project
)]
3272 (setq project-alist
(cdr project-alist
)))
3274 (if vhdl-project-sort
3276 (function (lambda (a b
) (string< (elt a
0) (elt b
0)))))
3277 (nreverse menu-list
)))
3278 (vhdl-menu-split menu-list
"Project"))
3280 ["Select Project..." vhdl-set-project t
]
3281 ["Set As Default Project" vhdl-set-default-project t
]
3283 ["Duplicate Project" vhdl-duplicate-project vhdl-project
]
3284 ["Import Project..." vhdl-import-project
3285 :keys
"C-c C-p C-m" :active t
]
3286 ["Export Project" vhdl-export-project vhdl-project
]
3288 ["Customize Project..." (customize-option 'vhdl-project-alist
) t
]))
3291 ["Compile Buffer" vhdl-compile t
]
3292 ["Stop Compilation" kill-compilation t
]
3294 ["Make" vhdl-make t
]
3295 ["Generate Makefile" vhdl-generate-makefile t
]
3297 ["Next Error" next-error t
]
3298 ["Previous Error" previous-error t
]
3299 ["First Error" first-error t
]
3303 ;; add menu entries for defined compilers
3304 (let ((comp-alist vhdl-compiler-alist
) menu-list name
)
3306 (setq name
(caar comp-alist
))
3308 (cons `[,name
(setq vhdl-compiler
,name
)
3309 :style radio
:selected
(equal ,name vhdl-compiler
)]
3311 (setq comp-alist
(cdr comp-alist
)))
3312 (setq menu-list
(nreverse menu-list
))
3313 (vhdl-menu-split menu-list
"Compiler"))
3315 ["Select Compiler..." vhdl-set-compiler t
]
3317 ["Customize Compiler..."
3318 (customize-option 'vhdl-compiler-alist
) t
])))
3323 ["Alias" vhdl-template-alias t
]
3324 ["Architecture" vhdl-template-architecture t
]
3325 ["Assert" vhdl-template-assert t
]
3326 ["Attribute (Decl)" vhdl-template-attribute-decl t
]
3327 ["Attribute (Spec)" vhdl-template-attribute-spec t
]
3328 ["Block" vhdl-template-block t
]
3329 ["Case" vhdl-template-case-is t
]
3330 ["Component (Decl)" vhdl-template-component-decl t
]
3331 ["(Component) Instance" vhdl-template-component-inst t
]
3332 ["Conditional (Signal Asst)" vhdl-template-conditional-signal-asst t
]
3333 ["Configuration (Block)" vhdl-template-block-configuration t
]
3334 ["Configuration (Comp)" vhdl-template-component-conf t
]
3335 ["Configuration (Decl)" vhdl-template-configuration-decl t
]
3336 ["Configuration (Spec)" vhdl-template-configuration-spec t
]
3337 ["Constant" vhdl-template-constant t
]
3338 ["Disconnect" vhdl-template-disconnect t
]
3339 ["Else" vhdl-template-else t
]
3340 ["Elsif" vhdl-template-elsif t
]
3341 ["Entity" vhdl-template-entity t
]
3342 ["Exit" vhdl-template-exit t
]
3343 ["File" vhdl-template-file t
]
3344 ["For (Generate)" vhdl-template-for-generate t
]
3345 ["For (Loop)" vhdl-template-for-loop t
]
3346 ["Function (Body)" vhdl-template-function-body t
]
3347 ["Function (Decl)" vhdl-template-function-decl t
]
3348 ["Generic" vhdl-template-generic t
]
3349 ["Group (Decl)" vhdl-template-group-decl t
]
3350 ["Group (Template)" vhdl-template-group-template t
])
3352 ["If (Generate)" vhdl-template-if-generate t
]
3353 ["If (Then)" vhdl-template-if-then t
]
3354 ["Library" vhdl-template-library t
]
3355 ["Loop" vhdl-template-bare-loop t
]
3356 ["Map" vhdl-template-map t
]
3357 ["Next" vhdl-template-next t
]
3358 ["Others (Aggregate)" vhdl-template-others t
]
3359 ["Package (Decl)" vhdl-template-package-decl t
]
3360 ["Package (Body)" vhdl-template-package-body t
]
3361 ["Port" vhdl-template-port t
]
3362 ["Procedure (Body)" vhdl-template-procedure-body t
]
3363 ["Procedure (Decl)" vhdl-template-procedure-decl t
]
3364 ["Process (Comb)" vhdl-template-process-comb t
]
3365 ["Process (Seq)" vhdl-template-process-seq t
]
3366 ["Report" vhdl-template-report t
]
3367 ["Return" vhdl-template-return t
]
3368 ["Select" vhdl-template-selected-signal-asst t
]
3369 ["Signal" vhdl-template-signal t
]
3370 ["Subtype" vhdl-template-subtype t
]
3371 ["Type" vhdl-template-type t
]
3372 ["Use" vhdl-template-use t
]
3373 ["Variable" vhdl-template-variable t
]
3374 ["Wait" vhdl-template-wait t
]
3375 ["(Clocked Wait)" vhdl-template-clocked-wait t
]
3376 ["When" vhdl-template-when t
]
3377 ["While (Loop)" vhdl-template-while-loop t
]
3378 ["With" vhdl-template-with t
]))
3379 (when (vhdl-standard-p 'ams
)
3380 '(("VHDL-AMS Construct"
3381 ["Break" vhdl-template-break t
]
3382 ["Case (Use)" vhdl-template-case-use t
]
3383 ["If (Use)" vhdl-template-if-use t
]
3384 ["Limit" vhdl-template-limit t
]
3385 ["Nature" vhdl-template-nature t
]
3386 ["Procedural" vhdl-template-procedural t
]
3387 ["Quantity (Free)" vhdl-template-quantity-free t
]
3388 ["Quantity (Branch)" vhdl-template-quantity-branch t
]
3389 ["Quantity (Source)" vhdl-template-quantity-source t
]
3390 ["Subnature" vhdl-template-subnature t
]
3391 ["Terminal" vhdl-template-terminal t
])))
3392 '(["Insert Construct..." vhdl-template-insert-construct
3393 :keys
"C-c C-i C-t"]
3398 '(["numeric_bit" vhdl-template-package-numeric-bit t
]
3399 ["numeric_std" vhdl-template-package-numeric-std t
]
3400 ["std_logic_1164" vhdl-template-package-std-logic-1164 t
]
3401 ["textio" vhdl-template-package-textio t
]
3403 ["std_logic_arith" vhdl-template-package-std-logic-arith t
]
3404 ["std_logic_signed" vhdl-template-package-std-logic-signed t
]
3405 ["std_logic_unsigned" vhdl-template-package-std-logic-unsigned t
]
3406 ["std_logic_misc" vhdl-template-package-std-logic-misc t
]
3407 ["std_logic_textio" vhdl-template-package-std-logic-textio t
]
3409 (when (vhdl-standard-p 'ams
)
3410 '(["fundamental_constants" vhdl-template-package-fundamental-constants t
]
3411 ["material_constants" vhdl-template-package-material-constants t
]
3412 ["energy_systems" vhdl-template-package-energy-systems t
]
3413 ["electrical_systems" vhdl-template-package-electrical-systems t
]
3414 ["mechanical_systems" vhdl-template-package-mechanical-systems t
]
3415 ["radiant_systems" vhdl-template-package-radiant-systems t
]
3416 ["thermal_systems" vhdl-template-package-thermal-systems t
]
3417 ["fluidic_systems" vhdl-template-package-fluidic-systems t
]
3419 (when (vhdl-standard-p 'math
)
3420 '(["math_complex" vhdl-template-package-math-complex t
]
3421 ["math_real" vhdl-template-package-math-real t
]
3423 '(["Insert Package..." vhdl-template-insert-package
3424 :keys
"C-c C-i C-p"])))
3426 ["translate_on" vhdl-template-directive-translate-on t
]
3427 ["translate_off" vhdl-template-directive-translate-off t
]
3428 ["synthesis_on" vhdl-template-directive-synthesis-on t
]
3429 ["synthesis_off" vhdl-template-directive-synthesis-off t
]
3431 ["Insert Directive..." vhdl-template-insert-directive
3432 :keys
"C-c C-i C-d"])
3434 ["Insert Header" vhdl-template-header
:keys
"C-c C-t C-h"]
3435 ["Insert Footer" vhdl-template-footer t
]
3436 ["Insert Date" vhdl-template-insert-date t
]
3437 ["Modify Date" vhdl-template-modify
:keys
"C-c C-t C-m"]
3439 ["Query Next Prompt" vhdl-template-search-prompt t
]))
3442 ;; add menu entries for defined models
3443 (let ((model-alist vhdl-model-alist
) menu-list model
)
3445 (setq model
(car model-alist
))
3450 (vhdl-function-name "vhdl-model" (nth 0 model
))
3451 :keys
(concat "C-c C-m " (key-description (nth 2 model
))))
3453 (setq model-alist
(cdr model-alist
)))
3454 (setq menu-list
(nreverse menu-list
))
3455 (vhdl-menu-split menu-list
"Model"))
3457 ["Insert Model..." vhdl-model-insert
:keys
"C-c C-i C-m"]
3458 ["Customize Model..." (customize-option 'vhdl-model-alist
) t
]))
3460 ["Copy" vhdl-port-copy t
]
3462 ["Paste As Entity" vhdl-port-paste-entity vhdl-port-list
]
3463 ["Paste As Component" vhdl-port-paste-component vhdl-port-list
]
3464 ["Paste As Instance" vhdl-port-paste-instance
3465 :keys
"C-c C-p C-i" :active vhdl-port-list
]
3466 ["Paste As Signals" vhdl-port-paste-signals vhdl-port-list
]
3467 ["Paste As Constants" vhdl-port-paste-constants vhdl-port-list
]
3468 ["Paste As Generic Map" vhdl-port-paste-generic-map vhdl-port-list
]
3469 ["Paste As Initializations" vhdl-port-paste-initializations vhdl-port-list
]
3471 ["Paste As Testbench" vhdl-port-paste-testbench vhdl-port-list
]
3473 ["Flatten" vhdl-port-flatten
3474 :style toggle
:selected vhdl-port-flattened
:active vhdl-port-list
]
3475 ["Reverse Direction" vhdl-port-reverse-direction
3476 :style toggle
:selected vhdl-port-reversed-direction
:active vhdl-port-list
])
3478 ["New Component" vhdl-compose-new-component t
]
3479 ["Copy Component" vhdl-port-copy t
]
3480 ["Place Component" vhdl-compose-place-component vhdl-port-list
]
3481 ["Wire Components" vhdl-compose-wire-components t
]
3483 ["Generate Configuration" vhdl-compose-configuration t
]
3484 ["Generate Components Package" vhdl-compose-components-package t
])
3486 ["Copy" vhdl-subprog-copy t
]
3488 ["Paste As Declaration" vhdl-subprog-paste-declaration vhdl-subprog-list
]
3489 ["Paste As Body" vhdl-subprog-paste-body vhdl-subprog-list
]
3490 ["Paste As Call" vhdl-subprog-paste-call vhdl-subprog-list
]
3492 ["Flatten" vhdl-subprog-flatten
3493 :style toggle
:selected vhdl-subprog-flattened
:active vhdl-subprog-list
])
3496 ["(Un)Comment Out Region" vhdl-comment-uncomment-region
(mark)]
3498 ["Insert Inline Comment" vhdl-comment-append-inline t
]
3499 ["Insert Horizontal Line" vhdl-comment-display-line t
]
3500 ["Insert Display Comment" vhdl-comment-display t
]
3502 ["Fill Comment" fill-paragraph t
]
3503 ["Fill Comment Region" fill-region
(mark)]
3504 ["Kill Comment Region" vhdl-comment-kill-region
(mark)]
3505 ["Kill Inline Comment Region" vhdl-comment-kill-inline-region
(mark)])
3507 ["Kill" vhdl-line-kill t
]
3508 ["Copy" vhdl-line-copy t
]
3509 ["Yank" vhdl-line-yank t
]
3510 ["Expand" vhdl-line-expand t
]
3512 ["Transpose Next" vhdl-line-transpose-next t
]
3513 ["Transpose Prev" vhdl-line-transpose-previous t
]
3514 ["Open" vhdl-line-open t
]
3515 ["Join" vhdl-delete-indentation t
]
3517 ["Goto" goto-line t
]
3518 ["(Un)Comment Out" vhdl-comment-uncomment-line t
])
3520 ["Forward Statement" vhdl-end-of-statement t
]
3521 ["Backward Statement" vhdl-beginning-of-statement t
]
3522 ["Forward Expression" vhdl-forward-sexp t
]
3523 ["Backward Expression" vhdl-backward-sexp t
]
3524 ["Forward Same Indent" vhdl-forward-same-indent t
]
3525 ["Backward Same Indent" vhdl-backward-same-indent t
]
3526 ["Forward Function" vhdl-end-of-defun
t]
3527 ["Backward Function" vhdl-beginning-of-defun
t]
3528 ["Mark Function" vhdl-mark-defun
t])
3531 ["Line" indent-according-to-mode
:keys
"C-c C-i C-l"]
3532 ["Group" vhdl-indent-group
:keys
"C-c C-i C-g"]
3533 ["Region" vhdl-indent-region
(mark)]
3534 ["Buffer" vhdl-indent-buffer
:keys
"C-c C-i C-b"])
3536 ["Group" vhdl-align-group t
]
3537 ["Same Indent" vhdl-align-same-indent
:keys
"C-c C-a C-i"]
3538 ["List" vhdl-align-list t
]
3539 ["Declarations" vhdl-align-declarations t
]
3540 ["Region" vhdl-align-region
(mark)]
3541 ["Buffer" vhdl-align-buffer t
]
3543 ["Inline Comment Group" vhdl-align-inline-comment-group t
]
3544 ["Inline Comment Region" vhdl-align-inline-comment-region
(mark)]
3545 ["Inline Comment Buffer" vhdl-align-inline-comment-buffer t
])
3547 ["List" vhdl-fill-list t
]
3548 ["Group" vhdl-fill-group t
]
3549 ["Same Indent" vhdl-fill-same-indent
:keys
"C-c C-f C-i"]
3550 ["Region" vhdl-fill-region
(mark)])
3552 ["Region" vhdl-beautify-region
(mark)]
3553 ["Buffer" vhdl-beautify-buffer t
])
3555 ["Generic/Port Clause" vhdl-fix-clause t
]
3556 ["Generic/Port Clause Buffer" vhdl-fix-clause t
]
3558 ["Case Region" vhdl-fix-case-region
(mark)]
3559 ["Case Buffer" vhdl-fix-case-buffer t
]
3561 ["Whitespace Region" vhdl-fixup-whitespace-region
(mark)]
3562 ["Whitespace Buffer" vhdl-fixup-whitespace-buffer t
]
3564 ["Statement Region" vhdl-fix-statement-region
(mark)]
3565 ["Statement Buffer" vhdl-fix-statement-buffer t
]
3567 ["Trailing Spaces Buffer" vhdl-remove-trailing-spaces t
])
3569 ["Sensitivity List" vhdl-update-sensitivity-list-process t
]
3570 ["Sensitivity List Buffer" vhdl-update-sensitivity-list-buffer t
])
3572 ["Fontify Buffer" vhdl-fontify-buffer t
]
3573 ["Statistics Buffer" vhdl-statistics-buffer t
]
3574 ["Show Messages" vhdl-show-messages t
]
3575 ["Syntactic Info" vhdl-show-syntactic-information t
]
3577 ["Speedbar" vhdl-speedbar t
]
3578 ["Hide/Show" vhdl-hs-minor-mode t
]
3581 ["VHDL Mode" vhdl-doc-mode
:keys
"C-c C-h"]
3582 ["Release Notes" (vhdl-doc-variable 'vhdl-doc-release-notes
) t
]
3583 ["Reserved Words" (vhdl-doc-variable 'vhdl-doc-keywords
) t
]
3584 ["Coding Style" (vhdl-doc-variable 'vhdl-doc-coding-style
) t
])
3585 ["Version" vhdl-version t
]
3586 ["Bug Report..." vhdl-submit-bug-report t
]
3591 (progn (customize-set-variable 'vhdl-electric-mode
3592 (not vhdl-electric-mode
))
3593 (vhdl-mode-line-update))
3594 :style toggle
:selected vhdl-electric-mode
:keys
"C-c C-m C-e"]
3596 (progn (customize-set-variable 'vhdl-stutter-mode
3597 (not vhdl-stutter-mode
))
3598 (vhdl-mode-line-update))
3599 :style toggle
:selected vhdl-stutter-mode
:keys
"C-c C-m C-s"]
3601 (progn (customize-set-variable 'vhdl-indent-tabs-mode
3602 (not vhdl-indent-tabs-mode
))
3603 (setq indent-tabs-mode vhdl-indent-tabs-mode
))
3604 :style toggle
:selected vhdl-indent-tabs-mode
]
3606 ["Customize Group..." (customize-group 'vhdl-mode
) t
])
3608 ["Project Setup..." (customize-option 'vhdl-project-alist
) t
]
3610 '("Selected Project at Startup"
3611 ["None" (progn (customize-set-variable 'vhdl-project nil
)
3612 (vhdl-set-project ""))
3613 :style radio
:selected
(null vhdl-project
)]
3615 ;; add menu entries for defined projects
3616 (let ((project-alist vhdl-project-alist
) menu-list name
)
3617 (while project-alist
3618 (setq name
(caar project-alist
))
3620 (cons `[,name
(progn (customize-set-variable
3621 'vhdl-project
,name
)
3622 (vhdl-set-project ,name
))
3623 :style radio
:selected
(equal ,name vhdl-project
)]
3625 (setq project-alist
(cdr project-alist
)))
3626 (setq menu-list
(nreverse menu-list
))
3627 (vhdl-menu-split menu-list
"Project")))
3628 ["Setup File Name..." (customize-option 'vhdl-project-file-name
) t
]
3629 ("Auto Load Setup File"
3631 (customize-set-variable 'vhdl-project-auto-load
3632 (if (memq 'startup vhdl-project-auto-load
)
3633 (delq 'startup vhdl-project-auto-load
)
3634 (cons 'startup vhdl-project-auto-load
)))
3635 :style toggle
:selected
(memq 'startup vhdl-project-auto-load
)])
3637 (customize-set-variable 'vhdl-project-sort
(not vhdl-project-sort
))
3638 :style toggle
:selected vhdl-project-sort
]
3640 ["Customize Group..." (customize-group 'vhdl-project
) t
])
3642 ["Compiler Setup..." (customize-option 'vhdl-compiler-alist
) t
]
3644 '("Selected Compiler at Startup")
3645 ;; add menu entries for defined compilers
3646 (let ((comp-alist vhdl-compiler-alist
) menu-list name
)
3648 (setq name
(caar comp-alist
))
3650 (cons `[,name
(customize-set-variable 'vhdl-compiler
,name
)
3651 :style radio
:selected
(equal ,name vhdl-compiler
)]
3653 (setq comp-alist
(cdr comp-alist
)))
3654 (setq menu-list
(nreverse menu-list
))
3655 (vhdl-menu-split menu-list
"Compiler")))
3656 ["Use Local Error Regexp"
3657 (customize-set-variable 'vhdl-compile-use-local-error-regexp
3658 (not vhdl-compile-use-local-error-regexp
))
3659 :style toggle
:selected vhdl-compile-use-local-error-regexp
]
3660 ["Makefile Default Targets..."
3661 (customize-option 'vhdl-makefile-default-targets
) t
]
3662 ["Makefile Generation Hook..."
3663 (customize-option 'vhdl-makefile-generation-hook
) t
]
3664 ["Default Library Name" (customize-option 'vhdl-default-library
) t
]
3666 ["Customize Group..." (customize-group 'vhdl-compiler
) t
])
3670 (progn (customize-set-variable 'vhdl-standard
3671 (list '87 (cadr vhdl-standard
)))
3672 (vhdl-activate-customizations))
3673 :style radio
:selected
(eq '87 (car vhdl-standard
))]
3675 (progn (customize-set-variable 'vhdl-standard
3676 (list '93 (cadr vhdl-standard
)))
3677 (vhdl-activate-customizations))
3678 :style radio
:selected
(eq '93 (car vhdl-standard
))]
3681 (progn (customize-set-variable
3682 'vhdl-standard
(list (car vhdl-standard
)
3683 (if (memq 'ams
(cadr vhdl-standard
))
3684 (delq 'ams
(cadr vhdl-standard
))
3685 (cons 'ams
(cadr vhdl-standard
)))))
3686 (vhdl-activate-customizations))
3687 :style toggle
:selected
(memq 'ams
(cadr vhdl-standard
))]
3689 (progn (customize-set-variable
3690 'vhdl-standard
(list (car vhdl-standard
)
3691 (if (memq 'math
(cadr vhdl-standard
))
3692 (delq 'math
(cadr vhdl-standard
))
3693 (cons 'math
(cadr vhdl-standard
)))))
3694 (vhdl-activate-customizations))
3695 :style toggle
:selected
(memq 'math
(cadr vhdl-standard
))])
3696 ["Indentation Offset..." (customize-option 'vhdl-basic-offset
) t
]
3697 ["Upper Case Keywords"
3698 (customize-set-variable 'vhdl-upper-case-keywords
3699 (not vhdl-upper-case-keywords
))
3700 :style toggle
:selected vhdl-upper-case-keywords
]
3702 (customize-set-variable 'vhdl-upper-case-types
3703 (not vhdl-upper-case-types
))
3704 :style toggle
:selected vhdl-upper-case-types
]
3705 ["Upper Case Attributes"
3706 (customize-set-variable 'vhdl-upper-case-attributes
3707 (not vhdl-upper-case-attributes
))
3708 :style toggle
:selected vhdl-upper-case-attributes
]
3709 ["Upper Case Enumeration Values"
3710 (customize-set-variable 'vhdl-upper-case-enum-values
3711 (not vhdl-upper-case-enum-values
))
3712 :style toggle
:selected vhdl-upper-case-enum-values
]
3713 ["Upper Case Constants"
3714 (customize-set-variable 'vhdl-upper-case-constants
3715 (not vhdl-upper-case-constants
))
3716 :style toggle
:selected vhdl-upper-case-constants
]
3717 ("Use Direct Instantiation"
3719 (customize-set-variable 'vhdl-use-direct-instantiation
'never
)
3720 :style radio
:selected
(eq 'never vhdl-use-direct-instantiation
)]
3722 (customize-set-variable 'vhdl-use-direct-instantiation
'standard
)
3723 :style radio
:selected
(eq 'standard vhdl-use-direct-instantiation
)]
3725 (customize-set-variable 'vhdl-use-direct-instantiation
'always
)
3726 :style radio
:selected
(eq 'always vhdl-use-direct-instantiation
)])
3727 ["Include Array Index and Record Field in Sensitivity List"
3728 (customize-set-variable 'vhdl-array-index-record-field-in-sensitivity-list
3729 (not vhdl-array-index-record-field-in-sensitivity-list
))
3730 :style toggle
:selected vhdl-array-index-record-field-in-sensitivity-list
]
3732 ["Customize Group..." (customize-group 'vhdl-style
) t
])
3734 ["Entity File Name..." (customize-option 'vhdl-entity-file-name
) t
]
3735 ["Architecture File Name..."
3736 (customize-option 'vhdl-architecture-file-name
) t
]
3737 ["Configuration File Name..."
3738 (customize-option 'vhdl-configuration-file-name
) t
]
3739 ["Package File Name..." (customize-option 'vhdl-package-file-name
) t
]
3742 (customize-set-variable 'vhdl-file-name-case
'identity
)
3743 :style radio
:selected
(eq 'identity vhdl-file-name-case
)]
3745 (customize-set-variable 'vhdl-file-name-case
'downcase
)
3746 :style radio
:selected
(eq 'downcase vhdl-file-name-case
)]
3748 (customize-set-variable 'vhdl-file-name-case
'upcase
)
3749 :style radio
:selected
(eq 'upcase vhdl-file-name-case
)]
3751 (customize-set-variable 'vhdl-file-name-case
'capitalize
)
3752 :style radio
:selected
(eq 'capitalize vhdl-file-name-case
)])
3754 ["Customize Group..." (customize-group 'vhdl-naming
) t
])
3756 ("Electric Keywords"
3758 (customize-set-variable 'vhdl-electric-keywords
3759 (if (memq 'vhdl vhdl-electric-keywords
)
3760 (delq 'vhdl vhdl-electric-keywords
)
3761 (cons 'vhdl vhdl-electric-keywords
)))
3762 :style toggle
:selected
(memq 'vhdl vhdl-electric-keywords
)]
3763 ["User Model Keywords"
3764 (customize-set-variable 'vhdl-electric-keywords
3765 (if (memq 'user vhdl-electric-keywords
)
3766 (delq 'user vhdl-electric-keywords
)
3767 (cons 'user vhdl-electric-keywords
)))
3768 :style toggle
:selected
(memq 'user vhdl-electric-keywords
)])
3769 ("Insert Optional Labels"
3771 (customize-set-variable 'vhdl-optional-labels
'none
)
3772 :style radio
:selected
(eq 'none vhdl-optional-labels
)]
3774 (customize-set-variable 'vhdl-optional-labels
'process
)
3775 :style radio
:selected
(eq 'process vhdl-optional-labels
)]
3777 (customize-set-variable 'vhdl-optional-labels
'all
)
3778 :style radio
:selected
(eq 'all vhdl-optional-labels
)])
3779 ("Insert Empty Lines"
3781 (customize-set-variable 'vhdl-insert-empty-lines
'none
)
3782 :style radio
:selected
(eq 'none vhdl-insert-empty-lines
)]
3783 ["Design Units Only"
3784 (customize-set-variable 'vhdl-insert-empty-lines
'unit
)
3785 :style radio
:selected
(eq 'unit vhdl-insert-empty-lines
)]
3787 (customize-set-variable 'vhdl-insert-empty-lines
'all
)
3788 :style radio
:selected
(eq 'all vhdl-insert-empty-lines
)])
3789 ["Argument List Indent"
3790 (customize-set-variable 'vhdl-argument-list-indent
3791 (not vhdl-argument-list-indent
))
3792 :style toggle
:selected vhdl-argument-list-indent
]
3793 ["Association List with Formals"
3794 (customize-set-variable 'vhdl-association-list-with-formals
3795 (not vhdl-association-list-with-formals
))
3796 :style toggle
:selected vhdl-association-list-with-formals
]
3797 ["Conditions in Parenthesis"
3798 (customize-set-variable 'vhdl-conditions-in-parenthesis
3799 (not vhdl-conditions-in-parenthesis
))
3800 :style toggle
:selected vhdl-conditions-in-parenthesis
]
3801 ["Zero String..." (customize-option 'vhdl-zero-string
) t
]
3802 ["One String..." (customize-option 'vhdl-one-string
) t
]
3804 ["Header String..." (customize-option 'vhdl-file-header
) t
]
3805 ["Footer String..." (customize-option 'vhdl-file-footer
) t
]
3806 ["Company Name..." (customize-option 'vhdl-company-name
) t
]
3807 ["Copyright String..." (customize-option 'vhdl-copyright-string
) t
]
3808 ["Platform Specification..." (customize-option 'vhdl-platform-spec
) t
]
3809 ["Date Format..." (customize-option 'vhdl-date-format
) t
]
3810 ["Modify Date Prefix String..."
3811 (customize-option 'vhdl-modify-date-prefix-string
) t
]
3812 ["Modify Date on Saving"
3813 (progn (customize-set-variable 'vhdl-modify-date-on-saving
3814 (not vhdl-modify-date-on-saving
))
3815 (vhdl-activate-customizations))
3816 :style toggle
:selected vhdl-modify-date-on-saving
])
3817 ("Sequential Process"
3820 (customize-set-variable 'vhdl-reset-kind
'none
)
3821 :style radio
:selected
(eq 'none vhdl-reset-kind
)]
3823 (customize-set-variable 'vhdl-reset-kind
'sync
)
3824 :style radio
:selected
(eq 'sync vhdl-reset-kind
)]
3826 (customize-set-variable 'vhdl-reset-kind
'async
)
3827 :style radio
:selected
(eq 'async vhdl-reset-kind
)]
3829 (customize-set-variable 'vhdl-reset-kind
'query
)
3830 :style radio
:selected
(eq 'query vhdl-reset-kind
)])
3831 ["Reset is Active High"
3832 (customize-set-variable 'vhdl-reset-active-high
3833 (not vhdl-reset-active-high
))
3834 :style toggle
:selected vhdl-reset-active-high
]
3835 ["Use Rising Clock Edge"
3836 (customize-set-variable 'vhdl-clock-rising-edge
3837 (not vhdl-clock-rising-edge
))
3838 :style toggle
:selected vhdl-clock-rising-edge
]
3839 ("Clock Edge Condition"
3841 (customize-set-variable 'vhdl-clock-edge-condition
'standard
)
3842 :style radio
:selected
(eq 'standard vhdl-clock-edge-condition
)]
3843 ["Function \"rising_edge\""
3844 (customize-set-variable 'vhdl-clock-edge-condition
'function
)
3845 :style radio
:selected
(eq 'function vhdl-clock-edge-condition
)])
3846 ["Clock Name..." (customize-option 'vhdl-clock-name
) t
]
3847 ["Reset Name..." (customize-option 'vhdl-reset-name
) t
])
3849 ["Customize Group..." (customize-group 'vhdl-template
) t
])
3851 ["Model Definition..." (customize-option 'vhdl-model-alist
) t
])
3853 ["Include Port Comments"
3854 (customize-set-variable 'vhdl-include-port-comments
3855 (not vhdl-include-port-comments
))
3856 :style toggle
:selected vhdl-include-port-comments
]
3857 ["Include Direction Comments"
3858 (customize-set-variable 'vhdl-include-direction-comments
3859 (not vhdl-include-direction-comments
))
3860 :style toggle
:selected vhdl-include-direction-comments
]
3861 ["Include Type Comments"
3862 (customize-set-variable 'vhdl-include-type-comments
3863 (not vhdl-include-type-comments
))
3864 :style toggle
:selected vhdl-include-type-comments
]
3865 ("Include Group Comments"
3867 (customize-set-variable 'vhdl-include-group-comments
'never
)
3868 :style radio
:selected
(eq 'never vhdl-include-group-comments
)]
3870 (customize-set-variable 'vhdl-include-group-comments
'decl
)
3871 :style radio
:selected
(eq 'decl vhdl-include-group-comments
)]
3873 (customize-set-variable 'vhdl-include-group-comments
'always
)
3874 :style radio
:selected
(eq 'always vhdl-include-group-comments
)])
3875 ["Actual Generic Name..." (customize-option 'vhdl-actual-generic-name
) t
]
3876 ["Actual Port Name..." (customize-option 'vhdl-actual-port-name
) t
]
3877 ["Instance Name..." (customize-option 'vhdl-instance-name
) t
]
3879 ["Entity Name..." (customize-option 'vhdl-testbench-entity-name
) t
]
3880 ["Architecture Name..."
3881 (customize-option 'vhdl-testbench-architecture-name
) t
]
3882 ["Configuration Name..."
3883 (customize-option 'vhdl-testbench-configuration-name
) t
]
3884 ["DUT Name..." (customize-option 'vhdl-testbench-dut-name
) t
]
3886 (customize-set-variable 'vhdl-testbench-include-header
3887 (not vhdl-testbench-include-header
))
3888 :style toggle
:selected vhdl-testbench-include-header
]
3889 ["Declarations..." (customize-option 'vhdl-testbench-declarations
) t
]
3890 ["Statements..." (customize-option 'vhdl-testbench-statements
) t
]
3891 ["Initialize Signals"
3892 (customize-set-variable 'vhdl-testbench-initialize-signals
3893 (not vhdl-testbench-initialize-signals
))
3894 :style toggle
:selected vhdl-testbench-initialize-signals
]
3895 ["Include Library Clause"
3896 (customize-set-variable 'vhdl-testbench-include-library
3897 (not vhdl-testbench-include-library
))
3898 :style toggle
:selected vhdl-testbench-include-library
]
3899 ["Include Configuration"
3900 (customize-set-variable 'vhdl-testbench-include-configuration
3901 (not vhdl-testbench-include-configuration
))
3902 :style toggle
:selected vhdl-testbench-include-configuration
]
3905 (customize-set-variable 'vhdl-testbench-create-files
'none
)
3906 :style radio
:selected
(eq 'none vhdl-testbench-create-files
)]
3908 (customize-set-variable 'vhdl-testbench-create-files
'single
)
3909 :style radio
:selected
(eq 'single vhdl-testbench-create-files
)]
3911 (customize-set-variable 'vhdl-testbench-create-files
'separate
)
3912 :style radio
:selected
(eq 'separate vhdl-testbench-create-files
)])
3913 ["Testbench Entity File Name..."
3914 (customize-option 'vhdl-testbench-entity-file-name
) t
]
3915 ["Testbench Architecture File Name..."
3916 (customize-option 'vhdl-testbench-architecture-file-name
) t
])
3918 ["Customize Group..." (customize-group 'vhdl-port
) t
])
3920 ["Architecture Name..."
3921 (customize-option 'vhdl-compose-architecture-name
) t
]
3922 ["Configuration Name..."
3923 (customize-option 'vhdl-compose-configuration-name
) t
]
3924 ["Components Package Name..."
3925 (customize-option 'vhdl-components-package-name
) t
]
3926 ["Use Components Package"
3927 (customize-set-variable 'vhdl-use-components-package
3928 (not vhdl-use-components-package
))
3929 :style toggle
:selected vhdl-use-components-package
]
3931 (customize-set-variable 'vhdl-compose-include-header
3932 (not vhdl-compose-include-header
))
3933 :style toggle
:selected vhdl-compose-include-header
]
3934 ("Create Entity/Architecture Files"
3936 (customize-set-variable 'vhdl-compose-create-files
'none
)
3937 :style radio
:selected
(eq 'none vhdl-compose-create-files
)]
3939 (customize-set-variable 'vhdl-compose-create-files
'single
)
3940 :style radio
:selected
(eq 'single vhdl-compose-create-files
)]
3942 (customize-set-variable 'vhdl-compose-create-files
'separate
)
3943 :style radio
:selected
(eq 'separate vhdl-compose-create-files
)])
3944 ["Create Configuration File"
3945 (customize-set-variable 'vhdl-compose-configuration-create-file
3946 (not vhdl-compose-configuration-create-file
))
3947 :style toggle
:selected vhdl-compose-configuration-create-file
]
3948 ["Hierarchical Configuration"
3949 (customize-set-variable 'vhdl-compose-configuration-hierarchical
3950 (not vhdl-compose-configuration-hierarchical
))
3951 :style toggle
:selected vhdl-compose-configuration-hierarchical
]
3952 ["Use Subconfiguration"
3953 (customize-set-variable 'vhdl-compose-configuration-use-subconfiguration
3954 (not vhdl-compose-configuration-use-subconfiguration
))
3955 :style toggle
:selected vhdl-compose-configuration-use-subconfiguration
]
3957 ["Customize Group..." (customize-group 'vhdl-compose
) t
])
3959 ["Self Insert Comments"
3960 (customize-set-variable 'vhdl-self-insert-comments
3961 (not vhdl-self-insert-comments
))
3962 :style toggle
:selected vhdl-self-insert-comments
]
3963 ["Prompt for Comments"
3964 (customize-set-variable 'vhdl-prompt-for-comments
3965 (not vhdl-prompt-for-comments
))
3966 :style toggle
:selected vhdl-prompt-for-comments
]
3967 ["Inline Comment Column..."
3968 (customize-option 'vhdl-inline-comment-column
) t
]
3969 ["End Comment Column..." (customize-option 'vhdl-end-comment-column
) t
]
3971 ["Customize Group..." (customize-group 'vhdl-comment
) t
])
3973 ["Auto Align Templates"
3974 (customize-set-variable 'vhdl-auto-align
(not vhdl-auto-align
))
3975 :style toggle
:selected vhdl-auto-align
]
3976 ["Align Line Groups"
3977 (customize-set-variable 'vhdl-align-groups
(not vhdl-align-groups
))
3978 :style toggle
:selected vhdl-align-groups
]
3979 ["Group Separation String..."
3980 (customize-option 'vhdl-align-group-separate
) t
]
3981 ["Align Lines with Same Indent"
3982 (customize-set-variable 'vhdl-align-same-indent
3983 (not vhdl-align-same-indent
))
3984 :style toggle
:selected vhdl-align-same-indent
]
3985 ["Beautify Options..." (customize-option 'vhdl-beautify-options
) t
]
3987 ["Customize Group..." (customize-group 'vhdl-beautify
) t
])
3989 ["Highlighting On/Off..."
3991 (if (fboundp 'global-font-lock-mode
)
3992 'global-font-lock-mode
'font-lock-auto-fontify
)) t
]
3993 ["Highlight Keywords"
3994 (progn (customize-set-variable 'vhdl-highlight-keywords
3995 (not vhdl-highlight-keywords
))
3996 (vhdl-fontify-buffer))
3997 :style toggle
:selected vhdl-highlight-keywords
]
3999 (progn (customize-set-variable 'vhdl-highlight-names
4000 (not vhdl-highlight-names
))
4001 (vhdl-fontify-buffer))
4002 :style toggle
:selected vhdl-highlight-names
]
4003 ["Highlight Special Words"
4004 (progn (customize-set-variable 'vhdl-highlight-special-words
4005 (not vhdl-highlight-special-words
))
4006 (vhdl-fontify-buffer))
4007 :style toggle
:selected vhdl-highlight-special-words
]
4008 ["Highlight Forbidden Words"
4009 (progn (customize-set-variable 'vhdl-highlight-forbidden-words
4010 (not vhdl-highlight-forbidden-words
))
4011 (vhdl-fontify-buffer))
4012 :style toggle
:selected vhdl-highlight-forbidden-words
]
4013 ["Highlight Verilog Keywords"
4014 (progn (customize-set-variable 'vhdl-highlight-verilog-keywords
4015 (not vhdl-highlight-verilog-keywords
))
4016 (vhdl-fontify-buffer))
4017 :style toggle
:selected vhdl-highlight-verilog-keywords
]
4018 ["Highlight \"translate_off\""
4019 (progn (customize-set-variable 'vhdl-highlight-translate-off
4020 (not vhdl-highlight-translate-off
))
4021 (vhdl-fontify-buffer))
4022 :style toggle
:selected vhdl-highlight-translate-off
]
4023 ["Case Sensitive Highlighting"
4024 (progn (customize-set-variable 'vhdl-highlight-case-sensitive
4025 (not vhdl-highlight-case-sensitive
))
4026 (vhdl-fontify-buffer))
4027 :style toggle
:selected vhdl-highlight-case-sensitive
]
4028 ["Special Syntax Definition..."
4029 (customize-option 'vhdl-special-syntax-alist
) t
]
4030 ["Forbidden Words..." (customize-option 'vhdl-forbidden-words
) t
]
4031 ["Forbidden Syntax..." (customize-option 'vhdl-forbidden-syntax
) t
]
4032 ["Directive Keywords..." (customize-option 'vhdl-directive-keywords
) t
]
4033 ["Colors..." (customize-group 'vhdl-highlight-faces
) t
]
4035 ["Customize Group..." (customize-group 'vhdl-highlight
) t
])
4037 ["Auto Open at Startup"
4038 (customize-set-variable 'vhdl-speedbar-auto-open
4039 (not vhdl-speedbar-auto-open
))
4040 :style toggle
:selected vhdl-speedbar-auto-open
]
4041 ("Default Displaying Mode"
4043 (customize-set-variable 'vhdl-speedbar-display-mode
'files
)
4044 :style radio
:selected
(eq 'files vhdl-speedbar-display-mode
)]
4045 ["Directory Hierarchy"
4046 (customize-set-variable 'vhdl-speedbar-display-mode
'directory
)
4047 :style radio
:selected
(eq 'directory vhdl-speedbar-display-mode
)]
4048 ["Project Hierarchy"
4049 (customize-set-variable 'vhdl-speedbar-display-mode
'project
)
4050 :style radio
:selected
(eq 'project vhdl-speedbar-display-mode
)])
4051 ["Indentation Offset..."
4052 (customize-option 'speedbar-indentation-width
) t
]
4053 ["Scan Size Limits..." (customize-option 'vhdl-speedbar-scan-limit
) t
]
4054 ["Jump to Unit when Opening"
4055 (customize-set-variable 'vhdl-speedbar-jump-to-unit
4056 (not vhdl-speedbar-jump-to-unit
))
4057 :style toggle
:selected vhdl-speedbar-jump-to-unit
]
4058 ["Update Hierarchy on File Saving"
4059 (customize-set-variable 'vhdl-speedbar-update-on-saving
4060 (not vhdl-speedbar-update-on-saving
))
4061 :style toggle
:selected vhdl-speedbar-update-on-saving
]
4062 ("Save in Cache File"
4063 ["Hierarchy Information"
4064 (customize-set-variable 'vhdl-speedbar-save-cache
4065 (if (memq 'hierarchy vhdl-speedbar-save-cache
)
4066 (delq 'hierarchy vhdl-speedbar-save-cache
)
4067 (cons 'hierarchy vhdl-speedbar-save-cache
)))
4068 :style toggle
:selected
(memq 'hierarchy vhdl-speedbar-save-cache
)]
4069 ["Displaying Status"
4070 (customize-set-variable 'vhdl-speedbar-save-cache
4071 (if (memq 'display vhdl-speedbar-save-cache
)
4072 (delq 'display vhdl-speedbar-save-cache
)
4073 (cons 'display vhdl-speedbar-save-cache
)))
4074 :style toggle
:selected
(memq 'display vhdl-speedbar-save-cache
)])
4075 ["Cache File Name..."
4076 (customize-option 'vhdl-speedbar-cache-file-name
) t
]
4078 ["Customize Group..." (customize-group 'vhdl-speedbar
) t
])
4080 ["Add Index Menu when Loading File"
4081 (progn (customize-set-variable 'vhdl-index-menu
(not vhdl-index-menu
))
4082 (vhdl-index-menu-init))
4083 :style toggle
:selected vhdl-index-menu
]
4084 ["Add Source File Menu when Loading File"
4085 (progn (customize-set-variable 'vhdl-source-file-menu
4086 (not vhdl-source-file-menu
))
4087 (vhdl-add-source-files-menu))
4088 :style toggle
:selected vhdl-source-file-menu
]
4089 ["Add Hideshow Menu at Startup"
4090 (progn (customize-set-variable 'vhdl-hideshow-menu
4091 (not vhdl-hideshow-menu
))
4092 (vhdl-activate-customizations))
4093 :style toggle
:selected vhdl-hideshow-menu
]
4094 ["Hide Everything Initially"
4095 (customize-set-variable 'vhdl-hide-all-init
(not vhdl-hide-all-init
))
4096 :style toggle
:selected vhdl-hide-all-init
]
4098 ["Customize Group..." (customize-group 'vhdl-menu
) t
])
4100 ["In Two Column Format"
4101 (progn (customize-set-variable 'vhdl-print-two-column
4102 (not vhdl-print-two-column
))
4103 (message "Activate new setting by saving options and restarting Emacs"))
4104 :style toggle
:selected vhdl-print-two-column
]
4105 ["Use Customized Faces"
4106 (progn (customize-set-variable 'vhdl-print-customize-faces
4107 (not vhdl-print-customize-faces
))
4108 (message "Activate new setting by saving options and restarting Emacs"))
4109 :style toggle
:selected vhdl-print-customize-faces
]
4111 ["Customize Group..." (customize-group 'vhdl-print
) t
])
4113 ["Use Intelligent Tab"
4114 (progn (customize-set-variable 'vhdl-intelligent-tab
4115 (not vhdl-intelligent-tab
))
4116 (vhdl-activate-customizations))
4117 :style toggle
:selected vhdl-intelligent-tab
]
4118 ["Indent Syntax-Based"
4119 (customize-set-variable 'vhdl-indent-syntax-based
4120 (not vhdl-indent-syntax-based
))
4121 :style toggle
:selected vhdl-indent-syntax-based
]
4122 ["Indent Comments Like Next Code Line"
4123 (customize-set-variable 'vhdl-indent-comment-like-next-code-line
4124 (not vhdl-indent-comment-like-next-code-line
))
4125 :style toggle
:selected vhdl-indent-comment-like-next-code-line
]
4126 ["Word Completion is Case Sensitive"
4127 (customize-set-variable 'vhdl-word-completion-case-sensitive
4128 (not vhdl-word-completion-case-sensitive
))
4129 :style toggle
:selected vhdl-word-completion-case-sensitive
]
4130 ["Word Completion in Minibuffer"
4131 (progn (customize-set-variable 'vhdl-word-completion-in-minibuffer
4132 (not vhdl-word-completion-in-minibuffer
))
4133 (message "Activate new setting by saving options and restarting Emacs"))
4134 :style toggle
:selected vhdl-word-completion-in-minibuffer
]
4135 ["Underscore is Part of Word"
4136 (progn (customize-set-variable 'vhdl-underscore-is-part-of-word
4137 (not vhdl-underscore-is-part-of-word
))
4138 (vhdl-activate-customizations))
4139 :style toggle
:selected vhdl-underscore-is-part-of-word
]
4141 ["Customize Group..." (customize-group 'vhdl-misc
) t
])
4142 ["Related..." (customize-browse 'vhdl-related
) t
]
4144 ["Save Options" customize-save-customized t
]
4145 ["Activate Options" vhdl-activate-customizations t
]
4146 ["Browse Options..." vhdl-customize t
])))
4148 (defvar vhdl-mode-menu-list
(vhdl-create-mode-menu)
4151 (defun vhdl-update-mode-menu ()
4152 "Update VHDL Mode menu."
4154 (easy-menu-remove vhdl-mode-menu-list
) ; for XEmacs
4155 (setq vhdl-mode-menu-list
(vhdl-create-mode-menu))
4156 (easy-menu-add vhdl-mode-menu-list
) ; for XEmacs
4157 (easy-menu-define vhdl-mode-menu vhdl-mode-map
4158 "Menu keymap for VHDL Mode." vhdl-mode-menu-list
))
4160 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4161 ;; Index menu (using `imenu.el'), also used for speedbar (using `speedbar.el')
4163 (defconst vhdl-imenu-generic-expression
4166 "^\\s-*\\(\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\s-+\\(\"?\\(\\w\\|\\s_\\)+\"?\\)"
4169 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\s-*:\\(\\s-\\|\n\\)*\\(entity\\s-+\\(\\w\\|\\s_\\)+\\.\\)?\\(\\w\\|\\s_\\)+\\)\\(\\s-\\|\n\\)+\\(generic\\|port\\)\\s-+map\\>"
4172 "^\\s-*\\(component\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
4175 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(procedural\\)"
4178 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(\\(postponed\\s-+\\|\\)process\\)"
4181 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(block\\)"
4184 "^\\s-*\\(package\\( body\\|\\)\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
4187 "^\\s-*\\(configuration\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)"
4190 "^\\s-*\\(architecture\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)"
4193 "^\\s-*\\(entity\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
4196 "Imenu generic expression for VHDL Mode. See `imenu-generic-expression'.")
4198 (defun vhdl-index-menu-init ()
4199 "Initialize index menu."
4200 (set (make-local-variable 'imenu-case-fold-search
) t
)
4201 (set (make-local-variable 'imenu-generic-expression
)
4202 vhdl-imenu-generic-expression
)
4203 (when (and vhdl-index-menu
(fboundp 'imenu
))
4204 (imenu-add-to-menubar "Index")))
4206 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4207 ;; Source file menu (using `easy-menu.el')
4209 (defvar vhdl-sources-menu nil
)
4211 (defun vhdl-directory-files (directory &optional full match
)
4212 "Call `directory-files' if DIRECTORY exists, otherwise generate error
4214 (if (not (file-directory-p directory
))
4215 (vhdl-warning-when-idle "No such directory: \"%s\"" directory
)
4216 (let ((dir (directory-files directory full match
)))
4217 (setq dir
(delete "." dir
))
4218 (setq dir
(delete ".." dir
))
4221 (defun vhdl-get-source-files (&optional full directory
)
4222 "Get list of VHDL source files in DIRECTORY or current directory."
4223 (let ((mode-alist auto-mode-alist
)
4225 ;; create regular expressions for matching file names
4226 (setq filename-regexp
"\\`[^.].*\\(")
4228 (when (eq (cdar mode-alist
) 'vhdl-mode
)
4229 (setq filename-regexp
4230 (concat filename-regexp
(caar mode-alist
) "\\|")))
4231 (setq mode-alist
(cdr mode-alist
)))
4232 (setq filename-regexp
4233 (concat (substring filename-regexp
0
4234 (string-match "\\\\|$" filename-regexp
)) "\\)"))
4236 (vhdl-directory-files
4237 (or directory default-directory
) full filename-regexp
)))
4239 (defun vhdl-add-source-files-menu ()
4240 "Scan directory for all VHDL source files and generate menu.
4241 The directory of the current source file is scanned."
4243 (message "Scanning directory for source files ...")
4244 (let ((newmap (current-local-map))
4245 (file-list (vhdl-get-source-files))
4247 ;; Create list for menu
4251 (push (vector (car file-list
) (list 'find-file
(car file-list
)) t
)
4253 (setq file-list
(cdr file-list
)))
4254 (setq menu-list
(vhdl-menu-split menu-list
"Sources"))
4255 (when found
(push "--" menu-list
))
4256 (push ["*Rescan*" vhdl-add-source-files-menu t
] menu-list
)
4257 (push "Sources" menu-list
)
4259 (easy-menu-add menu-list
)
4260 (easy-menu-define vhdl-sources-menu newmap
4261 "VHDL source files menu" menu-list
))
4265 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4267 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4268 ;; performs all buffer local initializations
4271 (define-derived-mode vhdl-mode prog-mode
4272 '("VHDL" (vhdl-electric-mode "/" (vhdl-stutter-mode "/"))
4273 (vhdl-electric-mode "e")
4274 (vhdl-stutter-mode "s"))
4275 "Major mode for editing VHDL code.
4280 TEMPLATE INSERTION (electrification):
4281 After typing a VHDL keyword and entering `SPC', you are prompted for
4282 arguments while a template is generated for that VHDL construct. Typing
4283 `RET' or `C-g' at the first \(mandatory) prompt aborts the current
4284 template generation. Optional arguments are indicated by square
4285 brackets and removed if the queried string is left empty. Prompts for
4286 mandatory arguments remain in the code if the queried string is left
4287 empty. They can be queried again by `C-c C-t C-q'. Enabled
4288 electrification is indicated by `/e' in the mode line.
4290 Typing `M-SPC' after a keyword inserts a space without calling the
4291 template generator. Automatic template generation (i.e.
4292 electrification) can be disabled (enabled) by typing `C-c C-m C-e' or by
4293 setting option `vhdl-electric-mode' (see OPTIONS).
4295 Template generators can be invoked from the VHDL menu, by key
4296 bindings, by typing `C-c C-i C-c' and choosing a construct, or by typing
4297 the keyword (i.e. first word of menu entry not in parenthesis) and
4298 `SPC'. The following abbreviations can also be used: arch, attr, cond,
4299 conf, comp, cons, func, inst, pack, sig, var.
4301 Template styles can be customized in customization group
4302 `vhdl-template' \(see OPTIONS).
4306 A file header can be inserted by `C-c C-t C-h'. A file footer
4307 (template at the end of the file) can be inserted by `C-c C-t C-f'.
4308 See customization group `vhdl-header'.
4312 Double striking of some keys inserts cumbersome VHDL syntax elements.
4313 Stuttering can be disabled (enabled) by typing `C-c C-m C-s' or by
4314 option `vhdl-stutter-mode'. Enabled stuttering is indicated by `/s' in
4315 the mode line. The stuttering keys and their effects are:
4317 ;; --> \" : \" [ --> ( -- --> comment
4318 ;;; --> \" := \" [[ --> [ --CR --> comment-out code
4319 .. --> \" => \" ] --> ) --- --> horizontal line
4320 ,, --> \" <= \" ]] --> ] ---- --> display comment
4321 == --> \" == \" '' --> \\\"
4325 Typing `TAB' after a (not completed) word looks for a VHDL keyword or a
4326 word in the buffer that starts alike, inserts it and adjusts case.
4327 Re-typing `TAB' toggles through alternative word completions. This also
4328 works in the minibuffer (i.e. in template generator prompts).
4330 Typing `TAB' after `(' looks for and inserts complete parenthesized
4331 expressions (e.g. for array index ranges). All keywords as well as
4332 standard types and subprograms of VHDL have predefined abbreviations
4333 \(e.g. type \"std\" and `TAB' will toggle through all standard types
4334 beginning with \"std\").
4336 Typing `TAB' after a non-word character indents the line if at the
4337 beginning of a line (i.e. no preceding non-blank characters), and
4338 inserts a tabulator stop otherwise. `M-TAB' always inserts a tabulator
4343 `--' puts a single comment.
4344 `---' draws a horizontal line for separating code segments.
4345 `----' inserts a display comment, i.e. two horizontal lines
4346 with a comment in between.
4347 `--CR' comments out code on that line. Re-hitting CR comments
4348 out following lines.
4349 `C-c C-c' comments out a region if not commented out,
4350 uncomments a region if already commented out. Option
4351 `comment-style' defines where the comment characters
4352 should be placed (beginning of line, indent, etc.).
4354 You are prompted for comments after object definitions (i.e. signals,
4355 variables, constants, ports) and after subprogram and process
4356 specifications if option `vhdl-prompt-for-comments' is non-nil.
4357 Comments are automatically inserted as additional labels (e.g. after
4358 begin statements) and as help comments if `vhdl-self-insert-comments' is
4361 Inline comments (i.e. comments after a piece of code on the same line)
4362 are indented at least to `vhdl-inline-comment-column'. Comments go at
4363 maximum to `vhdl-end-comment-column'. `RET' after a space in a comment
4364 will open a new comment line. Typing beyond `vhdl-end-comment-column'
4365 in a comment automatically opens a new comment line. `M-q' re-fills
4366 multi-line comments.
4370 `TAB' indents a line if at the beginning of the line. The amount of
4371 indentation is specified by option `vhdl-basic-offset'. `C-c C-i C-l'
4372 always indents the current line (is bound to `TAB' if option
4373 `vhdl-intelligent-tab' is nil). If a region is active, `TAB' indents
4376 Indentation can be done for a group of lines (`C-c C-i C-g'), a region
4377 \(`M-C-\\') or the entire buffer (menu). Argument and port lists are
4378 indented normally (nil) or relative to the opening parenthesis (non-nil)
4379 according to option `vhdl-argument-list-indent'.
4381 If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of
4382 tabs. `M-x tabify' and `M-x untabify' allow to convert spaces to tabs
4385 Syntax-based indentation can be very slow in large files. Option
4386 `vhdl-indent-syntax-based' allows to use faster but simpler indentation.
4388 Option `vhdl-indent-comment-like-next-code-line' controls whether
4389 comment lines are indented like the preceding or like the following code
4394 The alignment functions align operators, keywords, and inline comments
4395 to beautify the code. `C-c C-a C-a' aligns a group of consecutive lines
4396 separated by blank lines, `C-c C-a C-i' a block of lines with same
4397 indent. `C-c C-a C-l' aligns all lines belonging to a list enclosed by
4398 a pair of parentheses (e.g. port clause/map, argument list), and `C-c
4399 C-a C-d' all lines within the declarative part of a design unit. `C-c
4400 C-a M-a' aligns an entire region. `C-c C-a C-c' aligns inline comments
4401 for a group of lines, and `C-c C-a M-c' for a region.
4403 If option `vhdl-align-groups' is non-nil, groups of code lines
4404 separated by special lines (see option `vhdl-align-group-separate') are
4405 aligned individually. If option `vhdl-align-same-indent' is non-nil,
4406 blocks of lines with same indent are aligned separately. Some templates
4407 are automatically aligned after generation if option `vhdl-auto-align'
4410 Alignment tries to align inline comments at
4411 `vhdl-inline-comment-column' and tries inline comment not to exceed
4412 `vhdl-end-comment-column'.
4414 `C-c C-x M-w' fixes up whitespace in a region. That is, operator
4415 symbols are surrounded by one space, and multiple spaces are eliminated.
4419 Code filling allows to condense code (e.g. sensitivity lists or port
4420 maps) by removing comments and newlines and re-wrapping so that all
4421 lines are maximally filled (block filling). `C-c C-f C-f' fills a list
4422 enclosed by parenthesis, `C-c C-f C-g' a group of lines separated by
4423 blank lines, `C-c C-f C-i' a block of lines with same indent, and
4424 `C-c C-f M-f' an entire region.
4427 CODE BEAUTIFICATION:
4428 `C-c M-b' and `C-c C-b' beautify the code of a region or of the entire
4429 buffer respectively. This includes indentation, alignment, and case
4430 fixing. Code beautification can also be run non-interactively using the
4433 emacs -batch -l ~/.emacs filename.vhd -f vhdl-beautify-buffer
4437 Generic and port clauses from entity or component declarations can be
4438 copied (`C-c C-p C-w') and pasted as entity and component declarations,
4439 as component instantiations and corresponding internal constants and
4440 signals, as a generic map with constants as actual generics, and as
4441 internal signal initializations (menu).
4443 To include formals in component instantiations, see option
4444 `vhdl-association-list-with-formals'. To include comments in pasting,
4445 see options `vhdl-include-...-comments'.
4447 A clause with several generic/port names on the same line can be
4448 flattened (`C-c C-p C-f') so that only one name per line exists. The
4449 direction of ports can be reversed (`C-c C-p C-r'), i.e., inputs become
4450 outputs and vice versa, which can be useful in testbenches. (This
4451 reversion is done on the internal data structure and is only reflected
4452 in subsequent paste operations.)
4454 Names for actual ports, instances, testbenches, and
4455 design-under-test instances can be derived from existing names according
4456 to options `vhdl-...-name'. See customization group `vhdl-port'.
4459 SUBPROGRAM TRANSLATION:
4460 Similar functionality exists for copying/pasting the interface of
4461 subprograms (function/procedure). A subprogram interface can be copied
4462 and then pasted as a subprogram declaration, body or call (uses
4463 association list with formals).
4466 TESTBENCH GENERATION:
4467 A copied port can also be pasted as a testbench. The generated
4468 testbench includes an entity, an architecture, and an optional
4469 configuration. The architecture contains the component declaration and
4470 instantiation of the DUT as well as internal constant and signal
4471 declarations. Additional user-defined templates can be inserted. The
4472 names used for entity/architecture/configuration/DUT as well as the file
4473 structure to be generated can be customized. See customization group
4478 Key bindings (`C-c ...') exist for most commands (see in menu).
4482 All commands can be found in the VHDL menu including their key bindings.
4486 The speedbar allows browsing of directories and file contents. It can
4487 be accessed from the VHDL menu and is automatically opened if option
4488 `vhdl-speedbar-auto-open' is non-nil.
4490 In speedbar, open files and directories with `mouse-2' on the name and
4491 browse/rescan their contents with `mouse-2'/`S-mouse-2' on the `+'.
4494 DESIGN HIERARCHY BROWSER:
4495 The speedbar can also be used for browsing the hierarchy of design units
4496 contained in the source files of the current directory or the specified
4497 projects (see option `vhdl-project-alist').
4499 The speedbar can be switched between file, directory hierarchy and
4500 project hierarchy browsing mode in the speedbar menu or by typing `f',
4501 `h' or `H' in speedbar.
4503 In speedbar, open design units with `mouse-2' on the name and browse
4504 their hierarchy with `mouse-2' on the `+'. Ports can directly be copied
4505 from entities and components (in packages). Individual design units and
4506 complete designs can directly be compiled (\"Make\" menu entry).
4508 The hierarchy is automatically updated upon saving a modified source
4509 file when option `vhdl-speedbar-update-on-saving' is non-nil. The
4510 hierarchy is only updated for projects that have been opened once in the
4511 speedbar. The hierarchy is cached between Emacs sessions in a file (see
4512 options in group `vhdl-speedbar').
4514 Simple design consistency checks are done during scanning, such as
4515 multiple declarations of the same unit or missing primary units that are
4516 required by secondary units.
4519 STRUCTURAL COMPOSITION:
4520 Enables simple structural composition. `C-c C-m C-n' creates a skeleton
4521 for a new component. Subcomponents (i.e. component declaration and
4522 instantiation) can be automatically placed from a previously read port
4523 \(`C-c C-m C-p') or directly from the hierarchy browser (`P'). Finally,
4524 all subcomponents can be automatically connected using internal signals
4525 and ports (`C-c C-m C-w') following these rules:
4526 - subcomponent actual ports with same name are considered to be
4527 connected by a signal (internal signal or port)
4528 - signals that are only inputs to subcomponents are considered as
4529 inputs to this component -> input port created
4530 - signals that are only outputs from subcomponents are considered as
4531 outputs from this component -> output port created
4532 - signals that are inputs to AND outputs from subcomponents are
4533 considered as internal connections -> internal signal created
4535 Purpose: With appropriate naming conventions it is possible to
4536 create higher design levels with only a few mouse clicks or key
4537 strokes. A new design level can be created by simply generating a new
4538 component, placing the required subcomponents from the hierarchy
4539 browser, and wiring everything automatically.
4541 Note: Automatic wiring only works reliably on templates of new
4542 components and component instantiations that were created by VHDL mode.
4544 Component declarations can be placed in a components package (option
4545 `vhdl-use-components-package') which can be automatically generated for
4546 an entire directory or project (`C-c C-m M-p'). The VHDL'93 direct
4547 component instantiation is also supported (option
4548 `vhdl-use-direct-instantiation').
4550 Configuration declarations can automatically be generated either from
4551 the menu (`C-c C-m C-f') (for the architecture the cursor is in) or from
4552 the speedbar menu (for the architecture under the cursor). The
4553 configurations can optionally be hierarchical (i.e. include all
4554 component levels of a hierarchical design, option
4555 `vhdl-compose-configuration-hierarchical') or include subconfigurations
4556 (option `vhdl-compose-configuration-use-subconfiguration'). For
4557 subcomponents in hierarchical configurations, the most-recently-analyzed
4558 (mra) architecture is selected. If another architecture is desired, it
4559 can be marked as most-recently-analyzed (speedbar menu) before
4560 generating the configuration.
4562 Note: Configurations of subcomponents (i.e. hierarchical configuration
4563 declarations) are currently not considered when displaying
4564 configurations in speedbar.
4566 See the options group `vhdl-compose' for all relevant user options.
4569 SOURCE FILE COMPILATION:
4570 The syntax of the current buffer can be analyzed by calling a VHDL
4571 compiler (menu, `C-c C-k'). The compiler to be used is specified by
4572 option `vhdl-compiler'. The available compilers are listed in option
4573 `vhdl-compiler-alist' including all required compilation command,
4574 command options, compilation directory, and error message syntax
4575 information. New compilers can be added.
4577 All the source files of an entire design can be compiled by the `make'
4578 command (menu, `C-c M-C-k') if an appropriate Makefile exists.
4581 MAKEFILE GENERATION:
4582 Makefiles can be generated automatically by an internal generation
4583 routine (`C-c M-k'). The library unit dependency information is
4584 obtained from the hierarchy browser. Makefile generation can be
4585 customized for each compiler in option `vhdl-compiler-alist'.
4587 Makefile generation can also be run non-interactively using the
4590 emacs -batch -l ~/.emacs -l vhdl-mode
4591 [-compiler compilername] [-project projectname]
4592 -f vhdl-generate-makefile
4594 The Makefile's default target \"all\" compiles the entire design, the
4595 target \"clean\" removes it and the target \"library\" creates the
4596 library directory if not existent. These target names can be customized
4597 by option `vhdl-makefile-default-targets'. The Makefile also includes a
4598 target for each primary library unit which allows selective compilation
4599 of this unit, its secondary units and its subhierarchy (example:
4600 compilation of a design specified by a configuration). User specific
4601 parts can be inserted into a Makefile with option
4602 `vhdl-makefile-generation-hook'.
4605 - Only library units and dependencies within the current library are
4606 considered. Makefiles for designs that span multiple libraries are
4607 not (yet) supported.
4608 - Only one-level configurations are supported (also hierarchical),
4609 but configurations that go down several levels are not.
4610 - The \"others\" keyword in configurations is not supported.
4614 Projects can be defined in option `vhdl-project-alist' and a current
4615 project be selected using option `vhdl-project' (permanently) or from
4616 the menu or speedbar (temporarily). For each project, title and
4617 description strings (for the file headers), source files/directories
4618 (for the hierarchy browser and Makefile generation), library name, and
4619 compiler-dependent options, exceptions and compilation directory can be
4620 specified. Compilation settings overwrite the settings of option
4621 `vhdl-compiler-alist'.
4623 Project setups can be exported (i.e. written to a file) and imported.
4624 Imported setups are not automatically saved in `vhdl-project-alist' but
4625 can be saved afterwards in its customization buffer. When starting
4626 Emacs with VHDL Mode (i.e. load a VHDL file or use \"emacs -l
4627 vhdl-mode\") in a directory with an existing project setup file, it is
4628 automatically loaded and its project activated if option
4629 `vhdl-project-auto-load' is non-nil. Names/paths of the project setup
4630 files can be specified in option `vhdl-project-file-name'. Multiple
4631 project setups can be automatically loaded from global directories.
4632 This is an alternative to specifying project setups with option
4633 `vhdl-project-alist'.
4637 As an alternative to the speedbar, an index menu can be added (set
4638 option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu
4639 (e.g. add \"(global-set-key '[S-down-mouse-3] 'imenu)\" to your start-up
4640 file) for browsing the file contents (is not populated if buffer is
4641 larger than 256000). Also, a source file menu can be
4642 added (set option `vhdl-source-file-menu' to non-nil) for browsing the
4643 current directory for VHDL source files.
4647 The VHDL standards to be used are specified in option `vhdl-standard'.
4648 Available standards are: VHDL'87/'93(02), VHDL-AMS, and Math Packages.
4652 Lower and upper case for keywords and standardized types, attributes,
4653 and enumeration values is supported. If the option
4654 `vhdl-upper-case-keywords' is set to non-nil, keywords can be typed in
4655 lower case and are converted into upper case automatically (not for
4656 types, attributes, and enumeration values). The case of keywords,
4657 types, attributes,and enumeration values can be fixed for an entire
4658 region (menu) or buffer (`C-c C-x C-c') according to the options
4659 `vhdl-upper-case-{keywords,types,attributes,enum-values}'.
4662 HIGHLIGHTING (fontification):
4663 Keywords and standardized types, attributes, enumeration values, and
4664 function names (controlled by option `vhdl-highlight-keywords'), as well
4665 as comments, strings, and template prompts are highlighted using
4666 different colors. Unit, subprogram, signal, variable, constant,
4667 parameter and generic/port names in declarations as well as labels are
4668 highlighted if option `vhdl-highlight-names' is non-nil.
4670 Additional reserved words or words with a forbidden syntax (e.g. words
4671 that should be avoided) can be specified in option
4672 `vhdl-forbidden-words' or `vhdl-forbidden-syntax' and be highlighted in
4673 a warning color (option `vhdl-highlight-forbidden-words'). Verilog
4674 keywords are highlighted as forbidden words if option
4675 `vhdl-highlight-verilog-keywords' is non-nil.
4677 Words with special syntax can be highlighted by specifying their
4678 syntax and color in option `vhdl-special-syntax-alist' and by setting
4679 option `vhdl-highlight-special-words' to non-nil. This allows to
4680 establish some naming conventions (e.g. to distinguish different kinds
4681 of signals or other objects by using name suffices) and to support them
4684 Option `vhdl-highlight-case-sensitive' can be set to non-nil in order
4685 to support case-sensitive highlighting. However, keywords are then only
4686 highlighted if written in lower case.
4688 Code between \"translate_off\" and \"translate_on\" pragmas is
4689 highlighted using a different background color if option
4690 `vhdl-highlight-translate-off' is non-nil.
4692 For documentation and customization of the used colors see
4693 customization group `vhdl-highlight-faces' (`M-x customize-group'). For
4694 highlighting of matching parenthesis, see customization group
4695 `paren-showing'. Automatic buffer highlighting is turned on/off by
4696 option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs).
4700 VHDL models (templates) can be specified by the user and made accessible
4701 in the menu, through key bindings (`C-c C-m ...'), or by keyword
4702 electrification. See option `vhdl-model-alist'.
4706 The code of blocks, processes, subprograms, component declarations and
4707 instantiations, generic/port clauses, and configuration declarations can
4708 be hidden using the `Hide/Show' menu or by pressing `S-mouse-2' within
4709 the code (see customization group `vhdl-menu'). XEmacs: limited
4710 functionality due to old `hideshow.el' package.
4714 - Sensitivity List: `C-c C-u C-s' updates the sensitivity list of the
4715 current process, `C-c C-u M-s' of all processes in the current buffer.
4717 - Only declared local signals (ports, signals declared in
4718 architecture and blocks) are automatically inserted.
4719 - Global signals declared in packages are not automatically inserted.
4720 Insert them once manually (will be kept afterwards).
4721 - Out parameters of procedures are considered to be read.
4722 Use option `vhdl-entity-file-name' to specify the entity file name
4723 \(used to obtain the port names).
4724 Use option `vhdl-array-index-record-field-in-sensitivity-list' to
4725 specify whether to include array indices and record fields in
4730 `C-c C-x C-p' fixes the closing parenthesis of a generic/port clause
4731 \(e.g. if the closing parenthesis is on the wrong line or is missing).
4735 PostScript printing with different faces (an optimized set of faces is
4736 used if `vhdl-print-customize-faces' is non-nil) or colors \(if
4737 `ps-print-color-p' is non-nil) is possible using the standard Emacs
4738 PostScript printing commands. Option `vhdl-print-two-column' defines
4739 appropriate default settings for nice landscape two-column printing.
4740 The paper format can be set by option `ps-paper-type'. Do not forget to
4741 switch `ps-print-color-p' to nil for printing on black-and-white
4746 User options allow customization of VHDL Mode. All options are
4747 accessible from the \"Options\" menu entry. Simple options (switches
4748 and choices) can directly be changed, while for complex options a
4749 customization buffer is opened. Changed options can be saved for future
4750 sessions using the \"Save Options\" menu entry.
4752 Options and their detailed descriptions can also be accessed by using
4753 the \"Customize\" menu entry or the command `M-x customize-option' (`M-x
4754 customize-group' for groups). Some customizations only take effect
4755 after some action (read the NOTE in the option documentation).
4756 Customization can also be done globally (i.e. site-wide, read the
4759 Not all options are described in this documentation, so go and see
4760 what other useful user options there are (`M-x vhdl-customize' or menu)!
4764 As default, files with extensions \".vhd\" and \".vhdl\" are
4765 automatically recognized as VHDL source files. To add an extension
4766 \".xxx\", add the following line to your Emacs start-up file (`.emacs'):
4768 \(push '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist)
4772 - To start Emacs with open VHDL hierarchy browser without having to load
4773 a VHDL file first, use the command:
4775 emacs -l vhdl-mode -f speedbar-frame-mode
4777 - Type `C-g C-g' to interrupt long operations or if Emacs hangs.
4779 - Some features only work on properly indented code.
4783 See also the release notes (menu) for added features in new releases.
4789 To submit a bug report, enter `M-x vhdl-submit-bug-report' within VHDL Mode.
4790 Add a description of the problem and include a reproducible test case.
4792 Questions and enhancement requests can be sent to <reto@gnu.org>.
4794 The `vhdl-mode-announce' mailing list informs about new VHDL Mode releases.
4795 The `vhdl-mode-victims' mailing list informs about new VHDL Mode beta
4796 releases. You are kindly invited to participate in beta testing. Subscribe
4797 to above mailing lists by sending an email to <reto@gnu.org>.
4799 VHDL Mode is officially distributed at
4800 http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html
4801 where the latest version can be found.
4807 - XEmacs: Incorrect start-up when automatically opening speedbar.
4808 - XEmacs: Indentation in XEmacs 21.4 (and higher).
4809 - Indentation incorrect for new 'postponed' VHDL keyword.
4810 - Indentation incorrect for 'protected body' construct.
4813 The VHDL Mode Authors
4814 Reto Zimmermann and Rod Whitby
4820 :abbrev-table vhdl-mode-abbrev-table
4822 ;; set local variables
4823 (set (make-local-variable 'paragraph-start
)
4824 "\\s-*\\(--+\\s-*$\\|$\\)")
4825 (set (make-local-variable 'paragraph-separate
) paragraph-start
)
4826 (set (make-local-variable 'paragraph-ignore-fill-prefix
) t
)
4827 (set (make-local-variable 'parse-sexp-ignore-comments
) t
)
4828 (set (make-local-variable 'indent-line-function
) 'vhdl-indent-line
)
4829 (set (make-local-variable 'comment-start
) "--")
4830 (set (make-local-variable 'comment-end
) "")
4832 (set (make-local-variable 'comment-padding
) ""))
4833 (set (make-local-variable 'comment-column
) vhdl-inline-comment-column
)
4834 (set (make-local-variable 'end-comment-column
) vhdl-end-comment-column
)
4835 (set (make-local-variable 'comment-start-skip
) "--+\\s-*")
4836 (set (make-local-variable 'comment-multi-line
) nil
)
4837 (set (make-local-variable 'indent-tabs-mode
) vhdl-indent-tabs-mode
)
4838 (set (make-local-variable 'hippie-expand-verbose
) nil
)
4840 ;; setup the comment indent variable in a Emacs version portable way
4841 ;; ignore any byte compiler warnings you might get here
4842 (when (boundp 'comment-indent-function
)
4843 (set (make-local-variable 'comment-indent-function
) 'vhdl-comment-indent
))
4845 ;; initialize font locking
4846 (set (make-local-variable 'font-lock-defaults
)
4848 '(nil vhdl-font-lock-keywords
) nil
4849 (not vhdl-highlight-case-sensitive
) '((?\_ .
"w")) 'beginning-of-line
))
4850 (if (eval-when-compile (fboundp 'syntax-propertize-rules
))
4851 (set (make-local-variable 'syntax-propertize-function
)
4852 (syntax-propertize-rules
4853 ;; Mark single quotes as having string quote syntax in
4855 ("\\(\'\\).\\(\'\\)" (1 "\"'") (2 "\"'"))))
4856 (set (make-local-variable 'font-lock-syntactic-keywords
)
4857 vhdl-font-lock-syntactic-keywords
))
4858 (unless vhdl-emacs-21
4859 (set (make-local-variable 'font-lock-support-mode
) 'lazy-lock-mode
)
4860 (set (make-local-variable 'lazy-lock-defer-contextually
) nil
)
4861 (set (make-local-variable 'lazy-lock-defer-on-the-fly
) t
)
4862 (set (make-local-variable 'lazy-lock-defer-on-scrolling
) t
))
4864 ;; variables for source file compilation
4865 (when vhdl-compile-use-local-error-regexp
4866 (set (make-local-variable 'compilation-error-regexp-alist
) nil
)
4867 (set (make-local-variable 'compilation-file-regexp-alist
) nil
))
4870 (vhdl-index-menu-init)
4871 ;; add source file menu
4872 (if vhdl-source-file-menu
(vhdl-add-source-files-menu))
4874 (easy-menu-add vhdl-mode-menu-list
) ; for XEmacs
4875 (easy-menu-define vhdl-mode-menu vhdl-mode-map
4876 "Menu keymap for VHDL Mode." vhdl-mode-menu-list
)
4877 ;; initialize hideshow and add menu
4878 (vhdl-hideshow-init)
4879 (run-hooks 'menu-bar-update-hook
)
4882 (vhdl-ps-print-init)
4883 (vhdl-write-file-hooks-init)
4884 (message "VHDL Mode %s.%s" vhdl-version
4885 (if noninteractive
"" " See menu for documentation and release notes.")))
4887 (defun vhdl-activate-customizations ()
4888 "Activate all customizations on local variables."
4890 (vhdl-mode-map-init)
4891 (use-local-map vhdl-mode-map
)
4892 (set-syntax-table vhdl-mode-syntax-table
)
4893 (setq comment-column vhdl-inline-comment-column
)
4894 (setq end-comment-column vhdl-end-comment-column
)
4895 (vhdl-write-file-hooks-init)
4896 (vhdl-update-mode-menu)
4897 (vhdl-hideshow-init)
4898 (run-hooks 'menu-bar-update-hook
))
4900 (defun vhdl-write-file-hooks-init ()
4901 "Add/remove hooks when buffer is saved."
4902 (if vhdl-modify-date-on-saving
4903 (add-hook 'local-write-file-hooks
'vhdl-template-modify-noerror nil t
)
4904 (remove-hook 'local-write-file-hooks
'vhdl-template-modify-noerror t
))
4905 (if (featurep 'xemacs
) (make-local-hook 'after-save-hook
))
4906 (add-hook 'after-save-hook
'vhdl-add-modified-file nil t
))
4908 (defun vhdl-process-command-line-option (option)
4909 "Process command line options for VHDL Mode."
4912 ((equal option
"-compiler")
4913 (vhdl-set-compiler (car command-line-args-left
))
4914 (setq command-line-args-left
(cdr command-line-args-left
)))
4916 ((equal option
"-project")
4917 (vhdl-set-project (car command-line-args-left
))
4918 (setq command-line-args-left
(cdr command-line-args-left
)))))
4920 ;; make Emacs process VHDL Mode options
4921 (setq command-switch-alist
4922 (append command-switch-alist
4923 '(("-compiler" . vhdl-process-command-line-option
)
4924 ("-project" . vhdl-process-command-line-option
))))
4927 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4928 ;;; Keywords and standardized words
4929 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4931 (defconst vhdl-02-keywords
4933 "abs" "access" "after" "alias" "all" "and" "architecture" "array"
4934 "assert" "attribute"
4935 "begin" "block" "body" "buffer" "bus"
4936 "case" "component" "configuration" "constant"
4937 "disconnect" "downto"
4938 "else" "elsif" "end" "entity" "exit"
4939 "file" "for" "function"
4940 "generate" "generic" "group" "guarded"
4941 "if" "impure" "in" "inertial" "inout" "is"
4942 "label" "library" "linkage" "literal" "loop"
4944 "nand" "new" "next" "nor" "not" "null"
4945 "of" "on" "open" "or" "others" "out"
4946 "package" "port" "postponed" "procedure" "process" "protected" "pure"
4947 "range" "record" "register" "reject" "rem" "report" "return"
4949 "select" "severity" "shared" "signal" "sla" "sll" "sra" "srl" "subtype"
4950 "then" "to" "transport" "type"
4951 "unaffected" "units" "until" "use"
4953 "wait" "when" "while" "with"
4956 "List of VHDL'02 keywords.")
4958 (defconst vhdl-ams-keywords
4960 "across" "break" "limit" "nature" "noise" "procedural" "quantity"
4961 "reference" "spectrum" "subnature" "terminal" "through"
4964 "List of VHDL-AMS keywords.")
4966 (defconst vhdl-verilog-keywords
4968 "`define" "`else" "`endif" "`ifdef" "`include" "`timescale" "`undef"
4969 "always" "and" "assign" "begin" "buf" "bufif0" "bufif1"
4970 "case" "casex" "casez" "cmos" "deassign" "default" "defparam" "disable"
4971 "edge" "else" "end" "endattribute" "endcase" "endfunction" "endmodule"
4972 "endprimitive" "endspecify" "endtable" "endtask" "event"
4973 "for" "force" "forever" "fork" "function"
4974 "highz0" "highz1" "if" "initial" "inout" "input" "integer" "join" "large"
4975 "macromodule" "makefile" "medium" "module"
4976 "nand" "negedge" "nmos" "nor" "not" "notif0" "notif1" "or" "output"
4977 "parameter" "pmos" "posedge" "primitive" "pull0" "pull1" "pulldown"
4979 "rcmos" "real" "realtime" "reg" "release" "repeat" "rnmos" "rpmos" "rtran"
4980 "rtranif0" "rtranif1"
4981 "scalared" "signed" "small" "specify" "specparam" "strength" "strong0"
4982 "strong1" "supply" "supply0" "supply1"
4983 "table" "task" "time" "tran" "tranif0" "tranif1" "tri" "tri0" "tri1"
4984 "triand" "trior" "trireg"
4985 "vectored" "wait" "wand" "weak0" "weak1" "while" "wire" "wor" "xnor" "xor"
4987 "List of Verilog keywords as candidate for additional reserved words.")
4989 (defconst vhdl-02-types
4991 "boolean" "bit" "bit_vector" "character" "severity_level" "integer"
4992 "real" "time" "natural" "positive" "string" "line" "text" "side"
4993 "unsigned" "signed" "delay_length" "file_open_kind" "file_open_status"
4994 "std_logic" "std_logic_vector"
4995 "std_ulogic" "std_ulogic_vector"
4997 "List of VHDL'02 standardized types.")
4999 (defconst vhdl-ams-types
5000 ;; standards: IEEE Std 1076.1-2007, IEEE Std 1076.1.1-2004
5002 ;; package `standard'
5003 "domain_type" "real_vector"
5004 ;; package `energy_systems'
5005 "energy" "power" "periodicity" "real_across" "real_through" "unspecified"
5006 "unspecified_vector" "energy_vector" "power_vector" "periodicity_vector"
5007 "real_across_vector" "real_through_vector"
5008 ;; package `electrical_systems'
5009 "voltage" "current" "charge" "resistance" "conductance" "capacitance"
5010 "mmf" "electric_flux" "electric_flux_density" "electric_field_strength"
5011 "magnetic_flux" "magnetic_flux_density" "magnetic_field_strength"
5012 "inductance" "reluctance" "electrical" "electrical_vector" "magnetic"
5013 "magnetic_vector" "voltage_vector" "current_vector" "mmf_vector"
5014 "magnetic_flux_vector" "charge_vector" "resistance_vector"
5015 "conductance_vector" "capacitance_vector" "electric_flux_vector"
5016 "electric_flux_density_vector" "electric_field_strength_vector"
5017 "magnetic_flux_density_vector" "magnetic_field_strength_vector"
5018 "inductance_vector" "reluctance_vector" "ground"
5019 ;; package `mechanical_systems'
5020 "displacement" "force" "velocity" "acceleration" "mass" "stiffness"
5021 "damping" "momentum" "angle" "torque" "angular_velocity"
5022 "angular_acceleration" "moment_inertia" "angular_momentum"
5023 "angular_stiffness" "angular_damping" "translational"
5024 "translational_vector" "translational_velocity"
5025 "translational_velocity_vector" "rotational" "rotational_vector"
5026 "rotational_velocity" "rotational_velocity_vector" "displacement_vector"
5027 "force_vector" "velocity_vector" "force_velocity_vector" "angle_vector"
5028 "torque_vector" "angular_velocity_vector" "torque_velocity_vector"
5029 "acceleration_vector" "mass_vector" "stiffness_vector" "damping_vector"
5030 "momentum_vector" "angular_acceleration_vector" "moment_inertia_vector"
5031 "angular_momentum_vector" "angular_stiffness_vector"
5032 "angular_damping_vector" "anchor" "translational_v_ref"
5033 "rotational_v_ref" "translational_v" "rotational_v"
5034 ;; package `radiant_systems'
5035 "illuminance" "luminous_flux" "luminous_intensity" "irradiance" "radiant"
5036 "radiant_vector" "luminous_intensity_vector" "luminous_flux_vector"
5037 "illuminance_vector" "irradiance_vector"
5038 ;; package `thermal_systems'
5039 "temperature" "heat_flow" "thermal_capacitance" "thermal_resistance"
5040 "thermal_conductance" "thermal" "thermal_vector" "temperature_vector"
5041 "heat_flow_vector" "thermal_capacitance_vector"
5042 "thermal_resistance_vector" "thermal_conductance_vector"
5043 ;; package `fluidic_systems'
5044 "pressure" "vflow_rate" "mass_flow_rate" "volume" "density" "viscosity"
5045 "fresistance" "fconductance" "fcapacitance" "inertance" "cfresistance"
5046 "cfcapacitance" "cfinertance" "cfconductance" "fluidic" "fluidic_vector"
5047 "compressible_fluidic" "compressible_fluidic_vector" "pressure_vector"
5048 "vflow_rate_vector" "mass_flow_rate_vector" "volume_vector"
5049 "density_vector" "viscosity_vector" "fresistance_vector"
5050 "fconductance_vector" "fcapacitance_vector" "inertance_vector"
5051 "cfresistance_vector" "cfconductance_vector" "cfcapacitance_vector"
5052 "cfinertance_vector"
5054 "List of VHDL-AMS standardized types.")
5056 (defconst vhdl-math-types
5058 "complex" "complex_polar" "positive_real" "principal_value"
5060 "List of Math Packages standardized types.")
5062 (defconst vhdl-02-attributes
5064 "base" "left" "right" "high" "low" "pos" "val" "succ"
5065 "pred" "leftof" "rightof" "range" "reverse_range"
5066 "length" "delayed" "stable" "quiet" "transaction"
5067 "event" "active" "last_event" "last_active" "last_value"
5068 "driving" "driving_value" "ascending" "value" "image"
5069 "simple_name" "instance_name" "path_name"
5072 "List of VHDL'02 standardized attributes.")
5074 (defconst vhdl-ams-attributes
5077 "reference" "contribution" "tolerance"
5078 "dot" "integ" "delayed" "above" "zoh" "ltf" "ztf"
5081 "List of VHDL-AMS standardized attributes.")
5083 (defconst vhdl-02-enum-values
5086 "note" "warning" "error" "failure"
5087 "read_mode" "write_mode" "append_mode"
5088 "open_ok" "status_error" "name_error" "mode_error"
5089 "fs" "ps" "ns" "us" "ms" "sec" "min" "hr"
5092 "List of VHDL'02 standardized enumeration values.")
5094 (defconst vhdl-ams-enum-values
5096 "quiescent_domain" "time_domain" "frequency_domain"
5097 ;; from `nature_pkg' package
5098 "eps0" "mu0" "ground" "mecvf_gnd" "mecpf_gnd" "rot_gnd" "fld_gnd"
5100 "List of VHDL-AMS standardized enumeration values.")
5102 (defconst vhdl-ams-constants
5103 ;; standard: IEEE Std 1076.1.1-2004
5105 ;; package `fundamental_constants'
5106 "phys_q" "phys_eps0" "phys_mu0" "phys_k" "phys_gravity" "phys_ctok"
5107 "phys_c" "phys_h" "phys_h_over_2_pi" "yocto" "zepto" "atto" "femto"
5108 "pico" "nano" "micro" "milli" "centi" "deci" "deka" "hecto" "kilo" "mega"
5109 "giga" "tera" "peta" "exa" "zetta" "yotta" "deca"
5110 ;; package `material_constants'
5111 "phys_eps_si" "phys_eps_sio2" "phys_e_si" "phys_e_sio2" "phys_e_poly"
5112 "phys_nu_si" "phys_nu_poly" "phys_rho_poly" "phys_rho_sio2"
5113 "ambient_temperature" "ambient_pressure" "ambient_illuminance"
5115 "List of VHDL-AMS standardized constants.")
5117 (defconst vhdl-math-constants
5118 ;; standard: IEEE Std 1076.2-1996
5120 "math_1_over_e" "math_1_over_pi" "math_1_over_sqrt_2" "math_2_pi"
5121 "math_3_pi_over_2" "math_cbase_1" "math_cbase_j" "math_czero"
5122 "math_deg_to_rad" "math_e" "math_log10_of_e" "math_log2_of_e"
5123 "math_log_of_10" "math_log_of_2" "math_pi" "math_pi_over_2"
5124 "math_pi_over_3" "math_pi_over_4" "math_rad_to_deg" "math_sqrt_2"
5127 "List of Math Packages standardized constants.")
5129 (defconst vhdl-02-functions
5131 "now" "resolved" "rising_edge" "falling_edge"
5132 "read" "readline" "hread" "oread" "write" "writeline" "hwrite" "owrite"
5134 "resize" "is_X" "std_match"
5135 "shift_left" "shift_right" "rotate_left" "rotate_right"
5136 "to_unsigned" "to_signed" "to_integer"
5137 "to_stdLogicVector" "to_stdULogic" "to_stdULogicVector"
5138 "to_bit" "to_bitVector" "to_X01" "to_X01Z" "to_UX01" "to_01"
5139 "conv_unsigned" "conv_signed" "conv_integer" "conv_std_logic_vector"
5140 "shl" "shr" "ext" "sxt"
5143 "List of VHDL'02 standardized functions.")
5145 (defconst vhdl-ams-functions
5147 ;; package `standard'
5150 "List of VHDL-AMS standardized functions.")
5152 (defconst vhdl-math-functions
5153 ;; standard: IEEE Std 1076.2-1996
5155 "arccos" "arccosh" "arcsin" "arcsinh" "arctan" "arctanh" "arg"
5156 "cbrt" "ceil" "cmplx" "complex_to_polar" "conj" "cos" "cosh" "exp"
5157 "floor" "get_principal_value" "log" "log10" "log2" "polar_to_complex"
5158 "realmax" "realmin" "round" "sign" "sin" "sinh" "sqrt"
5159 "tan" "tanh" "trunc" "uniform"
5161 "List of Math Packages standardized functions.")
5163 (defconst vhdl-02-packages
5165 "std_logic_1164" "numeric_std" "numeric_bit"
5167 "std_logic_arith" "std_logic_signed" "std_logic_unsigned"
5168 "std_logic_misc" "std_logic_textio"
5171 "List of VHDL'02 standardized packages and libraries.")
5173 (defconst vhdl-ams-packages
5175 "fundamental_constants" "material_constants" "energy_systems"
5176 "electrical_systems" "mechanical_systems" "radiant_systems"
5177 "thermal_systems" "fluidic_systems"
5179 "List of VHDL-AMS standardized packages and libraries.")
5181 (defconst vhdl-math-packages
5183 "math_real" "math_complex"
5185 "List of Math Packages standardized packages and libraries.")
5187 (defvar vhdl-keywords nil
5188 "List of VHDL keywords.")
5190 (defvar vhdl-types nil
5191 "List of VHDL standardized types.")
5193 (defvar vhdl-attributes nil
5194 "List of VHDL standardized attributes.")
5196 (defvar vhdl-enum-values nil
5197 "List of VHDL standardized enumeration values.")
5199 (defvar vhdl-constants nil
5200 "List of VHDL standardized constants.")
5202 (defvar vhdl-functions nil
5203 "List of VHDL standardized functions.")
5205 (defvar vhdl-packages nil
5206 "List of VHDL standardized packages and libraries.")
5208 (defvar vhdl-reserved-words nil
5209 "List of additional reserved words.")
5211 (defvar vhdl-keywords-regexp nil
5212 "Regexp for VHDL keywords.")
5214 (defvar vhdl-types-regexp nil
5215 "Regexp for VHDL standardized types.")
5217 (defvar vhdl-attributes-regexp nil
5218 "Regexp for VHDL standardized attributes.")
5220 (defvar vhdl-enum-values-regexp nil
5221 "Regexp for VHDL standardized enumeration values.")
5223 (defvar vhdl-constants-regexp nil
5224 "Regexp for VHDL standardized constants.")
5226 (defvar vhdl-functions-regexp nil
5227 "Regexp for VHDL standardized functions.")
5229 (defvar vhdl-packages-regexp nil
5230 "Regexp for VHDL standardized packages and libraries.")
5232 (defvar vhdl-reserved-words-regexp nil
5233 "Regexp for additional reserved words.")
5235 (defvar vhdl-directive-keywords-regexp nil
5236 "Regexp for compiler directive keywords.")
5238 (defun vhdl-upcase-list (condition list
)
5239 "Upcase all elements in LIST based on CONDITION."
5241 (let ((tmp-list list
))
5243 (setcar tmp-list
(upcase (car tmp-list
)))
5244 (setq tmp-list
(cdr tmp-list
)))))
5247 (defun vhdl-words-init ()
5248 "Initialize reserved words."
5251 (and vhdl-highlight-case-sensitive vhdl-upper-case-keywords
)
5252 (append vhdl-02-keywords
5253 (when (vhdl-standard-p 'ams
) vhdl-ams-keywords
))))
5256 (and vhdl-highlight-case-sensitive vhdl-upper-case-types
)
5257 (append vhdl-02-types
5258 (when (vhdl-standard-p 'ams
) vhdl-ams-types
)
5259 (when (vhdl-standard-p 'math
) vhdl-math-types
))))
5260 (setq vhdl-attributes
5262 (and vhdl-highlight-case-sensitive vhdl-upper-case-attributes
)
5263 (append vhdl-02-attributes
5264 (when (vhdl-standard-p 'ams
) vhdl-ams-attributes
))))
5265 (setq vhdl-enum-values
5267 (and vhdl-highlight-case-sensitive vhdl-upper-case-enum-values
)
5268 (append vhdl-02-enum-values
5269 (when (vhdl-standard-p 'ams
) vhdl-ams-enum-values
))))
5270 (setq vhdl-constants
5272 (and vhdl-highlight-case-sensitive vhdl-upper-case-constants
)
5273 (append (when (vhdl-standard-p 'ams
) vhdl-ams-constants
)
5274 (when (vhdl-standard-p 'math
) vhdl-math-constants
)
5276 (setq vhdl-functions
5277 (append vhdl-02-functions
5278 (when (vhdl-standard-p 'ams
) vhdl-ams-functions
)
5279 (when (vhdl-standard-p 'math
) vhdl-math-functions
)))
5281 (append vhdl-02-packages
5282 (when (vhdl-standard-p 'ams
) vhdl-ams-packages
)
5283 (when (vhdl-standard-p 'math
) vhdl-math-packages
)))
5284 (setq vhdl-reserved-words
5285 (append (when vhdl-highlight-forbidden-words vhdl-forbidden-words
)
5286 (when vhdl-highlight-verilog-keywords vhdl-verilog-keywords
)
5288 (setq vhdl-keywords-regexp
5289 (concat "\\<\\(" (regexp-opt vhdl-keywords
) "\\)\\>"))
5290 (setq vhdl-types-regexp
5291 (concat "\\<\\(" (regexp-opt vhdl-types
) "\\)\\>"))
5292 (setq vhdl-attributes-regexp
5293 (concat "\\<\\(" (regexp-opt vhdl-attributes
) "\\)\\>"))
5294 (setq vhdl-enum-values-regexp
5295 (concat "\\<\\(" (regexp-opt vhdl-enum-values
) "\\)\\>"))
5296 (setq vhdl-constants-regexp
5297 (concat "\\<\\(" (regexp-opt vhdl-constants
) "\\)\\>"))
5298 (setq vhdl-functions-regexp
5299 (concat "\\<\\(" (regexp-opt vhdl-functions
) "\\)\\>"))
5300 (setq vhdl-packages-regexp
5301 (concat "\\<\\(" (regexp-opt vhdl-packages
) "\\)\\>"))
5302 (setq vhdl-reserved-words-regexp
5304 (unless (equal vhdl-forbidden-syntax
"")
5305 (concat vhdl-forbidden-syntax
"\\|"))
5306 (regexp-opt vhdl-reserved-words
)
5308 (setq vhdl-directive-keywords-regexp
5309 (concat "\\<\\(" (mapconcat 'regexp-quote
5310 vhdl-directive-keywords
"\\|") "\\)\\>"))
5311 (vhdl-abbrev-list-init))
5313 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5316 (defvar vhdl-abbrev-list nil
5317 "Predefined abbreviations for VHDL.")
5319 (defun vhdl-abbrev-list-init ()
5320 (setq vhdl-abbrev-list
5322 (list vhdl-upper-case-keywords
) vhdl-keywords
5323 (list vhdl-upper-case-types
) vhdl-types
5324 (list vhdl-upper-case-attributes
) vhdl-attributes
5325 (list vhdl-upper-case-enum-values
) vhdl-enum-values
5326 (list vhdl-upper-case-constants
) vhdl-constants
5327 (list nil
) vhdl-functions
5328 (list nil
) vhdl-packages
)))
5330 ;; initialize reserved words for VHDL Mode
5334 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5336 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5338 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5341 ;; constant regular expressions for looking at various constructs
5343 (defconst vhdl-symbol-key
"\\(\\w\\|\\s_\\)+"
5344 "Regexp describing a VHDL symbol.
5345 We cannot use just `word' syntax class since `_' cannot be in word
5346 class. Putting underscore in word class breaks forward word movement
5347 behavior that users are familiar with.")
5349 (defconst vhdl-case-header-key
"case[( \t\n\r\f][^;=>]+[) \t\n\r\f]is"
5350 "Regexp describing a case statement header key.")
5352 (defconst vhdl-label-key
5353 (concat "\\(" vhdl-symbol-key
"\\s-*:\\)[^=]")
5354 "Regexp describing a VHDL label.")
5356 ;; Macro definitions:
5358 (defmacro vhdl-point
(position)
5359 "Return the value of point at certain commonly referenced POSITIONs.
5360 POSITION can be one of the following symbols:
5362 bol -- beginning of line
5364 bod -- beginning of defun
5365 boi -- back to indentation
5366 eoi -- last whitespace on line
5367 ionl -- indentation of next line
5368 iopl -- indentation of previous line
5369 bonl -- beginning of next line
5370 bopl -- beginning of previous line
5372 This function does not modify point or mark."
5373 (or (and (eq 'quote
(car-safe position
))
5374 (null (cddr position
)))
5375 (error "ERROR: Bad buffer position requested: %s" position
))
5376 (setq position
(nth 1 position
))
5377 `(let ((here (point)))
5379 ((eq position
'bol
) '((beginning-of-line)))
5380 ((eq position
'eol
) '((end-of-line)))
5381 ((eq position
'bod
) '((save-match-data
5382 (vhdl-beginning-of-defun))))
5383 ((eq position
'boi
) '((back-to-indentation)))
5384 ((eq position
'eoi
) '((end-of-line) (skip-chars-backward " \t")))
5385 ((eq position
'bonl
) '((forward-line 1)))
5386 ((eq position
'bopl
) '((forward-line -
1)))
5387 ((eq position
'iopl
)
5389 (back-to-indentation)))
5390 ((eq position
'ionl
)
5392 (back-to-indentation)))
5393 (t (error "ERROR: Unknown buffer position requested: %s" position
))
5398 ;; workaround for an Emacs18 bug -- blech! Well, at least it
5399 ;; doesn't hurt for v19
5403 (defmacro vhdl-safe
(&rest body
)
5404 "Safely execute BODY, return nil if an error occurred."
5405 `(condition-case nil
5409 (defmacro vhdl-add-syntax
(symbol &optional relpos
)
5410 "A simple macro to append the syntax in SYMBOL to the syntax list.
5411 Try to increase performance by using this macro."
5412 `(setq vhdl-syntactic-context
5413 (cons (cons ,symbol
,relpos
) vhdl-syntactic-context
)))
5415 (defmacro vhdl-has-syntax
(symbol)
5416 "A simple macro to return check the syntax list.
5417 Try to increase performance by using this macro."
5418 `(assoc ,symbol vhdl-syntactic-context
))
5420 ;; Syntactic element offset manipulation:
5422 (defun vhdl-read-offset (langelem)
5423 "Read new offset value for LANGELEM from minibuffer.
5424 Return a valid value only."
5425 (let ((oldoff (format "%s" (cdr-safe (assq langelem vhdl-offsets-alist
))))
5426 (errmsg "Offset must be int, func, var, or one of +, -, ++, --: ")
5428 offset input interned
)
5430 (setq input
(read-string prompt oldoff
)
5431 offset
(cond ((string-equal "+" input
) '+)
5432 ((string-equal "-" input
) '-
)
5433 ((string-equal "++" input
) '++)
5434 ((string-equal "--" input
) '--
)
5435 ((string-match "^-?[0-9]+$" input
)
5436 (string-to-number input
))
5437 ((fboundp (setq interned
(intern input
)))
5439 ((boundp interned
) interned
)
5440 ;; error, but don't signal one, keep trying
5441 ;; to read an input value
5443 (setq prompt errmsg
)
5447 (defun vhdl-set-offset (symbol offset
&optional add-p
)
5448 "Change the value of a syntactic element symbol in `vhdl-offsets-alist'.
5449 SYMBOL is the syntactic element symbol to change and OFFSET is the new
5450 offset for that syntactic element. Optional ADD-P says to add SYMBOL to
5451 `vhdl-offsets-alist' if it doesn't already appear there."
5454 (intern (completing-read
5455 (concat "Syntactic symbol to change"
5456 (if current-prefix-arg
" or add" "")
5461 (cons (format "%s" (car langelem
)) nil
)))
5463 nil
(not current-prefix-arg
)
5464 ;; initial contents tries to be the last element
5465 ;; on the syntactic analysis list for the current
5467 (let* ((syntax (vhdl-get-syntactic-context))
5468 (len (length syntax
))
5469 (ic (format "%s" (car (nth (1- len
) syntax
)))))
5472 (offset (vhdl-read-offset langelem
)))
5473 (list langelem offset current-prefix-arg
)))
5474 ;; sanity check offset
5482 (error "ERROR: Offset must be int, func, var, or one of +, -, ++, --: %s"
5484 (let ((entry (assq symbol vhdl-offsets-alist
)))
5486 (setcdr entry offset
)
5488 (setq vhdl-offsets-alist
5489 (cons (cons symbol offset
) vhdl-offsets-alist
))
5490 (error "ERROR: %s is not a valid syntactic symbol" symbol
))))
5491 (vhdl-keep-region-active))
5493 (defun vhdl-set-style (style &optional local
)
5494 "Set `vhdl-mode' variables to use one of several different indentation styles.
5495 STYLE is a string representing the desired style and optional LOCAL is
5496 a flag which, if non-nil, means to make the style variables being
5497 changed buffer local, instead of the default, which is to set the
5498 global variables. Interactively, the flag comes from the prefix
5499 argument. The styles are chosen from the `vhdl-style-alist' variable."
5500 (interactive (list (completing-read "Use which VHDL indentation style? "
5501 vhdl-style-alist nil t
)
5502 current-prefix-arg
))
5503 (let ((vars (cdr (assoc style vhdl-style-alist
))))
5505 (error "ERROR: Invalid VHDL indentation style `%s'" style
))
5506 ;; set all the variables
5510 (let ((var (car varentry
))
5511 (val (cdr varentry
)))
5512 ;; special case for vhdl-offsets-alist
5513 (if (not (eq var
'vhdl-offsets-alist
))
5514 (set (if local
(make-local-variable var
) var
) val
)
5515 ;; reset vhdl-offsets-alist to the default value first
5516 (set (if local
(make-local-variable var
) var
)
5517 (copy-alist vhdl-offsets-alist-default
))
5518 ;; now set the langelems that are different
5522 (let ((langelem (car langentry
))
5523 (offset (cdr langentry
)))
5524 (vhdl-set-offset langelem offset
)
5529 (vhdl-keep-region-active))
5531 (defun vhdl-get-offset (langelem)
5532 "Get offset from LANGELEM which is a cons cell of the form:
5533 \(SYMBOL . RELPOS). The symbol is matched against
5534 vhdl-offsets-alist and the offset found there is either returned,
5535 or added to the indentation at RELPOS. If RELPOS is nil, then
5536 the offset is simply returned."
5537 (let* ((symbol (car langelem
))
5538 (relpos (cdr langelem
))
5539 (match (assq symbol vhdl-offsets-alist
))
5540 (offset (cdr-safe match
)))
5541 ;; offset can be a number, a function, a variable, or one of the
5545 (if vhdl-strict-syntax-p
5546 (error "ERROR: Don't know how to indent a %s" symbol
)
5549 ((eq offset
'+) (setq offset vhdl-basic-offset
))
5550 ((eq offset
'-
) (setq offset
(- vhdl-basic-offset
)))
5551 ((eq offset
'++) (setq offset
(* 2 vhdl-basic-offset
)))
5552 ((eq offset
'--
) (setq offset
(* 2 (- vhdl-basic-offset
))))
5553 ((and (not (numberp offset
))
5555 (setq offset
(funcall offset langelem
)))
5556 ((not (numberp offset
))
5557 (setq offset
(eval offset
)))
5560 (< relpos
(vhdl-point 'bol
)))
5567 ;; Syntactic support functions:
5569 (defun vhdl-in-comment-p ()
5570 "Check if point is in a comment."
5571 (eq (vhdl-in-literal) 'comment
))
5573 (defun vhdl-in-string-p ()
5574 "Check if point is in a string."
5575 (eq (vhdl-in-literal) 'string
))
5577 (defun vhdl-in-quote-p ()
5578 "Check if point is in a quote ('x')."
5579 (or (and (> (point) (point-min))
5580 (< (1+ (point)) (point-max))
5581 (= (char-before (point)) ?
\')
5582 (= (char-after (1+ (point))) ?
\'))
5583 (and (> (1- (point)) (point-min))
5584 (< (point) (point-max))
5585 (= (char-before (1- (point))) ?
\')
5586 (= (char-after (point)) ?
\'))))
5588 (defun vhdl-in-literal ()
5589 "Determine if point is in a VHDL literal."
5591 (let ((state (parse-partial-sexp (vhdl-point 'bol
) (point))))
5593 ((nth 3 state
) 'string
)
5594 ((nth 4 state
) 'comment
)
5595 ((vhdl-beginning-of-macro) 'pound
)
5598 (defun vhdl-in-extended-identifier-p ()
5599 "Determine if point is inside extended identifier (delimited by '\')."
5601 (and (save-excursion (re-search-backward "\\\\" (vhdl-point 'bol
) t
))
5602 (save-excursion (re-search-forward "\\\\" (vhdl-point 'eol
) t
)))))
5604 (defun vhdl-forward-comment (&optional direction
)
5605 "Skip all comments (including whitespace). Skip backwards if DIRECTION is
5606 negative, skip forward otherwise."
5608 (if (and direction
(< direction
0))
5611 (skip-chars-backward " \t\n\r\f")
5612 (while (re-search-backward "^[^\"-]*\\(\\(-?\"[^\"]*\"\\|-[^\"-]\\)[^\"-]*\\)*\\(--\\)" (vhdl-point 'bol
) t
)
5613 (goto-char (match-beginning 3))
5614 (skip-chars-backward " \t\n\r\f")))
5616 (skip-chars-forward " \t\n\r\f")
5617 (while (looking-at "--.*")
5618 (goto-char (match-end 0))
5619 (skip-chars-forward " \t\n\r\f"))))
5621 ;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+
5622 (unless (and (featurep 'xemacs
) (string< "21.2" emacs-version
))
5623 (defalias 'vhdl-forward-comment
'forward-comment
))
5625 (defun vhdl-back-to-indentation ()
5626 "Move point to the first non-whitespace character on this line."
5628 (beginning-of-line 1)
5629 (skip-syntax-forward " " (vhdl-point 'eol
)))
5631 ;; XEmacs hack: work around old `back-to-indentation' in XEmacs
5632 (when (featurep 'xemacs
)
5633 (defalias 'back-to-indentation
'vhdl-back-to-indentation
))
5635 ;; This is the best we can do in Win-Emacs.
5636 (defun vhdl-win-il (&optional lim
)
5637 "Determine if point is in a VHDL literal."
5639 (let* ((here (point))
5642 (lim (or lim
(vhdl-point 'bod
))))
5644 (while (< (point) here
)
5646 (and (re-search-forward "--\\|[\"']"
5648 (buffer-substring (match-beginning 0) (match-end 0))))
5653 ;; looking at the opening of a VHDL style comment
5654 ((string= "--" match
)
5655 (if (<= here
(progn (end-of-line) (point))) 'comment
))
5656 ;; looking at the opening of a double quote string
5657 ((string= "\"" match
)
5658 (if (not (save-restriction
5659 ;; this seems to be necessary since the
5660 ;; re-search-forward will not work without it
5661 (narrow-to-region (point) here
)
5663 ;; this regexp matches a double quote
5664 ;; which is preceded by an even number
5665 ;; of backslashes, including zero
5666 "\\([^\\]\\|^\\)\\(\\\\\\\\\\)*\"" here
'move
)))
5668 ;; looking at the opening of a single quote string
5669 ((string= "'" match
)
5670 (if (not (save-restriction
5671 ;; see comments from above
5672 (narrow-to-region (point) here
)
5674 ;; this matches a single quote which is
5675 ;; preceded by zero or two backslashes.
5676 "\\([^\\]\\|^\\)\\(\\\\\\\\\\)?'"
5683 (and (string-match "Win-Emacs" emacs-version
)
5684 (fset 'vhdl-in-literal
'vhdl-win-il
))
5686 ;; Skipping of "syntactic whitespace". Syntactic whitespace is
5687 ;; defined as lexical whitespace or comments. Search no farther back
5688 ;; or forward than optional LIM. If LIM is omitted, (point-min) is
5689 ;; used for backward skipping, (point-max) is used for forward
5692 (defun vhdl-forward-syntactic-ws (&optional lim
)
5693 "Forward skip of syntactic whitespace."
5694 (let* ((here (point-max))
5695 (hugenum (point-max)))
5696 (while (/= here
(point))
5698 (vhdl-forward-comment hugenum
)
5699 ;; skip preprocessor directives
5700 (when (and (eq (char-after) ?
#)
5701 (= (vhdl-point 'boi
) (point)))
5702 (while (and (eq (char-before (vhdl-point 'eol
)) ?
\\)
5703 (= (forward-line 1) 0)))
5705 (if lim
(goto-char (min (point) lim
)))))
5708 ;; This is the best we can do in Win-Emacs.
5709 (defun vhdl-win-fsws (&optional lim
)
5710 "Forward skip syntactic whitespace for Win-Emacs."
5711 (let ((lim (or lim
(point-max)))
5714 (skip-chars-forward " \t\n\r\f" lim
)
5717 ((looking-at "--") (end-of-line))
5718 ;; none of the above
5719 (t (setq stop t
))))))
5721 (and (string-match "Win-Emacs" emacs-version
)
5722 (fset 'vhdl-forward-syntactic-ws
'vhdl-win-fsws
))
5724 (defun vhdl-beginning-of-macro (&optional lim
)
5725 "Go to the beginning of a cpp macro definition (nicked from `cc-engine')."
5726 (let ((here (point)))
5728 (while (eq (char-before (1- (point))) ?
\\)
5730 (back-to-indentation)
5731 (if (and (<= (point) here
)
5732 (eq (char-after) ?
#))
5737 (defun vhdl-backward-syntactic-ws (&optional lim
)
5738 "Backward skip over syntactic whitespace."
5739 (let* ((here (point-min))
5740 (hugenum (- (point-max))))
5741 (while (/= here
(point))
5743 (vhdl-forward-comment hugenum
)
5744 (vhdl-beginning-of-macro))
5745 (if lim
(goto-char (max (point) lim
)))))
5747 ;; This is the best we can do in Win-Emacs.
5748 (defun vhdl-win-bsws (&optional lim
)
5749 "Backward skip syntactic whitespace for Win-Emacs."
5750 (let ((lim (or lim
(vhdl-point 'bod
)))
5753 (skip-chars-backward " \t\n\r\f" lim
)
5756 ((eq (vhdl-in-literal) 'comment
)
5757 (skip-chars-backward "^-" lim
)
5758 (skip-chars-backward "-" lim
)
5759 (while (not (or (and (= (following-char) ?-
)
5760 (= (char-after (1+ (point))) ?-
))
5762 (skip-chars-backward "^-" lim
)
5763 (skip-chars-backward "-" lim
)))
5764 ;; none of the above
5765 (t (setq stop t
))))))
5767 (and (string-match "Win-Emacs" emacs-version
)
5768 (fset 'vhdl-backward-syntactic-ws
'vhdl-win-bsws
))
5770 ;; Functions to help finding the correct indentation column:
5772 (defun vhdl-first-word (point)
5773 "If the keyword at POINT is at boi, then return (current-column) at
5774 that point, else nil."
5776 (and (goto-char point
)
5777 (eq (point) (vhdl-point 'boi
))
5780 (defun vhdl-last-word (point)
5781 "If the keyword at POINT is at eoi, then return (current-column) at
5782 that point, else nil."
5784 (and (goto-char point
)
5785 (save-excursion (or (eq (progn (forward-sexp) (point))
5787 (looking-at "\\s-*\\(--\\)?")))
5790 ;; Core syntactic evaluation functions:
5792 (defconst vhdl-libunit-re
5793 "\\b\\(architecture\\|configuration\\|entity\\|package\\)\\b[^_]")
5795 (defun vhdl-libunit-p ()
5799 (skip-chars-forward " \t\n\r\f")
5800 (not (looking-at "is\\b[^_]")))
5803 (and (not (looking-at "use\\b[^_]"))
5806 (vhdl-forward-syntactic-ws)
5807 (/= (following-char) ?
:))))
5810 (defconst vhdl-defun-re
5811 "\\b\\(architecture\\|block\\|configuration\\|entity\\|package\\|process\\|procedural\\|procedure\\|function\\)\\b[^_]")
5813 (defun vhdl-defun-p ()
5815 (if (looking-at "block\\|process\\|procedural")
5816 ;; "block", "process", "procedural":
5819 (not (looking-at "end\\s-+\\w")))
5820 ;; "architecture", "configuration", "entity",
5821 ;; "package", "procedure", "function":
5824 (defun vhdl-corresponding-defun ()
5825 "If the word at the current position corresponds to a \"defun\"
5826 keyword, then return a string that can be used to find the
5827 corresponding \"begin\" keyword, else return nil."
5829 (and (looking-at vhdl-defun-re
)
5831 (if (looking-at "block\\|process\\|procedural")
5832 ;; "block", "process". "procedural:
5833 (buffer-substring (match-beginning 0) (match-end 0))
5834 ;; "architecture", "configuration", "entity", "package",
5835 ;; "procedure", "function":
5838 (defconst vhdl-begin-fwd-re
5839 "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|protected\\(\\s-+body\\)?\\|for\\)\\b\\([^_]\\|\\'\\)"
5840 "A regular expression for searching forward that matches all known
5841 \"begin\" keywords.")
5843 (defconst vhdl-begin-bwd-re
5844 "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|protected\\(\\s-+body\\)?\\|for\\)\\b[^_]"
5845 "A regular expression for searching backward that matches all known
5846 \"begin\" keywords.")
5848 (defun vhdl-begin-p (&optional lim
)
5849 "Return t if we are looking at a real \"begin\" keyword.
5850 Assumes that the caller will make sure that we are looking at
5851 vhdl-begin-fwd-re, and are not inside a literal, and that we are not in
5852 the middle of an identifier that just happens to contain a \"begin\"
5855 ;; "[architecture|case|configuration|entity|package|
5856 ;; procedure|function] ... is":
5857 ((and (looking-at "i")
5859 ;; Skip backward over first sexp (needed to skip over a
5860 ;; procedure interface list, and is harmless in other
5861 ;; situations). Note that we need "return" in the
5862 ;; following search list so that we don't run into
5863 ;; semicolons in the function interface list.
5866 (while (and (not foundp
)
5868 ";\\|\\b\\(architecture\\|case\\|configuration\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|procedural\\|block\\)\\b[^_]"
5870 (if (or (= (preceding-char) ?_
)
5874 (and (/= (following-char) ?\
;)
5875 (not (looking-at "is\\|begin\\|process\\|procedural\\|block")))))
5877 ;; "begin", "then", "use":
5878 ((looking-at "be\\|t\\|use")
5881 ((and (looking-at "e")
5882 ;; make sure that the "else" isn't inside a
5883 ;; conditional signal assignment.
5885 (vhdl-re-search-backward ";\\|\\bwhen\\b[^_]" lim
'move
)
5886 (or (eq (following-char) ?\
;)
5889 ;; "block", "generate", "loop", "process", "procedural",
5890 ;; "units", "record", "protected body":
5891 ((and (looking-at "block\\|generate\\|loop\\|process\\|procedural\\|protected\\(\\s-+body\\)?\\|units\\|record")
5894 (not (looking-at "end\\s-+\\w"))))
5897 ((and (looking-at "c")
5900 (not (looking-at "end\\s-+\\w")))
5901 ;; look out for the dreaded entity class in an attribute
5903 (vhdl-backward-syntactic-ws lim
)
5904 (/= (preceding-char) ?
:)))
5906 ;; "for" (inside configuration declaration):
5907 ((and (looking-at "f")
5910 (not (looking-at "end\\s-+\\w")))
5911 (vhdl-has-syntax 'configuration
))
5915 (defun vhdl-corresponding-mid (&optional lim
)
5917 ((looking-at "is\\|block\\|generate\\|process\\|procedural")
5919 ((looking-at "then\\|use")
5924 (defun vhdl-corresponding-end (&optional lim
)
5925 "If the word at the current position corresponds to a \"begin\"
5926 keyword, then return a vector containing enough information to find
5927 the corresponding \"end\" keyword, else return nil. The keyword to
5928 search forward for is aref 0. The column in which the keyword must
5929 appear is aref 1 or nil if any column is suitable.
5930 Assumes that the caller will make sure that we are not in the middle
5931 of an identifier that just happens to contain a \"begin\" keyword."
5933 (and (looking-at vhdl-begin-fwd-re
)
5934 (or (not (looking-at "\\<use\\>"))
5935 (save-excursion (back-to-indentation)
5936 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
5937 (/= (preceding-char) ?_
)
5938 (not (vhdl-in-literal))
5941 ;; "is", "generate", "loop":
5942 ((looking-at "[igl]")
5944 (and (vhdl-last-word (point))
5945 (or (vhdl-first-word (point))
5947 (vhdl-beginning-of-statement-1 lim
)
5948 (vhdl-backward-skip-label lim
)
5949 (vhdl-first-word (point)))))))
5950 ;; "begin", "else", "for":
5951 ((looking-at "be\\|[ef]")
5953 (and (vhdl-last-word (point))
5954 (or (vhdl-first-word (point))
5956 (vhdl-beginning-of-statement-1 lim
)
5957 (vhdl-backward-skip-label lim
)
5958 (vhdl-first-word (point)))))))
5959 ;; "component", "units", "record", "protected body":
5960 ((looking-at "component\\|units\\|protected\\(\\s-+body\\)?\\|record")
5961 ;; The first end found will close the block
5963 ;; "block", "process", "procedural":
5964 ((looking-at "bl\\|p")
5966 (or (vhdl-first-word (point))
5968 (vhdl-beginning-of-statement-1 lim
)
5969 (vhdl-backward-skip-label lim
)
5970 (vhdl-first-word (point))))))
5972 ((looking-at "t\\|use")
5973 (vector "elsif\\|else\\|end\\s-+\\(if\\|use\\)"
5974 (and (vhdl-last-word (point))
5975 (or (vhdl-first-word (point))
5977 (vhdl-beginning-of-statement-1 lim
)
5978 (vhdl-backward-skip-label lim
)
5979 (vhdl-first-word (point)))))))
5982 (defconst vhdl-end-fwd-re
"\\b\\(end\\|else\\|elsif\\)\\b\\([^_]\\|\\'\\)")
5984 (defconst vhdl-end-bwd-re
"\\b\\(end\\|else\\|elsif\\)\\b[^_]")
5986 (defun vhdl-end-p (&optional lim
)
5987 "Return t if we are looking at a real \"end\" keyword.
5988 Assumes that the caller will make sure that we are looking at
5989 vhdl-end-fwd-re, and are not inside a literal, and that we are not in
5990 the middle of an identifier that just happens to contain an \"end\"
5992 (or (not (looking-at "else"))
5993 ;; make sure that the "else" isn't inside a conditional signal
5996 (re-search-backward ";\\|\\bwhen\\b[^_]" lim
'move
)
5997 (or (eq (following-char) ?\
;)
5999 (vhdl-in-literal)))))
6001 (defun vhdl-corresponding-begin (&optional lim
)
6002 "If the word at the current position corresponds to an \"end\"
6003 keyword, then return a vector containing enough information to find
6004 the corresponding \"begin\" keyword, else return nil. The keyword to
6005 search backward for is aref 0. The column in which the keyword must
6006 appear is aref 1 or nil if any column is suitable. The supplementary
6007 keyword to search forward for is aref 2 or nil if this is not
6008 required. If aref 3 is t, then the \"begin\" keyword may be found in
6009 the middle of a statement.
6010 Assumes that the caller will make sure that we are not in the middle
6011 of an identifier that just happens to contain an \"end\" keyword."
6014 (if (and (looking-at vhdl-end-fwd-re
)
6015 (not (vhdl-in-literal))
6017 (if (looking-at "el")
6019 (vector "if\\|elsif" (vhdl-first-word (point)) "then\\|use" nil
)
6023 (skip-chars-forward " \t\n\r\f")
6026 ((looking-at "if\\b[^_]")
6027 (vector "else\\|elsif\\|if"
6028 (vhdl-first-word pos
)
6029 "else\\|then\\|use" nil
))
6031 ((looking-at "component\\b[^_]")
6032 (vector (buffer-substring (match-beginning 1)
6034 (vhdl-first-word pos
)
6036 ;; "end units", "end record", "end protected":
6037 ((looking-at "\\(units\\|record\\|protected\\(\\s-+body\\)?\\)\\b[^_]")
6038 (vector (buffer-substring (match-beginning 1)
6040 (vhdl-first-word pos
)
6042 ;; "end block", "end process", "end procedural":
6043 ((looking-at "\\(block\\|process\\|procedural\\)\\b[^_]")
6044 (vector "begin" (vhdl-first-word pos
) nil nil
))
6046 ((looking-at "case\\b[^_]")
6047 (vector "case" (vhdl-first-word pos
) "is" nil
))
6049 ((looking-at "generate\\b[^_]")
6050 (vector "generate\\|for\\|if"
6051 (vhdl-first-word pos
)
6054 ((looking-at "loop\\b[^_]")
6055 (vector "loop\\|while\\|for"
6056 (vhdl-first-word pos
)
6058 ;; "end for" (inside configuration declaration):
6059 ((looking-at "for\\b[^_]")
6060 (vector "for" (vhdl-first-word pos
) nil nil
))
6063 (vector "begin\\|architecture\\|configuration\\|entity\\|package\\|procedure\\|function"
6064 (vhdl-first-word pos
)
6065 ;; return an alist of (statement . keyword) mappings
6067 ;; "begin ... end [id]":
6069 ;; "architecture ... is ... begin ... end [id]":
6070 ("architecture" .
"is")
6071 ;; "configuration ... is ... end [id]":
6072 ("configuration" .
"is")
6073 ;; "entity ... is ... end [id]":
6075 ;; "package ... is ... end [id]":
6077 ;; "procedure ... is ... begin ... end [id]":
6078 ("procedure" .
"is")
6079 ;; "function ... is ... begin ... end [id]":
6086 (defconst vhdl-leader-re
6087 "\\b\\(block\\|component\\|process\\|procedural\\|for\\)\\b[^_]")
6089 (defun vhdl-end-of-leader ()
6091 (cond ((looking-at "block\\|process\\|procedural")
6094 (skip-chars-forward " \t\n\r\f")
6095 (= (following-char) ?\
())
6098 (when (looking-at "[ \t\n\r\f]*is")
6099 (goto-char (match-end 0)))
6101 ((looking-at "component")
6103 (when (looking-at "[ \t\n\r\f]*is")
6104 (goto-char (match-end 0)))
6108 (skip-chars-forward " \t\n\r\f")
6109 (while (looking-at "[,:(]")
6111 (skip-chars-forward " \t\n\r\f"))
6116 (defconst vhdl-trailer-re
6117 "\\b\\(is\\|then\\|generate\\|loop\\|record\\|protected\\(\\s-+body\\)?\\|use\\)\\b[^_]")
6119 (defconst vhdl-statement-fwd-re
6120 "\\b\\(if\\|for\\|while\\|loop\\)\\b\\([^_]\\|\\'\\)"
6121 "A regular expression for searching forward that matches all known
6122 \"statement\" keywords.")
6124 (defconst vhdl-statement-bwd-re
6125 "\\b\\(if\\|for\\|while\\|loop\\)\\b[^_]"
6126 "A regular expression for searching backward that matches all known
6127 \"statement\" keywords.")
6129 (defun vhdl-statement-p (&optional lim
)
6130 "Return t if we are looking at a real \"statement\" keyword.
6131 Assumes that the caller will make sure that we are looking at
6132 vhdl-statement-fwd-re, and are not inside a literal, and that we are not
6133 in the middle of an identifier that just happens to contain a
6134 \"statement\" keyword."
6136 ;; "for" ... "generate":
6137 ((and (looking-at "f")
6138 ;; Make sure it's the start of a parameter specification.
6141 (skip-chars-forward " \t\n\r\f")
6142 (looking-at "in\\b[^_]"))
6143 ;; Make sure it's not an "end for".
6146 (not (looking-at "end\\s-+\\w"))))
6148 ;; "if" ... "then", "if" ... "generate", "if" ... "loop":
6149 ((and (looking-at "i")
6150 ;; Make sure it's not an "end if".
6153 (not (looking-at "end\\s-+\\w"))))
6155 ;; "while" ... "loop":
6160 (defconst vhdl-case-alternative-re
"when[( \t\n\r\f][^;=>]+=>"
6161 "Regexp describing a case statement alternative key.")
6163 (defun vhdl-case-alternative-p (&optional lim
)
6164 "Return t if we are looking at a real case alternative.
6165 Assumes that the caller will make sure that we are looking at
6166 vhdl-case-alternative-re, and are not inside a literal, and that
6167 we are not in the middle of an identifier that just happens to
6168 contain a \"when\" keyword."
6171 (while (and (not foundp
)
6172 (re-search-backward ";\\|<=" lim
'move
))
6173 (if (or (= (preceding-char) ?_
)
6177 (or (eq (following-char) ?\
;)
6181 ;; Core syntactic movement functions:
6183 (defconst vhdl-b-t-b-re
6184 (concat vhdl-begin-bwd-re
"\\|" vhdl-end-bwd-re
))
6186 (defun vhdl-backward-to-block (&optional lim
)
6187 "Move backward to the previous \"begin\" or \"end\" keyword."
6189 (while (and (not foundp
)
6190 (re-search-backward vhdl-b-t-b-re lim
'move
))
6191 (if (or (= (preceding-char) ?_
)
6196 ((and (looking-at vhdl-begin-fwd-re
)
6197 (or (not (looking-at "\\<use\\>"))
6198 (save-excursion (back-to-indentation)
6199 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
6200 (/= (preceding-char) ?_
)
6202 (setq foundp
'begin
))
6204 ((and (looking-at vhdl-end-fwd-re
)
6205 (/= (preceding-char) ?_
)
6213 (defun vhdl-forward-sexp (&optional count lim
)
6214 "Move forward across one balanced expression (sexp).
6215 With COUNT, do it that many times."
6217 (let ((count (or count
1))
6218 (case-fold-search t
)
6223 (skip-chars-forward " \t\n\r\f")
6224 ;; Check for an unbalanced "end" keyword
6225 (if (and (looking-at vhdl-end-fwd-re
)
6226 (/= (preceding-char) ?_
)
6227 (not (vhdl-in-literal))
6229 (not (looking-at "else")))
6231 "ERROR: Containing expression ends prematurely in vhdl-forward-sexp"))
6232 ;; If the current keyword is a "begin" keyword, then find the
6233 ;; corresponding "end" keyword.
6234 (if (setq end-vec
(vhdl-corresponding-end lim
))
6236 ;; end-re is the statement keyword to search for
6238 (concat "\\b\\(" (aref end-vec
0) "\\)\\b\\([^_]\\|\\'\\)"))
6239 ;; column is either the statement keyword target column
6241 (column (aref end-vec
1))
6242 (eol (vhdl-point 'eol
))
6243 foundp literal placeholder
)
6244 ;; Look for the statement keyword.
6245 (while (and (not foundp
)
6246 (re-search-forward end-re nil t
)
6247 (setq placeholder
(match-end 1))
6248 (goto-char (match-beginning 0)))
6249 ;; If we are in a literal, or not in the right target
6250 ;; column and not on the same line as the begin, then
6253 (/= (current-indentation) column
)
6255 (= (preceding-char) ?_
)
6256 (setq literal
(vhdl-in-literal)))
6257 (if (eq literal
'comment
)
6260 ;; An "else" keyword corresponds to both the opening brace
6261 ;; of the following sexp and the closing brace of the
6263 (if (not (looking-at "else"))
6264 (goto-char placeholder
))
6268 (error "ERROR: Unbalanced keywords in vhdl-forward-sexp"))
6270 ;; If the current keyword is not a "begin" keyword, then just
6271 ;; perform the normal forward-sexp.
6274 (setq count
(1- count
))
6276 (setq target
(point)))
6280 (defun vhdl-backward-sexp (&optional count lim
)
6281 "Move backward across one balanced expression (sexp).
6282 With COUNT, do it that many times. LIM bounds any required backward
6285 (let ((count (or count
1))
6286 (case-fold-search t
)
6290 ;; Perform the normal backward-sexp, unless we are looking at
6291 ;; "else" - an "else" keyword corresponds to both the opening brace
6292 ;; of the following sexp and the closing brace of the previous sexp.
6293 (if (and (looking-at "else\\b\\([^_]\\|\\'\\)")
6294 (/= (preceding-char) ?_
)
6295 (not (vhdl-in-literal)))
6298 (if (and (looking-at vhdl-begin-fwd-re
)
6299 (or (not (looking-at "\\<use\\>"))
6301 (back-to-indentation)
6302 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
6303 (/= (preceding-char) ?_
)
6304 (not (vhdl-in-literal))
6306 (error "ERROR: Containing expression ends prematurely in vhdl-backward-sexp")))
6307 ;; If the current keyword is an "end" keyword, then find the
6308 ;; corresponding "begin" keyword.
6309 (if (and (setq begin-vec
(vhdl-corresponding-begin lim
))
6310 (/= (preceding-char) ?_
))
6312 ;; begin-re is the statement keyword to search for
6314 (concat "\\b\\(" (aref begin-vec
0) "\\)\\b[^_]"))
6315 ;; column is either the statement keyword target column
6317 (column (aref begin-vec
1))
6318 ;; internal-p controls where the statement keyword can
6320 (internal-p (aref begin-vec
3))
6321 (last-backward (point)) last-forward
6322 foundp literal keyword
)
6323 ;; Look for the statement keyword.
6324 (while (and (not foundp
)
6325 (re-search-backward begin-re lim t
)
6327 (buffer-substring (match-beginning 1)
6329 ;; If we are in a literal or in the wrong column,
6332 (and (/= (current-indentation) column
)
6333 ;; possibly accept current-column as
6334 ;; well as current-indentation.
6335 (or (not internal-p
)
6336 (/= (current-column) column
))))
6337 (= (preceding-char) ?_
)
6340 ;; If there is a supplementary keyword, then
6341 ;; search forward for it.
6342 (if (and (setq begin-re
(aref begin-vec
2))
6343 (or (not (listp begin-re
))
6344 ;; If begin-re is an alist, then find the
6345 ;; element corresponding to the actual
6346 ;; keyword that we found.
6349 (assoc keyword begin-re
))
6351 (setq begin-re
(cdr begin-re
))))))
6354 (concat "\\b\\(" begin-re
"\\)\\b[^_]"))
6356 (setq last-forward
(point))
6357 ;; Look for the supplementary keyword
6358 ;; (bounded by the backward search start
6360 (while (and (not foundp
)
6361 (re-search-forward begin-re
6363 (goto-char (match-beginning 1)))
6364 ;; If we are in a literal, then try again.
6365 (if (or (= (preceding-char) ?_
)
6368 (if (eq literal
'comment
)
6370 (min (vhdl-point 'eol
) last-backward
))
6372 ;; We have found the supplementary keyword.
6373 ;; Save the position of the keyword in foundp.
6374 (setq foundp
(point)))
6377 ;; If the supplementary keyword was found, then
6378 ;; move point to the supplementary keyword.
6380 ;; If there was no supplementary keyword, then
6381 ;; point is already at the statement keyword.
6383 ) ; end of the search for the statement keyword
6385 (error "ERROR: Unbalanced keywords in vhdl-backward-sexp"))
6387 (setq count
(1- count
))
6389 (setq target
(point)))
6393 (defun vhdl-backward-up-list (&optional count limit
)
6394 "Move backward out of one level of blocks.
6395 With argument, do this that many times."
6397 (let ((count (or count
1))
6401 (if (looking-at vhdl-defun-re
)
6402 (error "ERROR: Unbalanced blocks"))
6403 (vhdl-backward-to-block limit
)
6404 (setq count
(1- count
)))
6405 (setq target
(point)))
6406 (goto-char target
)))
6408 (defun vhdl-end-of-defun (&optional count
)
6409 "Move forward to the end of a VHDL defun."
6411 (let ((case-fold-search t
))
6412 (vhdl-beginning-of-defun)
6413 (if (not (looking-at "block\\|process\\|procedural"))
6414 (re-search-forward "\\bis\\b"))
6415 (vhdl-forward-sexp)))
6417 (defun vhdl-mark-defun ()
6418 "Put mark at end of this \"defun\", point at beginning."
6420 (let ((case-fold-search t
))
6422 (vhdl-beginning-of-defun)
6424 (if (not (looking-at "block\\|process\\|procedural"))
6425 (re-search-forward "\\bis\\b"))
6427 (exchange-point-and-mark)))
6429 (defun vhdl-beginning-of-libunit ()
6430 "Move backward to the beginning of a VHDL library unit.
6431 Returns the location of the corresponding begin keyword, unless search
6432 stops due to beginning or end of buffer.
6433 Note that if point is between the \"libunit\" keyword and the
6434 corresponding \"begin\" keyword, then that libunit will not be
6435 recognized, and the search will continue backwards. If point is
6436 at the \"begin\" keyword, then the defun will be recognized. The
6437 returned point is at the first character of the \"libunit\" keyword."
6438 (let ((last-forward (point))
6440 ;; Just in case we are actually sitting on the "begin"
6441 ;; keyword, allow for the keyword and an extra character,
6442 ;; as this will be used when looking forward for the
6444 (save-excursion (forward-word 1) (1+ (point))))
6445 foundp literal placeholder
)
6446 ;; Find the "libunit" keyword.
6447 (while (and (not foundp
)
6448 (re-search-backward vhdl-libunit-re nil
'move
))
6449 ;; If we are in a literal, or not at a real libunit, then try again.
6450 (if (or (= (preceding-char) ?_
)
6452 (not (vhdl-libunit-p)))
6454 ;; Find the corresponding "begin" keyword.
6455 (setq last-forward
(point))
6456 (while (and (not foundp
)
6457 (re-search-forward "\\bis\\b[^_]" last-backward t
)
6458 (setq placeholder
(match-beginning 0)))
6459 (if (or (= (preceding-char) ?_
)
6460 (setq literal
(vhdl-in-literal)))
6461 ;; It wasn't a real keyword, so keep searching.
6462 (if (eq literal
'comment
)
6464 (min (vhdl-point 'eol
) last-backward
))
6466 ;; We have found the begin keyword, loop will exit.
6467 (setq foundp placeholder
)))
6468 ;; Go back to the libunit keyword
6469 (goto-char last-forward
)))
6472 (defun vhdl-beginning-of-defun (&optional count
)
6473 "Move backward to the beginning of a VHDL defun.
6474 With argument, do it that many times.
6475 Returns the location of the corresponding begin keyword, unless search
6476 stops due to beginning or end of buffer."
6477 ;; Note that if point is between the "defun" keyword and the
6478 ;; corresponding "begin" keyword, then that defun will not be
6479 ;; recognized, and the search will continue backwards. If point is
6480 ;; at the "begin" keyword, then the defun will be recognized. The
6481 ;; returned point is at the first character of the "defun" keyword.
6483 (let ((count (or count
1))
6484 (case-fold-search t
)
6485 (last-forward (point))
6489 (goto-char last-forward
)
6490 (let ((last-backward
6491 ;; Just in case we are actually sitting on the "begin"
6492 ;; keyword, allow for the keyword and an extra character,
6493 ;; as this will be used when looking forward for the
6495 (save-excursion (forward-word 1) (1+ (point))))
6496 begin-string literal
)
6497 (while (and (not foundp
)
6498 (re-search-backward vhdl-defun-re nil
'move
))
6499 ;; If we are in a literal, then try again.
6500 (if (or (= (preceding-char) ?_
)
6503 (if (setq begin-string
(vhdl-corresponding-defun))
6504 ;; This is a real defun keyword.
6505 ;; Find the corresponding "begin" keyword.
6506 ;; Look for the begin keyword.
6508 ;; Save the search start point.
6509 (setq last-forward
(point))
6510 (while (and (not foundp
)
6511 (search-forward begin-string last-backward t
))
6512 (if (or (= (preceding-char) ?_
)
6514 (setq literal
(vhdl-in-literal))))
6515 ;; It wasn't a real keyword, so keep searching.
6516 (if (eq literal
'comment
)
6518 (min (vhdl-point 'eol
) last-backward
))
6520 ;; We have found the begin keyword, loop will exit.
6521 (setq foundp
(match-beginning 0)))
6523 ;; Go back to the defun keyword
6524 (goto-char last-forward
)) ; end search for begin keyword
6526 ) ; end of the search for the defun keyword
6528 (setq count
(1- count
))
6530 (vhdl-keep-region-active)
6533 (defun vhdl-beginning-of-statement (&optional count lim interactive
)
6534 "Go to the beginning of the innermost VHDL statement.
6535 With prefix arg, go back N - 1 statements. If already at the
6536 beginning of a statement then go to the beginning of the preceding
6537 one. If within a string or comment, or next to a comment (only
6538 whitespace between), move by sentences instead of statements.
6540 When called from a program, this function takes 3 optional args: the
6541 prefix arg, a buffer position limit which is the farthest back to
6542 search, and an argument indicating an interactive call."
6543 (interactive "p\np")
6544 (let ((count (or count
1))
6545 (case-fold-search t
)
6546 (lim (or lim
(point-min)))
6551 (setq state
(parse-partial-sexp (point) here nil nil
)))
6552 (if (and interactive
6555 (looking-at (concat "[ \t]*" comment-start-skip
))))
6556 (forward-sentence (- count
))
6558 (vhdl-beginning-of-statement-1 lim
)
6559 (setq count
(1- count
))))
6560 ;; its possible we've been left up-buf of lim
6561 (goto-char (max (point) lim
))
6563 (vhdl-keep-region-active))
6565 (defconst vhdl-e-o-s-re
6566 (concat ";\\|" vhdl-begin-fwd-re
"\\|" vhdl-statement-fwd-re
))
6568 (defun vhdl-end-of-statement ()
6569 "Very simple implementation."
6571 (re-search-forward vhdl-e-o-s-re
))
6573 (defconst vhdl-b-o-s-re
6574 (concat ";[^_]\\|\([^_]\\|\)[^_]\\|\\bwhen\\b[^_]\\|"
6575 vhdl-begin-bwd-re
"\\|" vhdl-statement-bwd-re
))
6577 (defun vhdl-beginning-of-statement-1 (&optional lim
)
6578 "Move to the start of the current statement, or the previous
6579 statement if already at the beginning of one."
6580 (let ((lim (or lim
(point-min)))
6584 ;; go backwards one balanced expression, but be careful of
6585 ;; unbalanced paren being reached
6586 (if (not (vhdl-safe (progn (backward-sexp) t
)))
6588 (backward-up-list 1)
6590 (vhdl-forward-syntactic-ws here
)
6592 (while (and (not donep
)
6594 ;; look backwards for a statement boundary
6595 (progn (forward-char) (re-search-backward vhdl-b-o-s-re lim
'move
)))
6596 (if (or (= (preceding-char) ?_
)
6600 ;; If we are looking at an open paren, then stop after it
6601 ((eq (following-char) ?\
()
6603 (vhdl-forward-syntactic-ws here
)
6605 ;; If we are looking at a close paren, then skip it
6606 ((eq (following-char) ?\
))
6611 (progn (goto-char pos
)
6612 (vhdl-forward-syntactic-ws here
)
6614 ;; If we are looking at a semicolon, then stop
6615 ((and (eq (following-char) ?\
;) (not (vhdl-in-quote-p)))
6618 (vhdl-forward-syntactic-ws here
)
6620 ;; If we are looking at a "begin", then stop
6621 ((and (looking-at vhdl-begin-fwd-re
)
6622 (or (not (looking-at "\\<use\\>"))
6624 (back-to-indentation)
6625 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
6626 (/= (preceding-char) ?_
)
6628 ;; If it's a leader "begin", then find the
6630 (if (looking-at vhdl-leader-re
)
6632 ;; set a default stop point at the begin
6634 ;; is the start point inside the leader area ?
6635 (goto-char (vhdl-end-of-leader))
6636 (vhdl-forward-syntactic-ws here
)
6637 (if (< (point) here
)
6638 ;; start point was not inside leader area
6639 ;; set stop point at word after leader
6640 (setq pos
(point))))
6642 (vhdl-forward-syntactic-ws here
)
6646 ;; If we are looking at a "statement", then stop
6647 ((and (looking-at vhdl-statement-fwd-re
)
6648 (/= (preceding-char) ?_
)
6649 (vhdl-statement-p nil
))
6651 ;; If we are looking at a case alternative key, then stop
6652 ((and (looking-at vhdl-case-alternative-re
)
6653 (vhdl-case-alternative-p lim
))
6655 ;; set a default stop point at the when
6657 ;; is the start point inside the case alternative key ?
6658 (looking-at vhdl-case-alternative-re
)
6659 (goto-char (match-end 0))
6660 (vhdl-forward-syntactic-ws here
)
6661 (if (< (point) here
)
6662 ;; start point was not inside the case alternative key
6663 ;; set stop point at word after case alternative keyleader
6664 (setq pos
(point))))
6667 ;; Bogus find, continue
6672 ;; Defuns for calculating the current syntactic state:
6674 (defun vhdl-get-library-unit (bod placeholder
)
6675 "If there is an enclosing library unit at BOD, with its \"begin\"
6676 keyword at PLACEHOLDER, then return the library unit type."
6677 (let ((here (vhdl-point 'bol
)))
6679 (goto-char placeholder
)
6680 (vhdl-safe (vhdl-forward-sexp 1 bod
))
6685 ((looking-at "e") 'entity
)
6686 ((looking-at "a") 'architecture
)
6687 ((looking-at "c") 'configuration
)
6692 (vhdl-forward-syntactic-ws here
)
6693 (if (looking-at "body\\b[^_]")
6694 'package-body
'package
))))))
6697 (defun vhdl-get-block-state (&optional lim
)
6698 "Finds and records all the closest opens.
6699 LIM is the furthest back we need to search (it should be the
6700 previous libunit keyword)."
6701 (let ((here (point))
6702 (lim (or lim
(point-min)))
6703 keyword sexp-start sexp-mid sexp-end
6704 preceding-sexp containing-sexp
6705 containing-begin containing-mid containing-paren
)
6707 ;; Find the containing-paren, and use that as the limit
6708 (if (setq containing-paren
6710 (narrow-to-region lim
(point))
6711 (vhdl-safe (scan-lists (point) -
1 1))))
6712 (setq lim containing-paren
))
6713 ;; Look backwards for "begin" and "end" keywords.
6714 (while (and (> (point) lim
)
6715 (not containing-sexp
))
6716 (setq keyword
(vhdl-backward-to-block lim
))
6718 ((eq keyword
'begin
)
6719 ;; Found a "begin" keyword
6720 (setq sexp-start
(point))
6721 (setq sexp-mid
(vhdl-corresponding-mid lim
))
6722 (setq sexp-end
(vhdl-safe
6724 (vhdl-forward-sexp 1 lim
) (point))))
6725 (if (and sexp-end
(<= sexp-end here
))
6726 ;; we want to record this sexp, but we only want to
6727 ;; record the last-most of any of them before here
6729 (setq preceding-sexp sexp-start
))
6730 ;; we're contained in this sexp so put sexp-start on
6732 (setq containing-sexp sexp-start
)
6733 (setq containing-mid sexp-mid
)
6734 (setq containing-begin t
)))
6736 ;; Found an "end" keyword
6738 (setq sexp-end
(point))
6741 (or (vhdl-safe (vhdl-backward-sexp 1 lim
) (point))
6742 (progn (backward-sexp) (point))))
6743 ;; we want to record this sexp, but we only want to
6744 ;; record the last-most of any of them before here
6746 (setq preceding-sexp sexp-start
)))
6748 ;; Check if the containing-paren should be the containing-sexp
6749 (if (and containing-paren
6750 (or (null containing-sexp
)
6751 (< containing-sexp containing-paren
)))
6752 (setq containing-sexp containing-paren
6754 containing-begin nil
6755 containing-mid nil
))
6756 (vector containing-sexp preceding-sexp containing-begin containing-mid
)
6760 (defconst vhdl-s-c-a-re
6761 (concat vhdl-case-alternative-re
"\\|" vhdl-case-header-key
))
6763 (defun vhdl-skip-case-alternative (&optional lim
)
6764 "Skip forward over case/when bodies, with optional maximal
6765 limit. If no next case alternative is found, nil is returned and
6766 point is not moved."
6767 (let ((lim (or lim
(point-max)))
6770 (while (and (< (point) lim
)
6772 (if (and (re-search-forward vhdl-s-c-a-re lim
'move
)
6774 (not (vhdl-in-literal)))
6775 (/= (match-beginning 0) here
))
6777 (goto-char (match-beginning 0))
6779 ((and (looking-at "case")
6780 (re-search-forward "\\bis[^_]" lim t
))
6782 (vhdl-forward-sexp))
6790 (defun vhdl-backward-skip-label (&optional lim
)
6791 "Skip backward over a label, with optional maximal
6792 limit. If label is not found, nil is returned and point
6794 (let ((lim (or lim
(point-min)))
6797 (vhdl-backward-syntactic-ws lim
)
6798 (and (eq (preceding-char) ?
:)
6801 (setq placeholder
(point))
6802 (looking-at vhdl-label-key
))))
6803 (goto-char placeholder
))
6806 (defun vhdl-forward-skip-label (&optional lim
)
6807 "Skip forward over a label, with optional maximal
6808 limit. If label is not found, nil is returned and point
6810 (let ((lim (or lim
(point-max))))
6811 (if (looking-at vhdl-label-key
)
6813 (goto-char (match-end 0))
6814 (vhdl-forward-syntactic-ws lim
)))
6817 (defun vhdl-get-syntactic-context ()
6818 "Guess the syntactic description of the current line of VHDL code."
6822 (let* ((indent-point (point))
6823 (case-fold-search t
)
6824 vec literal containing-sexp preceding-sexp
6825 containing-begin containing-mid containing-leader
6826 char-before-ip char-after-ip begin-after-ip end-after-ip
6827 placeholder lim library-unit
6830 ;; Reset the syntactic context
6831 (setq vhdl-syntactic-context nil
)
6834 ;; Move to the start of the previous library unit, and
6835 ;; record the position of the "begin" keyword.
6836 (setq placeholder
(vhdl-beginning-of-libunit))
6837 ;; The position of the "libunit" keyword gives us a gross
6842 ;; If there is a previous library unit, and we are enclosed by
6843 ;; it, then set the syntax accordingly.
6845 (setq library-unit
(vhdl-get-library-unit lim placeholder
))
6846 (vhdl-add-syntax library-unit lim
))
6848 ;; Find the surrounding state.
6849 (if (setq vec
(vhdl-get-block-state lim
))
6851 (setq containing-sexp
(aref vec
0))
6852 (setq preceding-sexp
(aref vec
1))
6853 (setq containing-begin
(aref vec
2))
6854 (setq containing-mid
(aref vec
3))
6857 ;; set the limit on the farthest back we need to search
6858 (setq lim
(if containing-sexp
6860 (goto-char containing-sexp
)
6861 ;; set containing-leader if required
6862 (if (looking-at vhdl-leader-re
)
6863 (setq containing-leader
(vhdl-end-of-leader)))
6867 ;; cache char before and after indent point, and move point to
6868 ;; the most likely position to perform the majority of tests
6869 (goto-char indent-point
)
6870 (skip-chars-forward " \t")
6871 (setq literal
(vhdl-in-literal))
6872 (setq char-after-ip
(following-char))
6873 (setq begin-after-ip
(and
6875 (looking-at vhdl-begin-fwd-re
)
6876 (or (not (looking-at "\\<use\\>"))
6878 (back-to-indentation)
6879 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
6881 (setq end-after-ip
(and
6883 (looking-at vhdl-end-fwd-re
)
6885 (vhdl-backward-syntactic-ws lim
)
6886 (setq char-before-ip
(preceding-char))
6887 (goto-char indent-point
)
6888 (skip-chars-forward " \t")
6890 ;; now figure out syntactic qualities of the current line
6892 ;; CASE 1: in a string or comment.
6893 ((memq literal
'(string comment
))
6894 (vhdl-add-syntax literal
(vhdl-point 'bopl
)))
6895 ;; CASE 2: Line is at top level.
6896 ((null containing-sexp
)
6897 ;; Find the point to which indentation will be relative
6899 (if (null preceding-sexp
)
6901 ;; no preceding-sexp -> use the preceding statement
6902 (vhdl-beginning-of-statement-1 lim
)
6904 ;; if there is a preceding-sexp then indent relative to it
6905 (goto-char preceding-sexp
)
6906 ;; if not at boi, then the block-opening keyword is
6907 ;; probably following a label, so we need a different
6909 (if (/= (point) (vhdl-point 'boi
))
6911 (vhdl-beginning-of-statement-1 lim
)))
6912 ;; v-b-o-s could have left us at point-min
6915 (vhdl-forward-syntactic-ws indent-point
))
6916 (setq placeholder
(point)))
6918 ;; CASE 2A : we are looking at a block-open
6920 (vhdl-add-syntax 'block-open placeholder
))
6921 ;; CASE 2B: we are looking at a block-close
6923 (vhdl-add-syntax 'block-close placeholder
))
6924 ;; CASE 2C: we are looking at a top-level statement
6926 (vhdl-backward-syntactic-ws lim
)
6928 (and (= (preceding-char) ?\
;)
6929 (not (vhdl-in-quote-p)))))
6930 (vhdl-add-syntax 'statement placeholder
))
6931 ;; CASE 2D: we are looking at a top-level statement-cont
6933 (vhdl-beginning-of-statement-1 lim
)
6934 ;; v-b-o-s could have left us at point-min
6937 (vhdl-forward-syntactic-ws indent-point
))
6938 (vhdl-add-syntax 'statement-cont
(point)))
6940 ;; CASE 3: line is inside parentheses. Most likely we are
6941 ;; either in a subprogram argument (interface) list, or a
6942 ;; continued expression containing parentheses.
6943 ((null containing-begin
)
6944 (vhdl-backward-syntactic-ws containing-sexp
)
6946 ;; CASE 3A: we are looking at the arglist closing paren
6947 ((eq char-after-ip ?\
))
6948 (goto-char containing-sexp
)
6949 (vhdl-add-syntax 'arglist-close
(vhdl-point 'boi
)))
6950 ;; CASE 3B: we are looking at the first argument in an empty
6952 ((eq char-before-ip ?\
()
6953 (goto-char containing-sexp
)
6954 (vhdl-add-syntax 'arglist-intro
(vhdl-point 'boi
)))
6955 ;; CASE 3C: we are looking at an arglist continuation line,
6956 ;; but the preceding argument is on the same line as the
6957 ;; opening paren. This case includes multi-line
6958 ;; expression paren groupings.
6959 ((and (save-excursion
6960 (goto-char (1+ containing-sexp
))
6961 (skip-chars-forward " \t")
6963 (not (looking-at "--")))
6965 (vhdl-beginning-of-statement-1 containing-sexp
)
6966 (skip-chars-backward " \t(")
6967 (while (and (= (preceding-char) ?\
;)
6968 (not (vhdl-in-quote-p)))
6969 (vhdl-beginning-of-statement-1 containing-sexp
)
6970 (skip-chars-backward " \t("))
6971 (<= (point) containing-sexp
)))
6972 (goto-char containing-sexp
)
6973 (vhdl-add-syntax 'arglist-cont-nonempty
(vhdl-point 'boi
)))
6974 ;; CASE 3D: we are looking at just a normal arglist
6975 ;; continuation line
6976 (t (vhdl-beginning-of-statement-1 containing-sexp
)
6977 (vhdl-forward-syntactic-ws indent-point
)
6978 (vhdl-add-syntax 'arglist-cont
(vhdl-point 'boi
)))
6980 ;; CASE 4: A block mid open
6981 ((and begin-after-ip
6982 (looking-at containing-mid
))
6983 (goto-char containing-sexp
)
6984 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
6985 (if (looking-at vhdl-trailer-re
)
6987 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil
)))
6988 (vhdl-backward-skip-label (vhdl-point 'boi
))
6989 (vhdl-add-syntax 'block-open
(point)))
6990 ;; CASE 5: block close brace
6992 (goto-char containing-sexp
)
6993 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
6994 (if (looking-at vhdl-trailer-re
)
6996 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil
)))
6997 (vhdl-backward-skip-label (vhdl-point 'boi
))
6998 (vhdl-add-syntax 'block-close
(point)))
6999 ;; CASE 6: A continued statement
7000 ((and (/= char-before-ip ?\
;)
7001 ;; check it's not a trailer begin keyword, or a begin
7002 ;; keyword immediately following a label.
7003 (not (and begin-after-ip
7004 (or (looking-at vhdl-trailer-re
)
7006 (vhdl-backward-skip-label containing-sexp
)))))
7007 ;; check it's not a statement keyword
7008 (not (and (looking-at vhdl-statement-fwd-re
)
7009 (vhdl-statement-p)))
7010 ;; see if the b-o-s is before the indent point
7013 (vhdl-beginning-of-statement-1 containing-sexp
)
7014 ;; If we ended up after a leader, then this will
7015 ;; move us forward to the start of the first
7016 ;; statement. Note that a containing sexp here is
7017 ;; always a keyword, not a paren, so this will
7018 ;; have no effect if we hit the containing-sexp.
7019 (vhdl-forward-syntactic-ws indent-point
)
7020 (setq placeholder
(point))))
7021 ;; check it's not a block-intro
7022 (/= placeholder containing-sexp
)
7023 ;; check it's not a case block-intro
7025 (goto-char placeholder
)
7026 (or (not (looking-at vhdl-case-alternative-re
))
7027 (> (match-end 0) indent-point
))))
7028 ;; Make placeholder skip a label, but only if it puts us
7029 ;; before the indent point at the start of a line.
7030 (let ((new placeholder
))
7031 (if (and (> indent-point
7033 (goto-char placeholder
)
7034 (vhdl-forward-skip-label indent-point
)
7035 (setq new
(point))))
7038 (eq new
(progn (back-to-indentation) (point)))))
7039 (setq placeholder new
)))
7040 (vhdl-add-syntax 'statement-cont placeholder
)
7042 (vhdl-add-syntax 'block-open
)))
7043 ;; Statement. But what kind?
7044 ;; CASE 7: A case alternative key
7045 ((and (looking-at vhdl-case-alternative-re
)
7046 (vhdl-case-alternative-p containing-sexp
))
7047 ;; for a case alternative key, we set relpos to the first
7048 ;; non-whitespace char on the line containing the "case"
7050 (goto-char containing-sexp
)
7051 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
7052 (if (looking-at vhdl-trailer-re
)
7053 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil
)))
7054 (vhdl-add-syntax 'case-alternative
(vhdl-point 'boi
)))
7055 ;; CASE 8: statement catchall
7057 ;; we know its a statement, but we need to find out if it is
7058 ;; the first statement in a block
7059 (if containing-leader
7060 (goto-char containing-leader
)
7061 (goto-char containing-sexp
)
7062 ;; Note that a containing sexp here is always a keyword,
7063 ;; not a paren, so skip over the keyword.
7065 ;; move to the start of the first statement
7066 (vhdl-forward-syntactic-ws indent-point
)
7067 (setq placeholder
(point))
7068 ;; we want to ignore case alternatives keys when skipping forward
7070 (while (looking-at vhdl-case-alternative-re
)
7071 (setq incase-p
(point))
7072 ;; we also want to skip over the body of the
7073 ;; case/when statement if that doesn't put us at
7074 ;; after the indent-point
7075 (while (vhdl-skip-case-alternative indent-point
))
7076 ;; set up the match end
7077 (looking-at vhdl-case-alternative-re
)
7078 (goto-char (match-end 0))
7079 ;; move to the start of the first case alternative statement
7080 (vhdl-forward-syntactic-ws indent-point
)
7081 (setq placeholder
(point)))
7083 ;; CASE 8A: we saw a case/when statement so we must be
7084 ;; in a switch statement. find out if we are at the
7085 ;; statement just after a case alternative key
7087 (= (point) indent-point
))
7088 ;; relpos is the "when" keyword
7089 (vhdl-add-syntax 'statement-case-intro incase-p
))
7090 ;; CASE 8B: any old statement
7091 ((< (point) indent-point
)
7092 ;; relpos is the first statement of the block
7093 (vhdl-add-syntax 'statement placeholder
)
7095 (vhdl-add-syntax 'block-open
)))
7096 ;; CASE 8C: first statement in a block
7098 (goto-char containing-sexp
)
7099 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
7100 (if (looking-at vhdl-trailer-re
)
7101 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil
)))
7102 (vhdl-backward-skip-label (vhdl-point 'boi
))
7103 (vhdl-add-syntax 'statement-block-intro
(point))
7105 (vhdl-add-syntax 'block-open
)))
7109 ;; now we need to look at any modifiers
7110 (goto-char indent-point
)
7111 (skip-chars-forward " \t")
7112 (if (looking-at "--")
7113 (vhdl-add-syntax 'comment
))
7114 (if (eq literal
'pound
)
7115 (vhdl-add-syntax 'cpp-macro
))
7116 ;; return the syntax
7117 vhdl-syntactic-context
))))
7119 ;; Standard indentation line-ups:
7121 (defun vhdl-lineup-arglist (langelem)
7122 "Lineup the current arglist line with the arglist appearing just
7123 after the containing paren which starts the arglist."
7125 (let* ((containing-sexp
7127 ;; arglist-cont-nonempty gives relpos ==
7128 ;; to boi of containing-sexp paren. This
7129 ;; is good when offset is +, but bad
7130 ;; when it is vhdl-lineup-arglist, so we
7131 ;; have to special case a kludge here.
7132 (if (memq (car langelem
) '(arglist-intro arglist-cont-nonempty
))
7135 (backward-up-list 1)
7136 (skip-chars-forward " \t" (vhdl-point 'eol
)))
7137 (goto-char (cdr langelem
)))
7139 (cs-curcol (save-excursion
7140 (goto-char (cdr langelem
))
7144 (looking-at "[ \t]*)"))
7145 (progn (goto-char (match-end 0))
7148 (vhdl-forward-syntactic-ws)
7149 (- (current-column) cs-curcol
))
7150 (goto-char containing-sexp
)
7152 (let ((eol (vhdl-point 'eol
))
7155 (skip-chars-forward " \t")
7157 (vhdl-forward-syntactic-ws)
7160 (- (current-column) cs-curcol
)
7163 (defun vhdl-lineup-arglist-intro (langelem)
7164 "Lineup an arglist-intro line to just after the open paren."
7166 (let ((cs-curcol (save-excursion
7167 (goto-char (cdr langelem
))
7169 (ce-curcol (save-excursion
7171 (backward-up-list 1)
7172 (skip-chars-forward " \t" (vhdl-point 'eol
))
7174 (- ce-curcol cs-curcol -
1))))
7176 (defun vhdl-lineup-comment (langelem)
7177 "Support old behavior for comment indentation. We look at
7178 vhdl-comment-only-line-offset to decide how to indent comment
7181 (back-to-indentation)
7182 ;; at or to the right of comment-column
7183 (if (>= (current-column) comment-column
)
7184 (vhdl-comment-indent)
7185 ;; otherwise, indent as specified by vhdl-comment-only-line-offset
7187 (or (car-safe vhdl-comment-only-line-offset
)
7188 vhdl-comment-only-line-offset
)
7189 (or (cdr-safe vhdl-comment-only-line-offset
)
7190 (car-safe vhdl-comment-only-line-offset
)
7191 -
1000 ;jam it against the left side
7194 (defun vhdl-lineup-statement-cont (langelem)
7195 "Line up statement-cont after the assignment operator."
7197 (let* ((relpos (cdr langelem
))
7198 (assignp (save-excursion
7199 (goto-char (vhdl-point 'boi
))
7200 (and (re-search-forward "\\(<\\|:\\|=\\)="
7201 (vhdl-point 'eol
) t
)
7202 (- (point) (vhdl-point 'boi
)))))
7207 (while (and (not foundp
)
7208 (< (point) (vhdl-point 'eol
)))
7209 (re-search-forward "\\(<\\|:\\|=\\)=\\|(" (vhdl-point 'eol
) 'move
)
7210 (if (vhdl-in-literal)
7212 (if (= (preceding-char) ?\
()
7213 ;; skip over any parenthesized expressions
7214 (goto-char (min (vhdl-point 'eol
)
7215 (scan-lists (point) 1 1)))
7216 ;; found an assignment operator (not at eol)
7217 (setq foundp
(not (looking-at "\\s-*$"))))))
7219 ;; there's no assignment operator on the line
7221 ;; calculate indentation column after assign and ws, unless
7222 ;; our line contains an assignment operator
7226 (skip-chars-forward " \t")
7228 (- (current-column) assignp curcol
))
7231 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7232 ;; Progress reporting
7234 (defvar vhdl-progress-info nil
7235 "Array variable for progress information: 0 begin, 1 end, 2 time.")
7237 (defun vhdl-update-progress-info (string pos
)
7238 "Update progress information."
7239 (when (and vhdl-progress-info
(not noninteractive
)
7240 (< vhdl-progress-interval
7241 (- (nth 1 (current-time)) (aref vhdl-progress-info
2))))
7242 (let ((delta (- (aref vhdl-progress-info
1)
7243 (aref vhdl-progress-info
0))))
7245 (message (concat string
"... (100%s)") "%")
7246 (message (concat string
"... (%2d%s)")
7247 (/ (* 100 (- pos
(aref vhdl-progress-info
0)))
7249 (aset vhdl-progress-info
2 (nth 1 (current-time)))))
7251 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7252 ;; Indentation commands
7254 (defun vhdl-electric-tab (&optional prefix-arg
)
7255 "If preceding character is part of a word or a paren then hippie-expand,
7256 else if right of non whitespace on line then insert tab,
7257 else if last command was a tab or return then dedent one step or if a comment
7258 toggle between normal indent and inline comment indent,
7259 else indent `correctly'."
7261 (vhdl-prepare-search-2
7263 ;; indent region if region is active
7264 ((and (not (featurep 'xemacs
)) (use-region-p))
7265 (vhdl-indent-region (region-beginning) (region-end) nil
))
7267 ((= (char-syntax (preceding-char)) ?w
)
7268 (let ((case-fold-search (not vhdl-word-completion-case-sensitive
))
7270 (hippie-expand-only-buffers
7271 (or (and (boundp 'hippie-expand-only-buffers
)
7272 hippie-expand-only-buffers
)
7274 (vhdl-expand-abbrev prefix-arg
)))
7275 ;; expand parenthesis
7276 ((or (= (preceding-char) ?\
() (= (preceding-char) ?\
)))
7277 (let ((case-fold-search (not vhdl-word-completion-case-sensitive
))
7279 (vhdl-expand-paren prefix-arg
)))
7281 ((> (current-column) (current-indentation))
7283 ;; toggle comment indent
7284 ((and (looking-at "--")
7285 (or (eq last-command
'vhdl-electric-tab
)
7286 (eq last-command
'vhdl-electric-return
)))
7287 (cond ((= (current-indentation) 0) ; no indent
7289 (indent-according-to-mode))
7290 ((< (current-indentation) comment-column
) ; normal indent
7291 (indent-to comment-column
)
7292 (indent-according-to-mode))
7293 (t ; inline comment indent
7294 (delete-region (line-beginning-position) (point)))))
7296 ((and (>= (current-indentation) vhdl-basic-offset
)
7297 (or (eq last-command
'vhdl-electric-tab
)
7298 (eq last-command
'vhdl-electric-return
)))
7299 (backward-delete-char-untabify vhdl-basic-offset nil
))
7301 (t (indent-according-to-mode)))
7302 (setq this-command
'vhdl-electric-tab
)))
7304 (defun vhdl-electric-return ()
7305 "newline-and-indent or indent-new-comment-line if in comment and preceding
7306 character is a space."
7308 (if (and (= (preceding-char) ?
) (vhdl-in-comment-p))
7309 (indent-new-comment-line)
7310 (when (and (>= (preceding-char) ?a
) (<= (preceding-char) ?z
)
7311 (not (vhdl-in-comment-p)))
7312 (vhdl-fix-case-word -
1))
7313 (newline-and-indent)))
7315 (defun vhdl-indent-line ()
7316 "Indent the current line as VHDL code. Returns the amount of
7317 indentation change."
7319 (let* ((syntax (and vhdl-indent-syntax-based
(vhdl-get-syntactic-context)))
7320 (pos (- (point-max) (point)))
7324 ;; indent syntax-based
7325 (if (and (eq (caar syntax
) 'comment
)
7326 (>= (vhdl-get-offset (car syntax
)) comment-column
))
7327 ;; special case: comments at or right of comment-column
7328 (vhdl-get-offset (car syntax
))
7329 ;; align comments like following code line
7330 (when vhdl-indent-comment-like-next-code-line
7332 (while (eq (caar syntax
) 'comment
)
7334 (beginning-of-line 2)
7335 (setq syntax
(vhdl-get-syntactic-context)))))
7337 (push (cons 'comment nil
) syntax
))
7338 (apply '+ (mapcar 'vhdl-get-offset syntax
)))
7339 ;; indent like previous nonblank line
7340 (save-excursion (beginning-of-line)
7341 (re-search-backward "^[^\n]" nil t
)
7342 (current-indentation))))
7343 (shift-amt (- indent
(current-indentation))))
7344 (and vhdl-echo-syntactic-information-p
7345 (message "syntax: %s, indent= %d" syntax indent
))
7347 (save-excursion (beginning-of-line) (looking-at "\\s-*\f"))))
7348 (when (or (not (zerop shift-amt
)) has-formfeed
)
7349 (delete-region (vhdl-point 'bol
) (vhdl-point 'boi
))
7351 (when has-formfeed
(insert "\f"))
7352 (indent-to indent
)))
7353 (if (< (point) (vhdl-point 'boi
))
7354 (back-to-indentation)
7355 ;; If initial point was within line's indentation, position after
7356 ;; the indentation. Else stay at same point in text.
7357 (when (> (- (point-max) pos
) (point))
7358 (goto-char (- (point-max) pos
))))
7359 (run-hooks 'vhdl-special-indent-hook
)
7360 (vhdl-update-progress-info "Indenting" (vhdl-current-line))
7363 (defun vhdl-indent-region (beg end
&optional column
)
7364 "Indent region as VHDL code.
7365 Adds progress reporting to `indent-region'."
7366 (interactive "r\nP")
7367 (when vhdl-progress-interval
7368 (setq vhdl-progress-info
(vector (count-lines (point-min) beg
)
7369 (count-lines (point-min) end
) 0)))
7370 (indent-region beg end column
)
7371 (when vhdl-progress-interval
(message "Indenting...done"))
7372 (setq vhdl-progress-info nil
))
7374 (defun vhdl-indent-buffer ()
7375 "Indent whole buffer as VHDL code.
7376 Calls `indent-region' for whole buffer and adds progress reporting."
7378 (vhdl-indent-region (point-min) (point-max)))
7380 (defun vhdl-indent-group ()
7381 "Indent group of lines between empty lines."
7383 (let ((beg (save-excursion
7384 (if (re-search-backward vhdl-align-group-separate nil t
)
7386 (point-min-marker))))
7387 (end (save-excursion
7388 (if (re-search-forward vhdl-align-group-separate nil t
)
7390 (point-max-marker)))))
7391 (vhdl-indent-region beg end
)))
7393 (defun vhdl-indent-sexp (&optional endpos
)
7394 "Indent each line of the list starting just after point.
7395 If optional arg ENDPOS is given, indent each line, stopping when
7396 ENDPOS is encountered."
7400 (end (progn (vhdl-forward-sexp nil endpos
) (point))))
7401 (indent-region beg end nil
))))
7403 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7404 ;; Miscellaneous commands
7406 (defun vhdl-show-syntactic-information ()
7407 "Show syntactic information for current line."
7409 (message "Syntactic analysis: %s" (vhdl-get-syntactic-context))
7410 (vhdl-keep-region-active))
7412 ;; Verification and regression functions:
7414 (defun vhdl-regress-line (&optional arg
)
7415 "Check syntactic information for current line."
7417 (let ((expected (save-excursion
7419 (when (search-backward " -- ((" (vhdl-point 'bol
) t
)
7421 (read (current-buffer)))))
7422 (actual (vhdl-get-syntactic-context))
7424 ;; remove the library unit symbols
7428 (if (memq (car elt
) '(entity configuration package
7429 package-body architecture
))
7431 (setq expurgated
(append expurgated
(list elt
))))))
7433 (if (and (not arg
) expected
(listp expected
))
7434 (if (not (equal expected expurgated
))
7435 (error "ERROR: Should be: %s, is: %s" expected expurgated
))
7438 (when (not (looking-at "^\\s-*\\(--.*\\)?$"))
7440 (if (search-backward " -- ((" (vhdl-point 'bol
) t
)
7441 (delete-region (point) (line-end-position)))
7443 (insert (format "%s" expurgated
))))))
7444 (vhdl-keep-region-active))
7447 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7448 ;;; Alignment, beautifying
7449 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7451 (defconst vhdl-align-alist
7453 ;; after some keywords
7454 (vhdl-mode "^\\s-*\\(across\\|constant\\|quantity\\|signal\\|subtype\\|terminal\\|through\\|type\\|variable\\)[ \t]"
7455 "^\\s-*\\(across\\|constant\\|quantity\\|signal\\|subtype\\|terminal\\|through\\|type\\|variable\\)\\([ \t]+\\)" 2)
7457 (vhdl-mode ":[^=]" "\\([ \t]*\\):[^=]")
7458 ;; after direction specifications
7459 (vhdl-mode ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\>"
7460 ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\([ \t]+\\)" 2)
7461 ;; before "==", ":=", "=>", and "<="
7462 (vhdl-mode "[<:=]=" "\\([ \t]*\\)\\??[<:=]=" 1) ; since "<= ... =>" can occur
7463 (vhdl-mode "=>" "\\([ \t]*\\)=>" 1)
7464 (vhdl-mode "[<:=]=" "\\([ \t]*\\)\\??[<:=]=" 1) ; since "=> ... <=" can occur
7465 ;; before some keywords
7466 (vhdl-mode "[ \t]after\\>" "[^ \t]\\([ \t]+\\)after\\>" 1)
7467 (vhdl-mode "[ \t]when\\>" "[^ \t]\\([ \t]+\\)when\\>" 1)
7468 (vhdl-mode "[ \t]else\\>" "[^ \t]\\([ \t]+\\)else\\>" 1)
7469 (vhdl-mode "[ \t]across\\>" "[^ \t]\\([ \t]+\\)across\\>" 1)
7470 (vhdl-mode "[ \t]through\\>" "[^ \t]\\([ \t]+\\)through\\>" 1)
7471 ;; before "=>" since "when/else ... =>" can occur
7472 (vhdl-mode "=>" "\\([ \t]*\\)=>" 1)
7474 "The format of this alist is (MODES [or MODE] REGEXP ALIGN-PATTERN SUBEXP).
7475 It is searched in order. If REGEXP is found anywhere in the first
7476 line of a region to be aligned, ALIGN-PATTERN will be used for that
7477 region. ALIGN-PATTERN must include the whitespace to be expanded or
7478 contracted. It may also provide regexps for the text surrounding the
7479 whitespace. SUBEXP specifies which sub-expression of
7480 ALIGN-PATTERN matches the white space to be expanded/contracted.")
7482 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7485 (defvar vhdl-align-try-all-clauses t
7486 "If REGEXP is not found on the first line of the region that clause
7487 is ignored. If this variable is non-nil, then the clause is tried anyway.")
7489 (defun vhdl-do-group (function &optional spacing
)
7490 "Apply FUNCTION on group of lines between empty lines."
7492 ;; search for group beginning
7493 ((beg (save-excursion
7494 (if (re-search-backward vhdl-align-group-separate nil t
)
7495 (progn (beginning-of-line 2) (back-to-indentation) (point))
7497 ;; search for group end
7498 (end (save-excursion
7499 (if (re-search-forward vhdl-align-group-separate nil t
)
7500 (progn (beginning-of-line) (point))
7503 (funcall function beg end spacing
)))
7505 (defun vhdl-do-list (function &optional spacing
)
7506 "Apply FUNCTION to the lines of a list surrounded by a balanced group of
7510 ;; search for beginning of balanced group of parentheses
7511 (setq beg
(vhdl-re-search-backward "[()]" nil t
))
7512 (while (looking-at ")")
7513 (forward-char) (backward-sexp)
7514 (setq beg
(vhdl-re-search-backward "[()]" nil t
)))
7515 ;; search for end of balanced group of parentheses
7519 (goto-char (1+ beg
))
7520 (skip-chars-forward " \t\n\r\f")
7521 (setq beg
(point))))
7524 (funcall function beg end spacing
)
7525 (error "ERROR: Not within a list enclosed by a pair of parentheses"))))
7527 (defun vhdl-do-same-indent (function &optional spacing
)
7528 "Apply FUNCTION to block of lines with same indent."
7529 (let ((indent (current-indentation))
7531 ;; search for first line with same indent
7533 (while (and (not (bobp))
7534 (or (looking-at "^\\s-*\\(--.*\\)?$")
7535 (= (current-indentation) indent
)))
7536 (unless (looking-at "^\\s-*$")
7537 (back-to-indentation) (setq beg
(point)))
7538 (beginning-of-line -
0)))
7539 ;; search for last line with same indent
7541 (while (and (not (eobp))
7542 (or (looking-at "^\\s-*\\(--.*\\)?$")
7543 (= (current-indentation) indent
)))
7544 (if (looking-at "^\\s-*$")
7545 (beginning-of-line 2)
7546 (beginning-of-line 2)
7547 (setq end
(point)))))
7549 (funcall function beg end spacing
)))
7551 (defun vhdl-align-region-1 (begin end
&optional spacing alignment-list indent
)
7552 "Attempt to align a range of lines based on the content of the
7553 lines. The definition of `alignment-list' determines the matching
7554 order and the manner in which the lines are aligned. If ALIGNMENT-LIST
7555 is not specified `vhdl-align-alist' is used. If INDENT is non-nil,
7556 indentation is done before aligning."
7557 (interactive "r\np")
7558 (setq alignment-list
(or alignment-list vhdl-align-alist
))
7559 (setq spacing
(or spacing
1))
7563 (setq end
(point-marker))
7565 (setq bol
(setq begin
(progn (beginning-of-line) (point))))
7567 (indent-region bol end nil
))))
7568 (let ((copy (copy-alist alignment-list
)))
7569 (vhdl-prepare-search-2
7574 (eol (point-at-eol)))
7575 (setq element
(nth 0 copy
))
7576 (when (and (or (and (listp (car element
))
7577 (memq major-mode
(car element
)))
7578 (eq major-mode
(car element
)))
7579 (or vhdl-align-try-all-clauses
7580 (re-search-forward (car (cdr element
)) eol t
)))
7581 (vhdl-align-region-2 begin end
(car (cdr (cdr element
)))
7582 (car (cdr (cdr (cdr element
)))) spacing
))
7583 (setq copy
(cdr copy
))))))))
7585 (defun vhdl-align-region-2 (begin end match
&optional substr spacing
)
7586 "Align a range of lines from BEGIN to END. The regular expression
7587 MATCH must match exactly one field: the whitespace to be
7588 contracted/expanded. The alignment column will equal the
7589 rightmost column of the widest whitespace block. SPACING is
7590 the amount of extra spaces to add to the calculated maximum required.
7591 SPACING defaults to 1 so that at least one space is inserted after
7592 the token in MATCH."
7593 (setq spacing
(or spacing
1))
7594 (setq substr
(or substr
1))
7596 (let (distance (max 0) (lines 0) bol eol width
)
7597 ;; Determine the greatest whitespace distance to the alignment
7600 (setq eol
(point-at-eol)
7601 bol
(setq begin
(progn (beginning-of-line) (point))))
7604 (when (and (vhdl-re-search-forward match eol t
)
7606 (goto-char (match-beginning 0))
7608 (and (not (vhdl-in-literal))
7609 (not (vhdl-in-quote-p))
7610 (not (vhdl-in-extended-identifier-p))))
7611 (not (looking-at "\\s-*$")))
7612 (setq distance
(- (match-beginning substr
) bol
))
7613 (when (> distance max
)
7614 (setq max distance
))))
7618 (setq lines
(1+ lines
)))
7619 ;; Now insert enough maxs to push each assignment operator to
7620 ;; the same column. We need to use 'lines' as a counter, since
7621 ;; the location of the mark may change
7622 (goto-char (setq bol begin
))
7623 (setq eol
(point-at-eol))
7625 (when (and (vhdl-re-search-forward match eol t
)
7627 (goto-char (match-beginning 0))
7629 (and (not (vhdl-in-literal))
7630 (not (vhdl-in-quote-p))
7631 (not (vhdl-in-extended-identifier-p))))
7632 (not (looking-at "\\s-*$"))
7633 (> (match-beginning 0) ; not if at boi
7634 (save-excursion (back-to-indentation) (point))))
7635 (setq width
(- (match-end substr
) (match-beginning substr
)))
7636 (setq distance
(- (match-beginning substr
) bol
))
7637 (goto-char (match-beginning substr
))
7639 (insert-char ?
(+ (- max distance
) spacing
)))
7644 (setq lines
(1- lines
))))))
7646 (defun vhdl-align-region-groups (beg end
&optional spacing
7647 no-message no-comments
)
7648 "Align region, treat groups of lines separately."
7649 (interactive "r\nP")
7654 (setq orig
(point-marker))
7657 (setq end
(point-marker))
7660 (when vhdl-progress-interval
7661 (setq vhdl-progress-info
(vector (count-lines (point-min) beg
)
7662 (count-lines (point-min) end
) 0))))
7663 (when (nth 0 vhdl-beautify-options
)
7664 (vhdl-fixup-whitespace-region beg end t
))
7666 (if (not vhdl-align-groups
)
7667 ;; align entire region
7668 (progn (vhdl-align-region-1 beg end spacing
)
7670 (vhdl-align-inline-comment-region-1 beg end
)))
7672 (while (and (< beg end
)
7673 (re-search-forward vhdl-align-group-separate end t
))
7674 (setq pos
(point-marker))
7675 (vhdl-align-region-1 beg pos spacing
)
7676 (unless no-comments
(vhdl-align-inline-comment-region-1 beg pos
))
7677 (vhdl-update-progress-info "Aligning" (vhdl-current-line))
7682 (vhdl-align-region-1 beg end spacing
)
7683 (unless no-comments
(vhdl-align-inline-comment-region-1 beg end
))
7684 (vhdl-update-progress-info "Aligning" (vhdl-current-line))))
7685 (when vhdl-indent-tabs-mode
7688 (when vhdl-progress-interval
(message "Aligning...done"))
7689 (setq vhdl-progress-info nil
)))))
7691 (defun vhdl-align-region (beg end
&optional spacing
)
7692 "Align region, treat blocks with same indent and argument lists separately."
7693 (interactive "r\nP")
7694 (if (not vhdl-align-same-indent
)
7695 ;; align entire region
7696 (vhdl-align-region-groups beg end spacing
)
7697 ;; align blocks with same indent and argument lists
7701 (when vhdl-progress-interval
7702 (setq vhdl-progress-info
(vector (count-lines (point-min) beg
)
7703 (count-lines (point-min) end
) 0)))
7705 (setq end
(point-marker))
7707 (while (< (point) end
)
7708 ;; is argument list opening?
7709 (if (setq cur-beg
(nth 1 (save-excursion (parse-partial-sexp
7710 (point) (vhdl-point 'eol
)))))
7711 ;; determine region for argument list
7712 (progn (goto-char cur-beg
)
7714 (setq cur-end
(point))
7715 (beginning-of-line 2))
7716 ;; determine region with same indent
7717 (setq indent
(current-indentation))
7718 (setq cur-beg
(point))
7719 (setq cur-end
(vhdl-point 'bonl
))
7720 (beginning-of-line 2)
7721 (while (and (< (point) end
)
7722 (or (looking-at "^\\s-*\\(--.*\\)?$")
7723 (= (current-indentation) indent
))
7725 (nth 0 (parse-partial-sexp
7726 (point) (vhdl-point 'eol
)))) 0))
7727 (unless (looking-at "^\\s-*$")
7728 (setq cur-end
(vhdl-point 'bonl
)))
7729 (beginning-of-line 2)))
7731 (vhdl-align-region-groups cur-beg cur-end spacing t t
))
7732 (vhdl-align-inline-comment-region beg end spacing noninteractive
)
7733 (when vhdl-progress-interval
(message "Aligning...done"))
7734 (setq vhdl-progress-info nil
)))))
7736 (defun vhdl-align-group (&optional spacing
)
7737 "Align group of lines between empty lines."
7739 (vhdl-do-group 'vhdl-align-region spacing
))
7741 (defun vhdl-align-list (&optional spacing
)
7742 "Align the lines of a list surrounded by a balanced group of parentheses."
7744 (vhdl-do-list 'vhdl-align-region-groups spacing
))
7746 (defun vhdl-align-same-indent (&optional spacing
)
7747 "Align block of lines with same indent."
7749 (vhdl-do-same-indent 'vhdl-align-region-groups spacing
))
7751 (defun vhdl-align-declarations (&optional spacing
)
7752 "Align the lines within the declarative part of a design unit."
7755 (vhdl-prepare-search-2
7757 ;; search for declarative part
7758 (when (and (re-search-backward "^\\(architecture\\|begin\\|configuration\\|end\\|entity\\|package\\)\\>" nil t
)
7759 (not (member (upcase (match-string 1)) '("BEGIN" "END"))))
7761 (re-search-forward "^\\(begin\\|end\\)\\>" nil t
)
7762 (setq end
(point)))))
7764 (vhdl-align-region-groups beg end spacing
)
7765 (error "ERROR: Not within the declarative part of a design unit"))))
7767 (defun vhdl-align-buffer ()
7770 (vhdl-align-region (point-min) (point-max)))
7772 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7773 ;; Align inline comments
7775 (defun vhdl-align-inline-comment-region-1 (beg end
&optional spacing
)
7776 "Align inline comments in region."
7778 (let ((start-max comment-column
)
7780 comment-list start-list tmp-list start length
7781 cur-start prev-start no-code
)
7782 (setq spacing
(or spacing
2))
7783 (vhdl-prepare-search-2
7785 ;; search for comment start positions and lengths
7786 (while (< (point) end
)
7787 (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))
7788 (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\s-*\\(--.*\\)$")
7789 (not (save-excursion (goto-char (match-beginning 2))
7790 (vhdl-in-literal))))
7791 (setq start
(+ (- (match-end 1) (match-beginning 1)) spacing
))
7792 (setq length
(- (match-end 2) (match-beginning 2)))
7793 (setq start-max
(max start start-max
))
7794 (setq length-max
(max length length-max
))
7795 (push (cons start length
) comment-list
))
7796 (beginning-of-line 2))
7798 (sort comment-list
(function (lambda (a b
) (> (car a
) (car b
))))))
7799 ;; reduce start positions
7800 (setq start-list
(list (caar comment-list
)))
7801 (setq comment-list
(cdr comment-list
))
7803 (unless (or (= (caar comment-list
) (car start-list
))
7804 (<= (+ (car start-list
) (cdar comment-list
))
7805 end-comment-column
))
7806 (push (caar comment-list
) start-list
))
7807 (setq comment-list
(cdr comment-list
)))
7808 ;; align lines as nicely as possible
7810 (while (< (point) end
)
7811 (setq cur-start nil
)
7812 (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))
7813 (or (and (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\(\\s-*\\)\\(--.*\\)$")
7814 (not (save-excursion
7815 (goto-char (match-beginning 3))
7816 (vhdl-in-literal))))
7817 (and (looking-at "^\\(\\)\\(\\s-*\\)\\(--.*\\)$")
7818 (>= (- (match-end 2) (match-beginning 2))
7820 (setq start
(+ (- (match-end 1) (match-beginning 1)) spacing
))
7821 (setq length
(- (match-end 3) (match-beginning 3)))
7822 (setq no-code
(= (match-beginning 1) (match-end 1)))
7823 ;; insert minimum whitespace
7824 (goto-char (match-end 2))
7825 (delete-region (match-beginning 2) (match-end 2))
7826 (insert-char ?\ spacing
)
7827 (setq tmp-list start-list
)
7828 ;; insert additional whitespace to align
7831 ;; align comment-only line to inline comment of previous line
7832 ((and no-code prev-start
7833 (<= length
(- end-comment-column prev-start
)))
7835 ;; align all comments at `start-max' if this is possible
7836 ((<= (+ start-max length-max
) end-comment-column
)
7838 ;; align at `comment-column' if possible
7839 ((and (<= start comment-column
)
7840 (<= length
(- end-comment-column comment-column
)))
7842 ;; align at left-most possible start position otherwise
7844 (while (and tmp-list
(< (car tmp-list
) start
))
7845 (setq tmp-list
(cdr tmp-list
)))
7847 (indent-to cur-start
))
7848 (setq prev-start cur-start
)
7849 (beginning-of-line 2))))))
7851 (defun vhdl-align-inline-comment-region (beg end
&optional spacing no-message
)
7852 "Align inline comments within a region. Groups of code lines separated by
7853 empty lines are aligned individually, if `vhdl-align-groups' is non-nil."
7854 (interactive "r\nP")
7859 (setq orig
(point-marker))
7862 (setq end
(point-marker))
7864 (unless no-message
(message "Aligning inline comments..."))
7866 (if (not vhdl-align-groups
)
7867 ;; align entire region
7868 (vhdl-align-inline-comment-region-1 beg end spacing
)
7870 (while (and (< beg end
)
7871 (re-search-forward vhdl-align-group-separate end t
))
7872 (setq pos
(point-marker))
7873 (vhdl-align-inline-comment-region-1 beg pos spacing
)
7878 (vhdl-align-inline-comment-region-1 beg end spacing
)))
7879 (when vhdl-indent-tabs-mode
7881 (unless no-message
(message "Aligning inline comments...done")))))
7883 (defun vhdl-align-inline-comment-group (&optional spacing
)
7884 "Align inline comments within a group of lines between empty lines."
7887 (let ((start (point))
7889 (setq end
(if (re-search-forward vhdl-align-group-separate nil t
)
7890 (point-marker) (point-max)))
7892 (setq beg
(if (re-search-backward vhdl-align-group-separate nil t
)
7893 (point) (point-min)))
7895 (message "Aligning inline comments...")
7896 (vhdl-align-inline-comment-region-1 beg end
)
7897 (when vhdl-indent-tabs-mode
7899 (message "Aligning inline comments...done"))))
7901 (defun vhdl-align-inline-comment-buffer ()
7902 "Align inline comments within buffer. Groups of code lines separated by
7903 empty lines are aligned individually, if `vhdl-align-groups' is non-nil."
7905 (vhdl-align-inline-comment-region (point-min) (point-max)))
7907 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7910 (defun vhdl-fixup-whitespace-region (beg end
&optional no-message
)
7911 "Fixup whitespace in region. Surround operator symbols by one space,
7912 eliminate multiple spaces (except at beginning of line), eliminate spaces at
7913 end of line, do nothing in comments and strings."
7915 (unless no-message
(message "Fixing up whitespace..."))
7918 (setq end
(point-marker))
7919 ;; have no space before and one space after `,' and ';'
7921 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\s-*\\([,;]\\)\\)" end t
)
7922 (if (match-string 1)
7923 (goto-char (match-end 1))
7924 (replace-match "\\3 " nil nil nil
2)))
7925 ;; have no space after `('
7927 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\((\\)\\s-+" end t
)
7928 (if (match-string 1)
7929 (goto-char (match-end 1))
7930 (replace-match "\\2")))
7931 ;; have no space before `)'
7933 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\|^\\s-+\\)\\|\\s-+\\()\\)" end t
)
7934 (if (match-string 1)
7935 (goto-char (match-end 1))
7936 (replace-match "\\2")))
7937 ;; surround operator symbols by one space
7939 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\([^/:<>=\n]\\)\\(:\\|\\??=\\|\\??<<\\|\\??>>\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>\n]\\|$\\)\\)" end t
)
7940 (if (or (match-string 1)
7941 (<= (match-beginning 0) ; not if at boi
7942 (save-excursion (back-to-indentation) (point))))
7943 (goto-char (match-end 0))
7944 (replace-match "\\3 \\4 \\5")
7945 (goto-char (match-end 2))))
7946 ;; eliminate multiple spaces and spaces at end of line
7948 (while (or (and (looking-at "--.*\n") (re-search-forward "--.*\n" end t
))
7949 (and (looking-at "--.*") (re-search-forward "--.*" end t
))
7950 (and (looking-at "\"") (re-search-forward "\"[^\"\n]*[\"\n]" end t
))
7951 (and (looking-at "\\s-+$") (re-search-forward "\\s-+$" end t
)
7952 (progn (replace-match "" nil nil
) t
))
7953 (and (looking-at "\\s-+;") (re-search-forward "\\s-+;" end t
)
7954 (progn (replace-match ";" nil nil
) t
))
7955 (and (looking-at "^\\s-+") (re-search-forward "^\\s-+" end t
))
7956 (and (looking-at "\\s-+--") (re-search-forward "\\s-+" end t
)
7957 (progn (replace-match " " nil nil
) t
))
7958 (and (looking-at "\\s-+") (re-search-forward "\\s-+" end t
)
7959 (progn (replace-match " " nil nil
) t
))
7960 (and (looking-at "-") (re-search-forward "-" end t
))
7961 (re-search-forward "[^ \t\"-]+" end t
))))
7962 (unless no-message
(message "Fixing up whitespace...done")))
7964 (defun vhdl-fixup-whitespace-buffer ()
7965 "Fixup whitespace in buffer. Surround operator symbols by one space,
7966 eliminate multiple spaces (except at beginning of line), eliminate spaces at
7967 end of line, do nothing in comments."
7969 (vhdl-fixup-whitespace-region (point-min) (point-max)))
7971 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7974 (defun vhdl-fix-case-region-1 (beg end upper-case word-regexp
&optional count
)
7975 "Convert all words matching WORD-REGEXP in region to lower or upper case,
7976 depending on parameter UPPER-CASE."
7977 (let ((case-replace nil
)
7979 (vhdl-prepare-search-2
7982 (setq end
(point-marker))
7984 (while (re-search-forward word-regexp end t
)
7985 (or (vhdl-in-literal)
7988 (downcase-word -
1)))
7989 (when (and count vhdl-progress-interval
(not noninteractive
)
7990 (< vhdl-progress-interval
7991 (- (nth 1 (current-time)) last-update
)))
7992 (message "Fixing case... (%2d%s)"
7993 (+ (* count
20) (/ (* 20 (- (point) beg
)) (- end beg
)))
7995 (setq last-update
(nth 1 (current-time)))))
7998 (defun vhdl-fix-case-region (beg end
&optional arg
)
7999 "Convert all VHDL words in region to lower or upper case, depending on
8000 options vhdl-upper-case-{keywords,types,attributes,enum-values}."
8001 (interactive "r\nP")
8002 (vhdl-fix-case-region-1
8003 beg end vhdl-upper-case-keywords vhdl-keywords-regexp
0)
8004 (vhdl-fix-case-region-1
8005 beg end vhdl-upper-case-types vhdl-types-regexp
1)
8006 (vhdl-fix-case-region-1
8007 beg end vhdl-upper-case-attributes
(concat "'" vhdl-attributes-regexp
) 2)
8008 (vhdl-fix-case-region-1
8009 beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp
3)
8010 (vhdl-fix-case-region-1
8011 beg end vhdl-upper-case-constants vhdl-constants-regexp
4)
8012 (when vhdl-progress-interval
(message "Fixing case...done")))
8014 (defun vhdl-fix-case-buffer ()
8015 "Convert all VHDL words in buffer to lower or upper case, depending on
8016 options vhdl-upper-case-{keywords,types,attributes,enum-values}."
8018 (vhdl-fix-case-region (point-min) (point-max)))
8020 (defun vhdl-fix-case-word (&optional arg
)
8021 "Convert word after cursor to upper case if necessary."
8024 (when arg
(backward-word 1))
8025 (vhdl-prepare-search-1
8026 (when (and vhdl-upper-case-keywords
8027 (looking-at vhdl-keywords-regexp
))
8029 (when (and vhdl-upper-case-types
8030 (looking-at vhdl-types-regexp
))
8032 (when (and vhdl-upper-case-attributes
8033 (looking-at vhdl-attributes-regexp
))
8035 (when (and vhdl-upper-case-enum-values
8036 (looking-at vhdl-enum-values-regexp
))
8038 (when (and vhdl-upper-case-constants
8039 (looking-at vhdl-constants-regexp
))
8042 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8044 ;; - force each statement to be on a separate line except when on same line
8045 ;; with 'end' keyword
8047 (defun vhdl-fix-statement-region (beg end
&optional arg
)
8048 "Force statements in region on separate line except when on same line
8049 with 'end' keyword (necessary for correct indentation).
8050 Currently supported keywords: 'begin', 'if'."
8051 (interactive "r\nP")
8052 (vhdl-prepare-search-2
8056 (setq end
(point-marker))
8059 (while (re-search-forward
8060 "^\\s-*[^ \t\n].*?\\(\\<begin\\>\\)\\(.*\\<end\\>\\)?" end t
)
8061 (goto-char (match-end 0))
8062 (setq point
(point-marker))
8063 (when (and (match-string 1)
8064 (or (not (match-string 2))
8065 (save-excursion (goto-char (match-end 2))
8067 (not (save-excursion (goto-char (match-beginning 1))
8068 (vhdl-in-literal))))
8069 (goto-char (match-beginning 1))
8071 (indent-according-to-mode))
8074 ;; `for', `if' keywords
8075 (while (re-search-forward "\\<\\(for\\|if\\)\\>" end t
)
8076 (goto-char (match-end 1))
8077 (setq point
(point-marker))
8078 ;; exception: in literal or preceded by `end', `wait' or label
8079 (when (and (not (save-excursion (goto-char (match-beginning 1))
8082 (beginning-of-line 1)
8084 (and (re-search-forward "^\\s-*\\([^ \t\n].*\\)"
8085 (match-beginning 1) t
)
8087 "\\(\\<end\\>\\|\\<wait .*\\|\\w+\\s-*:\\)\\s-*$"
8088 (match-string 1)))))))
8089 (goto-char (match-beginning 1))
8091 (indent-according-to-mode))
8092 (goto-char point
))))))
8094 (defun vhdl-fix-statement-buffer ()
8095 "Force statements in buffer on separate line except when on same line
8096 with 'end' keyword (necessary for correct indentation)."
8098 (vhdl-fix-statement-region (point-min) (point-max)))
8100 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8103 (defun vhdl-remove-trailing-spaces-region (beg end
&optional arg
)
8104 "Remove trailing spaces in region."
8105 (interactive "r\nP")
8108 (setq end
(point-marker))
8110 (while (re-search-forward "[ \t]+$" end t
)
8111 (unless (vhdl-in-literal)
8112 (replace-match "" nil nil
)))))
8114 (defun vhdl-remove-trailing-spaces ()
8115 "Remove trailing spaces in buffer."
8117 (vhdl-remove-trailing-spaces-region (point-min) (point-max)))
8119 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8122 (defun vhdl-beautify-region (beg end
)
8123 "Beautify region by applying indentation, whitespace fixup, alignment, and
8124 case fixing to a region. Calls functions `vhdl-indent-buffer',
8125 `vhdl-align-buffer' (option `vhdl-align-groups' set to non-nil), and
8126 `vhdl-fix-case-buffer'."
8128 (setq end
(save-excursion (goto-char end
) (point-marker)))
8129 (save-excursion ; remove DOS EOL characters in UNIX file
8131 (while (search-forward "
" nil t
)
8132 (replace-match "" nil t
)))
8133 (when (nth 0 vhdl-beautify-options
) (vhdl-fixup-whitespace-region beg end t
))
8134 (when (nth 1 vhdl-beautify-options
) (vhdl-fix-statement-region beg end
))
8135 (when (nth 2 vhdl-beautify-options
) (vhdl-indent-region beg end
))
8136 (when (nth 3 vhdl-beautify-options
)
8137 (let ((vhdl-align-groups t
)) (vhdl-align-region beg end
)))
8138 (when (nth 4 vhdl-beautify-options
) (vhdl-fix-case-region beg end
))
8139 (when (nth 0 vhdl-beautify-options
)
8140 (vhdl-remove-trailing-spaces-region beg end
)
8141 (if vhdl-indent-tabs-mode
(tabify beg end
) (untabify beg end
))))
8143 (defun vhdl-beautify-buffer ()
8144 "Beautify buffer by applying indentation, whitespace fixup, alignment, and
8145 case fixing to entire buffer. Calls `vhdl-beautify-region' for the entire
8148 (vhdl-beautify-region (point-min) (point-max))
8149 (when noninteractive
(save-buffer)))
8151 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8154 (defun vhdl-fill-region (beg end
&optional arg
)
8155 "Fill lines for a region of code."
8156 (interactive "r\np")
8159 (let ((margin (if arg
(current-indentation) (current-column))))
8161 (setq end
(point-marker))
8162 ;; remove inline comments, newlines and whitespace
8163 (vhdl-comment-kill-region beg end
)
8164 (vhdl-comment-kill-inline-region beg end
)
8165 (subst-char-in-region beg
(1- end
) ?
\n ?\
)
8166 (vhdl-fixup-whitespace-region beg end
)
8167 ;; wrap and end-comment-column
8169 (while (re-search-forward "\\s-" end t
)
8170 (when(> (current-column) vhdl-end-comment-column
)
8172 (when (re-search-backward "\\s-" beg t
)
8173 (replace-match "\n")
8174 (indent-to margin
)))))))
8176 (defun vhdl-fill-group ()
8177 "Fill group of lines between empty lines."
8179 (vhdl-do-group 'vhdl-fill-region
))
8181 (defun vhdl-fill-list ()
8182 "Fill the lines of a list surrounded by a balanced group of parentheses."
8184 (vhdl-do-list 'vhdl-fill-region
))
8186 (defun vhdl-fill-same-indent ()
8187 "Fill the lines of block of lines with same indent."
8189 (vhdl-do-same-indent 'vhdl-fill-region
))
8192 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8193 ;;; Code updating/fixing
8194 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8196 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8197 ;; Sensitivity list update
8200 ;; - no sensitivity list is generated for processes with wait statements
8201 ;; - otherwise, do the following:
8202 ;; 1. scan for all local signals (ports, signals declared in arch./blocks)
8203 ;; 2. scan for all signals already in the sensitivity list (in order to catch
8204 ;; manually entered global signals)
8205 ;; 3. signals from 1. and 2. form the list of visible signals
8206 ;; 4. search for if/elsif conditions containing an event (sequential code)
8207 ;; 5. scan for strings that are within syntactical regions where signals are
8208 ;; read but not within sequential code, and that correspond to visible
8210 ;; 6. replace sensitivity list by list of signals from 5.
8212 (defun vhdl-update-sensitivity-list-process ()
8213 "Update sensitivity list of current process."
8216 (vhdl-prepare-search-2
8218 ;; look whether in process
8219 (if (not (and (re-search-backward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(process\\|end\\s-+process\\)\\>" nil t
)
8220 (equal (upcase (match-string 2)) "PROCESS")
8221 (save-excursion (re-search-forward "^\\s-*end\\s-+process\\>" nil t
))))
8222 (error "ERROR: Not within a process")
8223 (message "Updating sensitivity list...")
8224 (vhdl-update-sensitivity-list)
8225 (message "Updating sensitivity list...done")))))
8227 (defun vhdl-update-sensitivity-list-buffer ()
8228 "Update sensitivity list of all processes in current buffer."
8231 (vhdl-prepare-search-2
8232 (goto-char (point-min))
8233 (message "Updating sensitivity lists...")
8234 (while (re-search-forward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?process\\>" nil t
)
8235 (goto-char (match-beginning 0))
8236 (condition-case nil
(vhdl-update-sensitivity-list) (error "")))
8237 (message "Updating sensitivity lists...done")))
8238 (when noninteractive
(save-buffer)))
8240 (defun vhdl-update-sensitivity-list ()
8241 "Update sensitivity list."
8242 (let ((proc-beg (point))
8243 (proc-end (re-search-forward "^\\s-*end\\s-+process\\>" nil t
))
8244 (proc-mid (vhdl-re-search-backward
8245 "\\(\\(\\<begin\\>\\)\\|^\\s-*process\\>\\)" nil t
))
8248 ;; error if 'begin' keyword missing
8249 ((not (match-string 2))
8250 (error "ERROR: No 'begin' keyword found"))
8251 ;; search for wait statement (no sensitivity list allowed)
8252 ((progn (goto-char proc-mid
)
8253 (vhdl-re-search-forward "\\<wait\\>" proc-end t
))
8254 (error "ERROR: Process with wait statement, sensitivity list not generated"))
8255 ;; combinational process (update sensitivity list)
8258 ;; scan for visible signals
8259 ((visible-list (vhdl-get-visible-signals))
8260 ;; define syntactic regions where signals are read
8262 '(;; right-hand side of signal/variable assignment
8263 ;; (special case: "<=" is relational operator in a condition)
8264 ((vhdl-re-search-forward "[<:]=" proc-end t
)
8265 (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t
))
8267 ((vhdl-re-search-forward "^\\s-*if\\>" proc-end t
)
8268 (vhdl-re-search-forward "\\<then\\>" proc-end t
))
8270 ((vhdl-re-search-forward "\\<elsif\\>" proc-end t
)
8271 (vhdl-re-search-forward "\\<then\\>" proc-end t
))
8272 ;; while loop condition
8273 ((vhdl-re-search-forward "^\\s-*while\\>" proc-end t
)
8274 (vhdl-re-search-forward "\\<loop\\>" proc-end t
))
8275 ;; exit/next condition
8276 ((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t
)
8277 (vhdl-re-search-forward ";" proc-end t
))
8279 ((vhdl-re-search-forward "\\<assert\\>" proc-end t
)
8280 (vhdl-re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" proc-end t
))
8282 ((vhdl-re-search-forward "^\\s-*case\\>" proc-end t
)
8283 (vhdl-re-search-forward "\\<is\\>" proc-end t
))
8284 ;; parameter list of procedure call, array index
8285 ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t
)
8287 (progn (backward-char) (forward-sexp)
8288 (while (looking-at "(") (forward-sexp)) (point)))))
8289 name field read-list sens-list signal-list tmp-list
8290 sens-beg sens-end beg end margin
)
8291 ;; scan for signals in old sensitivity list
8292 (goto-char proc-beg
)
8293 (vhdl-re-search-forward "\\<process\\>" proc-mid t
)
8294 (if (not (looking-at "[ \t\n\r\f]*("))
8295 (setq sens-beg
(point))
8296 (setq sens-beg
(vhdl-re-search-forward "\\([ \t\n\r\f]*\\)([ \t\n\r\f]*" nil t
))
8297 (goto-char (match-end 1))
8299 (setq sens-end
(1- (point)))
8300 (goto-char sens-beg
)
8301 (while (and (vhdl-re-search-forward "\\(\\w+\\)" sens-end t
)
8303 (cons (downcase (match-string 0)) sens-list
))
8304 (vhdl-re-search-forward "\\s-*,\\s-*" sens-end t
))))
8305 (setq signal-list
(append visible-list sens-list
))
8306 ;; search for sequential parts
8307 (goto-char proc-mid
)
8308 (while (setq beg
(re-search-forward "^\\s-*\\(els\\)?if\\>" proc-end t
))
8309 (setq end
(vhdl-re-search-forward "\\<then\\>" proc-end t
))
8310 (when (vhdl-re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t
)
8314 (push (cons end
(point)) seq-region-list
)
8315 (beginning-of-line)))
8316 ;; scan for signals read in process
8317 (while scan-regions-list
8318 (goto-char proc-mid
)
8319 (while (and (setq beg
(eval (nth 0 (car scan-regions-list
))))
8320 (setq end
(eval (nth 1 (car scan-regions-list
)))))
8322 (unless (or (vhdl-in-literal)
8323 (and seq-region-list
8324 (let ((tmp-list seq-region-list
))
8325 (while (and tmp-list
8326 (< (point) (caar tmp-list
)))
8327 (setq tmp-list
(cdr tmp-list
)))
8328 (and tmp-list
(< (point) (cdar tmp-list
))))))
8329 (while (vhdl-re-search-forward "[^'\".]\\<\\([a-zA-Z]\\w*\\)\\(\\(\\.\\w+\\|[ \t\n\r\f]*([^)]*)\\)*\\)[ \t\n\r\f]*\\('\\(\\w+\\)\\|\\(=>\\)\\)?" end t
)
8330 (setq name
(match-string 1))
8331 ;; get array index range
8332 (when vhdl-array-index-record-field-in-sensitivity-list
8333 (setq field
(match-string 2))
8334 ;; not use if it includes a variable name
8336 (setq tmp-list visible-list
)
8337 (while (and field tmp-list
)
8339 (concat "\\<" (car tmp-list
) "\\>") field
)
8341 (setq tmp-list
(cdr tmp-list
)))))
8342 (when (and (not (match-string 6)) ; not when formal parameter
8343 (not (and (match-string 5) ; not event attribute
8344 (not (member (downcase (match-string 5))
8345 '("event" "last_event" "transaction")))))
8346 (member (downcase name
) signal-list
))
8347 ;; not add if name or name+field already exists
8349 (or (member-ignore-case name read-list
)
8350 (member-ignore-case (concat name field
) read-list
))
8351 (push (concat name field
) read-list
))
8352 (setq tmp-list read-list
)
8353 ;; remove existing name+field if name is added
8356 (when (string-match (concat "^" name field
"[(.]")
8358 (setq read-list
(delete (car tmp-list
) read-list
)))
8359 (setq tmp-list
(cdr tmp-list
)))))
8360 (goto-char (match-end 1)))))
8361 (setq scan-regions-list
(cdr scan-regions-list
)))
8362 ;; update sensitivity list
8363 (goto-char sens-beg
)
8365 (delete-region sens-beg sens-end
)
8367 (insert " ()") (backward-char)))
8368 (setq read-list
(sort read-list
'string
<))
8370 (setq margin
(current-column))
8371 (insert (car read-list
))
8372 (setq read-list
(cdr read-list
))
8375 (if (<= (+ (current-column) (length (car read-list
)) 2)
8378 (insert "\n") (indent-to margin
))
8379 (insert (car read-list
))
8380 (setq read-list
(cdr read-list
)))))))))
8382 (defun vhdl-get-visible-signals ()
8383 "Get all signals visible in the current block."
8384 (let (beg end signal-list entity-name file-name
)
8385 (vhdl-prepare-search-2
8388 (unless (and (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t
)
8389 (not (equal "END" (upcase (match-string 1))))
8390 (setq entity-name
(match-string 2)))
8391 (error "ERROR: Not within an architecture")))
8392 ;; search for signals declared in entity port clause
8394 (goto-char (point-min))
8395 (unless (re-search-forward (concat "^entity\\s-+" entity-name
"\\>") nil t
)
8397 (concat (vhdl-replace-string vhdl-entity-file-name entity-name t
)
8398 "." (file-name-extension (buffer-file-name)))))
8401 (vhdl-prepare-search-2
8402 (goto-char (point-min))
8403 (if (not (re-search-forward (concat "^entity\\s-+" entity-name
"\\>") nil t
))
8404 (error "ERROR: Entity \"%s\" not found:\n --> see option `vhdl-entity-file-name'" entity-name
)
8405 (when (setq beg
(vhdl-re-search-forward
8406 "\\<port[ \t\n\r\f]*("
8408 (re-search-forward "^end\\>" nil t
)) t
))
8409 (setq end
(save-excursion
8410 (backward-char) (forward-sexp) (point)))
8411 (vhdl-forward-syntactic-ws)
8412 (while (< (point) end
)
8413 (when (looking-at "signal[ \t\n\r\f]+")
8414 (goto-char (match-end 0)))
8415 (while (looking-at "\\([a-zA-Z]\\w*\\)[ \t\n\r\f,]+")
8417 (cons (downcase (match-string 1)) signal-list
))
8418 (goto-char (match-end 0))
8419 (vhdl-forward-syntactic-ws))
8420 (re-search-forward ";" end
1)
8421 (vhdl-forward-syntactic-ws)))))))
8422 ;; search for signals declared in architecture declarative part
8424 (if (not (and (setq beg
(re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t
))
8425 (not (equal "END" (upcase (match-string 1))))
8426 (setq end
(re-search-forward "^begin\\>" nil t
))))
8427 (error "ERROR: No architecture declarative part found")
8428 ;; scan for all declared signal and alias names
8430 (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t
)
8431 (when (= 0 (nth 0 (parse-partial-sexp beg
(point))))
8432 (if (match-string 2)
8434 (while (looking-at "[ \t\n\r\f,]+\\([a-zA-Z]\\w*\\)")
8436 (cons (downcase (match-string 1)) signal-list
))
8437 (goto-char (match-end 0)))
8438 ;; scan alias name, check is alias of (declared) signal
8439 (when (and (looking-at "[ \t\n\r\f]+\\([a-zA-Z]\\w*\\)[^;]*\\<is[ \t\n\r\f]+\\([a-zA-Z]\\w*\\)")
8440 (member (downcase (match-string 2)) signal-list
))
8442 (cons (downcase (match-string 1)) signal-list
))
8443 (goto-char (match-end 0))))
8444 (setq beg
(point))))))
8445 ;; search for signals declared in surrounding block declarative parts
8447 (while (and (progn (while (and (setq beg
(re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*\\(block\\|\\(for\\|if\\).*\\<generate\\>\\)\\|\\(end\\)\\s-+block\\)\\>" nil t
))
8449 (goto-char (match-end 4))
8450 (vhdl-backward-sexp)
8451 (re-search-backward "^\\s-*\\w+\\s-*:\\s-*\\(block\\|generate\\)\\>" nil t
))
8453 (setq end
(re-search-forward "^\\s-*begin\\>" nil t
)))
8454 ;; scan for all declared signal names
8456 (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t
)
8457 (when (= 0 (nth 0 (parse-partial-sexp beg
(point))))
8458 (if (match-string 2)
8460 (while (looking-at "[ \t\n,]+\\(\\w+\\)")
8462 (cons (downcase (match-string 1)) signal-list
))
8463 (goto-char (match-end 0)))
8464 ;; scan alias name, check is alias of (declared) signal
8465 (when (and (looking-at "[ \t\n]+\\(\\w+\\)[^;]*\\<is[ \t\n]+\\(\\w+\\)")
8466 (member (downcase (match-string 2)) signal-list
))
8468 (cons (downcase (match-string 1)) signal-list
))
8469 (goto-char (match-end 0))))))
8473 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8474 ;; Generic/port clause fixing
8476 (defun vhdl-fix-clause-buffer ()
8477 "Fix all generic/port clauses in current buffer."
8480 (vhdl-prepare-search-2
8481 (goto-char (point-min))
8482 (message "Fixing generic/port clauses...")
8483 (while (re-search-forward "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(" nil t
)
8484 (goto-char (match-end 0))
8485 (condition-case nil
(vhdl-fix-clause) (error "")))
8486 (message "Fixing generic/port clauses...done"))))
8488 (defun vhdl-fix-clause ()
8489 "Fix closing parenthesis within generic/port clause."
8492 (vhdl-prepare-search-2
8496 (if (not (re-search-backward "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(" nil t
))
8497 (error "ERROR: Not within a generic/port clause")
8498 ;; search for end of clause
8499 (goto-char (match-end 0))
8500 (setq beg
(1- (point)))
8501 (vhdl-forward-syntactic-ws)
8502 (while (looking-at "\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*[ \t\n\r\f]*:[ \t\n\r\f]*\\w+[^;]*;")
8503 (goto-char (1- (match-end 0)))
8504 (setq end
(point-marker))
8506 (vhdl-forward-syntactic-ws))
8508 (when (> pos
(point-at-eol))
8509 (error "ERROR: Not within a generic/port clause"))
8510 ;; delete closing parenthesis on separate line (not supported style)
8511 (when (save-excursion (beginning-of-line) (looking-at "^\\s-*);"))
8513 (vhdl-backward-syntactic-ws)
8514 (setq end
(point-marker))
8516 ;; delete superfluous parentheses
8517 (while (progn (goto-char beg
)
8518 (condition-case () (forward-sexp)
8519 (error (goto-char (point-max))))
8522 ;; add closing parenthesis
8523 (when (> (point) end
)
8528 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8530 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8532 (defconst vhdl-template-prompt-syntax
"[^ =<>][^<>@.\n]*[^ =<>]"
8533 "Syntax of prompt inserted by template generators.")
8535 (defvar vhdl-template-invoked-by-hook nil
8536 "Indicates whether a template has been invoked by a hook or by key or menu.
8537 Used for undoing after template abortion.")
8539 ;; correct different behavior of function `unread-command-events' in XEmacs
8540 (defun vhdl-character-to-event (arg))
8541 (defalias 'vhdl-character-to-event
8542 (if (fboundp 'character-to-event
) 'character-to-event
'identity
))
8544 (defun vhdl-work-library ()
8545 "Return the working library name of the current project or \"work\" if no
8546 project is defined."
8547 (vhdl-resolve-env-variable
8548 (or (nth 6 (aget vhdl-project-alist vhdl-project
)) vhdl-default-library
)))
8550 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8551 ;; Enabling/disabling
8553 (define-minor-mode vhdl-electric-mode
8554 "Toggle VHDL electric mode.
8555 With a prefix argument ARG, enable the mode if ARG is positive,
8556 and disable it otherwise. If called from Lisp, enable it if ARG
8558 :global t
:group
'vhdl-mode
)
8560 (define-minor-mode vhdl-stutter-mode
8561 "Toggle VHDL stuttering mode.
8562 With a prefix argument ARG, enable the mode if ARG is positive,
8563 and disable it otherwise. If called from Lisp, enable it if ARG
8565 :global t
:group
'vhdl-mode
)
8567 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8570 (defun vhdl-electric-dash (count)
8571 "-- starts a comment, --- draws a horizontal line,
8572 ---- starts a display comment."
8574 (if (and vhdl-stutter-mode
(not (vhdl-in-literal)))
8576 ((and abbrev-start-location
(= abbrev-start-location
(point)))
8577 (setq abbrev-start-location nil
)
8578 (goto-char last-abbrev-location
)
8579 (beginning-of-line nil
)
8580 (vhdl-comment-display))
8581 ((/= (preceding-char) ?-
) ; standard dash (minus)
8582 (self-insert-command count
))
8583 (t (self-insert-command count
)
8584 (message "Enter '-' for horiz. line, 'CR' for commenting-out code, else enter comment")
8585 (let ((next-input (read-char)))
8586 (if (= next-input ?-
) ; triple dash
8588 (vhdl-comment-display-line)
8590 "Enter '-' for display comment, else continue coding")
8591 (let ((next-input (read-char)))
8592 (if (= next-input ?-
) ; four dashes
8593 (vhdl-comment-display t
)
8594 (setq unread-command-events
; pushback the char
8595 (list (vhdl-character-to-event next-input
))))))
8596 (setq unread-command-events
; pushback the char
8597 (list (vhdl-character-to-event next-input
)))
8598 (vhdl-comment-insert)))))
8599 (self-insert-command count
)))
8601 (defun vhdl-electric-open-bracket (count) "'[' --> '(', '([' --> '['"
8603 (if (and vhdl-stutter-mode
(= count
1) (not (vhdl-in-literal)))
8604 (if (= (preceding-char) ?\
()
8605 (progn (delete-char -
1) (insert-char ?\
[ 1))
8606 (insert-char ?\
( 1))
8607 (self-insert-command count
)))
8609 (defun vhdl-electric-close-bracket (count) "']' --> ')', ')]' --> ']'"
8611 (if (and vhdl-stutter-mode
(= count
1) (not (vhdl-in-literal)))
8613 (if (= (preceding-char) ?\
))
8614 (progn (delete-char -
1) (insert-char ?\
] 1))
8615 (insert-char ?\
) 1))
8616 (blink-matching-open))
8617 (self-insert-command count
)))
8619 (defun vhdl-electric-quote (count) "'' --> \""
8621 (if (and vhdl-stutter-mode
(= count
1) (not (vhdl-in-literal)))
8622 (if (= (preceding-char) vhdl-last-input-event
)
8623 (progn (delete-char -
1) (insert-char ?
\" 1))
8624 (insert-char ?
\' 1))
8625 (self-insert-command count
)))
8627 (defun vhdl-electric-semicolon (count) "';;' --> ' : ', ': ;' --> ' := '"
8629 (if (and vhdl-stutter-mode
(= count
1) (not (vhdl-in-literal)))
8630 (cond ((= (preceding-char) vhdl-last-input-event
)
8631 (progn (delete-char -
1)
8632 (unless (eq (preceding-char) ?
) (insert " "))
8634 (setq this-command
'vhdl-electric-colon
)))
8636 (eq last-command
'vhdl-electric-colon
) (= (preceding-char) ?
))
8637 (progn (delete-char -
1) (insert "= ")))
8638 (t (insert-char ?\
; 1)))
8639 (self-insert-command count
)))
8641 (defun vhdl-electric-comma (count) "',,' --> ' <= '"
8643 (if (and vhdl-stutter-mode
(= count
1) (not (vhdl-in-literal)))
8644 (cond ((= (preceding-char) vhdl-last-input-event
)
8645 (progn (delete-char -
1)
8646 (unless (eq (preceding-char) ?
) (insert " "))
8648 (t (insert-char ?\
, 1)))
8649 (self-insert-command count
)))
8651 (defun vhdl-electric-period (count) "'..' --> ' => '"
8653 (if (and vhdl-stutter-mode
(= count
1) (not (vhdl-in-literal)))
8654 (cond ((= (preceding-char) vhdl-last-input-event
)
8655 (progn (delete-char -
1)
8656 (unless (eq (preceding-char) ?
) (insert " "))
8658 (t (insert-char ?\.
1)))
8659 (self-insert-command count
)))
8661 (defun vhdl-electric-equal (count) "'==' --> ' == '"
8663 (if (and vhdl-stutter-mode
(= count
1) (not (vhdl-in-literal)))
8664 (cond ((= (preceding-char) vhdl-last-input-event
)
8665 (progn (delete-char -
1)
8666 (unless (eq (preceding-char) ?
) (insert " "))
8668 (t (insert-char ?\
= 1)))
8669 (self-insert-command count
)))
8671 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8674 (defun vhdl-template-paired-parens ()
8675 "Insert a pair of round parentheses, placing point between them."
8680 (defun vhdl-template-alias ()
8681 "Insert alias declaration."
8683 (let ((start (point)))
8684 (vhdl-insert-keyword "ALIAS ")
8685 (when (vhdl-template-field "name" nil t start
(point))
8687 (unless (vhdl-template-field
8688 (concat "[type" (and (vhdl-standard-p 'ams
) " or nature") "]")
8691 (vhdl-insert-keyword " IS ")
8692 (vhdl-template-field "name" ";")
8693 (vhdl-comment-insert-inline))))
8695 (defun vhdl-template-architecture ()
8696 "Insert architecture."
8698 (let ((margin (current-indentation))
8701 (vhdl-insert-keyword "ARCHITECTURE ")
8702 (when (setq arch-name
8703 (vhdl-template-field "name" nil t start
(point)))
8704 (vhdl-insert-keyword " OF ")
8706 (vhdl-prepare-search-1
8707 (vhdl-re-search-backward "\\<entity \\(\\w+\\) is\\>" nil t
)))
8708 (insert (match-string 1))
8709 (vhdl-template-field "entity name"))
8710 (vhdl-insert-keyword " IS\n")
8711 (vhdl-template-begin-end
8712 (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name margin
8713 (memq vhdl-insert-empty-lines
'(unit all
))))))
8715 (defun vhdl-template-array (kind &optional secondary
)
8716 "Insert array type definition."
8718 (let ((start (point)))
8719 (vhdl-insert-keyword "ARRAY (")
8720 (when (or (vhdl-template-field "range" nil
(not secondary
) start
(point))
8722 (vhdl-insert-keyword ") OF ")
8723 (vhdl-template-field (if (eq kind
'type
) "type" "nature"))
8724 (vhdl-insert-keyword ";"))))
8726 (defun vhdl-template-assert ()
8727 "Insert an assertion statement."
8729 (let ((start (point)))
8730 (vhdl-insert-keyword "ASSERT ")
8731 (when vhdl-conditions-in-parenthesis
(insert "("))
8732 (when (vhdl-template-field "condition (negated)" nil t start
(point))
8733 (when vhdl-conditions-in-parenthesis
(insert ")"))
8734 (setq start
(point))
8735 (vhdl-insert-keyword " REPORT ")
8736 (unless (vhdl-template-field "string expression" nil nil nil nil t
)
8737 (delete-region start
(point)))
8738 (setq start
(point))
8739 (vhdl-insert-keyword " SEVERITY ")
8740 (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t
)
8741 (delete-region start
(point)))
8744 (defun vhdl-template-attribute ()
8745 "Insert an attribute declaration or specification."
8747 (if (eq (vhdl-decision-query
8748 "attribute" "(d)eclaration or (s)pecification?" t
) ?s
)
8749 (vhdl-template-attribute-spec)
8750 (vhdl-template-attribute-decl)))
8752 (defun vhdl-template-attribute-decl ()
8753 "Insert an attribute declaration."
8755 (let ((start (point)))
8756 (vhdl-insert-keyword "ATTRIBUTE ")
8757 (when (vhdl-template-field "name" " : " t start
(point))
8758 (vhdl-template-field "type" ";")
8759 (vhdl-comment-insert-inline))))
8761 (defun vhdl-template-attribute-spec ()
8762 "Insert an attribute specification."
8764 (let ((start (point)))
8765 (vhdl-insert-keyword "ATTRIBUTE ")
8766 (when (vhdl-template-field "name" nil t start
(point))
8767 (vhdl-insert-keyword " OF ")
8768 (vhdl-template-field "entity names | OTHERS | ALL" " : ")
8769 (vhdl-template-field "entity class")
8770 (vhdl-insert-keyword " IS ")
8771 (vhdl-template-field "expression" ";"))))
8773 (defun vhdl-template-block ()
8776 (let ((margin (current-indentation))
8779 (vhdl-insert-keyword ": BLOCK ")
8781 (when (setq label
(vhdl-template-field "label" nil t start
(+ (point) 8)))
8785 (if (vhdl-template-field "[guard expression]" nil t
)
8788 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
8790 (vhdl-template-begin-end "BLOCK" label margin
)
8791 (vhdl-comment-block))))
8793 (defun vhdl-template-block-configuration ()
8794 "Insert a block configuration statement."
8796 (let ((margin (current-indentation))
8798 (vhdl-insert-keyword "FOR ")
8799 (when (vhdl-template-field "block name" nil t start
(point))
8800 (vhdl-insert-keyword "\n\n")
8802 (vhdl-insert-keyword "END FOR;")
8804 (indent-to (+ margin vhdl-basic-offset
)))))
8806 (defun vhdl-template-break ()
8807 "Insert a break statement."
8810 (vhdl-insert-keyword "BREAK")
8811 (setq position
(point))
8814 (progn (vhdl-insert-keyword "FOR ")
8815 (if (vhdl-template-field "[quantity name]" " USE " t
)
8816 (progn (vhdl-template-field "quantity name" " => ") t
)
8817 (delete-region (point)
8818 (progn (forward-word -
1) (point)))
8820 (vhdl-template-field "[quantity name]" " => " t
))
8821 (vhdl-template-field "expression")
8822 (setq position
(point))
8824 (delete-region position
(point))
8825 (unless (vhdl-sequential-statement-p)
8826 (vhdl-insert-keyword " ON ")
8827 (if (vhdl-template-field "[sensitivity list]" nil t
)
8828 (setq position
(point))
8829 (delete-region position
(point))))
8830 (vhdl-insert-keyword " WHEN ")
8831 (when vhdl-conditions-in-parenthesis
(insert "("))
8832 (if (vhdl-template-field "[condition]" nil t
)
8833 (when vhdl-conditions-in-parenthesis
(insert ")"))
8834 (delete-region position
(point)))
8837 (defun vhdl-template-case (&optional kind
)
8838 "Insert a case statement."
8840 (let ((margin (current-indentation))
8843 (unless kind
(setq kind
(if (or (vhdl-sequential-statement-p)
8844 (not (vhdl-standard-p 'ams
))) 'is
'use
)))
8845 (if (or (not (eq vhdl-optional-labels
'all
)) (vhdl-standard-p '87))
8846 (vhdl-insert-keyword "CASE ")
8847 (vhdl-insert-keyword ": CASE ")
8849 (setq label
(vhdl-template-field "[label]" nil t
))
8850 (unless label
(delete-char 2))
8853 (when (vhdl-template-field "expression" nil t start
(point))
8854 (vhdl-insert-keyword (concat " " (if (eq kind
'is
) "IS" "USE") "\n\n"))
8856 (vhdl-insert-keyword "END CASE")
8857 (when label
(insert " " label
))
8860 (indent-to (+ margin vhdl-basic-offset
))
8861 (vhdl-insert-keyword "WHEN ")
8862 (let ((position (point)))
8864 (indent-to (+ margin vhdl-basic-offset
))
8865 (vhdl-insert-keyword "WHEN OTHERS => null;")
8866 (goto-char position
)))))
8868 (defun vhdl-template-case-is ()
8869 "Insert a sequential case statement."
8871 (vhdl-template-case 'is
))
8873 (defun vhdl-template-case-use ()
8874 "Insert a simultaneous case statement."
8876 (vhdl-template-case 'use
))
8878 (defun vhdl-template-component ()
8879 "Insert a component declaration."
8881 (vhdl-template-component-decl))
8883 (defun vhdl-template-component-conf ()
8884 "Insert a component configuration (uses `vhdl-template-configuration-spec'
8885 since these are almost equivalent)."
8887 (let ((margin (current-indentation))
8888 (result (vhdl-template-configuration-spec t
)))
8892 (vhdl-insert-keyword "END FOR;")
8893 (when (eq result
'no-use
)
8894 (end-of-line -
0)))))
8896 (defun vhdl-template-component-decl ()
8897 "Insert a component declaration."
8899 (let ((margin (current-indentation))
8902 (vhdl-insert-keyword "COMPONENT ")
8903 (when (setq name
(vhdl-template-field "name" nil t start
(point)))
8904 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
8907 (vhdl-insert-keyword "END COMPONENT")
8908 (unless (vhdl-standard-p '87) (insert " " name
))
8910 (setq end-column
(current-column))
8912 (indent-to (+ margin vhdl-basic-offset
))
8913 (vhdl-template-generic-list t t
)
8915 (indent-to (+ margin vhdl-basic-offset
))
8916 (vhdl-template-port-list t
)
8917 (beginning-of-line 2)
8918 (forward-char end-column
))))
8920 (defun vhdl-template-component-inst ()
8921 "Insert a component instantiation statement."
8923 (let ((margin (current-indentation))
8926 (when (vhdl-template-field "instance label" nil t start
(point))
8928 (if (not (vhdl-use-direct-instantiation))
8929 (vhdl-template-field "component name")
8930 ;; direct instantiation
8931 (setq unit
(vhdl-template-field
8932 "[COMPONENT | ENTITY | CONFIGURATION]" " " t
))
8933 (setq unit
(upcase (or unit
"")))
8934 (cond ((equal unit
"ENTITY")
8935 (let ((begin (point)))
8936 (vhdl-template-field "library name" "." t begin
(point) nil
8937 (vhdl-work-library))
8938 (vhdl-template-field "entity name" "(")
8939 (if (vhdl-template-field "[architecture name]" nil t
)
8942 ((equal unit
"CONFIGURATION")
8943 (vhdl-template-field "library name" "." nil nil nil nil
8944 (vhdl-work-library))
8945 (vhdl-template-field "configuration name"))
8946 (t (vhdl-template-field "component name"))))
8948 (indent-to (+ margin vhdl-basic-offset
))
8949 (setq position
(point))
8950 (vhdl-insert-keyword "GENERIC ")
8951 (when (vhdl-template-map position t t
)
8953 (indent-to (+ margin vhdl-basic-offset
)))
8954 (setq position
(point))
8955 (vhdl-insert-keyword "PORT ")
8956 (unless (vhdl-template-map position t t
)
8957 (delete-region (line-beginning-position) (point))
8961 (defun vhdl-template-conditional-signal-asst ()
8962 "Insert a conditional signal assignment."
8964 (when (vhdl-template-field "target signal")
8966 (let ((margin (current-column))
8969 (vhdl-template-field "waveform")
8970 (setq position
(point))
8971 (vhdl-insert-keyword " WHEN ")
8972 (when vhdl-conditions-in-parenthesis
(insert "("))
8973 (while (and (vhdl-template-field "[condition]" nil t
)
8975 (when vhdl-conditions-in-parenthesis
(insert ")"))
8976 (setq position
(point))
8977 (vhdl-insert-keyword " ELSE")
8980 (vhdl-template-field "[waveform]" nil t
)))
8981 (setq position
(point))
8982 (vhdl-insert-keyword " WHEN ")
8983 (when vhdl-conditions-in-parenthesis
(insert "(")))
8984 (delete-region position
(point))
8986 (when vhdl-auto-align
(vhdl-align-region-groups start
(point) 1)))))
8988 (defun vhdl-template-configuration ()
8989 "Insert a configuration specification if within an architecture,
8990 a block or component configuration if within a configuration declaration,
8991 a configuration declaration if not within a design unit."
8993 (vhdl-prepare-search-1
8995 ((and (save-excursion ; architecture body
8996 (re-search-backward "^\\(architecture\\|end\\)\\>" nil t
))
8997 (equal "ARCHITECTURE" (upcase (match-string 1))))
8998 (vhdl-template-configuration-spec))
8999 ((and (save-excursion ; configuration declaration
9000 (re-search-backward "^\\(configuration\\|end\\)\\>" nil t
))
9001 (equal "CONFIGURATION" (upcase (match-string 1))))
9002 (if (eq (vhdl-decision-query
9003 "configuration" "(b)lock or (c)omponent configuration?" t
) ?c
)
9004 (vhdl-template-component-conf)
9005 (vhdl-template-block-configuration)))
9006 (t (vhdl-template-configuration-decl))))) ; otherwise
9008 (defun vhdl-template-configuration-spec (&optional optional-use
)
9009 "Insert a configuration specification."
9011 (let ((margin (current-indentation))
9014 (vhdl-insert-keyword "FOR ")
9015 (when (vhdl-template-field "instance names | OTHERS | ALL" " : "
9017 (vhdl-template-field "component name" "\n")
9018 (indent-to (+ margin vhdl-basic-offset
))
9019 (setq start
(point))
9020 (vhdl-insert-keyword "USE ")
9021 (if (and optional-use
9022 (not (setq aspect
(vhdl-template-field
9023 "[ENTITY | CONFIGURATION | OPEN]" " " t
))))
9024 (progn (delete-region start
(point)) 'no-use
)
9025 (unless optional-use
9026 (setq aspect
(vhdl-template-field
9027 "ENTITY | CONFIGURATION | OPEN" " ")))
9028 (setq aspect
(upcase (or aspect
"")))
9029 (cond ((equal aspect
"ENTITY")
9030 (vhdl-template-field "library name" "." nil nil nil nil
9031 (vhdl-work-library))
9032 (vhdl-template-field "entity name" "(")
9033 (if (vhdl-template-field "[architecture name]" nil t
)
9037 (indent-to (+ margin
(* 2 vhdl-basic-offset
)))
9038 (setq position
(point))
9039 (vhdl-insert-keyword "GENERIC ")
9040 (when (vhdl-template-map position t t
)
9042 (indent-to (+ margin
(* 2 vhdl-basic-offset
))))
9043 (setq position
(point))
9044 (vhdl-insert-keyword "PORT ")
9045 (unless (vhdl-template-map position t t
)
9046 (delete-region (line-beginning-position) (point))
9050 ((equal aspect
"CONFIGURATION")
9051 (vhdl-template-field "library name" "." nil nil nil nil
9052 (vhdl-work-library))
9053 (vhdl-template-field "configuration name" ";"))
9054 (t (delete-char -
1) (insert ";") t
))))))
9057 (defun vhdl-template-configuration-decl ()
9058 "Insert a configuration declaration."
9060 (let ((margin (current-indentation))
9062 entity-exists string name position
)
9063 (vhdl-insert-keyword "CONFIGURATION ")
9064 (when (setq name
(vhdl-template-field "name" nil t start
(point)))
9065 (vhdl-insert-keyword " OF ")
9067 (vhdl-prepare-search-1
9068 (setq entity-exists
(vhdl-re-search-backward
9069 "\\<entity \\(\\w*\\) is\\>" nil t
))
9070 (setq string
(match-string 1))))
9071 (if (and entity-exists
(not (equal string
"")))
9073 (vhdl-template-field "entity name"))
9074 (vhdl-insert-keyword " IS\n")
9075 (when (memq vhdl-insert-empty-lines
'(unit all
)) (insert "\n"))
9076 (indent-to (+ margin vhdl-basic-offset
))
9077 (setq position
(point))
9079 (when (memq vhdl-insert-empty-lines
'(unit all
)) (insert "\n"))
9081 (vhdl-insert-keyword "END ")
9082 (unless (vhdl-standard-p '87)
9083 (vhdl-insert-keyword "CONFIGURATION "))
9085 (goto-char position
))))
9087 (defun vhdl-template-constant ()
9088 "Insert a constant declaration."
9090 (let ((start (point))
9091 (in-arglist (vhdl-in-argument-list-p)))
9092 (vhdl-insert-keyword "CONSTANT ")
9093 (when (vhdl-template-field "name" nil t start
(point))
9095 (when in-arglist
(vhdl-insert-keyword "IN "))
9096 (vhdl-template-field "type")
9099 (vhdl-comment-insert-inline))
9100 (let ((position (point)))
9102 (unless (vhdl-template-field "[initialization]" nil t
)
9103 (delete-region position
(point)))
9105 (vhdl-comment-insert-inline))))))
9107 (defun vhdl-template-default ()
9116 (defun vhdl-template-default-indent ()
9117 "Insert nothing and indent."
9124 (indent-according-to-mode))
9126 (defun vhdl-template-disconnect ()
9127 "Insert a disconnect statement."
9129 (let ((start (point)))
9130 (vhdl-insert-keyword "DISCONNECT ")
9131 (when (vhdl-template-field "signal names | OTHERS | ALL"
9132 " : " t start
(point))
9133 (vhdl-template-field "type")
9134 (vhdl-insert-keyword " AFTER ")
9135 (vhdl-template-field "time expression" ";"))))
9137 (defun vhdl-template-else ()
9138 "Insert an else statement."
9141 (vhdl-prepare-search-1
9142 (vhdl-insert-keyword "ELSE")
9143 (if (and (save-excursion (vhdl-re-search-backward "\\(\\<when\\>\\|;\\)" nil t
))
9144 (equal "WHEN" (upcase (match-string 1))))
9146 (indent-according-to-mode)
9147 (setq margin
(current-indentation))
9149 (indent-to (+ margin vhdl-basic-offset
))))))
9151 (defun vhdl-template-elsif ()
9152 "Insert an elsif statement."
9154 (let ((start (point))
9156 (vhdl-insert-keyword "ELSIF ")
9157 (when (or (vhdl-sequential-statement-p) (vhdl-standard-p 'ams
))
9158 (when vhdl-conditions-in-parenthesis
(insert "("))
9159 (when (vhdl-template-field "condition" nil t start
(point))
9160 (when vhdl-conditions-in-parenthesis
(insert ")"))
9161 (indent-according-to-mode)
9162 (setq margin
(current-indentation))
9163 (vhdl-insert-keyword
9164 (concat " " (if (vhdl-sequential-statement-p) "THEN" "USE") "\n"))
9165 (indent-to (+ margin vhdl-basic-offset
))))))
9167 (defun vhdl-template-entity ()
9170 (let ((margin (current-indentation))
9173 (vhdl-insert-keyword "ENTITY ")
9174 (when (setq name
(vhdl-template-field "name" nil t start
(point)))
9175 (vhdl-insert-keyword " IS\n\n")
9177 (vhdl-insert-keyword "END ")
9178 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
9180 (setq end-column
(current-column))
9182 (indent-to (+ margin vhdl-basic-offset
))
9183 (when (memq vhdl-insert-empty-lines
'(unit all
)) (insert "\n"))
9184 (indent-to (+ margin vhdl-basic-offset
))
9185 (when (vhdl-template-generic-list t
)
9186 (when (memq vhdl-insert-empty-lines
'(unit all
)) (insert "\n")))
9188 (indent-to (+ margin vhdl-basic-offset
))
9189 (when (vhdl-template-port-list t
)
9190 (when (memq vhdl-insert-empty-lines
'(unit all
)) (insert "\n")))
9191 (beginning-of-line 2)
9192 (forward-char end-column
))))
9194 (defun vhdl-template-exit ()
9195 "Insert an exit statement."
9197 (let ((start (point)))
9198 (vhdl-insert-keyword "EXIT ")
9199 (if (vhdl-template-field "[loop label]" nil t start
(point))
9200 (let ((position (point)))
9201 (vhdl-insert-keyword " WHEN ")
9202 (when vhdl-conditions-in-parenthesis
(insert "("))
9203 (if (vhdl-template-field "[condition]" nil t
)
9204 (when vhdl-conditions-in-parenthesis
(insert ")"))
9205 (delete-region position
(point))))
9209 (defun vhdl-template-file ()
9210 "Insert a file declaration."
9212 (let ((start (point)))
9213 (vhdl-insert-keyword "FILE ")
9214 (when (vhdl-template-field "name" nil t start
(point))
9216 (vhdl-template-field "type")
9217 (unless (vhdl-standard-p '87)
9218 (vhdl-insert-keyword " OPEN ")
9219 (unless (vhdl-template-field "[READ_MODE | WRITE_MODE | APPEND_MODE]"
9222 (vhdl-insert-keyword " IS ")
9223 (when (vhdl-standard-p '87)
9224 (vhdl-template-field "[IN | OUT]" " " t
))
9225 (vhdl-template-field "filename-string" nil nil nil nil t
)
9227 (vhdl-comment-insert-inline))))
9229 (defun vhdl-template-for ()
9230 "Insert a block or component configuration if within a configuration
9231 declaration, a configuration specification if within an architecture
9232 declarative part (and not within a subprogram), a for-loop if within a
9233 sequential statement part (subprogram or process), and a for-generate
9236 (vhdl-prepare-search-1
9238 ((vhdl-sequential-statement-p) ; sequential statement
9239 (vhdl-template-for-loop))
9240 ((and (save-excursion ; configuration declaration
9241 (re-search-backward "^\\(configuration\\|end\\)\\>" nil t
))
9242 (equal "CONFIGURATION" (upcase (match-string 1))))
9243 (if (eq (vhdl-decision-query
9244 "for" "(b)lock or (c)omponent configuration?" t
) ?c
)
9245 (vhdl-template-component-conf)
9246 (vhdl-template-block-configuration)))
9247 ((and (save-excursion
9248 (re-search-backward ; architecture declarative part
9249 "^\\(architecture\\|entity\\|begin\\|end\\)\\>" nil t
))
9250 (equal "ARCHITECTURE" (upcase (match-string 1))))
9251 (vhdl-template-configuration-spec))
9252 (t (vhdl-template-for-generate))))) ; concurrent statement
9254 (defun vhdl-template-for-generate ()
9255 "Insert a for-generate."
9257 (let ((margin (current-indentation))
9260 (vhdl-insert-keyword ": FOR ")
9261 (setq position
(point-marker))
9263 (when (setq label
(vhdl-template-field "label" nil t start position
))
9264 (goto-char position
)
9265 (vhdl-template-field "loop variable")
9266 (vhdl-insert-keyword " IN ")
9267 (vhdl-template-field "range")
9268 (vhdl-template-generate-body margin label
))))
9270 (defun vhdl-template-for-loop ()
9271 "Insert a for loop."
9273 (let ((margin (current-indentation))
9276 (if (not (eq vhdl-optional-labels
'all
))
9277 (vhdl-insert-keyword "FOR ")
9278 (vhdl-insert-keyword ": FOR ")
9280 (setq label
(vhdl-template-field "[label]" nil t
))
9281 (unless label
(delete-char 2))
9284 (when (setq index
(vhdl-template-field "loop variable"
9285 nil t start
(point)))
9286 (vhdl-insert-keyword " IN ")
9287 (vhdl-template-field "range")
9288 (vhdl-insert-keyword " LOOP\n\n")
9290 (vhdl-insert-keyword "END LOOP")
9292 (insert " " label
";")
9294 (when vhdl-self-insert-comments
(insert " -- " index
)))
9296 (indent-to (+ margin vhdl-basic-offset
)))))
9298 (defun vhdl-template-function (&optional kind
)
9299 "Insert a function declaration or body."
9301 (let ((margin (current-indentation))
9304 (vhdl-insert-keyword "FUNCTION ")
9305 (when (setq name
(vhdl-template-field "name" nil t start
(point)))
9306 (vhdl-template-argument-list t
)
9307 (when vhdl-auto-align
(vhdl-align-region-groups start
(point) 1))
9310 (indent-to (+ margin vhdl-basic-offset
))
9311 (vhdl-insert-keyword "RETURN ")
9312 (vhdl-template-field "type")
9313 (if (if kind
(eq kind
'body
)
9314 (eq (vhdl-decision-query nil
"(d)eclaration or (b)ody?") ?b
))
9315 (progn (vhdl-insert-keyword " IS\n")
9316 (vhdl-template-begin-end
9317 (unless (vhdl-standard-p '87) "FUNCTION") name margin
)
9318 (vhdl-comment-block))
9321 (defun vhdl-template-function-decl ()
9322 "Insert a function declaration."
9324 (vhdl-template-function 'decl
))
9326 (defun vhdl-template-function-body ()
9327 "Insert a function declaration."
9329 (vhdl-template-function 'body
))
9331 (defun vhdl-template-generate ()
9332 "Insert a generation scheme."
9334 (if (eq (vhdl-decision-query nil
"(f)or or (i)f?" t
) ?i
)
9335 (vhdl-template-if-generate)
9336 (vhdl-template-for-generate)))
9338 (defun vhdl-template-generic ()
9339 "Insert generic declaration, or generic map in instantiation statements."
9341 (let ((start (point)))
9342 (vhdl-prepare-search-1
9344 ((and (save-excursion ; entity declaration
9345 (re-search-backward "^\\(entity\\|end\\)\\>" nil t
))
9346 (equal "ENTITY" (upcase (match-string 1))))
9347 (vhdl-template-generic-list nil
))
9348 ((or (save-excursion
9349 (or (beginning-of-line)
9350 (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+")))
9351 (equal 'statement-cont
(caar (vhdl-get-syntactic-context))))
9352 (vhdl-insert-keyword "GENERIC ")
9353 (vhdl-template-map start
))
9354 (t (vhdl-template-generic-list nil t
))))))
9356 (defun vhdl-template-group ()
9357 "Insert group or group template declaration."
9359 (let ((start (point)))
9360 (if (eq (vhdl-decision-query
9361 "group" "(d)eclaration or (t)emplate declaration?" t
) ?t
)
9362 (vhdl-template-group-template)
9363 (vhdl-template-group-decl))))
9365 (defun vhdl-template-group-decl ()
9366 "Insert group declaration."
9368 (let ((start (point)))
9369 (vhdl-insert-keyword "GROUP ")
9370 (when (vhdl-template-field "name" " : " t start
(point))
9371 (vhdl-template-field "template name" " (")
9372 (vhdl-template-field "constituent list" ");")
9373 (vhdl-comment-insert-inline))))
9375 (defun vhdl-template-group-template ()
9376 "Insert group template declaration."
9378 (let ((start (point)))
9379 (vhdl-insert-keyword "GROUP ")
9380 (when (vhdl-template-field "template name" nil t start
(point))
9381 (vhdl-insert-keyword " IS (")
9382 (vhdl-template-field "entity class list" ");")
9383 (vhdl-comment-insert-inline))))
9385 (defun vhdl-template-if ()
9386 "Insert a sequential if statement or an if-generate statement."
9388 (if (vhdl-sequential-statement-p)
9389 (vhdl-template-if-then)
9390 (if (and (vhdl-standard-p 'ams
)
9391 (eq (vhdl-decision-query "if" "(g)enerate or (u)se?" t
) ?u
))
9392 (vhdl-template-if-use)
9393 (vhdl-template-if-generate))))
9395 (defun vhdl-template-if-generate ()
9396 "Insert an if-generate."
9398 (let ((margin (current-indentation))
9401 (vhdl-insert-keyword ": IF ")
9402 (setq position
(point-marker))
9404 (when (setq label
(vhdl-template-field "label" nil t start position
))
9405 (goto-char position
)
9406 (when vhdl-conditions-in-parenthesis
(insert "("))
9407 (vhdl-template-field "condition")
9408 (when vhdl-conditions-in-parenthesis
(insert ")"))
9409 (vhdl-template-generate-body margin label
))))
9411 (defun vhdl-template-if-then-use (kind)
9412 "Insert a sequential if statement."
9414 (let ((margin (current-indentation))
9417 (if (or (not (eq vhdl-optional-labels
'all
)) (vhdl-standard-p '87))
9418 (vhdl-insert-keyword "IF ")
9419 (vhdl-insert-keyword ": IF ")
9421 (setq label
(vhdl-template-field "[label]" nil t
))
9422 (unless label
(delete-char 2))
9425 (when vhdl-conditions-in-parenthesis
(insert "("))
9426 (when (vhdl-template-field "condition" nil t start
(point))
9427 (when vhdl-conditions-in-parenthesis
(insert ")"))
9428 (vhdl-insert-keyword
9429 (concat " " (if (eq kind
'then
) "THEN" "USE") "\n\n"))
9431 (vhdl-insert-keyword (concat "END " (if (eq kind
'then
) "IF" "USE")))
9432 (when label
(insert " " label
))
9435 (indent-to (+ margin vhdl-basic-offset
)))))
9437 (defun vhdl-template-if-then ()
9438 "Insert a sequential if statement."
9440 (vhdl-template-if-then-use 'then
))
9442 (defun vhdl-template-if-use ()
9443 "Insert a simultaneous if statement."
9445 (vhdl-template-if-then-use 'use
))
9447 (defun vhdl-template-instance ()
9448 "Insert a component instantiation statement."
9450 (vhdl-template-component-inst))
9452 (defun vhdl-template-library ()
9453 "Insert a library specification."
9455 (let ((margin (current-indentation))
9458 (vhdl-insert-keyword "LIBRARY ")
9459 (when (setq name
(vhdl-template-field "names" nil t start
(point)))
9461 (unless (string-match "," name
)
9462 (setq end-pos
(point))
9465 (vhdl-insert-keyword "USE ")
9467 (vhdl-insert-keyword "..ALL;")
9469 (if (vhdl-template-field "package name")
9471 (delete-region end-pos
(+ (point) 5)))))))
9473 (defun vhdl-template-limit ()
9476 (let ((start (point)))
9477 (vhdl-insert-keyword "LIMIT ")
9478 (when (vhdl-template-field "quantity names | OTHERS | ALL" " : "
9480 (vhdl-template-field "type")
9481 (vhdl-insert-keyword " WITH ")
9482 (vhdl-template-field "real expression" ";"))))
9484 (defun vhdl-template-loop ()
9487 (let ((char (vhdl-decision-query nil
"(w)hile, (f)or, or (b)are?" t
)))
9489 (vhdl-template-while-loop))
9491 (vhdl-template-for-loop))
9492 (t (vhdl-template-bare-loop)))))
9494 (defun vhdl-template-bare-loop ()
9497 (let ((margin (current-indentation))
9500 (if (not (eq vhdl-optional-labels
'all
))
9501 (vhdl-insert-keyword "LOOP ")
9502 (vhdl-insert-keyword ": LOOP ")
9504 (setq label
(vhdl-template-field "[label]" nil t
))
9505 (unless label
(delete-char 2))
9510 (vhdl-insert-keyword "END LOOP")
9511 (insert (if label
(concat " " label
";") ";"))
9513 (indent-to (+ margin vhdl-basic-offset
))))
9515 (defun vhdl-template-map (&optional start optional secondary
)
9516 "Insert a map specification with association list."
9518 (let ((start (or start
(point)))
9520 (vhdl-insert-keyword "MAP (")
9521 (if (not vhdl-association-list-with-formals
)
9522 (if (vhdl-template-field
9523 (concat (and optional
"[") "association list" (and optional
"]"))
9524 ")" (or (not secondary
) optional
)
9525 (and (not secondary
) start
) (point))
9527 (if (and optional secondary
) (delete-region start
(point)))
9529 (if vhdl-argument-list-indent
9530 (setq margin
(current-column))
9531 (setq margin
(+ (current-indentation) vhdl-basic-offset
))
9534 (if (vhdl-template-field
9535 (concat (and optional
"[") "formal" (and optional
"]"))
9536 " => " (or (not secondary
) optional
)
9537 (and (not secondary
) start
) (point))
9539 (vhdl-template-field "actual" ",")
9540 (setq end-pos
(point))
9543 (while (vhdl-template-field "[formal]" " => " t
)
9544 (vhdl-template-field "actual" ",")
9545 (setq end-pos
(point))
9548 (delete-region end-pos
(point))
9551 (when vhdl-auto-align
(vhdl-align-region-groups start
(point) 1))
9553 (when (and optional secondary
) (delete-region start
(point)))
9556 (defun vhdl-template-modify (&optional noerror
)
9557 "Actualize modification date."
9559 (vhdl-prepare-search-2
9561 (goto-char (point-min))
9562 (if (re-search-forward vhdl-modify-date-prefix-string nil t
)
9563 (progn (delete-region (point) (progn (end-of-line) (point)))
9564 (vhdl-template-insert-date))
9566 (error "ERROR: Modification date prefix string \"%s\" not found"
9567 vhdl-modify-date-prefix-string
))))))
9570 (defun vhdl-template-modify-noerror ()
9571 "Call `vhdl-template-modify' with NOERROR non-nil."
9572 (vhdl-template-modify t
))
9574 (defun vhdl-template-nature ()
9575 "Insert a nature declaration."
9577 (let ((start (point))
9578 name mid-pos end-pos
)
9579 (vhdl-insert-keyword "NATURE ")
9580 (when (setq name
(vhdl-template-field "name" nil t start
(point)))
9581 (vhdl-insert-keyword " IS ")
9584 (or (vhdl-template-field
9585 "across type | ARRAY | RECORD")
9587 (cond ((equal definition
"")
9589 ((equal definition
"ARRAY")
9590 (delete-region (point) (progn (forward-word -
1) (point)))
9591 (vhdl-template-array 'nature t
))
9592 ((equal definition
"RECORD")
9593 (setq mid-pos
(point-marker))
9594 (delete-region (point) (progn (forward-word -
1) (point)))
9595 (vhdl-template-record 'nature name t
))
9597 (vhdl-insert-keyword " ACROSS ")
9598 (vhdl-template-field "through type")
9599 (vhdl-insert-keyword " THROUGH ")
9600 (vhdl-template-field "reference name")
9601 (vhdl-insert-keyword " REFERENCE;")))
9603 (setq end-pos
(point-marker))
9606 (vhdl-comment-insert-inline)
9607 (when end-pos
(goto-char end-pos
))))))
9609 (defun vhdl-template-next ()
9610 "Insert a next statement."
9612 (let ((start (point)))
9613 (vhdl-insert-keyword "NEXT ")
9614 (if (vhdl-template-field "[loop label]" nil t start
(point))
9615 (let ((position (point)))
9616 (vhdl-insert-keyword " WHEN ")
9617 (when vhdl-conditions-in-parenthesis
(insert "("))
9618 (if (vhdl-template-field "[condition]" nil t
)
9619 (when vhdl-conditions-in-parenthesis
(insert ")"))
9620 (delete-region position
(point))))
9624 (defun vhdl-template-others ()
9625 "Insert an others aggregate."
9627 (let ((start (point)))
9628 (if (or (= (preceding-char) ?\
() (not vhdl-template-invoked-by-hook
))
9629 (progn (unless vhdl-template-invoked-by-hook
(insert "("))
9630 (vhdl-insert-keyword "OTHERS => '")
9631 (when (vhdl-template-field "value" nil t start
(point))
9633 (vhdl-insert-keyword "OTHERS "))))
9635 (defun vhdl-template-package (&optional kind
)
9636 "Insert a package specification or body."
9638 (let ((margin (current-indentation))
9641 (vhdl-insert-keyword "PACKAGE ")
9642 (setq body
(if kind
(eq kind
'body
)
9643 (eq (vhdl-decision-query nil
"(d)eclaration or (b)ody?") ?b
)))
9645 (vhdl-insert-keyword "BODY ")
9646 (when (save-excursion
9647 (vhdl-prepare-search-1
9648 (vhdl-re-search-backward "\\<package \\(\\w+\\) is\\>" nil t
)))
9649 (insert (setq name
(match-string 1)))))
9651 (setq name
(vhdl-template-field "name" nil t start
(point))))
9652 (vhdl-insert-keyword " IS\n")
9653 (when (memq vhdl-insert-empty-lines
'(unit all
)) (insert "\n"))
9654 (indent-to (+ margin vhdl-basic-offset
))
9655 (setq position
(point))
9657 (when (memq vhdl-insert-empty-lines
'(unit all
)) (insert "\n"))
9659 (vhdl-insert-keyword "END ")
9660 (unless (vhdl-standard-p '87)
9661 (vhdl-insert-keyword (concat "PACKAGE " (and body
"BODY "))))
9662 (insert (or name
"") ";")
9663 (goto-char position
))))
9665 (defun vhdl-template-package-decl ()
9666 "Insert a package specification."
9668 (vhdl-template-package 'decl
))
9670 (defun vhdl-template-package-body ()
9671 "Insert a package body."
9673 (vhdl-template-package 'body
))
9675 (defun vhdl-template-port ()
9676 "Insert a port declaration, or port map in instantiation statements."
9678 (let ((start (point)))
9679 (vhdl-prepare-search-1
9681 ((and (save-excursion ; entity declaration
9682 (re-search-backward "^\\(entity\\|end\\)\\>" nil t
))
9683 (equal "ENTITY" (upcase (match-string 1))))
9684 (vhdl-template-port-list nil
))
9685 ((or (save-excursion
9686 (or (beginning-of-line)
9687 (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+")))
9688 (equal 'statement-cont
(caar (vhdl-get-syntactic-context))))
9689 (vhdl-insert-keyword "PORT ")
9690 (vhdl-template-map start
))
9691 (t (vhdl-template-port-list nil
))))))
9693 (defun vhdl-template-procedural ()
9694 "Insert a procedural."
9696 (let ((margin (current-indentation))
9698 (case-fold-search t
)
9700 (vhdl-insert-keyword "PROCEDURAL ")
9701 (when (memq vhdl-optional-labels
'(process all
))
9705 (setq label
(vhdl-template-field "[label]" nil t
))
9706 (unless label
(delete-char 2))
9709 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "IS"))
9711 (vhdl-template-begin-end "PROCEDURAL" label margin
)
9712 (vhdl-comment-block)))
9714 (defun vhdl-template-procedure (&optional kind
)
9715 "Insert a procedure declaration or body."
9717 (let ((margin (current-indentation))
9720 (vhdl-insert-keyword "PROCEDURE ")
9721 (when (setq name
(vhdl-template-field "name" nil t start
(point)))
9722 (vhdl-template-argument-list)
9723 (if (if kind
(eq kind
'body
)
9724 (eq (vhdl-decision-query nil
"(d)eclaration or (b)ody?") ?b
))
9725 (progn (vhdl-insert-keyword " IS")
9726 (when vhdl-auto-align
9727 (vhdl-align-region-groups start
(point) 1))
9728 (end-of-line) (insert "\n")
9729 (vhdl-template-begin-end
9730 (unless (vhdl-standard-p '87) "PROCEDURE")
9732 (vhdl-comment-block))
9734 (when vhdl-auto-align
(vhdl-align-region-groups start
(point) 1))
9737 (defun vhdl-template-procedure-decl ()
9738 "Insert a procedure declaration."
9740 (vhdl-template-procedure 'decl
))
9742 (defun vhdl-template-procedure-body ()
9743 "Insert a procedure body."
9745 (vhdl-template-procedure 'body
))
9747 (defun vhdl-template-process (&optional kind
)
9750 (let ((margin (current-indentation))
9752 (reset-kind vhdl-reset-kind
)
9753 label seq input-signals clock reset final-pos
)
9754 (setq seq
(if kind
(eq kind
'seq
)
9755 (eq (vhdl-decision-query
9756 "process" "(c)ombinational or (s)equential?" t
) ?s
)))
9757 (vhdl-insert-keyword "PROCESS ")
9758 (when (memq vhdl-optional-labels
'(process all
))
9762 (setq label
(vhdl-template-field "[label]" nil t
))
9763 (unless label
(delete-char 2))
9768 (unless (setq input-signals
9769 (vhdl-template-field "[sensitivity list]" ")" t
))
9770 (setq input-signals
"")
9772 (setq clock
(or (and (not (equal "" vhdl-clock-name
))
9773 (progn (insert vhdl-clock-name
) vhdl-clock-name
))
9774 (vhdl-template-field "clock name") "<clock>"))
9775 (when (eq reset-kind
'query
)
9777 (if (eq (vhdl-decision-query
9778 "" "(a)synchronous or (s)ynchronous reset?" t
) ?a
)
9781 (when (eq reset-kind
'async
)
9783 (setq reset
(or (and (not (equal "" vhdl-reset-name
))
9784 (progn (insert vhdl-reset-name
) vhdl-reset-name
))
9785 (vhdl-template-field "reset name") "<reset>")))
9787 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
9789 (vhdl-template-begin-end "PROCESS" label margin
)
9790 (when seq
(setq reset
(vhdl-template-seq-process clock reset reset-kind
)))
9791 (when vhdl-prompt-for-comments
9792 (setq final-pos
(point-marker))
9793 (vhdl-prepare-search-2
9794 (when (and (vhdl-re-search-backward "\\<begin\\>" nil t
)
9795 (vhdl-re-search-backward "\\<process\\>" nil t
))
9798 (progn (insert "\n") (forward-line -
1))
9801 (insert "-- purpose: ")
9802 (if (not (vhdl-template-field "[description]" nil t
))
9803 (vhdl-line-kill-entire)
9806 (insert "-- type : ")
9807 (insert (if seq
"sequential" "combinational") "\n")
9809 (insert "-- inputs : ")
9811 (insert input-signals
)
9813 (when reset
(insert reset
", "))
9814 (unless (vhdl-template-field "[signal names]" nil t
)
9818 (insert "-- outputs: ")
9819 (vhdl-template-field "[signal names]" nil t
))))
9820 (goto-char final-pos
))))
9822 (defun vhdl-template-process-comb ()
9823 "Insert a combinational process."
9825 (vhdl-template-process 'comb
))
9827 (defun vhdl-template-process-seq ()
9828 "Insert a sequential process."
9830 (vhdl-template-process 'seq
))
9832 (defun vhdl-template-quantity ()
9833 "Insert a quantity declaration."
9835 (if (vhdl-in-argument-list-p)
9836 (let ((start (point)))
9837 (vhdl-insert-keyword "QUANTITY ")
9838 (when (vhdl-template-field "names" nil t start
(point))
9840 (vhdl-template-field "[IN | OUT]" " " t
)
9841 (vhdl-template-field "type")
9843 (vhdl-comment-insert-inline)))
9844 (let ((char (vhdl-decision-query
9845 "quantity" "(f)ree, (b)ranch, or (s)ource quantity?" t
)))
9846 (cond ((eq char ?f
) (vhdl-template-quantity-free))
9847 ((eq char ?b
) (vhdl-template-quantity-branch))
9848 ((eq char ?s
) (vhdl-template-quantity-source))
9849 (t (vhdl-template-undo (point) (point)))))))
9851 (defun vhdl-template-quantity-free ()
9852 "Insert a free quantity declaration."
9854 (vhdl-insert-keyword "QUANTITY ")
9855 (vhdl-template-field "names")
9857 (vhdl-template-field "type")
9858 (let ((position (point)))
9860 (unless (vhdl-template-field "[initialization]" nil t
)
9861 (delete-region position
(point)))
9863 (vhdl-comment-insert-inline)))
9865 (defun vhdl-template-quantity-branch ()
9866 "Insert a branch quantity declaration."
9869 (vhdl-insert-keyword "QUANTITY ")
9870 (when (vhdl-template-field "[across names]" " " t
)
9871 (vhdl-insert-keyword "ACROSS "))
9872 (when (vhdl-template-field "[through names]" " " t
)
9873 (vhdl-insert-keyword "THROUGH "))
9874 (vhdl-template-field "plus terminal name")
9875 (setq position
(point))
9876 (vhdl-insert-keyword " TO ")
9877 (unless (vhdl-template-field "[minus terminal name]" nil t
)
9878 (delete-region position
(point)))
9880 (vhdl-comment-insert-inline)))
9882 (defun vhdl-template-quantity-source ()
9883 "Insert a source quantity declaration."
9885 (vhdl-insert-keyword "QUANTITY ")
9886 (vhdl-template-field "names")
9888 (vhdl-template-field "type" " ")
9889 (if (eq (vhdl-decision-query nil
"(s)pectrum or (n)oise?") ?n
)
9890 (progn (vhdl-insert-keyword "NOISE ")
9891 (vhdl-template-field "power expression"))
9892 (vhdl-insert-keyword "SPECTRUM ")
9893 (vhdl-template-field "magnitude expression" ", ")
9894 (vhdl-template-field "phase expression"))
9896 (vhdl-comment-insert-inline))
9898 (defun vhdl-template-record (kind &optional name secondary
)
9899 "Insert a record type declaration."
9901 (let ((margin (current-indentation))
9904 (vhdl-insert-keyword "RECORD\n")
9905 (indent-to (+ margin vhdl-basic-offset
))
9906 (when (or (vhdl-template-field "element names"
9907 nil
(not secondary
) start
(point))
9909 (while (or first
(vhdl-template-field "[element names]" nil t
))
9911 (vhdl-template-field (if (eq kind
'type
) "type" "nature") ";")
9912 (vhdl-comment-insert-inline)
9914 (indent-to (+ margin vhdl-basic-offset
))
9916 (delete-region (line-beginning-position) (point))
9918 (vhdl-insert-keyword "END RECORD")
9919 (unless (vhdl-standard-p '87) (and name
(insert " " name
)))
9921 (when vhdl-auto-align
(vhdl-align-region-groups start
(point) 1)))))
9923 (defun vhdl-template-report ()
9924 "Insert a report statement."
9926 (let ((start (point)))
9927 (vhdl-insert-keyword "REPORT ")
9928 (if (equal "\"\"" (vhdl-template-field
9929 "string expression" nil t start
(point) t
))
9931 (setq start
(point))
9932 (vhdl-insert-keyword " SEVERITY ")
9933 (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t
)
9934 (delete-region start
(point)))
9937 (defun vhdl-template-return ()
9938 "Insert a return statement."
9940 (let ((start (point)))
9941 (vhdl-insert-keyword "RETURN ")
9942 (unless (vhdl-template-field "[expression]" nil t start
(point))
9946 (defun vhdl-template-selected-signal-asst ()
9947 "Insert a selected signal assignment."
9949 (let ((margin (current-indentation))
9952 (let ((position (point)))
9953 (vhdl-insert-keyword " SELECT ")
9954 (goto-char position
))
9955 (vhdl-insert-keyword "WITH ")
9956 (when (vhdl-template-field "selector expression"
9957 nil t start
(+ (point) 7))
9961 (indent-to (+ margin vhdl-basic-offset
))
9962 (vhdl-template-field "target signal" " <= ")
9964 (indent-to (+ margin vhdl-basic-offset
))
9965 (vhdl-template-field "waveform")
9966 (vhdl-insert-keyword " WHEN ")
9967 (vhdl-template-field "choices" ",")
9969 (indent-to (+ margin vhdl-basic-offset
))
9970 (while (and choices
(vhdl-template-field "[waveform]" nil t
))
9971 (vhdl-insert-keyword " WHEN ")
9972 (if (setq choices
(vhdl-template-field "[choices]" "," t
))
9973 (progn (insert "\n") (indent-to (+ margin vhdl-basic-offset
)))
9974 (vhdl-insert-keyword "OTHERS")))
9979 (when vhdl-auto-align
(vhdl-align-region-groups start
(point) 1)))))
9981 (defun vhdl-template-signal ()
9982 "Insert a signal declaration."
9984 (let ((start (point))
9985 (in-arglist (vhdl-in-argument-list-p)))
9986 (vhdl-insert-keyword "SIGNAL ")
9987 (when (vhdl-template-field "names" nil t start
(point))
9989 (when in-arglist
(vhdl-template-field "[IN | OUT | INOUT]" " " t
))
9990 (vhdl-template-field "type")
9993 (vhdl-comment-insert-inline))
9994 (let ((position (point)))
9996 (unless (vhdl-template-field "[initialization]" nil t
)
9997 (delete-region position
(point)))
9999 (vhdl-comment-insert-inline))))))
10001 (defun vhdl-template-subnature ()
10002 "Insert a subnature declaration."
10004 (let ((start (point))
10006 (vhdl-insert-keyword "SUBNATURE ")
10007 (when (vhdl-template-field "name" nil t start
(point))
10008 (vhdl-insert-keyword " IS ")
10009 (vhdl-template-field "nature" " (")
10010 (if (vhdl-template-field "[index range]" nil t
)
10013 (setq position
(point))
10014 (vhdl-insert-keyword " TOLERANCE ")
10015 (if (equal "\"\"" (vhdl-template-field "[string expression]"
10017 (delete-region position
(point))
10018 (vhdl-insert-keyword " ACROSS ")
10019 (vhdl-template-field "string expression" nil nil nil nil t
)
10020 (vhdl-insert-keyword " THROUGH"))
10022 (vhdl-comment-insert-inline))))
10024 (defun vhdl-template-subprogram-body ()
10025 "Insert a subprogram body."
10027 (if (eq (vhdl-decision-query nil
"(p)rocedure or (f)unction?" t
) ?f
)
10028 (vhdl-template-function-body)
10029 (vhdl-template-procedure-body)))
10031 (defun vhdl-template-subprogram-decl ()
10032 "Insert a subprogram declaration."
10034 (if (eq (vhdl-decision-query nil
"(p)rocedure or (f)unction?" t
) ?f
)
10035 (vhdl-template-function-decl)
10036 (vhdl-template-procedure-decl)))
10038 (defun vhdl-template-subtype ()
10039 "Insert a subtype declaration."
10041 (let ((start (point)))
10042 (vhdl-insert-keyword "SUBTYPE ")
10043 (when (vhdl-template-field "name" nil t start
(point))
10044 (vhdl-insert-keyword " IS ")
10045 (vhdl-template-field "type" " ")
10047 (vhdl-template-field "[RANGE value range | ( index range )]" nil t
)
10050 (vhdl-comment-insert-inline))))
10052 (defun vhdl-template-terminal ()
10053 "Insert a terminal declaration."
10055 (let ((start (point)))
10056 (vhdl-insert-keyword "TERMINAL ")
10057 (when (vhdl-template-field "names" nil t start
(point))
10059 (vhdl-template-field "nature")
10061 (vhdl-comment-insert-inline))))
10063 (defun vhdl-template-type ()
10064 "Insert a type declaration."
10066 (let ((start (point))
10067 name mid-pos end-pos
)
10068 (vhdl-insert-keyword "TYPE ")
10069 (when (setq name
(vhdl-template-field "name" nil t start
(point)))
10070 (vhdl-insert-keyword " IS ")
10073 (or (vhdl-template-field
10074 "[scalar type | ARRAY | RECORD | ACCESS | FILE | ENUM]" nil t
)
10076 (cond ((equal definition
"")
10079 ((equal definition
"ARRAY")
10080 (delete-region (point) (progn (forward-word -
1) (point)))
10081 (vhdl-template-array 'type t
))
10082 ((equal definition
"RECORD")
10083 (setq mid-pos
(point-marker))
10084 (delete-region (point) (progn (forward-word -
1) (point)))
10085 (vhdl-template-record 'type name t
))
10086 ((equal definition
"ACCESS")
10088 (vhdl-template-field "type" ";"))
10089 ((equal definition
"FILE")
10090 (vhdl-insert-keyword " OF ")
10091 (vhdl-template-field "type" ";"))
10092 ((equal definition
"ENUM")
10095 (setq end-pos
(point-marker))
10099 (setq end-pos
(point-marker))
10100 (goto-char mid-pos
)
10102 (vhdl-comment-insert-inline)
10103 (when end-pos
(goto-char end-pos
))))))
10105 (defun vhdl-template-use ()
10106 "Insert a use clause."
10108 (let ((start (point)))
10109 (vhdl-prepare-search-1
10110 (vhdl-insert-keyword "USE ")
10111 (when (save-excursion (beginning-of-line) (looking-at "^\\s-*use\\>"))
10112 (vhdl-insert-keyword "..ALL;")
10114 (when (vhdl-template-field "library name" nil t start
(+ (point) 6))
10116 (vhdl-template-field "package name")
10117 (forward-char 5))))))
10119 (defun vhdl-template-variable ()
10120 "Insert a variable declaration."
10122 (let ((start (point))
10123 (in-arglist (vhdl-in-argument-list-p)))
10124 (vhdl-prepare-search-2
10125 (if (or (save-excursion
10126 (progn (vhdl-beginning-of-block)
10127 (looking-at "\\s-*\\(\\w+\\s-*:\\s-*\\)?\\<\\(\\<function\\|procedure\\|process\\|procedural\\)\\>")))
10128 (save-excursion (backward-word 1) (looking-at "\\<shared\\>")))
10129 (vhdl-insert-keyword "VARIABLE ")
10130 (if (vhdl-standard-p '87)
10131 (error "ERROR: Not within sequential block")
10132 (vhdl-insert-keyword "SHARED VARIABLE "))))
10133 (when (vhdl-template-field "names" nil t start
(point))
10135 (when in-arglist
(vhdl-template-field "[IN | OUT | INOUT]" " " t
))
10136 (vhdl-template-field "type")
10138 (progn (insert ";")
10139 (vhdl-comment-insert-inline))
10140 (let ((position (point)))
10142 (unless (vhdl-template-field "[initialization]" nil t
)
10143 (delete-region position
(point)))
10145 (vhdl-comment-insert-inline))))))
10147 (defun vhdl-template-wait ()
10148 "Insert a wait statement."
10150 (vhdl-insert-keyword "WAIT ")
10151 (unless (vhdl-template-field
10152 "[ON sensitivity list] [UNTIL condition] [FOR time expression]"
10157 (defun vhdl-template-when ()
10158 "Indent correctly if within a case statement."
10160 (let ((position (point))
10162 (vhdl-prepare-search-2
10163 (if (and (= (current-column) (current-indentation))
10164 (vhdl-re-search-forward "\\<end\\>" nil t
)
10165 (looking-at "\\s-*\\<case\\>"))
10167 (setq margin
(current-indentation))
10168 (goto-char position
)
10169 (delete-horizontal-space)
10170 (indent-to (+ margin vhdl-basic-offset
)))
10171 (goto-char position
)))
10172 (vhdl-insert-keyword "WHEN ")))
10174 (defun vhdl-template-while-loop ()
10175 "Insert a while loop."
10177 (let* ((margin (current-indentation))
10180 (if (not (eq vhdl-optional-labels
'all
))
10181 (vhdl-insert-keyword "WHILE ")
10182 (vhdl-insert-keyword ": WHILE ")
10184 (setq label
(vhdl-template-field "[label]" nil t
))
10185 (unless label
(delete-char 2))
10188 (when vhdl-conditions-in-parenthesis
(insert "("))
10189 (when (vhdl-template-field "condition" nil t start
(point))
10190 (when vhdl-conditions-in-parenthesis
(insert ")"))
10191 (vhdl-insert-keyword " LOOP\n\n")
10193 (vhdl-insert-keyword "END LOOP")
10194 (insert (if label
(concat " " label
";") ";"))
10196 (indent-to (+ margin vhdl-basic-offset
)))))
10198 (defun vhdl-template-with ()
10199 "Insert a with statement (i.e. selected signal assignment)."
10201 (vhdl-prepare-search-1
10202 (if (and (save-excursion (vhdl-re-search-backward "\\(\\<limit\\>\\|;\\)"))
10203 (equal ";" (match-string 1)))
10204 (vhdl-template-selected-signal-asst)
10205 (vhdl-insert-keyword "WITH "))))
10207 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10208 ;; Special templates
10210 (defun vhdl-template-clocked-wait ()
10211 "Insert a wait statement for rising/falling clock edge."
10213 (let ((start (point))
10215 (vhdl-insert-keyword "WAIT UNTIL ")
10217 (or (and (not (equal "" vhdl-clock-name
))
10218 (progn (insert vhdl-clock-name
) vhdl-clock-name
))
10219 (vhdl-template-field "clock name" nil t start
(point))))
10221 (vhdl-insert-keyword " AND ")
10224 " = " (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string
) ";")
10225 (vhdl-comment-insert-inline
10226 (concat (if vhdl-clock-rising-edge
"rising" "falling")
10229 (defun vhdl-template-seq-process (clock reset reset-kind
)
10230 "Insert a template for the body of a sequential process."
10231 (let ((margin (current-indentation))
10233 (vhdl-insert-keyword "IF ")
10234 (when vhdl-conditions-in-parenthesis
(insert "("))
10235 (when (eq reset-kind
'async
)
10236 (insert reset
" = "
10237 (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string
))
10238 (when vhdl-conditions-in-parenthesis
(insert ")"))
10239 (vhdl-insert-keyword " THEN")
10240 (vhdl-comment-insert-inline
10241 (concat "asynchronous reset (active "
10242 (if vhdl-reset-active-high
"high" "low") ")"))
10243 (insert "\n") (indent-to (+ margin vhdl-basic-offset
))
10244 (setq position
(point))
10245 (insert "\n") (indent-to margin
)
10246 (vhdl-insert-keyword "ELSIF ")
10247 (when vhdl-conditions-in-parenthesis
(insert "(")))
10248 (if (eq vhdl-clock-edge-condition
'function
)
10249 (insert (if vhdl-clock-rising-edge
"rising" "falling")
10250 "_edge(" clock
")")
10251 (insert clock
"'event")
10252 (vhdl-insert-keyword " AND ")
10253 (insert clock
" = "
10254 (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string
)))
10255 (when vhdl-conditions-in-parenthesis
(insert ")"))
10256 (vhdl-insert-keyword " THEN")
10257 (vhdl-comment-insert-inline
10258 (concat (if vhdl-clock-rising-edge
"rising" "falling") " clock edge"))
10259 (insert "\n") (indent-to (+ margin vhdl-basic-offset
))
10260 (when (eq reset-kind
'sync
)
10261 (vhdl-insert-keyword "IF ")
10262 (when vhdl-conditions-in-parenthesis
(insert "("))
10263 (setq reset
(or (and (not (equal "" vhdl-reset-name
))
10264 (progn (insert vhdl-reset-name
) vhdl-reset-name
))
10265 (vhdl-template-field "reset name") "<reset>"))
10267 (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string
))
10268 (when vhdl-conditions-in-parenthesis
(insert ")"))
10269 (vhdl-insert-keyword " THEN")
10270 (vhdl-comment-insert-inline
10271 (concat "synchronous reset (active "
10272 (if vhdl-reset-active-high
"high" "low") ")"))
10273 (insert "\n") (indent-to (+ margin
(* 2 vhdl-basic-offset
)))
10274 (setq position
(point))
10275 (insert "\n") (indent-to (+ margin vhdl-basic-offset
))
10276 (vhdl-insert-keyword "ELSE")
10277 (insert "\n") (indent-to (+ margin
(* 2 vhdl-basic-offset
)))
10278 (insert "\n") (indent-to (+ margin vhdl-basic-offset
))
10279 (vhdl-insert-keyword "END IF;"))
10280 (when (eq reset-kind
'none
)
10281 (setq position
(point)))
10282 (insert "\n") (indent-to margin
)
10283 (vhdl-insert-keyword "END IF;")
10284 (goto-char position
)
10287 (defun vhdl-template-standard-package (library package
)
10288 "Insert specification of a standard package. Include a library
10289 specification, if not already there."
10290 (let ((margin (current-indentation)))
10291 (unless (equal library
"std")
10292 (unless (or (save-excursion
10293 (vhdl-prepare-search-1
10295 (re-search-backward
10296 (concat "^\\s-*\\(\\(library\\)\\s-+\\(\\w+\\s-*,\\s-*\\)*"
10297 library
"\\|end\\)\\>") nil t
)
10298 (match-string 2))))
10299 (equal (downcase library
) "work"))
10300 (vhdl-insert-keyword "LIBRARY ")
10301 (insert library
";")
10304 (indent-to margin
))))
10306 (vhdl-insert-keyword "USE ")
10307 (insert library
"." package
)
10308 (vhdl-insert-keyword ".ALL;"))))
10310 (defun vhdl-template-package-numeric-bit ()
10311 "Insert specification of `numeric_bit' package."
10313 (vhdl-template-standard-package "ieee" "numeric_bit"))
10315 (defun vhdl-template-package-numeric-std ()
10316 "Insert specification of `numeric_std' package."
10318 (vhdl-template-standard-package "ieee" "numeric_std"))
10320 (defun vhdl-template-package-std-logic-1164 ()
10321 "Insert specification of `std_logic_1164' package."
10323 (vhdl-template-standard-package "ieee" "std_logic_1164"))
10325 (defun vhdl-template-package-std-logic-arith ()
10326 "Insert specification of `std_logic_arith' package."
10328 (vhdl-template-standard-package "ieee" "std_logic_arith"))
10330 (defun vhdl-template-package-std-logic-misc ()
10331 "Insert specification of `std_logic_misc' package."
10333 (vhdl-template-standard-package "ieee" "std_logic_misc"))
10335 (defun vhdl-template-package-std-logic-signed ()
10336 "Insert specification of `std_logic_signed' package."
10338 (vhdl-template-standard-package "ieee" "std_logic_signed"))
10340 (defun vhdl-template-package-std-logic-textio ()
10341 "Insert specification of `std_logic_textio' package."
10343 (vhdl-template-standard-package "ieee" "std_logic_textio"))
10345 (defun vhdl-template-package-std-logic-unsigned ()
10346 "Insert specification of `std_logic_unsigned' package."
10348 (vhdl-template-standard-package "ieee" "std_logic_unsigned"))
10350 (defun vhdl-template-package-textio ()
10351 "Insert specification of `textio' package."
10353 (vhdl-template-standard-package "std" "textio"))
10355 (defun vhdl-template-package-fundamental-constants ()
10356 "Insert specification of `fundamental_constants' package."
10358 (vhdl-template-standard-package "ieee" "fundamental_constants"))
10360 (defun vhdl-template-package-material-constants ()
10361 "Insert specification of `material_constants' package."
10363 (vhdl-template-standard-package "ieee" "material_constants"))
10365 (defun vhdl-template-package-energy-systems ()
10366 "Insert specification of `energy_systems' package."
10368 (vhdl-template-standard-package "ieee" "energy_systems"))
10370 (defun vhdl-template-package-electrical-systems ()
10371 "Insert specification of `electrical_systems' package."
10373 (vhdl-template-standard-package "ieee" "electrical_systems"))
10375 (defun vhdl-template-package-mechanical-systems ()
10376 "Insert specification of `mechanical_systems' package."
10378 (vhdl-template-standard-package "ieee" "mechanical_systems"))
10380 (defun vhdl-template-package-radiant-systems ()
10381 "Insert specification of `radiant_systems' package."
10383 (vhdl-template-standard-package "ieee" "radiant_systems"))
10385 (defun vhdl-template-package-thermal-systems ()
10386 "Insert specification of `thermal_systems' package."
10388 (vhdl-template-standard-package "ieee" "thermal_systems"))
10390 (defun vhdl-template-package-fluidic-systems ()
10391 "Insert specification of `fluidic_systems' package."
10393 (vhdl-template-standard-package "ieee" "fluidic_systems"))
10395 (defun vhdl-template-package-math-complex ()
10396 "Insert specification of `math_complex' package."
10398 (vhdl-template-standard-package "ieee" "math_complex"))
10400 (defun vhdl-template-package-math-real ()
10401 "Insert specification of `math_real' package."
10403 (vhdl-template-standard-package "ieee" "math_real"))
10405 (defun vhdl-template-directive (directive)
10406 "Insert directive."
10407 (unless (= (current-indentation) (current-column))
10408 (delete-horizontal-space)
10410 (insert "-- pragma " directive
))
10412 (defun vhdl-template-directive-translate-on ()
10413 "Insert directive 'translate_on'."
10415 (vhdl-template-directive "translate_on"))
10417 (defun vhdl-template-directive-translate-off ()
10418 "Insert directive 'translate_off'."
10420 (vhdl-template-directive "translate_off"))
10422 (defun vhdl-template-directive-synthesis-on ()
10423 "Insert directive 'synthesis_on'."
10425 (vhdl-template-directive "synthesis_on"))
10427 (defun vhdl-template-directive-synthesis-off ()
10428 "Insert directive 'synthesis_off'."
10430 (vhdl-template-directive "synthesis_off"))
10432 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10433 ;; Header and footer templates
10435 (defun vhdl-template-header (&optional file-title
)
10436 "Insert a VHDL file header."
10438 (unless (equal vhdl-file-header
"")
10441 (goto-char (point-min))
10442 (vhdl-insert-string-or-file vhdl-file-header
)
10443 (setq pos
(point-marker)))
10444 (vhdl-template-replace-header-keywords
10445 (point-min-marker) pos file-title
))))
10447 (defun vhdl-template-footer ()
10448 "Insert a VHDL file footer."
10450 (unless (equal vhdl-file-footer
"")
10453 (goto-char (point-max))
10454 (setq pos
(point-marker))
10455 (vhdl-insert-string-or-file vhdl-file-footer
)
10456 (unless (= (preceding-char) ?
\n)
10458 (vhdl-template-replace-header-keywords pos
(point-max-marker)))))
10460 (defun vhdl-template-replace-header-keywords (beg end
&optional file-title
10462 "Replace keywords in header and footer."
10463 (let ((project-title (or (nth 0 (aget vhdl-project-alist vhdl-project
)) ""))
10464 (project-desc (or (nth 9 (aget vhdl-project-alist vhdl-project
)) ""))
10466 (vhdl-prepare-search-2
10469 (while (search-forward "<projectdesc>" end t
)
10470 (replace-match project-desc t t
))
10472 (while (search-forward "<filename>" end t
)
10473 (replace-match (buffer-name) t t
))
10475 (while (search-forward "<copyright>" end t
)
10476 (replace-match vhdl-copyright-string t t
))
10478 (while (search-forward "<author>" end t
)
10479 (replace-match "" t t
)
10480 (insert (user-full-name))
10481 (when user-mail-address
(insert " <" user-mail-address
">")))
10483 (while (search-forward "<authorfull>" end t
)
10484 (replace-match (user-full-name) t t
))
10486 (while (search-forward "<login>" end t
)
10487 (replace-match (user-login-name) t t
))
10489 (while (search-forward "<project>" end t
)
10490 (replace-match project-title t t
))
10492 (while (search-forward "<company>" end t
)
10493 (replace-match vhdl-company-name t t
))
10495 (while (search-forward "<platform>" end t
)
10496 (replace-match vhdl-platform-spec t t
))
10498 (while (search-forward "<standard>" end t
)
10500 (concat "VHDL" (cond ((vhdl-standard-p '87) "'87")
10501 ((vhdl-standard-p '93) "'93/02"))
10502 (when (vhdl-standard-p 'ams
) ", VHDL-AMS")
10503 (when (vhdl-standard-p 'math
) ", Math Packages")) t t
))
10505 ;; Replace <RCS> with $, so that RCS for the source is
10506 ;; not over-enthusiastic with replacements
10507 (while (search-forward "<RCS>" end t
)
10508 (replace-match "$" nil t
))
10510 (while (search-forward "<date>" end t
)
10511 (replace-match "" t t
)
10512 (vhdl-template-insert-date))
10514 (while (search-forward "<year>" end t
)
10515 (replace-match (format-time-string "%Y" nil
) t t
))
10518 (while (search-forward "<title string>" end t
)
10519 (replace-match file-title t t
))
10523 (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t
)
10524 (setq string
(read-string (concat (match-string 1) ": ")))
10525 (replace-match string t t
)))
10527 (when (and (not is-model
) (search-forward "<cursor>" end t
))
10528 (replace-match "" t t
)
10529 (setq pos
(point))))
10530 (when pos
(goto-char pos
))
10532 (when (or (not project-title
) (equal project-title
""))
10533 (message "You can specify a project title in user option `vhdl-project-alist'"))
10534 (when (or (not project-desc
) (equal project-desc
""))
10535 (message "You can specify a project description in user option `vhdl-project-alist'"))
10536 (when (equal vhdl-platform-spec
"")
10537 (message "You can specify a platform in user option `vhdl-platform-spec'"))
10538 (when (equal vhdl-company-name
"")
10539 (message "You can specify a company name in user option `vhdl-company-name'"))))))
10541 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10542 ;; Comment templates and functions
10544 (defun vhdl-comment-indent ()
10546 (let* ((position (point))
10550 (if (re-search-forward "--" position t
)
10551 (- (current-column) 2) ; existing comment at bol stays there
10552 (goto-char position
)
10553 (skip-chars-backward " \t")
10554 (max comment-column
; else indent to comment column
10555 (1+ (current-column))))))) ; except leave at least one space
10556 (goto-char position
)
10559 (defun vhdl-comment-insert ()
10560 "Start a comment at the end of the line.
10561 If on line with code, indent at least `comment-column'.
10562 If starting after end-comment-column, start a new line."
10564 (when (> (current-column) end-comment-column
) (newline-and-indent))
10565 (if (or (looking-at "\\s-*$") ; end of line
10566 (and (not unread-command-events
) ; called with key binding or menu
10567 (not (end-of-line))))
10569 (while (= (preceding-char) ?-
) (delete-char -
1))
10570 (setq margin
(current-column))
10571 (delete-horizontal-space)
10573 (progn (indent-to margin
) (insert "--"))
10575 (indent-to comment-column
)
10577 (if (not unread-command-events
) (insert " ")))
10578 ;; else code following current point implies commenting out code
10579 (let (next-input code
)
10580 (while (= (preceding-char) ?-
) (delete-char -
2))
10581 (while (= (setq next-input
(read-char)) 13) ; CR
10582 (insert "--") ; or have a space after it?
10585 (message "Enter CR if commenting out a line of code.")
10588 (insert "--")) ; hardwire to 1 space or use vhdl-basic-offset?
10589 (setq unread-command-events
10590 (list (vhdl-character-to-event next-input
)))))) ; pushback the char
10592 (defun vhdl-comment-display (&optional line-exists
)
10593 "Add 2 comment lines at the current indent, making a display comment."
10595 (let ((margin (current-indentation)))
10596 (unless line-exists
(vhdl-comment-display-line))
10597 (insert "\n") (indent-to margin
)
10598 (insert "\n") (indent-to margin
)
10599 (vhdl-comment-display-line)
10603 (defun vhdl-comment-display-line ()
10604 "Displays one line of dashes."
10606 (while (= (preceding-char) ?-
) (delete-char -
2))
10608 (let* ((col (current-column))
10609 (len (- end-comment-column col
)))
10610 (insert-char vhdl-comment-display-line-char len
)))
10612 (defun vhdl-comment-append-inline ()
10613 "Append empty inline comment to current line."
10616 (delete-horizontal-space)
10618 (indent-to comment-column
)
10621 (defun vhdl-comment-insert-inline (&optional string always-insert
)
10622 "Insert inline comment."
10623 (when (or (and string
(or vhdl-self-insert-comments always-insert
))
10624 (and (not string
) vhdl-prompt-for-comments
))
10625 (let ((position (point)))
10627 (indent-to comment-column
)
10629 (if (not (or (and string
(progn (insert string
) t
))
10630 (vhdl-template-field "[comment]" nil t
)))
10631 (delete-region position
(point))
10632 (while (= (preceding-char) ?\
) (delete-char -
1))))))
10634 (defun vhdl-comment-block ()
10635 "Insert comment for code block."
10636 (when vhdl-prompt-for-comments
10637 (let ((final-pos (point-marker)))
10638 (vhdl-prepare-search-2
10639 (when (and (re-search-backward "^\\s-*begin\\>" nil t
)
10640 (re-search-backward "\\<\\(architecture\\|block\\|function\\|procedure\\|process\\|procedural\\)\\>" nil t
))
10642 (back-to-indentation)
10643 (setq margin
(current-column))
10646 (progn (insert "\n") (forward-line -
1))
10649 (insert "-- purpose: ")
10650 (unless (vhdl-template-field "[description]" nil t
)
10651 (vhdl-line-kill-entire)))))
10652 (goto-char final-pos
))))
10654 (defun vhdl-comment-uncomment-region (beg end
&optional arg
)
10655 "Comment out region if not commented out, uncomment otherwise."
10656 (interactive "r\nP")
10658 (goto-char (1- end
))
10660 (setq end
(point-marker))
10662 (beginning-of-line)
10664 (if (looking-at (concat "\\s-*" comment-start
))
10665 (comment-region beg end
'(4))
10666 (comment-region beg end
))))
10668 (defun vhdl-comment-uncomment-line (&optional arg
)
10669 "Comment out line if not commented out, uncomment otherwise."
10672 (beginning-of-line)
10673 (let ((position (point)))
10674 (forward-line (or arg
1))
10675 (vhdl-comment-uncomment-region position
(point)))))
10677 (defun vhdl-comment-kill-region (beg end
)
10678 "Kill comments in region."
10682 (setq end
(point-marker))
10684 (beginning-of-line)
10685 (while (< (point) end
)
10686 (if (looking-at "^\\(\\s-*--.*\n\\)")
10687 (progn (delete-region (match-beginning 1) (match-end 1)))
10688 (beginning-of-line 2)))))
10690 (defun vhdl-comment-kill-inline-region (beg end
)
10691 "Kill inline comments in region."
10695 (setq end
(point-marker))
10697 (beginning-of-line)
10698 (while (< (point) end
)
10699 (when (looking-at "^.*[^ \t\n\r\f-]+\\(\\s-*--.*\\)$")
10700 (delete-region (match-beginning 1) (match-end 1)))
10701 (beginning-of-line 2))))
10703 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10706 (defun vhdl-template-begin-end (construct name margin
&optional empty-lines
)
10707 "Insert a begin ... end pair with optional name after the end.
10708 Point is left between them."
10710 (when (or empty-lines
(eq vhdl-insert-empty-lines
'all
)) (insert "\n"))
10712 (vhdl-insert-keyword "BEGIN")
10713 (when (and (or construct name
) vhdl-self-insert-comments
)
10715 (when construct
(insert " ") (vhdl-insert-keyword construct
))
10716 (when name
(insert " " name
)))
10718 (when (or empty-lines
(eq vhdl-insert-empty-lines
'all
)) (insert "\n"))
10719 (indent-to (+ margin vhdl-basic-offset
))
10720 (setq position
(point))
10722 (when (or empty-lines
(eq vhdl-insert-empty-lines
'all
)) (insert "\n"))
10724 (vhdl-insert-keyword "END")
10725 (when construct
(insert " ") (vhdl-insert-keyword construct
))
10726 (insert (if name
(concat " " name
) "") ";")
10727 (goto-char position
)))
10729 (defun vhdl-template-argument-list (&optional is-function
)
10730 "Read from user a procedure or function argument list."
10732 (let ((margin (current-column))
10735 not-empty interface semicolon-pos
)
10736 (unless vhdl-argument-list-indent
10737 (setq margin
(+ (current-indentation) vhdl-basic-offset
))
10739 (indent-to margin
))
10740 (setq interface
(vhdl-template-field
10741 (concat "[CONSTANT | SIGNAL"
10742 (unless is-function
" | VARIABLE") "]") " " t
))
10743 (while (vhdl-template-field "[names]" nil t
)
10746 (unless is-function
10747 (if (and interface
(equal (upcase interface
) "CONSTANT"))
10748 (vhdl-insert-keyword "IN ")
10749 (vhdl-template-field "[IN | OUT | INOUT]" " " t
)))
10750 (vhdl-template-field "type")
10751 (setq semicolon-pos
(point))
10753 (vhdl-comment-insert-inline)
10754 (setq end-pos
(point))
10757 (setq interface
(vhdl-template-field
10758 (concat "[CONSTANT | SIGNAL"
10759 (unless is-function
" | VARIABLE") "]") " " t
)))
10760 (delete-region end-pos
(point))
10761 (when semicolon-pos
(goto-char semicolon-pos
))
10763 (progn (delete-char 1) (insert ")"))
10764 (delete-char -
2))))
10766 (defun vhdl-template-generic-list (optional &optional no-value
)
10767 "Read from user a generic spec argument list."
10770 (vhdl-insert-keyword "GENERIC (")
10771 (setq margin
(current-column))
10772 (unless vhdl-argument-list-indent
10773 (let ((position (point)))
10774 (back-to-indentation)
10775 (setq margin
(+ (current-column) vhdl-basic-offset
))
10776 (goto-char position
)
10778 (indent-to margin
)))
10779 (let ((vhdl-generics (vhdl-template-field
10780 (concat (and optional
"[") "name"
10781 (and no-value
"s") (and optional
"]"))
10783 (if (not vhdl-generics
)
10785 (progn (vhdl-line-kill-entire) (end-of-line -
0)
10786 (unless vhdl-argument-list-indent
10787 (vhdl-line-kill-entire) (end-of-line -
0)))
10788 (vhdl-template-undo start
(point))
10791 (let (semicolon-pos end-pos
)
10792 (while vhdl-generics
10793 (vhdl-template-field "type")
10795 (progn (setq semicolon-pos
(point))
10798 (unless (vhdl-template-field "[value]" nil t
)
10800 (setq semicolon-pos
(point))
10802 (vhdl-comment-insert-inline)
10803 (setq end-pos
(point))
10806 (setq vhdl-generics
(vhdl-template-field
10807 (concat "[name" (and no-value
"s") "]")
10809 (delete-region end-pos
(point))
10810 (goto-char semicolon-pos
)
10813 (when vhdl-auto-align
(vhdl-align-region-groups start
(point) 1))
10816 (defun vhdl-template-port-list (optional)
10817 "Read from user a port spec argument list."
10818 (let ((start (point))
10819 margin vhdl-ports object
)
10820 (vhdl-insert-keyword "PORT (")
10821 (setq margin
(current-column))
10822 (unless vhdl-argument-list-indent
10823 (let ((position (point)))
10824 (back-to-indentation)
10825 (setq margin
(+ (current-column) vhdl-basic-offset
))
10826 (goto-char position
)
10828 (indent-to margin
)))
10829 (when (vhdl-standard-p 'ams
)
10830 (setq object
(vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]"
10832 (setq vhdl-ports
(vhdl-template-field
10833 (concat (and optional
"[") "names" (and optional
"]"))
10835 (if (not vhdl-ports
)
10837 (progn (vhdl-line-kill-entire) (end-of-line -
0)
10838 (unless vhdl-argument-list-indent
10839 (vhdl-line-kill-entire) (end-of-line -
0)))
10840 (vhdl-template-undo start
(point))
10843 (let (semicolon-pos end-pos
)
10845 (cond ((or (null object
) (equal "SIGNAL" (upcase object
)))
10846 (vhdl-template-field "IN | OUT | INOUT" " "))
10847 ((equal "QUANTITY" (upcase object
))
10848 (vhdl-template-field "[IN | OUT]" " " t
)))
10849 (vhdl-template-field
10850 (if (and object
(equal "TERMINAL" (upcase object
)))
10852 (setq semicolon-pos
(point))
10854 (vhdl-comment-insert-inline)
10855 (setq end-pos
(point))
10858 (when (vhdl-standard-p 'ams
)
10859 (setq object
(vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]"
10861 (setq vhdl-ports
(vhdl-template-field "[names]" " : " t
)))
10862 (delete-region end-pos
(point))
10863 (goto-char semicolon-pos
)
10866 (when vhdl-auto-align
(vhdl-align-region-groups start end-pos
1))
10869 (defun vhdl-template-generate-body (margin label
)
10870 "Insert body for generate template."
10871 (vhdl-insert-keyword " GENERATE")
10874 (vhdl-insert-keyword "END GENERATE ")
10877 (indent-to (+ margin vhdl-basic-offset
)))
10879 (defun vhdl-template-insert-date ()
10880 "Insert date in appropriate format."
10884 ;; 'american, 'european, 'scientific kept for backward compatibility
10885 ((eq vhdl-date-format
'american
) (format-time-string "%m/%d/%Y" nil
))
10886 ((eq vhdl-date-format
'european
) (format-time-string "%d.%m.%Y" nil
))
10887 ((eq vhdl-date-format
'scientific
) (format-time-string "%Y/%m/%d" nil
))
10888 (t (format-time-string vhdl-date-format nil
)))))
10890 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10893 (defun vhdl-electric-space (count)
10894 "Expand abbreviations and self-insert space(s), do indent-new-comment-line
10895 if in comment and past end-comment-column."
10897 (cond ((vhdl-in-comment-p)
10898 (self-insert-command count
)
10899 (cond ((>= (current-column) (+ 2 end-comment-column
))
10901 (skip-chars-backward "^ \t\n\r\f")
10902 (indent-new-comment-line)
10903 (skip-chars-forward "^ \t\n\r\f")
10905 ((>= (current-column) end-comment-column
)
10906 (indent-new-comment-line))
10908 ((or (and (>= (preceding-char) ?a
) (<= (preceding-char) ?z
))
10909 (and (>= (preceding-char) ?A
) (<= (preceding-char) ?Z
)))
10910 (vhdl-prepare-search-1
10911 (or (expand-abbrev) (vhdl-fix-case-word -
1)))
10912 (self-insert-command count
))
10913 (t (self-insert-command count
))))
10915 (defun vhdl-template-field (prompt &optional follow-string optional
10916 begin end is-string default
)
10917 "Prompt for string and insert it in buffer with optional FOLLOW-STRING.
10918 If OPTIONAL is nil, the prompt is left if an empty string is inserted. If
10919 an empty string is inserted, return nil and call `vhdl-template-undo' for
10920 the region between BEGIN and END. IS-STRING indicates whether a string
10921 with double-quotes is to be inserted. DEFAULT specifies a default string."
10922 (let ((position (point))
10924 (insert "<" prompt
">")
10927 (read-from-minibuffer (concat prompt
": ")
10928 (or (and is-string
'("\"\"" .
2)) default
)
10929 vhdl-minibuffer-local-map
)
10930 (quit (if (and optional begin end
)
10932 (keyboard-quit)))))
10933 (when (or (not (equal string
"")) optional
)
10934 (delete-region position
(point)))
10935 (when (and (equal string
"") optional begin end
)
10936 (vhdl-template-undo begin end
)
10937 (message "Template aborted"))
10938 (unless (equal string
"")
10940 (vhdl-fix-case-region-1 position
(point) vhdl-upper-case-keywords
10941 vhdl-keywords-regexp
)
10942 (vhdl-fix-case-region-1 position
(point) vhdl-upper-case-types
10944 (vhdl-fix-case-region-1 position
(point) vhdl-upper-case-attributes
10945 (concat "'" vhdl-attributes-regexp
))
10946 (vhdl-fix-case-region-1 position
(point) vhdl-upper-case-enum-values
10947 vhdl-enum-values-regexp
)
10948 (vhdl-fix-case-region-1 position
(point) vhdl-upper-case-constants
10949 vhdl-constants-regexp
))
10950 (when (or (not (equal string
"")) (not optional
))
10951 (insert (or follow-string
"")))
10952 (if (equal string
"") nil string
)))
10954 (defun vhdl-decision-query (string prompt
&optional optional
)
10955 "Query a decision from the user."
10956 (let ((start (point)))
10957 (when string
(vhdl-insert-keyword (concat string
" ")))
10958 (message "%s" (or prompt
""))
10959 (let ((char (read-char)))
10960 (delete-region start
(point))
10961 (if (and optional
(eq char ?
\r))
10962 (progn (insert " ")
10964 (throw 'abort
"ERROR: Template aborted"))
10967 (defun vhdl-insert-keyword (keyword)
10968 "Insert KEYWORD and adjust case."
10969 (insert (if vhdl-upper-case-keywords
(upcase keyword
) (downcase keyword
))))
10971 (defun vhdl-case-keyword (keyword)
10972 "Adjust case of KEYWORD."
10973 (if vhdl-upper-case-keywords
(upcase keyword
) (downcase keyword
)))
10975 (defun vhdl-case-word (num)
10976 "Adjust case of following NUM words."
10977 (if vhdl-upper-case-keywords
(upcase-word num
) (downcase-word num
)))
10979 (defun vhdl-minibuffer-tab (&optional prefix-arg
)
10980 "If preceding character is part of a word or a paren then hippie-expand,
10981 else insert tab (used for word completion in VHDL minibuffer)."
10985 ((= (char-syntax (preceding-char)) ?w
)
10986 (let ((case-fold-search (not vhdl-word-completion-case-sensitive
))
10988 (hippie-expand-only-buffers
10989 (or (and (boundp 'hippie-expand-only-buffers
)
10990 hippie-expand-only-buffers
)
10992 (vhdl-expand-abbrev prefix-arg
)))
10993 ;; expand parenthesis
10994 ((or (= (preceding-char) ?\
() (= (preceding-char) ?\
)))
10995 (let ((case-fold-search (not vhdl-word-completion-case-sensitive
))
10996 (case-replace nil
))
10997 (vhdl-expand-paren prefix-arg
)))
11001 (defun vhdl-template-search-prompt ()
11002 "Search for left out template prompts and query again."
11004 (vhdl-prepare-search-2
11005 (when (or (re-search-forward
11006 (concat "<\\(" vhdl-template-prompt-syntax
"\\)>") nil t
)
11007 (re-search-backward
11008 (concat "<\\(" vhdl-template-prompt-syntax
"\\)>") nil t
))
11009 (let ((string (match-string 1)))
11011 (vhdl-template-field string
)))))
11013 (defun vhdl-template-undo (begin end
)
11014 "Undo aborted template by deleting region and unexpanding the keyword."
11015 (cond (vhdl-template-invoked-by-hook
11018 (delete-region begin end
)
11020 (t (delete-region begin end
))))
11022 (defun vhdl-insert-string-or-file (string)
11023 "Insert STRING or file contents if STRING is an existing file name."
11024 (unless (equal string
"")
11026 (progn (string-match "^\\([^\n]+\\)" string
)
11027 (vhdl-resolve-env-variable (match-string 1 string
)))))
11028 (if (file-exists-p file-name
)
11029 (forward-char (cadr (insert-file-contents file-name
)))
11030 (insert string
)))))
11032 (defun vhdl-beginning-of-block ()
11033 "Move cursor to the beginning of the enclosing block."
11035 (vhdl-prepare-search-2
11037 (beginning-of-line)
11038 ;; search backward for block beginning or end
11039 (while (or (while (and (setq pos
(re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t
))
11040 ;; not consider subprogram declarations
11041 (or (and (match-string 5)
11044 (goto-char (match-end 5))
11046 (vhdl-forward-syntactic-ws)
11047 (when (looking-at "(")
11049 (re-search-forward "\\<is\\>\\|\\(;\\)" nil t
))
11051 ;; not consider configuration specifications
11052 (and (match-string 6)
11055 (vhdl-end-of-block)
11056 (beginning-of-line)
11057 (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
11059 ;; skip subblock if block end found
11060 (vhdl-beginning-of-block))))
11061 (when pos
(goto-char pos
))))
11063 (defun vhdl-end-of-block ()
11064 "Move cursor to the end of the enclosing block."
11066 (vhdl-prepare-search-2
11069 ;; search forward for block beginning or end
11070 (while (or (while (and (setq pos
(re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t
))
11071 ;; not consider subprogram declarations
11072 (or (and (match-string 5)
11074 (save-excursion (re-search-forward "\\<is\\>\\|\\(;\\)" nil t
))
11076 ;; not consider configuration specifications
11077 (and (match-string 6)
11080 (vhdl-end-of-block)
11081 (beginning-of-line)
11082 (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
11083 (not (match-string 2)))
11084 ;; skip subblock if block beginning found
11085 (vhdl-end-of-block))))
11086 (when pos
(goto-char pos
))))
11088 (defun vhdl-sequential-statement-p ()
11089 "Check if point is within sequential statement part."
11090 (let ((start (point)))
11092 (vhdl-prepare-search-2
11093 ;; is sequential statement if ...
11094 (and (re-search-backward "^\\s-*begin\\>" nil t
)
11095 ;; ... point is between "begin" and "end" of ...
11096 (progn (vhdl-end-of-block)
11098 ;; ... a sequential block
11099 (progn (vhdl-beginning-of-block)
11100 (looking-at "^\\s-*\\(\\(\\w+[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(\\w+[ \t\n\r\f]+\\)?\\(procedural\\|process\\)\\)\\>")))))))
11102 (defun vhdl-in-argument-list-p ()
11103 "Check if within an argument list."
11105 (vhdl-prepare-search-2
11106 (or (string-match "arglist"
11107 (format "%s" (caar (vhdl-get-syntactic-context))))
11108 (progn (beginning-of-line)
11109 (looking-at "^\\s-*\\(generic\\|port\\|\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\>\\s-*\\(\\w+\\s-*\\)?("))))))
11111 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11114 (defun vhdl-hooked-abbrev (func)
11115 "Do function, if syntax says abbrev is a keyword, invoked by hooked abbrev,
11116 but not if inside a comment or quote."
11117 (if (or (vhdl-in-literal)
11120 (and (looking-at "\\<end\\>") (not (looking-at "\\<end;")))))
11127 (if (not vhdl-electric-mode
)
11134 (let ((invoke-char vhdl-last-input-event
)
11136 (vhdl-template-invoked-by-hook t
))
11137 (let ((caught (catch 'abort
11139 (when (stringp caught
) (message "%s" caught
)))
11140 (when (= invoke-char ?-
) (setq abbrev-start-location
(point)))
11141 ;; delete CR which is still in event queue
11142 (if (fboundp 'enqueue-eval-event
)
11143 (enqueue-eval-event 'delete-char -
1)
11144 (setq unread-command-events
; push back a delete char
11145 (list (vhdl-character-to-event ?
\177))))))))
11147 (defun vhdl-template-alias-hook ()
11148 (vhdl-hooked-abbrev 'vhdl-template-alias
))
11149 (defun vhdl-template-architecture-hook ()
11150 (vhdl-hooked-abbrev 'vhdl-template-architecture
))
11151 (defun vhdl-template-assert-hook ()
11152 (vhdl-hooked-abbrev 'vhdl-template-assert
))
11153 (defun vhdl-template-attribute-hook ()
11154 (vhdl-hooked-abbrev 'vhdl-template-attribute
))
11155 (defun vhdl-template-block-hook ()
11156 (vhdl-hooked-abbrev 'vhdl-template-block
))
11157 (defun vhdl-template-break-hook ()
11158 (vhdl-hooked-abbrev 'vhdl-template-break
))
11159 (defun vhdl-template-case-hook ()
11160 (vhdl-hooked-abbrev 'vhdl-template-case
))
11161 (defun vhdl-template-component-hook ()
11162 (vhdl-hooked-abbrev 'vhdl-template-component
))
11163 (defun vhdl-template-instance-hook ()
11164 (vhdl-hooked-abbrev 'vhdl-template-instance
))
11165 (defun vhdl-template-conditional-signal-asst-hook ()
11166 (vhdl-hooked-abbrev 'vhdl-template-conditional-signal-asst
))
11167 (defun vhdl-template-configuration-hook ()
11168 (vhdl-hooked-abbrev 'vhdl-template-configuration
))
11169 (defun vhdl-template-constant-hook ()
11170 (vhdl-hooked-abbrev 'vhdl-template-constant
))
11171 (defun vhdl-template-disconnect-hook ()
11172 (vhdl-hooked-abbrev 'vhdl-template-disconnect
))
11173 (defun vhdl-template-display-comment-hook ()
11174 (vhdl-hooked-abbrev 'vhdl-comment-display
))
11175 (defun vhdl-template-else-hook ()
11176 (vhdl-hooked-abbrev 'vhdl-template-else
))
11177 (defun vhdl-template-elsif-hook ()
11178 (vhdl-hooked-abbrev 'vhdl-template-elsif
))
11179 (defun vhdl-template-entity-hook ()
11180 (vhdl-hooked-abbrev 'vhdl-template-entity
))
11181 (defun vhdl-template-exit-hook ()
11182 (vhdl-hooked-abbrev 'vhdl-template-exit
))
11183 (defun vhdl-template-file-hook ()
11184 (vhdl-hooked-abbrev 'vhdl-template-file
))
11185 (defun vhdl-template-for-hook ()
11186 (vhdl-hooked-abbrev 'vhdl-template-for
))
11187 (defun vhdl-template-function-hook ()
11188 (vhdl-hooked-abbrev 'vhdl-template-function
))
11189 (defun vhdl-template-generic-hook ()
11190 (vhdl-hooked-abbrev 'vhdl-template-generic
))
11191 (defun vhdl-template-group-hook ()
11192 (vhdl-hooked-abbrev 'vhdl-template-group
))
11193 (defun vhdl-template-library-hook ()
11194 (vhdl-hooked-abbrev 'vhdl-template-library
))
11195 (defun vhdl-template-limit-hook ()
11196 (vhdl-hooked-abbrev 'vhdl-template-limit
))
11197 (defun vhdl-template-if-hook ()
11198 (vhdl-hooked-abbrev 'vhdl-template-if
))
11199 (defun vhdl-template-bare-loop-hook ()
11200 (vhdl-hooked-abbrev 'vhdl-template-bare-loop
))
11201 (defun vhdl-template-map-hook ()
11202 (vhdl-hooked-abbrev 'vhdl-template-map
))
11203 (defun vhdl-template-nature-hook ()
11204 (vhdl-hooked-abbrev 'vhdl-template-nature
))
11205 (defun vhdl-template-next-hook ()
11206 (vhdl-hooked-abbrev 'vhdl-template-next
))
11207 (defun vhdl-template-others-hook ()
11208 (vhdl-hooked-abbrev 'vhdl-template-others
))
11209 (defun vhdl-template-package-hook ()
11210 (vhdl-hooked-abbrev 'vhdl-template-package
))
11211 (defun vhdl-template-port-hook ()
11212 (vhdl-hooked-abbrev 'vhdl-template-port
))
11213 (defun vhdl-template-procedural-hook ()
11214 (vhdl-hooked-abbrev 'vhdl-template-procedural
))
11215 (defun vhdl-template-procedure-hook ()
11216 (vhdl-hooked-abbrev 'vhdl-template-procedure
))
11217 (defun vhdl-template-process-hook ()
11218 (vhdl-hooked-abbrev 'vhdl-template-process
))
11219 (defun vhdl-template-quantity-hook ()
11220 (vhdl-hooked-abbrev 'vhdl-template-quantity
))
11221 (defun vhdl-template-report-hook ()
11222 (vhdl-hooked-abbrev 'vhdl-template-report
))
11223 (defun vhdl-template-return-hook ()
11224 (vhdl-hooked-abbrev 'vhdl-template-return
))
11225 (defun vhdl-template-selected-signal-asst-hook ()
11226 (vhdl-hooked-abbrev 'vhdl-template-selected-signal-asst
))
11227 (defun vhdl-template-signal-hook ()
11228 (vhdl-hooked-abbrev 'vhdl-template-signal
))
11229 (defun vhdl-template-subnature-hook ()
11230 (vhdl-hooked-abbrev 'vhdl-template-subnature
))
11231 (defun vhdl-template-subtype-hook ()
11232 (vhdl-hooked-abbrev 'vhdl-template-subtype
))
11233 (defun vhdl-template-terminal-hook ()
11234 (vhdl-hooked-abbrev 'vhdl-template-terminal
))
11235 (defun vhdl-template-type-hook ()
11236 (vhdl-hooked-abbrev 'vhdl-template-type
))
11237 (defun vhdl-template-use-hook ()
11238 (vhdl-hooked-abbrev 'vhdl-template-use
))
11239 (defun vhdl-template-variable-hook ()
11240 (vhdl-hooked-abbrev 'vhdl-template-variable
))
11241 (defun vhdl-template-wait-hook ()
11242 (vhdl-hooked-abbrev 'vhdl-template-wait
))
11243 (defun vhdl-template-when-hook ()
11244 (vhdl-hooked-abbrev 'vhdl-template-when
))
11245 (defun vhdl-template-while-loop-hook ()
11246 (vhdl-hooked-abbrev 'vhdl-template-while-loop
))
11247 (defun vhdl-template-with-hook ()
11248 (vhdl-hooked-abbrev 'vhdl-template-with
))
11249 (defun vhdl-template-and-hook ()
11250 (vhdl-hooked-abbrev 'vhdl-template-and
))
11251 (defun vhdl-template-or-hook ()
11252 (vhdl-hooked-abbrev 'vhdl-template-or
))
11253 (defun vhdl-template-nand-hook ()
11254 (vhdl-hooked-abbrev 'vhdl-template-nand
))
11255 (defun vhdl-template-nor-hook ()
11256 (vhdl-hooked-abbrev 'vhdl-template-nor
))
11257 (defun vhdl-template-xor-hook ()
11258 (vhdl-hooked-abbrev 'vhdl-template-xor
))
11259 (defun vhdl-template-xnor-hook ()
11260 (vhdl-hooked-abbrev 'vhdl-template-xnor
))
11261 (defun vhdl-template-not-hook ()
11262 (vhdl-hooked-abbrev 'vhdl-template-not
))
11264 (defun vhdl-template-default-hook ()
11265 (vhdl-hooked-abbrev 'vhdl-template-default
))
11266 (defun vhdl-template-default-indent-hook ()
11267 (vhdl-hooked-abbrev 'vhdl-template-default-indent
))
11269 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11270 ;; Template insertion from completion list
11272 (defun vhdl-template-insert-construct (name)
11273 "Insert the built-in construct template with NAME."
11275 (list (let ((completion-ignore-case t
))
11276 (completing-read "Construct name: "
11277 vhdl-template-construct-alist nil t
))))
11278 (vhdl-template-insert-fun
11279 (cadr (assoc name vhdl-template-construct-alist
))))
11281 (defun vhdl-template-insert-package (name)
11282 "Insert the built-in package template with NAME."
11284 (list (let ((completion-ignore-case t
))
11285 (completing-read "Package name: "
11286 vhdl-template-package-alist nil t
))))
11287 (vhdl-template-insert-fun
11288 (cadr (assoc name vhdl-template-package-alist
))))
11290 (defun vhdl-template-insert-directive (name)
11291 "Insert the built-in directive template with NAME."
11293 (list (let ((completion-ignore-case t
))
11294 (completing-read "Directive name: "
11295 vhdl-template-directive-alist nil t
))))
11296 (vhdl-template-insert-fun
11297 (cadr (assoc name vhdl-template-directive-alist
))))
11299 (defun vhdl-template-insert-fun (fun)
11300 "Call FUN to insert a built-in template."
11301 (let ((caught (catch 'abort
(when fun
(funcall fun
)))))
11302 (when (stringp caught
) (message "%s" caught
))))
11305 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11307 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11309 (defun vhdl-model-insert (model-name)
11310 "Insert the user model with name MODEL-NAME."
11312 (let ((completion-ignore-case t
))
11313 (list (completing-read "Model name: " vhdl-model-alist
))))
11314 (indent-according-to-mode)
11315 (let ((start (point-marker))
11316 (margin (current-indentation))
11317 model position prompt string end
)
11318 (vhdl-prepare-search-2
11319 (when (setq model
(assoc model-name vhdl-model-alist
))
11321 (beginning-of-line)
11322 (delete-horizontal-space)
11324 (vhdl-insert-string-or-file (nth 1 model
))
11325 (setq end
(point-marker))
11328 (beginning-of-line)
11329 (while (< (point) end
)
11330 (unless (looking-at "^$")
11331 (insert-char ? margin
))
11332 (beginning-of-line 2))
11335 (unless (equal "" vhdl-clock-name
)
11336 (while (re-search-forward "<clock>" end t
)
11337 (replace-match vhdl-clock-name
)))
11340 (unless (equal "" vhdl-reset-name
)
11341 (while (re-search-forward "<reset>" end t
)
11342 (replace-match vhdl-reset-name
)))
11343 ;; replace header prompts
11344 (vhdl-template-replace-header-keywords start end nil t
)
11346 ;; query other prompts
11347 (while (re-search-forward
11348 (concat "<\\(" vhdl-template-prompt-syntax
"\\)>") end t
)
11349 (unless (equal "cursor" (match-string 1))
11350 (setq position
(match-beginning 1))
11351 (setq prompt
(match-string 1))
11353 (setq string
(vhdl-template-field prompt nil t
))
11354 ;; replace occurrences of same prompt
11355 (while (re-search-forward (concat "<\\(" prompt
"\\)>") end t
)
11356 (replace-match (or string
"")))
11357 (goto-char position
)))
11359 ;; goto final position
11360 (if (re-search-forward "<cursor>" end t
)
11362 (goto-char end
))))))
11364 (defun vhdl-model-defun ()
11365 "Define help and hook functions for user models."
11366 (let ((model-alist vhdl-model-alist
)
11367 model-name model-keyword
)
11369 ;; define functions for user models that can be invoked from menu and key
11370 ;; bindings and which themselves call `vhdl-model-insert' with the model
11371 ;; name as argument
11372 (setq model-name
(nth 0 (car model-alist
)))
11373 (eval `(defun ,(vhdl-function-name "vhdl-model" model-name
) ()
11374 ,(concat "Insert model for \"" model-name
"\".")
11376 (vhdl-model-insert ,model-name
)))
11377 ;; define hooks for user models that are invoked from keyword abbrevs
11378 (setq model-keyword
(nth 3 (car model-alist
)))
11379 (unless (equal model-keyword
"")
11381 ,(vhdl-function-name
11382 "vhdl-model" model-name
"hook") ()
11383 (vhdl-hooked-abbrev
11384 ',(vhdl-function-name "vhdl-model" model-name
)))))
11385 (setq model-alist
(cdr model-alist
)))))
11390 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11391 ;;; Port translation
11392 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11394 (defvar vhdl-port-list nil
11395 "Variable to hold last port map parsed.")
11396 ;; structure: (parenthesized expression means list of such entries)
11398 ;; ((generic-names) generic-type generic-init generic-comment group-comment)
11399 ;; ((port-names) port-object port-direct port-type port-comment group-comment)
11400 ;; (lib-name pack-key))
11402 (defun vhdl-parse-string (string &optional optional
)
11403 "Check that the text following point matches the regexp in STRING."
11404 (if (looking-at string
)
11405 (progn (goto-char (match-end 0))
11406 (when (vhdl-in-literal)
11410 (throw 'parse
(format "ERROR: Syntax error near line %s, expecting \"%s\""
11411 (vhdl-current-line) string
)))
11414 (defun vhdl-replace-string (regexp-cons string
&optional adjust-case
)
11415 "Replace STRING from car of REGEXP-CONS to cdr of REGEXP-CONS."
11416 (vhdl-prepare-search-1
11417 (if (string-match (car regexp-cons
) string
)
11419 (funcall vhdl-file-name-case
11420 (replace-match (cdr regexp-cons
) t nil string
))
11421 (replace-match (cdr regexp-cons
) t nil string
))
11424 (defun vhdl-parse-group-comment ()
11425 "Parse comment and empty lines between groups of lines."
11426 (let ((start (point))
11428 (vhdl-forward-comment (point-max))
11429 (setq string
(buffer-substring-no-properties start
(point)))
11430 (vhdl-forward-syntactic-ws)
11431 ;; strip off leading blanks and first newline
11432 (while (string-match "^\\(\\s-+\\)" string
)
11433 (setq string
(concat (substring string
0 (match-beginning 1))
11434 (substring string
(match-end 1)))))
11435 (if (and (not (equal string
"")) (equal (substring string
0 1) "\n"))
11436 (substring string
1)
11439 (defun vhdl-paste-group-comment (string indent
)
11440 "Paste comment and empty lines from STRING between groups of lines
11442 (let ((pos (point-marker)))
11444 (while (string-match "^\\(--\\)" string
)
11445 (setq string
(concat (substring string
0 (match-beginning 1))
11446 (make-string indent ?
)
11447 (substring string
(match-beginning 1))))))
11448 (beginning-of-line)
11452 (defvar vhdl-port-flattened nil
11453 "Indicates whether a port has been flattened.")
11455 (defun vhdl-port-flatten (&optional as-alist
)
11456 "Flatten port list so that only one generic/port exists per line.
11457 This operation is performed on an internally stored port and is only
11458 reflected in a subsequent paste operation."
11460 (if (not vhdl-port-list
)
11461 (error "ERROR: No port has been read")
11462 (message "Flattening port for next paste...")
11463 (let ((new-vhdl-port-list (list (car vhdl-port-list
)))
11464 (old-vhdl-port-list (cdr vhdl-port-list
))
11465 old-port-list new-port-list old-port new-port names
)
11466 ;; traverse port list and flatten entries
11467 (while (cdr old-vhdl-port-list
)
11468 (setq old-port-list
(car old-vhdl-port-list
))
11469 (setq new-port-list nil
)
11470 (while old-port-list
11471 (setq old-port
(car old-port-list
))
11472 (setq names
(car old-port
))
11474 (setq new-port
(cons (if as-alist
(car names
) (list (car names
)))
11476 (setq new-port-list
(append new-port-list
(list new-port
)))
11477 (setq names
(cdr names
)))
11478 (setq old-port-list
(cdr old-port-list
)))
11479 (setq old-vhdl-port-list
(cdr old-vhdl-port-list
))
11480 (setq new-vhdl-port-list
(append new-vhdl-port-list
11481 (list new-port-list
))))
11482 (setq vhdl-port-list
11483 (append new-vhdl-port-list
(list old-vhdl-port-list
))
11484 vhdl-port-flattened t
)
11485 (message "Flattening port for next paste...done"))))
11487 (defvar vhdl-port-reversed-direction nil
11488 "Indicates whether port directions are reversed.")
11490 (defun vhdl-port-reverse-direction ()
11491 "Reverse direction for all ports (useful in testbenches).
11492 This operation is performed on an internally stored port and is only
11493 reflected in a subsequent paste operation."
11495 (if (not vhdl-port-list
)
11496 (error "ERROR: No port has been read")
11497 (message "Reversing port directions for next paste...")
11498 (let ((port-list (nth 2 vhdl-port-list
))
11499 port-dir-car port-dir
)
11500 ;; traverse port list and reverse directions
11502 (setq port-dir-car
(cddr (car port-list
))
11503 port-dir
(car port-dir-car
))
11504 (setcar port-dir-car
11505 (cond ((equal port-dir
"in") "out")
11506 ((equal port-dir
"IN") "OUT")
11507 ((equal port-dir
"out") "in")
11508 ((equal port-dir
"OUT") "IN")
11510 (setq port-list
(cdr port-list
)))
11511 (setq vhdl-port-reversed-direction
(not vhdl-port-reversed-direction
))
11512 (message "Reversing port directions for next paste...done"))))
11514 (defun vhdl-port-copy ()
11515 "Get generic and port information from an entity or component declaration."
11518 (let (parse-error end-of-list
11519 decl-type name generic-list port-list context-clause
11520 object names direct type init comment group-comment
)
11521 (vhdl-prepare-search-2
11525 ;; check if within entity or component declaration
11527 (when (or (not (re-search-backward
11528 "^\\s-*\\(component\\|entity\\|end\\)\\>" nil t
))
11529 (equal "END" (upcase (match-string 1))))
11530 (throw 'parse
"ERROR: Not within an entity or component declaration"))
11531 (setq decl-type
(downcase (match-string-no-properties 1)))
11533 (vhdl-parse-string "\\s-+\\(\\w+\\)\\(\\s-+is\\>\\)?")
11534 (setq name
(match-string-no-properties 1))
11535 (message "Reading port of %s \"%s\"..." decl-type name
)
11536 (vhdl-forward-syntactic-ws)
11537 ;; parse generic clause
11538 (when (vhdl-parse-string "generic[ \t\n\r\f]*(" t
)
11539 ;; parse group comment and spacing
11540 (setq group-comment
(vhdl-parse-group-comment))
11541 (setq end-of-list
(vhdl-parse-string ")[ \t\n\r\f]*;[ \t\n\r\f]*" t
))
11542 (while (not end-of-list
)
11543 ;; parse names (accept extended identifiers)
11544 (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*")
11545 (setq names
(list (match-string-no-properties 1)))
11546 (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t
)
11548 (append names
(list (match-string-no-properties 1)))))
11550 (vhdl-parse-string ":[ \t\n\r\f]*\\([^():;\n]+\\)")
11551 (setq type
(match-string-no-properties 1))
11552 (when (vhdl-in-comment-p) ; if stuck in comment
11553 (setq type
(concat type
(and (vhdl-parse-string ".*")
11554 (match-string-no-properties 0)))))
11556 (while (looking-at "(")
11559 (buffer-substring-no-properties
11560 (point) (progn (forward-sexp) (point)))
11561 (and (vhdl-parse-string "\\([^():;\n]*\\)" t
)
11562 (match-string-no-properties 1)))))
11563 ;; special case: closing parenthesis is on separate line
11564 (when (and type
(string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type
))
11565 (setq comment
(substring type
(match-beginning 2)))
11566 (setq type
(substring type
0 (match-beginning 1))))
11567 ;; strip of trailing group-comment
11568 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type
)
11569 (setq type
(substring type
0 (match-end 1)))
11570 ;; parse initialization expression
11572 (when (vhdl-parse-string ":=[ \t\n\r\f]*" t
)
11573 (vhdl-parse-string "\\([^();\n]*\\)")
11574 (setq init
(match-string-no-properties 1))
11575 (while (looking-at "(")
11578 (buffer-substring-no-properties
11579 (point) (progn (forward-sexp) (point)))
11580 (and (vhdl-parse-string "\\([^();\n]*\\)" t
)
11581 (match-string-no-properties 1))))))
11582 ;; special case: closing parenthesis is on separate line
11583 (when (and init
(string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init
))
11584 (setq comment
(substring init
(match-beginning 2)))
11585 (setq init
(substring init
0 (match-beginning 1)))
11586 (vhdl-forward-syntactic-ws))
11587 (skip-chars-forward " \t")
11588 ;; parse inline comment, special case: as above, no initial.
11590 (setq comment
(and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t
)
11591 (match-string-no-properties 1))))
11592 (vhdl-forward-syntactic-ws)
11593 (setq end-of-list
(vhdl-parse-string ")" t
))
11594 (vhdl-parse-string "\\s-*;\\s-*")
11595 ;; parse inline comment
11597 (setq comment
(and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t
)
11598 (match-string-no-properties 1))))
11599 ;; save everything in list
11600 (setq generic-list
(append generic-list
11601 (list (list names type init
11602 comment group-comment
))))
11603 ;; parse group comment and spacing
11604 (setq group-comment
(vhdl-parse-group-comment))))
11605 ;; parse port clause
11606 (when (vhdl-parse-string "port[ \t\n\r\f]*(" t
)
11607 ;; parse group comment and spacing
11608 (setq group-comment
(vhdl-parse-group-comment))
11609 (setq end-of-list
(vhdl-parse-string ")[ \t\n\r\f]*;[ \t\n\r\f]*" t
))
11610 (while (not end-of-list
)
11613 (and (vhdl-parse-string "\\<\\(signal\\|quantity\\|terminal\\)\\>[ \t\n\r\f]*" t
)
11614 (match-string-no-properties 1)))
11615 ;; parse names (accept extended identifiers)
11616 (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*")
11617 (setq names
(list (match-string-no-properties 1)))
11618 (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t
)
11619 (setq names
(append names
(list (match-string-no-properties 1)))))
11621 (vhdl-parse-string ":[ \t\n\r\f]*")
11623 (and (vhdl-parse-string "\\<\\(in\\|out\\|inout\\|buffer\\|linkage\\)\\>[ \t\n\r\f]+" t
)
11624 (match-string-no-properties 1)))
11626 (vhdl-parse-string "\\([^();\n]+\\)")
11627 (setq type
(match-string-no-properties 1))
11628 (when (vhdl-in-comment-p) ; if stuck in comment
11629 (setq type
(concat type
(and (vhdl-parse-string ".*")
11630 (match-string-no-properties 0)))))
11632 (while (looking-at "(")
11633 (setq type
(concat type
11634 (buffer-substring-no-properties
11635 (point) (progn (forward-sexp) (point)))
11636 (and (vhdl-parse-string "\\([^();\n]*\\)" t
)
11637 (match-string-no-properties 1)))))
11638 ;; special case: closing parenthesis is on separate line
11639 (when (and type
(string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type
))
11640 (setq comment
(substring type
(match-beginning 2)))
11641 (setq type
(substring type
0 (match-beginning 1))))
11642 ;; strip of trailing group-comment
11643 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type
)
11644 (setq type
(substring type
0 (match-end 1)))
11645 (vhdl-forward-syntactic-ws)
11646 (setq end-of-list
(vhdl-parse-string ")" t
))
11647 (vhdl-parse-string "\\s-*;\\s-*")
11648 ;; parse inline comment
11650 (setq comment
(and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t
)
11651 (match-string-no-properties 1))))
11652 ;; save everything in list
11653 (setq port-list
(append port-list
11654 (list (list names object direct type
11655 comment group-comment
))))
11656 ;; parse group comment and spacing
11657 (setq group-comment
(vhdl-parse-group-comment))))
11658 ;; parse context clause
11659 (setq context-clause
(vhdl-scan-context-clause))
11660 ; ;; add surrounding package to context clause
11661 ; (when (and (equal decl-type "component")
11662 ; (re-search-backward "^\\s-*package\\s-+\\(\\w+\\)" nil t))
11663 ; (setq context-clause
11664 ; (append context-clause
11665 ; (list (cons (vhdl-work-library)
11666 ; (match-string-no-properties 1))))))
11667 (message "Reading port of %s \"%s\"...done" decl-type name
)
11671 (error parse-error
)
11672 (setq vhdl-port-list
(list name generic-list port-list context-clause
)
11673 vhdl-port-reversed-direction nil
11674 vhdl-port-flattened nil
)))))
11676 (defun vhdl-port-paste-context-clause (&optional exclude-pack-name
)
11677 "Paste a context clause."
11678 (let ((margin (current-indentation))
11679 (clause-list (nth 3 vhdl-port-list
))
11682 (setq clause
(car clause-list
))
11683 (unless (or (and exclude-pack-name
(equal (downcase (cdr clause
))
11684 (downcase exclude-pack-name
)))
11686 (re-search-backward
11687 (concat "^\\s-*use\\s-+" (car clause
)
11688 "\." (cdr clause
) "\\>") nil t
)))
11689 (vhdl-template-standard-package (car clause
) (cdr clause
))
11691 (setq clause-list
(cdr clause-list
)))))
11693 (defun vhdl-port-paste-generic (&optional no-init
)
11694 "Paste a generic clause."
11695 (let ((margin (current-indentation))
11696 (generic-list (nth 1 vhdl-port-list
))
11697 list-margin start names generic
)
11698 ;; paste generic clause
11700 (setq start
(point))
11701 (vhdl-insert-keyword "GENERIC (")
11702 (unless vhdl-argument-list-indent
11703 (insert "\n") (indent-to (+ margin vhdl-basic-offset
)))
11704 (setq list-margin
(current-column))
11705 (while generic-list
11706 (setq generic
(car generic-list
))
11707 ;; paste group comment and spacing
11708 (when (memq vhdl-include-group-comments
'(decl always
))
11709 (vhdl-paste-group-comment (nth 4 generic
) list-margin
))
11711 (setq names
(nth 0 generic
))
11713 (insert (car names
))
11714 (setq names
(cdr names
))
11715 (when names
(insert ", ")))
11717 (insert " : " (nth 1 generic
))
11718 ;; paste initialization
11719 (when (and (not no-init
) (nth 2 generic
))
11720 (insert " := " (nth 2 generic
)))
11721 (unless (cdr generic-list
) (insert ")"))
11724 (when (and vhdl-include-port-comments
(nth 3 generic
))
11725 (vhdl-comment-insert-inline (nth 3 generic
) t
))
11726 (setq generic-list
(cdr generic-list
))
11727 (when generic-list
(insert "\n") (indent-to list-margin
)))
11728 ;; align generic clause
11729 (when vhdl-auto-align
(vhdl-align-region-groups start
(point) 1 t
)))))
11731 (defun vhdl-port-paste-port ()
11732 "Paste a port clause."
11733 (let ((margin (current-indentation))
11734 (port-list (nth 2 vhdl-port-list
))
11735 list-margin start names port
)
11736 ;; paste port clause
11738 (setq start
(point))
11739 (vhdl-insert-keyword "PORT (")
11740 (unless vhdl-argument-list-indent
11741 (insert "\n") (indent-to (+ margin vhdl-basic-offset
)))
11742 (setq list-margin
(current-column))
11744 (setq port
(car port-list
))
11745 ;; paste group comment and spacing
11746 (when (memq vhdl-include-group-comments
'(decl always
))
11747 (vhdl-paste-group-comment (nth 5 port
) list-margin
))
11749 (when (nth 1 port
) (insert (nth 1 port
) " "))
11751 (setq names
(nth 0 port
))
11753 (insert (car names
))
11754 (setq names
(cdr names
))
11755 (when names
(insert ", ")))
11758 (when (nth 2 port
) (insert (nth 2 port
) " "))
11760 (insert (nth 3 port
))
11761 (unless (cdr port-list
) (insert ")"))
11764 (when (and vhdl-include-port-comments
(nth 4 port
))
11765 (vhdl-comment-insert-inline (nth 4 port
) t
))
11766 (setq port-list
(cdr port-list
))
11767 (when port-list
(insert "\n") (indent-to list-margin
)))
11768 ;; align port clause
11769 (when vhdl-auto-align
(vhdl-align-region-groups start
(point) 1)))))
11771 (defun vhdl-port-paste-declaration (kind &optional no-indent
)
11772 "Paste as an entity or component declaration."
11773 (unless no-indent
(indent-according-to-mode))
11774 (let ((margin (current-indentation))
11775 (name (nth 0 vhdl-port-list
)))
11776 (vhdl-insert-keyword (if (eq kind
'entity
) "ENTITY " "COMPONENT "))
11778 (when (or (eq kind
'entity
) (not (vhdl-standard-p '87)))
11779 (vhdl-insert-keyword " IS"))
11780 ;; paste generic and port clause
11781 (when (nth 1 vhdl-port-list
)
11783 (when (and (memq vhdl-insert-empty-lines
'(unit all
)) (eq kind
'entity
))
11785 (indent-to (+ margin vhdl-basic-offset
))
11786 (vhdl-port-paste-generic (eq kind
'component
)))
11787 (when (nth 2 vhdl-port-list
)
11789 (when (and (memq vhdl-insert-empty-lines
'(unit all
))
11792 (indent-to (+ margin vhdl-basic-offset
)))
11793 (vhdl-port-paste-port)
11795 (when (and (memq vhdl-insert-empty-lines
'(unit all
)) (eq kind
'entity
))
11798 (vhdl-insert-keyword "END")
11799 (if (eq kind
'entity
)
11801 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " ENTITY"))
11803 (vhdl-insert-keyword " COMPONENT")
11804 (unless (vhdl-standard-p '87) (insert " " name
)))
11807 (defun vhdl-port-paste-entity (&optional no-indent
)
11808 "Paste as an entity declaration."
11810 (if (not vhdl-port-list
)
11811 (error "ERROR: No port read")
11812 (message "Pasting port as entity \"%s\"..." (car vhdl-port-list
))
11813 (vhdl-port-paste-declaration 'entity no-indent
)
11814 (message "Pasting port as entity \"%s\"...done" (car vhdl-port-list
))))
11816 (defun vhdl-port-paste-component (&optional no-indent
)
11817 "Paste as a component declaration."
11819 (if (not vhdl-port-list
)
11820 (error "ERROR: No port read")
11821 (message "Pasting port as component \"%s\"..." (car vhdl-port-list
))
11822 (vhdl-port-paste-declaration 'component no-indent
)
11823 (message "Pasting port as component \"%s\"...done" (car vhdl-port-list
))))
11825 (defun vhdl-port-paste-generic-map (&optional secondary no-constants
)
11826 "Paste as a generic map."
11828 (unless secondary
(indent-according-to-mode))
11829 (let ((margin (current-indentation))
11830 list-margin start generic
11831 (generic-list (nth 1 vhdl-port-list
)))
11833 (setq start
(point))
11834 (vhdl-insert-keyword "GENERIC MAP (")
11835 (if (not vhdl-association-list-with-formals
)
11836 ;; paste list of actual generics
11837 (while generic-list
11838 (insert (if no-constants
11839 (car (nth 0 (car generic-list
)))
11840 (or (nth 2 (car generic-list
)) " ")))
11841 (setq generic-list
(cdr generic-list
))
11842 (insert (if generic-list
", " ")"))
11843 (when (and (not generic-list
) secondary
11844 (null (nth 2 vhdl-port-list
)))
11846 (unless vhdl-argument-list-indent
11847 (insert "\n") (indent-to (+ margin vhdl-basic-offset
)))
11848 (setq list-margin
(current-column))
11849 (while generic-list
11850 (setq generic
(car generic-list
))
11851 ;; paste group comment and spacing
11852 (when (eq vhdl-include-group-comments
'always
)
11853 (vhdl-paste-group-comment (nth 4 generic
) list-margin
))
11854 ;; paste formal and actual generic
11855 (insert (car (nth 0 generic
)) " => "
11857 (vhdl-replace-string vhdl-actual-generic-name
11858 (car (nth 0 generic
)))
11859 (or (nth 2 generic
) "")))
11860 (setq generic-list
(cdr generic-list
))
11861 (insert (if generic-list
"," ")"))
11862 (when (and (not generic-list
) secondary
11863 (null (nth 2 vhdl-port-list
)))
11866 (when (or vhdl-include-type-comments
11867 (and vhdl-include-port-comments
(nth 3 generic
)))
11868 (vhdl-comment-insert-inline
11870 (when vhdl-include-type-comments
11871 (concat "[" (nth 1 generic
) "] "))
11872 (when vhdl-include-port-comments
(nth 3 generic
))) t
))
11873 (when generic-list
(insert "\n") (indent-to list-margin
)))
11874 ;; align generic map
11875 (when vhdl-auto-align
11876 (vhdl-align-region-groups start
(point) 1 t
))))))
11878 (defun vhdl-port-paste-port-map ()
11879 "Paste as a port map."
11880 (let ((margin (current-indentation))
11881 list-margin start port
11882 (port-list (nth 2 vhdl-port-list
)))
11884 (setq start
(point))
11885 (vhdl-insert-keyword "PORT MAP (")
11886 (if (not vhdl-association-list-with-formals
)
11887 ;; paste list of actual ports
11889 (insert (vhdl-replace-string vhdl-actual-port-name
11890 (car (nth 0 (car port-list
)))))
11891 (setq port-list
(cdr port-list
))
11892 (insert (if port-list
", " ")")))
11893 (unless vhdl-argument-list-indent
11894 (insert "\n") (indent-to (+ margin vhdl-basic-offset
)))
11895 (setq list-margin
(current-column))
11897 (setq port
(car port-list
))
11898 ;; paste group comment and spacing
11899 (when (eq vhdl-include-group-comments
'always
)
11900 (vhdl-paste-group-comment (nth 5 port
) list-margin
))
11901 ;; paste formal and actual port
11902 (insert (car (nth 0 port
)) " => ")
11903 (insert (vhdl-replace-string vhdl-actual-port-name
11904 (car (nth 0 port
))))
11905 (setq port-list
(cdr port-list
))
11906 (insert (if port-list
"," ");"))
11908 (when (or (and vhdl-include-direction-comments
(nth 2 port
))
11909 vhdl-include-type-comments
11910 (and vhdl-include-port-comments
(nth 4 port
)))
11911 (vhdl-comment-insert-inline
11913 (cond ((and vhdl-include-direction-comments
11914 vhdl-include-type-comments
)
11915 (concat "[" (format "%-4s" (concat (nth 2 port
) " "))
11916 (nth 3 port
) "] "))
11917 ((and vhdl-include-direction-comments
(nth 2 port
))
11918 (format "%-6s" (concat "[" (nth 2 port
) "] ")))
11919 (vhdl-include-direction-comments " ")
11920 (vhdl-include-type-comments
11921 (concat "[" (nth 3 port
) "] ")))
11922 (when vhdl-include-port-comments
(nth 4 port
))) t
))
11923 (when port-list
(insert "\n") (indent-to list-margin
)))
11924 ;; align port clause
11925 (when vhdl-auto-align
11926 (vhdl-align-region-groups start
(point) 1))))))
11928 (defun vhdl-port-paste-instance (&optional name no-indent title
)
11929 "Paste as an instantiation."
11931 (if (not vhdl-port-list
)
11932 (error "ERROR: No port read")
11933 (let ((orig-vhdl-port-list vhdl-port-list
))
11934 ;; flatten local copy of port list (must be flat for port mapping)
11935 (vhdl-port-flatten)
11936 (unless no-indent
(indent-according-to-mode))
11937 (let ((margin (current-indentation)))
11938 ;; paste instantiation
11941 ((equal (cdr vhdl-instance-name
) "")
11942 (setq name
(vhdl-template-field "instance name")))
11943 ((string-match "\%d" (cdr vhdl-instance-name
))
11945 (while (save-excursion
11946 (setq name
(format (vhdl-replace-string
11948 (nth 0 vhdl-port-list
)) n
))
11949 (goto-char (point-min))
11950 (vhdl-re-search-forward name nil t
))
11953 (t (insert (vhdl-replace-string vhdl-instance-name
11954 (nth 0 vhdl-port-list
)))))
11955 (message "Pasting port as instantiation \"%s\"..." name
)
11959 (beginning-of-line)
11960 (indent-to vhdl-basic-offset
)
11961 (insert "-- instance \"" name
"\"\n")))
11962 (if (not (vhdl-use-direct-instantiation))
11963 (insert (nth 0 vhdl-port-list
))
11964 (vhdl-insert-keyword "ENTITY ")
11965 (insert (vhdl-work-library) "." (nth 0 vhdl-port-list
)))
11966 (when (nth 1 vhdl-port-list
)
11967 (insert "\n") (indent-to (+ margin vhdl-basic-offset
))
11968 (vhdl-port-paste-generic-map t t
))
11969 (when (nth 2 vhdl-port-list
)
11970 (insert "\n") (indent-to (+ margin vhdl-basic-offset
))
11971 (vhdl-port-paste-port-map))
11972 (unless (or (nth 1 vhdl-port-list
) (nth 2 vhdl-port-list
))
11974 (message "Pasting port as instantiation \"%s\"...done" name
))
11975 (setq vhdl-port-list orig-vhdl-port-list
))))
11977 (defun vhdl-port-paste-constants (&optional no-indent
)
11978 "Paste generics as constants."
11980 (if (not vhdl-port-list
)
11981 (error "ERROR: No port read")
11982 (let ((orig-vhdl-port-list vhdl-port-list
))
11983 (message "Pasting port as constants...")
11984 ;; flatten local copy of port list (must be flat for constant initial.)
11985 (vhdl-port-flatten)
11986 (unless no-indent
(indent-according-to-mode))
11987 (let ((margin (current-indentation))
11989 (generic-list (nth 1 vhdl-port-list
)))
11991 (setq start
(point))
11992 (while generic-list
11993 (setq generic
(car generic-list
))
11994 ;; paste group comment and spacing
11995 (when (memq vhdl-include-group-comments
'(decl always
))
11996 (vhdl-paste-group-comment (nth 4 generic
) margin
))
11997 (vhdl-insert-keyword "CONSTANT ")
11998 ;; paste generic constants
11999 (setq name
(nth 0 generic
))
12001 (insert (vhdl-replace-string vhdl-actual-generic-name
(car name
)))
12003 (insert " : " (nth 1 generic
))
12004 ;; paste initialization
12005 (when (nth 2 generic
)
12006 (insert " := " (nth 2 generic
)))
12009 (when (and vhdl-include-port-comments
(nth 3 generic
))
12010 (vhdl-comment-insert-inline (nth 3 generic
) t
))
12011 (setq generic-list
(cdr generic-list
))
12012 (when generic-list
(insert "\n") (indent-to margin
))))
12013 ;; align signal list
12014 (when vhdl-auto-align
12015 (vhdl-align-region-groups start
(point) 1))))
12016 (message "Pasting port as constants...done")
12017 (setq vhdl-port-list orig-vhdl-port-list
))))
12019 (defun vhdl-port-paste-signals (&optional initialize no-indent
)
12020 "Paste ports as internal signals."
12022 (if (not vhdl-port-list
)
12023 (error "ERROR: No port read")
12024 (message "Pasting port as signals...")
12025 (unless no-indent
(indent-according-to-mode))
12026 (let ((margin (current-indentation))
12027 start port names type generic-list port-name constant-name pos
12028 (port-list (nth 2 vhdl-port-list
)))
12030 (setq start
(point))
12032 (setq port
(car port-list
))
12033 ;; paste group comment and spacing
12034 (when (memq vhdl-include-group-comments
'(decl always
))
12035 (vhdl-paste-group-comment (nth 5 port
) margin
))
12038 (insert (nth 1 port
) " ")
12039 (vhdl-insert-keyword "SIGNAL "))
12040 ;; paste actual port signals
12041 (setq names
(nth 0 port
))
12043 (insert (vhdl-replace-string vhdl-actual-port-name
(car names
)))
12044 (setq names
(cdr names
))
12045 (when names
(insert ", ")))
12047 (setq type
(nth 3 port
))
12048 (setq generic-list
(nth 1 vhdl-port-list
))
12049 (vhdl-prepare-search-1
12051 ;; replace formal by actual generics
12052 (while generic-list
12053 (setq port-name
(car (nth 0 (car generic-list
))))
12054 (while (string-match (concat "\\<" port-name
"\\>") type pos
)
12055 (setq constant-name
12056 (save-match-data (vhdl-replace-string
12057 vhdl-actual-generic-name port-name
)))
12058 (setq type
(replace-match constant-name t nil type
))
12059 (setq pos
(match-end 0)))
12060 (setq generic-list
(cdr generic-list
))))
12061 (insert " : " type
)
12062 ;; paste initialization (inputs only)
12063 (when (and initialize
(nth 2 port
) (equal "IN" (upcase (nth 2 port
))))
12065 (cond ((string-match "integer" (nth 3 port
)) "0")
12066 ((string-match "natural" (nth 3 port
)) "0")
12067 ((string-match "positive" (nth 3 port
)) "0")
12068 ((string-match "real" (nth 3 port
)) "0.0")
12069 ((string-match "(.+)" (nth 3 port
)) "(others => '0')")
12073 (when (or (and vhdl-include-direction-comments
(nth 2 port
))
12074 (and vhdl-include-port-comments
(nth 4 port
)))
12075 (vhdl-comment-insert-inline
12077 (cond ((and vhdl-include-direction-comments
(nth 2 port
))
12078 (format "%-6s" (concat "[" (nth 2 port
) "] ")))
12079 (vhdl-include-direction-comments " "))
12080 (when vhdl-include-port-comments
(nth 4 port
))) t
))
12081 (setq port-list
(cdr port-list
))
12082 (when port-list
(insert "\n") (indent-to margin
)))
12083 ;; align signal list
12084 (when vhdl-auto-align
(vhdl-align-region-groups start
(point) 1))))
12085 (message "Pasting port as signals...done")))
12087 (defun vhdl-port-paste-initializations (&optional no-indent
)
12088 "Paste ports as signal initializations."
12090 (if (not vhdl-port-list
)
12091 (error "ERROR: No port read")
12092 (let ((orig-vhdl-port-list vhdl-port-list
))
12093 (message "Pasting port as initializations...")
12094 ;; flatten local copy of port list (must be flat for signal initial.)
12095 (vhdl-port-flatten)
12096 (unless no-indent
(indent-according-to-mode))
12097 (let ((margin (current-indentation))
12099 (port-list (nth 2 vhdl-port-list
)))
12101 (setq start
(point))
12103 (setq port
(car port-list
))
12104 ;; paste actual port signal (inputs only)
12105 (when (equal "IN" (upcase (nth 2 port
)))
12106 (setq name
(car (nth 0 port
)))
12107 (insert (vhdl-replace-string vhdl-actual-port-name name
))
12108 ;; paste initialization
12110 (cond ((string-match "integer" (nth 3 port
)) "0")
12111 ((string-match "natural" (nth 3 port
)) "0")
12112 ((string-match "positive" (nth 3 port
)) "0")
12113 ((string-match "real" (nth 3 port
)) "0.0")
12114 ((string-match "(.+)" (nth 3 port
)) "(others => '0')")
12117 (setq port-list
(cdr port-list
))
12118 (when (and port-list
12119 (equal "IN" (upcase (nth 2 (car port-list
)))))
12120 (insert "\n") (indent-to margin
)))
12121 ;; align signal list
12122 (when vhdl-auto-align
(vhdl-align-region-groups start
(point) 1))))
12123 (message "Pasting port as initializations...done")
12124 (setq vhdl-port-list orig-vhdl-port-list
))))
12126 (defun vhdl-port-paste-testbench ()
12127 "Paste as a bare-bones testbench."
12129 (if (not vhdl-port-list
)
12130 (error "ERROR: No port read")
12131 (let ((case-fold-search t
)
12132 (ent-name (vhdl-replace-string vhdl-testbench-entity-name
12133 (nth 0 vhdl-port-list
)))
12134 (source-buffer (current-buffer))
12135 arch-name config-name ent-file-name arch-file-name
12136 ent-buffer arch-buffer position
)
12137 ;; open entity file
12138 (unless (eq vhdl-testbench-create-files
'none
)
12139 (setq ent-file-name
12140 (concat (vhdl-replace-string vhdl-testbench-entity-file-name
12142 "." (file-name-extension (buffer-file-name))))
12143 (if (file-exists-p ent-file-name
)
12145 (concat "File \"" ent-file-name
"\" exists; overwrite? "))
12146 (progn (find-file ent-file-name
)
12148 (set-buffer-modified-p nil
))
12149 (if (eq vhdl-testbench-create-files
'separate
)
12150 (setq ent-file-name nil
)
12151 (error "ERROR: Pasting port as testbench...aborted")))
12152 (find-file ent-file-name
)))
12153 (unless (and (eq vhdl-testbench-create-files
'separate
)
12154 (null ent-file-name
))
12155 ;; paste entity header
12156 (if vhdl-testbench-include-header
12157 (progn (vhdl-template-header
12158 (concat "Testbench for design \""
12159 (nth 0 vhdl-port-list
) "\""))
12160 (goto-char (point-max)))
12161 (vhdl-comment-display-line) (insert "\n\n"))
12162 ;; paste std_logic_1164 package
12163 (when vhdl-testbench-include-library
12164 (vhdl-template-package-std-logic-1164)
12165 (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n"))
12166 ;; paste entity declaration
12167 (vhdl-insert-keyword "ENTITY ")
12169 (vhdl-insert-keyword " IS")
12170 (when (memq vhdl-insert-empty-lines
'(unit all
)) (insert "\n"))
12172 (vhdl-insert-keyword "END ")
12173 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
12174 (insert ent-name
";")
12176 (vhdl-comment-display-line) (insert "\n"))
12177 ;; get architecture name
12178 (setq arch-name
(if (equal (cdr vhdl-testbench-architecture-name
) "")
12179 (read-from-minibuffer "architecture name: "
12180 nil vhdl-minibuffer-local-map
)
12181 (vhdl-replace-string vhdl-testbench-architecture-name
12182 (nth 0 vhdl-port-list
))))
12183 (message "Pasting port as testbench \"%s(%s)\"..." ent-name arch-name
)
12184 ;; open architecture file
12185 (if (not (eq vhdl-testbench-create-files
'separate
))
12187 (setq ent-buffer
(current-buffer))
12188 (setq arch-file-name
12189 (concat (vhdl-replace-string vhdl-testbench-architecture-file-name
12190 (concat ent-name
" " arch-name
) t
)
12191 "." (file-name-extension (buffer-file-name))))
12192 (when (and (file-exists-p arch-file-name
)
12193 (not (y-or-n-p (concat "File \"" arch-file-name
12194 "\" exists; overwrite? "))))
12195 (error "ERROR: Pasting port as testbench...aborted"))
12196 (find-file arch-file-name
)
12198 (set-buffer-modified-p nil
)
12199 ;; paste architecture header
12200 (if vhdl-testbench-include-header
12201 (progn (vhdl-template-header
12202 (concat "Testbench architecture for design \""
12203 (nth 0 vhdl-port-list
) "\""))
12204 (goto-char (point-max)))
12205 (vhdl-comment-display-line) (insert "\n\n")))
12206 ;; paste architecture body
12207 (vhdl-insert-keyword "ARCHITECTURE ")
12209 (vhdl-insert-keyword " OF ")
12211 (vhdl-insert-keyword " IS")
12212 (insert "\n\n") (indent-to vhdl-basic-offset
)
12213 ;; paste component declaration
12214 (unless (vhdl-use-direct-instantiation)
12215 (vhdl-port-paste-component t
)
12216 (insert "\n\n") (indent-to vhdl-basic-offset
))
12218 (when (nth 1 vhdl-port-list
)
12219 (insert "-- component generics\n") (indent-to vhdl-basic-offset
)
12220 (vhdl-port-paste-constants t
)
12221 (insert "\n\n") (indent-to vhdl-basic-offset
))
12222 ;; paste internal signals
12223 (insert "-- component ports\n") (indent-to vhdl-basic-offset
)
12224 (vhdl-port-paste-signals vhdl-testbench-initialize-signals t
)
12226 ;; paste custom declarations
12227 (unless (equal "" vhdl-testbench-declarations
)
12229 (setq position
(point))
12230 (vhdl-insert-string-or-file vhdl-testbench-declarations
)
12231 (vhdl-indent-region position
(point)))
12232 (setq position
(point))
12234 (vhdl-comment-display-line) (insert "\n")
12235 (when vhdl-testbench-include-configuration
12236 (setq config-name
(vhdl-replace-string
12237 vhdl-testbench-configuration-name
12238 (concat ent-name
" " arch-name
)))
12240 (vhdl-insert-keyword "CONFIGURATION ") (insert config-name
)
12241 (vhdl-insert-keyword " OF ") (insert ent-name
)
12242 (vhdl-insert-keyword " IS\n")
12243 (indent-to vhdl-basic-offset
)
12244 (vhdl-insert-keyword "FOR ") (insert arch-name
"\n")
12245 (indent-to vhdl-basic-offset
)
12246 (vhdl-insert-keyword "END FOR;\n")
12247 (vhdl-insert-keyword "END ") (insert config-name
";\n\n")
12248 (vhdl-comment-display-line) (insert "\n"))
12249 (goto-char position
)
12250 (vhdl-template-begin-end
12251 (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name
0 t
)
12252 ;; paste instantiation
12253 (insert "-- component instantiation\n") (indent-to vhdl-basic-offset
)
12254 (vhdl-port-paste-instance
12255 (vhdl-replace-string vhdl-testbench-dut-name
(nth 0 vhdl-port-list
)) t
)
12257 ;; paste custom statements
12258 (unless (equal "" vhdl-testbench-statements
)
12260 (setq position
(point))
12261 (vhdl-insert-string-or-file vhdl-testbench-statements
)
12262 (vhdl-indent-region position
(point)))
12264 (indent-to vhdl-basic-offset
)
12265 (unless (eq vhdl-testbench-create-files
'none
)
12266 (setq arch-buffer
(current-buffer))
12267 (when ent-buffer
(set-buffer ent-buffer
) (save-buffer))
12268 (set-buffer arch-buffer
) (save-buffer))
12270 (concat (format "Pasting port as testbench \"%s(%s)\"...done"
12271 ent-name arch-name
)
12273 (format "\n File created: \"%s\"" ent-file-name
))
12274 (and arch-file-name
12275 (format "\n File created: \"%s\"" arch-file-name
)))))))
12278 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12279 ;;; Subprogram interface translation
12280 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12282 (defvar vhdl-subprog-list nil
12283 "Variable to hold last subprogram interface parsed.")
12284 ;; structure: (parenthesized expression means list of such entries)
12285 ;; (subprog-name kind
12286 ;; ((names) object direct type init comment group-comment)
12287 ;; return-type return-comment group-comment)
12289 (defvar vhdl-subprog-flattened nil
12290 "Indicates whether an subprogram interface has been flattened.")
12292 (defun vhdl-subprog-flatten ()
12293 "Flatten interface list so that only one parameter exists per line."
12295 (if (not vhdl-subprog-list
)
12296 (error "ERROR: No subprogram interface has been read")
12297 (message "Flattening subprogram interface...")
12298 (let ((old-subprog-list (nth 2 vhdl-subprog-list
))
12299 new-subprog-list old-subprog new-subprog names
)
12300 ;; traverse parameter list and flatten entries
12301 (while old-subprog-list
12302 (setq old-subprog
(car old-subprog-list
))
12303 (setq names
(car old-subprog
))
12305 (setq new-subprog
(cons (list (car names
)) (cdr old-subprog
)))
12306 (setq new-subprog-list
(append new-subprog-list
(list new-subprog
)))
12307 (setq names
(cdr names
)))
12308 (setq old-subprog-list
(cdr old-subprog-list
)))
12309 (setq vhdl-subprog-list
12310 (list (nth 0 vhdl-subprog-list
) (nth 1 vhdl-subprog-list
)
12311 new-subprog-list
(nth 3 vhdl-subprog-list
)
12312 (nth 4 vhdl-subprog-list
) (nth 5 vhdl-subprog-list
))
12313 vhdl-subprog-flattened t
)
12314 (message "Flattening subprogram interface...done"))))
12316 (defun vhdl-subprog-copy ()
12317 "Get interface information from a subprogram specification."
12320 (let (parse-error pos end-of-list
12321 name kind param-list object names direct type init
12322 comment group-comment
12323 return-type return-comment return-group-comment
)
12324 (vhdl-prepare-search-2
12328 ;; check if within function declaration
12331 (when (looking-at "[ \t\n\r\f]*\\((\\|;\\|is\\>\\)") (goto-char (match-end 0)))
12332 (unless (and (re-search-backward "^\\s-*\\(\\(procedure\\)\\|\\(\\(pure\\|impure\\)\\s-+\\)?function\\)\\s-+\\(\"?\\w+\"?\\)[ \t\n\r\f]*\\(\\((\\)\\|;\\|is\\>\\)" nil t
)
12333 (goto-char (match-end 0))
12334 (save-excursion (backward-char)
12337 (throw 'parse
"ERROR: Not within a subprogram specification"))
12338 (setq name
(match-string-no-properties 5))
12339 (setq kind
(if (match-string 2) 'procedure
'function
))
12340 (setq end-of-list
(not (match-string 7)))
12341 (message "Reading interface of subprogram \"%s\"..." name
)
12342 ;; parse parameter list
12343 (setq group-comment
(vhdl-parse-group-comment))
12344 (setq end-of-list
(or end-of-list
12345 (vhdl-parse-string ")[ \t\n\r\f]*\\(;\\|\\(is\\|return\\)\\>\\)" t
)))
12346 (while (not end-of-list
)
12349 (and (vhdl-parse-string "\\(constant\\|signal\\|variable\\|file\\|quantity\\|terminal\\)[ \t\n\r\f]*" t
)
12350 (match-string-no-properties 1)))
12351 ;; parse names (accept extended identifiers)
12352 (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*")
12353 (setq names
(list (match-string-no-properties 1)))
12354 (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t
)
12355 (setq names
(append names
(list (match-string-no-properties 1)))))
12357 (vhdl-parse-string ":[ \t\n\r\f]*")
12359 (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n\r\f]+" t
)
12360 (match-string-no-properties 1)))
12362 (vhdl-parse-string "\\([^():;\n]+\\)")
12363 (setq type
(match-string-no-properties 1))
12365 (while (looking-at "(")
12368 (buffer-substring-no-properties
12369 (point) (progn (forward-sexp) (point)))
12370 (and (vhdl-parse-string "\\([^():;\n]*\\)" t
)
12371 (match-string-no-properties 1)))))
12372 ;; special case: closing parenthesis is on separate line
12373 (when (and type
(string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type
))
12374 (setq comment
(substring type
(match-beginning 2)))
12375 (setq type
(substring type
0 (match-beginning 1))))
12376 ;; strip off trailing group-comment
12377 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type
)
12378 (setq type
(substring type
0 (match-end 1)))
12379 ;; parse initialization expression
12381 (when (vhdl-parse-string ":=[ \t\n\r\f]*" t
)
12382 (vhdl-parse-string "\\([^();\n]*\\)")
12383 (setq init
(match-string-no-properties 1))
12384 (while (looking-at "(")
12387 (buffer-substring-no-properties
12388 (point) (progn (forward-sexp) (point)))
12389 (and (vhdl-parse-string "\\([^();\n]*\\)" t
)
12390 (match-string-no-properties 1))))))
12391 ;; special case: closing parenthesis is on separate line
12392 (when (and init
(string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init
))
12393 (setq comment
(substring init
(match-beginning 2)))
12394 (setq init
(substring init
0 (match-beginning 1)))
12395 (vhdl-forward-syntactic-ws))
12396 (skip-chars-forward " \t")
12397 ;; parse inline comment, special case: as above, no initial.
12399 (setq comment
(and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t
)
12400 (match-string-no-properties 1))))
12401 (vhdl-forward-syntactic-ws)
12402 (setq end-of-list
(vhdl-parse-string ")\\s-*" t
))
12403 ;; parse inline comment
12405 (setq comment
(and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t
)
12406 (match-string-no-properties 1))))
12407 (setq return-group-comment
(vhdl-parse-group-comment))
12408 (vhdl-parse-string "\\(;\\|\\(is\\|\\(return\\)\\)\\>\\)\\s-*")
12409 ;; parse return type
12410 (when (match-string 3)
12411 (vhdl-parse-string "[ \t\n\r\f]*\\(.+\\)[ \t\n\r\f]*\\(;\\|is\\>\\)\\s-*")
12412 (setq return-type
(match-string-no-properties 1))
12413 (when (and return-type
12414 (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" return-type
))
12415 (setq return-comment
(substring return-type
(match-beginning 2)))
12416 (setq return-type
(substring return-type
0 (match-beginning 1))))
12417 ;; strip of trailing group-comment
12418 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" return-type
)
12419 (setq return-type
(substring return-type
0 (match-end 1)))
12420 ;; parse return comment
12421 (unless return-comment
12422 (setq return-comment
(and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t
)
12423 (match-string-no-properties 1)))))
12424 ;; parse inline comment
12426 (setq comment
(and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t
)
12427 (match-string-no-properties 1))))
12428 ;; save everything in list
12429 (setq param-list
(append param-list
12430 (list (list names object direct type init
12431 comment group-comment
))))
12432 ;; parse group comment and spacing
12433 (setq group-comment
(vhdl-parse-group-comment)))
12434 (message "Reading interface of subprogram \"%s\"...done" name
)
12438 (error parse-error
)
12439 (setq vhdl-subprog-list
12440 (list name kind param-list return-type return-comment
12441 return-group-comment
)
12442 vhdl-subprog-flattened nil
)))))
12444 (defun vhdl-subprog-paste-specification (kind)
12445 "Paste as a subprogram specification."
12446 (indent-according-to-mode)
12447 (let ((margin (current-column))
12448 (param-list (nth 2 vhdl-subprog-list
))
12449 list-margin start names param
)
12450 ;; paste keyword and name
12451 (vhdl-insert-keyword
12452 (if (eq (nth 1 vhdl-subprog-list
) 'procedure
) "PROCEDURE " "FUNCTION "))
12453 (insert (nth 0 vhdl-subprog-list
))
12454 (if (not param-list
)
12455 (if (eq kind
'decl
) (insert ";") (vhdl-insert-keyword " is"))
12456 (setq start
(point))
12457 ;; paste parameter list
12459 (unless vhdl-argument-list-indent
12460 (insert "\n") (indent-to (+ margin vhdl-basic-offset
)))
12461 (setq list-margin
(current-column))
12463 (setq param
(car param-list
))
12464 ;; paste group comment and spacing
12465 (when (memq vhdl-include-group-comments
(list kind
'always
))
12466 (vhdl-paste-group-comment (nth 6 param
) list-margin
))
12468 (when (nth 1 param
) (insert (nth 1 param
) " "))
12470 (setq names
(nth 0 param
))
12472 (insert (car names
))
12473 (setq names
(cdr names
))
12474 (when names
(insert ", ")))
12477 (when (nth 2 param
) (insert (nth 2 param
) " "))
12479 (insert (nth 3 param
))
12480 ;; paste initialization
12481 (when (nth 4 param
) (insert " := " (nth 4 param
)))
12483 (if (cdr param-list
)
12486 (when (null (nth 3 vhdl-subprog-list
))
12487 (if (eq kind
'decl
) (insert ";") (vhdl-insert-keyword " is"))))
12489 (when (and vhdl-include-port-comments
(nth 5 param
))
12490 (vhdl-comment-insert-inline (nth 5 param
) t
))
12491 (setq param-list
(cdr param-list
))
12492 (when param-list
(insert "\n") (indent-to list-margin
)))
12493 (when (nth 3 vhdl-subprog-list
)
12494 (insert "\n") (indent-to list-margin
)
12495 ;; paste group comment and spacing
12496 (when (memq vhdl-include-group-comments
(list kind
'always
))
12497 (vhdl-paste-group-comment (nth 5 vhdl-subprog-list
) list-margin
))
12498 ;; paste return type
12499 (insert "return " (nth 3 vhdl-subprog-list
))
12500 (if (eq kind
'decl
) (insert ";") (vhdl-insert-keyword " is"))
12501 (when (and vhdl-include-port-comments
(nth 4 vhdl-subprog-list
))
12502 (vhdl-comment-insert-inline (nth 4 vhdl-subprog-list
) t
)))
12503 ;; align parameter list
12504 (when vhdl-auto-align
(vhdl-align-region-groups start
(point) 1 t
)))
12506 (when (eq kind
'body
)
12508 (vhdl-template-begin-end
12509 (unless (vhdl-standard-p '87)
12510 (if (eq (nth 1 vhdl-subprog-list
) 'procedure
) "PROCEDURE" "FUNCTION"))
12511 (nth 0 vhdl-subprog-list
) margin
))))
12513 (defun vhdl-subprog-paste-declaration ()
12514 "Paste as a subprogram declaration."
12516 (if (not vhdl-subprog-list
)
12517 (error "ERROR: No subprogram interface read")
12518 (message "Pasting interface as subprogram declaration \"%s\"..."
12519 (car vhdl-subprog-list
))
12520 ;; paste specification
12521 (vhdl-subprog-paste-specification 'decl
)
12522 (message "Pasting interface as subprogram declaration \"%s\"...done"
12523 (car vhdl-subprog-list
))))
12525 (defun vhdl-subprog-paste-body ()
12526 "Paste as a subprogram body."
12528 (if (not vhdl-subprog-list
)
12529 (error "ERROR: No subprogram interface read")
12530 (message "Pasting interface as subprogram body \"%s\"..."
12531 (car vhdl-subprog-list
))
12532 ;; paste specification and body
12533 (vhdl-subprog-paste-specification 'body
)
12534 (message "Pasting interface as subprogram body \"%s\"...done"
12535 (car vhdl-subprog-list
))))
12537 (defun vhdl-subprog-paste-call ()
12538 "Paste as a subprogram call."
12540 (if (not vhdl-subprog-list
)
12541 (error "ERROR: No subprogram interface read")
12542 (let ((orig-vhdl-subprog-list vhdl-subprog-list
)
12543 param-list margin list-margin param start
)
12544 ;; flatten local copy of interface list (must be flat for parameter mapping)
12545 (vhdl-subprog-flatten)
12546 (setq param-list
(nth 2 vhdl-subprog-list
))
12547 (indent-according-to-mode)
12548 (setq margin
(current-indentation))
12549 (message "Pasting interface as subprogram call \"%s\"..."
12550 (car vhdl-subprog-list
))
12552 (insert (nth 0 vhdl-subprog-list
))
12553 (if (not param-list
)
12555 (setq start
(point))
12556 ;; paste parameter list
12558 (unless vhdl-argument-list-indent
12559 (insert "\n") (indent-to (+ margin vhdl-basic-offset
)))
12560 (setq list-margin
(current-column))
12562 (setq param
(car param-list
))
12563 ;; paste group comment and spacing
12564 (when (eq vhdl-include-group-comments
'always
)
12565 (vhdl-paste-group-comment (nth 6 param
) list-margin
))
12566 ;; paste formal port
12567 (insert (car (nth 0 param
)) " => ")
12568 (setq param-list
(cdr param-list
))
12569 (insert (if param-list
"," ");"))
12571 (when (and vhdl-include-port-comments
(nth 5 param
))
12572 (vhdl-comment-insert-inline (nth 5 param
)))
12573 (when param-list
(insert "\n") (indent-to list-margin
)))
12574 ;; align parameter list
12575 (when vhdl-auto-align
12576 (vhdl-align-region-groups start
(point) 1)))
12577 (message "Pasting interface as subprogram call \"%s\"...done"
12578 (car vhdl-subprog-list
))
12579 (setq vhdl-subprog-list orig-vhdl-subprog-list
))))
12582 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12584 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12586 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12587 ;; Hippie expand customization
12589 (defvar vhdl-expand-upper-case nil
)
12591 (defun vhdl-try-expand-abbrev (old)
12592 "Try expanding abbreviations from `vhdl-abbrev-list'."
12594 (he-init-string (he-dabbrev-beg) (point))
12595 (setq he-expand-list
12596 (let ((abbrev-list vhdl-abbrev-list
)
12597 (sel-abbrev-list '()))
12599 (when (or (not (stringp (car abbrev-list
)))
12601 (concat "^" he-search-string
) (car abbrev-list
)))
12602 (setq sel-abbrev-list
12603 (cons (car abbrev-list
) sel-abbrev-list
)))
12604 (setq abbrev-list
(cdr abbrev-list
)))
12605 (nreverse sel-abbrev-list
))))
12606 (while (and he-expand-list
12607 (or (not (stringp (car he-expand-list
)))
12608 (he-string-member (car he-expand-list
) he-tried-table t
)))
12609 (unless (stringp (car he-expand-list
))
12610 (setq vhdl-expand-upper-case
(car he-expand-list
)))
12611 (setq he-expand-list
(cdr he-expand-list
)))
12612 (if (null he-expand-list
)
12613 (progn (when old
(he-reset-string))
12615 (he-substitute-string
12616 (if vhdl-expand-upper-case
12617 (upcase (car he-expand-list
))
12618 (car he-expand-list
))
12620 (setq he-expand-list
(cdr he-expand-list
))
12623 (defun vhdl-he-list-beg ()
12624 "Also looks at the word before `(' in order to better match parenthesized
12625 expressions (e.g. for index ranges of types and signals)."
12628 (progn (backward-up-list 1)
12629 (skip-syntax-backward "w_")) ; crashes in `viper-mode'
12633 ;; override `he-list-beg' from `hippie-exp'
12634 (unless (and (boundp 'viper-mode
) viper-mode
)
12635 (defalias 'he-list-beg
'vhdl-he-list-beg
))
12637 ;; function for expanding abbrevs and dabbrevs
12638 (defalias 'vhdl-expand-abbrev
(make-hippie-expand-function
12639 '(try-expand-dabbrev
12640 try-expand-dabbrev-all-buffers
12641 vhdl-try-expand-abbrev
)))
12643 ;; function for expanding parenthesis
12644 (defalias 'vhdl-expand-paren
(make-hippie-expand-function
12646 try-expand-list-all-buffers
)))
12648 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12649 ;; Line handling functions
12651 (defun vhdl-current-line ()
12652 "Return the line number of the line containing point."
12655 (1+ (count-lines (point-min) (point-at-bol)))))
12657 (defun vhdl-line-kill-entire (&optional arg
)
12658 "Delete entire line."
12660 (beginning-of-line)
12661 (kill-line (or arg
1)))
12663 (defun vhdl-line-kill (&optional arg
)
12664 "Kill current line."
12666 (vhdl-line-kill-entire arg
))
12668 (defun vhdl-line-copy (&optional arg
)
12669 "Copy current line."
12672 (let ((position (point-at-bol)))
12673 (forward-line (or arg
1))
12674 (copy-region-as-kill position
(point)))))
12676 (defun vhdl-line-yank ()
12677 "Yank entire line."
12679 (beginning-of-line)
12682 (defun vhdl-line-expand (&optional prefix-arg
)
12683 "Hippie-expand current line."
12685 (require 'hippie-exp
)
12686 (let ((case-fold-search t
) (case-replace nil
)
12687 (hippie-expand-try-functions-list
12688 '(try-expand-line try-expand-line-all-buffers
)))
12689 (hippie-expand prefix-arg
)))
12691 (defun vhdl-line-transpose-next (&optional arg
)
12692 "Interchange this line with next line."
12695 (transpose-lines (or arg
1))
12698 (defun vhdl-line-transpose-previous (&optional arg
)
12699 "Interchange this line with previous line."
12702 (transpose-lines (- 0 (or arg
0)))
12705 (defun vhdl-line-open ()
12706 "Open a new line and indent."
12709 (newline-and-indent))
12711 (defun vhdl-delete-indentation ()
12712 "Join lines. That is, call `delete-indentation' with `fill-prefix' so that
12713 it works within comments too."
12715 (let ((fill-prefix "-- "))
12716 (delete-indentation)))
12718 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12721 (defun vhdl-forward-same-indent ()
12722 "Move forward to next line with same indent."
12724 (let ((pos (point))
12725 (indent (current-indentation)))
12726 (beginning-of-line 2)
12727 (while (and (not (eobp))
12728 (or (looking-at "^\\s-*\\(--.*\\)?$")
12729 (> (current-indentation) indent
)))
12730 (beginning-of-line 2))
12731 (if (= (current-indentation) indent
)
12732 (back-to-indentation)
12733 (message "No following line with same indent found in this block")
12737 (defun vhdl-backward-same-indent ()
12738 "Move backward to previous line with same indent."
12740 (let ((pos (point))
12741 (indent (current-indentation)))
12742 (beginning-of-line -
0)
12743 (while (and (not (bobp))
12744 (or (looking-at "^\\s-*\\(--.*\\)?$")
12745 (> (current-indentation) indent
)))
12746 (beginning-of-line -
0))
12747 (if (= (current-indentation) indent
)
12748 (back-to-indentation)
12749 (message "No preceding line with same indent found in this block")
12753 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12756 (defun vhdl-statistics-buffer ()
12757 "Get some file statistics."
12764 (no-lines (count-lines (point-min) (point-max))))
12766 ;; count statements
12767 (goto-char (point-min))
12768 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\)\\|;" nil t
)
12769 (if (match-string 1)
12770 (goto-char (match-end 1))
12771 (setq no-stats
(1+ no-stats
))))
12772 ;; count code lines
12773 (goto-char (point-min))
12774 (while (not (eobp))
12775 (unless (looking-at "^\\s-*\\(--.*\\)?$")
12776 (setq no-code-lines
(1+ no-code-lines
)))
12777 (beginning-of-line 2))
12778 ;; count empty lines
12779 (goto-char (point-min))
12780 (while (and (re-search-forward "^\\s-*$" nil t
)
12781 (not (eq (point) (point-max))))
12782 (if (match-string 1)
12783 (goto-char (match-end 1))
12784 (setq no-empty-lines
(1+ no-empty-lines
))
12785 (unless (eq (point) (point-max))
12787 ;; count comment-only lines
12788 (goto-char (point-min))
12789 (while (re-search-forward "^\\s-*--.*" nil t
)
12790 (if (match-string 1)
12791 (goto-char (match-end 1))
12792 (setq no-comm-lines
(1+ no-comm-lines
))))
12794 (goto-char (point-min))
12795 (while (re-search-forward "--.*" nil t
)
12796 (if (match-string 1)
12797 (goto-char (match-end 1))
12798 (setq no-comments
(1+ no-comments
)))))
12801 File statistics: \"%s\"\n\
12802 -----------------------\n\
12803 # statements : %5d\n\
12804 # code lines : %5d\n\
12805 # empty lines : %5d\n\
12806 # comment lines : %5d\n\
12807 # comments : %5d\n\
12808 # total lines : %5d\n\ "
12809 (buffer-file-name) no-stats no-code-lines no-empty-lines
12810 no-comm-lines no-comments no-lines
)
12811 (unless vhdl-emacs-21
(vhdl-show-messages))))
12813 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12816 (defun vhdl-re-search-forward (regexp &optional bound noerror count
)
12817 "Like `re-search-forward', but does not match within literals."
12820 (while (and (setq pos
(re-search-forward regexp bound noerror count
))
12821 (vhdl-in-literal))))
12822 (when pos
(goto-char pos
))
12825 (defun vhdl-re-search-backward (regexp &optional bound noerror count
)
12826 "Like `re-search-backward', but does not match within literals."
12829 (while (and (setq pos
(re-search-backward regexp bound noerror count
))
12830 (vhdl-in-literal))))
12831 (when pos
(goto-char pos
))
12835 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12837 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12839 (defun vhdl-set-project (name)
12840 "Set current project to NAME."
12842 (list (let ((completion-ignore-case t
))
12843 (completing-read "Project name: " vhdl-project-alist nil t
))))
12844 (cond ((equal name
"")
12845 (setq vhdl-project nil
)
12846 (message "Current VHDL project: None"))
12847 ((assoc name vhdl-project-alist
)
12848 (setq vhdl-project name
)
12849 (message "Current VHDL project: \"%s\"" name
))
12851 (vhdl-warning (format "Unknown VHDL project: \"%s\"" name
))))
12852 (vhdl-speedbar-update-current-project))
12854 (defun vhdl-set-default-project ()
12855 "Set current project as default on startup."
12857 (customize-set-variable 'vhdl-project vhdl-project
)
12858 (customize-save-customized))
12860 (defun vhdl-toggle-project (name token indent
)
12861 "Set current project to NAME or unset if NAME is current project."
12862 (vhdl-set-project (if (equal name vhdl-project
) "" name
)))
12864 (defun vhdl-export-project (file-name)
12865 "Write project setup for current project."
12867 (let ((name (vhdl-resolve-env-variable
12868 (vhdl-replace-string
12869 (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name
))
12870 (concat (subst-char-in-string
12871 ? ?_
(or (vhdl-project-p)
12872 (error "ERROR: No current project")))
12873 " " (user-login-name))))))
12874 (list (read-file-name
12875 "Write project file: "
12876 (when (file-name-absolute-p name
) "") nil nil name
))))
12877 (setq file-name
(abbreviate-file-name file-name
))
12878 (let ((orig-buffer (current-buffer)))
12879 (unless (file-exists-p (file-name-directory file-name
))
12880 (make-directory (file-name-directory file-name
) t
))
12881 (if (not (file-writable-p file-name
))
12882 (error "ERROR: File not writable: \"%s\"" file-name
)
12883 (set-buffer (find-file-noselect file-name t t
))
12885 (insert ";; -*- Emacs-Lisp -*-\n\n"
12886 ";;; " (file-name-nondirectory file-name
)
12887 " - project setup file for Emacs VHDL Mode " vhdl-version
"\n\n"
12888 ";; Project : " vhdl-project
"\n"
12889 ";; Saved : " (format-time-string "%Y-%m-%d %T ")
12890 (user-login-name) "\n\n\n"
12891 ";; project name\n"
12892 "(setq vhdl-project \"" vhdl-project
"\")\n\n"
12893 ";; project setup\n"
12894 "(aput 'vhdl-project-alist vhdl-project\n'")
12895 (pp (aget vhdl-project-alist vhdl-project
) (current-buffer))
12898 (kill-buffer (current-buffer))
12899 (set-buffer orig-buffer
))))
12901 (defun vhdl-import-project (file-name &optional auto not-make-current
)
12902 "Read project setup and set current project."
12904 (let ((name (vhdl-resolve-env-variable
12905 (vhdl-replace-string
12906 (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name
))
12907 (concat "" " " (user-login-name))))))
12908 (list (read-file-name
12909 "Read project file: " (when (file-name-absolute-p name
) "") nil t
12910 (file-name-directory name
)))))
12911 (when (file-exists-p file-name
)
12913 (let ((current-project vhdl-project
))
12914 (load-file file-name
)
12915 (when (/= (length (aget vhdl-project-alist vhdl-project t
)) 10)
12916 (adelete 'vhdl-project-alist vhdl-project
)
12918 (when not-make-current
12919 (setq vhdl-project current-project
))
12920 (vhdl-update-mode-menu)
12921 (vhdl-speedbar-refresh)
12922 (unless not-make-current
12923 (message "Current VHDL project: \"%s\"%s"
12924 vhdl-project
(if auto
" (auto-loaded)" ""))))
12925 (error (vhdl-warning
12926 (format "ERROR: Invalid project setup file: \"%s\"" file-name
))))))
12928 (defun vhdl-duplicate-project ()
12929 "Duplicate setup of current project."
12931 (let ((new-name (read-from-minibuffer "New project name: "))
12932 (project-entry (aget vhdl-project-alist vhdl-project t
)))
12933 (setq vhdl-project-alist
12934 (append vhdl-project-alist
12935 (list (cons new-name project-entry
))))
12936 (vhdl-update-mode-menu)))
12938 (defun vhdl-auto-load-project ()
12939 "Automatically load project setup at startup."
12940 (let ((file-name-list vhdl-project-file-name
)
12941 file-list list-length
)
12942 (while file-name-list
12945 (file-expand-wildcards
12946 (vhdl-resolve-env-variable
12947 (vhdl-replace-string
12948 (cons "\\(.*\\) \\(.*\\)" (car file-name-list
))
12949 (concat "\*" " " (user-login-name)))))))
12950 (setq list-length
(or list-length
(length file-list
)))
12951 (setq file-name-list
(cdr file-name-list
)))
12953 (vhdl-import-project (expand-file-name (car file-list
)) t
12954 (not (> list-length
0)))
12955 (setq list-length
(1- list-length
))
12956 (setq file-list
(cdr file-list
)))))
12958 ;; automatically load project setup when idle after startup
12959 (when (memq 'startup vhdl-project-auto-load
)
12961 (vhdl-auto-load-project)
12962 (vhdl-run-when-idle .1 nil
'vhdl-auto-load-project
)))
12965 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12967 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12968 ;; (using `hideshow.el')
12970 (defconst vhdl-hs-start-regexp
12973 ;; generic/port clause
12974 "\\(generic\\|port\\)[ \t\n\r\f]*(\\|"
12977 ;; component instantiation
12978 "\\(\\w\\|\\s_\\)+[ \t\n\r\f]*:[ \t\n\r\f]*"
12979 "\\(\\(component\\|configuration\\|entity\\)[ \t\n\r\f]+\\)?"
12980 "\\(\\w\\|\\s_\\)+\\([ \t\n\r\f]*(\\(\\w\\|\\s_\\)+)\\)?[ \t\n\r\f]*"
12981 "\\(generic\\|port\\)[ \t\n\r\f]+map[ \t\n\r\f]*(\\|"
12983 "\\(function\\|procedure\\)\\>\\|"
12985 "\\(\\(\\w\\|\\s_\\)+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(process\\|block\\)\\>\\|"
12986 ;; configuration declaration
12989 "Regexp to match start of construct to hide.")
12991 (defun vhdl-hs-forward-sexp-func (count)
12992 "Find end of construct to hide (for hideshow). Only searches forward."
12993 (let ((pos (point)))
12994 (vhdl-prepare-search-2
12995 (beginning-of-line)
12997 ;; generic/port clause
12998 ((looking-at "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(")
12999 (goto-char (match-end 0))
13002 ;; component declaration
13003 ((looking-at "^\\s-*component\\>")
13004 (re-search-forward "^\\s-*end\\s-+component\\>" nil t
))
13005 ;; component instantiation
13008 "^\\s-*\\w+\\s-*:[ \t\n\r\f]*"
13009 "\\(\\(component\\|configuration\\|entity\\)[ \t\n\r\f]+\\)?"
13010 "\\w+\\(\\s-*(\\w+)\\)?[ \t\n\r\f]*"
13011 "\\(generic\\|port\\)\\s-+map[ \t\n\r\f]*("))
13012 (goto-char (match-end 0))
13016 (vhdl-forward-syntactic-ws)
13017 (when (looking-at "port\\s-+map[ \t\n\r\f]*(")
13018 (goto-char (match-end 0))
13021 (setq pos
(point)))
13023 ;; subprogram declaration/body
13024 ((looking-at "^\\s-*\\(function\\|procedure\\)\\s-+\\(\\w+\\|\".+\"\\)")
13025 (goto-char (match-end 0))
13026 (vhdl-forward-syntactic-ws)
13027 (when (looking-at "(")
13029 (while (and (re-search-forward "\\(;\\)\\|\\(\\<is\\>\\)" nil t
)
13030 (vhdl-in-literal)))
13032 (when (match-string 2)
13033 (re-search-forward "^\\s-*\\<begin\\>" nil t
)
13035 (vhdl-forward-sexp)))
13036 ;; block (recursive)
13037 ((looking-at "^\\s-*\\w+\\s-*:\\s-*block\\>")
13038 (goto-char (match-end 0))
13039 (while (and (re-search-forward "^\\s-*\\(\\(\\w+\\s-*:\\s-*block\\>\\)\\|\\(end\\s-+block\\>\\)\\)" nil t
)
13040 (match-beginning 2))
13041 (vhdl-hs-forward-sexp-func count
)))
13043 ((looking-at "^\\s-*\\(\\w+\\s-*:\\s-*\\)?process\\>")
13044 (re-search-forward "^\\s-*end\\s-+process\\>" nil t
))
13045 ;; configuration declaration
13046 ((looking-at "^\\s-*configuration\\>")
13048 (vhdl-forward-sexp))
13049 (t (goto-char pos
))))))
13051 (defun vhdl-hideshow-init ()
13052 "Initialize `hideshow'."
13053 (when vhdl-hideshow-menu
13054 (vhdl-hs-minor-mode 1)))
13056 (defun vhdl-hs-minor-mode (&optional arg
)
13057 "Toggle hideshow minor mode and update menu bar."
13059 (require 'hideshow
)
13060 ;; check for hideshow version 5.x
13061 (if (not (boundp 'hs-block-start-mdata-select
))
13062 (vhdl-warning-when-idle "Install included `hideshow.el' patch first (see INSTALL file)")
13063 ;; initialize hideshow
13064 (unless (assoc 'vhdl-mode hs-special-modes-alist
)
13065 (setq hs-special-modes-alist
13066 (cons (list 'vhdl-mode vhdl-hs-start-regexp nil
"--\\( \\|$\\)"
13067 'vhdl-hs-forward-sexp-func nil
)
13068 hs-special-modes-alist
)))
13069 (if (featurep 'xemacs
) (make-local-hook 'hs-minor-mode-hook
))
13070 (if vhdl-hide-all-init
13071 (add-hook 'hs-minor-mode-hook
'hs-hide-all nil t
)
13072 (remove-hook 'hs-minor-mode-hook
'hs-hide-all t
))
13073 (hs-minor-mode arg
)
13074 (force-mode-line-update))) ; hack to update menu bar
13077 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13079 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13080 ;; (using `font-lock.el')
13082 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13085 (defun vhdl-within-translate-off ()
13086 "Return point if within translate-off region, else nil."
13087 (and (save-excursion
13088 (re-search-backward
13089 "^\\s-*--\\s-*pragma\\s-*translate_\\(on\\|off\\)\\s-*\n" nil t
))
13090 (equal "off" (match-string 1))
13093 (defun vhdl-start-translate-off (limit)
13094 "Return point before translate-off pragma if before LIMIT, else nil."
13095 (when (re-search-forward
13096 "^\\s-*--\\s-*pragma\\s-*translate_off\\s-*\n" limit t
)
13097 (match-beginning 0)))
13099 (defun vhdl-end-translate-off (limit)
13100 "Return point after translate-on pragma if before LIMIT, else nil."
13101 (re-search-forward "^\\s-*--\\s-*pragma\\s-*translate_on\\s-*\n" limit t
))
13103 (defun vhdl-match-translate-off (limit)
13104 "Match a translate-off block, setting match-data and returning t, else nil."
13105 (when (< (point) limit
)
13106 (let ((start (or (vhdl-within-translate-off)
13107 (vhdl-start-translate-off limit
)))
13108 (case-fold-search t
))
13110 (let ((end (or (vhdl-end-translate-off limit
) limit
)))
13111 (set-match-data (list start end
))
13112 (goto-char end
))))))
13114 (defun vhdl-font-lock-match-item (limit)
13115 "Match, and move over, any declaration item after point. Adapted from
13116 `font-lock-match-c-style-declaration-item-and-skip-to-next'."
13117 (condition-case nil
13119 (narrow-to-region (point-min) limit
)
13121 (when (looking-at "\\s-*\\([a-zA-Z]\\w*\\)")
13123 (goto-char (match-end 1))
13124 ;; move to next item
13125 (if (looking-at "\\(\\s-*,\\)")
13126 (goto-char (match-end 1))
13127 (end-of-line) t
))))
13130 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13131 ;; Syntax definitions
13133 (defconst vhdl-font-lock-syntactic-keywords
13134 '(("\\(\'\\).\\(\'\\)" (1 (7 . ?
\')) (2 (7 . ?
\'))))
13135 "Mark single quotes as having string quote syntax in 'c' instances.")
13137 (defvar vhdl-font-lock-keywords nil
13138 "Regular expressions to highlight in VHDL Mode.")
13140 (defvar vhdl-font-lock-keywords-0
13141 ;; set in `vhdl-font-lock-init' because dependent on user options
13142 "For consideration as a value of `vhdl-font-lock-keywords'.
13143 This does highlighting of template prompts and directives (pragmas).")
13145 (defvar vhdl-font-lock-keywords-1 nil
13146 ;; set in `vhdl-font-lock-init' because dependent on user options
13147 "For consideration as a value of `vhdl-font-lock-keywords'.
13148 This does highlighting of keywords and standard identifiers.")
13150 (defconst vhdl-font-lock-keywords-2
13152 ;; highlight names of units, subprograms, and components when declared
13156 "architecture\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|"
13157 "\\(\\(impure\\|pure\\)\\s-+\\)?function\\|procedure\\|component"
13158 "\\)\\s-+\\(\\w+\\)")
13159 5 'font-lock-function-name-face
)
13161 ;; highlight entity names of architectures and configurations
13163 "^\\s-*\\(architecture\\|configuration\\)\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)"
13164 2 'font-lock-function-name-face
)
13166 ;; highlight labels of common constructs
13169 "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*\\(\\("
13170 "assert\\|block\\|case\\|exit\\|for\\|if\\|loop\\|next\\|null\\|"
13171 "postponed\\|process\\|"
13172 (when (vhdl-standard-p 'ams
) "procedural\\|")
13174 "\\)\\>\\|\\w+\\s-*\\(([^\n]*)\\|\\.\\w+\\)*\\s-*<=\\)")
13175 1 'font-lock-function-name-face
)
13177 ;; highlight label and component name of component instantiations
13180 "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]*"
13181 "\\(--[^\n]*[ \t\n\r\f]+\\)*\\(generic\\|port\\)\\s-+map\\>")
13182 '(1 font-lock-function-name-face
) '(2 font-lock-function-name-face
))
13184 ;; highlight label and instantiated unit of component instantiations
13187 "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*"
13188 "\\(component\\|configuration\\|entity\\)\\s-+"
13189 "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\(\\s-*(\\(\\w+\\))\\)?")
13190 '(1 font-lock-function-name-face
) '(3 font-lock-function-name-face
)
13191 '(5 font-lock-function-name-face nil t
)
13192 '(7 font-lock-function-name-face nil t
))
13194 ;; highlight names and labels at end of constructs
13197 "^\\s-*end\\s-+\\(\\("
13198 "architecture\\|block\\|case\\|component\\|configuration\\|entity\\|"
13199 "for\\|function\\|generate\\|if\\|loop\\|package\\(\\s-+body\\)?\\|"
13200 "procedure\\|\\(postponed\\s-+\\)?process\\|"
13201 (when (vhdl-standard-p 'ams
) "procedural\\|")
13203 "\\)\\s-+\\)?\\(\\w*\\)")
13204 5 'font-lock-function-name-face
)
13206 ;; highlight labels in exit and next statements
13209 "^\\s-*\\(\\w+\\s-*:\\s-*\\)?\\(exit\\|next\\)\\s-+\\(\\w*\\)")
13210 3 'font-lock-function-name-face
)
13212 ;; highlight entity name in attribute specifications
13215 "^\\s-*attribute\\s-+\\w+\\s-+of\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\s-*:")
13216 1 'font-lock-function-name-face
)
13218 ;; highlight labels in block and component specifications
13221 "^\\s-*for\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\>\\s-*"
13222 "\\(:[ \t\n\r\f]*\\(\\w+\\)\\|[^i \t]\\)")
13223 '(1 font-lock-function-name-face
) '(4 font-lock-function-name-face nil t
))
13225 ;; highlight names in library clauses
13226 (list "^\\s-*library\\>"
13227 '(vhdl-font-lock-match-item nil nil
(1 font-lock-function-name-face
)))
13229 ;; highlight names in use clauses
13232 "\\<use\\s-+\\(\\(entity\\|configuration\\)\\s-+\\)?"
13233 "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\((\\(\\w+\\))\\)?")
13234 '(3 font-lock-function-name-face
) '(5 font-lock-function-name-face nil t
)
13235 '(7 font-lock-function-name-face nil t
))
13237 ;; highlight attribute name in attribute declarations/specifications
13240 "^\\s-*attribute\\s-+\\(\\w+\\)")
13241 1 'vhdl-font-lock-attribute-face
)
13243 ;; highlight type/nature name in (sub)type/(sub)nature declarations
13246 "^\\s-*\\(\\(sub\\)?\\(nature\\|type\\)\\|end\\s-+\\(record\\|protected\\)\\)\\s-+\\(\\w+\\)")
13247 5 'font-lock-type-face
)
13249 ;; highlight signal/variable/constant declaration names
13250 (list "\\(:[^=]\\)"
13251 '(vhdl-font-lock-match-item
13252 (progn (goto-char (match-beginning 1))
13253 (skip-syntax-backward " ")
13254 (skip-syntax-backward "w_")
13255 (skip-syntax-backward " ")
13256 (while (= (preceding-char) ?
,)
13258 (skip-syntax-backward " ")
13259 (skip-syntax-backward "w_")
13260 (skip-syntax-backward " ")))
13261 (goto-char (match-end 1)) (1 font-lock-variable-name-face
)))
13263 ;; highlight formal parameters in component instantiations and subprogram
13266 '(vhdl-font-lock-match-item
13267 (progn (goto-char (match-beginning 1))
13268 (skip-syntax-backward " ")
13269 (while (= (preceding-char) ?\
)) (backward-sexp))
13270 (skip-syntax-backward "w_")
13271 (skip-syntax-backward " ")
13272 (when (memq (preceding-char) '(?n ?N ?|
))
13273 (goto-char (point-max))))
13274 (goto-char (match-end 1)) (1 font-lock-variable-name-face
)))
13276 ;; highlight alias/group/quantity declaration names and for-loop/-generate
13278 (list "\\<\\(alias\\|for\\|group\\|quantity\\)\\s-+\\w+\\s-+\\(across\\|in\\|is\\)\\>"
13279 '(vhdl-font-lock-match-item
13280 (progn (goto-char (match-end 1)) (match-beginning 2))
13281 nil
(1 font-lock-variable-name-face
)))
13283 "For consideration as a value of `vhdl-font-lock-keywords'.
13284 This does context sensitive highlighting of names and labels.")
13286 (defvar vhdl-font-lock-keywords-3 nil
13287 ;; set in `vhdl-font-lock-init' because dependent on user options
13288 "For consideration as a value of `vhdl-font-lock-keywords'.
13289 This does highlighting of words with special syntax.")
13291 (defvar vhdl-font-lock-keywords-4 nil
13292 ;; set in `vhdl-font-lock-init' because dependent on user options
13293 "For consideration as a value of `vhdl-font-lock-keywords'.
13294 This does highlighting of additional reserved words.")
13296 (defconst vhdl-font-lock-keywords-5
13297 ;; background highlight translate-off regions
13298 '((vhdl-match-translate-off (0 vhdl-font-lock-translate-off-face append
)))
13299 "For consideration as a value of `vhdl-font-lock-keywords'.
13300 This does background highlighting of translate-off regions.")
13302 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13303 ;; Font and color definitions
13305 (defvar vhdl-font-lock-prompt-face
'vhdl-font-lock-prompt-face
13306 "Face name to use for prompts.")
13308 (defvar vhdl-font-lock-attribute-face
'vhdl-font-lock-attribute-face
13309 "Face name to use for standardized attributes.")
13311 (defvar vhdl-font-lock-enumvalue-face
'vhdl-font-lock-enumvalue-face
13312 "Face name to use for standardized enumeration values.")
13314 (defvar vhdl-font-lock-function-face
'vhdl-font-lock-function-face
13315 "Face name to use for standardized functions and packages.")
13317 (defvar vhdl-font-lock-directive-face
'vhdl-font-lock-directive-face
13318 "Face name to use for directives.")
13320 (defvar vhdl-font-lock-reserved-words-face
'vhdl-font-lock-reserved-words-face
13321 "Face name to use for additional reserved words.")
13323 (defvar vhdl-font-lock-translate-off-face
'vhdl-font-lock-translate-off-face
13324 "Face name to use for translate-off regions.")
13326 ;; face names to use for words with special syntax.
13327 (let ((syntax-alist vhdl-special-syntax-alist
)
13329 (while syntax-alist
13330 (setq name
(vhdl-function-name
13331 "vhdl-font-lock" (nth 0 (car syntax-alist
)) "face"))
13332 (eval `(defvar ,name
',name
13333 ,(concat "Face name to use for "
13334 (nth 0 (car syntax-alist
)) ".")))
13335 (setq syntax-alist
(cdr syntax-alist
))))
13337 (defgroup vhdl-highlight-faces nil
13338 "Faces for highlighting."
13339 :group
'vhdl-highlight
)
13341 ;; add faces used from `font-lock'
13342 (custom-add-to-group
13343 'vhdl-highlight-faces
'font-lock-comment-face
'custom-face
)
13344 (custom-add-to-group
13345 'vhdl-highlight-faces
'font-lock-string-face
'custom-face
)
13346 (custom-add-to-group
13347 'vhdl-highlight-faces
'font-lock-keyword-face
'custom-face
)
13348 (custom-add-to-group
13349 'vhdl-highlight-faces
'font-lock-type-face
'custom-face
)
13350 (custom-add-to-group
13351 'vhdl-highlight-faces
'font-lock-function-name-face
'custom-face
)
13352 (custom-add-to-group
13353 'vhdl-highlight-faces
'font-lock-variable-name-face
'custom-face
)
13355 (defface vhdl-font-lock-prompt-face
13356 '((((min-colors 88) (class color
) (background light
))
13357 (:foreground
"Red1" :bold t
))
13358 (((class color
) (background light
)) (:foreground
"Red" :bold t
))
13359 (((class color
) (background dark
)) (:foreground
"Pink" :bold t
))
13360 (t (:inverse-video t
)))
13361 "Font lock mode face used to highlight prompts."
13362 :group
'vhdl-highlight-faces
)
13364 (defface vhdl-font-lock-attribute-face
13365 '((((class color
) (background light
)) (:foreground
"Orchid"))
13366 (((class color
) (background dark
)) (:foreground
"LightSteelBlue"))
13367 (t (:italic t
:bold t
)))
13368 "Font lock mode face used to highlight standardized attributes."
13369 :group
'vhdl-highlight-faces
)
13371 (defface vhdl-font-lock-enumvalue-face
13372 '((((class color
) (background light
)) (:foreground
"SaddleBrown"))
13373 (((class color
) (background dark
)) (:foreground
"BurlyWood"))
13374 (t (:italic t
:bold t
)))
13375 "Font lock mode face used to highlight standardized enumeration values."
13376 :group
'vhdl-highlight-faces
)
13378 (defface vhdl-font-lock-function-face
13379 '((((class color
) (background light
)) (:foreground
"Cyan4"))
13380 (((class color
) (background dark
)) (:foreground
"Orchid1"))
13381 (t (:italic t
:bold t
)))
13382 "Font lock mode face used to highlight standardized functions and packages."
13383 :group
'vhdl-highlight-faces
)
13385 (defface vhdl-font-lock-directive-face
13386 '((((class color
) (background light
)) (:foreground
"CadetBlue"))
13387 (((class color
) (background dark
)) (:foreground
"Aquamarine"))
13388 (t (:italic t
:bold t
)))
13389 "Font lock mode face used to highlight directives."
13390 :group
'vhdl-highlight-faces
)
13392 (defface vhdl-font-lock-reserved-words-face
13393 '((((class color
) (background light
)) (:foreground
"Orange" :bold t
))
13394 (((min-colors 88) (class color
) (background dark
))
13395 (:foreground
"Yellow1" :bold t
))
13396 (((class color
) (background dark
)) (:foreground
"Yellow" :bold t
))
13398 "Font lock mode face used to highlight additional reserved words."
13399 :group
'vhdl-highlight-faces
)
13401 (defface vhdl-font-lock-translate-off-face
13402 '((((class color
) (background light
)) (:background
"LightGray"))
13403 (((class color
) (background dark
)) (:background
"DimGray"))
13405 "Font lock mode face used to background highlight translate-off regions."
13406 :group
'vhdl-highlight-faces
)
13408 ;; font lock mode faces used to highlight words with special syntax.
13409 (let ((syntax-alist vhdl-special-syntax-alist
))
13410 (while syntax-alist
13411 (eval `(defface ,(vhdl-function-name
13412 "vhdl-font-lock" (caar syntax-alist
) "face")
13413 '((((class color
) (background light
))
13414 (:foreground
,(nth 2 (car syntax-alist
))))
13415 (((class color
) (background dark
))
13416 (:foreground
,(nth 3 (car syntax-alist
))))
13418 ,(concat "Font lock mode face used to highlight "
13419 (nth 0 (car syntax-alist
)) ".")
13420 :group
'vhdl-highlight-faces
))
13421 (setq syntax-alist
(cdr syntax-alist
))))
13423 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13424 ;; Font lock initialization
13426 (defun vhdl-font-lock-init ()
13427 "Initialize fontification."
13428 ;; highlight template prompts and directives
13429 (setq vhdl-font-lock-keywords-0
13430 (list (list (concat "\\(^\\|[ \t(.']\\)\\(<"
13431 vhdl-template-prompt-syntax
">\\)")
13432 2 'vhdl-font-lock-prompt-face t
)
13433 (list (concat "--\\s-*"
13434 vhdl-directive-keywords-regexp
"\\s-+\\(.*\\)$")
13435 2 'vhdl-font-lock-directive-face t
)
13436 ;; highlight c-preprocessor directives
13437 (list "^#[ \t]*\\(\\w+\\)\\([ \t]+\\(\\w+\\)\\)?"
13438 '(1 font-lock-builtin-face
)
13439 '(3 font-lock-variable-name-face nil t
))))
13440 ;; highlight keywords and standardized types, attributes, enumeration
13441 ;; values, and subprograms
13442 (setq vhdl-font-lock-keywords-1
13444 (list (concat "'" vhdl-attributes-regexp
)
13445 1 'vhdl-font-lock-attribute-face
)
13446 (list vhdl-types-regexp
1 'font-lock-type-face
)
13447 (list vhdl-functions-regexp
1 'vhdl-font-lock-function-face
)
13448 (list vhdl-packages-regexp
1 'vhdl-font-lock-function-face
)
13449 (list vhdl-enum-values-regexp
1 'vhdl-font-lock-enumvalue-face
)
13450 (list vhdl-constants-regexp
1 'font-lock-constant-face
)
13451 (list vhdl-keywords-regexp
1 'font-lock-keyword-face
)))
13452 ;; highlight words with special syntax.
13453 (setq vhdl-font-lock-keywords-3
13454 (let ((syntax-alist vhdl-special-syntax-alist
)
13456 (while syntax-alist
13459 (list (concat "\\(" (nth 1 (car syntax-alist
)) "\\)") 1
13460 (vhdl-function-name
13461 "vhdl-font-lock" (nth 0 (car syntax-alist
)) "face")
13462 (nth 4 (car syntax-alist
)))
13464 (setq syntax-alist
(cdr syntax-alist
)))
13466 ;; highlight additional reserved words
13467 (setq vhdl-font-lock-keywords-4
13468 (list (list vhdl-reserved-words-regexp
1
13469 'vhdl-font-lock-reserved-words-face
)))
13470 ;; highlight everything together
13471 (setq vhdl-font-lock-keywords
13473 vhdl-font-lock-keywords-0
13474 (when vhdl-highlight-keywords vhdl-font-lock-keywords-1
)
13475 (when (or vhdl-highlight-forbidden-words
13476 vhdl-highlight-verilog-keywords
) vhdl-font-lock-keywords-4
)
13477 (when vhdl-highlight-special-words vhdl-font-lock-keywords-3
)
13478 (when vhdl-highlight-names vhdl-font-lock-keywords-2
)
13479 (when vhdl-highlight-translate-off vhdl-font-lock-keywords-5
))))
13481 ;; initialize fontification for VHDL Mode
13482 (vhdl-font-lock-init)
13484 (defun vhdl-fontify-buffer ()
13485 "Re-initialize fontification and fontify buffer."
13487 (setq font-lock-defaults
13488 `(vhdl-font-lock-keywords
13489 nil
,(not vhdl-highlight-case-sensitive
) ((?\_ .
"w"))
13490 beginning-of-line
))
13491 (when (fboundp 'font-lock-unset-defaults
)
13492 (font-lock-unset-defaults)) ; not implemented in XEmacs
13493 (font-lock-set-defaults)
13494 (font-lock-mode nil
)
13495 (font-lock-mode t
))
13497 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13498 ;; Initialization for PostScript printing
13500 (defun vhdl-ps-print-settings ()
13501 "Initialize custom face and page settings for PostScript printing."
13502 ;; define custom face settings
13503 (unless (or (not vhdl-print-customize-faces
)
13505 (set (make-local-variable 'ps-bold-faces
)
13506 '(font-lock-keyword-face
13507 font-lock-type-face
13508 vhdl-font-lock-attribute-face
13509 vhdl-font-lock-enumvalue-face
13510 vhdl-font-lock-directive-face
))
13511 (set (make-local-variable 'ps-italic-faces
)
13512 '(font-lock-comment-face
13513 font-lock-function-name-face
13514 font-lock-type-face
13515 vhdl-font-lock-attribute-face
13516 vhdl-font-lock-enumvalue-face
13517 vhdl-font-lock-directive-face
))
13518 (set (make-local-variable 'ps-underlined-faces
)
13519 '(font-lock-string-face))
13520 (setq ps-always-build-face-reference t
))
13521 ;; define page settings, so that a line containing 79 characters (default)
13522 ;; fits into one column
13523 (when vhdl-print-two-column
13524 (set (make-local-variable 'ps-landscape-mode
) t
)
13525 (set (make-local-variable 'ps-number-of-columns
) 2)
13526 (set (make-local-variable 'ps-font-size
) 7.0)
13527 (set (make-local-variable 'ps-header-title-font-size
) 10.0)
13528 (set (make-local-variable 'ps-header-font-size
) 9.0)
13529 (set (make-local-variable 'ps-header-offset
) 12.0)
13530 (when (eq ps-paper-type
'letter
)
13531 (set (make-local-variable 'ps-inter-column
) 40.0)
13532 (set (make-local-variable 'ps-left-margin
) 40.0)
13533 (set (make-local-variable 'ps-right-margin
) 40.0))))
13535 (defun vhdl-ps-print-init ()
13536 "Initialize PostScript printing."
13537 (if (featurep 'xemacs
)
13538 (when (boundp 'ps-print-color-p
)
13539 (vhdl-ps-print-settings))
13540 (if (featurep 'xemacs
) (make-local-hook 'ps-print-hook
))
13541 (add-hook 'ps-print-hook
'vhdl-ps-print-settings nil t
)))
13544 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13545 ;;; Hierarchy browser (using `speedbar.el')
13546 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13547 ;; Allows displaying the hierarchy of all VHDL design units contained in a
13548 ;; directory by using the speedbar.
13550 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13553 (defvar vhdl-entity-alist nil
13554 "Cache with entities and corresponding architectures for each
13555 project/directory.")
13556 ;; structure: (parenthesized expression means list of such entries)
13558 ;; (ent-key ent-name ent-file ent-line
13559 ;; (arch-key arch-name arch-file arch-line
13560 ;; (inst-key inst-name inst-file inst-line inst-comp-name inst-ent-key
13561 ;; inst-arch-key inst-conf-key inst-lib-key inst-path)
13562 ;; (lib-name pack-key))
13563 ;; mra-key (lib-name pack-key))
13565 (defvar vhdl-config-alist nil
13566 "Cache with configurations for each project/directory.")
13567 ;; structure: (parenthesized expression means list of such entries)
13569 ;; (conf-key conf-name conf-file conf-line ent-key arch-key
13570 ;; (inst-key inst-comp-name inst-ent-key inst-arch-key
13571 ;; inst-conf-key inst-lib-key)
13572 ;; (lib-name pack-key)))
13574 (defvar vhdl-package-alist nil
13575 "Cache with packages for each project/directory.")
13576 ;; structure: (parenthesized expression means list of such entries)
13578 ;; (pack-key pack-name pack-file pack-line
13579 ;; (comp-key comp-name comp-file comp-line)
13580 ;; (func-key func-name func-file func-line)
13581 ;; (lib-name pack-key)
13582 ;; pack-body-file pack-body-line
13583 ;; (func-key func-name func-body-file func-body-line)
13584 ;; (lib-name pack-key)))
13586 (defvar vhdl-ent-inst-alist nil
13587 "Cache with instantiated entities for each project/directory.")
13588 ;; structure: (parenthesized expression means list of such entries)
13589 ;; (cache-key (inst-ent-key))
13591 (defvar vhdl-file-alist nil
13592 "Cache with design units in each file for each project/directory.")
13593 ;; structure: (parenthesized expression means list of such entries)
13595 ;; (file-name (ent-list) (arch-list) (arch-ent-list) (conf-list)
13596 ;; (pack-list) (pack-body-list) (inst-list) (inst-ent-list))
13598 (defvar vhdl-directory-alist nil
13599 "Cache with source directories for each project.")
13600 ;; structure: (parenthesized expression means list of such entries)
13601 ;; (cache-key (directory))
13603 (defvar vhdl-speedbar-shown-unit-alist nil
13604 "Alist of design units simultaneously open in the current speedbar for each
13605 directory and project.")
13607 (defvar vhdl-speedbar-shown-project-list nil
13608 "List of projects simultaneously open in the current speedbar.")
13610 (defvar vhdl-updated-project-list nil
13611 "List of projects and directories with updated files.")
13613 (defvar vhdl-modified-file-list nil
13614 "List of modified files to be rescanned for hierarchy updating.")
13616 (defvar vhdl-speedbar-hierarchy-depth
0
13617 "Depth of instantiation hierarchy to display.")
13619 (defvar vhdl-speedbar-show-projects nil
13620 "Non-nil means project hierarchy is displayed in speedbar, directory
13621 hierarchy otherwise.")
13623 (defun vhdl-get-end-of-unit ()
13624 "Return position of end of current unit."
13625 (let ((pos (point)))
13627 (while (and (re-search-forward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil
1)
13629 (goto-char (match-beginning 0))
13630 (vhdl-backward-syntactic-ws)
13631 (and (/= (preceding-char) ?\
;) (not (bobp))))))
13632 (re-search-backward "^[ \t]*end\\>" pos
1)
13635 (defun vhdl-match-string-downcase (num &optional string
)
13636 "Like `match-string-no-properties' with down-casing."
13637 (let ((match (match-string-no-properties num string
)))
13638 (and match
(downcase match
))))
13641 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13644 (defun vhdl-scan-context-clause ()
13645 "Scan the context clause that precedes a design unit."
13648 (when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil t
)
13649 (while (and (re-search-backward "^[ \t]*\\(end\\|use\\)\\>" nil t
)
13650 (equal "USE" (upcase (match-string 1))))
13651 (when (looking-at "^[ \t]*use[ \t\n\r\f]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+")
13652 (push (cons (match-string-no-properties 1)
13653 (vhdl-match-string-downcase 2))
13657 (defun vhdl-scan-directory-contents (name &optional project update num-string
13659 "Scan contents of VHDL files in directory or file pattern NAME."
13660 (string-match "\\(.*[/\\]\\)\\(.*\\)" name
)
13661 (let* ((dir-name (match-string 1 name
))
13662 (file-pattern (match-string 2 name
))
13663 (is-directory (= 0 (length file-pattern
)))
13668 (vhdl-get-source-files t dir-name
)
13669 (vhdl-directory-files
13670 dir-name t
(wildcard-to-regexp file-pattern
)))))
13671 (key (or project dir-name
))
13672 (file-exclude-regexp
13673 (or (nth 3 (aget vhdl-project-alist project
)) ""))
13674 (limit-design-file-size (nth 0 vhdl-speedbar-scan-limit
))
13675 (limit-hier-file-size (nth 0 (nth 1 vhdl-speedbar-scan-limit
)))
13676 (limit-hier-inst-no (nth 1 (nth 1 vhdl-speedbar-scan-limit
)))
13677 ent-alist conf-alist pack-alist ent-inst-list file-alist
13678 tmp-list tmp-entry no-files files-exist big-files
)
13679 (when (or project update
)
13680 (setq ent-alist
(aget vhdl-entity-alist key t
)
13681 conf-alist
(aget vhdl-config-alist key t
)
13682 pack-alist
(aget vhdl-package-alist key t
)
13683 ent-inst-list
(car (aget vhdl-ent-inst-alist key t
))
13684 file-alist
(aget vhdl-file-alist key t
)))
13685 (when (and (not is-directory
) (null file-list
))
13686 (message "No such file: \"%s\"" name
))
13687 (setq files-exist file-list
)
13689 (setq no-files
(length file-list
))
13690 (message "Scanning %s %s\"%s\"..."
13691 (if is-directory
"directory" "files") (or num-string
"") name
)
13693 (unless (equal file-exclude-regexp
"")
13694 (let ((case-fold-search nil
)
13697 (unless (string-match file-exclude-regexp
(car file-list
))
13698 (push (car file-list
) file-tmp-list
))
13699 (setq file-list
(cdr file-list
)))
13700 (setq file-list
(nreverse file-tmp-list
))))
13701 ;; do for all files
13703 (unless noninteractive
13704 (message "Scanning %s %s\"%s\"... (%2d%s)"
13705 (if is-directory
"directory" "files")
13706 (or num-string
"") name
13707 (/ (* 100 (- no-files
(length file-list
))) no-files
) "%"))
13708 (let ((file-name (abbreviate-file-name (car file-list
)))
13709 ent-list arch-list arch-ent-list conf-list
13710 pack-list pack-body-list inst-list inst-ent-list
)
13714 (vhdl-prepare-search-2
13716 ;; scan for design units
13717 (if (and limit-design-file-size
13718 (< limit-design-file-size
(buffer-size)))
13719 (progn (message "WARNING: Scan limit (design units: file size) reached in file:\n \"%s\"" file-name
)
13720 (setq big-files t
))
13721 ;; scan for entities
13722 (goto-char (point-min))
13723 (while (re-search-forward "^[ \t]*entity[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t
)
13724 (let* ((ent-name (match-string-no-properties 1))
13725 (ent-key (downcase ent-name
))
13726 (ent-entry (aget ent-alist ent-key t
))
13727 (lib-alist (vhdl-scan-context-clause)))
13728 (if (nth 1 ent-entry
)
13729 (vhdl-warning-when-idle
13730 "Entity declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)"
13731 ent-name
(nth 1 ent-entry
) (nth 2 ent-entry
)
13732 file-name
(vhdl-current-line))
13733 (push ent-key ent-list
)
13734 (aput 'ent-alist ent-key
13735 (list ent-name file-name
(vhdl-current-line)
13736 (nth 3 ent-entry
) (nth 4 ent-entry
)
13738 ;; scan for architectures
13739 (goto-char (point-min))
13740 (while (re-search-forward "^[ \t]*architecture[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t
)
13741 (let* ((arch-name (match-string-no-properties 1))
13742 (arch-key (downcase arch-name
))
13743 (ent-name (match-string-no-properties 2))
13744 (ent-key (downcase ent-name
))
13745 (ent-entry (aget ent-alist ent-key t
))
13746 (arch-alist (nth 3 ent-entry
))
13747 (arch-entry (aget arch-alist arch-key t
))
13748 (lib-arch-alist (vhdl-scan-context-clause)))
13750 (vhdl-warning-when-idle
13751 "Architecture declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)"
13752 arch-name ent-name
(nth 1 arch-entry
)
13753 (nth 2 arch-entry
) file-name
(vhdl-current-line))
13754 (setq arch-list
(cons arch-key arch-list
)
13755 arch-ent-list
(cons ent-key arch-ent-list
))
13756 (aput 'arch-alist arch-key
13757 (list arch-name file-name
(vhdl-current-line) nil
13759 (aput 'ent-alist ent-key
13760 (list (or (nth 0 ent-entry
) ent-name
)
13761 (nth 1 ent-entry
) (nth 2 ent-entry
)
13762 (vhdl-sort-alist arch-alist
)
13763 arch-key
(nth 5 ent-entry
))))))
13764 ;; scan for configurations
13765 (goto-char (point-min))
13766 (while (re-search-forward "^[ \t]*configuration[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t
)
13767 (let* ((conf-name (match-string-no-properties 1))
13768 (conf-key (downcase conf-name
))
13769 (conf-entry (aget conf-alist conf-key t
))
13770 (ent-name (match-string-no-properties 2))
13771 (ent-key (downcase ent-name
))
13772 (lib-alist (vhdl-scan-context-clause))
13773 (conf-line (vhdl-current-line))
13774 (end-of-unit (vhdl-get-end-of-unit))
13775 arch-key comp-conf-list inst-key-list
13776 inst-comp-key inst-ent-key inst-arch-key
13777 inst-conf-key inst-lib-key
)
13778 (when (vhdl-re-search-forward "\\<for[ \t\n\r\f]+\\(\\w+\\)")
13779 (setq arch-key
(vhdl-match-string-downcase 1)))
13781 (vhdl-warning-when-idle
13782 "Configuration declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)"
13783 conf-name ent-name
(nth 1 conf-entry
)
13784 (nth 2 conf-entry
) file-name conf-line
)
13785 (push conf-key conf-list
)
13786 ;; scan for subconfigurations and subentities
13787 (while (re-search-forward "^[ \t]*for[ \t\n\r\f]+\\(\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]+" end-of-unit t
)
13788 (setq inst-comp-key
(vhdl-match-string-downcase 3)
13789 inst-key-list
(split-string
13790 (vhdl-match-string-downcase 1)
13791 "[ \t\n\r\f]*,[ \t\n\r\f]*"))
13792 (vhdl-forward-syntactic-ws)
13793 (when (looking-at "use[ \t\n\r\f]+\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\w+\\)\\.\\(\\w+\\)[ \t\n\r\f]*\\((\\(\\w+\\))\\)?")
13795 inst-lib-key
(vhdl-match-string-downcase 3)
13796 inst-ent-key
(and (match-string 2)
13797 (vhdl-match-string-downcase 4))
13798 inst-arch-key
(and (match-string 2)
13799 (vhdl-match-string-downcase 6))
13800 inst-conf-key
(and (not (match-string 2))
13801 (vhdl-match-string-downcase 4)))
13802 (while inst-key-list
13803 (setq comp-conf-list
13804 (cons (list (car inst-key-list
)
13805 inst-comp-key inst-ent-key
13806 inst-arch-key inst-conf-key
13809 (setq inst-key-list
(cdr inst-key-list
)))))
13810 (aput 'conf-alist conf-key
13811 (list conf-name file-name conf-line ent-key
13812 arch-key comp-conf-list lib-alist
)))))
13813 ;; scan for packages
13814 (goto-char (point-min))
13815 (while (re-search-forward "^[ \t]*package[ \t\n\r\f]+\\(body[ \t\n\r\f]+\\)?\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t
)
13816 (let* ((pack-name (match-string-no-properties 2))
13817 (pack-key (downcase pack-name
))
13818 (is-body (match-string-no-properties 1))
13819 (pack-entry (aget pack-alist pack-key t
))
13820 (pack-line (vhdl-current-line))
13821 (end-of-unit (vhdl-get-end-of-unit))
13822 comp-name func-name comp-alist func-alist lib-alist
)
13823 (if (if is-body
(nth 6 pack-entry
) (nth 1 pack-entry
))
13824 (vhdl-warning-when-idle
13825 "Package%s declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)"
13826 (if is-body
" body" "") pack-name
13827 (if is-body
(nth 6 pack-entry
) (nth 1 pack-entry
))
13828 (if is-body
(nth 7 pack-entry
) (nth 2 pack-entry
))
13829 file-name
(vhdl-current-line))
13830 ;; scan for context clauses
13831 (setq lib-alist
(vhdl-scan-context-clause))
13832 ;; scan for component and subprogram declarations/bodies
13833 (while (re-search-forward "^[ \t]*\\(component\\|function\\|procedure\\)[ \t\n\r\f]+\\(\\w+\\|\".*\"\\)" end-of-unit t
)
13834 (if (equal (upcase (match-string 1)) "COMPONENT")
13835 (setq comp-name
(match-string-no-properties 2)
13837 (cons (list (downcase comp-name
) comp-name
13838 file-name
(vhdl-current-line))
13840 (setq func-name
(match-string-no-properties 2)
13842 (cons (list (downcase func-name
) func-name
13843 file-name
(vhdl-current-line))
13845 (setq func-alist
(nreverse func-alist
))
13846 (setq comp-alist
(nreverse comp-alist
))
13848 (push pack-key pack-body-list
)
13849 (push pack-key pack-list
))
13851 'pack-alist pack-key
13853 (list (or (nth 0 pack-entry
) pack-name
)
13854 (nth 1 pack-entry
) (nth 2 pack-entry
)
13855 (nth 3 pack-entry
) (nth 4 pack-entry
)
13857 file-name pack-line func-alist lib-alist
)
13858 (list pack-name file-name pack-line
13859 comp-alist func-alist lib-alist
13860 (nth 6 pack-entry
) (nth 7 pack-entry
)
13861 (nth 8 pack-entry
) (nth 9 pack-entry
))))))))
13862 ;; scan for hierarchy
13863 (if (and limit-hier-file-size
13864 (< limit-hier-file-size
(buffer-size)))
13865 (progn (message "WARNING: Scan limit (hierarchy: file size) reached in file:\n \"%s\"" file-name
)
13866 (setq big-files t
))
13867 ;; scan for architectures
13868 (goto-char (point-min))
13869 (while (re-search-forward "^[ \t]*architecture[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t
)
13870 (let* ((ent-name (match-string-no-properties 2))
13871 (ent-key (downcase ent-name
))
13872 (arch-name (match-string-no-properties 1))
13873 (arch-key (downcase arch-name
))
13874 (ent-entry (aget ent-alist ent-key t
))
13875 (arch-alist (nth 3 ent-entry
))
13876 (arch-entry (aget arch-alist arch-key t
))
13877 (beg-of-unit (point))
13878 (end-of-unit (vhdl-get-end-of-unit))
13880 inst-alist inst-path
)
13881 ;; scan for contained instantiations
13882 (while (and (re-search-forward
13883 (concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\("
13884 "\\(\\w+\\)[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(generic\\|port\\)[ \t\n\r\f]+map\\>\\|"
13885 "component[ \t\n\r\f]+\\(\\w+\\)\\|"
13886 "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?\\|"
13887 "\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|"
13888 "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") end-of-unit t
)
13889 (or (not limit-hier-inst-no
)
13890 (<= (if (or (match-string 14)
13893 (setq inst-no
(1+ inst-no
)))
13894 limit-hier-inst-no
)))
13896 ;; block/generate beginning found
13899 (cons (match-string-no-properties 1) inst-path
)))
13900 ;; block/generate end found
13902 (setq inst-path
(cdr inst-path
)))
13903 ;; instantiation found
13905 (let* ((inst-name (match-string-no-properties 1))
13906 (inst-key (downcase inst-name
))
13908 (or (match-string-no-properties 3)
13909 (match-string-no-properties 6)))
13911 (or (and (match-string 8)
13912 (vhdl-match-string-downcase 11))
13913 (and inst-comp-name
13914 (downcase inst-comp-name
))))
13915 (inst-arch-key (vhdl-match-string-downcase 13))
13917 (and (not (match-string 8))
13918 (vhdl-match-string-downcase 11)))
13919 (inst-lib-key (vhdl-match-string-downcase 10)))
13920 (goto-char (match-end 1))
13921 (setq inst-list
(cons inst-key inst-list
)
13923 (cons inst-ent-key inst-ent-list
))
13927 (list (list inst-key inst-name file-name
13928 (vhdl-current-line) inst-comp-name
13929 inst-ent-key inst-arch-key
13930 inst-conf-key inst-lib-key
13931 (reverse inst-path
)))))))))
13932 ;; scan for contained configuration specifications
13933 (goto-char beg-of-unit
)
13934 (while (re-search-forward
13935 (concat "^[ \t]*for[ \t\n\r\f]+\\(\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*"
13936 "use[ \t\n\r\f]+\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?") end-of-unit t
)
13937 (let* ((inst-comp-name (match-string-no-properties 3))
13939 (and (match-string 6)
13940 (vhdl-match-string-downcase 9)))
13941 (inst-arch-key (vhdl-match-string-downcase 11))
13943 (and (not (match-string 6))
13944 (vhdl-match-string-downcase 9)))
13945 (inst-lib-key (vhdl-match-string-downcase 8))
13947 (split-string (vhdl-match-string-downcase 1)
13948 "[ \t\n\r\f]*,[ \t\n\r\f]*"))
13949 (tmp-inst-alist inst-alist
)
13951 (while tmp-inst-alist
13952 (when (and (or (equal "all" (car inst-key-list
))
13953 (member (nth 0 (car tmp-inst-alist
))
13957 (or (nth 4 (car tmp-inst-alist
)) ""))
13958 (downcase inst-comp-name
)))
13959 (setq inst-entry
(car tmp-inst-alist
))
13960 (setq inst-ent-list
13961 (cons (or inst-ent-key
(nth 5 inst-entry
))
13963 (nth 5 inst-entry
) inst-ent-list
)))
13965 (list (nth 0 inst-entry
) (nth 1 inst-entry
)
13966 (nth 2 inst-entry
) (nth 3 inst-entry
)
13968 (or inst-ent-key
(nth 5 inst-entry
))
13969 (or inst-arch-key
(nth 6 inst-entry
))
13970 inst-conf-key inst-lib-key
))
13971 (setcar tmp-inst-alist inst-entry
))
13972 (setq tmp-inst-alist
(cdr tmp-inst-alist
)))))
13974 (aput 'arch-alist arch-key
13975 (list (nth 0 arch-entry
) (nth 1 arch-entry
)
13976 (nth 2 arch-entry
) inst-alist
13977 (nth 4 arch-entry
)))
13978 (aput 'ent-alist ent-key
13979 (list (nth 0 ent-entry
) (nth 1 ent-entry
)
13980 (nth 2 ent-entry
) (vhdl-sort-alist arch-alist
)
13981 (nth 4 ent-entry
) (nth 5 ent-entry
)))
13982 (when (and limit-hier-inst-no
13983 (> inst-no limit-hier-inst-no
))
13984 (message "WARNING: Scan limit (hierarchy: instances per architecture) reached in file:\n \"%s\"" file-name
)
13985 (setq big-files t
))
13986 (goto-char end-of-unit
))))
13987 ;; remember design units for this file
13988 (aput 'file-alist file-name
13989 (list ent-list arch-list arch-ent-list conf-list
13990 pack-list pack-body-list inst-list inst-ent-list
))
13991 (setq ent-inst-list
(append inst-ent-list ent-inst-list
))))))
13992 (setq file-list
(cdr file-list
))))
13993 (when (or (and (not project
) files-exist
)
13994 (and project
(not non-final
)))
13995 ;; consistency checks:
13996 ;; check whether each architecture has a corresponding entity
13997 (setq tmp-list ent-alist
)
13999 (when (null (nth 2 (car tmp-list
)))
14000 (setq tmp-entry
(car (nth 4 (car tmp-list
))))
14001 (vhdl-warning-when-idle
14002 "Architecture of non-existing entity: \"%s\" of \"%s\"\n in \"%s\" (line %d)"
14003 (nth 1 tmp-entry
) (nth 1 (car tmp-list
)) (nth 2 tmp-entry
)
14004 (nth 3 tmp-entry
)))
14005 (setq tmp-list
(cdr tmp-list
)))
14006 ;; check whether configuration has a corresponding entity/architecture
14007 (setq tmp-list conf-alist
)
14009 (if (setq tmp-entry
(aget ent-alist
(nth 4 (car tmp-list
)) t
))
14010 (unless (aget (nth 3 tmp-entry
) (nth 5 (car tmp-list
)) t
)
14011 (setq tmp-entry
(car tmp-list
))
14012 (vhdl-warning-when-idle
14013 "Configuration of non-existing architecture: \"%s\" of \"%s(%s)\"\n in \"%s\" (line %d)"
14014 (nth 1 tmp-entry
) (nth 4 tmp-entry
) (nth 5 tmp-entry
)
14015 (nth 2 tmp-entry
) (nth 3 tmp-entry
)))
14016 (setq tmp-entry
(car tmp-list
))
14017 (vhdl-warning-when-idle
14018 "Configuration of non-existing entity: \"%s\" of \"%s\"\n in \"%s\" (line %d)"
14019 (nth 1 tmp-entry
) (nth 4 tmp-entry
)
14020 (nth 2 tmp-entry
) (nth 3 tmp-entry
)))
14021 (setq tmp-list
(cdr tmp-list
)))
14022 ;; check whether each package body has a package declaration
14023 (setq tmp-list pack-alist
)
14025 (when (null (nth 2 (car tmp-list
)))
14026 (setq tmp-entry
(car tmp-list
))
14027 (vhdl-warning-when-idle
14028 "Package body of non-existing package: \"%s\"\n in \"%s\" (line %d)"
14029 (nth 1 tmp-entry
) (nth 7 tmp-entry
) (nth 8 tmp-entry
)))
14030 (setq tmp-list
(cdr tmp-list
)))
14032 (setq ent-alist
(vhdl-sort-alist ent-alist
))
14033 (setq conf-alist
(vhdl-sort-alist conf-alist
))
14034 (setq pack-alist
(vhdl-sort-alist pack-alist
))
14035 ;; remember updated directory/project
14036 (add-to-list 'vhdl-updated-project-list
(or project dir-name
)))
14037 ;; clear directory alists
14039 (adelete 'vhdl-entity-alist key
)
14040 (adelete 'vhdl-config-alist key
)
14041 (adelete 'vhdl-package-alist key
)
14042 (adelete 'vhdl-ent-inst-alist key
)
14043 (adelete 'vhdl-file-alist key
))
14044 ;; put directory contents into cache
14045 (aput 'vhdl-entity-alist key ent-alist
)
14046 (aput 'vhdl-config-alist key conf-alist
)
14047 (aput 'vhdl-package-alist key pack-alist
)
14048 (aput 'vhdl-ent-inst-alist key
(list ent-inst-list
))
14049 (aput 'vhdl-file-alist key file-alist
)
14051 (message "Scanning %s %s\"%s\"...done"
14052 (if is-directory
"directory" "files") (or num-string
"") name
)
14053 (unless project
(message "Scanning directory...done"))
14055 (vhdl-warning-when-idle "Scanning is incomplete.\n --> see user option `vhdl-speedbar-scan-limit'"))
14056 ;; save cache when scanned non-interactively
14057 (when (or (not project
) (not non-final
))
14058 (when (and noninteractive vhdl-speedbar-save-cache
)
14059 (vhdl-save-cache key
)))
14062 (defun vhdl-scan-project-contents (project)
14063 "Scan the contents of all VHDL files found in the directories and files
14065 (let ((dir-list (or (nth 2 (aget vhdl-project-alist project
)) '("")))
14066 (default-dir (vhdl-resolve-env-variable
14067 (nth 1 (aget vhdl-project-alist project
))))
14068 (file-exclude-regexp
14069 (or (nth 3 (aget vhdl-project-alist project
)) ""))
14070 dir-list-tmp dir dir-name num-dir act-dir recursive
)
14071 ;; clear project alists
14072 (adelete 'vhdl-entity-alist project
)
14073 (adelete 'vhdl-config-alist project
)
14074 (adelete 'vhdl-package-alist project
)
14075 (adelete 'vhdl-ent-inst-alist project
)
14076 (adelete 'vhdl-file-alist project
)
14077 ;; expand directory names by default-directory
14078 (message "Collecting source files...")
14080 (setq dir
(vhdl-resolve-env-variable (car dir-list
)))
14081 (string-match "\\(\\(-r \\)?\\)\\(.*\\)" dir
)
14082 (setq recursive
(match-string 1 dir
)
14083 dir-name
(match-string 3 dir
))
14085 (cons (concat recursive
14086 (if (file-name-absolute-p dir-name
) "" default-dir
)
14089 (setq dir-list
(cdr dir-list
)))
14090 ;; resolve path wildcards
14091 (setq dir-list-tmp
(vhdl-resolve-paths dir-list-tmp
))
14092 ;; expand directories
14093 (while dir-list-tmp
14094 (setq dir
(car dir-list-tmp
))
14095 ;; get subdirectories
14096 (if (string-match "-r \\(.*[/\\]\\)" dir
)
14097 (setq dir-list
(append dir-list
(vhdl-get-subdirs
14098 (match-string 1 dir
))))
14099 (setq dir-list
(append dir-list
(list dir
))))
14100 (setq dir-list-tmp
(cdr dir-list-tmp
)))
14102 (unless (equal file-exclude-regexp
"")
14103 (let ((case-fold-search nil
))
14105 (unless (string-match file-exclude-regexp
(car dir-list
))
14106 (push (car dir-list
) dir-list-tmp
))
14107 (setq dir-list
(cdr dir-list
)))
14108 (setq dir-list
(nreverse dir-list-tmp
))))
14109 (message "Collecting source files...done")
14110 ;; scan for design units for each directory in DIR-LIST
14111 (setq dir-list-tmp nil
14112 num-dir
(length dir-list
)
14115 (setq dir-name
(abbreviate-file-name
14116 (expand-file-name (car dir-list
))))
14117 (vhdl-scan-directory-contents dir-name project nil
14118 (format "(%s/%s) " act-dir num-dir
)
14120 (add-to-list 'dir-list-tmp
(file-name-directory dir-name
))
14121 (setq dir-list
(cdr dir-list
)
14122 act-dir
(1+ act-dir
)))
14123 (aput 'vhdl-directory-alist project
(list (nreverse dir-list-tmp
)))
14124 (message "Scanning project \"%s\"...done" project
)))
14126 (defun vhdl-update-file-contents (file-name)
14127 "Update hierarchy information by contents of current buffer."
14128 (setq file-name
(abbreviate-file-name file-name
))
14129 (let* ((dir-name (file-name-directory file-name
))
14130 (directory-alist vhdl-directory-alist
)
14132 (while directory-alist
14133 (when (member dir-name
(nth 1 (car directory-alist
)))
14134 (let* ((vhdl-project (nth 0 (car directory-alist
)))
14135 (project (vhdl-project-p))
14136 (ent-alist (aget vhdl-entity-alist
(or project dir-name
) t
))
14137 (conf-alist (aget vhdl-config-alist
(or project dir-name
) t
))
14138 (pack-alist (aget vhdl-package-alist
(or project dir-name
) t
))
14139 (ent-inst-list (car (aget vhdl-ent-inst-alist
14140 (or project dir-name
) t
)))
14141 (file-alist (aget vhdl-file-alist
(or project dir-name
) t
))
14142 (file-entry (aget file-alist file-name t
))
14143 (ent-list (nth 0 file-entry
))
14144 (arch-list (nth 1 file-entry
))
14145 (arch-ent-list (nth 2 file-entry
))
14146 (conf-list (nth 3 file-entry
))
14147 (pack-list (nth 4 file-entry
))
14148 (pack-body-list (nth 5 file-entry
))
14149 (inst-ent-list (nth 7 file-entry
))
14150 (cache-key (or project dir-name
))
14151 arch-alist key ent-key entry
)
14152 ;; delete design units previously contained in this file:
14155 (setq key
(car ent-list
)
14156 entry
(aget ent-alist key t
))
14157 (when (equal file-name
(nth 1 entry
))
14159 (aput 'ent-alist key
14160 (list (nth 0 entry
) nil nil
(nth 3 entry
) nil
))
14161 (adelete 'ent-alist key
)))
14162 (setq ent-list
(cdr ent-list
)))
14165 (setq key
(car arch-list
)
14166 ent-key
(car arch-ent-list
)
14167 entry
(aget ent-alist ent-key t
)
14168 arch-alist
(nth 3 entry
))
14169 (when (equal file-name
(nth 1 (aget arch-alist key t
)))
14170 (adelete 'arch-alist key
)
14171 (if (or (nth 1 entry
) arch-alist
)
14172 (aput 'ent-alist ent-key
14173 (list (nth 0 entry
) (nth 1 entry
) (nth 2 entry
)
14174 arch-alist
(nth 4 entry
) (nth 5 entry
)))
14175 (adelete 'ent-alist ent-key
)))
14176 (setq arch-list
(cdr arch-list
)
14177 arch-ent-list
(cdr arch-ent-list
)))
14180 (setq key
(car conf-list
))
14181 (when (equal file-name
(nth 1 (aget conf-alist key t
)))
14182 (adelete 'conf-alist key
))
14183 (setq conf-list
(cdr conf-list
)))
14184 ;; package declarations
14186 (setq key
(car pack-list
)
14187 entry
(aget pack-alist key t
))
14188 (when (equal file-name
(nth 1 entry
))
14190 (aput 'pack-alist key
14191 (list (nth 0 entry
) nil nil nil nil nil
14192 (nth 6 entry
) (nth 7 entry
) (nth 8 entry
)
14194 (adelete 'pack-alist key
)))
14195 (setq pack-list
(cdr pack-list
)))
14197 (while pack-body-list
14198 (setq key
(car pack-body-list
)
14199 entry
(aget pack-alist key t
))
14200 (when (equal file-name
(nth 6 entry
))
14202 (aput 'pack-alist key
14203 (list (nth 0 entry
) (nth 1 entry
) (nth 2 entry
)
14204 (nth 3 entry
) (nth 4 entry
) (nth 5 entry
)
14206 (adelete 'pack-alist key
)))
14207 (setq pack-body-list
(cdr pack-body-list
)))
14208 ;; instantiated entities
14209 (while inst-ent-list
14210 (setq ent-inst-list
14211 (vhdl-delete (car inst-ent-list
) ent-inst-list
))
14212 (setq inst-ent-list
(cdr inst-ent-list
)))
14214 (vhdl-aput 'vhdl-entity-alist cache-key ent-alist
)
14215 (vhdl-aput 'vhdl-config-alist cache-key conf-alist
)
14216 (vhdl-aput 'vhdl-package-alist cache-key pack-alist
)
14217 (vhdl-aput 'vhdl-ent-inst-alist cache-key
(list ent-inst-list
))
14219 (vhdl-scan-directory-contents file-name project t
)
14220 (when (or (and vhdl-speedbar-show-projects project
)
14221 (and (not vhdl-speedbar-show-projects
) (not project
)))
14222 (vhdl-speedbar-refresh project
))
14224 (setq directory-alist
(cdr directory-alist
)))
14227 (defun vhdl-update-hierarchy ()
14228 "Update directory and hierarchy information in speedbar."
14229 (let ((file-list (reverse vhdl-modified-file-list
))
14231 (when (and vhdl-speedbar-update-on-saving file-list
)
14234 (or (vhdl-update-file-contents (car file-list
))
14236 (setq file-list
(cdr file-list
)))
14237 (setq vhdl-modified-file-list nil
)
14238 (vhdl-speedbar-update-current-unit)
14239 (when updated
(message "Updating hierarchy...done")))))
14241 ;; structure (parenthesized expression means list of such entries)
14242 ;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker
14243 ;; comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker
14244 ;; comp-lib-name level)
14245 (defun vhdl-get-hierarchy (ent-alist conf-alist ent-key arch-key conf-key
14246 conf-inst-alist level indent
14247 &optional include-top ent-hier
)
14248 "Get instantiation hierarchy beginning in architecture ARCH-KEY of
14250 (let* ((ent-entry (aget ent-alist ent-key t
))
14251 (arch-entry (if arch-key
(aget (nth 3 ent-entry
) arch-key t
)
14252 (cdar (last (nth 3 ent-entry
)))))
14253 (inst-alist (nth 3 arch-entry
))
14254 inst-entry inst-ent-entry inst-arch-entry inst-conf-entry comp-entry
14255 hier-list subcomp-list tmp-list inst-key inst-comp-name
14256 inst-ent-key inst-arch-key inst-conf-key inst-lib-key
)
14257 (when (= level
0) (message "Extract design hierarchy..."))
14259 (setq level
(1+ level
)))
14260 (when (member ent-key ent-hier
)
14261 (error "ERROR: Instantiation loop detected, component instantiates itself: \"%s\"" ent-key
))
14262 ;; process all instances
14264 (setq inst-entry
(car inst-alist
)
14265 inst-key
(nth 0 inst-entry
)
14266 inst-comp-name
(nth 4 inst-entry
)
14267 inst-conf-key
(nth 7 inst-entry
))
14268 ;; search entry in configuration's instantiations list
14269 (setq tmp-list conf-inst-alist
)
14270 (while (and tmp-list
14271 (not (and (member (nth 0 (car tmp-list
))
14272 (list "all" inst-key
))
14273 (equal (nth 1 (car tmp-list
))
14274 (downcase (or inst-comp-name
""))))))
14275 (setq tmp-list
(cdr tmp-list
)))
14276 (setq inst-conf-key
(or (nth 4 (car tmp-list
)) inst-conf-key
))
14277 (setq inst-conf-entry
(aget conf-alist inst-conf-key t
))
14278 (when (and inst-conf-key
(not inst-conf-entry
))
14279 (vhdl-warning-when-idle "Configuration not found: \"%s\"" inst-conf-key
))
14280 ;; determine entity
14282 (or (nth 2 (car tmp-list
)) ; from configuration
14283 (nth 3 inst-conf-entry
) ; from subconfiguration
14284 (nth 3 (aget conf-alist
(nth 7 inst-entry
) t
))
14285 ; from configuration spec.
14286 (nth 5 inst-entry
))) ; from direct instantiation
14287 (setq inst-ent-entry
(aget ent-alist inst-ent-key t
))
14288 ;; determine architecture
14289 (setq inst-arch-key
14290 (or (nth 3 (car tmp-list
)) ; from configuration
14291 (nth 4 inst-conf-entry
) ; from subconfiguration
14292 (nth 6 inst-entry
) ; from direct instantiation
14293 (nth 4 (aget conf-alist
(nth 7 inst-entry
)))
14294 ; from configuration spec.
14295 (nth 4 inst-ent-entry
) ; MRA
14296 (caar (nth 3 inst-ent-entry
)))) ; first alphabetically
14297 (setq inst-arch-entry
(aget (nth 3 inst-ent-entry
) inst-arch-key t
))
14300 (or (nth 5 (car tmp-list
)) ; from configuration
14301 (nth 8 inst-entry
))) ; from direct instantiation
14302 ;; gather information for this instance
14304 (list (nth 1 inst-entry
)
14305 (cons (nth 2 inst-entry
) (nth 3 inst-entry
))
14306 (or (nth 0 inst-ent-entry
) (nth 4 inst-entry
))
14307 (cons (nth 1 inst-ent-entry
) (nth 2 inst-ent-entry
))
14308 (or (nth 0 inst-arch-entry
) inst-arch-key
)
14309 (cons (nth 1 inst-arch-entry
) (nth 2 inst-arch-entry
))
14310 (or (nth 0 inst-conf-entry
) inst-conf-key
)
14311 (cons (nth 1 inst-conf-entry
) (nth 2 inst-conf-entry
))
14312 inst-lib-key level
))
14313 ;; get subcomponent hierarchy
14314 (setq subcomp-list
(vhdl-get-hierarchy
14315 ent-alist conf-alist
14316 inst-ent-key inst-arch-key inst-conf-key
14317 (nth 5 inst-conf-entry
)
14318 (1+ level
) indent nil
(cons ent-key ent-hier
)))
14320 (setq hier-list
(append hier-list
(list comp-entry
) subcomp-list
))
14321 (setq inst-alist
(cdr inst-alist
)))
14324 (cons (list nil nil
(nth 0 ent-entry
)
14325 (cons (nth 1 ent-entry
) (nth 2 ent-entry
))
14327 (cons (nth 1 arch-entry
) (nth 2 arch-entry
))
14331 (when (or (= level
0) (and include-top
(= level
1))) (message ""))
14334 (defun vhdl-get-instantiations (ent-key indent
)
14335 "Get all instantiations of entity ENT-KEY."
14336 (let ((ent-alist (aget vhdl-entity-alist
(vhdl-speedbar-line-key indent
) t
))
14337 arch-alist inst-alist ent-inst-list
14338 ent-entry arch-entry inst-entry
)
14340 (setq ent-entry
(car ent-alist
))
14341 (setq arch-alist
(nth 4 ent-entry
))
14343 (setq arch-entry
(car arch-alist
))
14344 (setq inst-alist
(nth 4 arch-entry
))
14346 (setq inst-entry
(car inst-alist
))
14347 (when (equal ent-key
(nth 5 inst-entry
))
14348 (setq ent-inst-list
14349 (cons (list (nth 1 inst-entry
)
14350 (cons (nth 2 inst-entry
) (nth 3 inst-entry
))
14352 (cons (nth 2 ent-entry
) (nth 3 ent-entry
))
14354 (cons (nth 2 arch-entry
) (nth 3 arch-entry
)))
14356 (setq inst-alist
(cdr inst-alist
)))
14357 (setq arch-alist
(cdr arch-alist
)))
14358 (setq ent-alist
(cdr ent-alist
)))
14359 (nreverse ent-inst-list
)))
14361 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14364 (defun vhdl-save-caches ()
14365 "Save all updated hierarchy caches to file."
14367 (condition-case nil
14368 (when vhdl-speedbar-save-cache
14369 ;; update hierarchy
14370 (vhdl-update-hierarchy)
14371 (let ((project-list vhdl-updated-project-list
))
14372 (message "Saving hierarchy caches...")
14373 ;; write updated project caches
14374 (while project-list
14375 (vhdl-save-cache (car project-list
))
14376 (setq project-list
(cdr project-list
)))
14377 (message "Saving hierarchy caches...done")))
14378 (error (progn (vhdl-warning "ERROR: An error occurred while saving the hierarchy caches")
14381 (defun vhdl-save-cache (key)
14382 "Save current hierarchy cache to file."
14383 (let* ((orig-buffer (current-buffer))
14385 (project (vhdl-project-p))
14386 (default-directory key
)
14387 (directory (abbreviate-file-name (vhdl-default-directory)))
14388 (file-name (vhdl-resolve-env-variable
14389 (vhdl-replace-string
14390 (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name
)
14392 (subst-char-in-string ? ?_
(or project
"dir"))
14393 " " (user-login-name)))))
14394 (file-dir-name (expand-file-name file-name directory
))
14395 (cache-key (or project directory
))
14396 (key (if project
"project" "directory")))
14397 (unless (file-exists-p (file-name-directory file-dir-name
))
14398 (make-directory (file-name-directory file-dir-name
) t
))
14399 (if (not (file-writable-p file-dir-name
))
14400 (progn (vhdl-warning (format "File not writable: \"%s\""
14401 (abbreviate-file-name file-dir-name
)))
14403 (message "Saving cache: \"%s\"" file-dir-name
)
14404 (set-buffer (find-file-noselect file-dir-name t t
))
14406 (insert ";; -*- Emacs-Lisp -*-\n\n"
14407 ";;; " (file-name-nondirectory file-name
)
14408 " - design hierarchy cache file for Emacs VHDL Mode "
14410 (insert "\n;; " (if project
"Project " "Directory") " : ")
14411 (if project
(insert project
) (prin1 directory
(current-buffer)))
14412 (insert "\n;; Saved : " (format-time-string "%Y-%m-%d %T ")
14413 (user-login-name) "\n\n"
14414 "\n;; version number\n"
14415 "(setq vhdl-cache-version \"" vhdl-version
"\")\n"
14416 "\n;; " (if project
"project" "directory") " name"
14417 "\n(setq " key
" ")
14418 (prin1 (or project directory
) (current-buffer))
14420 (when (member 'hierarchy vhdl-speedbar-save-cache
)
14421 (insert "\n;; entity and architecture cache\n"
14422 "(aput 'vhdl-entity-alist " key
" '")
14423 (print (aget vhdl-entity-alist cache-key t
) (current-buffer))
14424 (insert ")\n\n;; configuration cache\n"
14425 "(aput 'vhdl-config-alist " key
" '")
14426 (print (aget vhdl-config-alist cache-key t
) (current-buffer))
14427 (insert ")\n\n;; package cache\n"
14428 "(aput 'vhdl-package-alist " key
" '")
14429 (print (aget vhdl-package-alist cache-key t
) (current-buffer))
14430 (insert ")\n\n;; instantiated entities cache\n"
14431 "(aput 'vhdl-ent-inst-alist " key
" '")
14432 (print (aget vhdl-ent-inst-alist cache-key t
) (current-buffer))
14433 (insert ")\n\n;; design units per file cache\n"
14434 "(aput 'vhdl-file-alist " key
" '")
14435 (print (aget vhdl-file-alist cache-key t
) (current-buffer))
14437 (insert ")\n\n;; source directories in project cache\n"
14438 "(aput 'vhdl-directory-alist " key
" '")
14439 (print (aget vhdl-directory-alist cache-key t
) (current-buffer)))
14441 (when (member 'display vhdl-speedbar-save-cache
)
14442 (insert "\n;; shown design units cache\n"
14443 "(aput 'vhdl-speedbar-shown-unit-alist " key
" '")
14444 (print (aget vhdl-speedbar-shown-unit-alist cache-key t
)
14447 (setq vhdl-updated-project-list
14448 (delete cache-key vhdl-updated-project-list
))
14450 (kill-buffer (current-buffer))
14451 (set-buffer orig-buffer
))))
14453 (defun vhdl-load-cache (key)
14454 "Load hierarchy cache information from file."
14455 (let* ((vhdl-project key
)
14456 (default-directory key
)
14457 (directory (vhdl-default-directory))
14458 (file-name (vhdl-resolve-env-variable
14459 (vhdl-replace-string
14460 (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name
)
14462 (subst-char-in-string ? ?_
(or (vhdl-project-p) "dir"))
14463 " " (user-login-name)))))
14464 (file-dir-name (expand-file-name file-name directory
))
14465 vhdl-cache-version
)
14466 (unless (memq 'vhdl-save-caches kill-emacs-hook
)
14467 (add-hook 'kill-emacs-hook
'vhdl-save-caches
))
14468 (when (file-exists-p file-dir-name
)
14470 (progn (load-file file-dir-name
)
14471 (string< (mapconcat
14472 (lambda (a) (format "%3d" (string-to-number a
)))
14473 (split-string "3.33" "\\.") "")
14475 (lambda (a) (format "%3d" (string-to-number a
)))
14476 (split-string vhdl-cache-version
"\\.") "")))
14477 (error (progn (vhdl-warning (format "ERROR: Corrupted cache file: \"%s\"" file-dir-name
))
14480 (defun vhdl-require-hierarchy-info ()
14481 "Make sure that hierarchy information is available. Load cache or scan files
14483 (if (vhdl-project-p)
14484 (unless (or (assoc vhdl-project vhdl-file-alist
)
14485 (vhdl-load-cache vhdl-project
))
14486 (vhdl-scan-project-contents vhdl-project
))
14487 (let ((directory (abbreviate-file-name default-directory
)))
14488 (unless (or (assoc directory vhdl-file-alist
)
14489 (vhdl-load-cache directory
))
14490 (vhdl-scan-directory-contents directory
)))))
14492 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14493 ;; Add hierarchy browser functionality to speedbar
14495 (defvar vhdl-speedbar-mode-map nil
14496 "Keymap used when in the VHDL hierarchy browser mode.")
14498 (defvar vhdl-speedbar-menu-items nil
14499 "Additional menu-items to add to speedbar frame.")
14501 (declare-function speedbar-add-supported-extension
"speedbar" (extension))
14502 (declare-function speedbar-add-mode-functions-list
"speedbar" (new-list))
14503 (declare-function speedbar-make-specialized-keymap
"speedbar" ())
14504 (declare-function speedbar-change-initial-expansion-list
"speedbar"
14506 (declare-function speedbar-add-expansion-list
"speedbar" (new-list))
14508 (defun vhdl-speedbar-initialize ()
14509 "Initialize speedbar."
14510 ;; general settings
14511 ;; VHDL file extensions (extracted from `auto-mode-alist')
14512 (let ((mode-alist auto-mode-alist
))
14514 (when (eq (cdar mode-alist
) 'vhdl-mode
)
14515 (speedbar-add-supported-extension (caar mode-alist
)))
14516 (setq mode-alist
(cdr mode-alist
))))
14517 ;; hierarchy browser settings
14518 (when (boundp 'speedbar-mode-functions-list
)
14519 ;; special functions
14520 (speedbar-add-mode-functions-list
14522 (speedbar-item-info . vhdl-speedbar-item-info
)
14523 (speedbar-line-directory . speedbar-files-line-path
)))
14524 (speedbar-add-mode-functions-list
14526 (speedbar-item-info . vhdl-speedbar-item-info
)
14527 (speedbar-line-directory . vhdl-speedbar-line-project
)))
14529 (unless vhdl-speedbar-mode-map
14530 (setq vhdl-speedbar-mode-map
(speedbar-make-specialized-keymap))
14531 (define-key vhdl-speedbar-mode-map
"e" 'speedbar-edit-line
)
14532 (define-key vhdl-speedbar-mode-map
"\C-m" 'speedbar-edit-line
)
14533 (define-key vhdl-speedbar-mode-map
"+" 'speedbar-expand-line
)
14534 (define-key vhdl-speedbar-mode-map
"=" 'speedbar-expand-line
)
14535 (define-key vhdl-speedbar-mode-map
"-" 'vhdl-speedbar-contract-level
)
14536 (define-key vhdl-speedbar-mode-map
"_" 'vhdl-speedbar-contract-all
)
14537 (define-key vhdl-speedbar-mode-map
"C" 'vhdl-speedbar-port-copy
)
14538 (define-key vhdl-speedbar-mode-map
"P" 'vhdl-speedbar-place-component
)
14539 (define-key vhdl-speedbar-mode-map
"F" 'vhdl-speedbar-configuration
)
14540 (define-key vhdl-speedbar-mode-map
"A" 'vhdl-speedbar-select-mra
)
14541 (define-key vhdl-speedbar-mode-map
"K" 'vhdl-speedbar-make-design
)
14542 (define-key vhdl-speedbar-mode-map
"R" 'vhdl-speedbar-rescan-hierarchy
)
14543 (define-key vhdl-speedbar-mode-map
"S" 'vhdl-save-caches
)
14546 (define-key vhdl-speedbar-mode-map
(int-to-string key
)
14547 `(lambda () (interactive) (vhdl-speedbar-set-depth ,key
)))
14548 (setq key
(1+ key
)))))
14549 (define-key speedbar-mode-map
"h"
14550 (lambda () (interactive)
14551 (speedbar-change-initial-expansion-list "vhdl directory")))
14552 (define-key speedbar-mode-map
"H"
14553 (lambda () (interactive)
14554 (speedbar-change-initial-expansion-list "vhdl project")))
14556 (unless vhdl-speedbar-menu-items
14558 vhdl-speedbar-menu-items
14559 `(["Edit" speedbar-edit-line t
]
14560 ["Expand" speedbar-expand-line
14561 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *.\\+. "))]
14562 ["Contract" vhdl-speedbar-contract-level t
]
14563 ["Expand All" vhdl-speedbar-expand-all t
]
14564 ["Contract All" vhdl-speedbar-contract-all t
]
14565 ,(let ((key 0) (menu-list '("Hierarchy Depth")))
14568 (cons `[,(if (= key
0) "All" (int-to-string key
))
14569 (vhdl-speedbar-set-depth ,key
)
14571 :selected
(= vhdl-speedbar-hierarchy-depth
,key
)
14572 :keys
,(int-to-string key
)]
14574 (setq key
(1+ key
)))
14575 (nreverse menu-list
))
14577 ["Copy Port/Subprogram" vhdl-speedbar-port-copy
14578 (or (vhdl-speedbar-check-unit 'entity
)
14579 (vhdl-speedbar-check-unit 'subprogram
))]
14580 ["Place Component" vhdl-speedbar-place-component
14581 (vhdl-speedbar-check-unit 'entity
)]
14582 ["Generate Configuration" vhdl-speedbar-configuration
14583 (vhdl-speedbar-check-unit 'architecture
)]
14584 ["Select as MRA" vhdl-speedbar-select-mra
14585 (vhdl-speedbar-check-unit 'architecture
)]
14586 ["Make" vhdl-speedbar-make-design
14587 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
14588 ["Generate Makefile" vhdl-speedbar-generate-makefile
14589 (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))]
14590 ["Rescan Directory" vhdl-speedbar-rescan-hierarchy
14591 :active
(save-excursion (beginning-of-line) (looking-at "[0-9]+:"))
14592 ,(if (featurep 'xemacs
) :active
:visible
) (not vhdl-speedbar-show-projects
)]
14593 ["Rescan Project" vhdl-speedbar-rescan-hierarchy
14594 :active
(save-excursion (beginning-of-line) (looking-at "[0-9]+:"))
14595 ,(if (featurep 'xemacs
) :active
:visible
) vhdl-speedbar-show-projects
]
14596 ["Save Caches" vhdl-save-caches vhdl-updated-project-list
])))
14598 (speedbar-add-expansion-list
14599 '("vhdl directory" vhdl-speedbar-menu-items vhdl-speedbar-mode-map
14600 vhdl-speedbar-display-directory
))
14601 (speedbar-add-expansion-list
14602 '("vhdl project" vhdl-speedbar-menu-items vhdl-speedbar-mode-map
14603 vhdl-speedbar-display-projects
))
14604 (setq speedbar-stealthy-function-list
14606 '(("vhdl directory" vhdl-speedbar-update-current-unit
)
14607 ("vhdl project" vhdl-speedbar-update-current-project
14608 vhdl-speedbar-update-current-unit
))
14609 speedbar-stealthy-function-list
))
14610 (when (eq vhdl-speedbar-display-mode
'directory
)
14611 (setq speedbar-initial-expansion-list-name
"vhdl directory"))
14612 (when (eq vhdl-speedbar-display-mode
'project
)
14613 (setq speedbar-initial-expansion-list-name
"vhdl project"))
14614 (add-hook 'speedbar-timer-hook
'vhdl-update-hierarchy
)))
14616 (defun vhdl-speedbar (&optional arg
)
14617 "Open/close speedbar."
14619 (if (not (fboundp 'speedbar
))
14620 (error "WARNING: Speedbar is not available or not installed")
14622 (speedbar-frame-mode arg
)
14623 (error (error "WARNING: An error occurred while opening speedbar")))))
14625 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14626 ;; Display functions
14628 (defvar vhdl-speedbar-last-selected-project nil
14629 "Name of last selected project.")
14631 ;; macros must be defined in the file they are used (copied from `speedbar.el')
14632 ;;; (defmacro speedbar-with-writable (&rest forms)
14633 ;;; "Allow the buffer to be writable and evaluate FORMS."
14634 ;;; (list 'let '((inhibit-read-only t))
14635 ;;; (cons 'progn forms)))
14636 ;;; (put 'speedbar-with-writable 'lisp-indent-function 0)
14638 (declare-function speedbar-extension-list-to-regex
"speedbar" (extlist))
14639 (declare-function speedbar-directory-buttons
"speedbar" (directory _index
))
14640 (declare-function speedbar-file-lists
"speedbar" (directory))
14642 (defun vhdl-speedbar-display-directory (directory depth
&optional rescan
)
14643 "Display directory and hierarchy information in speedbar."
14644 (setq vhdl-speedbar-show-projects nil
)
14645 (setq speedbar-ignored-directory-regexp
14646 (speedbar-extension-list-to-regex speedbar-ignored-directory-expressions
))
14647 (setq directory
(abbreviate-file-name (file-name-as-directory directory
)))
14648 (setq speedbar-last-selected-file nil
)
14649 (speedbar-with-writable
14650 (condition-case nil
14652 ;; insert directory path
14653 (speedbar-directory-buttons directory depth
)
14654 ;; insert subdirectories
14655 (vhdl-speedbar-insert-dirs (speedbar-file-lists directory
) depth
)
14656 ;; scan and insert hierarchy of current directory
14657 (vhdl-speedbar-insert-dir-hierarchy directory depth
14658 speedbar-power-click
)
14659 ;; expand subdirectories
14660 (when (= depth
0) (vhdl-speedbar-expand-dirs directory
)))
14661 (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly")))))
14663 (defun vhdl-speedbar-display-projects (project depth
&optional rescan
)
14664 "Display projects and hierarchy information in speedbar."
14665 (setq vhdl-speedbar-show-projects t
)
14666 (setq speedbar-ignored-directory-regexp
".")
14667 (setq speedbar-last-selected-file nil
)
14668 (setq vhdl-speedbar-last-selected-project nil
)
14669 (speedbar-with-writable
14670 (condition-case nil
14672 (vhdl-speedbar-insert-projects)
14673 (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly"))))
14674 (setq speedbar-full-text-cache nil
)) ; prevent caching
14676 (declare-function speedbar-make-tag-line
"speedbar"
14677 (type char func data tag tfunc tdata tface depth
))
14679 (defun vhdl-speedbar-insert-projects ()
14680 "Insert all projects in speedbar."
14681 (vhdl-speedbar-make-title-line "Projects:")
14682 (let ((project-alist (if vhdl-project-sort
14683 (vhdl-sort-alist (copy-alist vhdl-project-alist
))
14684 vhdl-project-alist
))
14685 (vhdl-speedbar-update-current-unit nil
))
14687 (while project-alist
14688 (speedbar-make-tag-line
14689 'angle ?
+ 'vhdl-speedbar-expand-project
14690 (caar project-alist
) (caar project-alist
)
14691 'vhdl-toggle-project
(caar project-alist
) 'speedbar-directory-face
0)
14692 (setq project-alist
(cdr project-alist
)))
14693 (setq project-alist vhdl-project-alist
)
14695 (while project-alist
14696 (when (member (caar project-alist
) vhdl-speedbar-shown-project-list
)
14697 (goto-char (point-min))
14698 (when (re-search-forward
14699 (concat "^\\([0-9]+:\\s-*<\\)[+]>\\s-+" (caar project-alist
) "$") nil t
)
14700 (goto-char (match-end 1))
14701 (speedbar-do-function-pointer)))
14702 (setq project-alist
(cdr project-alist
)))))
14704 (defun vhdl-speedbar-insert-project-hierarchy (project indent
&optional rescan
)
14705 "Insert hierarchy of PROJECT. Rescan directories if RESCAN is non-nil,
14706 otherwise use cached data."
14707 (when (or rescan
(and (not (assoc project vhdl-file-alist
))
14708 (not (vhdl-load-cache project
))))
14709 (vhdl-scan-project-contents project
))
14710 ;; insert design hierarchy
14711 (vhdl-speedbar-insert-hierarchy
14712 (aget vhdl-entity-alist project t
)
14713 (aget vhdl-config-alist project t
)
14714 (aget vhdl-package-alist project t
)
14715 (car (aget vhdl-ent-inst-alist project t
)) indent
)
14716 (insert (int-to-string indent
) ":\n")
14717 (put-text-property (- (point) 3) (1- (point)) 'invisible t
)
14718 (put-text-property (1- (point)) (point) 'invisible nil
)
14719 ;; expand design units
14720 (vhdl-speedbar-expand-units project
))
14722 (defun vhdl-speedbar-insert-dir-hierarchy (directory depth
&optional rescan
)
14723 "Insert hierarchy of DIRECTORY. Rescan directory if RESCAN is non-nil,
14724 otherwise use cached data."
14725 (when (or rescan
(and (not (assoc directory vhdl-file-alist
))
14726 (not (vhdl-load-cache directory
))))
14727 (vhdl-scan-directory-contents directory
))
14728 ;; insert design hierarchy
14729 (vhdl-speedbar-insert-hierarchy
14730 (aget vhdl-entity-alist directory t
)
14731 (aget vhdl-config-alist directory t
)
14732 (aget vhdl-package-alist directory t
)
14733 (car (aget vhdl-ent-inst-alist directory t
)) depth
)
14734 ;; expand design units
14735 (vhdl-speedbar-expand-units directory
)
14736 (aput 'vhdl-directory-alist directory
(list (list directory
))))
14738 (defun vhdl-speedbar-insert-hierarchy (ent-alist conf-alist pack-alist
14739 ent-inst-list depth
)
14740 "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST."
14741 (if (not (or ent-alist conf-alist pack-alist
))
14742 (vhdl-speedbar-make-title-line "No VHDL design units!" depth
)
14743 (let (ent-entry conf-entry pack-entry
)
14745 (when ent-alist
(vhdl-speedbar-make-title-line "Entities:" depth
))
14747 (setq ent-entry
(car ent-alist
))
14748 (speedbar-make-tag-line
14749 'bracket ?
+ 'vhdl-speedbar-expand-entity
(nth 0 ent-entry
)
14750 (nth 1 ent-entry
) 'vhdl-speedbar-find-file
14751 (cons (nth 2 ent-entry
) (nth 3 ent-entry
))
14752 'vhdl-speedbar-entity-face depth
)
14753 (unless (nth 2 ent-entry
)
14754 (end-of-line 0) (insert "!") (forward-char 1))
14755 (unless (member (nth 0 ent-entry
) ent-inst-list
)
14756 (end-of-line 0) (insert " (top)") (forward-char 1))
14757 (setq ent-alist
(cdr ent-alist
)))
14758 ;; insert configurations
14759 (when conf-alist
(vhdl-speedbar-make-title-line "Configurations:" depth
))
14761 (setq conf-entry
(car conf-alist
))
14762 (speedbar-make-tag-line
14763 'bracket ?
+ 'vhdl-speedbar-expand-config
(nth 0 conf-entry
)
14764 (nth 1 conf-entry
) 'vhdl-speedbar-find-file
14765 (cons (nth 2 conf-entry
) (nth 3 conf-entry
))
14766 'vhdl-speedbar-configuration-face depth
)
14767 (setq conf-alist
(cdr conf-alist
)))
14769 (when pack-alist
(vhdl-speedbar-make-title-line "Packages:" depth
))
14771 (setq pack-entry
(car pack-alist
))
14772 (vhdl-speedbar-make-pack-line
14773 (nth 0 pack-entry
) (nth 1 pack-entry
)
14774 (cons (nth 2 pack-entry
) (nth 3 pack-entry
))
14775 (cons (nth 7 pack-entry
) (nth 8 pack-entry
))
14777 (setq pack-alist
(cdr pack-alist
))))))
14779 (declare-function speedbar-line-directory
"speedbar" (&optional depth
))
14781 (defun vhdl-speedbar-rescan-hierarchy ()
14782 "Rescan hierarchy for the directory or project under the cursor."
14787 (vhdl-speedbar-show-projects
14788 (setq key
(vhdl-speedbar-line-project))
14789 (vhdl-scan-project-contents key
))
14790 ;; top-level directory
14791 ((save-excursion (beginning-of-line) (looking-at "[^0-9]"))
14792 (re-search-forward "[0-9]+:" nil t
)
14793 (vhdl-scan-directory-contents
14794 (abbreviate-file-name (speedbar-line-directory))))
14795 ;; current directory
14796 (t (setq path
(speedbar-line-directory))
14797 (string-match "^\\(.+[/\\]\\)" path
)
14798 (vhdl-scan-directory-contents
14799 (abbreviate-file-name (match-string 1 path
)))))
14800 (vhdl-speedbar-refresh key
)))
14802 (declare-function speedbar-goto-this-file
"speedbar" (file))
14804 (defun vhdl-speedbar-expand-dirs (directory)
14805 "Expand subdirectories in DIRECTORY according to
14806 `speedbar-shown-directories'."
14807 ;; (nicked from `speedbar-default-directory-list')
14808 (let ((sf (cdr (reverse speedbar-shown-directories
)))
14809 (vhdl-speedbar-update-current-unit nil
))
14810 (setq speedbar-shown-directories
14811 (list (expand-file-name default-directory
)))
14813 (when (speedbar-goto-this-file (car sf
))
14814 (beginning-of-line)
14815 (when (looking-at "[0-9]+:\\s-*<")
14816 (goto-char (match-end 0))
14817 (speedbar-do-function-pointer)))
14818 (setq sf
(cdr sf
))))
14819 (vhdl-speedbar-update-current-unit nil t
))
14821 (defun vhdl-speedbar-expand-units (key)
14822 "Expand design units in directory/project KEY according to
14823 `vhdl-speedbar-shown-unit-alist'."
14824 (let ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t
))
14825 (vhdl-speedbar-update-current-unit nil
)
14826 vhdl-updated-project-list
)
14827 (adelete 'vhdl-speedbar-shown-unit-alist key
)
14828 (vhdl-prepare-search-1
14829 (while unit-alist
; expand units
14830 (vhdl-speedbar-goto-this-unit key
(caar unit-alist
))
14831 (beginning-of-line)
14832 (let ((arch-alist (nth 1 (car unit-alist
)))
14834 (when (looking-at "^[0-9]+:\\s-*\\[")
14835 (goto-char (match-end 0))
14836 (setq position
(point))
14837 (speedbar-do-function-pointer)
14838 (select-frame speedbar-frame
)
14839 (while arch-alist
; expand architectures
14840 (goto-char position
)
14841 (when (re-search-forward
14842 (concat "^[0-9]+:\\s-*\\(\\[\\|{.}\\s-+"
14843 (car arch-alist
) "\\>\\)") nil t
)
14844 (beginning-of-line)
14845 (when (looking-at "^[0-9]+:\\s-*{")
14846 (goto-char (match-end 0))
14847 (speedbar-do-function-pointer)
14848 (select-frame speedbar-frame
)))
14849 (setq arch-alist
(cdr arch-alist
))))
14850 (setq unit-alist
(cdr unit-alist
))))))
14851 (vhdl-speedbar-update-current-unit nil t
))
14853 (declare-function speedbar-center-buffer-smartly
"speedbar" ())
14855 (defun vhdl-speedbar-contract-level ()
14856 "Contract current level in current directory/project."
14858 (when (or (save-excursion
14859 (beginning-of-line) (looking-at "^[0-9]:\\s-*[[{<]-"))
14860 (and (save-excursion
14861 (beginning-of-line) (looking-at "^\\([0-9]+\\):"))
14862 (re-search-backward
14863 (format "^[0-%d]:\\s-*[[{<]-"
14864 (max (1- (string-to-number (match-string 1))) 0)) nil t
)))
14865 (goto-char (match-end 0))
14866 (speedbar-do-function-pointer)
14867 (speedbar-center-buffer-smartly)))
14869 (defun vhdl-speedbar-contract-all ()
14870 "Contract all expanded design units in current directory/project."
14872 (if (and vhdl-speedbar-show-projects
14873 (save-excursion (beginning-of-line) (looking-at "^0:")))
14874 (progn (setq vhdl-speedbar-shown-project-list nil
)
14875 (vhdl-speedbar-refresh))
14876 (let ((key (vhdl-speedbar-line-key)))
14877 (adelete 'vhdl-speedbar-shown-unit-alist key
)
14878 (vhdl-speedbar-refresh (and vhdl-speedbar-show-projects key
))
14879 (when (memq 'display vhdl-speedbar-save-cache
)
14880 (add-to-list 'vhdl-updated-project-list key
)))))
14882 (defun vhdl-speedbar-expand-all ()
14883 "Expand all design units in current directory/project."
14885 (let* ((key (vhdl-speedbar-line-key))
14886 (ent-alist (aget vhdl-entity-alist key t
))
14887 (conf-alist (aget vhdl-config-alist key t
))
14888 (pack-alist (aget vhdl-package-alist key t
))
14889 arch-alist unit-alist subunit-alist
)
14890 (add-to-list 'vhdl-speedbar-shown-project-list key
)
14892 (setq arch-alist
(nth 4 (car ent-alist
)))
14893 (setq subunit-alist nil
)
14895 (push (caar arch-alist
) subunit-alist
)
14896 (setq arch-alist
(cdr arch-alist
)))
14897 (push (list (caar ent-alist
) subunit-alist
) unit-alist
)
14898 (setq ent-alist
(cdr ent-alist
)))
14900 (push (list (caar conf-alist
)) unit-alist
)
14901 (setq conf-alist
(cdr conf-alist
)))
14903 (push (list (caar pack-alist
)) unit-alist
)
14904 (setq pack-alist
(cdr pack-alist
)))
14905 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist
)
14906 (vhdl-speedbar-refresh)
14907 (when (memq 'display vhdl-speedbar-save-cache
)
14908 (add-to-list 'vhdl-updated-project-list key
))))
14910 (declare-function speedbar-change-expand-button-char
"speedbar" (char))
14911 (declare-function speedbar-delete-subblock
"speedbar" (indent))
14913 (defun vhdl-speedbar-expand-project (text token indent
)
14914 "Expand/contract the project under the cursor."
14916 ((string-match "+" text
) ; expand project
14917 (speedbar-change-expand-button-char ?-
)
14918 (unless (member token vhdl-speedbar-shown-project-list
)
14919 (setq vhdl-speedbar-shown-project-list
14920 (cons token vhdl-speedbar-shown-project-list
)))
14921 (speedbar-with-writable
14923 (end-of-line) (forward-char 1)
14924 (vhdl-speedbar-insert-project-hierarchy token
(1+ indent
)
14925 speedbar-power-click
))))
14926 ((string-match "-" text
) ; contract project
14927 (speedbar-change-expand-button-char ?
+)
14928 (setq vhdl-speedbar-shown-project-list
14929 (delete token vhdl-speedbar-shown-project-list
))
14930 (speedbar-delete-subblock indent
))
14931 (t (error "Nothing to display")))
14932 (when (equal (selected-frame) speedbar-frame
)
14933 (speedbar-center-buffer-smartly)))
14935 (defun vhdl-speedbar-expand-entity (text token indent
)
14936 "Expand/contract the entity under the cursor."
14938 ((string-match "+" text
) ; expand entity
14939 (let* ((key (vhdl-speedbar-line-key indent
))
14940 (ent-alist (aget vhdl-entity-alist key t
))
14941 (ent-entry (aget ent-alist token t
))
14942 (arch-alist (nth 3 ent-entry
))
14943 (inst-alist (vhdl-get-instantiations token indent
))
14944 (subpack-alist (nth 5 ent-entry
))
14945 (multiple-arch (> (length arch-alist
) 1))
14946 arch-entry inst-entry
)
14947 (if (not (or arch-alist inst-alist subpack-alist
))
14948 (speedbar-change-expand-button-char ??
)
14949 (speedbar-change-expand-button-char ?-
)
14950 ;; add entity to `vhdl-speedbar-shown-unit-alist'
14951 (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t
)))
14952 (aput 'unit-alist token nil
)
14953 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist
))
14954 (speedbar-with-writable
14956 (end-of-line) (forward-char 1)
14957 ;; insert architectures
14959 (vhdl-speedbar-make-title-line "Architectures:" (1+ indent
)))
14961 (setq arch-entry
(car arch-alist
))
14962 (speedbar-make-tag-line
14963 'curly ?
+ 'vhdl-speedbar-expand-architecture
14964 (cons token
(nth 0 arch-entry
))
14965 (nth 1 arch-entry
) 'vhdl-speedbar-find-file
14966 (cons (nth 2 arch-entry
) (nth 3 arch-entry
))
14967 'vhdl-speedbar-architecture-face
(1+ indent
))
14968 (when (and multiple-arch
14969 (equal (nth 0 arch-entry
) (nth 4 ent-entry
)))
14970 (end-of-line 0) (insert " (mra)") (forward-char 1))
14971 (setq arch-alist
(cdr arch-alist
)))
14972 ;; insert instantiations
14974 (vhdl-speedbar-make-title-line "Instantiated as:" (1+ indent
)))
14976 (setq inst-entry
(car inst-alist
))
14977 (vhdl-speedbar-make-inst-line
14978 (nth 0 inst-entry
) (nth 1 inst-entry
) (nth 2 inst-entry
)
14979 (nth 3 inst-entry
) (nth 4 inst-entry
) (nth 5 inst-entry
)
14980 nil nil nil
(1+ indent
) 0 " in ")
14981 (setq inst-alist
(cdr inst-alist
)))
14982 ;; insert required packages
14983 (vhdl-speedbar-insert-subpackages
14984 subpack-alist
(1+ indent
) indent
)))
14985 (when (memq 'display vhdl-speedbar-save-cache
)
14986 (add-to-list 'vhdl-updated-project-list key
))
14987 (vhdl-speedbar-update-current-unit t t
))))
14988 ((string-match "-" text
) ; contract entity
14989 (speedbar-change-expand-button-char ?
+)
14990 ;; remove entity from `vhdl-speedbar-shown-unit-alist'
14991 (let* ((key (vhdl-speedbar-line-key indent
))
14992 (unit-alist (aget vhdl-speedbar-shown-unit-alist key t
)))
14993 (adelete 'unit-alist token
)
14995 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist
)
14996 (adelete 'vhdl-speedbar-shown-unit-alist key
))
14997 (speedbar-delete-subblock indent
)
14998 (when (memq 'display vhdl-speedbar-save-cache
)
14999 (add-to-list 'vhdl-updated-project-list key
))))
15000 (t (error "Nothing to display")))
15001 (when (equal (selected-frame) speedbar-frame
)
15002 (speedbar-center-buffer-smartly)))
15004 (defun vhdl-speedbar-expand-architecture (text token indent
)
15005 "Expand/contract the architecture under the cursor."
15007 ((string-match "+" text
) ; expand architecture
15008 (let* ((key (vhdl-speedbar-line-key (1- indent
)))
15009 (ent-alist (aget vhdl-entity-alist key t
))
15010 (conf-alist (aget vhdl-config-alist key t
))
15011 (hier-alist (vhdl-get-hierarchy
15012 ent-alist conf-alist
(car token
) (cdr token
) nil nil
15014 (ent-entry (aget ent-alist
(car token
) t
))
15015 (arch-entry (aget (nth 3 ent-entry
) (cdr token
) t
))
15016 (subpack-alist (nth 4 arch-entry
))
15018 (if (not (or hier-alist subpack-alist
))
15019 (speedbar-change-expand-button-char ??
)
15020 (speedbar-change-expand-button-char ?-
)
15021 ;; add architecture to `vhdl-speedbar-shown-unit-alist'
15022 (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t
))
15023 (arch-alist (nth 0 (aget unit-alist
(car token
) t
))))
15024 (aput 'unit-alist
(car token
) (list (cons (cdr token
) arch-alist
)))
15025 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist
))
15026 (speedbar-with-writable
15028 (end-of-line) (forward-char 1)
15029 ;; insert instance hierarchy
15031 (vhdl-speedbar-make-title-line "Subcomponent hierarchy:"
15034 (setq entry
(car hier-alist
))
15035 (when (or (= vhdl-speedbar-hierarchy-depth
0)
15036 (< (nth 9 entry
) vhdl-speedbar-hierarchy-depth
))
15037 (vhdl-speedbar-make-inst-line
15038 (nth 0 entry
) (nth 1 entry
) (nth 2 entry
) (nth 3 entry
)
15039 (nth 4 entry
) (nth 5 entry
) (nth 6 entry
) (nth 7 entry
)
15040 (nth 8 entry
) (1+ indent
) (1+ (nth 9 entry
)) ": "))
15041 (setq hier-alist
(cdr hier-alist
)))
15042 ;; insert required packages
15043 (vhdl-speedbar-insert-subpackages
15044 subpack-alist
(1+ indent
) (1- indent
))))
15045 (when (memq 'display vhdl-speedbar-save-cache
)
15046 (add-to-list 'vhdl-updated-project-list key
))
15047 (vhdl-speedbar-update-current-unit t t
))))
15048 ((string-match "-" text
) ; contract architecture
15049 (speedbar-change-expand-button-char ?
+)
15050 ;; remove architecture from `vhdl-speedbar-shown-unit-alist'
15051 (let* ((key (vhdl-speedbar-line-key (1- indent
)))
15052 (unit-alist (aget vhdl-speedbar-shown-unit-alist key t
))
15053 (arch-alist (nth 0 (aget unit-alist
(car token
) t
))))
15054 (aput 'unit-alist
(car token
) (list (delete (cdr token
) arch-alist
)))
15055 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist
)
15056 (speedbar-delete-subblock indent
)
15057 (when (memq 'display vhdl-speedbar-save-cache
)
15058 (add-to-list 'vhdl-updated-project-list key
))))
15059 (t (error "Nothing to display")))
15060 (when (equal (selected-frame) speedbar-frame
)
15061 (speedbar-center-buffer-smartly)))
15063 (defun vhdl-speedbar-expand-config (text token indent
)
15064 "Expand/contract the configuration under the cursor."
15066 ((string-match "+" text
) ; expand configuration
15067 (let* ((key (vhdl-speedbar-line-key indent
))
15068 (conf-alist (aget vhdl-config-alist key t
))
15069 (conf-entry (aget conf-alist token
))
15070 (ent-alist (aget vhdl-entity-alist key t
))
15071 (hier-alist (vhdl-get-hierarchy
15072 ent-alist conf-alist
(nth 3 conf-entry
)
15073 (nth 4 conf-entry
) token
(nth 5 conf-entry
)
15075 (subpack-alist (nth 6 conf-entry
))
15077 (if (not (or hier-alist subpack-alist
))
15078 (speedbar-change-expand-button-char ??
)
15079 (speedbar-change-expand-button-char ?-
)
15080 ;; add configuration to `vhdl-speedbar-shown-unit-alist'
15081 (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t
)))
15082 (aput 'unit-alist token nil
)
15083 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist
))
15084 (speedbar-with-writable
15086 (end-of-line) (forward-char 1)
15087 ;; insert instance hierarchy
15089 (vhdl-speedbar-make-title-line "Design hierarchy:" (1+ indent
)))
15091 (setq entry
(car hier-alist
))
15092 (when (or (= vhdl-speedbar-hierarchy-depth
0)
15093 (<= (nth 9 entry
) vhdl-speedbar-hierarchy-depth
))
15094 (vhdl-speedbar-make-inst-line
15095 (nth 0 entry
) (nth 1 entry
) (nth 2 entry
) (nth 3 entry
)
15096 (nth 4 entry
) (nth 5 entry
) (nth 6 entry
) (nth 7 entry
)
15097 (nth 8 entry
) (1+ indent
) (nth 9 entry
) ": "))
15098 (setq hier-alist
(cdr hier-alist
)))
15099 ;; insert required packages
15100 (vhdl-speedbar-insert-subpackages
15101 subpack-alist
(1+ indent
) indent
)))
15102 (when (memq 'display vhdl-speedbar-save-cache
)
15103 (add-to-list 'vhdl-updated-project-list key
))
15104 (vhdl-speedbar-update-current-unit t t
))))
15105 ((string-match "-" text
) ; contract configuration
15106 (speedbar-change-expand-button-char ?
+)
15107 ;; remove configuration from `vhdl-speedbar-shown-unit-alist'
15108 (let* ((key (vhdl-speedbar-line-key indent
))
15109 (unit-alist (aget vhdl-speedbar-shown-unit-alist key t
)))
15110 (adelete 'unit-alist token
)
15112 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist
)
15113 (adelete 'vhdl-speedbar-shown-unit-alist key
))
15114 (speedbar-delete-subblock indent
)
15115 (when (memq 'display vhdl-speedbar-save-cache
)
15116 (add-to-list 'vhdl-updated-project-list key
))))
15117 (t (error "Nothing to display")))
15118 (when (equal (selected-frame) speedbar-frame
)
15119 (speedbar-center-buffer-smartly)))
15121 (defun vhdl-speedbar-expand-package (text token indent
)
15122 "Expand/contract the package under the cursor."
15124 ((string-match "+" text
) ; expand package
15125 (let* ((key (vhdl-speedbar-line-key indent
))
15126 (pack-alist (aget vhdl-package-alist key t
))
15127 (pack-entry (aget pack-alist token t
))
15128 (comp-alist (nth 3 pack-entry
))
15129 (func-alist (nth 4 pack-entry
))
15130 (func-body-alist (nth 8 pack-entry
))
15131 (subpack-alist (append (nth 5 pack-entry
) (nth 9 pack-entry
)))
15132 comp-entry func-entry func-body-entry
)
15133 (if (not (or comp-alist func-alist subpack-alist
))
15134 (speedbar-change-expand-button-char ??
)
15135 (speedbar-change-expand-button-char ?-
)
15136 ;; add package to `vhdl-speedbar-shown-unit-alist'
15137 (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t
)))
15138 (aput 'unit-alist token nil
)
15139 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist
))
15140 (speedbar-with-writable
15142 (end-of-line) (forward-char 1)
15143 ;; insert components
15145 (vhdl-speedbar-make-title-line "Components:" (1+ indent
)))
15147 (setq comp-entry
(car comp-alist
))
15148 (speedbar-make-tag-line
15150 (cons token
(nth 0 comp-entry
))
15151 (nth 1 comp-entry
) 'vhdl-speedbar-find-file
15152 (cons (nth 2 comp-entry
) (nth 3 comp-entry
))
15153 'vhdl-speedbar-entity-face
(1+ indent
))
15154 (setq comp-alist
(cdr comp-alist
)))
15155 ;; insert subprograms
15157 (vhdl-speedbar-make-title-line "Subprograms:" (1+ indent
)))
15159 (setq func-entry
(car func-alist
)
15160 func-body-entry
(aget func-body-alist
(car func-entry
) t
))
15161 (when (nth 2 func-entry
)
15162 (vhdl-speedbar-make-subprogram-line
15164 (cons (nth 2 func-entry
) (nth 3 func-entry
))
15165 (cons (nth 1 func-body-entry
) (nth 2 func-body-entry
))
15167 (setq func-alist
(cdr func-alist
)))
15168 ;; insert required packages
15169 (vhdl-speedbar-insert-subpackages
15170 subpack-alist
(1+ indent
) indent
)))
15171 (when (memq 'display vhdl-speedbar-save-cache
)
15172 (add-to-list 'vhdl-updated-project-list key
))
15173 (vhdl-speedbar-update-current-unit t t
))))
15174 ((string-match "-" text
) ; contract package
15175 (speedbar-change-expand-button-char ?
+)
15176 ;; remove package from `vhdl-speedbar-shown-unit-alist'
15177 (let* ((key (vhdl-speedbar-line-key indent
))
15178 (unit-alist (aget vhdl-speedbar-shown-unit-alist key t
)))
15179 (adelete 'unit-alist token
)
15181 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist
)
15182 (adelete 'vhdl-speedbar-shown-unit-alist key
))
15183 (speedbar-delete-subblock indent
)
15184 (when (memq 'display vhdl-speedbar-save-cache
)
15185 (add-to-list 'vhdl-updated-project-list key
))))
15186 (t (error "Nothing to display")))
15187 (when (equal (selected-frame) speedbar-frame
)
15188 (speedbar-center-buffer-smartly)))
15190 (defun vhdl-speedbar-insert-subpackages (subpack-alist indent dir-indent
)
15191 "Insert required packages."
15192 (let* ((pack-alist (aget vhdl-package-alist
15193 (vhdl-speedbar-line-key dir-indent
) t
))
15194 pack-key lib-name pack-entry
)
15195 (when subpack-alist
15196 (vhdl-speedbar-make-title-line "Packages Used:" indent
))
15197 (while subpack-alist
15198 (setq pack-key
(cdar subpack-alist
)
15199 lib-name
(caar subpack-alist
))
15200 (setq pack-entry
(aget pack-alist pack-key t
))
15201 (vhdl-speedbar-make-subpack-line
15202 (or (nth 0 pack-entry
) pack-key
) lib-name
15203 (cons (nth 1 pack-entry
) (nth 2 pack-entry
))
15204 (cons (nth 6 pack-entry
) (nth 7 pack-entry
)) indent
)
15205 (setq subpack-alist
(cdr subpack-alist
)))))
15207 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15208 ;; Display help functions
15210 (defvar vhdl-speedbar-update-current-unit t
15211 "Non-nil means to run `vhdl-speedbar-update-current-unit'.")
15213 (defun vhdl-speedbar-update-current-project ()
15214 "Highlight project that is currently active."
15215 (when (and vhdl-speedbar-show-projects
15216 (not (equal vhdl-speedbar-last-selected-project vhdl-project
))
15217 (and (boundp 'speedbar-frame
)
15218 (frame-live-p speedbar-frame
)))
15219 (let ((last-frame (selected-frame))
15220 (project-alist vhdl-project-alist
)
15222 (select-frame speedbar-frame
)
15223 (speedbar-with-writable
15225 (while project-alist
15226 (goto-char (point-min))
15227 (when (re-search-forward
15228 (concat "<.> \\(" (caar project-alist
) "\\)$") nil t
)
15229 (put-text-property (match-beginning 1) (match-end 1) 'face
15230 (if (equal (caar project-alist
) vhdl-project
)
15231 'speedbar-selected-face
15232 'speedbar-directory-face
))
15233 (when (equal (caar project-alist
) vhdl-project
)
15234 (setq pos
(1- (match-beginning 1)))))
15235 (setq project-alist
(cdr project-alist
))))
15236 (when pos
(goto-char pos
)))
15237 (select-frame last-frame
)
15238 (setq vhdl-speedbar-last-selected-project vhdl-project
)))
15241 (declare-function speedbar-position-cursor-on-line
"speedbar" ())
15243 (defun vhdl-speedbar-update-current-unit (&optional no-position always
)
15244 "Highlight all design units that are contained in the current file.
15245 NO-POSITION non-nil means do not re-position cursor."
15246 (let ((last-frame (selected-frame))
15247 (project-list vhdl-speedbar-shown-project-list
)
15248 file-alist pos file-name
)
15249 ;; get current file name
15250 (if (fboundp 'speedbar-select-attached-frame
)
15251 (speedbar-select-attached-frame)
15252 (select-frame speedbar-attached-frame
))
15253 (setq file-name
(abbreviate-file-name (or (buffer-file-name) "")))
15254 (when (and vhdl-speedbar-update-current-unit
15255 (or always
(not (equal file-name speedbar-last-selected-file
))))
15256 (if vhdl-speedbar-show-projects
15257 (while project-list
15258 (setq file-alist
(append file-alist
(aget vhdl-file-alist
15259 (car project-list
) t
)))
15260 (setq project-list
(cdr project-list
)))
15261 (setq file-alist
(aget vhdl-file-alist
15262 (abbreviate-file-name default-directory
) t
)))
15263 (select-frame speedbar-frame
)
15264 (set-buffer speedbar-buffer
)
15265 (speedbar-with-writable
15266 (vhdl-prepare-search-1
15268 ;; unhighlight last units
15269 (let* ((file-entry (aget file-alist speedbar-last-selected-file t
)))
15270 (vhdl-speedbar-update-units
15271 "\\[.\\] " (nth 0 file-entry
)
15272 speedbar-last-selected-file
'vhdl-speedbar-entity-face
)
15273 (vhdl-speedbar-update-units
15274 "{.} " (nth 1 file-entry
)
15275 speedbar-last-selected-file
'vhdl-speedbar-architecture-face
)
15276 (vhdl-speedbar-update-units
15277 "\\[.\\] " (nth 3 file-entry
)
15278 speedbar-last-selected-file
'vhdl-speedbar-configuration-face
)
15279 (vhdl-speedbar-update-units
15280 "[]>] " (nth 4 file-entry
)
15281 speedbar-last-selected-file
'vhdl-speedbar-package-face
)
15282 (vhdl-speedbar-update-units
15283 "\\[.\\].+(" '("body")
15284 speedbar-last-selected-file
'vhdl-speedbar-package-face
)
15285 (vhdl-speedbar-update-units
15286 "> " (nth 6 file-entry
)
15287 speedbar-last-selected-file
'vhdl-speedbar-instantiation-face
))
15288 ;; highlight current units
15289 (let* ((file-entry (aget file-alist file-name t
)))
15291 pos
(vhdl-speedbar-update-units
15292 "\\[.\\] " (nth 0 file-entry
)
15293 file-name
'vhdl-speedbar-entity-selected-face pos
)
15294 pos
(vhdl-speedbar-update-units
15295 "{.} " (nth 1 file-entry
)
15296 file-name
'vhdl-speedbar-architecture-selected-face pos
)
15297 pos
(vhdl-speedbar-update-units
15298 "\\[.\\] " (nth 3 file-entry
)
15299 file-name
'vhdl-speedbar-configuration-selected-face pos
)
15300 pos
(vhdl-speedbar-update-units
15301 "[]>] " (nth 4 file-entry
)
15302 file-name
'vhdl-speedbar-package-selected-face pos
)
15303 pos
(vhdl-speedbar-update-units
15304 "\\[.\\].+(" '("body")
15305 file-name
'vhdl-speedbar-package-selected-face pos
)
15306 pos
(vhdl-speedbar-update-units
15307 "> " (nth 6 file-entry
)
15308 file-name
'vhdl-speedbar-instantiation-selected-face pos
))))))
15309 ;; move speedbar so the first highlighted unit is visible
15310 (when (and pos
(not no-position
))
15312 (speedbar-center-buffer-smartly)
15313 (speedbar-position-cursor-on-line))
15314 (setq speedbar-last-selected-file file-name
))
15315 (select-frame last-frame
)
15318 (defun vhdl-speedbar-update-units (text unit-list file-name face
15320 "Help function to highlight design units."
15322 (goto-char (point-min))
15323 (while (re-search-forward
15324 (concat text
"\\(" (car unit-list
) "\\)\\>") nil t
)
15325 (when (equal file-name
(car (get-text-property
15326 (match-beginning 1) 'speedbar-token
)))
15327 (setq pos
(or pos
(point-marker)))
15328 (put-text-property (match-beginning 1) (match-end 1) 'face face
)))
15329 (setq unit-list
(cdr unit-list
)))
15332 (declare-function speedbar-make-button
"speedbar"
15333 (start end face mouse function
&optional token
))
15335 (defun vhdl-speedbar-make-inst-line (inst-name inst-file-marker
15336 ent-name ent-file-marker
15337 arch-name arch-file-marker
15338 conf-name conf-file-marker
15339 lib-name depth offset delimiter
)
15340 "Insert instantiation entry."
15341 (let ((start (point))
15343 (insert (int-to-string depth
) ":")
15344 (put-text-property start
(point) 'invisible t
)
15345 (setq visible-start
(point))
15346 (insert-char ?
(* depth speedbar-indentation-width
))
15347 (while (> offset
0)
15349 (insert-char (if (= offset
1) ?- ?
) (1- speedbar-indentation-width
))
15350 (setq offset
(1- offset
)))
15351 (put-text-property visible-start
(point) 'invisible nil
)
15352 (setq start
(point))
15354 (speedbar-make-button start
(point) nil nil nil
)
15355 (setq visible-start
(point))
15357 (setq start
(point))
15358 (if (not inst-name
)
15361 (speedbar-make-button
15362 start
(point) 'vhdl-speedbar-instantiation-face
'speedbar-highlight-face
15363 'vhdl-speedbar-find-file inst-file-marker
))
15366 (setq start
(point))
15368 (speedbar-make-button
15369 start
(point) 'vhdl-speedbar-entity-face
'speedbar-highlight-face
15370 'vhdl-speedbar-find-file ent-file-marker
)
15373 (setq start
(point))
15375 (speedbar-make-button
15376 start
(point) 'vhdl-speedbar-architecture-face
'speedbar-highlight-face
15377 'vhdl-speedbar-find-file arch-file-marker
)
15381 (setq start
(point))
15383 (speedbar-make-button
15384 start
(point) 'vhdl-speedbar-configuration-face
'speedbar-highlight-face
15385 'vhdl-speedbar-find-file conf-file-marker
)
15387 (when (and lib-name
(not (equal lib-name
(downcase (vhdl-work-library)))))
15388 (setq start
(point))
15389 (insert " (" lib-name
")")
15390 (put-text-property (+ 2 start
) (1- (point)) 'face
15391 'vhdl-speedbar-library-face
))
15392 (insert-char ?
\n 1)
15393 (put-text-property visible-start
(point) 'invisible nil
)))
15395 (defun vhdl-speedbar-make-pack-line (pack-key pack-name pack-file-marker
15396 body-file-marker depth
)
15397 "Insert package entry."
15398 (let ((start (point))
15400 (insert (int-to-string depth
) ":")
15401 (put-text-property start
(point) 'invisible t
)
15402 (setq visible-start
(point))
15403 (insert-char ?
(* depth speedbar-indentation-width
))
15404 (put-text-property visible-start
(point) 'invisible nil
)
15405 (setq start
(point))
15407 (speedbar-make-button
15408 start
(point) 'speedbar-button-face
'speedbar-highlight-face
15409 'vhdl-speedbar-expand-package pack-key
)
15410 (setq visible-start
(point))
15411 (insert-char ?
1 nil
)
15412 (setq start
(point))
15414 (speedbar-make-button
15415 start
(point) 'vhdl-speedbar-package-face
'speedbar-highlight-face
15416 'vhdl-speedbar-find-file pack-file-marker
)
15417 (unless (car pack-file-marker
)
15419 (when (car body-file-marker
)
15421 (setq start
(point))
15423 (speedbar-make-button
15424 start
(point) 'vhdl-speedbar-package-face
'speedbar-highlight-face
15425 'vhdl-speedbar-find-file body-file-marker
)
15427 (insert-char ?
\n 1)
15428 (put-text-property visible-start
(point) 'invisible nil
)))
15430 (defun vhdl-speedbar-make-subpack-line (pack-name lib-name pack-file-marker
15431 pack-body-file-marker depth
)
15432 "Insert used package entry."
15433 (let ((start (point))
15435 (insert (int-to-string depth
) ":")
15436 (put-text-property start
(point) 'invisible t
)
15437 (setq visible-start
(point))
15438 (insert-char ?
(* depth speedbar-indentation-width
))
15439 (put-text-property visible-start
(point) 'invisible nil
)
15440 (setq start
(point))
15442 (speedbar-make-button start
(point) nil nil nil
)
15443 (setq visible-start
(point))
15445 (setq start
(point))
15447 (speedbar-make-button
15448 start
(point) 'vhdl-speedbar-package-face
'speedbar-highlight-face
15449 'vhdl-speedbar-find-file pack-file-marker
)
15450 (when (car pack-body-file-marker
)
15452 (setq start
(point))
15454 (speedbar-make-button
15455 start
(point) 'vhdl-speedbar-package-face
'speedbar-highlight-face
15456 'vhdl-speedbar-find-file pack-body-file-marker
)
15458 (setq start
(point))
15459 (insert " (" lib-name
")")
15460 (put-text-property (+ 2 start
) (1- (point)) 'face
15461 'vhdl-speedbar-library-face
)
15462 (insert-char ?
\n 1)
15463 (put-text-property visible-start
(point) 'invisible nil
)))
15465 (defun vhdl-speedbar-make-subprogram-line (func-name func-file-marker
15466 func-body-file-marker
15468 "Insert subprogram entry."
15469 (let ((start (point))
15471 (insert (int-to-string depth
) ":")
15472 (put-text-property start
(point) 'invisible t
)
15473 (setq visible-start
(point))
15474 (insert-char ?
(* depth speedbar-indentation-width
))
15475 (put-text-property visible-start
(point) 'invisible nil
)
15476 (setq start
(point))
15478 (speedbar-make-button start
(point) nil nil nil
)
15479 (setq visible-start
(point))
15481 (setq start
(point))
15483 (speedbar-make-button
15484 start
(point) 'vhdl-speedbar-subprogram-face
'speedbar-highlight-face
15485 'vhdl-speedbar-find-file func-file-marker
)
15486 (when (car func-body-file-marker
)
15488 (setq start
(point))
15490 (speedbar-make-button
15491 start
(point) 'vhdl-speedbar-subprogram-face
'speedbar-highlight-face
15492 'vhdl-speedbar-find-file func-body-file-marker
)
15494 (insert-char ?
\n 1)
15495 (put-text-property visible-start
(point) 'invisible nil
)))
15497 (defun vhdl-speedbar-make-title-line (text &optional depth
)
15498 "Insert design unit title entry."
15499 (let ((start (point))
15502 (insert (int-to-string depth
) ":")
15503 (put-text-property start
(point) 'invisible t
))
15504 (setq visible-start
(point))
15505 (insert-char ?
(* (or depth
0) speedbar-indentation-width
))
15506 (setq start
(point))
15508 (speedbar-make-button start
(point) nil nil nil nil
)
15509 (insert-char ?
\n 1)
15510 (put-text-property visible-start
(point) 'invisible nil
)))
15512 (defun vhdl-speedbar-insert-dirs (files level
)
15513 "Insert subdirectories."
15514 (let ((dirs (car files
)))
15516 (speedbar-make-tag-line 'angle ?
+ 'vhdl-speedbar-dired
(car dirs
)
15517 (car dirs
) 'speedbar-dir-follow nil
15518 'speedbar-directory-face level
)
15519 (setq dirs
(cdr dirs
)))))
15521 (declare-function speedbar-reset-scanners
"speedbar" ())
15523 (defun vhdl-speedbar-dired (text token indent
)
15524 "Speedbar click handler for directory expand button in hierarchy mode."
15525 (cond ((string-match "+" text
) ; we have to expand this dir
15526 (setq speedbar-shown-directories
15527 (cons (expand-file-name
15528 (concat (speedbar-line-directory indent
) token
"/"))
15529 speedbar-shown-directories
))
15530 (speedbar-change-expand-button-char ?-
)
15531 (speedbar-reset-scanners)
15532 (speedbar-with-writable
15534 (end-of-line) (forward-char 1)
15535 (vhdl-speedbar-insert-dirs
15536 (speedbar-file-lists
15537 (concat (speedbar-line-directory indent
) token
"/"))
15539 (speedbar-reset-scanners)
15540 (vhdl-speedbar-insert-dir-hierarchy
15541 (abbreviate-file-name
15542 (concat (speedbar-line-directory indent
) token
"/"))
15543 (1+ indent
) speedbar-power-click
)))
15544 (vhdl-speedbar-update-current-unit t t
))
15545 ((string-match "-" text
) ; we have to contract this node
15546 (speedbar-reset-scanners)
15547 (let ((oldl speedbar-shown-directories
)
15549 (td (expand-file-name
15550 (concat (speedbar-line-directory indent
) token
))))
15552 (if (not (string-match (concat "^" (regexp-quote td
)) (car oldl
)))
15553 (push (car oldl
) newl
))
15554 (setq oldl
(cdr oldl
)))
15555 (setq speedbar-shown-directories
(nreverse newl
)))
15556 (speedbar-change-expand-button-char ?
+)
15557 (speedbar-delete-subblock indent
))
15558 (t (error "Nothing to display")))
15559 (when (equal (selected-frame) speedbar-frame
)
15560 (speedbar-center-buffer-smartly)))
15562 (declare-function speedbar-files-item-info
"speedbar" ())
15564 (defun vhdl-speedbar-item-info ()
15565 "Derive and display information about this line item."
15567 (beginning-of-line)
15568 ;; skip invisible number info
15569 (when (looking-at "^[0-9]+:") (goto-char (match-end 0)))
15571 ;; project/directory entry
15572 ((looking-at "\\s-*<[-+?]>\\s-+\\([^\n]+\\)$")
15573 (if vhdl-speedbar-show-projects
15574 (message "Project \"%s\"" (match-string-no-properties 1))
15575 (speedbar-files-item-info)))
15576 ;; design unit entry
15577 ((looking-at "\\(\\s-*\\([[{][-+?][]}]\\|[| -]*>\\) \\)\"?\\w")
15578 (goto-char (match-end 1))
15579 (let ((face (get-text-property (point) 'face
)))
15581 "%s \"%s\" in \"%s\""
15582 ;; design unit kind
15583 (cond ((or (eq face
'vhdl-speedbar-entity-face
)
15584 (eq face
'vhdl-speedbar-entity-selected-face
))
15585 (if (equal (match-string 2) ">") "Component" "Entity"))
15586 ((or (eq face
'vhdl-speedbar-architecture-face
)
15587 (eq face
'vhdl-speedbar-architecture-selected-face
))
15589 ((or (eq face
'vhdl-speedbar-configuration-face
)
15590 (eq face
'vhdl-speedbar-configuration-selected-face
))
15592 ((or (eq face
'vhdl-speedbar-package-face
)
15593 (eq face
'vhdl-speedbar-package-selected-face
))
15595 ((or (eq face
'vhdl-speedbar-instantiation-face
)
15596 (eq face
'vhdl-speedbar-instantiation-selected-face
))
15598 ((eq face
'vhdl-speedbar-subprogram-face
)
15601 ;; design unit name
15602 (buffer-substring-no-properties
15603 (progn (looking-at "\"?\\(\\(\\w\\|_\\)+\\)\"?") (match-beginning 1))
15606 (file-relative-name
15607 (or (car (get-text-property (point) 'speedbar-token
))
15609 (vhdl-default-directory)))))
15610 (t (message "")))))
15612 (declare-function speedbar-line-text
"speedbar" (&optional p
))
15614 (defun vhdl-speedbar-line-text ()
15615 "Calls `speedbar-line-text' and removes text properties."
15616 (let ((string (speedbar-line-text)))
15617 (set-text-properties 0 (length string
) nil string
)
15620 (defun vhdl-speedbar-higher-text ()
15621 "Get speedbar-line-text of higher level."
15622 (let (depth string
)
15624 (beginning-of-line)
15625 (looking-at "^\\([0-9]+\\):")
15626 (setq depth
(string-to-number (match-string 1)))
15627 (when (re-search-backward (format "^%d: *[[<{][-+?][]>}] \\([^ \n]+\\)" (1- depth
)) nil t
)
15628 (setq string
(match-string 1))
15629 (set-text-properties 0 (length string
) nil string
)
15632 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15635 (defun vhdl-speedbar-line-key (&optional indent
)
15636 "Get currently displayed directory of project name."
15637 (if vhdl-speedbar-show-projects
15638 (vhdl-speedbar-line-project)
15639 (abbreviate-file-name
15640 (file-name-as-directory (speedbar-line-directory indent
)))))
15642 (defun vhdl-speedbar-line-project (&optional indent
)
15643 "Get currently displayed project name."
15644 (and vhdl-speedbar-show-projects
15647 (re-search-backward "^[0-9]+:\\s-*<[-+?]>\\s-+\\([^\n]+\\)$" nil t
)
15648 (match-string-no-properties 1))))
15650 (defun vhdl-add-modified-file ()
15651 "Add file to `vhdl-modified-file-list'."
15652 (when vhdl-file-alist
15653 (add-to-list 'vhdl-modified-file-list
(buffer-file-name)))
15656 (defun vhdl-resolve-paths (path-list)
15657 "Resolve path wildcards in PATH-LIST."
15658 (let (path-list-1 path-list-2 path-beg path-end dir
)
15659 ;; eliminate non-existent directories
15661 (setq dir
(car path-list
))
15662 (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)" dir
)
15663 (if (file-directory-p (match-string 2 dir
))
15664 (push dir path-list-1
)
15665 (vhdl-warning-when-idle "No such directory: \"%s\"" (match-string 2 dir
)))
15666 (setq path-list
(cdr path-list
)))
15667 ;; resolve path wildcards
15669 (setq dir
(car path-list-1
))
15670 (if (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)\\([^/\\]*[?*][^/\\]*\\)\\([/\\].*\\)" dir
)
15672 (setq path-beg
(match-string 1 dir
)
15673 path-end
(match-string 5 dir
))
15678 (lambda (var) (concat path-beg var path-end
)))
15679 (let ((all-list (vhdl-directory-files
15680 (match-string 2 dir
) t
15681 (concat "\\<" (wildcard-to-regexp
15682 (match-string 4 dir
)))))
15685 (when (file-directory-p (car all-list
))
15686 (push (car all-list
) dir-list
))
15687 (setq all-list
(cdr all-list
)))
15689 (cdr path-list-1
))))
15690 (string-match "\\(-r \\)?\\(.*\\)[/\\].*" dir
)
15691 (when (file-directory-p (match-string 2 dir
))
15692 (push dir path-list-2
))
15693 (setq path-list-1
(cdr path-list-1
))))
15694 (nreverse path-list-2
)))
15696 (defun vhdl-speedbar-goto-this-unit (directory unit
)
15697 "If UNIT is displayed in DIRECTORY, goto this line and return t, else nil."
15698 (let ((dest (point)))
15699 (if (and (if vhdl-speedbar-show-projects
15700 (progn (goto-char (point-min)) t
)
15701 (speedbar-goto-this-file directory
))
15702 (re-search-forward (concat "[]}] " unit
"\\>") nil t
))
15703 (progn (speedbar-position-cursor-on-line)
15708 (declare-function speedbar-find-file-in-frame
"speedbar" (file))
15709 (declare-function speedbar-set-timer
"speedbar" (timeout))
15710 ;; speedbar loads dframe at runtime.
15711 (declare-function dframe-maybee-jump-to-attached-frame
"dframe" ())
15713 (defun vhdl-speedbar-find-file (text token indent
)
15714 "When user clicks on TEXT, load file with name and position in TOKEN.
15715 Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file
15716 is already shown in a buffer."
15717 (if (not (car token
))
15718 (error "ERROR: File cannot be found")
15719 (let ((buffer (get-file-buffer (car token
))))
15720 (speedbar-find-file-in-frame (car token
))
15721 (when (or vhdl-speedbar-jump-to-unit buffer
)
15722 (goto-char (point-min))
15723 (forward-line (1- (cdr token
)))
15725 (vhdl-speedbar-update-current-unit t t
)
15726 (speedbar-set-timer dframe-update-speed
)
15727 (dframe-maybee-jump-to-attached-frame))))
15729 (defun vhdl-speedbar-port-copy ()
15730 "Copy the port of the entity/component or subprogram under the cursor."
15732 (let ((is-entity (vhdl-speedbar-check-unit 'entity
)))
15733 (if (not (or is-entity
(vhdl-speedbar-check-unit 'subprogram
)))
15734 (error "ERROR: No entity/component or subprogram under cursor")
15735 (beginning-of-line)
15736 (if (looking-at "\\([0-9]\\)+:\\s-*\\(\\[[-+?]\\]\\|>\\) \\(\\(\\w\\|\\s_\\)+\\)")
15737 (condition-case info
15738 (let ((token (get-text-property
15739 (match-beginning 3) 'speedbar-token
)))
15740 (vhdl-visit-file (car token
) t
15741 (progn (goto-char (point-min))
15742 (forward-line (1- (cdr token
)))
15746 (vhdl-subprog-copy)))))
15747 (error (error "ERROR: %s not scanned successfully\n (%s)"
15748 (if is-entity
"Port" "Interface") (cadr info
))))
15749 (error "ERROR: No entity/component or subprogram on current line")))))
15751 (defun vhdl-speedbar-place-component ()
15752 "Place the entity/component under the cursor as component."
15754 (if (not (vhdl-speedbar-check-unit 'entity
))
15755 (error "ERROR: No entity/component under cursor")
15756 (vhdl-speedbar-port-copy)
15757 (if (fboundp 'speedbar-select-attached-frame
)
15758 (speedbar-select-attached-frame)
15759 (select-frame speedbar-attached-frame
))
15760 (vhdl-compose-place-component)
15761 (select-frame speedbar-frame
)))
15763 (defun vhdl-speedbar-configuration ()
15764 "Generate configuration for the architecture under the cursor."
15766 (if (not (vhdl-speedbar-check-unit 'architecture
))
15767 (error "ERROR: No architecture under cursor")
15768 (let ((arch-name (vhdl-speedbar-line-text))
15769 (ent-name (vhdl-speedbar-higher-text)))
15770 (if (fboundp 'speedbar-select-attached-frame
)
15771 (speedbar-select-attached-frame)
15772 (select-frame speedbar-attached-frame
))
15773 (vhdl-compose-configuration ent-name arch-name
))))
15775 (defun vhdl-speedbar-select-mra ()
15776 "Select the architecture under the cursor as MRA."
15778 (if (not (vhdl-speedbar-check-unit 'architecture
))
15779 (error "ERROR: No architecture under cursor")
15780 (let* ((arch-key (downcase (vhdl-speedbar-line-text)))
15781 (ent-key (downcase (vhdl-speedbar-higher-text)))
15782 (ent-alist (aget vhdl-entity-alist
15783 (or (vhdl-project-p) default-directory
) t
))
15784 (ent-entry (aget ent-alist ent-key t
)))
15785 (setcar (cddr (cddr ent-entry
)) arch-key
) ; (nth 4 ent-entry)
15786 (speedbar-refresh))))
15788 (declare-function speedbar-line-file
"speedbar" (&optional p
))
15790 (defun vhdl-speedbar-make-design ()
15791 "Make (compile) design unit or directory/project under the cursor."
15793 (if (not (save-excursion (beginning-of-line)
15794 (looking-at "[0-9]+: *\\(\\(\\[\\)\\|<\\)")))
15795 (error "ERROR: No primary design unit or directory/project under cursor")
15796 (let ((is-unit (match-string 2))
15797 (unit-name (vhdl-speedbar-line-text))
15798 (vhdl-project (vhdl-speedbar-line-project))
15799 (directory (file-name-as-directory
15800 (or (speedbar-line-file) (speedbar-line-directory)))))
15801 (if (fboundp 'speedbar-select-attached-frame
)
15802 (speedbar-select-attached-frame)
15803 (select-frame speedbar-attached-frame
))
15804 (let ((default-directory directory
))
15805 (vhdl-make (and is-unit unit-name
))))))
15807 (defun vhdl-speedbar-generate-makefile ()
15808 "Generate Makefile for directory/project under the cursor."
15810 (let ((vhdl-project (vhdl-speedbar-line-project))
15811 (default-directory (file-name-as-directory
15812 (or (speedbar-line-file) (speedbar-line-directory)))))
15813 (vhdl-generate-makefile)))
15815 (defun vhdl-speedbar-check-unit (design-unit)
15816 "Check whether design unit under cursor corresponds to DESIGN-UNIT (or its
15817 expansion function)."
15819 (speedbar-position-cursor-on-line)
15820 (cond ((eq design-unit
'entity
)
15821 (memq (get-text-property (match-end 0) 'face
)
15822 '(vhdl-speedbar-entity-face
15823 vhdl-speedbar-entity-selected-face
)))
15824 ((eq design-unit
'architecture
)
15825 (memq (get-text-property (match-end 0) 'face
)
15826 '(vhdl-speedbar-architecture-face
15827 vhdl-speedbar-architecture-selected-face
)))
15828 ((eq design-unit
'subprogram
)
15829 (eq (get-text-property (match-end 0) 'face
)
15830 'vhdl-speedbar-subprogram-face
))
15833 (defun vhdl-speedbar-set-depth (depth)
15834 "Set hierarchy display depth to DEPTH and refresh speedbar."
15835 (setq vhdl-speedbar-hierarchy-depth depth
)
15836 (speedbar-refresh))
15838 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15841 (defface vhdl-speedbar-entity-face
15842 '((((class color
) (background light
)) (:foreground
"ForestGreen"))
15843 (((class color
) (background dark
)) (:foreground
"PaleGreen")))
15844 "Face used for displaying entity names."
15845 :group
'speedbar-faces
)
15847 (defface vhdl-speedbar-architecture-face
15848 '((((min-colors 88) (class color
) (background light
)) (:foreground
"Blue1"))
15849 (((class color
) (background light
)) (:foreground
"Blue"))
15851 (((class color
) (background dark
)) (:foreground
"LightSkyBlue")))
15852 "Face used for displaying architecture names."
15853 :group
'speedbar-faces
)
15855 (defface vhdl-speedbar-configuration-face
15856 '((((class color
) (background light
)) (:foreground
"DarkGoldenrod"))
15857 (((class color
) (background dark
)) (:foreground
"Salmon")))
15858 "Face used for displaying configuration names."
15859 :group
'speedbar-faces
)
15861 (defface vhdl-speedbar-package-face
15862 '((((class color
) (background light
)) (:foreground
"Grey50"))
15863 (((class color
) (background dark
)) (:foreground
"Grey80")))
15864 "Face used for displaying package names."
15865 :group
'speedbar-faces
)
15867 (defface vhdl-speedbar-library-face
15868 '((((class color
) (background light
)) (:foreground
"Purple"))
15869 (((class color
) (background dark
)) (:foreground
"Orchid1")))
15870 "Face used for displaying library names."
15871 :group
'speedbar-faces
)
15873 (defface vhdl-speedbar-instantiation-face
15874 '((((class color
) (background light
)) (:foreground
"Brown"))
15875 (((min-colors 88) (class color
) (background dark
)) (:foreground
"Yellow1"))
15876 (((class color
) (background dark
)) (:foreground
"Yellow")))
15877 "Face used for displaying instantiation names."
15878 :group
'speedbar-faces
)
15880 (defface vhdl-speedbar-subprogram-face
15881 '((((class color
) (background light
)) (:foreground
"Orchid4"))
15882 (((class color
) (background dark
)) (:foreground
"BurlyWood2")))
15883 "Face used for displaying subprogram names."
15884 :group
'speedbar-faces
)
15886 (defface vhdl-speedbar-entity-selected-face
15887 '((((class color
) (background light
)) (:foreground
"ForestGreen" :underline t
))
15888 (((class color
) (background dark
)) (:foreground
"PaleGreen" :underline t
)))
15889 "Face used for displaying entity names."
15890 :group
'speedbar-faces
)
15892 (defface vhdl-speedbar-architecture-selected-face
15893 '((((min-colors 88) (class color
) (background light
)) (:foreground
15894 "Blue1" :underline t
))
15895 (((class color
) (background light
)) (:foreground
"Blue" :underline t
))
15896 (((class color
) (background dark
)) (:foreground
"LightSkyBlue" :underline t
)))
15897 "Face used for displaying architecture names."
15898 :group
'speedbar-faces
)
15900 (defface vhdl-speedbar-configuration-selected-face
15901 '((((class color
) (background light
)) (:foreground
"DarkGoldenrod" :underline t
))
15902 (((class color
) (background dark
)) (:foreground
"Salmon" :underline t
)))
15903 "Face used for displaying configuration names."
15904 :group
'speedbar-faces
)
15906 (defface vhdl-speedbar-package-selected-face
15907 '((((class color
) (background light
)) (:foreground
"Grey50" :underline t
))
15908 (((class color
) (background dark
)) (:foreground
"Grey80" :underline t
)))
15909 "Face used for displaying package names."
15910 :group
'speedbar-faces
)
15912 (defface vhdl-speedbar-instantiation-selected-face
15913 '((((class color
) (background light
)) (:foreground
"Brown" :underline t
))
15914 (((class color
) (background dark
)) (:foreground
"Yellow" :underline t
)))
15915 "Face used for displaying instantiation names."
15916 :group
'speedbar-faces
)
15918 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15922 (when (fboundp 'speedbar
)
15923 (let ((current-frame (selected-frame)))
15925 (when (and vhdl-speedbar-auto-open
15926 (not (and (boundp 'speedbar-frame
)
15927 (frame-live-p speedbar-frame
))))
15928 (speedbar-frame-mode 1))
15929 (error (vhdl-warning-when-idle "ERROR: An error occurred while opening speedbar")))
15930 (select-frame current-frame
)))
15932 ;; initialize speedbar
15933 (if (not (boundp 'speedbar-frame
))
15934 (add-hook 'speedbar-load-hook
'vhdl-speedbar-initialize
)
15935 (vhdl-speedbar-initialize)
15936 (when speedbar-frame
(vhdl-speedbar-refresh)))
15939 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15940 ;;; Structural composition
15941 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15943 (defun vhdl-get-components-package-name ()
15944 "Return the name of the components package."
15945 (let ((project (vhdl-project-p)))
15947 (vhdl-replace-string (car vhdl-components-package-name
)
15948 (subst-char-in-string ? ?_ project
))
15949 (cdr vhdl-components-package-name
))))
15951 (defun vhdl-compose-new-component ()
15952 "Create entity and architecture for new component."
15954 (let* ((case-fold-search t
)
15955 (ent-name (read-from-minibuffer "entity name: "
15956 nil vhdl-minibuffer-local-map
))
15958 (if (equal (cdr vhdl-compose-architecture-name
) "")
15959 (read-from-minibuffer "architecture name: "
15960 nil vhdl-minibuffer-local-map
)
15961 (vhdl-replace-string vhdl-compose-architecture-name ent-name
)))
15962 ent-file-name arch-file-name ent-buffer arch-buffer project end-pos
)
15963 (message "Creating component \"%s(%s)\"..." ent-name arch-name
)
15964 ;; open entity file
15965 (unless (eq vhdl-compose-create-files
'none
)
15966 (setq ent-file-name
15967 (concat (vhdl-replace-string vhdl-entity-file-name ent-name t
)
15968 "." (file-name-extension (buffer-file-name))))
15969 (when (and (file-exists-p ent-file-name
)
15970 (not (y-or-n-p (concat "File \"" ent-file-name
15971 "\" exists; overwrite? "))))
15972 (error "ERROR: Creating component...aborted"))
15973 (find-file ent-file-name
)
15975 (set-buffer-modified-p nil
))
15977 (if vhdl-compose-include-header
15978 (progn (vhdl-template-header)
15979 (setq end-pos
(point))
15980 (goto-char (point-max)))
15981 (vhdl-comment-display-line) (insert "\n\n"))
15982 ;; insert library clause
15983 (vhdl-template-package-std-logic-1164)
15984 (when vhdl-use-components-package
15986 (vhdl-template-standard-package (vhdl-work-library)
15987 (vhdl-get-components-package-name)))
15988 (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n")
15989 ;; insert entity declaration
15990 (vhdl-insert-keyword "ENTITY ") (insert ent-name
)
15991 (vhdl-insert-keyword " IS\n")
15992 (when (memq vhdl-insert-empty-lines
'(unit all
)) (insert "\n"))
15993 (indent-to vhdl-basic-offset
) (vhdl-insert-keyword "GENERIC (\n")
15994 (indent-to (* 2 vhdl-basic-offset
)) (insert ");\n")
15995 (when (memq vhdl-insert-empty-lines
'(unit all
)) (insert "\n"))
15996 (indent-to vhdl-basic-offset
) (vhdl-insert-keyword "PORT (\n")
15997 (indent-to (* 2 vhdl-basic-offset
)) (insert ");\n")
15998 (when (memq vhdl-insert-empty-lines
'(unit all
)) (insert "\n"))
15999 (vhdl-insert-keyword "END ")
16000 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
16001 (insert ent-name
";\n\n")
16002 (vhdl-comment-display-line) (insert "\n")
16003 ;; open architecture file
16004 (if (not (eq vhdl-compose-create-files
'separate
))
16006 (goto-char (or end-pos
(point-min)))
16007 (setq ent-buffer
(current-buffer))
16008 (setq arch-file-name
16009 (concat (vhdl-replace-string vhdl-architecture-file-name
16010 (concat ent-name
" " arch-name
) t
)
16011 "." (file-name-extension (buffer-file-name))))
16012 (when (and (file-exists-p arch-file-name
)
16013 (not (y-or-n-p (concat "File \"" arch-file-name
16014 "\" exists; overwrite? "))))
16015 (error "ERROR: Creating component...aborted"))
16016 (find-file arch-file-name
)
16018 (set-buffer-modified-p nil
)
16020 (if vhdl-compose-include-header
16021 (progn (vhdl-template-header)
16022 (goto-char (point-max)))
16023 (vhdl-comment-display-line) (insert "\n\n")))
16024 ;; insert architecture body
16025 (vhdl-insert-keyword "ARCHITECTURE ") (insert arch-name
)
16026 (vhdl-insert-keyword " OF ") (insert ent-name
)
16027 (vhdl-insert-keyword " IS\n\n")
16028 (indent-to vhdl-basic-offset
) (vhdl-comment-display-line) (insert "\n")
16029 (indent-to vhdl-basic-offset
) (insert "-- Internal signal declarations\n")
16030 (indent-to vhdl-basic-offset
) (vhdl-comment-display-line) (insert "\n\n")
16031 (unless (or vhdl-use-components-package
(vhdl-use-direct-instantiation))
16032 (indent-to vhdl-basic-offset
) (vhdl-comment-display-line) (insert "\n")
16033 (indent-to vhdl-basic-offset
) (insert "-- Component declarations\n")
16034 (indent-to vhdl-basic-offset
) (vhdl-comment-display-line) (insert "\n\n"))
16035 (vhdl-insert-keyword "BEGIN")
16036 (when vhdl-self-insert-comments
16038 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE "))
16039 (insert arch-name
))
16041 (indent-to vhdl-basic-offset
) (vhdl-comment-display-line) (insert "\n")
16042 (indent-to vhdl-basic-offset
) (insert "-- Component instantiations\n")
16043 (indent-to vhdl-basic-offset
) (vhdl-comment-display-line) (insert "\n\n")
16044 (vhdl-insert-keyword "END ")
16045 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE "))
16046 (insert arch-name
";\n\n")
16047 ;; insert footer and save
16048 (if (and vhdl-compose-include-header
(not (equal vhdl-file-footer
"")))
16049 (vhdl-template-footer)
16050 (vhdl-comment-display-line) (insert "\n"))
16051 (goto-char (or end-pos
(point-min)))
16052 (setq arch-buffer
(current-buffer))
16053 (when ent-buffer
(set-buffer ent-buffer
) (save-buffer))
16054 (set-buffer arch-buffer
) (save-buffer)
16056 (concat (format "Creating component \"%s(%s)\"...done" ent-name arch-name
)
16058 (format "\n File created: \"%s\"" ent-file-name
))
16059 (and arch-file-name
16060 (format "\n File created: \"%s\"" arch-file-name
))))))
16062 (defun vhdl-compose-place-component ()
16063 "Place new component by pasting current port as component declaration and
16064 component instantiation."
16066 (if (not vhdl-port-list
)
16067 (error "ERROR: No port has been read")
16069 (vhdl-prepare-search-2
16070 (unless (or (re-search-backward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t
)
16071 (re-search-forward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t
))
16072 (error "ERROR: No architecture found"))
16073 (let* ((ent-name (match-string 1))
16075 (concat (vhdl-replace-string vhdl-entity-file-name ent-name t
)
16076 "." (file-name-extension (buffer-file-name))))
16077 (orig-buffer (current-buffer)))
16078 (message "Placing component \"%s\"..." (nth 0 vhdl-port-list
))
16079 ;; place component declaration
16080 (unless (or vhdl-use-components-package
16081 (vhdl-use-direct-instantiation)
16084 (concat "^\\s-*component\\s-+"
16085 (car vhdl-port-list
) "\\>") nil t
)))
16086 (re-search-forward "^begin\\>" nil
)
16087 (beginning-of-line)
16088 (skip-chars-backward " \t\n\r\f")
16089 (insert "\n\n") (indent-to vhdl-basic-offset
)
16090 (vhdl-port-paste-component t
))
16091 ;; place component instantiation
16092 (re-search-forward "^end\\>" nil
)
16093 (beginning-of-line)
16094 (skip-chars-backward " \t\n\r\f")
16095 (insert "\n\n") (indent-to vhdl-basic-offset
)
16096 (vhdl-port-paste-instance nil t t
)
16097 ;; place use clause for used packages
16098 (when (nth 3 vhdl-port-list
)
16099 ;; open entity file
16100 (when (file-exists-p ent-file-name
)
16101 (find-file ent-file-name
))
16102 (goto-char (point-min))
16103 (unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name
"[ \t\n\r\f]+is\\>") nil t
)
16104 (error "ERROR: Entity not found: \"%s\"" ent-name
))
16105 (goto-char (match-beginning 0))
16106 (if (and (save-excursion
16107 (re-search-backward "^\\(library\\|use\\)\\|end\\>" nil t
))
16109 (progn (goto-char (match-end 0))
16110 (beginning-of-line 2))
16113 (vhdl-port-paste-context-clause)
16114 (switch-to-buffer orig-buffer
))
16115 (message "Placing component \"%s\"...done" (nth 0 vhdl-port-list
)))))))
16117 (defun vhdl-compose-wire-components ()
16118 "Connect components."
16121 (vhdl-prepare-search-2
16122 (unless (or (re-search-backward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t
)
16123 (re-search-forward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t
))
16124 (error "ERROR: No architecture found"))
16125 (let* ((ent-name (match-string 1))
16127 (concat (vhdl-replace-string vhdl-entity-file-name ent-name t
)
16128 "." (file-name-extension (buffer-file-name))))
16129 (arch-decl-pos (point-marker))
16130 (arch-stat-pos (re-search-forward "^begin\\>" nil
))
16131 (arch-end-pos (re-search-forward "^end\\>" nil
))
16132 (pack-name (vhdl-get-components-package-name))
16134 (concat (vhdl-replace-string vhdl-package-file-name pack-name t
)
16135 "." (file-name-extension (buffer-file-name))))
16136 inst-name comp-name comp-ent-name comp-ent-file-name has-generic
16137 port-alist generic-alist inst-alist
16138 signal-name signal-entry signal-alist local-list written-list
16139 single-in-list multi-in-list single-out-list multi-out-list
16140 constant-name constant-entry constant-alist single-list multi-list
16141 port-beg-pos port-in-pos port-out-pos port-inst-pos port-end-pos
16142 generic-beg-pos generic-pos generic-inst-pos generic-end-pos
16143 signal-beg-pos signal-pos
16144 constant-temp-pos port-temp-pos signal-temp-pos
)
16145 (message "Wiring components...")
16146 ;; process all instances
16147 (goto-char arch-stat-pos
)
16148 (while (re-search-forward
16149 (concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\("
16150 "\\(component[ \t\n\r\f]+\\)?\\(\\w+\\)"
16151 "[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n\r\f]+map\\|"
16152 "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?"
16153 "[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n\r\f]+map\\)[ \t\n\r\f]*(") arch-end-pos t
)
16154 (setq inst-name
(match-string-no-properties 1)
16155 comp-name
(match-string-no-properties 4)
16156 comp-ent-name
(match-string-no-properties 12)
16157 has-generic
(or (match-string 7) (match-string 17)))
16160 ;; ... from component declaration
16162 (when vhdl-use-components-package pack-file-name
) t
16164 (goto-char (point-min))
16165 (unless (re-search-forward (concat "^\\s-*component[ \t\n\r\f]+" comp-name
"\\>") nil t
)
16166 (error "ERROR: Component declaration not found: \"%s\"" comp-name
))
16168 ;; ... from entity declaration (direct instantiation)
16169 (setq comp-ent-file-name
16170 (concat (vhdl-replace-string vhdl-entity-file-name comp-ent-name t
)
16171 "." (file-name-extension (buffer-file-name))))
16173 comp-ent-file-name t
16175 (goto-char (point-min))
16176 (unless (re-search-forward (concat "^\\s-*entity[ \t\n\r\f]+" comp-ent-name
"\\>") nil t
)
16177 (error "ERROR: Entity declaration not found: \"%s\"" comp-ent-name
))
16178 (vhdl-port-copy))))
16179 (vhdl-port-flatten t
)
16180 (setq generic-alist
(nth 1 vhdl-port-list
)
16181 port-alist
(nth 2 vhdl-port-list
)
16182 vhdl-port-list nil
)
16183 (setq constant-alist nil
16186 ;; process all constants in generic map
16187 (vhdl-forward-syntactic-ws)
16188 (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t
)
16189 (setq constant-name
(match-string-no-properties 3))
16190 (setq constant-entry
16191 (cons constant-name
16192 (if (match-string 1)
16193 (or (aget generic-alist
(match-string 2) t
)
16194 (error "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name
))
16195 (cdar generic-alist
))))
16196 (push constant-entry constant-alist
)
16197 (setq constant-name
(downcase constant-name
))
16198 (if (or (member constant-name single-list
)
16199 (member constant-name multi-list
))
16200 (progn (setq single-list
(delete constant-name single-list
))
16201 (add-to-list 'multi-list constant-name
))
16202 (add-to-list 'single-list constant-name
))
16203 (unless (match-string 1)
16204 (setq generic-alist
(cdr generic-alist
)))
16205 (vhdl-forward-syntactic-ws))
16206 (vhdl-re-search-forward "\\<port\\s-+map[ \t\n\r\f]*(" nil t
))
16207 ;; process all signals in port map
16208 (vhdl-forward-syntactic-ws)
16209 (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t
)
16210 (setq signal-name
(match-string-no-properties 3))
16211 (setq signal-entry
(cons signal-name
16212 (if (match-string 1)
16213 (or (aget port-alist
(match-string 2) t
)
16214 (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name
))
16215 (cdar port-alist
))))
16216 (push signal-entry signal-alist
)
16217 (setq signal-name
(downcase signal-name
))
16218 (if (equal (upcase (nth 2 signal-entry
)) "IN")
16221 ((member signal-name local-list
)
16223 ((or (member signal-name single-out-list
)
16224 (member signal-name multi-out-list
))
16225 (setq single-out-list
(delete signal-name single-out-list
))
16226 (setq multi-out-list
(delete signal-name multi-out-list
))
16227 (add-to-list 'local-list signal-name
))
16228 ((member signal-name single-in-list
)
16229 (setq single-in-list
(delete signal-name single-in-list
))
16230 (add-to-list 'multi-in-list signal-name
))
16231 ((not (member signal-name multi-in-list
))
16232 (add-to-list 'single-in-list signal-name
)))
16235 ((member signal-name local-list
)
16237 ((or (member signal-name single-in-list
)
16238 (member signal-name multi-in-list
))
16239 (setq single-in-list
(delete signal-name single-in-list
))
16240 (setq multi-in-list
(delete signal-name multi-in-list
))
16241 (add-to-list 'local-list signal-name
))
16242 ((member signal-name single-out-list
)
16243 (setq single-out-list
(delete signal-name single-out-list
))
16244 (add-to-list 'multi-out-list signal-name
))
16245 ((not (member signal-name multi-out-list
))
16246 (add-to-list 'single-out-list signal-name
))))
16247 (unless (match-string 1)
16248 (setq port-alist
(cdr port-alist
)))
16249 (vhdl-forward-syntactic-ws))
16250 (push (list inst-name
(nreverse constant-alist
)
16251 (nreverse signal-alist
)) inst-alist
))
16252 ;; prepare signal insertion
16253 (vhdl-goto-marker arch-decl-pos
)
16255 (re-search-forward "^\\s-*-- Internal signal declarations[ \t\n\r\f]*-*\n" arch-stat-pos t
)
16256 (setq signal-pos
(point-marker))
16257 (while (progn (vhdl-forward-syntactic-ws)
16258 (looking-at "signal\\>"))
16259 (beginning-of-line 2)
16260 (delete-region signal-pos
(point)))
16261 (setq signal-beg-pos signal-pos
)
16262 ;; open entity file
16263 (when (file-exists-p ent-file-name
)
16264 (find-file ent-file-name
))
16265 (goto-char (point-min))
16266 (unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name
"[ \t\n\r\f]+is\\>") nil t
)
16267 (error "ERROR: Entity not found: \"%s\"" ent-name
))
16268 ;; prepare generic clause insertion
16269 (unless (and (re-search-forward "\\(^\\s-*generic[ \t\n\r\f]*(\\)\\|^end\\>" nil t
)
16271 (goto-char (match-beginning 0))
16272 (indent-to vhdl-basic-offset
)
16273 (insert "generic ();\n\n")
16276 (setq generic-pos
(point-marker))
16277 (forward-sexp) (end-of-line)
16278 (delete-region generic-pos
(point)) (delete-char 1)
16282 (indent-to (* 2 vhdl-basic-offset
))
16283 (insert "-- global generics\n"))
16284 (setq generic-beg-pos
(point-marker) generic-pos
(point-marker)
16285 generic-inst-pos
(point-marker) generic-end-pos
(point-marker))
16286 ;; prepare port clause insertion
16287 (unless (and (re-search-forward "\\(^\\s-*port[ \t\n\r\f]*(\\)\\|^end\\>" nil t
)
16289 (goto-char (match-beginning 0))
16290 (indent-to vhdl-basic-offset
)
16291 (insert "port ();\n\n")
16294 (setq port-in-pos
(point-marker))
16295 (forward-sexp) (end-of-line)
16296 (delete-region port-in-pos
(point)) (delete-char 1)
16298 (when (or multi-in-list multi-out-list
)
16300 (indent-to (* 2 vhdl-basic-offset
))
16301 (insert "-- global ports\n"))
16302 (setq port-beg-pos
(point-marker) port-in-pos
(point-marker)
16303 port-out-pos
(point-marker) port-inst-pos
(point-marker)
16304 port-end-pos
(point-marker))
16305 ;; insert generics, ports and signals
16306 (setq inst-alist
(nreverse inst-alist
))
16308 (setq inst-name
(nth 0 (car inst-alist
))
16309 constant-alist
(nth 1 (car inst-alist
))
16310 signal-alist
(nth 2 (car inst-alist
))
16311 constant-temp-pos generic-inst-pos
16312 port-temp-pos port-inst-pos
16313 signal-temp-pos signal-pos
)
16315 (while constant-alist
16316 (setq constant-name
(downcase (caar constant-alist
))
16317 constant-entry
(car constant-alist
))
16318 (unless (string-match "^[0-9]+" constant-name
)
16319 (cond ((member constant-name written-list
)
16321 ((member constant-name multi-list
)
16322 (vhdl-goto-marker generic-pos
)
16323 (setq generic-end-pos
16326 (vhdl-compose-insert-generic constant-entry
)))
16327 (setq generic-pos
(point-marker))
16328 (add-to-list 'written-list constant-name
))
16331 (vhdl-max-marker generic-inst-pos generic-pos
))
16332 (setq generic-end-pos
16333 (vhdl-compose-insert-generic constant-entry
))
16334 (setq generic-inst-pos
(point-marker))
16335 (add-to-list 'written-list constant-name
))))
16336 (setq constant-alist
(cdr constant-alist
)))
16337 (when (/= constant-temp-pos generic-inst-pos
)
16338 (vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos
))
16339 (insert "\n") (indent-to (* 2 vhdl-basic-offset
))
16340 (insert "-- generics for \"" inst-name
"\"\n")
16341 (vhdl-goto-marker generic-inst-pos
))
16342 ;; ports and signals
16343 (while signal-alist
16344 (setq signal-name
(downcase (caar signal-alist
))
16345 signal-entry
(car signal-alist
))
16346 (cond ((member signal-name written-list
)
16348 ((member signal-name multi-in-list
)
16349 (vhdl-goto-marker port-in-pos
)
16352 port-end-pos
(vhdl-compose-insert-port signal-entry
)))
16353 (setq port-in-pos
(point-marker))
16354 (add-to-list 'written-list signal-name
))
16355 ((member signal-name multi-out-list
)
16356 (vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos
))
16359 port-end-pos
(vhdl-compose-insert-port signal-entry
)))
16360 (setq port-out-pos
(point-marker))
16361 (add-to-list 'written-list signal-name
))
16362 ((or (member signal-name single-in-list
)
16363 (member signal-name single-out-list
))
16367 (vhdl-max-marker port-out-pos port-in-pos
)))
16368 (setq port-end-pos
(vhdl-compose-insert-port signal-entry
))
16369 (setq port-inst-pos
(point-marker))
16370 (add-to-list 'written-list signal-name
))
16371 ((equal (upcase (nth 2 signal-entry
)) "OUT")
16372 (vhdl-goto-marker signal-pos
)
16373 (vhdl-compose-insert-signal signal-entry
)
16374 (setq signal-pos
(point-marker))
16375 (add-to-list 'written-list signal-name
)))
16376 (setq signal-alist
(cdr signal-alist
)))
16377 (when (/= port-temp-pos port-inst-pos
)
16379 (vhdl-max-marker port-temp-pos
16380 (vhdl-max-marker port-in-pos port-out-pos
)))
16381 (insert "\n") (indent-to (* 2 vhdl-basic-offset
))
16382 (insert "-- ports to \"" inst-name
"\"\n")
16383 (vhdl-goto-marker port-inst-pos
))
16384 (when (/= signal-temp-pos signal-pos
)
16385 (vhdl-goto-marker signal-temp-pos
)
16386 (insert "\n") (indent-to vhdl-basic-offset
)
16387 (insert "-- outputs of \"" inst-name
"\"\n")
16388 (vhdl-goto-marker signal-pos
))
16389 (setq inst-alist
(cdr inst-alist
)))
16390 ;; finalize generic/port clause
16391 (vhdl-goto-marker generic-end-pos
) (backward-char)
16392 (when (= generic-beg-pos generic-end-pos
)
16393 (insert "\n") (indent-to (* 2 vhdl-basic-offset
))
16394 (insert ";") (backward-char))
16396 (vhdl-goto-marker port-end-pos
) (backward-char)
16397 (when (= port-beg-pos port-end-pos
)
16398 (insert "\n") (indent-to (* 2 vhdl-basic-offset
))
16399 (insert ";") (backward-char))
16401 ;; align everything
16402 (when vhdl-auto-align
16403 (vhdl-goto-marker generic-beg-pos
)
16404 (vhdl-align-region-groups generic-beg-pos generic-end-pos
1)
16405 (vhdl-align-region-groups port-beg-pos port-end-pos
1)
16406 (vhdl-goto-marker signal-beg-pos
)
16407 (vhdl-align-region-groups signal-beg-pos signal-pos
))
16408 (switch-to-buffer (marker-buffer signal-beg-pos
))
16409 (message "Wiring components...done")))))
16411 (defun vhdl-compose-insert-generic (entry)
16412 "Insert ENTRY as generic declaration."
16414 (indent-to (* 2 vhdl-basic-offset
))
16415 (insert (nth 0 entry
) " : " (nth 1 entry
))
16416 (when (nth 2 entry
)
16417 (insert " := " (nth 2 entry
)))
16419 (setq pos
(point-marker))
16420 (when (and vhdl-include-port-comments
(nth 3 entry
))
16421 (vhdl-comment-insert-inline (nth 3 entry
) t
))
16425 (defun vhdl-compose-insert-port (entry)
16426 "Insert ENTRY as port declaration."
16428 (indent-to (* 2 vhdl-basic-offset
))
16429 (insert (nth 0 entry
) " : " (nth 2 entry
) " " (nth 3 entry
) ";")
16430 (setq pos
(point-marker))
16431 (when (and vhdl-include-port-comments
(nth 4 entry
))
16432 (vhdl-comment-insert-inline (nth 4 entry
) t
))
16436 (defun vhdl-compose-insert-signal (entry)
16437 "Insert ENTRY as signal declaration."
16438 (indent-to vhdl-basic-offset
)
16439 (insert "signal " (nth 0 entry
) " : " (nth 3 entry
) ";")
16440 (when (and vhdl-include-port-comments
(nth 4 entry
))
16441 (vhdl-comment-insert-inline (nth 4 entry
) t
))
16444 (defun vhdl-compose-components-package ()
16445 "Generate a package containing component declarations for all entities in the
16446 current project/directory."
16448 (vhdl-require-hierarchy-info)
16449 (let* ((project (vhdl-project-p))
16450 (pack-name (vhdl-get-components-package-name))
16452 (concat (vhdl-replace-string vhdl-package-file-name pack-name t
)
16453 "." (file-name-extension (buffer-file-name))))
16454 (ent-alist (aget vhdl-entity-alist
16455 (or project default-directory
) t
))
16456 (lazy-lock-minimum-size 0)
16457 clause-pos component-pos
)
16458 (message "Generating components package \"%s\"..." pack-name
)
16459 ;; open package file
16460 (when (and (file-exists-p pack-file-name
)
16461 (not (y-or-n-p (concat "File \"" pack-file-name
16462 "\" exists; overwrite? "))))
16463 (error "ERROR: Generating components package...aborted"))
16464 (find-file pack-file-name
)
16467 (if vhdl-compose-include-header
16468 (progn (vhdl-template-header
16469 (concat "Components package (generated by Emacs VHDL Mode "
16471 (goto-char (point-max)))
16472 (vhdl-comment-display-line) (insert "\n\n"))
16473 ;; insert std_logic_1164 package
16474 (vhdl-template-package-std-logic-1164)
16475 (insert "\n") (setq clause-pos
(point-marker))
16476 (insert "\n") (vhdl-comment-display-line) (insert "\n\n")
16477 ;; insert package declaration
16478 (vhdl-insert-keyword "PACKAGE ") (insert pack-name
)
16479 (vhdl-insert-keyword " IS\n\n")
16480 (indent-to vhdl-basic-offset
) (vhdl-comment-display-line) (insert "\n")
16481 (indent-to vhdl-basic-offset
) (insert "-- Component declarations\n")
16482 (indent-to vhdl-basic-offset
) (vhdl-comment-display-line) (insert "\n\n")
16483 (indent-to vhdl-basic-offset
)
16484 (setq component-pos
(point-marker))
16485 (insert "\n\n") (vhdl-insert-keyword "END ")
16486 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "PACKAGE "))
16487 (insert pack-name
";\n\n")
16489 (if (and vhdl-compose-include-header
(not (equal vhdl-file-footer
"")))
16490 (vhdl-template-footer)
16491 (vhdl-comment-display-line) (insert "\n"))
16492 ;; insert component declarations
16494 (vhdl-visit-file (nth 2 (car ent-alist
)) nil
16495 (progn (goto-char (point-min))
16496 (forward-line (1- (nth 3 (car ent-alist
))))
16499 (goto-char component-pos
)
16500 (vhdl-port-paste-component t
)
16501 (when (cdr ent-alist
) (insert "\n\n") (indent-to vhdl-basic-offset
))
16502 (setq component-pos
(point-marker))
16503 (goto-char clause-pos
)
16504 (vhdl-port-paste-context-clause pack-name
)
16505 (setq clause-pos
(point-marker))
16506 (setq ent-alist
(cdr ent-alist
)))
16507 (goto-char (point-min))
16509 (message "Generating components package \"%s\"...done\n File created: \"%s\""
16510 pack-name pack-file-name
)))
16512 (defun vhdl-compose-configuration-architecture (ent-name arch-name ent-alist
16513 conf-alist inst-alist
16514 &optional insert-conf
)
16515 "Generate block configuration for architecture."
16516 (let ((margin (current-indentation))
16517 (beg (point-at-bol))
16518 ent-entry inst-entry inst-path inst-prev-path cons-key tmp-alist
)
16519 ;; insert block configuration (for architecture)
16520 (vhdl-insert-keyword "FOR ") (insert arch-name
"\n")
16521 (setq margin
(+ margin vhdl-basic-offset
))
16522 ;; process all instances
16524 (setq inst-entry
(car inst-alist
))
16526 (when (nth 4 inst-entry
)
16527 (setq insert-conf t
)
16528 (setq inst-path
(nth 9 inst-entry
))
16529 ;; skip common path with previous instance
16530 (while (and inst-path
(equal (car inst-path
) (car inst-prev-path
)))
16531 (setq inst-path
(cdr inst-path
)
16532 inst-prev-path
(cdr inst-prev-path
)))
16533 ;; insert block configuration end (for previous block/generate)
16534 (while inst-prev-path
16535 (setq margin
(- margin vhdl-basic-offset
))
16537 (vhdl-insert-keyword "END FOR;\n")
16538 (setq inst-prev-path
(cdr inst-prev-path
)))
16539 ;; insert block configuration beginning (for current block/generate)
16542 (setq margin
(+ margin vhdl-basic-offset
))
16543 (vhdl-insert-keyword "FOR ")
16544 (insert (car inst-path
) "\n")
16546 (setq inst-path
(cdr inst-path
)))
16547 ;; insert component configuration beginning
16548 (vhdl-insert-keyword "FOR ")
16549 (insert (nth 1 inst-entry
) " : " (nth 4 inst-entry
) "\n")
16550 ;; find subconfiguration
16551 (setq conf-key
(nth 7 inst-entry
))
16552 (setq tmp-alist conf-alist
)
16553 ;; use first configuration found for instance's entity
16554 (while (and tmp-alist
(null conf-key
))
16555 (when (equal (nth 5 inst-entry
) (nth 4 (car tmp-alist
)))
16556 (setq conf-key
(nth 0 (car tmp-alist
))))
16557 (setq tmp-alist
(cdr tmp-alist
)))
16558 (setq conf-entry
(aget conf-alist conf-key t
))
16559 ;; insert binding indication ...
16560 ;; ... with subconfiguration (if exists)
16561 (if (and vhdl-compose-configuration-use-subconfiguration conf-entry
)
16563 (indent-to (+ margin vhdl-basic-offset
))
16564 (vhdl-insert-keyword "USE CONFIGURATION ")
16565 (insert (vhdl-work-library) "." (nth 0 conf-entry
))
16567 ;; ... with entity (if exists)
16568 (setq ent-entry
(aget ent-alist
(nth 5 inst-entry
) t
))
16570 (indent-to (+ margin vhdl-basic-offset
))
16571 (vhdl-insert-keyword "USE ENTITY ")
16572 (insert (vhdl-work-library) "." (nth 0 ent-entry
))
16573 ;; insert architecture name (if architecture exists)
16574 (when (nth 3 ent-entry
)
16576 ;; choose architecture name a) from configuration,
16577 ;; b) from mra, or c) from first architecture
16578 (or (nth 0 (aget (nth 3 ent-entry
)
16579 (or (nth 6 inst-entry
)
16580 (nth 4 ent-entry
)) t
))
16581 (nth 1 (car (nth 3 ent-entry
)))))
16582 (insert "(" arch-name
")"))
16584 ;; insert block configuration (for architecture of subcomponent)
16585 (when (and vhdl-compose-configuration-hierarchical
16587 (indent-to (+ margin vhdl-basic-offset
))
16588 (vhdl-compose-configuration-architecture
16589 (nth 0 ent-entry
) arch-name ent-alist conf-alist
16590 (nth 3 (aget (nth 3 ent-entry
) (downcase arch-name
) t
))))))
16591 ;; insert component configuration end
16593 (vhdl-insert-keyword "END FOR;\n")
16594 (setq inst-prev-path
(nth 9 inst-entry
)))
16595 (setq inst-alist
(cdr inst-alist
)))
16596 ;; insert block configuration end (for block/generate)
16597 (while inst-prev-path
16598 (setq margin
(- margin vhdl-basic-offset
))
16600 (vhdl-insert-keyword "END FOR;\n")
16601 (setq inst-prev-path
(cdr inst-prev-path
)))
16602 (indent-to (- margin vhdl-basic-offset
))
16603 ;; insert block configuration end or remove beginning (for architecture)
16605 (vhdl-insert-keyword "END FOR;\n")
16606 (delete-region beg
(point)))))
16608 (defun vhdl-compose-configuration (&optional ent-name arch-name
)
16609 "Generate configuration declaration."
16611 (vhdl-require-hierarchy-info)
16612 (let ((ent-alist (aget vhdl-entity-alist
16613 (or (vhdl-project-p) default-directory
) t
))
16614 (conf-alist (aget vhdl-config-alist
16615 (or (vhdl-project-p) default-directory
) t
))
16616 (from-speedbar ent-name
)
16617 inst-alist conf-name conf-file-name pos
)
16618 (vhdl-prepare-search-2
16619 ;; get entity and architecture name
16622 (unless (and (re-search-backward "^\\(architecture\\s-+\\(\\w+\\)\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t
)
16623 (not (equal "END" (upcase (match-string 1))))
16624 (setq ent-name
(match-string-no-properties 3))
16625 (setq arch-name
(match-string-no-properties 2)))
16626 (error "ERROR: Not within an architecture"))))
16627 (setq conf-name
(vhdl-replace-string
16628 vhdl-compose-configuration-name
16629 (concat ent-name
" " arch-name
)))
16631 (nth 3 (aget (nth 3 (aget ent-alist
(downcase ent-name
) t
))
16632 (downcase arch-name
) t
))))
16633 (message "Generating configuration \"%s\"..." conf-name
)
16634 (if vhdl-compose-configuration-create-file
16635 ;; open configuration file
16637 (setq conf-file-name
16638 (concat (vhdl-replace-string vhdl-configuration-file-name
16640 "." (file-name-extension (buffer-file-name))))
16641 (when (and (file-exists-p conf-file-name
)
16642 (not (y-or-n-p (concat "File \"" conf-file-name
16643 "\" exists; overwrite? "))))
16644 (error "ERROR: Creating configuration...aborted"))
16645 (find-file conf-file-name
)
16647 (set-buffer-modified-p nil
)
16649 (if vhdl-compose-include-header
16650 (progn (vhdl-template-header
16651 (concat "Configuration declaration for design \""
16652 ent-name
"(" arch-name
")\""))
16653 (goto-char (point-max)))
16654 (vhdl-comment-display-line) (insert "\n\n")))
16655 ;; goto end of architecture
16656 (unless from-speedbar
16657 (re-search-forward "^end\\>" nil
)
16658 (end-of-line) (insert "\n\n")
16659 (vhdl-comment-display-line) (insert "\n\n")))
16660 ;; insert library clause
16662 (vhdl-template-standard-package (vhdl-work-library) nil
)
16663 (when (/= pos
(point))
16665 ;; insert configuration
16666 (vhdl-insert-keyword "CONFIGURATION ") (insert conf-name
)
16667 (vhdl-insert-keyword " OF ") (insert ent-name
)
16668 (vhdl-insert-keyword " IS\n")
16669 (indent-to vhdl-basic-offset
)
16670 ;; insert block configuration (for architecture)
16671 (vhdl-compose-configuration-architecture
16672 ent-name arch-name ent-alist conf-alist inst-alist t
)
16673 (vhdl-insert-keyword "END ") (insert conf-name
";")
16674 (when conf-file-name
16675 ;; insert footer and save
16677 (if (and vhdl-compose-include-header
(not (equal vhdl-file-footer
"")))
16678 (vhdl-template-footer)
16679 (vhdl-comment-display-line) (insert "\n"))
16682 (concat (format "Generating configuration \"%s\"...done" conf-name
)
16683 (and conf-file-name
16684 (format "\n File created: \"%s\"" conf-file-name
))))))
16687 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16688 ;;; Compilation / Makefile generation
16689 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16690 ;; (using `compile.el')
16692 (defvar vhdl-compile-post-command
""
16693 "String appended to compile command after file name.")
16695 (defun vhdl-makefile-name ()
16696 "Return the Makefile name of the current project or the current compiler if
16697 no project is defined."
16698 (let ((project-alist (aget vhdl-project-alist vhdl-project
))
16699 (compiler-alist (aget vhdl-compiler-alist vhdl-compiler
)))
16700 (vhdl-replace-string
16701 (cons "\\(.*\\)\n\\(.*\\)"
16702 (or (nth 8 project-alist
) (nth 8 compiler-alist
)))
16703 (concat (nth 9 compiler-alist
) "\n" (nth 6 project-alist
)))))
16705 (defun vhdl-compile-directory ()
16706 "Return the directory where compilation/make should be run."
16707 (let* ((project (aget vhdl-project-alist
(vhdl-project-p t
)))
16708 (compiler (aget vhdl-compiler-alist vhdl-compiler
))
16709 (directory (vhdl-resolve-env-variable
16711 (vhdl-replace-string
16712 (cons "\\(.*\\)" (nth 5 project
)) (nth 9 compiler
))
16713 (nth 6 compiler
)))))
16714 (file-name-as-directory
16715 (if (file-name-absolute-p directory
)
16717 (expand-file-name directory
(vhdl-default-directory))))))
16719 (defun vhdl-uniquify (in-list)
16720 "Remove duplicate elements from IN-LIST."
16723 (add-to-list 'out-list
(car in-list
))
16724 (setq in-list
(cdr in-list
)))
16727 (defun vhdl-set-compiler (name)
16728 "Set current compiler to NAME."
16730 (list (let ((completion-ignore-case t
))
16731 (completing-read "Compiler name: " vhdl-compiler-alist nil t
))))
16732 (if (assoc name vhdl-compiler-alist
)
16733 (progn (setq vhdl-compiler name
)
16734 (message "Current compiler: \"%s\"" vhdl-compiler
))
16735 (vhdl-warning (format "Unknown compiler: \"%s\"" name
))))
16737 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16740 (defun vhdl-compile-init ()
16741 "Initialize for compilation."
16742 (when (or (null compilation-error-regexp-alist
)
16743 (not (assoc (car (nth 11 (car vhdl-compiler-alist
)))
16744 compilation-error-regexp-alist
)))
16745 ;; `compilation-error-regexp-alist'
16746 (let ((commands-alist vhdl-compiler-alist
)
16747 regexp-alist sublist
)
16748 (while commands-alist
16749 (setq sublist
(nth 11 (car commands-alist
)))
16750 (unless (or (equal "" (car sublist
))
16751 (assoc (car sublist
) regexp-alist
))
16752 (push (list (nth 0 sublist
)
16753 (if (and (featurep 'xemacs
) (not (nth 1 sublist
)))
16756 (nth 2 sublist
) (nth 3 sublist
))
16758 (setq commands-alist
(cdr commands-alist
)))
16759 (setq compilation-error-regexp-alist
16760 (append compilation-error-regexp-alist
(nreverse regexp-alist
))))
16761 ;; `compilation-file-regexp-alist'
16762 (let ((commands-alist vhdl-compiler-alist
)
16763 regexp-alist sublist
)
16764 ;; matches vhdl-mode file name output
16765 (setq regexp-alist
'(("^Compiling \"\\(.+\\)\"" 1)))
16766 (while commands-alist
16767 (setq sublist
(nth 12 (car commands-alist
)))
16768 (unless (or (equal "" (car sublist
))
16769 (assoc (car sublist
) regexp-alist
))
16770 (push sublist regexp-alist
))
16771 (setq commands-alist
(cdr commands-alist
)))
16772 (setq compilation-file-regexp-alist
16773 (append compilation-file-regexp-alist
(nreverse regexp-alist
))))))
16775 (defvar vhdl-compile-file-name nil
16776 "Name of file to be compiled.")
16778 (defun vhdl-compile-print-file-name ()
16779 "Function called within `compile' to print out file name for compilers that
16780 do not print any file names."
16781 (insert "Compiling \"" vhdl-compile-file-name
"\"\n"))
16783 (defun vhdl-get-compile-options (project compiler file-name
16784 &optional file-options-only
)
16785 "Get compiler options. Returning nil means do not compile this file."
16786 (let* ((compiler-options (nth 1 compiler
))
16787 (project-entry (aget (nth 4 project
) vhdl-compiler
))
16788 (project-options (nth 0 project-entry
))
16789 (exception-list (and file-name
(nth 2 project-entry
)))
16790 (work-library (vhdl-work-library))
16791 (case-fold-search nil
)
16793 (while (and exception-list
16794 (not (string-match (caar exception-list
) file-name
)))
16795 (setq exception-list
(cdr exception-list
)))
16796 (if (and exception-list
(not (cdar exception-list
)))
16798 (if (and file-options-only
(not exception-list
))
16800 (setq file-options
(cdar exception-list
))
16801 ;; insert library name in compiler-specific options
16802 (setq compiler-options
16803 (vhdl-replace-string (cons "\\(.*\\)" compiler-options
)
16805 ;; insert compiler-specific options in project-specific options
16806 (when project-options
16807 (setq project-options
16808 (vhdl-replace-string
16809 (cons "\\(.*\\)\n\\(.*\\)" project-options
)
16810 (concat work-library
"\n" compiler-options
))))
16811 ;; insert project-specific options in file-specific options
16814 (vhdl-replace-string
16815 (cons "\\(.*\\)\n\\(.*\\)\n\\(.*\\)" file-options
)
16816 (concat work-library
"\n" compiler-options
"\n"
16817 project-options
))))
16819 (or file-options project-options compiler-options
)))))
16821 (defun vhdl-get-make-options (project compiler
)
16822 "Get make options."
16823 (let* ((compiler-options (nth 3 compiler
))
16824 (project-entry (aget (nth 4 project
) vhdl-compiler
))
16825 (project-options (nth 1 project-entry
))
16826 (makefile-name (vhdl-makefile-name)))
16827 ;; insert Makefile name in compiler-specific options
16828 (setq compiler-options
16829 (vhdl-replace-string (cons "\\(.*\\)" (nth 3 compiler
))
16831 ;; insert compiler-specific options in project-specific options
16832 (when project-options
16833 (setq project-options
16834 (vhdl-replace-string
16835 (cons "\\(.*\\)\n\\(.*\\)" project-options
)
16836 (concat makefile-name
"\n" compiler-options
))))
16838 (or project-options compiler-options
)))
16840 (defun vhdl-compile ()
16841 "Compile current buffer using the VHDL compiler specified in
16844 (vhdl-compile-init)
16845 (let* ((project (aget vhdl-project-alist vhdl-project
))
16846 (compiler (or (aget vhdl-compiler-alist vhdl-compiler nil
)
16847 (error "ERROR: No such compiler: \"%s\"" vhdl-compiler
)))
16848 (command (nth 0 compiler
))
16849 (default-directory (vhdl-compile-directory))
16850 (file-name (if vhdl-compile-absolute-path
16852 (file-relative-name (buffer-file-name))))
16853 (options (vhdl-get-compile-options project compiler file-name
))
16854 compilation-process-setup-function
)
16855 (unless (file-directory-p default-directory
)
16856 (error "ERROR: Compile directory does not exist: \"%s\"" default-directory
))
16857 ;; put file name into quotes if it contains spaces
16858 (when (string-match " " file-name
)
16859 (setq file-name
(concat "\"" file-name
"\"")))
16860 ;; print out file name if compiler does not
16861 (setq vhdl-compile-file-name
(if vhdl-compile-absolute-path
16863 (file-relative-name (buffer-file-name))))
16864 (when (and (= 0 (nth 1 (nth 10 compiler
)))
16865 (= 0 (nth 1 (nth 11 compiler
))))
16866 (setq compilation-process-setup-function
'vhdl-compile-print-file-name
))
16870 (compile (concat command
" " options
" " file-name
16871 (unless (equal vhdl-compile-post-command
"")
16872 (concat " " vhdl-compile-post-command
)))))
16873 (vhdl-warning "Your project settings tell me not to compile this file"))))
16875 (defvar vhdl-make-target
"all"
16876 "Default target for `vhdl-make' command.")
16878 (defun vhdl-make (&optional target
)
16879 "Call make command for compilation of all updated source files (requires
16880 `Makefile'). Optional argument TARGET allows to compile the design
16881 specified by a target."
16883 (setq vhdl-make-target
16884 (or target
(read-from-minibuffer "Target: " vhdl-make-target
16885 vhdl-minibuffer-local-map
)))
16886 (vhdl-compile-init)
16887 (let* ((project (aget vhdl-project-alist vhdl-project
))
16888 (compiler (or (aget vhdl-compiler-alist vhdl-compiler
)
16889 (error "ERROR: No such compiler: \"%s\"" vhdl-compiler
)))
16890 (command (nth 2 compiler
))
16891 (options (vhdl-get-make-options project compiler
))
16892 (default-directory (vhdl-compile-directory)))
16893 (unless (file-directory-p default-directory
)
16894 (error "ERROR: Compile directory does not exist: \"%s\"" default-directory
))
16896 (compile (concat (if (equal command
"") "make" command
)
16897 " " options
" " vhdl-make-target
))))
16900 (defvar vhdl-error-regexp-emacs-alist
16901 ;; Get regexps from `vhdl-compiler-alist'
16902 (let ((compiler-alist vhdl-compiler-alist
)
16903 (error-regexp-alist '((vhdl-directory "^ *Compiling \"\\(.+\\)\"" 1))))
16904 (while compiler-alist
16905 ;; add error message regexps
16906 (setq error-regexp-alist
16907 (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?-
(downcase (nth 0 (car compiler-alist
)))))))
16908 (nth 11 (car compiler-alist
)))
16909 error-regexp-alist
))
16910 ;; add filename regexps
16911 (when (/= 0 (nth 1 (nth 12 (car compiler-alist
))))
16912 (setq error-regexp-alist
16913 (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?-
(downcase (nth 0 (car compiler-alist
)))) "-file")))
16914 (nth 12 (car compiler-alist
)))
16915 error-regexp-alist
)))
16916 (setq compiler-alist
(cdr compiler-alist
)))
16917 error-regexp-alist
)
16918 "List of regexps for VHDL compilers. For Emacs 22+.")
16920 ;; Add error regexps using compilation-mode-hook.
16921 (defun vhdl-error-regexp-add-emacs ()
16922 "Set up Emacs compile for VHDL."
16924 (when (and (boundp 'compilation-error-regexp-alist-alist
)
16925 (not (assoc 'vhdl-modelsim compilation-error-regexp-alist-alist
)))
16928 (push (car item
) compilation-error-regexp-alist
)
16929 (push item compilation-error-regexp-alist-alist
))
16930 vhdl-error-regexp-emacs-alist
)))
16932 (when vhdl-emacs-22
16933 (add-hook 'compilation-mode-hook
'vhdl-error-regexp-add-emacs
))
16935 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16936 ;; Makefile generation
16938 (defun vhdl-generate-makefile ()
16939 "Generate `Makefile'."
16941 (let* ((compiler (or (aget vhdl-compiler-alist vhdl-compiler
)
16942 (error "ERROR: No such compiler: \"%s\"" vhdl-compiler
)))
16943 (command (nth 4 compiler
)))
16944 ;; generate makefile
16946 (let ((default-directory (vhdl-compile-directory)))
16947 (compile (vhdl-replace-string
16948 (cons "\\(.*\\) \\(.*\\)" command
)
16949 (concat (vhdl-makefile-name) " " (vhdl-work-library)))))
16950 (vhdl-generate-makefile-1))))
16952 (defun vhdl-get-packages (lib-alist work-library
)
16953 "Get packages from LIB-ALIST that belong to WORK-LIBRARY."
16956 (when (equal (downcase (caar lib-alist
)) (downcase work-library
))
16957 (push (cdar lib-alist
) pack-list
))
16958 (setq lib-alist
(cdr lib-alist
)))
16961 (defun vhdl-generate-makefile-1 ()
16962 "Generate Makefile for current project or directory."
16963 ;; scan hierarchy if required
16964 (if (vhdl-project-p)
16965 (unless (or (assoc vhdl-project vhdl-file-alist
)
16966 (vhdl-load-cache vhdl-project
))
16967 (vhdl-scan-project-contents vhdl-project
))
16968 (let ((directory (abbreviate-file-name default-directory
)))
16969 (unless (or (assoc directory vhdl-file-alist
)
16970 (vhdl-load-cache directory
))
16971 (vhdl-scan-directory-contents directory
))))
16972 (let* ((directory (abbreviate-file-name (vhdl-default-directory)))
16973 (project (vhdl-project-p))
16974 (ent-alist (aget vhdl-entity-alist
(or project directory
) t
))
16975 (conf-alist (aget vhdl-config-alist
(or project directory
) t
))
16976 (pack-alist (aget vhdl-package-alist
(or project directory
) t
))
16977 (regexp-list (or (nth 12 (aget vhdl-compiler-alist vhdl-compiler
))
16978 '("\\1.vhd" "\\2_\\1.vhd" "\\1.vhd"
16979 "\\1.vhd" "\\1_body.vhd" identity
)))
16981 (if (nth 12 (aget vhdl-compiler-alist vhdl-compiler
)) t nil
))
16982 (ent-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 0 regexp-list
)))
16983 (arch-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 1 regexp-list
)))
16984 (conf-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 2 regexp-list
)))
16985 (pack-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 3 regexp-list
)))
16986 (pack-body-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 4 regexp-list
)))
16987 (adjust-case (nth 5 regexp-list
))
16988 (work-library (downcase (vhdl-work-library)))
16989 (compile-directory (expand-file-name (vhdl-compile-directory)
16990 default-directory
))
16991 (makefile-name (vhdl-makefile-name))
16992 rule-alist arch-alist inst-alist
16993 target-list depend-list unit-list prim-list second-list subcomp-list
16994 lib-alist lib-body-alist pack-list all-pack-list
16995 ent-key ent-file-name arch-key arch-file-name ent-arch-key
16996 conf-key conf-file-name pack-key pack-file-name
16997 ent-entry arch-entry conf-entry pack-entry inst-entry
16998 pack-body-key pack-body-file-name inst-ent-key inst-conf-key
16999 tmp-key tmp-list rule
)
17000 ;; check prerequisites
17001 (unless (file-exists-p compile-directory
)
17002 (make-directory compile-directory t
))
17003 (unless mapping-exist
17005 (format "No unit-to-file name mapping found for compiler \"%s\".\n Directory of dummy files is created instead (to be used as dependencies).\n Please contact the VHDL Mode maintainer for full support of \"%s\""
17006 vhdl-compiler vhdl-compiler
) t
))
17007 (message "Generating makefile \"%s\"..." makefile-name
)
17008 ;; rules for all entities
17009 (setq tmp-list ent-alist
)
17011 (setq ent-entry
(car ent-alist
)
17012 ent-key
(nth 0 ent-entry
))
17013 (when (nth 2 ent-entry
)
17014 (setq ent-file-name
(if vhdl-compile-absolute-path
17016 (file-relative-name (nth 2 ent-entry
)
17017 compile-directory
))
17018 arch-alist
(nth 4 ent-entry
)
17019 lib-alist
(nth 6 ent-entry
)
17020 rule
(aget rule-alist ent-file-name
)
17021 target-list
(nth 0 rule
)
17022 depend-list
(nth 1 rule
)
17025 (setq tmp-key
(vhdl-replace-string
17027 (funcall adjust-case
17028 (concat ent-key
" " work-library
))))
17029 (push (cons ent-key tmp-key
) unit-list
)
17030 ;; rule target for this entity
17031 (push ent-key target-list
)
17032 ;; rule dependencies for all used packages
17033 (setq pack-list
(vhdl-get-packages lib-alist work-library
))
17034 (setq depend-list
(append depend-list pack-list
))
17035 (setq all-pack-list pack-list
)
17037 (aput 'rule-alist ent-file-name
(list target-list depend-list
))
17038 ;; rules for all corresponding architectures
17040 (setq arch-entry
(car arch-alist
)
17041 arch-key
(nth 0 arch-entry
)
17042 ent-arch-key
(concat ent-key
"-" arch-key
)
17043 arch-file-name
(if vhdl-compile-absolute-path
17045 (file-relative-name (nth 2 arch-entry
)
17046 compile-directory
))
17047 inst-alist
(nth 4 arch-entry
)
17048 lib-alist
(nth 5 arch-entry
)
17049 rule
(aget rule-alist arch-file-name
)
17050 target-list
(nth 0 rule
)
17051 depend-list
(nth 1 rule
))
17052 (setq tmp-key
(vhdl-replace-string
17054 (funcall adjust-case
17055 (concat arch-key
" " ent-key
" "
17058 (cons (cons ent-arch-key tmp-key
) unit-list
))
17059 (push ent-arch-key second-list
)
17060 ;; rule target for this architecture
17061 (push ent-arch-key target-list
)
17062 ;; rule dependency for corresponding entity
17063 (push ent-key depend-list
)
17064 ;; rule dependencies for contained component instantiations
17066 (setq inst-entry
(car inst-alist
))
17067 (when (or (null (nth 8 inst-entry
))
17068 (equal (downcase (nth 8 inst-entry
)) work-library
))
17069 (setq inst-ent-key
(or (nth 7 inst-entry
)
17070 (nth 5 inst-entry
)))
17071 (setq depend-list
(cons inst-ent-key depend-list
)
17072 subcomp-list
(cons inst-ent-key subcomp-list
)))
17073 (setq inst-alist
(cdr inst-alist
)))
17074 ;; rule dependencies for all used packages
17075 (setq pack-list
(vhdl-get-packages lib-alist work-library
))
17076 (setq depend-list
(append depend-list pack-list
))
17077 (setq all-pack-list
(append all-pack-list pack-list
))
17079 (aput 'rule-alist arch-file-name
(list target-list depend-list
))
17080 (setq arch-alist
(cdr arch-alist
)))
17081 (push (list ent-key second-list
(append subcomp-list all-pack-list
))
17083 (setq ent-alist
(cdr ent-alist
)))
17084 (setq ent-alist tmp-list
)
17085 ;; rules for all configurations
17086 (setq tmp-list conf-alist
)
17088 (setq conf-entry
(car conf-alist
)
17089 conf-key
(nth 0 conf-entry
)
17090 conf-file-name
(if vhdl-compile-absolute-path
17092 (file-relative-name (nth 2 conf-entry
)
17093 compile-directory
))
17094 ent-key
(nth 4 conf-entry
)
17095 arch-key
(nth 5 conf-entry
)
17096 inst-alist
(nth 6 conf-entry
)
17097 lib-alist
(nth 7 conf-entry
)
17098 rule
(aget rule-alist conf-file-name
)
17099 target-list
(nth 0 rule
)
17100 depend-list
(nth 1 rule
)
17101 subcomp-list
(list ent-key
))
17102 (setq tmp-key
(vhdl-replace-string
17104 (funcall adjust-case
17105 (concat conf-key
" " work-library
))))
17106 (push (cons conf-key tmp-key
) unit-list
)
17107 ;; rule target for this configuration
17108 (push conf-key target-list
)
17109 ;; rule dependency for corresponding entity and architecture
17111 (cons ent-key
(cons (concat ent-key
"-" arch-key
) depend-list
)))
17112 ;; rule dependencies for used packages
17113 (setq pack-list
(vhdl-get-packages lib-alist work-library
))
17114 (setq depend-list
(append depend-list pack-list
))
17115 ;; rule dependencies for contained component configurations
17117 (setq inst-entry
(car inst-alist
))
17118 (setq inst-ent-key
(nth 2 inst-entry
)
17119 inst-conf-key
(nth 4 inst-entry
))
17120 (when (equal (downcase (nth 5 inst-entry
)) work-library
)
17122 (setq depend-list
(cons inst-ent-key depend-list
)
17123 subcomp-list
(cons inst-ent-key subcomp-list
)))
17124 (when inst-conf-key
17125 (setq depend-list
(cons inst-conf-key depend-list
)
17126 subcomp-list
(cons inst-conf-key subcomp-list
))))
17127 (setq inst-alist
(cdr inst-alist
)))
17129 (aput 'rule-alist conf-file-name
(list target-list depend-list
))
17130 (push (list conf-key nil
(append subcomp-list pack-list
)) prim-list
)
17131 (setq conf-alist
(cdr conf-alist
)))
17132 (setq conf-alist tmp-list
)
17133 ;; rules for all packages
17134 (setq tmp-list pack-alist
)
17136 (setq pack-entry
(car pack-alist
)
17137 pack-key
(nth 0 pack-entry
)
17139 (when (nth 2 pack-entry
)
17140 (setq pack-file-name
(if vhdl-compile-absolute-path
17142 (file-relative-name (nth 2 pack-entry
)
17143 compile-directory
))
17144 lib-alist
(nth 6 pack-entry
) lib-body-alist
(nth 10 pack-entry
)
17145 rule
(aget rule-alist pack-file-name
)
17146 target-list
(nth 0 rule
) depend-list
(nth 1 rule
))
17147 (setq tmp-key
(vhdl-replace-string
17149 (funcall adjust-case
17150 (concat pack-key
" " work-library
))))
17151 (push (cons pack-key tmp-key
) unit-list
)
17152 ;; rule target for this package
17153 (push pack-key target-list
)
17154 ;; rule dependencies for all used packages
17155 (setq pack-list
(vhdl-get-packages lib-alist work-library
))
17156 (setq depend-list
(append depend-list pack-list
))
17157 (setq all-pack-list pack-list
)
17159 (aput 'rule-alist pack-file-name
(list target-list depend-list
))
17160 ;; rules for this package's body
17161 (when (nth 7 pack-entry
)
17162 (setq pack-body-key
(concat pack-key
"-body")
17163 pack-body-file-name
(if vhdl-compile-absolute-path
17165 (file-relative-name (nth 7 pack-entry
)
17166 compile-directory
))
17167 rule
(aget rule-alist pack-body-file-name
)
17168 target-list
(nth 0 rule
)
17169 depend-list
(nth 1 rule
))
17170 (setq tmp-key
(vhdl-replace-string
17172 (funcall adjust-case
17173 (concat pack-key
" " work-library
))))
17175 (cons (cons pack-body-key tmp-key
) unit-list
))
17176 ;; rule target for this package's body
17177 (push pack-body-key target-list
)
17178 ;; rule dependency for corresponding package declaration
17179 (push pack-key depend-list
)
17180 ;; rule dependencies for all used packages
17181 (setq pack-list
(vhdl-get-packages lib-body-alist work-library
))
17182 (setq depend-list
(append depend-list pack-list
))
17183 (setq all-pack-list
(append all-pack-list pack-list
))
17185 (aput 'rule-alist pack-body-file-name
17186 (list target-list depend-list
)))
17188 (cons (list pack-key
(when pack-body-key
(list pack-body-key
))
17191 (setq pack-alist
(cdr pack-alist
)))
17192 (setq pack-alist tmp-list
)
17193 ;; generate Makefile
17194 (let* ((project (aget vhdl-project-alist project
))
17195 (compiler (aget vhdl-compiler-alist vhdl-compiler
))
17196 (compiler-id (nth 9 compiler
))
17198 (vhdl-resolve-env-variable
17199 (vhdl-replace-string
17200 (cons "\\(.*\\)" (or (nth 7 project
) (nth 7 compiler
)))
17202 (makefile-path-name (expand-file-name
17203 makefile-name compile-directory
))
17204 (orig-buffer (current-buffer))
17205 cell second-list subcomp-list options unit-key unit-name
)
17207 (setq unit-list
(vhdl-sort-alist unit-list
))
17208 (setq prim-list
(vhdl-sort-alist prim-list
))
17209 (setq tmp-list rule-alist
)
17210 (while tmp-list
; pre-sort rule targets
17211 (setq cell
(cdar tmp-list
))
17212 (setcar cell
(sort (car cell
) 'string
<))
17213 (setq tmp-list
(cdr tmp-list
)))
17214 (setq rule-alist
; sort by first rule target
17216 (function (lambda (a b
)
17217 (string< (car (cadr a
)) (car (cadr b
)))))))
17218 ;; open and clear Makefile
17219 (set-buffer (find-file-noselect makefile-path-name t t
))
17221 (insert "# -*- Makefile -*-\n"
17222 "### " (file-name-nondirectory makefile-name
)
17223 " - VHDL Makefile generated by Emacs VHDL Mode " vhdl-version
17226 (insert "\n# Project : " (nth 0 project
))
17227 (insert "\n# Directory : \"" directory
"\""))
17228 (insert "\n# Platform : " vhdl-compiler
17229 "\n# Generated : " (format-time-string "%Y-%m-%d %T ")
17230 (user-login-name) "\n")
17231 ;; insert compile and option variable settings
17232 (insert "\n\n# Define compilation command and options\n"
17233 "\nCOMPILE = " (nth 0 compiler
)
17234 "\nOPTIONS = " (vhdl-get-compile-options project compiler nil
)
17235 (if (equal vhdl-compile-post-command
"") ""
17236 (concat "\nPOST-COMPILE = " vhdl-compile-post-command
))
17238 ;; insert library paths
17239 (setq library-directory
17240 (directory-file-name
17241 (if (file-name-absolute-p library-directory
)
17243 (file-relative-name
17244 (expand-file-name library-directory directory
)
17245 compile-directory
))))
17246 (insert "\n\n# Define library paths\n"
17247 "\nLIBRARY-" work-library
" = " library-directory
"\n")
17248 (unless mapping-exist
17249 (insert "LIBRARY-" work-library
"-make = " "$(LIBRARY-" work-library
17251 ;; insert variable definitions for all library unit files
17252 (insert "\n\n# Define library unit files\n")
17253 (setq tmp-list unit-list
)
17255 (insert "\nUNIT-" work-library
"-" (caar unit-list
)
17256 " = \\\n\t$(LIBRARY-" work-library
17257 (if mapping-exist
"" "-make") ")/" (cdar unit-list
))
17258 (setq unit-list
(cdr unit-list
)))
17259 ;; insert variable definition for list of all library unit files
17260 (insert "\n\n\n# Define list of all library unit files\n"
17262 (setq unit-list tmp-list
)
17264 (insert " \\\n\t" "$(UNIT-" work-library
"-" (caar unit-list
) ")")
17265 (setq unit-list
(cdr unit-list
)))
17267 (setq unit-list tmp-list
)
17268 ;; insert `make all' rule
17269 (insert "\n\n\n# Rule for compiling entire design\n"
17270 "\n" (nth 0 vhdl-makefile-default-targets
) " :"
17271 " \\\n\t\t" (nth 2 vhdl-makefile-default-targets
)
17272 " \\\n\t\t$(ALL_UNITS)\n")
17273 ;; insert `make clean' rule
17274 (insert "\n\n# Rule for cleaning entire design\n"
17275 "\n" (nth 1 vhdl-makefile-default-targets
) " : "
17276 "\n\t-rm -f $(ALL_UNITS)\n")
17277 ;; insert `make library' rule
17278 (insert "\n\n# Rule for creating library directory\n"
17279 "\n" (nth 2 vhdl-makefile-default-targets
) " :"
17280 " \\\n\t\t$(LIBRARY-" work-library
")"
17281 (if mapping-exist
""
17282 (concat " \\\n\t\t$(LIBRARY-" work-library
"-make)\n"))
17284 "\n$(LIBRARY-" work-library
") :"
17286 (vhdl-replace-string
17287 (cons "\\(.*\\)\n\\(.*\\)" (nth 5 compiler
))
17288 (concat "$(LIBRARY-" work-library
")\n" (vhdl-work-library)))
17290 (unless mapping-exist
17291 (insert "\n$(LIBRARY-" work-library
"-make) :"
17293 "mkdir -p $(LIBRARY-" work-library
"-make)\n"))
17294 ;; insert '.PHONY' declaration
17295 (insert "\n\n.PHONY : "
17296 (nth 0 vhdl-makefile-default-targets
) " "
17297 (nth 1 vhdl-makefile-default-targets
) " "
17298 (nth 2 vhdl-makefile-default-targets
) "\n")
17299 ;; insert rule for each library unit
17300 (insert "\n\n# Rules for compiling single library units and their subhierarchy\n")
17302 (setq second-list
(sort (nth 1 (car prim-list
)) 'string
<))
17304 (sort (vhdl-uniquify (nth 2 (car prim-list
))) 'string
<))
17305 (setq unit-key
(caar prim-list
)
17306 unit-name
(or (nth 0 (aget ent-alist unit-key t
))
17307 (nth 0 (aget conf-alist unit-key t
))
17308 (nth 0 (aget pack-alist unit-key t
))))
17309 (insert "\n" unit-key
)
17310 (unless (equal unit-key unit-name
)
17311 (insert " \\\n" unit-name
))
17313 " \\\n\t\t" (nth 2 vhdl-makefile-default-targets
))
17314 (while subcomp-list
17315 (when (and (assoc (car subcomp-list
) unit-list
)
17316 (not (equal unit-key
(car subcomp-list
))))
17317 (insert " \\\n\t\t" (car subcomp-list
)))
17318 (setq subcomp-list
(cdr subcomp-list
)))
17319 (insert " \\\n\t\t$(UNIT-" work-library
"-" unit-key
")")
17321 (insert " \\\n\t\t$(UNIT-" work-library
"-" (car second-list
) ")")
17322 (setq second-list
(cdr second-list
)))
17324 (setq prim-list
(cdr prim-list
)))
17325 ;; insert rule for each library unit file
17326 (insert "\n\n# Rules for compiling single library unit files\n")
17328 (setq rule
(car rule-alist
))
17329 ;; get compiler options for this file
17331 (vhdl-get-compile-options project compiler
(nth 0 rule
) t
))
17332 ;; insert rule if file is supposed to be compiled
17333 (setq target-list
(nth 1 rule
)
17334 depend-list
(sort (vhdl-uniquify (nth 2 rule
)) 'string
<))
17336 (setq tmp-list target-list
)
17338 (insert "\n$(UNIT-" work-library
"-" (car target-list
) ")"
17339 (if (cdr target-list
) " \\" " :"))
17340 (setq target-list
(cdr target-list
)))
17341 (setq target-list tmp-list
)
17342 ;; insert file name as first dependency
17343 (insert " \\\n\t\t" (nth 0 rule
))
17344 ;; insert dependencies (except if also target or unit does not exist)
17346 (when (and (not (member (car depend-list
) target-list
))
17347 (assoc (car depend-list
) unit-list
))
17348 (insert " \\\n\t\t"
17349 "$(UNIT-" work-library
"-" (car depend-list
) ")"))
17350 (setq depend-list
(cdr depend-list
)))
17351 ;; insert compile command
17353 (insert "\n\t$(COMPILE) "
17354 (if (eq options
'default
) "$(OPTIONS)" options
) " "
17356 (if (equal vhdl-compile-post-command
"") ""
17357 " $(POST-COMPILE)") "\n")
17359 (unless (and options mapping-exist
)
17360 (setq tmp-list target-list
)
17362 (insert "\t@touch $(UNIT-" work-library
"-" (car target-list
) ")\n")
17363 (setq target-list
(cdr target-list
)))
17364 (setq target-list tmp-list
))
17365 (setq rule-alist
(cdr rule-alist
)))
17367 (insert "\n\n### " makefile-name
" ends here\n")
17368 ;; run Makefile generation hook
17369 (run-hooks 'vhdl-makefile-generation-hook
)
17370 (message "Generating makefile \"%s\"...done" makefile-name
)
17371 ;; save and close file
17372 (if (file-writable-p makefile-path-name
)
17373 (progn (save-buffer)
17374 (kill-buffer (current-buffer))
17375 (set-buffer orig-buffer
)
17376 (when (fboundp 'add-to-history
)
17377 (add-to-history 'file-name-history makefile-path-name
)))
17378 (vhdl-warning-when-idle
17379 (format "File not writable: \"%s\""
17380 (abbreviate-file-name makefile-path-name
)))
17381 (switch-to-buffer (current-buffer))))))
17384 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17386 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17387 ;; (using `reporter.el')
17389 (defconst vhdl-mode-help-address
17390 "Reto Zimmermann <reto@gnu.org>"
17391 "Address for VHDL Mode bug reports.")
17393 (defun vhdl-submit-bug-report ()
17394 "Submit via mail a bug report on VHDL Mode."
17396 ;; load in reporter
17398 (y-or-n-p "Do you want to submit a report on VHDL Mode? ")
17399 (let ((reporter-prompt-for-summary-p t
))
17400 (reporter-submit-bug-report
17401 vhdl-mode-help-address
17402 (concat "VHDL Mode " vhdl-version
)
17404 ;; report all important user options
17405 'vhdl-offsets-alist
17406 'vhdl-comment-only-line-offset
17408 'vhdl-electric-mode
17410 'vhdl-indent-tabs-mode
17411 'vhdl-project-alist
17413 'vhdl-project-file-name
17414 'vhdl-project-auto-load
17416 'vhdl-compiler-alist
17418 'vhdl-compile-use-local-error-regexp
17419 'vhdl-makefile-default-targets
17420 'vhdl-makefile-generation-hook
17421 'vhdl-default-library
17424 'vhdl-upper-case-keywords
17425 'vhdl-upper-case-types
17426 'vhdl-upper-case-attributes
17427 'vhdl-upper-case-enum-values
17428 'vhdl-upper-case-constants
17429 'vhdl-use-direct-instantiation
17430 'vhdl-array-index-record-field-in-sensitivity-list
17431 'vhdl-compose-configuration-name
17432 'vhdl-entity-file-name
17433 'vhdl-architecture-file-name
17434 'vhdl-configuration-file-name
17435 'vhdl-package-file-name
17436 'vhdl-file-name-case
17437 'vhdl-electric-keywords
17438 'vhdl-optional-labels
17439 'vhdl-insert-empty-lines
17440 'vhdl-argument-list-indent
17441 'vhdl-association-list-with-formals
17442 'vhdl-conditions-in-parenthesis
17448 'vhdl-copyright-string
17449 'vhdl-platform-spec
17451 'vhdl-modify-date-prefix-string
17452 'vhdl-modify-date-on-saving
17454 'vhdl-reset-active-high
17455 'vhdl-clock-rising-edge
17456 'vhdl-clock-edge-condition
17460 'vhdl-include-port-comments
17461 'vhdl-include-direction-comments
17462 'vhdl-include-type-comments
17463 'vhdl-include-group-comments
17464 'vhdl-actual-generic-name
17465 'vhdl-actual-port-name
17466 'vhdl-instance-name
17467 'vhdl-testbench-entity-name
17468 'vhdl-testbench-architecture-name
17469 'vhdl-testbench-configuration-name
17470 'vhdl-testbench-dut-name
17471 'vhdl-testbench-include-header
17472 'vhdl-testbench-declarations
17473 'vhdl-testbench-statements
17474 'vhdl-testbench-initialize-signals
17475 'vhdl-testbench-include-library
17476 'vhdl-testbench-include-configuration
17477 'vhdl-testbench-create-files
17478 'vhdl-testbench-entity-file-name
17479 'vhdl-testbench-architecture-file-name
17480 'vhdl-compose-create-files
17481 'vhdl-compose-configuration-create-file
17482 'vhdl-compose-configuration-hierarchical
17483 'vhdl-compose-configuration-use-subconfiguration
17484 'vhdl-compose-include-header
17485 'vhdl-compose-architecture-name
17486 'vhdl-components-package-name
17487 'vhdl-use-components-package
17488 'vhdl-self-insert-comments
17489 'vhdl-prompt-for-comments
17490 'vhdl-inline-comment-column
17491 'vhdl-end-comment-column
17494 'vhdl-align-group-separate
17495 'vhdl-align-same-indent
17496 'vhdl-highlight-keywords
17497 'vhdl-highlight-names
17498 'vhdl-highlight-special-words
17499 'vhdl-highlight-forbidden-words
17500 'vhdl-highlight-verilog-keywords
17501 'vhdl-highlight-translate-off
17502 'vhdl-highlight-case-sensitive
17503 'vhdl-special-syntax-alist
17504 'vhdl-forbidden-words
17505 'vhdl-forbidden-syntax
17506 'vhdl-directive-keywords
17507 'vhdl-speedbar-auto-open
17508 'vhdl-speedbar-display-mode
17509 'vhdl-speedbar-scan-limit
17510 'vhdl-speedbar-jump-to-unit
17511 'vhdl-speedbar-update-on-saving
17512 'vhdl-speedbar-save-cache
17513 'vhdl-speedbar-cache-file-name
17515 'vhdl-source-file-menu
17516 'vhdl-hideshow-menu
17517 'vhdl-hide-all-init
17518 'vhdl-print-two-column
17519 'vhdl-print-customize-faces
17520 'vhdl-intelligent-tab
17521 'vhdl-indent-syntax-based
17522 'vhdl-indent-comment-like-next-code-line
17523 'vhdl-word-completion-case-sensitive
17524 'vhdl-word-completion-in-minibuffer
17525 'vhdl-underscore-is-part-of-word
17530 (if vhdl-special-indent-hook
17531 (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n"
17532 "vhdl-special-indent-hook is set to '"
17533 (format "%s" vhdl-special-indent-hook
)
17534 ".\nPerhaps this is your problem?\n"
17535 "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n")
17541 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17543 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17545 (defconst vhdl-doc-release-notes nil
17547 Release Notes for VHDL Mode 3.34
17548 ================================
17550 - Added support for GNU Emacs 22/23/24:
17551 - Compilation error parsing fixed for new `compile.el' package.
17553 - Port translation: Derive actual generic name from formal generic name.
17555 - New user options:
17556 `vhdl-actual-generic-name': Specify how actual generic names are obtained.
17559 Release Notes for VHDL Mode 3.33
17560 ================================
17565 CONFIGURATION DECLARATION GENERATION:
17566 - Automatic generation of a configuration declaration for a design.
17567 (See documentation (`C-c C-h') in section on STRUCTURAL COMPOSITION.)
17573 For Emacs compliance the following key bindings have been changed:
17575 - `C-c c' -> `C-c C-c' `vhdl-comment-uncomment-region'
17576 - `C-c f' -> `C-c C-i C-f' `vhdl-fontify-buffer'
17577 - `C-c s' -> `C-c C-i C-s' `vhdl-statistics-buffer'
17578 - `C-c C-c ...' -> `C-c C-m ...' `vhdl-compose-...'
17584 `vhdl-configuration-file-name': (new)
17585 Specify how the configuration file name is obtained.
17586 `vhdl-compose-configuration-name': (new)
17587 Specify how the configuration name is obtained.
17588 `vhdl-compose-configuration-create-file': (new)
17589 Specify whether a new file should be created for a configuration.
17590 `vhdl-compose-configuration-hierarchical': (new)
17591 Specify whether hierarchical configurations should be created.
17592 `vhdl-compose-configuration-use-subconfiguration': (new)
17593 Specify whether subconfigurations should be used inside configurations.
17594 `vhdl-makefile-default-targets': (new)
17595 Customize names of Makefile default targets.
17596 `vhdl-indent-comment-like-next-code-line': (new)
17597 Specify whether comment lines are indented like following code line.
17598 `vhdl-array-index-record-field-in-sensitivity-list': (new)
17599 Specify whether to include array indices / record fields in sensitivity list.
17603 (defconst vhdl-doc-keywords nil
17605 Reserved words in VHDL
17606 ----------------------
17608 VHDL'93/02 (IEEE Std 1076-1993/2002):
17609 `vhdl-02-keywords' : keywords
17610 `vhdl-02-types' : standardized types
17611 `vhdl-02-attributes' : standardized attributes
17612 `vhdl-02-enum-values' : standardized enumeration values
17613 `vhdl-02-functions' : standardized functions
17614 `vhdl-02-packages' : standardized packages and libraries
17616 VHDL-AMS (IEEE Std 1076.1 / 1076.1.1):
17617 `vhdl-ams-keywords' : keywords
17618 `vhdl-ams-types' : standardized types
17619 `vhdl-ams-attributes' : standardized attributes
17620 `vhdl-ams-enum-values' : standardized enumeration values
17621 `vhdl-ams-constants' : standardized constants
17622 `vhdl-ams-functions' : standardized functions
17624 Math Packages (IEEE Std 1076.2):
17625 `vhdl-math-types' : standardized types
17626 `vhdl-math-constants' : standardized constants
17627 `vhdl-math-functions' : standardized functions
17628 `vhdl-math-packages' : standardized packages
17631 `vhdl-verilog-keywords' : Verilog reserved words
17633 NOTE: click `mouse-2' on variable names above (not in XEmacs).")
17636 (defconst vhdl-doc-coding-style nil
17638 For VHDL coding style and naming convention guidelines, see the following
17642 \"VHDL Coding Styles and Methodologies\".
17643 Kluwer Academic Publishers, 1999.
17644 http://members.aol.com/vhdlcohen/vhdl/
17646 \[2] Michael Keating and Pierre Bricaud.
17647 \"Reuse Methodology Manual, Second Edition\".
17648 Kluwer Academic Publishers, 1999.
17649 http://www.openmore.com/openmore/rmm2.html
17651 \[3] European Space Agency.
17652 \"VHDL Modelling Guidelines\".
17653 ftp://ftp.estec.esa.nl/pub/vhdl/doc/ModelGuide.{pdf,ps}
17655 Use user options `vhdl-highlight-special-words' and `vhdl-special-syntax-alist'
17656 to visually support naming conventions.")
17659 (defun vhdl-version ()
17660 "Echo the current version of VHDL Mode in the minibuffer."
17662 (message "VHDL Mode %s (%s)" vhdl-version vhdl-time-stamp
)
17663 (vhdl-keep-region-active))
17665 (defun vhdl-doc-variable (variable)
17666 "Display VARIABLE's documentation in *Help* buffer."
17668 (unless (featurep 'xemacs
)
17669 (help-setup-xref (list #'vhdl-doc-variable variable
)
17670 (called-interactively-p 'interactive
)))
17671 (with-output-to-temp-buffer
17672 (if (fboundp 'help-buffer
) (help-buffer) "*Help*")
17673 (princ (documentation-property variable
'variable-documentation
))
17674 (with-current-buffer standard-output
17676 (help-print-return-message)))
17678 (defun vhdl-doc-mode ()
17679 "Display VHDL Mode documentation in *Help* buffer."
17681 (unless (featurep 'xemacs
)
17682 (help-setup-xref (list #'vhdl-doc-mode
)
17683 (called-interactively-p 'interactive
)))
17684 (with-output-to-temp-buffer
17685 (if (fboundp 'help-buffer
) (help-buffer) "*Help*")
17688 (princ (documentation 'vhdl-mode
))
17689 (with-current-buffer standard-output
17691 (help-print-return-message)))
17694 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17696 (provide 'vhdl-mode
)
17698 ;;; vhdl-mode.el ends here